implement callstack; tooltips in locals; listview event fix

Author: SweetIceLolly

.gitignore

@@ -1 +1,5 @@
+# 忽略烦人的vbw
+*.vbw
 
+# 不要理自动备份的文件
+Vb_autoBak/

DarkImageButton.ctl

@@ -111,7 +111,7 @@ Private Sub labTip_MouseUp(Button As Integer, Shift As Integer, X As Single, Y A
 End Sub
 
 Private Sub tmrSetColor_Timer()
- Dim pt As Point
+ Dim pt As POINT
  Dim Target As Long
 
  If Not Enabled Then
@@ -136,9 +136,9 @@ Private Sub tmrSetColor_Timer()
  BackB = MOUSEIN_B
  End If
  Else
- BackR = BackR - 1
- BackG = BackG - 1
- BackB = BackB - 1
+ BackR = BackR - (MOUSEIN_R - NORMAL_R) / 30
+ BackG = BackG - (MOUSEIN_G - NORMAL_G) / 30
+ BackB = BackB - (MOUSEIN_B - NORMAL_B) / 30
  If BackR < NORMAL_R Or BackG < NORMAL_G Or BackB < NORMAL_B Then
  BackR = NORMAL_R
  BackG = NORMAL_G
@@ -211,7 +211,7 @@ End Sub
 
 Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  If Button = vbLeftButton Then
- Dim pt As Point
+ Dim pt As POINT
  Dim Target As Long
 
  GetCursorPos pt

DarkListView.ctl

@@ -93,12 +93,12 @@ Public Sub RaiseClick(iItem As Long, iSubItem As Long, X As Long, Y As Long)
  RaiseEvent Click(iItem, iSubItem, X, Y)
 End Sub
 
+'Please note that this function is for internal usage only and is NOT suggested to call directly
 Public Sub RaiseDoubleClick(iItem As Long, iSubItem As Long, X As Long, Y As Long)
  RaiseEvent DoubleClick(iItem, iSubItem, X, Y)
 End Sub
 
 Public Function AddColumnHeader(Text As String, Optional Width As Integer = 75, Optional Index As Long = -1) As Long
- 
  Dim lvCol As LVCOLUMN
  Dim tmpStr() As Byte
 
@@ -317,7 +317,7 @@ Private Sub UserControl_Initialize()
  0, 0, UserControl.ScaleWidth / Screen.TwipsPerPixelX, _
  UserControl.ScaleHeight / Screen.TwipsPerPixelY, UserControl.hWnd, 0, App.hInstance, 0) 'Or WS_BORDER
 
- SetPropA lvHwnd, "ID", CtlListPushBack(Me)
+ SetPropA lvHwnd, "ID", ByVal CtlListPushBack(Me)
  SetPropA lvHwnd, "PARENT_CTL", UserControl.hWnd
 
  SendMessageA lvHwnd, LVM_SETBKCOLOR, ByVal 0, ByVal RGB(51, 51, 55)
@@ -415,6 +415,10 @@ Public Property Get ListViewHwnd() As Long
  ListViewHwnd = lvHwnd
 End Property
 
+Public Property Get hWnd() As Long
+ hWnd = UserControl.hWnd
+End Property
+
 'Initialize Properties for User Control
 Private Sub UserControl_InitProperties()
  m_FullRowSelect = m_def_FullRowSelect

DragControlsIDE.exe

@@ -53,6 +53,7 @@ Module=modTreeViewProc; modTreeViewProc.bas
 UserControl=DarkTreeView.ctl
 Form=frmCreateOptions.frm
 Form=frmSaveBox.frm
+Module=modTooltips; modTooltips.bas
 ResFile32="DragControlsIDE.res"
 IconForm="frmMain"
 Startup="frmMain"

DragControlsIDE.vbp

@@ -15,21 +15,21 @@ propMenuItems = 111, 43, 1512, 799, C, 295, 129, 1296, 754, C
 frmPopupMenu = 83, 74, 1476, 830, C, 52, 83, 1287, 756, C
 DarkListBox = 146, 197, 1389, 850, C, 67, 159, 1319, 832, C
 modListBoxRedrawProc = 24, 153, 1454, 732, C
-DarkListView = 80, 115, 1336, 853, C, 541, 254, 1328, 746, C
+DarkListView = 120, 64, 1376, 633, C, 541, 254, 1328, 746, C
 modListViewProc = 93, 200, 1393, 809, C
 DarkHScrollBar = 275, 223, 1527, 876, C, 76, 206, 1328, 879, C
