ورود

View Full Version : خبر: کنترلی برای مدیریت سورس کد ها با زبان های متفاوت برنامه نویسی



ROSTAM2
شنبه 15 دی 1403, 11:25 صبح
سلام

این شیء سفارشی می تواند به تعداد دلخواه سربرگ داشته باشد و هر سربرگ که انتخاب شود متن مرتبط با آن در یک RichTextBox نمایش و مدیریت می شود....

156356


<ToolboxBitmap(GetType(TabControl))>
<Docking(DockingBehavior.Ask)>
Public Class TextContentTabControl
Private TabItemsValue As New TabItemCollection(Me.ToolStrip1)
Public ReadOnly Property TabItems() As TabItemCollection
Get
Return TabItemsValue
End Get
End Property
Private SelectedIndexValue As Integer = 0
Public Property SelectedIndex() As Integer
Get
With Me.ToolStrip1
For i = 0 To .Items.Count - 2
If DirectCast(.Items(i), TabItem).Checked = True Then
Return i
End If
Next
End With
Return SelectedIndexValue
End Get
Set(ByVal value As Integer)
SelectedIndexValue = value
With Me.ToolStrip1
If value >= .Items.Count - 1 Then
Exit Property
End If
DirectCast(.Items(value), TabItem).Checked = True
End With
End Set
End Property


Public ReadOnly Property SelectedLabel() As String
Get
Return Me.TabItems(Me.SelectedIndex).Button.Text
End Get
End Property
Public ReadOnly Property SelectedContent() As String
Get
Return Me.TabItems(Me.SelectedIndex).Content
End Get
End Property
Private Sub ToolStripButton1_Click_1(sender As Object, e As System.EventArgs) Handles ToolStripButton1.Click
Dim DefaultName As String = "Language#"
With Me.ToolStrip1
Dim x As Integer = 1
For Each Item As ToolStripItem In .Items
If TypeOf (Item) Is TabItem Then
With DirectCast(Item, TabItem)
Do While (.Button.Text.EndsWith("#" + x.ToString))
x += 1
Loop
End With
End If
Next [Item]
DefaultName = DefaultName + x.ToString
Dim Item_ As New TabItem()
With TabItems.Add(Item_)
.Button.Text = DefaultName
.TabItemButton.EditMode = True
AddHandler .ButtonClciked, AddressOf TabItem_ButtonClciked
AddHandler .DeleteButtonClicked, AddressOf SelectedTabItem_DeleteButtonClicked
.Checked = True
End With
Me.SelectedTabItem = Item_
If Me.TabItems.Count = 1 Then
Me.RichTextBox1.Enabled = True
End If
Me.RichTextBox1.Text = Item_.Content
End With
End Sub


Public ReadOnly Property ContentBox() As RichTextBox
Get
Return Me.RichTextBox1
End Get
End Property
Protected Friend WithEvents SelectedTabItem As TabItem
Private Sub TabItem_ButtonClciked(sender As TabItem, Label As ToolStripLabel)
Me.SelectedTabItem = sender
Me.RichTextBox1.Text = sender.Content
End Sub


Private Sub RichTextBox1_TextChanged(sender As Object, e As EventArgs) Handles RichTextBox1.TextChanged
If Me.SelectedTabItem Is Nothing Then Exit Sub
Me.SelectedTabItem.Content = Me.RichTextBox1.Text
End Sub


Private Sub SelectedTabItem_DeleteButtonClicked(Sender As TabItem)
Dim Msg As MsgBoxResult =
MsgBox("Do you want to delete '" + Sender.Button.Text + "' Tab?",
MsgBoxStyle.Question Or MsgBoxStyle.YesNo)
If Msg = MsgBoxResult.No Then Exit Sub
Me.TabItems.Remove(Sender)
Me.RichTextBox1.Enabled = (Me.TabItems.Count > 0)
End Sub


