?? modhigui.bas
字號:
Attribute VB_Name = "ModHiGUI"
' -------------------------------------
' VB2Cpp - Visual Basic to C++ translator.
' Copyright (C) 2002-2003 Franck Charlet.
'
' VB2Cpp is free software; you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation; either version 2, or (at your option)
' any later version.
'
' VB2Cpp is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY; without even the implied warranty of
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
' GNU General Public License for more details.
'
' You should have received a copy of the GNU General Public License
' along with VB2Cpp; see the file Copying.txt. If not, write to
' the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
' Boston, MA 02111-1307, USA.
' -------------------------------------
' Graphical User Interface
' -------------------------------------
Option Explicit
' --- Constants --- '
Global Const MENU_OPENVB = 1000
Global Const MENU_PREFS = 1001
Global Const MENU_ABOUT = 1002
Global Const MENU_EXIT = 1003
Global Const MODULES_CONVERT = 1
Global Const MODULES_CANCEL = 2
' --- Create main dialog --- '
Public Sub InitGUI()
VertSBOn = False
HorzSBOn = False
MaxTextWidth = 0
CurrentColX = 0
CurrentLineY = 0
ReDim TextLines(0)
InitGUIContext AddressOf WindowProc
hWndDialog = CreateDialog(-1, -1, 500, 400, 0, 0, 0, "VB2Cpp v" & APPVersion, 0, WS_SYSMENU Or WS_MAXIMIZEBOX Or WS_MINIMIZEBOX Or WS_SIZEBOX, SW_SHOWMAXIMIZED)
WaitEvents 0, hWndDialog
ReleaseGUIContext
End Sub
' --- Main Window proc --- '
Private Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim TempProjectName As String
Dim wParam_MenuSelect As Long
Dim PaintS As PAINTSTRUCT
Dim MaxCurrentLine As Long
Select Case uMsg
Case WM_CREATE
hWndMain = hwnd
CreateMenuBar hwnd
hStatusBar = CreateStatusBar(hwnd, 0)
CharHeight = GDIGetFontHeight(hwnd, CourierFont)
CharWidth = GDIGetFontWidth(hwnd, CourierFont)
hWndDumpBox = CreateDumpBox(-1, -1, -1, -1, hwnd, 0, CourierFont, 0, 0, 10, 10, 0, WS_VSCROLL, WS_EX_STATICEDGE)
WriteText "VB2Cpp v" & APPVersion & " - Visual Basic to Visual C++ 6 converter.\n" & _
"Copyright (C) 2002-2003 Franck Charlet.\n\n" & _
"VB2Cpp is free software; you can redistribute it and/or modify\n" & _
"it under the terms of the GNU General Public License as published by\n" & _
"the Free Software Foundation; either version 2, or (at your option)\nany later version.\n\n" & _
"Read VB2Cpp.txt before crying.\n\n"
WindowProc = 0
CreateDump
Exit Function
Case WM_SIZE
If wParam <> SIZE_MINIMIZED Then
SendMessage hStatusBar, uMsg, wParam, ByVal lParam
If ControlIsVisible(hWndDumpBox) <> 0 Then
DumpBoxResize hWndDumpBox, 0, 0, lParam And &HFFFF&, ((lParam And &HFFFF0000) \ &H10000) - GetControlHeight(hStatusBar)
SetVertScrollBar
SetHorzScrollBar
RemoveDump
CreateDump
If VertSBOn = True Then
If CharHeight <> 0 Then
If CurrentLineY > (UBound(TextLines()) - DumpBoxGetVisibleLines(hWndDumpBox, CharHeight, 1)) Then
If (UBound(TextLines()) - DumpBoxGetVisibleLines(hWndDumpBox, CharHeight, 1)) > 0 Then
CurrentLineY = (UBound(TextLines()) - DumpBoxGetVisibleLines(hWndDumpBox, CharHeight, 1))
Else
CurrentLineY = 0
End If
End If
End If
End If
End If
End If
Case WM_CLOSE
If VBMsgBox(hwnd, "Really want to quit ?", MB_YESNO Or MB_ICONQUESTION, "VB2Cpp") = IDYES Then
RemoveDump
DestroyWindow hwnd
PostQuitMessage 0
End If
WindowProc = 0
Exit Function
Case WM_MENUSELECT
wParam_MenuSelect = (wParam And &H7FFF&)
If wParam_MenuSelect >= MENU_OPENVB And wParam_MenuSelect <= MENU_EXIT Then
StatusBarSetText hStatusBar, MenuComments(wParam_MenuSelect - MENU_OPENVB)
Else
StatusBarSetText hStatusBar, ""
End If
WindowProc = 0
Exit Function
Case WM_EXITMENULOOP
StatusBarSetText hStatusBar, ""
WindowProc = 0
Exit Function
Case WM_ERASEBKGND
WindowProc = 0
Exit Function
Case WM_PAINT
BeginPaint hwnd, PaintS
DisplayPage False
EndPaint hwnd, PaintS
WindowProc = 0
Exit Function
' Handle text view in dumpbox
Case WM_KEYDOWN
Select Case wParam
Case VK_UP
If VertSBOn = True Then SendMessage hWndDumpBox, WM_VSCROLL, SB_LINEUP, ByVal 0
Case VK_DOWN
If VertSBOn = True Then SendMessage hWndDumpBox, WM_VSCROLL, SB_LINEDOWN, ByVal 0
Case VK_LEFT
If HorzSBOn = True Then SendMessage hWndDumpBox, WM_HSCROLL, SB_LINELEFT, ByVal 0
Case VK_RIGHT
Case VK_END
If (GetKeyState(VK_CONTROL) And &H80&) Then
If VertSBOn = True Then SendMessage hWndDumpBox, WM_VSCROLL, SB_BOTTOM, ByVal 0
End If
If HorzSBOn = True Then SendMessage hWndDumpBox, WM_HSCROLL, SB_BOTTOM, ByVal 0
Case VK_HOME
If (GetKeyState(VK_CONTROL) And &H80&) Then
If VertSBOn = True Then SendMessage hWndDumpBox, WM_VSCROLL, SB_TOP, ByVal 0
End If
If HorzSBOn = True Then SendMessage hWndDumpBox, WM_HSCROLL, SB_TOP, ByVal 0
Case VK_PGUP
If VertSBOn = True Then SendMessage hWndDumpBox, WM_VSCROLL, SB_PAGEUP, ByVal 0
Case VK_PGDN
If VertSBOn = True Then SendMessage hWndDumpBox, WM_VSCROLL, SB_PAGEDOWN, ByVal 0
End Select
Case DUMPBOX_LINELEFT
If CurrentColX > 0 Then
CurrentColX = CurrentColX - 1
InvalidateRect hwnd, 0, 0
End If
WindowProc = CurrentColX
Exit Function
Case DUMPBOX_LINEUP
If CurrentLineY > 0 Then
CurrentLineY = CurrentLineY - 1
DumpBoxScrollUp hWndDumpBox, 1, CharHeight, 1
ClearTextLine 0
WriteLineToWindow BackGroundDC, TextLines(CurrentLineY), 0
BlitTextLine 0
End If
WindowProc = CurrentLineY
Exit Function
Case DUMPBOX_LINEDOWN
If CurrentLineY < (UBound(TextLines()) - DumpBoxGetVisibleLines(hWndDumpBox, CharHeight, 1)) Then
CurrentLineY = CurrentLineY + 1
DumpBoxScrollDown hWndDumpBox, 1, CharHeight, 1
MaxCurrentLine = DumpBoxGetVisibleLines(hWndDumpBox, CharHeight, 1)
ClearTextLine 0
WriteLineToWindow BackGroundDC, TextLines(CurrentLineY + MaxCurrentLine), 0
BlitTextLine MaxCurrentLine
End If
WindowProc = CurrentLineY
Exit Function
Case DUMPBOX_PAGEUP
If CurrentLineY > (10 - 1) Then
CurrentLineY = CurrentLineY - 10
InvalidateRect hwnd, 0, 0
Else
CurrentLineY = 0
InvalidateRect hwnd, 0, 0
End If
WindowProc = CurrentLineY
Exit Function
Case DUMPBOX_PAGEDOWN
If CurrentLineY < (UBound(TextLines()) - DumpBoxGetVisibleLines(hWndDumpBox, CharHeight, 1)) Then
CurrentLineY = CurrentLineY + 10
If CurrentLineY > (UBound(TextLines()) - DumpBoxGetVisibleLines(hWndDumpBox, CharHeight, 1)) Then
CurrentLineY = UBound(TextLines()) - DumpBoxGetVisibleLines(hWndDumpBox, CharHeight, 1)
End If
InvalidateRect hwnd, 0, 0
Else
CurrentLineY = UBound(TextLines()) - DumpBoxGetVisibleLines(hWndDumpBox, CharHeight, 1)
InvalidateRect hwnd, 0, 0
End If
WindowProc = CurrentLineY
Exit Function
Case DUMPBOX_TOP
CurrentLineY = 0
InvalidateRect hwnd, 0, 0
WindowProc = CurrentLineY
Exit Function
Case DUMPBOX_BOTTOM
CurrentLineY = UBound(TextLines()) - DumpBoxGetVisibleLines(hWndDumpBox, CharHeight, 1)
InvalidateRect hwnd, 0, 0
WindowProc = CurrentLineY
Exit Function
Case DUMPBOX_POSITIONUPDOWN
CurrentLineY = lParam
If OldLineY <> CurrentLineY Then
OldLineY = CurrentLineY
InvalidateRect hwnd, 0, 0
End If
WindowProc = CurrentLineY
Exit Function
Case DUMPBOX_TRACKUPDOWN
CurrentLineY = lParam
If OldLineY <> CurrentLineY Then
OldLineY = CurrentLineY
InvalidateRect hwnd, 0, 0
End If
WindowProc = CurrentLineY
Exit Function
Case WM_COMMAND
Select Case (wParam And &H7FFF&)
Case MENU_OPENVB
TempProjectName = ChooseOpenFile(hwnd, "Visual Basic project files (*.vbp)|*.vbp", "", False)
If TempProjectName <> "" Then
ProjectName = TempProjectName
CursorSetWait
DoEvents
DoConversion
DoEvents
CursorSetNormal
StatusBarSetText hStatusBar, ""
End If
Case MENU_PREFS
CreateModalDialog 300, 216, hwnd, AddressOf PreferencesProc, WS_BORDER Or WS_CAPTION Or WS_SYSMENU
Case MENU_ABOUT
CmdMenu_About
Case MENU_EXIT
UnLoadForm hwnd
End Select
WindowProc = 0
Exit Function
End Select
WindowProc = DefWindowProc(hwnd, uMsg, wParam, lParam)
End Function
' --- Show about message --- '
Public Sub CmdMenu_About()
ShellAbout hWndDialog, "VB2Cpp ", _
"Version " & APPVersion & " (Built on " & Date & ")" & vbCr & "Copyright (C) 2002-2003 Franck Charlet.", 0
End Sub
' --- Create the menu bar --- '
Public Sub CreateMenuBar(hParent As Long)
ReDim MenuComments(0 To 3)
hMenuBar = CreateMenu
SetMenu hParent, hMenuBar
hMenu = CreatePopupMenu
AppendMenu hMenu, MF_STRING, MENU_OPENVB, "Convert"
MenuComments(0) = "Open and convert a Visual Basic project"
AppendMenu hMenu, MF_SEPARATOR, 1, "-"
AppendMenu hMenu, MF_STRING, MENU_PREFS, "Preferences"
MenuComments(1) = "Modify converter parameters"
AppendMenu hMenu, MF_SEPARATOR, 1, "-"
AppendMenu hMenu, MF_STRING, MENU_ABOUT, "About"
MenuComments(2) = "Show some essential informations"
AppendMenu hMenu, MF_SEPARATOR, 1, "-"
AppendMenu hMenu, MF_STRING, MENU_EXIT, "Exit" & vbTab & "Alt+F4"
MenuComments(3) = "Quit VB2Cpp"
AppendMenu hMenuBar, MF_POPUP, hMenu, "File"
DrawMenuBar hParent
End Sub
' --- Preferences proc --- '
Public Function PreferencesProc(ByVal hwndDlg As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Select Case uMsg
Case WM_INITDIALOG
ControlSetText hwndDlg, "Preferences"
hWndPrefsOk = CreateButton(142, 191, 77, 23, hwndDlg, "Ok", 1, WS_TABSTOP Or WS_GROUP Or BS_DEFPUSHBUTTON)
hWndPrefsCancel = CreateButton(221, 191, 77, 23, hwndDlg, "Cancel", 2, WS_TABSTOP)
hWndPrefsSysTab = CreateSysTab(2, 1, 293, 158, hwndDlg, 0, 0, 0, WS_TABSTOP Or TCS_BUTTONS Or TCS_FLATBUTTONS Or TCS_HOTTRACK)
SysTabAddItem hWndPrefsSysTab, "Converter", 0, 0
SysTabAddItem hWndPrefsSysTab, "Visuals", 1, 0
hWndFrameOptions = CreateFrame(3, 25, 295, 162, hwndDlg, "Options", 0, 0, AddressOf FrameConverterProc)
hWndFrameVisuals = CreateFrame(3, 25, 295, 162, hwndDlg, "Options", 0, 0, AddressOf FrameVisualsProc)
hWndOptDouble = CreateCheckBox(10, 17, 280, 15, hWndFrameOptions, "Performs multiple symbols checking", 6, WS_TABSTOP)
hWndOptDispWarns = CreateCheckBox(10, 17 + 16, 280, 15, hWndFrameOptions, "Report conversion warnings", 8, WS_TABSTOP)
hWndOptStopAtError = CreateCheckBox(10, 17 + (16 * 2), 280, 15, hWndFrameOptions, "Stop process at first error", 10, WS_TABSTOP)
hWndOptOutputVBLines = CreateCheckBox(10, 17 + (16 * 3), 280, 15, hWndFrameOptions, "Write VB code lines in output", 11, WS_TABSTOP)
CreateLabel 10, 18 + (16 * 4), 200, 17, hWndFrameOptions, "Assume default type:", 0, 0
hWndOptDefault = CreateComboBox(10, 18 + (16 * 4) + 15, 180, 150, hWndFrameOptions, "", 12, WS_TABSTOP Or CBS_DROPDOWNLIST)
CreateLabel 10, 18 + (16 * 6) + 8, 200, 17, hWndFrameOptions, "Visual C++ libraries directory:", 0, 0
hWndVCLib = CreateTextBox(10, 18 + (16 * 7) + 8, 254, 15, hWndFrameOptions, VCLibDir, 13, ES_READONLY, 0, 0)
hWndPrefsSelDir = CreateButton(266, 18 + (16 * 7) + 6, 21, 19, hWndFrameOptions, "...", 14, WS_TABSTOP)
CreateLabel 10, 16 + 6, 100, 17, hWndFrameVisuals, "Background color:", 0, 0
CreateLabel 10, 45 + 6, 100, 17, hWndFrameVisuals, "Foreground color:", 0, 0
hWndColorBackGround = CreateColorBox(110, 16, 26, 26, hWndFrameVisuals, 15, DumpBackColor, 0)
hWndColorForeGround = CreateColorBox(110, 45, 26, 26, hWndFrameVisuals, 16, DumpForeColor, 0)
ComboBoxAddItem hWndOptDefault, "(Report Error)", -1
ComboBoxAddItem hWndOptDefault, "Byte", -1
ComboBoxAddItem hWndOptDefault, "Integer", -1
ComboBoxAddItem hWndOptDefault, "Long", -1
ComboBoxAddItem hWndOptDefault, "Double", -1
ComboBoxAddItem hWndOptDefault, "Single", -1
ComboBoxAddItem hWndOptDefault, "Boolean", -1
ComboBoxAddItem hWndOptDefault, "String", -1
CheckBoxSetState hWndOptDouble, CLng(LookForDoubleSmb)
CheckBoxSetState hWndOptDispWarns, CLng(DisplayWarns)
CheckBoxSetState hWndOptStopAtError, CLng(StopAtError)
CheckBoxSetState hWndOptOutputVBLines, CLng(OutputVBLines)
ComboBoxSetIndex hWndOptDefault, DefReturnType
ControlVisible hWndFrameOptions, True
ControlVisible hWndFrameVisuals, False
SetFocus hWndPrefsSelDir
PreferencesProc = 0
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -