From 9f7b51a73affc3acfa169cc1f97524d54a1497ce Mon Sep 17 00:00:00 2001 From: Xusinboy Bekchanov Date: Wed, 17 Aug 2022 05:11:53 +0500 Subject: [PATCH] Added: Add Procedure Form --- src/EditControl.bas | 10 +- src/EditControl.bi | 4 +- src/Main.bas | 2 + src/TabWindow.bas | 3 +- src/VisualFBEditor.bas | 6 +- src/frmAddProcedure.frm | 287 ++++++++++++++++++++++++++++++++++++++++ 6 files changed, 302 insertions(+), 10 deletions(-) create mode 100644 src/frmAddProcedure.frm diff --git a/src/EditControl.bas b/src/EditControl.bas index 00a2d054..18e4a39a 100644 --- a/src/EditControl.bas +++ b/src/EditControl.bas @@ -2519,7 +2519,7 @@ Namespace My.Sys.Forms Return sTemp End Function - Sub EditControl.PaintControlPriv + Sub EditControl.PaintControlPriv(bFull As Boolean = False) ' On Error Goto ErrHandler #ifdef __USE_GTK__ If cr = 0 Then Exit Sub @@ -2689,7 +2689,7 @@ Namespace My.Sys.Forms ' SelectObject(bufDC, This.Canvas.Font.Handle) ' SelectObject(bufDC, This.Canvas.Pen.Handle) ' SetROP2 bufDC, This.Canvas.Pen.Mode - If OlddwClientX <> dwClientX OrElse OlddwClientY <> dwClientY OrElse OldPaintedVScrollPos(zz) <> VScrollPos OrElse OldPaintedHScrollPos(zz) <> HScrollPos OrElse iOldDivideY <> iDivideY OrElse iOldDividedY <> iDividedY OrElse iOldDivideX <> iDivideX OrElse iOldDividedX <> iDividedX OrElse CInt(bOldDividedX <> bDividedX) OrElse CInt(bOldDividedY <> bDividedY) Then + If bFull OrElse OlddwClientX <> dwClientX OrElse OlddwClientY <> dwClientY OrElse OldPaintedVScrollPos(zz) <> VScrollPos OrElse OldPaintedHScrollPos(zz) <> HScrollPos OrElse iOldDivideY <> iDivideY OrElse iOldDividedY <> iDividedY OrElse iOldDivideX <> iDivideX OrElse iOldDividedX <> iDividedX OrElse CInt(bOldDividedX <> bDividedX) OrElse CInt(bOldDividedY <> bDividedY) Then FillRect bufDC, @rc, This.Canvas.Brush.Handle End If #endif @@ -2718,7 +2718,7 @@ Namespace My.Sys.Forms If i < VScrollPos Then OldCollapseIndex = CollapseIndex: iC = FECLine->CommentIndex: Continue For If i - VScrollPos > vlc1 - 1 Then Exit For #ifdef __USE_WINAPI__ - If OlddwClientX = dwClientX AndAlso OlddwClientY = dwClientY AndAlso OldPaintedVScrollPos(zz) = VScrollPos AndAlso OldPaintedHScrollPos(zz) = HScrollPos AndAlso iOldDivideY = iDivideY AndAlso iOldDividedY = iDividedY AndAlso iOldDivideX = iDivideX AndAlso iOldDividedX = iDividedX AndAlso Cint(bOldDividedX = bDividedX) AndAlso CInt(bOldDividedY = bDividedY) Then + If bFull = False AndAlso OlddwClientX = dwClientX AndAlso OlddwClientY = dwClientY AndAlso OldPaintedVScrollPos(zz) = VScrollPos AndAlso OldPaintedHScrollPos(zz) = HScrollPos AndAlso iOldDivideY = iDivideY AndAlso iOldDividedY = iDividedY AndAlso iOldDivideX = iDivideX AndAlso iOldDividedX = iDividedX AndAlso Cint(bOldDividedX = bDividedX) AndAlso CInt(bOldDividedY = bDividedY) Then If (z < iSelStartLine OrElse z > iSelEndLine) AndAlso (z < iOldSelStartLine OrElse z > iOldSelEndLine) AndAlso (z <> FSelEndLine + 1) AndAlso BracketsStartLine <> z AndAlso BracketsEndLine <> z AndAlso OldBracketsStartLine <> z AndAlso OldBracketsEndLine <> z Then If CurWord <> "" OrElse OldCurWord <> "" Then If (CurWord = "" OrElse CurWord <> "" AndAlso InStr(LCase(*FECLine->Text), LCase(CurWord)) = 0) AndAlso (OldCurWord = "" OrElse OldCurWord <> "" AndAlso InStr(LCase(*FECLine->Text), LCase(OldCurWord)) = 0) Then @@ -3668,13 +3668,13 @@ Namespace My.Sys.Forms "in line " & Erl() End Sub - Sub EditControl.PaintControl + Sub EditControl.PaintControl(bFull As Boolean = False) #ifdef __USE_GTK__ 'PaintControlPriv bChanged = True If GTK_IS_WIDGET(widget) Then gtk_widget_queue_draw(widget) #else - PaintControlPriv + PaintControlPriv(bFull) #endif End Sub diff --git a/src/EditControl.bi b/src/EditControl.bi index 5d6e71f2..323a0ed1 100644 --- a/src/EditControl.bi +++ b/src/EditControl.bi @@ -397,8 +397,8 @@ Namespace My.Sys.Forms Declare Sub UnformatCode(WithoutUpdate As Boolean = False) Declare Function GetTabbedLength(ByRef SourceText As WString) As Integer Declare Function GetTabbedText(ByRef SourceText As WString, ByRef PosText As Integer = 0, ForPrint As Boolean = False) ByRef As WString - Declare Sub PaintControl() - Declare Sub PaintControlPriv() + Declare Sub PaintControl(bFull As Boolean = False) + Declare Sub PaintControlPriv(bFull As Boolean = False) Declare Function GetWordAt(LineIndex As Integer, CharIndex As Integer, WithDot As Boolean = False, WithQuestion As Boolean = False, ByRef StartChar As Integer = 0) As String Declare Function GetWordAtCursor(WithDot As Boolean = False) As String Declare Function GetWordAtPoint(X As Integer, Y As Integer, WithDot As Boolean = False) As String diff --git a/src/Main.bas b/src/Main.bas index 29a86f27..d4edbd2f 100644 --- a/src/Main.bas +++ b/src/Main.bas @@ -5194,6 +5194,8 @@ Sub CreateMenusAndToolBars mnuRestart->Enabled = False miXizmat = mnuMain.Add(ML("Servi&ce"), "", "Service") + miXizmat->Add(ML("Add &Procedure") & "..." & HK("AddProcedure"), "", "AddProcedure", @mClick) + miXizmat->Add("-") miXizmat->Add(ML("&Add-Ins") & "..." & HK("AddIns"), "", "AddIns", @mClick) miXizmat->Add("-") miXizmat->Add(ML("&Tools") & "..." & HK("Tools"), "", "Tools", @mClick) diff --git a/src/TabWindow.bas b/src/TabWindow.bas index e14d2127..cb8dcd08 100644 --- a/src/TabWindow.bas +++ b/src/TabWindow.bas @@ -2323,7 +2323,7 @@ Sub PropertyChanged(ByRef Sender As Control, ByRef Sender_Text As WString, IsCom pApp->DoEvents #endif Dim As Integer iLeft2, iTop2, iWidth2, iHeight2 - If st AndAlso st->IsComponentFunc AndAlso Cint(st->IsComponentFunc(pSelectedControls->Item(i))) Then + If st AndAlso st->IsComponentFunc AndAlso CInt(st->IsComponentFunc(pSelectedControls->Item(i))) Then If st->ComponentGetBoundsSub Then st->ComponentGetBoundsSub(pSelectedControls->Item(i), iLeft2, iTop2, iWidth2, iHeight2) If iLeft <> iLeft2 OrElse iTop <> iTop2 OrElse iWidth <> iWidth2 OrElse iHeight <> iHeight2 Then tb->Des->MoveDots pSelectedControls->Item(i), False End If @@ -2380,6 +2380,7 @@ Sub PropertyChanged(ByRef Sender As Control, ByRef Sender_Text As WString, IsCom .Changed "Unsurni o`zgartirish" pfrmMain->UpdateUnLock End If + .PaintControl(True) End With End Sub diff --git a/src/VisualFBEditor.bas b/src/VisualFBEditor.bas index 7e04d3a4..29b36f91 100644 --- a/src/VisualFBEditor.bas +++ b/src/VisualFBEditor.bas @@ -30,6 +30,7 @@ Declare Sub DebugPrint_(ByRef MSG As WString) #include once "Main.bi" #include once "Debug.bi" #include once "Designer.bi" +#include once "frmAddProcedure.frm" #include once "frmOptions.bi" #include once "frmGoto.bi" #include once "frmFind.bi" @@ -408,14 +409,14 @@ Sub mClick(Sender As My.Sys.Object) #ifndef __USE_GTK__ procin = procsk runtype = RTFRUN - CurrentTimer = SetTimer(0, 0, 1, @TimerProc) + CurrentTimer = SetTimer(0, 0, 1, @TIMERPROC) #endif ThreadCounter(ThreadCreate_(@StartDebugging)) End If End If Case "SaveAs", "Close", "SyntaxCheck", "Compile", "CompileAndRun", "Run", "RunToCursor", "SplitHorizontally", "SplitVertically", _ "Start", "Stop", "StepOut", "FindNext", "FindPrev", "Goto", "SetNextStatement", "SortLines", "SplitUp", "SplitDown", "SplitLeft", "SplitRight", _ - "AddWatch", "ShowVar", "NextBookmark", "PreviousBookmark", "ClearAllBookmarks", "Code", "Form", "CodeAndForm" ' + "AddWatch", "ShowVar", "NextBookmark", "PreviousBookmark", "ClearAllBookmarks", "Code", "Form", "CodeAndForm", "AddProcedure" ' Dim tb As TabWindow Ptr = Cast(TabWindow Ptr, ptabCode->SelectedTab) If tb = 0 Then Exit Sub Select Case Sender.ToString @@ -556,6 +557,7 @@ Sub mClick(Sender As My.Sys.Object) Case "Code": tb->tbrTop.Buttons.Item("Code")->Checked = True: tbrTop_ButtonClick tb->tbrTop, *tb->tbrTop.Buttons.Item("Code") Case "Form": tb->tbrTop.Buttons.Item("Form")->Checked = True: tbrTop_ButtonClick tb->tbrTop, *tb->tbrTop.Buttons.Item("Form") Case "CodeAndForm": tb->tbrTop.Buttons.Item("CodeAndForm")->Checked = True: tbrTop_ButtonClick tb->tbrTop, *tb->tbrTop.Buttons.Item("CodeAndForm") + Case "AddProcedure": frmAddProcedure.ShowModal frmMain End Select Case "SaveAll": SaveAll Case "CloseAll": CloseAllTabs diff --git a/src/frmAddProcedure.frm b/src/frmAddProcedure.frm new file mode 100644 index 00000000..d7e869cf --- /dev/null +++ b/src/frmAddProcedure.frm @@ -0,0 +1,287 @@ +'#Region "Form" + #include once "mff/Form.bi" + #include once "mff/Label.bi" + #include once "mff/TextBox.bi" + #include once "mff/CommandButton.bi" + #include once "mff/GroupBox.bi" + #include once "mff/RadioButton.bi" + #include once "mff/CheckBox.bi" + #include once "mff/ComboBoxEdit.bi" + + Using My.Sys.Forms + + Type frmAddProcedureType Extends Form + Declare Constructor + + Dim As Label lblName, lblParameters, lblType + Dim As TextBox txtName, txtName1 + Dim As CommandButton cmdOK, cmdCancel + Dim As GroupBox grbType, grbScope, grbAccessControl + Dim As RadioButton optSub, optFunction, optProperty, optPublicScope, optPrivateScope, optOperator, optPublicAccess, optProtectedAccess, optPrivateAccess, optConstructor, optOperator11 + Dim As CheckBox chkStatic + Dim As ComboBoxEdit cboType + End Type + + Constructor frmAddProcedureType + ' frmAddProcedure + With This + .Name = "frmAddProcedure" + .Text = ML("Add Procedure") + .Designer = @This + .Caption = ML("Add Procedure") + .BorderStyle = FormBorderStyle.FixedDialog + .MaximizeBox = False + .MinimizeBox = False + .Icon = "1" + .SetBounds 0, 0, 340, 400 + End With + ' lblName + With lblName + .Name = "lblName" + .Text = ML("Name") & ":" + .TabIndex = 0 + .Caption = ML("Name") & ":" + .SetBounds 10, 10, 90, 20 + .Designer = @This + .Parent = @This + End With + ' txtName + With txtName + .Name = "txtName" + .Text = "" + .TabIndex = 1 + .SetBounds 110, 10, 210, 20 + .Designer = @This + .Parent = @This + End With + ' cmdOK + With cmdOK + .Name = "cmdOK" + .Text = ML("OK") + .TabIndex = 2 + .Caption = ML("OK") + .SetBounds 150, 340, 80, 20 + .Designer = @This + .Parent = @This + End With + ' cmdCancel + With cmdCancel + .Name = "cmdCancel" + .Text = ML("Cancel") + .TabIndex = 3 + .ControlIndex = 2 + .Caption = ML("Cancel") + .SetBounds 240, 340, 80, 20 + .Designer = @This + .Parent = @This + End With + ' grbType + With grbType + .Name = "grbType" + .Text = ML("Type") + .TabIndex = 4 + .Caption = ML("Type") + .SetBounds 10, 160, 310, 80 + .Designer = @This + .Parent = @This + End With + ' optSub + With optSub + .Name = "optSub" + .Text = ML("Sub") + .TabIndex = 5 + .Caption = ML("Sub") + .SetBounds 10, 20, 100, 20 + .Designer = @This + .Parent = @grbType + End With + ' optFunction + With optFunction + .Name = "optFunction" + .Text = ML("Function") + .TabIndex = 6 + .ControlIndex = 0 + .Caption = ML("Function") + .SetBounds 110, 20, 100, 20 + .Designer = @This + .Parent = @grbType + End With + ' optProperty + With optProperty + .Name = "optProperty" + .Text = ML("Property") + .TabIndex = 7 + .ControlIndex = 1 + .Caption = ML("Property") + .SetBounds 210, 20, 90, 20 + .Designer = @This + .Parent = @grbType + End With + ' grbScope + With grbScope + .Name = "grbScope" + .Text = ML("Scope") + .TabIndex = 8 + .Caption = ML("Scope") + .SetBounds 10, 250, 310, 50 + .Designer = @This + .Parent = @This + End With + ' optPublicScope + With optPublicScope + .Name = "optPublicScope" + .Text = ML("Public") + .TabIndex = 9 + .Caption = ML("Public") + .SetBounds 10, 20, 90, 20 + .Designer = @This + .Parent = @grbScope + End With + ' optPrivateScope + With optPrivateScope + .Name = "optPrivateScope" + .Text = ML("Private") + .TabIndex = 10 + .ControlIndex = 0 + .Caption = ML("Private") + .SetBounds 110, 20, 90, 20 + .Designer = @This + .Parent = @grbScope + End With + ' chkStatic + With chkStatic + .Name = "chkStatic" + .Text = ML("Static") + .TabIndex = 11 + .Caption = ML("Static") + .SetBounds 10, 310, 140, 20 + .Designer = @This + .Parent = @This + End With + ' optOperator + With optOperator + .Name = "optOperator" + .Text = ML("Operator") + .TabIndex = 12 + .ControlIndex = 1 + .Caption = ML("Operator") + .SetBounds 10, 50, 100, 20 + .Designer = @This + .Parent = @grbType + End With + ' lblParameters + With lblParameters + .Name = "lblParameters" + .Text = ML("Parameters") & ":" + .TabIndex = 13 + .ControlIndex = 0 + .Caption = ML("Parameters") & ":" + .SetBounds 10, 40, 90, 20 + .Designer = @This + .Parent = @This + End With + ' txtName1 + With txtName1 + .Name = "txtName1" + .TabIndex = 14 + .ControlIndex = 2 + .Text = "" + .SetBounds 110, 40, 210, 20 + .Designer = @This + .Parent = @This + End With + ' lblType + With lblType + .Name = "lblType" + .Text = ML("Type") & ":" + .TabIndex = 15 + .ControlIndex = 0 + .Caption = ML("Type") & ":" + .SetBounds 10, 70, 90, 20 + .Designer = @This + .Parent = @This + End With + ' cboType + With cboType + .Name = "cboType" + .Text = "" + .TabIndex = 16 + .SetBounds 110, 70, 210, 21 + .Designer = @This + .Parent = @This + End With + ' grbAccessControl + With grbAccessControl + .Name = "grbAccessControl" + .Text = ML("Access Control") + .TabIndex = 17 + .ControlIndex = 7 + .Caption = ML("Access Control") + .SetBounds 10, 100, 310, 50 + .Designer = @This + .Parent = @This + End With + ' optPublicAccess + With optPublicAccess + .Name = "optPublicAccess" + .Text = ML("Public") + .TabIndex = 18 + .Caption = ML("Public") + .SetBounds 10, 20, 100, 20 + .Designer = @This + .Parent = @grbAccessControl + End With + ' optProtectedAccess + With optProtectedAccess + .Name = "optProtectedAccess" + .Text = ML("Protected") + .TabIndex = 19 + .Caption = ML("Protected") + .SetBounds 110, 20, 100, 20 + .Designer = @This + .Parent = @grbAccessControl + End With + ' optPrivateAccess + With optPrivateAccess + .Name = "optPrivateAccess" + .Text = ML("Private") + .TabIndex = 20 + .Caption = ML("Private") + .SetBounds 210, 20, 80, 20 + .Designer = @This + .Parent = @grbAccessControl + End With + ' optConstructor + With optConstructor + .Name = "optConstructor" + .Text = ML("Constructor") + .TabIndex = 21 + .ControlIndex = 3 + .Caption = ML("Constructor") + .SetBounds 110, 50, 100, 20 + .Designer = @This + .Parent = @grbType + End With + ' optOperator11 + With optOperator11 + .Name = "optOperator11" + .Text = ML("Destructor") + .TabIndex = 22 + .ControlIndex = 3 + .Caption = ML("Destructor") + .SetBounds 210, 50, 90, 20 + .Designer = @This + .Parent = @grbType + End With + End Constructor + + Dim Shared frmAddProcedure As frmAddProcedureType + + #ifndef _NOT_AUTORUN_FORMS_ + #define _NOT_AUTORUN_FORMS_ + + frmAddProcedure.Show + + App.Run + #endif +'#End Region