Private Sub TextContentTabControl_Load(sender As Object, e As EventArgs) Handles Me.Load
TabItemsValue = New TabItemCollection(Me.ToolStrip1)
End Sub
End Class


دانلود سورس پروژه https://eitaa.com/vbprogramming/628 (https://eitaa.com/vbprogramming/628)

ROSTAM2
شنبه 15 دی 1403, 12:43 عصر
عنوان اصلی تاپبک اشتباه شده.... (کنترلی برای نمایش متن های متفاوت با انتخاب سربرگ)

ROSTAM2
دوشنبه 17 دی 1403, 14:15 عصر
سلام مجدد
تعییرات جدید بایداسمشو بگذارم SourceCodeTabControl ان شاء الله....

156359

قابلیت ویرایش سورس کد و عنوان سربرگ و تعیین زبان سورس کد و اینکه از HTML و CSS برای HighlightSyntax استفاده کردم....


Function NewLine(LineNumber As Integer, Text As String) As HtmlElement
With Me.WebBrowser1.Document
Dim LinesTable As HtmlElement = .GetElementById("Lines")
Dim Row As HtmlElement = .CreateElement("tr")
Dim TR As mshtml.HTMLTableRow = .CreateElement("tr").DomElement
Dim TD As mshtml.HTMLTableCell = .CreateElement("td").DomElement
TD.innerHTML = LineNumber.ToString
TD.className = "Column1"
TR.AppendChild(TD)
TD = .CreateElement("td").DomElement
TD.innerHTML = Text.Trim
TD.className = "Column2"
TR.appendChild(TD)
Row.InnerHtml = TR.innerHTML
LinesTable.AppendChild(Row)
Return Row
End With
End Function
Sub SetText(Value As String())
Dim Expr As String = My.Resources.Blank_html
With Me.WebBrowser1
.DocumentText =
My.Resources.Blank_html
Do Until .ReadyState = WebBrowserReadyState.Complete
Application.DoEvents()
Loop


For i = 0 To Value.Length - 1
Dim V As String = Value(i)
VisualBasic.HighlightComments(V)
VisualBasic.Highlight(V)
NewLine(i + 1, V)
Next
End With


End Sub

ROSTAM2
شنبه 22 دی 1403, 02:49 صبح
سلام

کد مرتب سازی خطوط سوزس کد Visual Basic:

156368

متغیر های عمومی کلاس:


Dim LineIndent As Integer = 0
Dim BeginKeyWordList As String() = {
"Function", "Sub",
"Namespace", "Class", "Module", "Structure",
"Interface", "Property"}
Dim EndKeyWordList As String() = {"End Function", "End Sub",
"Loop", "Next", "End Namespace", "End Class", "End Module", "End Structure",
"End Interface", "End Property", "End With",
"End Select", "End If"}
Dim StartWithsKeywords As String() = {"Do", "For",
"If", "Select Case", "Case", "With"}


متود ایجاد متن سورس کد و مرتب سازی خطوط:

Sub SetText(Value As String())
Dim Expr As String = My.Resources.Blank_html
With Me.WebBrowser1
.DocumentText =
My.Resources.Blank_html
Do Until .ReadyState = WebBrowserReadyState.Complete
Application.DoEvents()
Loop
For i = 0 To Value.Length - 1
Dim V As String = Value(i).Trim
If LineIndent > 0 Then
For Each Item As String In EndKeyWordList
If V.ContainsKeywords(Item) Then
Debug.Print("Item: {0}", Item)
LineIndent -= 1
If Item = "End Select" Then LineIndent -= 1
End If
Next
End If
If i = Value.Length - 1 Then LineIndent = 0
Dim Value_ As String =
String.Format("{0}{1}",
StrDup((LineIndent), " "), V)
If LineIndent >= 0 Then
For Each Item As String In BeginKeyWordList
If V.ContainsKeywordsBut(ExcludeWord:="End", Item) Then
LineIndent += 1
End If
Next
For Each W As String In StartWithsKeywords
Select Case W
Case "If"
If (V.StartsWith("If ",
StringComparison.OrdinalIgnoreCase) = False Or
V.StartsWith("If ",
StringComparison.OrdinalIgnoreCase)) AndAlso
V.EndsWith(" Then", StringComparison.OrdinalIgnoreCase) Then
LineIndent += 1
End If
Continue For
End Select
If V.StartsWith(W) Then
LineIndent += 1
End If
Next
End If
VisualBasic.HighlightComments(Value_)
VisualBasic.Highlight(Value_)
SharedHighlight.HighLightStrings(Value_)
NewLine(i + 1, Value_)
Next
End With
End Sub


