-
-
Notifications
You must be signed in to change notification settings - Fork 38
/
VisualFBEditor.bas
731 lines (711 loc) · 31.7 KB
/
VisualFBEditor.bas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
'#########################################################
'# VisualFBEditor.bas #
'# This file is part of VisualFBEditor #
'# Authors: Xusinboy Bekchanov (bxusinboy@mail.ru) #
'# Liu XiaLin (LiuZiQi.HK@hotmail.com) #
'#########################################################
'#define __USE_GTK__
#ifndef __USE_MAKE__
'#define __USE_GTK3__
#define _NOT_AUTORUN_FORMS_
#endif
#define APP_TITLE "Visual FB Editor"
#define VER_MAJOR "1"
#define VER_MINOR "3"
#define VER_PATCH "3"
Const VERSION = VER_MAJOR + "." + VER_MINOR + "." + VER_PATCH
Const BUILD_DATE = __DATE__
Const SIGN = APP_TITLE + " " + VERSION
On Error Goto AA
#define MEMCHECK 0
#define FILENUMCHECK 1
#define _L DebugPrint_ __LINE__ & ": " & __FILE__ & ": " & __FUNCTION__:
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"
#include once "frmFindInFiles.bi"
#include once "frmProjectProperties.bi"
#include once "frmImageManager.bi"
#include once "frmParameters.bi"
#include once "frmAddIns.bi"
#include once "frmTools.bi"
#include once "frmAbout.bi"
#include once "TabWindow.bi"
Sub DebugPrint_(ByRef MSG As WString)
Debug.Print MSG, True, False, False, False
End Sub
Sub StartDebuggingWithCompile(Param As Any Ptr)
' ThreadsEnter
' ChangeEnabledDebug False, True, True
' ThreadsLeave
If Compile("Run") Then RunWithDebug(0) Else ThreadsEnter: ChangeEnabledDebug True, False, False: ThreadsLeave
End Sub
Sub StartDebugging(Param As Any Ptr)
ThreadsEnter
ChangeEnabledDebug False, True, True
ThreadsLeave
RunWithDebug(0)
End Sub
Sub RunCmd(Param As Any Ptr)
Dim As UString MainFile = GetMainFile()
Dim As UString cmd
Dim As WString Ptr Workdir, CmdL
If Trim(MainFile) = "" OrElse Trim(MainFile) = ML("Untitled") Then MainFile = GetFullPath(*ProjectsPath & "\1", pApp->FileName)
If OpenCommandPromptInMainFileFolder Then
WLet(Workdir, GetFolderName(MainFile))
Else
WLet(Workdir, *CommandPromptFolder)
End If
#ifdef __USE_GTK__
cmd = WGet(TerminalPath) & " --working-directory=""" & *Workdir & """"
Shell(cmd)
#else
cmd = Environ("COMSPEC") & " /K cd /D """ & *Workdir & """"
Dim As Integer pClass
Dim SInfo As STARTUPINFO
Dim PInfo As PROCESS_INFORMATION
WLet(CmdL, cmd)
SInfo.cb = Len(SInfo)
SInfo.dwFlags = STARTF_USESHOWWINDOW
SInfo.wShowWindow = SW_NORMAL
pClass = CREATE_UNICODE_ENVIRONMENT Or CREATE_NEW_CONSOLE
If CreateProcessW(NULL, CmdL, ByVal NULL, ByVal NULL, False, pClass, NULL, Workdir, @SInfo, @PInfo) Then
CloseHandle(PInfo.hProcess)
CloseHandle(PInfo.hThread)
End If
If CmdL Then Deallocate_( CmdL)
#endif
If Workdir Then Deallocate_( Workdir)
End Sub
Sub FindInFiles
ThreadCounter(ThreadCreate_(@FindSub))
End Sub
Sub ReplaceInFiles
ThreadCounter(ThreadCreate_(@ReplaceSub))
End Sub
Sub mClickUseDefine(Sender As My.Sys.Object)
Dim As String MenuName = Sender.ToString
If miUseDefine <> 0 Then miUseDefine->Checked = False
Dim As Integer Pos1 = InStr(MenuName, ":")
If Pos1 = 0 Then Pos1 = Len(MenuName)
UseDefine = Mid(MenuName, Pos1 + 1)
miUseDefine = Cast(MenuItem Ptr, @Sender)
miUseDefine->Checked = True
End Sub
Sub mClickMRU(Sender As My.Sys.Object)
If Sender.ToString = "ClearFiles" Then
miRecentFiles->Clear
miRecentFiles->Enabled = False
MRUFiles.Clear
ElseIf Sender.ToString = "ClearProjects" Then
miRecentProjects->Clear
miRecentProjects->Enabled = False
MRUProjects.Clear
ElseIf Sender.ToString = "ClearFolders" Then
miRecentFolders->Clear
miRecentFolders->Enabled = False
MRUFolders.Clear
ElseIf Sender.ToString = "ClearSessions" Then
miRecentSessions->Clear
miRecentSessions->Enabled = False
MRUSessions.Clear
Else
OpenFiles GetFullPath(Sender.ToString)
End If
End Sub
Sub mClickHelp(ByRef Sender As My.Sys.Object)
HelpOption.CurrentPath = Cast(MenuItem Ptr, @Sender)->ImageKey
HelpOption.CurrentWord = ""
ThreadCounter(ThreadCreate_(@RunHelp, @HelpOption))
End Sub
Sub mClickTool(ByRef Sender As My.Sys.Object)
Dim As MenuItem Ptr mi = Cast(MenuItem Ptr, @Sender)
If mi = 0 Then Exit Sub
Dim As UserToolType Ptr tt = mi->Tag
If tt <> 0 Then tt->Execute
End Sub
Sub mClickWindow(ByRef Sender As My.Sys.Object)
Dim As MenuItem Ptr mi = Cast(MenuItem Ptr, @Sender)
If mi = 0 Then Exit Sub
Dim As TabWindow Ptr tb = mi->Tag
If tb <> 0 Then tb->SelectTab
End Sub
Sub mClick(Sender As My.Sys.Object)
Select Case Sender.ToString
Case "NewProject": NewProject
Case "OpenProject": OpenProject
Case "OpenFolder": OpenFolder
Case "OpenSession": OpenSession
Case "SaveProject": SaveProject ptvExplorer->SelectedNode
Case "SaveProjectAs": SaveProject ptvExplorer->SelectedNode, True
Case "SaveSession": SaveSession
Case "CloseFolder": CloseFolder GetParentNode(ptvExplorer->SelectedNode)
Case "CloseProject": CloseProject GetParentNode(ptvExplorer->SelectedNode)
Case "New": AddTab
Case "Open": OpenProgram
Case "Save": Save
Case "Print": PrintThis
Case "PrintPreview": PrintPreview
Case "PageSetup": PageSetup
Case "CommandPrompt": ThreadCounter(ThreadCreate_(@RunCmd))
Case "AddFromTemplates": AddFromTemplates
Case "AddFilesToProject": AddFilesToProject
Case "RemoveFileFromProject": RemoveFileFromProject
Case "OpenProjectFolder": OpenProjectFolder
Case "ProjectProperties": pfProjectProperties->RefreshProperties: pfProjectProperties->ShowModal *pfrmMain
Case "SetAsMain": SetAsMain @Sender = miTabSetAsMain
Case "ReloadHistoryCode": ReloadHistoryCode
Case "ProjectExplorer": ptabLeft->Tab(0)->SelectTab
Case "PropertiesWindow": ptabRight->Tab(0)->SelectTab
Case "EventsWindow": ptabRight->Tab(1)->SelectTab
Case "ToolBox": ptabLeft->Tab(1)->SelectTab
Case "OutputWindow": ptabBottom->Tab(0)->SelectTab
Case "ErrorsWindow": ptabBottom->Tab(1)->SelectTab
Case "FindWindow": ptabBottom->Tab(2)->SelectTab
Case "ToDoWindow": ptabBottom->Tab(3)->SelectTab
Case "ChangeLogWindow": ptabBottom->Tab(4)->SelectTab
Case "ImmediateWindow": ptabBottom->Tab(5)->SelectTab
Case "LocalsWindow": ptabBottom->Tab(6)->SelectTab
Case "GlobalsWindow": ptabBottom->Tab(7)->SelectTab
'Case "ProceduresWindow": ptabBottom->Tab(8)->SelectTab
Case "ThreadsWindow": ptabBottom->Tab(8)->SelectTab
Case "WatchWindow": ptabBottom->Tab(9)->SelectTab
Case "ImageManager": pfImageManager->Show *pfrmMain
Case "Toolbars": 'ShowMainToolbar = Not ShowMainToolbar: ReBar1.Visible = ShowMainToolbar: pfrmMain->RequestAlign
Case "Standard": ShowStandardToolBar = Not ShowStandardToolBar: ReBar1.Bands.Item(0)->Visible = ShowStandardToolBar: mnuStandardToolBar->Checked = ShowStandardToolBar: pfrmMain->RequestAlign
Case "Edit": ShowEditToolBar = Not ShowEditToolBar: ReBar1.Bands.Item(1)->Visible = ShowEditToolBar: mnuEditToolBar->Checked = ShowEditToolBar: pfrmMain->RequestAlign
Case "Project": ShowProjectToolBar = Not ShowProjectToolBar: ReBar1.Bands.Item(2)->Visible = ShowProjectToolBar: mnuProjectToolBar->Checked = ShowProjectToolBar: pfrmMain->RequestAlign
Case "Build": ShowBuildToolBar = Not ShowBuildToolBar: ReBar1.Bands.Item(3)->Visible = ShowBuildToolBar: mnuBuildToolBar->Checked = ShowBuildToolBar: pfrmMain->RequestAlign
Case "Run": ShowRunToolBar = Not ShowRunToolBar: ReBar1.Bands.Item(4)->Visible = ShowRunToolBar: mnuRunToolBar->Checked = ShowRunToolBar: pfrmMain->RequestAlign
Case "TBUseDebugger": ChangeUseDebugger tbtUseDebugger->Checked, 0
Case "UseDebugger": ChangeUseDebugger Not mnuUseDebugger->Checked, 1
Case "Folder": WithFolder
Case "SyntaxCheck": If SaveAllBeforeCompile Then ThreadCounter(ThreadCreate_(@SyntaxCheck))
Case "CompileAll": If SaveAllBeforeCompile Then ThreadCounter(ThreadCreate_(@CompileAll))
Case "Compile": If SaveAllBeforeCompile Then ThreadCounter(ThreadCreate_(@CompileProgram))
Case "Make": If SaveAllBeforeCompile Then ThreadCounter(ThreadCreate_(@MakeExecute))
Case "MakeClean": If SaveAllBeforeCompile Then ThreadCounter(ThreadCreate_(@MakeExecute))
Case "BuildBundle": If SaveAllBeforeCompile Then ThreadCounter(ThreadCreate_(@CompileBundle))
Case "BuildAPK": If SaveAllBeforeCompile Then ThreadCounter(ThreadCreate_(@CompileAPK))
Case "CreateKeyStore": CreateKeyStore
Case "GenerateSignedBundle": GenerateSignedBundleAPK("bundle")
Case "GenerateSignedAPK": GenerateSignedBundleAPK("apk")
Case "FormatProject": ThreadCounter(ThreadCreate_(@FormatProject)) 'FormatProject 0
Case "UnformatProject": ThreadCounter(ThreadCreate_(@FormatProject, Cast(Any Ptr, 1))) 'FormatProject Cast(Any Ptr, 1)
Case "ProjectNumberOn": ThreadCounter(ThreadCreate_(@NumberingProject, @Sender))
Case "ProjectMacroNumberOn": ThreadCounter(ThreadCreate_(@NumberingProject, @Sender))
Case "ProjectMacroNumberOnStartsOfProcs": ThreadCounter(ThreadCreate_(@NumberingProject, @Sender))
Case "ProjectNumberOff": ThreadCounter(ThreadCreate_(@NumberingProject, @Sender))
Case "ProjectPreprocessorNumberOn": ThreadCounter(ThreadCreate_(@NumberingProject, @Sender))
Case "ProjectPreprocessorNumberOff": ThreadCounter(ThreadCreate_(@NumberingProject, @Sender))
Case "Parameters": pfParameters->ShowModal *pfrmMain
Case "GDBCommand": GDBCommand
Case "StartWithCompile"
If SaveAllBeforeCompile Then
ChangeEnabledDebug False, True, True
'SaveAll '
Dim As WString Ptr CurrentDebugger = IIf(tbt32Bit->Checked, CurrentDebugger32, CurrentDebugger64)
If *CurrentDebugger = ML("Integrated GDB Debugger") Then
#if Not (defined(__FB_WIN32__) AndAlso defined(__USE_GTK__))
If iFlagStartDebug = 0 Then
If UseDebugger Then
runtype = RTFRUN
CurrentTimer = SetTimer(0, 0, 1, Cast(Any Ptr, @TimerProcGDB))
ThreadCounter(ThreadCreate_(@StartDebuggingWithCompile))
Else
ThreadCounter(ThreadCreate_(@CompileAndRun))
End If
Else
continue_debug
End If
#endif
Else
If InDebug Then
#ifndef __USE_GTK__
ChangeEnabledDebug False, True, True
fastrun()
'runtype = RTRUN
'thread_rsm()
#endif
ElseIf UseDebugger Then
#ifndef __USE_GTK__
runtype = RTFRUN
'runtype = RTRUN
CurrentTimer = SetTimer(0, 0, 1, @TIMERPROC)
#endif
ThreadCounter(ThreadCreate_(@StartDebuggingWithCompile))
Else
ThreadCounter(ThreadCreate_(@CompileAndRun))
End If
End If
End If
Case "Start"
Dim As WString Ptr CurrentDebugger = IIf(tbt32Bit->Checked, CurrentDebugger32, CurrentDebugger64)
If *CurrentDebugger = ML("Integrated GDB Debugger") Then
#if Not (defined(__FB_WIN32__) AndAlso defined(__USE_GTK__))
If iFlagStartDebug = 0 Then
If UseDebugger Then
runtype= RTFRUN
CurrentTimer = SetTimer(0, 0, 1, Cast(Any Ptr, @TimerProcGDB))
ThreadCounter(ThreadCreate_(@StartDebugging))
Else
ThreadCounter(ThreadCreate_(@RunProgram))
End If
Else
ChangeEnabledDebug False, True, True
continue_debug()
End If
#endif
Else
If InDebug Then
#ifndef __USE_GTK__
ChangeEnabledDebug False, True, True
fastrun()
' runtype = RTRUN
' thread_rsm()
#endif
ElseIf UseDebugger Then
#ifndef __USE_GTK__
runtype = RTFRUN
'runtype = RTRUN
CurrentTimer = SetTimer(0, 0, 1, @TIMERPROC)
#endif
ThreadCounter(ThreadCreate_(@StartDebugging))
Else
ThreadCounter(ThreadCreate_(@RunProgram))
End If
End If
Case "Break":
#ifdef __USE_GTK__
ChangeEnabledDebug True, False, True
#else
If runtype=RTFREE Or runtype=RTFRUN Then
runtype=RTFRUN 'to treat free as fast
For i As Integer = 1 To linenb 'restore every breakpoint
WriteProcessMemory(dbghand,Cast(LPVOID,rline(i).ad),@breakcpu,1,0)
Next
Else
runtype=RTSTEP:procad=0:procin=0:proctop=False:procbot=0
EndIf
stopcode=CSHALTBU
'SetFocus(richeditcur)
#endif
Case "End":
Dim As WString Ptr CurrentDebugger = IIf(tbt32Bit->Checked, CurrentDebugger32, CurrentDebugger64)
If *CurrentDebugger = ML("Integrated GDB Debugger") Then
#if Not (defined(__FB_WIN32__) AndAlso defined(__USE_GTK__))
If Running Then
kill_debug()
Else
command_debug "q"
End If
#endif
Else
#ifdef __USE_GTK__
ChangeEnabledDebug True, False, False
#else
'kill_process("Terminate immediatly no saved data, other option Release")
For i As Integer = 1 To linenb 'restore old instructions
WriteProcessMemory(dbghand, Cast(LPVOID, rline(i).ad), @rline(i).sv, 1, 0)
Next
runtype = RTFREE
'but_enable()
thread_rsm()
DeleteDebugCursor
ChangeEnabledDebug True, False, False
#endif
End If
Case "Restart"
Dim As WString Ptr CurrentDebugger = IIf(tbt32Bit->Checked, CurrentDebugger32, CurrentDebugger64)
If *CurrentDebugger = ML("Integrated GDB Debugger") Then
#if Not (defined(__FB_WIN32__) AndAlso defined(__USE_GTK__))
command_debug("r")
#endif
Else
#ifndef __USE_GTK__
If prun AndAlso kill_process("Trying to launch but debuggee still running") = False Then
Exit Sub
End If
runtype = RTFRUN
'runtype = RTRUN
CurrentTimer = SetTimer(0, 0, 1, @TIMERPROC)
Restarting = True
ThreadCounter(ThreadCreate_(@StartDebugging))
#endif
End If
Case "StepInto":
ptabBottom->TabIndex = 6 'David Changed
Dim As WString Ptr CurrentDebugger = IIf(tbt32Bit->Checked, CurrentDebugger32, CurrentDebugger64)
If *CurrentDebugger = ML("Integrated GDB Debugger") Then
#if Not (defined(__FB_WIN32__) AndAlso defined(__USE_GTK__))
If iFlagStartDebug = 0 Then
runtype = RTSTEP
CurrentTimer = SetTimer(0, 0, 1, Cast(Any Ptr, @TimerProcGDB))
ThreadCounter(ThreadCreate_(@StartDebugging))
Else
step_debug("s")
End If
#endif
Else
If InDebug Then
ChangeEnabledDebug False, True, True
#ifndef __USE_GTK__
stopcode=0
'bcktrk_close
SetFocus(windmain)
thread_rsm
#endif
Else
#ifndef __USE_GTK__
runtype = RTSTEP
CurrentTimer = SetTimer(0, 0, 1, @TIMERPROC)
#endif
ThreadCounter(ThreadCreate_(@StartDebugging))
End If
End If
Case "StepOver":
Dim As WString Ptr CurrentDebugger = IIf(tbt32Bit->Checked, CurrentDebugger32, CurrentDebugger64)
If *CurrentDebugger = ML("Integrated GDB Debugger") Then
#if Not (defined(__FB_WIN32__) AndAlso defined(__USE_GTK__))
If iFlagStartDebug = 0 Then
CurrentTimer = SetTimer(0, 0, 1, Cast(Any Ptr, @TimerProcGDB))
ThreadCounter(ThreadCreate_(@StartDebugging))
Else
step_debug("n")
End If
#endif
Else
If InDebug Then
ChangeEnabledDebug False, True, True
#ifndef __USE_GTK__
procin = procsk
runtype = RTRUN
SetFocus(windmain)
thread_rsm()
#endif
Else
#ifndef __USE_GTK__
procin = procsk
runtype = RTFRUN
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", "AddProcedure" '
Dim tb As TabWindow Ptr = Cast(TabWindow Ptr, ptabCode->SelectedTab)
If tb = 0 Then Exit Sub
Select Case Sender.ToString
Case "Save": tb->Save
Case "SaveAs": tb->SaveAs: frmMain.Caption = tb->FileName & " - " & App.Title
Case "Close": CloseTab(tb)
Case "SortLines": tb->SortLines
Case "SplitHorizontally": tb->txtCode.SplittedHorizontally = Not mnuSplitHorizontally->Checked
Case "SplitVertically": tb->txtCode.SplittedVertically = Not mnuSplitVertically->Checked
Case "SplitUp", "SplitDown", "SplitLeft", "SplitRight":
Var ptabCode = Cast(TabControl Ptr, mnuTabs.ParentWindow)
Var tb = Cast(TabWindow Ptr, ptabCode->SelectedTab)
Var tp = Cast(TabPanel Ptr, tb->Parent->Parent)
Var ptabPanelNew = New TabPanel
Var bUpDown = False
Select Case Sender.ToString
Case "SplitUp"
ptabPanelNew->Align = DockStyle.alTop
ptabPanelNew->splGroup.Align = SplitterAlignmentConstants.alTop
bUpDown = True
Case "SplitDown"
ptabPanelNew->Align = DockStyle.alBottom
ptabPanelNew->splGroup.Align = SplitterAlignmentConstants.alBottom
bUpDown = True
Case "SplitLeft"
ptabPanelNew->Align = DockStyle.alLeft
ptabPanelNew->splGroup.Align = SplitterAlignmentConstants.alLeft
Case "SplitRight"
ptabPanelNew->Align = DockStyle.alRight
ptabPanelNew->splGroup.Align = SplitterAlignmentConstants.alRight
End Select
Var ptabPanel = Cast(TabPanel Ptr, tb->Parent->Parent)
Var Idx = tp->IndexOf(tb->Parent)
tp->Add ptabPanelNew, Idx
tp->Add @ptabPanelNew->splGroup, Idx + 1
Var SplitterCount = 0 'Fix(tp->ControlCount / 2)
For i As Integer = 1 To tp->ControlCount - 2 Step 2
If bUpDown Then
If tp->Controls[i]->Align = DockStyle.alTop OrElse tp->Controls[i]->Align = DockStyle.alBottom Then SplitterCount += 1
Else
If tp->Controls[i]->Align = DockStyle.alLeft OrElse tp->Controls[i]->Align = DockStyle.alRight Then SplitterCount += 1
End If
Next
For i As Integer = 0 To tp->ControlCount - 2 Step 2
If bUpDown Then
tp->Controls[i]->Height = (tp->Height - ptabPanelNew->splGroup.Height * SplitterCount) / (SplitterCount + 1)
Else
tp->Controls[i]->Width = (tp->Width - ptabPanelNew->splGroup.Width * SplitterCount) / (SplitterCount + 1)
End If
Next
ptabPanel->tabCode.DeleteTab tb
tb->Parent = @ptabPanelNew->tabCode
tb->ImageKey = tb->ImageKey
ptabPanelNew->tabCode.Add @tb->btnClose
tp->RequestAlign
ptabCode = @ptabPanelNew->tabCode
TabPanels.Add ptabPanelNew
Case "SetNextStatement":
Dim As WString Ptr CurrentDebugger = IIf(tbt32Bit->Checked, CurrentDebugger32, CurrentDebugger64)
If *CurrentDebugger = ML("Integrated GDB Debugger") Then
#if Not (defined(__FB_WIN32__) AndAlso defined(__USE_GTK__))
Dim As Integer iStartLine, iEndLine, iStartChar, iEndChar
tb->txtCode.GetSelection iStartLine, iEndLine, iStartChar, iEndChar
command_debug("jump " & Replace(tb->FileName, "\", "/") & ":" & Str(iEndLine))
#endif
Else
#ifndef __USE_GTK__
exe_mod()
#endif
End If
Case "ShowVar":
#ifndef __USE_GTK__
var_tip(1)
#endif
Case "StepOut":
Dim As WString Ptr CurrentDebugger = IIf(tbt32Bit->Checked, CurrentDebugger32, CurrentDebugger64)
If *CurrentDebugger = ML("Integrated GDB Debugger") Then
#if Not (defined(__FB_WIN32__) AndAlso defined(__USE_GTK__))
If iFlagStartDebug = 0 Then
ThreadCounter(ThreadCreate_(@StartDebugging))
Else
step_debug("n")
End If
#endif
Else
#ifndef __USE_GTK__
If InDebug Then
ChangeEnabledDebug False, True, True
If (threadcur<>0 AndAlso proc_find(thread(threadcur).id,KLAST)<>proc_find(thread(threadcur).id,KFIRST)) _
OrElse (threadcur=0 AndAlso PROC(procr(proc_find(thread(0).id,KLAST)).idx).nm<>"main") Then 'impossible to go out first proc of thread, constructore for shared 22/12/2015
procad = procsv
runtype = RTFRUN
End If
SetFocus(windmain)
thread_rsm()
End If
#endif
End If
Case "RunToCursor":
Dim As WString Ptr CurrentDebugger = IIf(tbt32Bit->Checked, CurrentDebugger32, CurrentDebugger64)
If *CurrentDebugger = ML("Integrated GDB Debugger") Then
#if Not (defined(__FB_WIN32__) AndAlso defined(__USE_GTK__))
If iFlagStartDebug = 1 Then
ChangeEnabledDebug False, True, True
set_bp True
continue_debug
Else
RunningToCursor = True
CurrentTimer = SetTimer(0, 0, 1, Cast(Any Ptr, @TimerProcGDB))
ThreadCounter(ThreadCreate_(@StartDebugging))
End If
#endif
Else
If InDebug Then
ChangeEnabledDebug False, True, True
#ifndef __USE_GTK__
brk_set(9)
#endif
Else
RunningToCursor = True
runtype = RTFRUN
#ifndef __USE_GTK__
CurrentTimer = SetTimer(0, 0, 1, @TIMERPROC)
#endif
ThreadCounter(ThreadCreate_(@StartDebugging))
End If
End If
Case "AddWatch":
#ifndef __USE_GTK__
var_tip(2)
#endif
Case "FindNext": pfFind->Find(True)
Case "FindPrev": pfFind->Find(False)
Case "Goto": pfGoto->Show *pfrmMain
Case "NextBookmark": NextBookmark 1
Case "PreviousBookmark": NextBookmark -1
Case "ClearAllBookmarks": ClearAllBookmarks
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
Case "CloseAllWithoutCurrent": CloseAllTabs(True)
Case "Exit": pfrmMain->CloseForm
Case "Find": mFormFind = True: pfFind->Show *pfrmMain
Case "FindInFiles": mFormFindInFile = True: pfFindFile->Show *pfrmMain
Case "ReplaceInFiles": mFormFindInFile = False: pfFindFile->Show *pfrmMain
Case "Replace": mFormFind = False: pfFind->Show *pfrmMain
Case "PinLeft": SetLeftClosedStyle Not tbLeft.Buttons.Item("PinLeft")->Checked, False
Case "PinRight": SetRightClosedStyle Not tbRight.Buttons.Item("PinRight")->Checked, False
Case "PinBottom": SetBottomClosedStyle Not tbBottom.Buttons.Item("PinBottom")->Checked, False
Case "EraseOutputWindow": txtOutput.Text = ""
Case "EraseImmediateWindow": txtImmediate.Text = ""
Case "Update":
#if Not (defined(__FB_WIN32__) AndAlso defined(__USE_GTK__))
iStateMenu = IIf(tbBottom.Buttons.Item("Update")->Checked, 2, 1): If Running = False Then command_debug("")
#endif
Case "AddForm": AddFromTemplate ExePath + "/Templates/Files/Form.frm"
Case "AddModule": AddFromTemplate ExePath + "/Templates/Files/Module.bas"
Case "AddIncludeFile": AddFromTemplate ExePath + "/Templates/Files/Include File.bi"
Case "AddUserControl": AddFromTemplate ExePath + "/Templates/Files/User Control.bas"
Case "AddResource": AddFromTemplate ExePath + "/Templates/Files/Resource.rc"
Case "AddManifest": AddFromTemplate ExePath + "/Templates/Files/Manifest.xml"
Case "PlainText", "Utf8", "Utf8BOM", "Utf16BOM", "Utf32BOM"
Dim tb As TabWindow Ptr = Cast(TabWindow Ptr, ptabCode->SelectedTab)
Dim FileEncoding As FileEncodings
Select Case Sender.ToString
Case "PlainText": FileEncoding = FileEncodings.PlainText
Case "Utf8": FileEncoding = FileEncodings.Utf8
Case "Utf8BOM": FileEncoding = FileEncodings.Utf8BOM
Case "Utf16BOM": FileEncoding = FileEncodings.Utf16BOM
Case "Utf32BOM": FileEncoding = FileEncodings.Utf32BOM
End Select
ChangeFileEncoding FileEncoding
If tb <> 0 Then
tb->FileEncoding = FileEncoding
tb->Modified = True
End If
Case "WindowsCRLF", "LinuxLF", "MacOSCR"
Dim tb As TabWindow Ptr = Cast(TabWindow Ptr, ptabCode->SelectedTab)
Dim NewLineType As NewLineTypes
Select Case Sender.ToString
Case "WindowsCRLF": NewLineType = NewLineTypes.WindowsCRLF
Case "LinuxLF": NewLineType = NewLineTypes.LinuxLF
Case "MacOSCR": NewLineType = NewLineTypes.MacOSCR
End Select
ChangeNewLineType NewLineType
If tb <> 0 Then
tb->NewLineType = NewLineType
tb->Modified = True
End If
#ifndef __USE_GTK__
Case "ShowString": string_sh(tviewvar)
Case "ShowExpandVariable": shwexp_new(tviewvar)
#endif
Case "Undo", "Redo", "CutCurrentLine", "Cut", "Copy", "Paste", "SelectAll", "Duplicate", "SingleComment", "BlockComment", "UnComment", _
"Indent", "Outdent", "Format", "Unformat", "AddSpaces", "NumberOn", "MacroNumberOn", "NumberOff", "ProcedureNumberOn", "ProcedureMacroNumberOn", "ProcedureNumberOff", _
"PreprocessorNumberOn", "PreprocessorNumberOff", "Breakpoint", "ToggleBookmark", "CollapseAll", "UnCollapseAll", "CollapseAllProcedures", "UnCollapseAllProcedures", _
"CollapseCurrent", "UnCollapseCurrent", "CompleteWord", "ParameterInfo", "OnErrorResumeNext", "OnErrorGoto", "OnErrorGotoResumeNext", "RemoveErrorHandling", "Define"
If pfrmMain->ActiveControl = 0 Then Exit Sub
If pfrmMain->ActiveControl->ClassName <> "EditControl" AndAlso pfrmMain->ActiveControl->ClassName <> "TextBox" AndAlso pfrmMain->ActiveControl->ClassName <> "Panel" Then Exit Sub
Dim tb As TabWindow Ptr = Cast(TabWindow Ptr, ptabCode->SelectedTab)
If pfrmMain->ActiveControl->ClassName = "TextBox" Then
Dim txt As TextBox Ptr = Cast(TextBox Ptr, pfrmMain->ActiveControl)
Select Case Sender.ToString
Case "Undo": txt->Undo
Case "Cut": txt->CutToClipboard
Case "Copy": txt->CopyToClipboard
Case "Paste": txt->PasteFromClipboard
Case "SelectAll": txt->SelectAll
End Select
ElseIf tb <> 0 Then
If tb->cboClass.ItemIndex > 0 Then
Dim des As Designer Ptr = tb->Des
If des = 0 Then Exit Sub
Select Case Sender.ToString
Case "Cut": des->CutControl
Case "Copy": des->CopyControl
Case "Paste": des->PasteControl
Case "Delete": des->DeleteControl
Case "Duplicate": des->DuplicateControl
Case "SelectAll": des->SelectAllControls
End Select
ElseIf pfrmMain->ActiveControl->ClassName = "EditControl" OrElse pfrmMain->ActiveControl->ClassName = "Panel" Then
Dim ec As EditControl Ptr = @tb->txtCode
Select Case Sender.ToString
Case "Redo": ec->Redo
Case "Undo": ec->Undo
Case "CutCurrentLine": ec->CutCurrentLineToClipboard
Case "Cut": ec->CutToClipboard
Case "Copy": ec->CopyToClipboard
Case "Paste": ec->PasteFromClipboard
Case "Duplicate": ec->DuplicateLine
Case "SelectAll": ec->SelectAll
Case "SingleComment": ec->CommentSingle
Case "BlockComment": ec->CommentBlock
Case "UnComment": ec->UnComment
Case "Indent": ec->Indent
Case "Outdent": ec->Outdent
Case "Format": ec->FormatCode
Case "Unformat": ec->UnformatCode
Case "AddSpaces": tb->AddSpaces
Case "Breakpoint":
Dim As WString Ptr CurrentDebugger = IIf(tbt32Bit->Checked, CurrentDebugger32, CurrentDebugger64)
If *CurrentDebugger = ML("Integrated GDB Debugger") Then
#if Not (defined(__FB_WIN32__) AndAlso defined(__USE_GTK__))
If iFlagStartDebug = 1 Then
set_bp
End If
#endif
Else
#ifndef __USE_GTK__
If InDebug Then: brk_set(1): End If
#endif
End If
ec->Breakpoint
Case "CollapseAll": ec->CollapseAll
Case "UnCollapseAll": ec->UnCollapseAll
Case "CollapseAllProcedures": ec->CollapseAllProcedures
Case "UnCollapseAllProcedures": ec->UnCollapseAllProcedures
Case "CollapseCurrent": ec->CollapseCurrent
Case "UnCollapseCurrent": ec->UnCollapseCurrent
Case "CompleteWord": CompleteWord
Case "ParameterInfo": ParameterInfo 0
Case "ToggleBookmark": ec->Bookmark
Case "Define": tb->Define
Case "NumberOn": tb->NumberOn
Case "MacroNumberOn": tb->NumberOn , , True
Case "NumberOff": tb->NumberOff
Case "ProcedureNumberOn": tb->ProcedureNumberOn
Case "ProcedureMacroNumberOn": tb->ProcedureNumberOn True
Case "ProcedureNumberOff": tb->ProcedureNumberOff
Case "PreprocessorNumberOn": tb->PreprocessorNumberOn
Case "PreprocessorNumberOff": tb->PreprocessorNumberOff
Case "OnErrorResumeNext": tb->SetErrorHandling "On Error Resume Next", ""
Case "OnErrorGoto": tb->SetErrorHandling "On Error Goto ErrorHandler", ""
Case "OnErrorGotoResumeNext": tb->SetErrorHandling "On Error Goto ErrorHandler", "Resume Next"
Case "RemoveErrorHandling": tb->RemoveErrorHandling
End Select
End If
End If
Case "Options": pfOptions->Show *pfrmMain
Case "AddIns": pfAddIns->Show *pfrmMain
Case "Tools": pfTools->Show *pfrmMain
Case "Content": ThreadCounter(ThreadCreate_(@RunHelp))
Case "FreeBasicForums": OpenUrl "https://www.freebasic.net/forum/index.php"
Case "FreeBasicWiKi": OpenUrl "https://www.freebasic.net/wiki/wikka.php?wakka=PageIndex"
Case "GitHubWebSite": OpenUrl "https://github.com"
Case "FreeBasicRepository": OpenUrl "https://github.com/freebasic/fbc"
Case "VisualFBEditorRepository": OpenUrl "https://github.com/XusinboyBekchanov/VisualFBEditor"
Case "VisualFBEditorWiKi": OpenUrl "https://github.com/XusinboyBekchanov/VisualFBEditor/wiki"
Case "VisualFBEditorDiscussions": OpenUrl "https://github.com/XusinboyBekchanov/VisualFBEditor/discussions"
Case "MyFbFrameworkRepository": OpenUrl "https://github.com/XusinboyBekchanov/MyFbFramework"
Case "MyFbFrameworkWiKi": OpenUrl "https://github.com/XusinboyBekchanov/MyFbFramework/wiki"
Case "MyFbFrameworkDiscussions": OpenUrl "https://github.com/XusinboyBekchanov/MyFbFramework/discussions"
Case "About": pfAbout->Show *pfrmMain
Case "TipoftheDay": pfTipOfDay->ShowModal *pfrmMain
End Select
End Sub
pApp->MainForm = @frmMain
pApp->Run
End
AA:
MsgBox ErrDescription(Err) & " (" & Err & ") " & _
"in function " & ZGet(Erfn()) & " " & _
"in module " & ZGet(Ermn()) ' & " " & _
'"in line " & Erl()