-frmMain = 82, 98, 1486, 716, , 10, 9, 1250, 629, C
+frmMain = -118, 18, 1350, 629, , 10, 9, 1250, 629, C
 modMain = 62, 84, 1463, 735, C
 frmCodeWindow = 17, 39, 1358, 762, C, 115, 152, 1397, 714, C
-modConfig = 98, 125, 1446, 922, C
+modConfig = 98, 125, 1446, 922, 
 frmStartupLogo = 132, 195, 1414, 750, C, 96, 96, 849, 426, C
 frmControlBox = 737, 289, 1945, 949, C, 125, 95, 1407, 650, C
 frmWindowContainer = 0, 0, 0, 0, C, 75, 75, 1357, 630, C
-frmBreakpoints = 9, 59, 1345, 719, C, 103, 319, 1385, 874, C
+frmBreakpoints = 124, 124, 1460, 784, C, 103, 319, 1385, 874, C
 frmWatch = 234, 234, 1442, 894, C, 75, 75, 1357, 630, C
-frmLocals = 3, 12, 1485, 801, Z, 196, 190, 1478, 745, C
+frmLocals = 19, 18, 1491, 786, C, 196, 189, 1478, 745, C
 frmImmediate = 26, 26, 1234, 686, C, 125, 125, 1407, 680, C
-frmCallStack = 51, 307, 1259, 967, C, 150, 150, 1432, 705, C
+frmCallStack = 69, 60, 1525, 876, , 150, 150, 1432, 705, C
 frmThreads = 130, 130, 1338, 790, C, 175, 175, 1457, 730, C
 frmModules = 156, 156, 1364, 816, C, 200, 200, 1482, 755, C
 frmMemory = 104, 104, 1312, 764, C, 225, 225, 1507, 780, C
@@ -41,8 +41,9 @@ frmErrorList = 312, 312, 1520, 972, C, 100, 100, 1382, 655, C
 frmOutput = 264, 120, 1521, 670, C, 125, 125, 1407, 680, C
 TabBar = 7, 146, 1396, 834, C, 0, 0, 1282, 555, C
 frmCreate = 407, 123, 1486, 768, C, 21, 176, 1348, 732, C
-clsPipe = 72, 47, 1421, 899, C
+clsPipe = 72, 48, 1421, 899, C
 modTreeViewProc = 632, 197, 2116, 1018, C
 DarkTreeView = -43, 181, 1449, 779, C, 210, 193, 1452, 743, C
 frmCreateOptions = -239, 310, 1256, 1061, C, -6, 46, 1236, 596, C
 frmSaveBox = 83, 162, 1449, 839, C, 205, 263, 1410, 923, C
+modTooltips = 81, 90, 1439, 883, C

DragControlsIDE.vbw

@@ -19,9 +19,9 @@ Begin VB.Form frmBreakpoints
  TabIndex = 0
  Top = 0
  Width = 6855
- _ExtentX = 8281
- _ExtentY = 5318
- CheckBoxes = -1 'True
+ _extentx = 8281
+ _extenty = 5318
+ checkboxes = -1
  End
 End
 Attribute VB_Name = "frmBreakpoints"
@@ -37,6 +37,15 @@ Attribute VB_Exposed = False
 
 Option Explicit
 
+'描述: 清空所有东西，为下一次调试做准备
+Public Sub ClearEverything()
+ Dim i As Long
+ 
+ For i = 0 To Me.lvBreakpoints.GetItemCount '清空断点对应的地址
+ Me.lvBreakpoints.SetItemText "", i, 2
+ Next i
+End Sub
+
 Private Sub Form_Load()
  Me.Caption = Lang_Breakpoints_Caption
 

frmBreakpoints.frm

@@ -3,23 +3,180 @@ Begin VB.Form frmCallStack
  BackColor = &H00302D2D&
  BorderStyle = 0 'None
  Caption = "调用堆栈"
- ClientHeight = 3030
+ ClientHeight = 3645
  ClientLeft = 0
  ClientTop = 0
- ClientWidth = 4560
+ ClientWidth = 5775
  LinkTopic = "Form1"
- ScaleHeight = 3030
- ScaleWidth = 4560
+ ScaleHeight = 3645
+ ScaleWidth = 5775
  ShowInTaskbar = 0 'False
  StartUpPosition = 3 'Windows Default
+ Begin DragControlsIDE.DarkListView lvCallStack 
+ Height = 2655
+ Left = 480
+ TabIndex = 0
+ Top = 240
+ Width = 3615
+ _extentx = 6376
+ _extenty = 4683
+ End
 End
 Attribute VB_Name = "frmCallStack"
 Attribute VB_GlobalNameSpace = False
 Attribute VB_Creatable = False
 Attribute VB_PredeclaredId = True
 Attribute VB_Exposed = False
+'====================================================
+'描述: 调用堆栈窗口，在中断状态下显示调用堆栈
+'作者: 冰棍
+'文件: frmCallStack.frm
+'====================================================
+
 Option Explicit
 
+'定义调用堆栈信息结构
+Private Type CallStackInfoStruct
+ Address As String '地址
+ Args As String '参数
+ File As String '文件
+ Line As Long '行号
+End Type
+
+Dim CallStackInfo() As CallStackInfoStruct '所有调用堆栈信息
+
+'描述: 清空所有东西，为下一次调试做准备
+Public Sub ClearEverything()
+ Me.lvCallStack.Clear
+ ReDim CallStackInfo(0)
+End Sub
+
+'描述: 获取调用堆栈列表
+Public Sub GetCallStack()
+ 'On Error Resume Next 'todo
+ Dim PipeOutput As String '管道的输出
+ Dim OutputLines() As String '输出的每一行
+ Dim StrPos As Long '查找到的字符串的位置
+ Dim BracketLevel As Long '括号匹配计数，一开始是0，遇到“(”加1, 遇到“)”减1
+ Dim NewListItem As Long '新添加的ListView列表项索引
+ Dim i As Long
+ 
+ Me.lvCallStack.Clear
+ frmMain.DockingPane.Panes(10).Title = Lang_CallStack_Retrieving_Caption
+ 
+ frmMain.GdbPipe.ClearPipe '清空管道里的内容
+ frmMain.GdbPipe.DosInput "info stack" & vbCrLf '向gdb发送获取调用堆栈命令
+ frmMain.GdbPipe.DosOutput PipeOutput, "(gdb) " '获取gdb输出
+ 
+ OutputLines = Split(PipeOutput, vbCrLf) '逐行分割开输出
+ ReDim CallStackInfo(UBound(OutputLines) - 1) '分配信息列表元素
+ For i = 0 To UBound(OutputLines) '逐行进行分析
+ If Trim(OutputLines(i)) <> "(gdb)" Then '去掉无用输出“(gdb) ”
+ If OutputLines(i) Like "[#]* * in *(*)" Then '输出中不带文件名
+ OutputLines(i) = Right(OutputLines(i), Len(OutputLines(i)) - Len(Split(OutputLines(i), " ")(0)) - 1) '（#n func(arg types) (args)）
+ CallStackInfo(i).Address = OutputLines(i)
+ Else '输出中带有文件名
+ StrPos = InStrRev(OutputLines(i), ":") '（#n func(arg types) (args) at file:line）
+ CallStackInfo(i).Line = CLng(Right(OutputLines(i), Len(OutputLines(i)) - StrPos)) '（#n func(arg types) (args) at file:[line]）
+ OutputLines(i) = Left(OutputLines(i), StrPos - 1) '（[#n func(arg types) (args) at file]:line）
+ StrPos = InStrRev(OutputLines(i), ":/") '向前查找“:/”
+ StrPos = InStrRev(OutputLines(i), " at ", StrPos) '从“:/”的位置继续向前查找“ at ”
+ CallStackInfo(i).File = Replace(Right(OutputLines(i), Len(OutputLines(i)) - StrPos - 3), "/", "\") '（#n func(arg types) (args) at [file]）
+ OutputLines(i) = Left(OutputLines(i), StrPos - 1) '（[#n func(arg types) (args)] at file）
+ OutputLines(i) = Right(OutputLines(i), Len(OutputLines(i)) - InStr(OutputLines(i), " ") - 1) '（#n [func(arg types) (args)]）
+ StrPos = InStr(OutputLines(i), "(") '查找字符串里的第一个“(”
+ BracketLevel = 0
+ For StrPos = StrPos + 1 To Len(OutputLines(i)) '往后面查找匹配的“)”（这部分代码与frmLocals的ArrayParser中的代码相似）
+ If Mid(OutputLines(i), StrPos, 1) = "(" Then '遇到开括号: 计数+1
+ BracketLevel = BracketLevel + 1
+ ElseIf Mid(OutputLines(i), StrPos, 1) = ")" Then '遇到关括号
+ If BracketLevel <= 0 Then '括号计数为0，即括号已经匹配。此时StrPos是下一个匹配的“)”的位置
+ CallStackInfo(i).Address = Left(OutputLines(i), StrPos) '（[func(arg types)] (args)）
+ Exit For '别继续往后找了
+ Else '括号仍未匹配，计数减1，继续往后查找
+ BracketLevel = BracketLevel - 1
+ End If
+ ElseIf Mid(OutputLines(i), StrPos, 1) = """" Then '遇到“"”，查找到下一个匹配的”"“，确保不会分析到字符串中间去
+ Do '一直向后查找“"”，直到不处于字符串中间
+ StrPos = StrPos + 1
+ Loop Until (Mid(OutputLines(i), StrPos, 1) = """" And Mid(OutputLines(i), StrPos - 1, 1) <> "\") Or StrPos > Len(OutputLines(i))
+ End If
+ Next StrPos
+ If StrPos = Len(OutputLines(i)) Then '输出里面没有参数
+ CallStackInfo(i).Args = "" '设置参数为空
+ Else '输出里面有参数
+ CallStackInfo(i).Args = Right(OutputLines(i), Len(OutputLines(i)) - StrPos - 1) '（func(arg types) [(args)]）
+ End If
+ 
+ NewListItem = Me.lvCallStack.AddItem(CallStackInfo(i).Address) '添加新列表项
+ Me.lvCallStack.SetItemText CallStackInfo(i).Args, NewListItem, 1
+ Me.lvCallStack.SetItemText CallStackInfo(i).File, NewListItem, 2
+ Me.lvCallStack.SetItemText CStr(CallStackInfo(i).Line), NewListItem, 3
+ End If
+ End If
+ Next i
+ 
+ frmMain.DockingPane.Panes(10).Title = Lang_CallStack_Caption
+End Sub
+
 Private Sub Form_Load()
  Me.Caption = Lang_CallStack_Caption
+ 
+ Me.lvCallStack.Move 0, 0
+ 
+ Me.lvCallStack.AddColumnHeader Lang_Breakpoints_ListViewHeader_Address, 300
+ Me.lvCallStack.AddColumnHeader Lang_CallStack_Args, 300
+ Me.lvCallStack.AddColumnHeader Lang_Breakpoints_ListViewHeader_File, 150
+ Me.lvCallStack.AddColumnHeader Lang_Breakpoints_ListViewHeader_Line
+ 
+ ReDim CallStackInfo(0) '初始化调用堆栈信息列表
+End Sub
+
+Private Sub Form_Resize()
+ On Error Resume Next
+ 
+ Me.lvCallStack.Width = Me.ScaleWidth
+ Me.lvCallStack.Height = Me.ScaleHeight
 End Sub
+
+Private Sub lvCallStack_DoubleClick(iItem As Long, iSubItem As Long, X As Long, Y As Long)
+ On Error Resume Next
+ Dim i As Long
+ 
+ If CallStackInfo(iItem).File <> "" Then '如果有对应的文件
+ For i = 0 To UBound(CurrentProject.Files) '尝试在工程的文件中查找对应的文件
+ If CurrentProject.Files(i).FilePath = CallStackInfo(iItem).File Then '查找到对应的文件
+ If CurrentProject.Files(i).TargetWindow Is Nothing Then '如果有对应的代码窗口就切换过去
+ Dim NewCodeWindow As frmCodeWindow
+ Dim FileData As String
+ Dim tmpData As String
+ 
+ Set NewCodeWindow = CreateNewCodeWindow(i) '创建新的代码窗体并设置绑定的文件序号
+ NewCodeWindow.Caption = GetFileName(CallStackInfo(iItem).File)
+ 
+ Err.Clear
+ Open CallStackInfo(iItem).File For Input As #1 '尝试打开对应的代码文件
+ If Err.Number <> 0 Then
+ Close #1
+ NoSkinMsgBox Lang_Main_Debug_OpenSourceFailure & CallStackInfo(iItem).File, vbExclamation, Lang_Msgbox_Error
+ Else
+ Do While Not EOF(1)
+ Line Input #1, tmpData
+ FileData = FileData & tmpData & vbCrLf
+ Loop
+ End If
+ Close #1
+ 
+ frmMain.TabBar.AddForm NewCodeWindow
+ Else '没有的话就创建一个新的代码窗口
+ frmMain.TabBar.SwitchToByForm CurrentProject.Files(i).TargetWindow
+ End If
+ 
+ CurrentProject.Files(i).TargetWindow.SyntaxEdit.CurrPos.Row = CallStackInfo(iItem).Line
+ CurrentProject.Files(i).TargetWindow.SyntaxEdit.SetFocus
+ Exit Sub
+ End If
+ Next i
+ End If
+End Sub
+