و متود چاپ هر خط در HTML:


Function NewLine(LineNumber As Integer, Text As String) As HtmlElement
With Me.WebBrowser1.Document
Dim LinesTable As HtmlElement = .GetElementById("Lines")
Dim Row As HtmlElement = .CreateElement("tr")
Dim TR As mshtml.HTMLTableRow = .CreateElement("tr").DomElement
Dim TD As mshtml.HTMLTableCell = .CreateElement("td").DomElement
TD.innerHTML = LineNumber.ToString
TD.className = "Column1"
TR.AppendChild(TD)
TD = .CreateElement("td").DomElement
TD.innerHTML = Text
TD.className = "Column2"
TR.appendChild(TD)
Row.InnerHtml = TR.innerHTML
LinesTable.AppendChild(Row)
Return Row
End With
End Function


Extension Methods:



Imports System.Runtime.CompilerServices
Public Module ExtensionMethods
''' <summary>
''' Returns True when all values exists at InputText, otherwise false.
''' </summary>
''' <param name="InputText"></param>
''' <param name="values"></param>
''' <returns></returns>
<Extension>
Public Function ContainsKeywords(InputText As String, ParamArray values() As String) As Boolean
Dim StartIndex, Index, BeginIndex As Integer
Dim ExcludeChars() As String = {"(", "'", Chr(34)}
For Each C As Char In ExcludeChars
Index = InStr(InputText, C)
If Index <= 0 Then Continue For
StartIndex = Index
If BeginIndex <= StartIndex Then
BeginIndex = StartIndex
End If
Next
If StartIndex <= 0 Then StartIndex = (InputText.Length - 1)
For Each Value As String In values
Index = InStr(InputText.Substring(0, StartIndex + 1), Value)
If Index <= 0 Then Return False
Next
Return True
End Function
''' <summary>
''' Returns True when all values exists at InputText but ExcludeWord, otherwise false.
''' </summary>
''' <param name="InputText"></param>
''' <param name="ExcludeWord"></param>
''' <param name="values"></param>
''' <returns></returns>
<Extension>
Public Function ContainsKeywordsBut(InputText As String, ExcludeWord As String, ParamArray values() As String) As Boolean
Dim Index As Integer = InStr(InputText, ExcludeWord)
If Index > 0 Then Return False
Dim StartIndex, BeginIndex As Integer
Dim ExcludeChars() As String = {"(", "'", Chr(34)}
For Each C As Char In ExcludeChars
Index = InStr(InputText, C)
If Index <= 0 Then Continue For
StartIndex = Index
If BeginIndex <= StartIndex Then
BeginIndex = StartIndex
End If
Next
If StartIndex <= 0 Then StartIndex = (InputText.Length - 1)
For Each Value As String In values
Index = InputText.Substring(0, StartIndex + 1).
Contains(Value)
If Index = False Then Return False
Next
Return True
End Function
End Module

ROSTAM2
سه شنبه 25 دی 1403, 17:16 عصر
سلام مجدد

از این کنترل در این نرم افزار استغاده کردم فعلا فقط Highlight Syntax برای Visual Basic درست شده....

156376

دانلود دموی نرم افزار: (دیتابیس باید روی SQL Server ) باشه که Backup ازون در پوشه موجود هست....

156375

ROSTAM2
چهارشنبه 26 دی 1403, 08:13 صبح
سلام مجدد

بخش Search تصحیح شد و کلید Copy Code هم اضافه شد....

156378

دانلود دموی نرم افزار

ROSTAM2
جمعه 28 دی 1403, 17:04 عصر
حذف شود....

ROSTAM2
جمعه 28 دی 1403, 17:05 عصر
دانلود دموی نرم افزار با آخرین تغییرات: (دیتابیس باید در SQL Server باشد - فایل Backup در پوشه است)

XML , Visual Basic, C#‎‎‎‎‎‎‎, JavaScript, C, PHP, ....

https://codestore.blogsky.com/1403/10/28/post-27/%d8%af%d8%a7%d9%86%d9%84%d9%88%d8%af-%d9%86%d8%b1%d9%85-%d8%a7%d9%81%d8%b2%d8%a7%d8%b1-%d8%b0%d8%ae%db%8c%d8%b1%d9%87-%d8%b3%d8%a7%d8%b2%db%8c-%da%a9%d8%af%d9%87%d8%a7%db%8c-%d8%a8%d8%b1%d9%86%d8%a7%d9%85%d9%87-%d9%86%d9%88%db%8c%d8%b3%db%8c-Code-Library-156390

mazoolagh
شنبه 29 دی 1403, 12:13 عصر
سلام و روز خوش

همین اول باید بگم زحمات شما و بخصوص روحیه اشتراک گذاری با دیگران واقعا قابل تقدیره.

ولی همون کتابخانه highligh.js (https://highlightjs.org/)
که چند وقت پیش در تاپیک برای آدرس دقیق پوشه local در base باید چه بنویسیم.... (http://برای آدرس دقیق پوشه local در base باید چه بنویسیم....)
میخواستین استفاده کنین انتخاب بهتری هست،
اینجوری شما دوباره باید چرخ رو اختراع کنین -
آخرش هم عملکردش مثل این (یا کتابخانه های مشابه) نمیشه!

البته با کنترل webbrowser نمیشه و باید از webview2 استفاده کنین،
در مقابل دیگه لازم نیست خودتون برای هر زبان گرامرش رو کد کنین
یا استایل های مختلف بسازین.

کل کار با این روش شاید با 100 خط کد و چند ساعت زمان جمع بشه.

=========
البته این highlight.js شماره خط نداره (اهمیتی هم نداره و چیز زائدی هست)
ولی کتابخونه های دیگه ای هم هست که دارن اینو.
=========
اگر نمیخواین از webview2 استفاده کنین،
میتونین کد جاوااسکریپتش رو برای ie قدیمی سازگار کنین:
معمولا با جایگزینی arrow function و چیزایی مثل foreach ... درست میشه - حتی این کار هم بهتر نتیجه میده.
استایل ها به احتمال قریب به یقین لازم نیست ویرایش بشه.

ROSTAM2
شنبه 29 دی 1403, 16:47 عصر
سلام
من ترجیح می دم نرم افزاری که می سازم کاملا سفارشی سازی شده باشه

ROSTAM2
شنبه 29 دی 1403, 16:48 عصر
دانلود نرم افزار ذخیره سازی کدهای برنامه نویسی (Code Library) (https://codestore.blogsky.com/1403/10/29/post-28/%d8%af%d8%a7%d9%86%d9%84%d9%88%d8%af-%d9%86%d8%b1%d9%85-%d8%a7%d9%81%d8%b2%d8%a7%d8%b1-%d8%b0%d8%ae%db%8c%d8%b1%d9%87-%d8%b3%d8%a7%d8%b2%db%8c-%da%a9%d8%af%d9%87%d8%a7%db%8c-%d8%a8%d8%b1%d9%86%d8%a7%d9%85%d9%87-%d9%86%d9%88%db%8c%d8%b3%db%8c-Code-Library-)

دانلود نسخه 2 از CodeStore با عنوان CodeLibrary و کاربری آسان با آخرین تغییرات در 1403/10/29 :
156393