├── CHCore ├── frmSplash.frx ├── Res │ └── Dll.ico ├── frmAbout.frm ├── frmAbout.frx ├── frmPlugins.frm ├── frmPlugins.frx ├── IHook.cls ├── isubclass.cls ├── mCHCore.bas ├── Plugins.cls ├── frmSplash.frm ├── HookGate.cls ├── CHCore.vbp ├── HookMonitor.cls ├── Connect.Dsr └── cHook.cls ├── CodeHelpInstaller.exe ├── Interfaces ├── chlib.tlb └── WinApiForVb.tlb ├── Plugins ├── CHTabIdx.chm ├── CHTabMDI.chm ├── CHTabMDI2 │ ├── Help │ │ ├── CHTabMDI.hhp │ │ ├── CodeHelp Tabbed MDI Workspace.htm │ │ └── CodeHelp Tabbed MDI Workspace_files │ │ │ ├── image002.gif │ │ │ └── image003.gif │ ├── CHTabMDI.RES │ ├── TabPage │ │ ├── MDIMon.cls │ │ ├── ITimer.cls │ │ ├── fChild.frm │ │ ├── mdiMain.frm │ │ ├── ITabPainter.cls │ │ ├── Project1.vbp │ │ ├── SafeCollection.cls │ │ ├── TabItem.cls │ │ ├── TabPaintManager.cls │ │ ├── frmTest.frm │ │ ├── cTimer.cls │ │ ├── DefaultPainter.cls │ │ └── MemoryDC.cls │ ├── DockWindow.dob │ ├── CHTabMDI.vbp │ └── mPublic.bas ├── TabIndex │ ├── CHTabIdx.vsd │ ├── Help │ │ ├── index.htm │ │ ├── CHTabIdx.chm │ │ ├── codehelp.png │ │ └── CHTabIdx.hhp │ ├── TabIdxEdit.RES │ ├── taborder.ico │ ├── CHTabIdx.vbp │ ├── Loader.cls │ └── MouseTrap.cls ├── CHCoder │ ├── code_templates.mdb │ ├── pTest.vbp │ ├── CHCoder.vbp │ ├── frmProp.frm │ └── Loader.cls ├── CHFullScreen │ ├── CHFullScreen.RES │ ├── CHFullScreen.vbp │ └── FullScreen.cls ├── CHCodeComplexity │ ├── CodeAnalysis.dll │ ├── Antlr4.Runtime.dll │ ├── CHCodeComplexity.vbp │ ├── MetricsPanel.dob │ └── Loader.cls ├── BlankTemplate │ ├── BlankPlugin.vbp │ └── Loader.cls └── CHMWheel │ ├── CHMWheel.vbp │ ├── frmProperties.frm │ └── Loader.cls ├── CodeHelp.vbg ├── .gitattributes ├── OldInterface ├── ICHCore.cls └── ICHPlugin.cls ├── .gitignore ├── CHGlobalLib ├── CHGlobalLib.vbp └── CHGlobal.cls ├── Readme.md └── MakeInstaller.nsi /CHCore/frmSplash.frx: -------------------------------------------------------------------------------- 1 | lt -------------------------------------------------------------------------------- /CHCore/Res/Dll.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/clayreimann/CodeHelp/HEAD/CHCore/Res/Dll.ico -------------------------------------------------------------------------------- /CHCore/frmAbout.frm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/clayreimann/CodeHelp/HEAD/CHCore/frmAbout.frm -------------------------------------------------------------------------------- /CHCore/frmAbout.frx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/clayreimann/CodeHelp/HEAD/CHCore/frmAbout.frx -------------------------------------------------------------------------------- /CHCore/frmPlugins.frm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/clayreimann/CodeHelp/HEAD/CHCore/frmPlugins.frm -------------------------------------------------------------------------------- /CHCore/frmPlugins.frx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/clayreimann/CodeHelp/HEAD/CHCore/frmPlugins.frx -------------------------------------------------------------------------------- /CodeHelpInstaller.exe: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/clayreimann/CodeHelp/HEAD/CodeHelpInstaller.exe -------------------------------------------------------------------------------- /Interfaces/chlib.tlb: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/clayreimann/CodeHelp/HEAD/Interfaces/chlib.tlb -------------------------------------------------------------------------------- /Plugins/CHTabIdx.chm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/clayreimann/CodeHelp/HEAD/Plugins/CHTabIdx.chm -------------------------------------------------------------------------------- /Plugins/CHTabMDI.chm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/clayreimann/CodeHelp/HEAD/Plugins/CHTabMDI.chm -------------------------------------------------------------------------------- /Interfaces/WinApiForVb.tlb: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/clayreimann/CodeHelp/HEAD/Interfaces/WinApiForVb.tlb -------------------------------------------------------------------------------- /Plugins/CHTabMDI2/Help/CHTabMDI.hhp: -------------------------------------------------------------------------------- 1 | [OPTIONS] 2 | 3 | [FILES] 4 | CodeHelp Tabbed MDI Workspace.htm 5 | -------------------------------------------------------------------------------- /Plugins/CHTabMDI2/CHTabMDI.RES: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/clayreimann/CodeHelp/HEAD/Plugins/CHTabMDI2/CHTabMDI.RES -------------------------------------------------------------------------------- /Plugins/TabIndex/CHTabIdx.vsd: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/clayreimann/CodeHelp/HEAD/Plugins/TabIndex/CHTabIdx.vsd -------------------------------------------------------------------------------- /Plugins/TabIndex/Help/index.htm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/clayreimann/CodeHelp/HEAD/Plugins/TabIndex/Help/index.htm -------------------------------------------------------------------------------- /Plugins/TabIndex/TabIdxEdit.RES: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/clayreimann/CodeHelp/HEAD/Plugins/TabIndex/TabIdxEdit.RES -------------------------------------------------------------------------------- /Plugins/TabIndex/taborder.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/clayreimann/CodeHelp/HEAD/Plugins/TabIndex/taborder.ico -------------------------------------------------------------------------------- /Plugins/CHCoder/code_templates.mdb: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/clayreimann/CodeHelp/HEAD/Plugins/CHCoder/code_templates.mdb -------------------------------------------------------------------------------- /Plugins/TabIndex/Help/CHTabIdx.chm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/clayreimann/CodeHelp/HEAD/Plugins/TabIndex/Help/CHTabIdx.chm -------------------------------------------------------------------------------- /Plugins/TabIndex/Help/codehelp.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/clayreimann/CodeHelp/HEAD/Plugins/TabIndex/Help/codehelp.png -------------------------------------------------------------------------------- /Plugins/CHFullScreen/CHFullScreen.RES: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/clayreimann/CodeHelp/HEAD/Plugins/CHFullScreen/CHFullScreen.RES -------------------------------------------------------------------------------- /Plugins/CHCodeComplexity/CodeAnalysis.dll: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/clayreimann/CodeHelp/HEAD/Plugins/CHCodeComplexity/CodeAnalysis.dll -------------------------------------------------------------------------------- /Plugins/CHCodeComplexity/Antlr4.Runtime.dll: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/clayreimann/CodeHelp/HEAD/Plugins/CHCodeComplexity/Antlr4.Runtime.dll -------------------------------------------------------------------------------- /Plugins/CHTabMDI2/Help/CodeHelp Tabbed MDI Workspace.htm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/clayreimann/CodeHelp/HEAD/Plugins/CHTabMDI2/Help/CodeHelp Tabbed MDI Workspace.htm -------------------------------------------------------------------------------- /Plugins/CHTabMDI2/Help/CodeHelp Tabbed MDI Workspace_files/image002.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/clayreimann/CodeHelp/HEAD/Plugins/CHTabMDI2/Help/CodeHelp Tabbed MDI Workspace_files/image002.gif -------------------------------------------------------------------------------- /Plugins/CHTabMDI2/Help/CodeHelp Tabbed MDI Workspace_files/image003.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/clayreimann/CodeHelp/HEAD/Plugins/CHTabMDI2/Help/CodeHelp Tabbed MDI Workspace_files/image003.gif -------------------------------------------------------------------------------- /CodeHelp.vbg: -------------------------------------------------------------------------------- 1 | VBGROUP 5.0 2 | StartupProject=CHCore\CHCore.vbp 3 | Project=CHGlobalLib\CHGlobalLib.vbp 4 | Project=Plugins\CHTabMDI2\CHTabMDI.vbp 5 | Project=Plugins\CHMWheel\CHMWheel.vbp 6 | Project=Plugins\CHCodeComplexity\CHCodeComplexity.vbp 7 | Project=Plugins\CHFullScreen\CHFullScreen.vbp 8 | Project=Plugins\CHCoder\CHCoder.vbp 9 | -------------------------------------------------------------------------------- /Plugins/TabIndex/Help/CHTabIdx.hhp: -------------------------------------------------------------------------------- 1 | [OPTIONS] 2 | Compatibility=1.1 or later 3 | Compiled file=CHTabIdx.chm 4 | Default Font=Verdana,8,0 5 | Default topic=index.htm 6 | Display compile progress=No 7 | Language=0x409 English (United States) 8 | Title=CodeHelp Tab Order Editor 9 | 10 | 11 | [FILES] 12 | index.htm 13 | 14 | [INFOTYPES] 15 | 16 | -------------------------------------------------------------------------------- /.gitattributes: -------------------------------------------------------------------------------- 1 | # Auto detect text files and perform LF normalization 2 | * text=auto 3 | 4 | # Custom for Visual Studio 5 | *.cs diff=csharp 6 | 7 | # Standard to msysgit 8 | *.doc diff=astextplain 9 | *.DOC diff=astextplain 10 | *.docx diff=astextplain 11 | *.DOCX diff=astextplain 12 | *.dot diff=astextplain 13 | *.DOT diff=astextplain 14 | *.pdf diff=astextplain 15 | *.PDF diff=astextplain 16 | *.rtf diff=astextplain 17 | *.RTF diff=astextplain 18 | -------------------------------------------------------------------------------- /Plugins/CHTabMDI2/TabPage/MDIMon.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | Persistable = 0 'NotPersistable 5 | DataBindingBehavior = 0 'vbNone 6 | DataSourceBehavior = 0 'vbNone 7 | MTSTransactionMode = 0 'NotAnMTSObject 8 | END 9 | Attribute VB_Name = "MDIMon" 10 | Attribute VB_GlobalNameSpace = False 11 | Attribute VB_Creatable = True 12 | Attribute VB_PredeclaredId = False 13 | Attribute VB_Exposed = False 14 | Option Explicit 15 | 16 | -------------------------------------------------------------------------------- /Plugins/CHTabMDI2/TabPage/ITimer.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | Persistable = 0 'NotPersistable 5 | DataBindingBehavior = 0 'vbNone 6 | DataSourceBehavior = 0 'vbNone 7 | MTSTransactionMode = 0 'NotAnMTSObject 8 | END 9 | Attribute VB_Name = "ITimer" 10 | Attribute VB_GlobalNameSpace = False 11 | Attribute VB_Creatable = True 12 | Attribute VB_PredeclaredId = False 13 | Attribute VB_Exposed = False 14 | Option Explicit 15 | 16 | Public Sub Proc(ByVal lElapsedMS As Long, ByVal lTimerID As Long) 17 | 18 | End Sub 19 | 20 | -------------------------------------------------------------------------------- /Plugins/CHTabMDI2/TabPage/fChild.frm: -------------------------------------------------------------------------------- 1 | VERSION 5.00 2 | Begin VB.Form Form1 3 | Caption = "Form1" 4 | ClientHeight = 3195 5 | ClientLeft = 60 6 | ClientTop = 345 7 | ClientWidth = 4680 8 | LinkTopic = "Form1" 9 | MDIChild = -1 'True 10 | ScaleHeight = 3195 11 | ScaleWidth = 4680 12 | End 13 | Attribute VB_Name = "Form1" 14 | Attribute VB_GlobalNameSpace = False 15 | Attribute VB_Creatable = False 16 | Attribute VB_PredeclaredId = True 17 | Attribute VB_Exposed = False 18 | Option Explicit 19 | 20 | -------------------------------------------------------------------------------- /CHCore/IHook.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | Persistable = 0 'NotPersistable 5 | DataBindingBehavior = 0 'vbNone 6 | DataSourceBehavior = 0 'vbNone 7 | MTSTransactionMode = 0 'NotAnMTSObject 8 | END 9 | Attribute VB_Name = "IHook" 10 | Attribute VB_GlobalNameSpace = False 11 | Attribute VB_Creatable = False 12 | Attribute VB_PredeclaredId = False 13 | Attribute VB_Exposed = False 14 | Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes" 15 | Attribute VB_Ext_KEY = "Top_Level" ,"Yes" 16 | Option Explicit 17 | 18 | 19 | Public Sub Proc(ByVal bBefore As Boolean, bHandled As Boolean, _ 20 | lReturn As Long, nCode As Long, wParam As Long, lParam As Long) 21 | 22 | End Sub 23 | 24 | 25 | -------------------------------------------------------------------------------- /CHCore/isubclass.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | Persistable = 0 'NotPersistable 5 | DataBindingBehavior = 0 'vbNone 6 | DataSourceBehavior = 0 'vbNone 7 | MTSTransactionMode = 0 'NotAnMTSObject 8 | END 9 | Attribute VB_Name = "ISubclass" 10 | Attribute VB_GlobalNameSpace = False 11 | Attribute VB_Creatable = False 12 | Attribute VB_PredeclaredId = False 13 | Attribute VB_Exposed = False 14 | Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes" 15 | Attribute VB_Ext_KEY = "Top_Level" ,"Yes" 16 | Option Explicit 17 | 18 | Sub Proc(ByVal bBefore As Boolean, _ 19 | bHandled As Boolean, _ 20 | lReturn As Long, _ 21 | hwnd As Long, _ 22 | uMsg As Long, _ 23 | wParam As Long, _ 24 | lParam As Long) 25 | 26 | End Sub 27 | -------------------------------------------------------------------------------- /OldInterface/ICHCore.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | Persistable = 0 'NotPersistable 5 | DataBindingBehavior = 0 'vbNone 6 | DataSourceBehavior = 0 'vbNone 7 | MTSTransactionMode = 0 'NotAnMTSObject 8 | END 9 | Attribute VB_Name = "ICHCore" 10 | Attribute VB_GlobalNameSpace = False 11 | Attribute VB_Creatable = False 12 | Attribute VB_PredeclaredId = False 13 | Attribute VB_Exposed = True 14 | Option Explicit 15 | '**************************************** 16 | 'CodeHelp Core Parent Interface 17 | '**************************************** 18 | 19 | Property Get VBE() As VBIDE.VBE 20 | 21 | End Property 22 | 23 | Function AddToCodeHelpMenu(ByVal Caption As String, _ 24 | Optional ByVal iconBitmap As StdPicture = Nothing) As CommandBarControl 25 | 26 | End Function 27 | -------------------------------------------------------------------------------- /CHCore/mCHCore.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "mCHCore" 2 | Option Explicit 3 | 4 | Public Declare Function GetProcAddress Lib "kernel32.dll" (ByVal hModule As Long, ByVal lpProcName As String) As Long 5 | 6 | 'Public vars 7 | Public HookMon As HookMonitor 8 | 9 | 'For crash prevention on Win98 10 | Public lockSubclass As cSubclass 11 | 12 | 'for passing to manual oPlugin connect/disconnect, not used but need to be pass along 13 | Public customVar() As Variant 14 | 15 | 'this is a pointer to Connect object, we'll need it when we re-enable a oPlugin at runtime 16 | Public gPtr As Long 17 | 18 | Private m_Plugins As Plugins 19 | 20 | Public Property Get Plugins() As Plugins 21 | Set Plugins = m_Plugins 22 | End Property 23 | 24 | Public Property Set Plugins(value As Plugins) 25 | Set m_Plugins = value 26 | End Property 27 | 28 | 29 | 30 | -------------------------------------------------------------------------------- /Plugins/CHTabMDI2/TabPage/mdiMain.frm: -------------------------------------------------------------------------------- 1 | VERSION 5.00 2 | Begin VB.MDIForm mdiMain 3 | BackColor = &H8000000C& 4 | Caption = "MDIForm1" 5 | ClientHeight = 3195 6 | ClientLeft = 60 7 | ClientTop = 630 8 | ClientWidth = 4680 9 | LinkTopic = "MDIForm1" 10 | StartUpPosition = 3 'Windows Default 11 | Begin VB.Menu mnuNew 12 | Caption = "New" 13 | End 14 | Begin VB.Menu mnuWindow 15 | Caption = "Window" 16 | WindowList = -1 'True 17 | End 18 | End 19 | Attribute VB_Name = "mdiMain" 20 | Attribute VB_GlobalNameSpace = False 21 | Attribute VB_Creatable = False 22 | Attribute VB_PredeclaredId = True 23 | Attribute VB_Exposed = False 24 | Option Explicit 25 | 26 | Private Sub mnuNew_Click() 27 | Dim a As New Form1 28 | a.Show 29 | End Sub 30 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # Binary files 2 | *.dll 3 | *.lib 4 | *.exp 5 | *.vbw 6 | *.DCA 7 | *.IDL 8 | *.tmp 9 | *.vbd 10 | CHCore/bin/ 11 | 12 | # Windows image file caches 13 | Thumbs.db 14 | ehthumbs.db 15 | 16 | # Folder config file 17 | Desktop.ini 18 | 19 | # Recycle Bin used on file shares 20 | $RECYCLE.BIN/ 21 | 22 | # Windows Installer files 23 | *.cab 24 | *.msi 25 | *.msm 26 | *.msp 27 | 28 | # Windows shortcuts 29 | *.lnk 30 | 31 | # ========================= 32 | # Operating System Files 33 | # ========================= 34 | 35 | # OSX 36 | # ========================= 37 | 38 | .DS_Store 39 | .AppleDouble 40 | .LSOverride 41 | 42 | # Thumbnails 43 | ._* 44 | 45 | # Files that might appear on external disk 46 | .Spotlight-V100 47 | .Trashes 48 | 49 | # Directories potentially created on remote AFP share 50 | .AppleDB 51 | .AppleDesktop 52 | Network Trash Folder 53 | Temporary Items 54 | .apdisk 55 | -------------------------------------------------------------------------------- /Plugins/CHCoder/pTest.vbp: -------------------------------------------------------------------------------- 1 | Type=Exe 2 | Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\WINDOWS\System32\stdole2.tlb#OLE Automation 3 | Reference=*\G{00000201-0000-0010-8000-00AA006D2EA4}#2.1#0#C:\Program Files\Common Files\System\ADO\msado21.tlb#Microsoft ActiveX Data Objects 2.1 Library 4 | Form=frmProp.frm 5 | Module=mMain; mMain.bas 6 | Startup="frmProp" 7 | HelpFile="" 8 | Command32="" 9 | Name="Project1" 10 | HelpContextID="0" 11 | CompatibleMode="0" 12 | MajorVer=1 13 | MinorVer=0 14 | RevisionVer=0 15 | AutoIncrementVer=0 16 | ServerSupportFiles=0 17 | VersionCompanyName="home" 18 | CompilationType=0 19 | OptimizationType=0 20 | FavorPentiumPro(tm)=0 21 | CodeViewDebugInfo=0 22 | NoAliasing=0 23 | BoundsCheck=0 24 | OverflowCheck=0 25 | FlPointCheck=0 26 | FDIVCheck=0 27 | UnroundedFP=0 28 | StartMode=0 29 | Unattended=0 30 | Retained=0 31 | ThreadPerObject=0 32 | MaxNumberOfThreads=1 33 | -------------------------------------------------------------------------------- /Plugins/CHTabMDI2/TabPage/ITabPainter.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | Persistable = 0 'NotPersistable 5 | DataBindingBehavior = 0 'vbNone 6 | DataSourceBehavior = 0 'vbNone 7 | MTSTransactionMode = 0 'NotAnMTSObject 8 | END 9 | Attribute VB_Name = "ITabPainter" 10 | Attribute VB_GlobalNameSpace = False 11 | Attribute VB_Creatable = True 12 | Attribute VB_PredeclaredId = False 13 | Attribute VB_Exposed = False 14 | Option Explicit 15 | 'TabPainter Interface 16 | 17 | Public Enum TabItemType 18 | DrawBackground 19 | DrawTabItem 20 | DrawCloseButton 21 | DrawNavLeftButton 22 | DrawNavRightButton 23 | End Enum 24 | 25 | Public Sub DrawItem(ByVal oDC As MemoryDC, bounds As RECT, ByVal Item As TabItem, ByVal itemType As TabItemType) 26 | 27 | End Sub 28 | 29 | Public Function CalculateTabWidth(ByVal Item As TabItem, ByVal oDC As MemoryDC) As Long 30 | 31 | End Function 32 | 33 | Public Sub DrawShortcut(ByVal oDC As MemoryDC, bounds As RECT, ByVal Item As TabItem, ByVal visibleIndex As Long) 34 | 35 | End Sub 36 | -------------------------------------------------------------------------------- /Plugins/CHTabMDI2/DockWindow.dob: -------------------------------------------------------------------------------- 1 | VERSION 5.00 2 | Begin VB.UserDocument DockWindow 3 | ClientHeight = 1395 4 | ClientLeft = 0 5 | ClientTop = 0 6 | ClientWidth = 4410 7 | ContinuousScroll= 0 'False 8 | HScrollSmallChange= 225 9 | ScaleHeight = 1395 10 | ScaleWidth = 4410 11 | ScrollBars = 0 'None 12 | VScrollSmallChange= 225 13 | Begin VB.Label Label1 14 | Caption = "Anyone interested in developing a task list viewer here?" 15 | Height = 330 16 | Left = 135 17 | TabIndex = 0 18 | Top = 405 19 | Width = 4020 20 | End 21 | End 22 | Attribute VB_Name = "DockWindow" 23 | Attribute VB_GlobalNameSpace = False 24 | Attribute VB_Creatable = True 25 | Attribute VB_PredeclaredId = False 26 | Attribute VB_Exposed = True 27 | Option Explicit 28 | 29 | Public Property Get hWnd() As Long 30 | hWnd = GetParent(UserDocument.hWnd) 31 | End Property 32 | 33 | Public Property Get RealhWnd() As Long 34 | RealhWnd = UserDocument.hWnd 35 | End Property 36 | 37 | -------------------------------------------------------------------------------- /Plugins/BlankTemplate/BlankPlugin.vbp: -------------------------------------------------------------------------------- 1 | Type=OleDll 2 | Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\WINDOWS\system32\stdole2.tlb#OLE Automation 3 | Reference=*\G{EF404E00-EDA6-101A-8DAF-00DD010F7EBB}#5.3#0#C:\Program Files\Microsoft Visual Studio\VB98\VB6EXT.OLB#Microsoft Visual Basic 6.0 Extensibility 4 | Reference=*\G{56A386D8-9525-4D57-854D-12FCFB26509D}#1.0#0#..\..\Interfaces\chlib.tlb# CodeHelp Interface Definitions 5 | Reference=*\G{68846601-810F-43A9-A491-3D2F1DD696B7}#1.0#0#..\..\CHGlobalLib\CHGlobalLib.dll# CodeHelp Global Object 6 | Class=Loader; Loader.cls 7 | Startup="(None)" 8 | Command32="" 9 | Name="BlankPlugin" 10 | HelpContextID="0" 11 | CompatibleMode="1" 12 | MajorVer=1 13 | MinorVer=0 14 | RevisionVer=0 15 | AutoIncrementVer=0 16 | ServerSupportFiles=0 17 | VersionCompanyName="ASI Jakarta" 18 | CompilationType=0 19 | OptimizationType=0 20 | FavorPentiumPro(tm)=0 21 | CodeViewDebugInfo=0 22 | NoAliasing=0 23 | BoundsCheck=0 24 | OverflowCheck=0 25 | FlPointCheck=0 26 | FDIVCheck=0 27 | UnroundedFP=0 28 | StartMode=1 29 | Unattended=0 30 | Retained=0 31 | ThreadPerObject=0 32 | MaxNumberOfThreads=1 33 | ThreadingModel=1 34 | 35 | [MS Transaction Server] 36 | AutoRefresh=1 37 | -------------------------------------------------------------------------------- /Plugins/CHMWheel/CHMWheel.vbp: -------------------------------------------------------------------------------- 1 | Type=OleDll 2 | Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#..\..\..\..\..\..\..\Windows\SysWOW64\stdole2.tlb#OLE Automation 3 | Reference=*\G{D4575622-4160-4FBE-8206-C7EF39D9E8B6}#1.1#0#..\..\Interfaces\WinApiForVb.tlb #WinApi For VB type library 4 | Reference=*\G{56A386D8-9525-4D57-854D-12FCFB26509D}#1.0#0#..\..\Interfaces\chlib.tlb #@ CodeHelp Global Object & Interface Definitions 5 | Reference=*\G{F1DB0540-8DE8-46E0-B054-4414D0FE0148}#1.0#0#..\..\CHCore\bin\CHGlobalLib.dll# CodeHelp Global Object 6 | Class=Loader; Loader.cls 7 | Form=frmProperties.frm 8 | Startup="(None)" 9 | HelpFile="" 10 | Title="CHMWheel" 11 | ExeName32="CHMWheel.dll" 12 | Path32=".." 13 | Command32="" 14 | Name="CHMWheel" 15 | HelpContextID="0" 16 | CompatibleMode="0" 17 | CompatibleEXE32="..\CHMWheel.dll" 18 | MajorVer=1 19 | MinorVer=1 20 | RevisionVer=1 21 | AutoIncrementVer=0 22 | ServerSupportFiles=0 23 | VersionCompanyName="ASI Jakarta" 24 | CompilationType=0 25 | OptimizationType=0 26 | FavorPentiumPro(tm)=0 27 | CodeViewDebugInfo=0 28 | NoAliasing=0 29 | BoundsCheck=0 30 | OverflowCheck=0 31 | FlPointCheck=0 32 | FDIVCheck=0 33 | UnroundedFP=0 34 | StartMode=1 35 | Unattended=0 36 | Retained=0 37 | ThreadPerObject=0 38 | MaxNumberOfThreads=1 39 | ThreadingModel=1 40 | 41 | [MS Transaction Server] 42 | AutoRefresh=1 43 | -------------------------------------------------------------------------------- /Plugins/CHTabMDI2/TabPage/Project1.vbp: -------------------------------------------------------------------------------- 1 | Type=Exe 2 | Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\WINDOWS\system32\stdole2.tlb#OLE Automation 3 | Reference=*\G{D4575622-4160-4FBE-8206-C7EF39D9E8B6}#1.1#0#..\..\..\..\Tlb\WinApiForVb.tlb#WinApi For VB type library 4 | Form=frmTest.frm 5 | Class=TabManager; TabManager.cls 6 | Class=ReadOnlyColl; ReadOnlyColl.cls 7 | Class=TabItem; TabItem.cls 8 | Class=MemoryDC; MemoryDC.cls 9 | Class=TabPaintManager; TabPaintManager.cls 10 | Class=ITabPainter; ITabPainter.cls 11 | Class=DefaultPainter; DefaultPainter.cls 12 | Class=cTimer; cTimer.cls 13 | Class=ITimer; ITimer.cls 14 | Form=mdiMain.frm 15 | Form=fChild.frm 16 | Class=MDIMon; MDIMon.cls 17 | Startup="frmTest" 18 | HelpFile="" 19 | ExeName32="Project1.exe" 20 | Command32="" 21 | Name="Project1" 22 | HelpContextID="0" 23 | CompatibleMode="0" 24 | MajorVer=1 25 | MinorVer=0 26 | RevisionVer=0 27 | AutoIncrementVer=0 28 | ServerSupportFiles=0 29 | VersionCompanyName="ASI Jakarta" 30 | CompilationType=0 31 | OptimizationType=2 32 | FavorPentiumPro(tm)=0 33 | CodeViewDebugInfo=-1 34 | NoAliasing=0 35 | BoundsCheck=0 36 | OverflowCheck=0 37 | FlPointCheck=0 38 | FDIVCheck=0 39 | UnroundedFP=0 40 | StartMode=0 41 | Unattended=0 42 | Retained=0 43 | ThreadPerObject=0 44 | MaxNumberOfThreads=1 45 | 46 | [MS Transaction Server] 47 | AutoRefresh=1 48 | -------------------------------------------------------------------------------- /Plugins/CHFullScreen/CHFullScreen.vbp: -------------------------------------------------------------------------------- 1 | Type=OleDll 2 | Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#..\..\..\..\..\..\..\Windows\SysWOW64\stdole2.tlb#OLE Automation 3 | Reference=*\G{2DF8D04C-5BFA-101B-BDE5-00AA0044DE52}#2.3#0#..\..\..\..\..\..\..\Program Files (x86)\Common Files\Microsoft Shared\OFFICE11\MSO.DLL#Microsoft Office 11.0 Object Library 4 | Reference=*\G{EF404E00-EDA6-101A-8DAF-00DD010F7EBB}#5.3#0#..\..\..\..\..\..\..\Program Files (x86)\Microsoft Visual Studio\VB98\VB6EXT.OLB#Microsoft Visual Basic 6.0 Extensibility 5 | Reference=*\G{D4575622-4160-4FBE-8206-C7EF39D9E8B6}#1.1#0#..\..\Interfaces\WinApiForVb.tlb #WinApi For VB type library 6 | Reference=*\G{56A386D8-9525-4D57-854D-12FCFB26509D}#1.1#0#..\..\Interfaces\chlib.tlb # CodeHelp Interface Definitions 7 | Reference=*\G{972EF324-4C56-459C-A956-36CBB32D1AE1}#1.0#0#..\..\CHCore\bin\CHGlobalLib.dll# CodeHelp Global Object 8 | Class=FullScreen; FullScreen.cls 9 | ResFile32="CHFullScreen.RES" 10 | Startup="(None)" 11 | HelpFile="" 12 | Title="CHFullScreen" 13 | ExeName32="CHFullScreen.dll" 14 | Path32=".." 15 | Command32="" 16 | Name="CHFullScreen" 17 | HelpContextID="0" 18 | CompatibleMode="0" 19 | CompatibleEXE32="..\CHFullScreen.dll" 20 | MajorVer=1 21 | MinorVer=1 22 | RevisionVer=0 23 | AutoIncrementVer=0 24 | ServerSupportFiles=0 25 | VersionCompanyName="luthv@yahoo.com" 26 | CompilationType=0 27 | OptimizationType=0 28 | FavorPentiumPro(tm)=0 29 | CodeViewDebugInfo=0 30 | NoAliasing=-1 31 | BoundsCheck=-1 32 | OverflowCheck=-1 33 | FlPointCheck=-1 34 | FDIVCheck=-1 35 | UnroundedFP=-1 36 | StartMode=1 37 | Unattended=0 38 | Retained=0 39 | ThreadPerObject=0 40 | MaxNumberOfThreads=1 41 | ThreadingModel=1 42 | 43 | [MS Transaction Server] 44 | AutoRefresh=1 45 | -------------------------------------------------------------------------------- /CHCore/Plugins.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | Persistable = 0 'NotPersistable 5 | DataBindingBehavior = 0 'vbNone 6 | DataSourceBehavior = 0 'vbNone 7 | MTSTransactionMode = 0 'NotAnMTSObject 8 | END 9 | Attribute VB_Name = "Plugins" 10 | Attribute VB_GlobalNameSpace = False 11 | Attribute VB_Creatable = False 12 | Attribute VB_PredeclaredId = False 13 | Attribute VB_Exposed = True 14 | Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes" 15 | Attribute VB_Ext_KEY = "Collection" ,"IHook" 16 | Attribute VB_Ext_KEY = "Member0" ,"IHook" 17 | Attribute VB_Ext_KEY = "Top_Level" ,"Yes" 18 | Option Explicit 19 | 20 | 'local variable to hold collection 21 | Private mCol As Collection 22 | 23 | Public Sub Add(ByVal oPlugin As CodeHelpDef.ICHPlugin) 24 | Call mCol.Add(oPlugin, oPlugin.Name) 25 | End Sub 26 | 27 | Public Property Get Item(vntIndexKey As Variant) As ICHPlugin 28 | Attribute Item.VB_UserMemId = 0 29 | Set Item = mCol(vntIndexKey) 30 | End Property 31 | 32 | Public Property Get Count() As Long 33 | Count = mCol.Count 34 | End Property 35 | 36 | Public Sub Remove(vntIndexKey As Variant) 37 | Call mCol.Remove(vntIndexKey) 38 | End Sub 39 | 40 | Public Property Get NewEnum() As IUnknown 41 | Attribute NewEnum.VB_UserMemId = -4 42 | Attribute NewEnum.VB_MemberFlags = "40" 43 | 'this property allows you to enumerate 44 | 'this collection with the For...Each syntax 45 | Set NewEnum = mCol.[_NewEnum] 46 | End Property 47 | 48 | Private Sub Class_Initialize() 49 | 'creates the collection when this class is created 50 | Set mCol = New Collection 51 | End Sub 52 | 53 | Private Sub Class_Terminate() 54 | 'destroys collection when this class is terminated 55 | Set mCol = Nothing 56 | End Sub 57 | 58 | -------------------------------------------------------------------------------- /CHGlobalLib/CHGlobalLib.vbp: -------------------------------------------------------------------------------- 1 | Type=OleDll 2 | Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#..\..\..\..\..\..\Windows\SysWOW64\stdole2.tlb#OLE Automation 3 | Reference=*\G{2DF8D04C-5BFA-101B-BDE5-00AA0044DE52}#2.3#0#..\..\..\..\..\..\Program Files (x86)\Common Files\Microsoft Shared\OFFICE11\MSO.DLL#Microsoft Office 11.0 Object Library 4 | Reference=*\G{EF404E00-EDA6-101A-8DAF-00DD010F7EBB}#5.3#0#..\..\..\..\..\..\Program Files (x86)\Microsoft Visual Studio\VB98\VB6EXT.OLB#Microsoft Visual Basic 6.0 Extensibility 5 | Reference=*\G{AC0714F2-3D04-11D1-AE7D-00A0C90F26F4}#1.0#0#..\..\..\..\..\..\Program Files (x86)\Common Files\Designer\MSADDNDR.DLL#Microsoft Add-In Designer 6 | Reference=*\G{D4575622-4160-4FBE-8206-C7EF39D9E8B6}#1.1#0#..\Interfaces\WinApiForVb.tlb #WinApi For VB type library 7 | Reference=*\G{56A386D8-9525-4D57-854D-12FCFB26509D}#1.0#0#..\Interfaces\chlib.tlb # CodeHelp Interface Definitions 8 | Class=CHHelper; CHGlobal.cls 9 | Startup="(None)" 10 | HelpFile="" 11 | Title="CHGlobalLib" 12 | ExeName32="CHGlobalLib.dll" 13 | Command32="" 14 | Name="CHGlobalLib" 15 | HelpContextID="0" 16 | Description=" CodeHelp Global Object" 17 | CompatibleMode="0" 18 | CompatibleEXE32="CHGlobalLib.dll" 19 | MajorVer=1 20 | MinorVer=1 21 | RevisionVer=0 22 | AutoIncrementVer=0 23 | ServerSupportFiles=0 24 | VersionCompanyName="luthv@yahoo.com" 25 | VersionFileDescription="CodeHelp Global Object" 26 | VersionProductName="CodeHelp" 27 | CompilationType=0 28 | OptimizationType=0 29 | FavorPentiumPro(tm)=0 30 | CodeViewDebugInfo=0 31 | NoAliasing=-1 32 | BoundsCheck=-1 33 | OverflowCheck=-1 34 | FlPointCheck=-1 35 | FDIVCheck=-1 36 | UnroundedFP=-1 37 | StartMode=1 38 | Unattended=0 39 | Retained=0 40 | ThreadPerObject=0 41 | MaxNumberOfThreads=1 42 | ThreadingModel=1 43 | DebugStartupOption=0 44 | 45 | [MS Transaction Server] 46 | AutoRefresh=1 47 | -------------------------------------------------------------------------------- /Plugins/TabIndex/CHTabIdx.vbp: -------------------------------------------------------------------------------- 1 | Type=OleDll 2 | Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\WINDOWS\system32\stdole2.tlb#OLE Automation 3 | Reference=*\G{2DF8D04C-5BFA-101B-BDE5-00AA0044DE52}#2.3#0#C:\Program Files\Common Files\Microsoft Shared\OFFICE11\MSO.DLL#Microsoft Office 11.0 Object Library 4 | Reference=*\G{EF404E00-EDA6-101A-8DAF-00DD010F7EBB}#5.3#0#C:\Program Files\Microsoft Visual Studio\VB98\VB6EXT.OLB#Microsoft Visual Basic 6.0 Extensibility 5 | Reference=*\G{D4575622-4160-4FBE-8206-C7EF39D9E8B6}#1.1#0#..\..\..\..\..\Tlb\WinApiForVb.tlb#WinApi For VB type library 6 | Reference=*\G{AC0714F2-3D04-11D1-AE7D-00A0C90F26F4}#1.0#0#C:\Program Files\Common Files\DESIGNER\MSADDNDR.DLL#Microsoft Add-In Designer 7 | Reference=*\G{56A386D8-9525-4D57-854D-12FCFB26509D}#1.0#0#C:\Program Files\CodeHelp\chlib.tlb#@ CodeHelp Global Object & Interface Definitions 8 | Reference=*\G{68846601-810F-43A9-A491-3D2F1DD696B7}#1.0#0#C:\Program Files\CodeHelp\CHGlobalLib.dll# CodeHelp Global Object 9 | Class=Loader; Loader.cls 10 | Class=MouseTrap; MouseTrap.cls 11 | ResFile32="TabIdxEdit.RES" 12 | Startup="(None)" 13 | HelpFile="" 14 | Title="CHTabIdx" 15 | ExeName32="CHTabIdx.dll" 16 | Path32=".." 17 | Command32="" 18 | Name="CHTabIdx" 19 | HelpContextID="0" 20 | CompatibleMode="2" 21 | CompatibleEXE32="..\CHTabIdx.dll" 22 | VersionCompatible32="1" 23 | MajorVer=1 24 | MinorVer=1 25 | RevisionVer=0 26 | AutoIncrementVer=0 27 | ServerSupportFiles=0 28 | VersionCompanyName="luthv@yahoo.com" 29 | CompilationType=0 30 | OptimizationType=0 31 | FavorPentiumPro(tm)=0 32 | CodeViewDebugInfo=0 33 | NoAliasing=0 34 | BoundsCheck=0 35 | OverflowCheck=0 36 | FlPointCheck=0 37 | FDIVCheck=0 38 | UnroundedFP=0 39 | StartMode=1 40 | Unattended=0 41 | Retained=0 42 | ThreadPerObject=0 43 | MaxNumberOfThreads=1 44 | ThreadingModel=1 45 | 46 | [MS Transaction Server] 47 | AutoRefresh=1 48 | -------------------------------------------------------------------------------- /Plugins/CHCoder/CHCoder.vbp: -------------------------------------------------------------------------------- 1 | Type=OleDll 2 | Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#..\..\..\..\..\..\..\Windows\SysWOW64\stdole2.tlb#OLE Automation 3 | Reference=*\G{EF404E00-EDA6-101A-8DAF-00DD010F7EBB}#5.3#0#..\..\..\..\..\..\..\Program Files (x86)\Microsoft Visual Studio\VB98\VB6EXT.OLB#Microsoft Visual Basic 6.0 Extensibility 4 | Reference=*\G{56A386D8-9525-4D57-854D-12FCFB26509D}#1.0#0#..\..\Interfaces\chlib.tlb # CodeHelp Interface Definitions 5 | Reference=*\G{D4575622-4160-4FBE-8206-C7EF39D9E8B6}#1.1#0#..\..\Interfaces\WinApiForVb.tlb #WinApi For VB type library 6 | Reference=*\G{00000201-0000-0010-8000-00AA006D2EA4}#2.1#0#..\..\..\..\..\..\..\Program Files (x86)\Common Files\System\ado\msado21.tlb#Microsoft ActiveX Data Objects 2.1 Library 7 | Reference=*\G{C6E13AD1-712F-4C7F-A25B-5AB45FB8371E}#1.0#0#..\..\CHCore\bin\CHGlobalLib.dll# CodeHelp Global Object 8 | Reference=*\G{2DF8D04C-5BFA-101B-BDE5-00AA0044DE52}#2.7#0#..\..\..\..\..\..\..\Program Files (x86)\Common Files\Microsoft Shared\OFFICE15\MSO.DLL#Microsoft Office 15.0 Object Library 9 | Class=Loader; Loader.cls 10 | Form=frmProp.frm 11 | Startup="(None)" 12 | HelpFile="" 13 | Title="CHCoder" 14 | ExeName32="CHCoder.dll" 15 | Path32=".." 16 | Command32="" 17 | Name="CHCoder" 18 | HelpContextID="0" 19 | CompatibleMode="0" 20 | CompatibleEXE32="..\CHCoder.dll" 21 | MajorVer=1 22 | MinorVer=0 23 | RevisionVer=0 24 | AutoIncrementVer=0 25 | ServerSupportFiles=0 26 | VersionCompanyName="luthv@yahoo.com" 27 | VersionLegalCopyright="luthv@yahoo.com" 28 | VersionProductName="CodeHelp Coder Plugin" 29 | CompilationType=0 30 | OptimizationType=0 31 | FavorPentiumPro(tm)=0 32 | CodeViewDebugInfo=0 33 | NoAliasing=0 34 | BoundsCheck=0 35 | OverflowCheck=0 36 | FlPointCheck=0 37 | FDIVCheck=0 38 | UnroundedFP=0 39 | StartMode=1 40 | Unattended=0 41 | Retained=0 42 | ThreadPerObject=0 43 | MaxNumberOfThreads=1 44 | ThreadingModel=1 45 | DebugStartupOption=0 46 | 47 | [MS Transaction Server] 48 | AutoRefresh=1 49 | -------------------------------------------------------------------------------- /Plugins/CHCodeComplexity/CHCodeComplexity.vbp: -------------------------------------------------------------------------------- 1 | Type=OleDll 2 | Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#..\..\..\..\..\..\..\Windows\SysWOW64\stdole2.tlb#OLE Automation 3 | Reference=*\G{EF404E00-EDA6-101A-8DAF-00DD010F7EBB}#5.3#0#..\..\..\..\..\..\..\Program Files (x86)\Microsoft Visual Studio\VB98\VB6EXT.OLB#Microsoft Visual Basic 6.0 Extensibility 4 | Reference=*\G{56A386D8-9525-4D57-854D-12FCFB26509D}#1.0#0#..\..\Interfaces\chlib.tlb # CodeHelp Interface Definitions 5 | Reference=*\G{C6E13AD1-712F-4C7F-A25B-5AB45FB8371E}#1.0#0#..\..\CHCore\bin\CHGlobalLib.dll# CodeHelp Global Object 6 | Reference=*\G{7AEBAD15-C088-4AC0-8005-6754D44D7347}#1.0#0#..\..\..\..\visual studio 2013\Projects\CodeAnalysisLib\CodeAnalysisLib\bin\Debug\CodeAnalysis.tlb#CodeAnalysis 7 | Reference=*\G{D4575622-4160-4FBE-8206-C7EF39D9E8B6}#1.1#0#..\..\Interfaces\WinApiForVb.tlb #WinApi For VB type library 8 | Object={831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.1#0; mscomctl.ocx 9 | Object={FAEEE763-117E-101B-8933-08002B2F4F5A}#1.1#0; dblist32.ocx 10 | Object={0ECD9B60-23AA-11D0-B351-00A0C9055D8E}#6.0#0; mshflxgd.ocx 11 | Object={5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0; msflxgrd.ocx 12 | Object={CDE57A40-8B86-11D0-B3C6-00A0C90AEA82}#1.0#0; msdatgrd.ocx 13 | Class=Loader; Loader.cls 14 | UserDocument=MetricsPanel.dob 15 | Startup="(None)" 16 | ExeName32="CHCodeComplexity.dll" 17 | Path32=".." 18 | Command32="" 19 | Name="CHCodeComplexity" 20 | HelpContextID="0" 21 | CompatibleMode="0" 22 | CompatibleEXE32="..\CHCodeComplexity.dll" 23 | MajorVer=1 24 | MinorVer=0 25 | RevisionVer=0 26 | AutoIncrementVer=0 27 | ServerSupportFiles=0 28 | VersionCompanyName="ASI Jakarta" 29 | CompilationType=0 30 | OptimizationType=0 31 | FavorPentiumPro(tm)=0 32 | CodeViewDebugInfo=0 33 | NoAliasing=0 34 | BoundsCheck=0 35 | OverflowCheck=0 36 | FlPointCheck=0 37 | FDIVCheck=0 38 | UnroundedFP=0 39 | StartMode=1 40 | Unattended=0 41 | Retained=0 42 | ThreadPerObject=0 43 | MaxNumberOfThreads=1 44 | ThreadingModel=1 45 | 46 | [MS Transaction Server] 47 | AutoRefresh=1 48 | -------------------------------------------------------------------------------- /Plugins/CHTabMDI2/TabPage/SafeCollection.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | Persistable = 0 'NotPersistable 5 | DataBindingBehavior = 0 'vbNone 6 | DataSourceBehavior = 0 'vbNone 7 | MTSTransactionMode = 0 'NotAnMTSObject 8 | END 9 | Attribute VB_Name = "SafeCollection" 10 | Attribute VB_GlobalNameSpace = False 11 | Attribute VB_Creatable = False 12 | Attribute VB_PredeclaredId = False 13 | Attribute VB_Exposed = False 14 | Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes" 15 | Attribute VB_Ext_KEY = "Collection" ,"Panel" 16 | Attribute VB_Ext_KEY = "Member0" ,"Panel" 17 | Attribute VB_Ext_KEY = "Top_Level" ,"Yes" 18 | Option Explicit 19 | 20 | Private m_Col As Collection 21 | 22 | Friend Sub AddItem(ByVal newObject As Object, ByVal key As String, Optional Index As Long = 0) 23 | If Index > 0 And Index <= m_Col.Count Then 24 | Call m_Col.Add(newObject, key, Index) 25 | Else 26 | Call m_Col.Add(newObject, key) 27 | End If 28 | End Sub 29 | 30 | Friend Sub Remove(ByVal key As String) 31 | If Exists(key) Then Call m_Col.Remove(key) 32 | End Sub 33 | 34 | Public Property Get item(vntIndexKey As Variant) As Object 35 | Attribute item.VB_UserMemId = 0 36 | Set item = m_Col(vntIndexKey) 37 | End Property 38 | 39 | Public Property Get Count() As Long 40 | Count = m_Col.Count 41 | End Property 42 | 43 | Public Property Get NewEnum() As IUnknown 44 | Attribute NewEnum.VB_UserMemId = -4 45 | Attribute NewEnum.VB_MemberFlags = "40" 46 | Set NewEnum = m_Col.[_NewEnum] 47 | End Property 48 | 49 | Function Exists(ByVal key As String) As Boolean 50 | Dim childItem As Object 51 | 52 | On Error GoTo ERR_HANDLER 53 | 54 | Set childItem = m_Col.item(key) 55 | Exists = True 56 | Set childItem = Nothing 57 | 58 | Exit Function 59 | ERR_HANDLER: 60 | Exists = False 61 | End Function 62 | 63 | Private Sub Class_Initialize() 64 | Set m_Col = New Collection 65 | End Sub 66 | 67 | Private Sub Class_Terminate() 68 | Set m_Col = Nothing 69 | End Sub 70 | 71 | -------------------------------------------------------------------------------- /Plugins/CHTabMDI2/CHTabMDI.vbp: -------------------------------------------------------------------------------- 1 | Type=OleDll 2 | Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#..\..\..\..\..\..\..\Windows\SysWOW64\stdole2.tlb#OLE Automation 3 | Reference=*\G{EF404E00-EDA6-101A-8DAF-00DD010F7EBB}#5.3#0#..\..\..\..\..\..\..\Program Files (x86)\Microsoft Visual Studio\VB98\VB6EXT.OLB#Microsoft Visual Basic 6.0 Extensibility 4 | Reference=*\G{D4575622-4160-4FBE-8206-C7EF39D9E8B6}#1.1#0#..\..\Interfaces\WinApiForVb.tlb #WinApi For VB type library 5 | Reference=*\G{56A386D8-9525-4D57-854D-12FCFB26509D}#1.0#0#..\..\Interfaces\chlib.tlb #@ CodeHelp Global Object & Interface Definitions 6 | Reference=*\G{F1DB0540-8DE8-46E0-B054-4414D0FE0148}#1.0#0#..\..\CHCore\bin\CHGlobalLib.dll# CodeHelp Global Object 7 | Class=MDIMonitor; MDIMonitor2.cls 8 | Module=mPublic; mPublic.bas 9 | Class=MemoryDC; TabPage\MemoryDC.cls 10 | Class=SafeCollection; TabPage\SafeCollection.cls 11 | Class=TabItem; TabPage\TabItem.cls 12 | Class=TabManager; TabPage\TabManager.cls 13 | Class=TabPaintManager; TabPage\TabPaintManager.cls 14 | Class=DefaultPainter; TabPage\DefaultPainter.cls 15 | Class=ITabPainter; TabPage\ITabPainter.cls 16 | Class=ITimer; TabPage\ITimer.cls 17 | Class=cTimer; TabPage\cTimer.cls 18 | UserDocument=DockWindow.dob 19 | Class=GroupPanel; GroupPanel.cls 20 | ResFile32="CHTabMDI.RES" 21 | Startup="(None)" 22 | HelpFile="" 23 | Title="CHTabMDI" 24 | ExeName32="CHTabMDI2.dll" 25 | Path32=".." 26 | Command32="" 27 | Name="CHTabMDI" 28 | HelpContextID="0" 29 | CompatibleMode="0" 30 | CompatibleEXE32="..\CHTabMDI2.dll" 31 | MajorVer=2 32 | MinorVer=2 33 | RevisionVer=1 34 | AutoIncrementVer=0 35 | ServerSupportFiles=0 36 | VersionCompanyName="luthv@yahoo.com" 37 | CompilationType=0 38 | OptimizationType=0 39 | FavorPentiumPro(tm)=0 40 | CodeViewDebugInfo=0 41 | NoAliasing=-1 42 | BoundsCheck=-1 43 | OverflowCheck=-1 44 | FlPointCheck=-1 45 | FDIVCheck=-1 46 | UnroundedFP=-1 47 | StartMode=1 48 | Unattended=0 49 | Retained=0 50 | ThreadPerObject=0 51 | MaxNumberOfThreads=1 52 | ThreadingModel=1 53 | 54 | [MS Transaction Server] 55 | AutoRefresh=1 56 | 57 | [CodeSMART] 58 | Task_UID=30_07_05_21_04_33 59 | -------------------------------------------------------------------------------- /CHCore/frmSplash.frm: -------------------------------------------------------------------------------- 1 | VERSION 5.00 2 | Begin VB.Form frmSplash 3 | BorderStyle = 3 'Fixed Dialog 4 | ClientHeight = 1605 5 | ClientLeft = 255 6 | ClientTop = 1410 7 | ClientWidth = 7380 8 | ClipControls = 0 'False 9 | ControlBox = 0 'False 10 | Icon = "frmSplash.frx":0000 11 | KeyPreview = -1 'True 12 | LinkTopic = "Form2" 13 | MaxButton = 0 'False 14 | MinButton = 0 'False 15 | ScaleHeight = 1605 16 | ScaleWidth = 7380 17 | ShowInTaskbar = 0 'False 18 | StartUpPosition = 2 'CenterScreen 19 | Begin VB.Label lblDesc 20 | AutoSize = -1 'True 21 | Caption = "Label1" 22 | BeginProperty Font 23 | Name = "Arial" 24 | Size = 8.25 25 | Charset = 0 26 | Weight = 400 27 | Underline = 0 'False 28 | Italic = 0 'False 29 | Strikethrough = 0 'False 30 | EndProperty 31 | Height = 210 32 | Left = 1440 33 | TabIndex = 1 34 | Top = 660 35 | Width = 480 36 | End 37 | Begin VB.Label lblTitle 38 | AutoSize = -1 'True 39 | Caption = "Label1" 40 | BeginProperty Font 41 | Name = "Arial" 42 | Size = 8.25 43 | Charset = 0 44 | Weight = 700 45 | Underline = 0 'False 46 | Italic = 0 'False 47 | Strikethrough = 0 'False 48 | EndProperty 49 | Height = 210 50 | Left = 1440 51 | TabIndex = 0 52 | Top = 120 53 | Width = 540 54 | End 55 | End 56 | Attribute VB_Name = "frmSplash" 57 | Attribute VB_GlobalNameSpace = False 58 | Attribute VB_Creatable = False 59 | Attribute VB_PredeclaredId = True 60 | Attribute VB_Exposed = False 61 | 62 | Option Explicit 63 | 64 | -------------------------------------------------------------------------------- /CHCore/HookGate.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | Persistable = 0 'NotPersistable 5 | DataBindingBehavior = 0 'vbNone 6 | DataSourceBehavior = 0 'vbNone 7 | MTSTransactionMode = 0 'NotAnMTSObject 8 | END 9 | Attribute VB_Name = "HookGate" 10 | Attribute VB_GlobalNameSpace = False 11 | Attribute VB_Creatable = False 12 | Attribute VB_PredeclaredId = False 13 | Attribute VB_Exposed = False 14 | Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes" 15 | Attribute VB_Ext_KEY = "Top_Level" ,"Yes" 16 | Option Explicit 17 | 18 | Private Type CWPSTRUCT 19 | lParam As Long 20 | wParam As Long 21 | message As Long 22 | hwnd As Long 23 | End Type 24 | 25 | Private Type tagMSG 26 | hwnd As Long 27 | message As Long 28 | wParam As Long 29 | lParam As Long 30 | time As Long 31 | pt As POINTAPI 32 | End Type 33 | 34 | Private m_Hook As cHook 35 | Private m_hookType As Long 36 | 37 | Implements IHook 38 | 39 | Public Sub StartHook(ByVal HookType As Long) 40 | Set m_Hook = New cHook 41 | m_Hook.Hook Me, HookType 42 | m_hookType = HookType 43 | 44 | End Sub 45 | 46 | Public Sub EndHook() 47 | 48 | If Not m_Hook Is Nothing Then 49 | m_Hook.UnHook 50 | Set m_Hook = Nothing 51 | End If 52 | End Sub 53 | 54 | Private Sub IHook_Proc(ByVal bBefore As Boolean, _ 55 | bHandled As Boolean, _ 56 | lReturn As Long, _ 57 | nCode As Long, _ 58 | wParam As Long, _ 59 | lParam As Long) 60 | 61 | If bBefore = False Then Exit Sub 62 | If nCode <> HC_ACTION Then Exit Sub 63 | 64 | Select Case m_hookType 65 | 66 | Case WH_KEYBOARD 67 | HookMon.KeyProc bHandled, lReturn, wParam, lParam 68 | 69 | Case WH_CALLWNDPROC 70 | Dim tCWP As CWPSTRUCT 71 | CopyMemory tCWP, ByVal lParam, Len(tCWP) 72 | HookMon.CWPMSGProc tCWP.hwnd, tCWP.message, tCWP.wParam, tCWP.lParam 73 | 74 | Case WH_GETMESSAGE 75 | Dim tMSG As tagMSG 76 | CopyMemory tMSG, ByVal lParam, Len(tMSG) 77 | 78 | If wParam = PM_REMOVE Then 79 | HookMon.CWPMSGProc tMSG.hwnd, tMSG.message, tMSG.wParam, tMSG.lParam 80 | End If 81 | End Select 82 | 83 | End Sub 84 | -------------------------------------------------------------------------------- /CHCore/CHCore.vbp: -------------------------------------------------------------------------------- 1 | Type=OleDll 2 | Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#..\..\..\..\..\..\Windows\SysWOW64\stdole2.tlb#OLE Automation 3 | Reference=*\G{2DF8D04C-5BFA-101B-BDE5-00AA0044DE52}#2.0#0#..\..\..\..\..\..\Program Files (x86)\Common Files\Microsoft Shared\OFFICE15\MSO.DLL#Microsoft Office 8.0 Object Library 4 | Reference=*\G{AC0714F2-3D04-11D1-AE7D-00A0C90F26F4}#1.0#0#..\..\..\..\..\..\Program Files (x86)\Common Files\Designer\MSADDNDR.DLL#Add-In Designer/Instance Control Library 5 | Reference=*\G{EF404E00-EDA6-101A-8DAF-00DD010F7EBB}#5.3#0#..\..\..\..\..\..\Program Files (x86)\Microsoft Visual Studio\VB98\VB6EXT.OLB#Microsoft Visual Basic 6.0 Extensibility 6 | Reference=*\G{8B217740-717D-11CE-AB5B-D41203C10000}#1.0#0#..\..\..\..\..\..\windows\SysWow64\TLBINF32.DLL#TypeLib Information 7 | Reference=*\G{D4575622-4160-4FBE-8206-C7EF39D9E8B6}#1.1#0#..\Interfaces\WinApiForVb.tlb #WinApi For VB type library 8 | Reference=*\G{56A386D8-9525-4D57-854D-12FCFB26509D}#1.0#0#..\Interfaces\chlib.tlb #@ CodeHelp Global Object & Interface Definitions 9 | Reference=*\G{F1DB0540-8DE8-46E0-B054-4414D0FE0148}#1.0#0#bin\CHGlobalLib.dll# CodeHelp Global Object 10 | Form=frmAbout.frm 11 | Designer=Connect.Dsr 12 | Class=IHook; IHook.cls 13 | Class=HookGate; HookGate.cls 14 | Class=HookMonitor; HookMonitor.cls 15 | Class=ISubclass; isubclass.cls 16 | Class=cHook; cHook.cls 17 | Module=mCHCore; mCHCore.bas 18 | Class=Plugins; Plugins.cls 19 | Form=frmSplash.frm 20 | Form=frmPlugins.frm 21 | Class=cSubclass; cSubclass.cls 22 | IconForm="frmSplash" 23 | Startup="(None)" 24 | HelpFile="" 25 | Title="CHCore" 26 | ExeName32="CHCore.dll" 27 | Command32="" 28 | Name="CHCore" 29 | HelpContextID="0" 30 | Description="CodeHelp Core IDE Framework" 31 | CompatibleMode="0" 32 | CompatibleEXE32="CHCore.dll" 33 | MajorVer=3 34 | MinorVer=0 35 | RevisionVer=7 36 | AutoIncrementVer=1 37 | ServerSupportFiles=0 38 | VersionCompanyName="luthv@yahoo.com" 39 | VersionProductName="CodeHelp Core" 40 | CondComp="IN_ADDIN = 1" 41 | CompilationType=0 42 | OptimizationType=0 43 | FavorPentiumPro(tm)=0 44 | CodeViewDebugInfo=0 45 | NoAliasing=-1 46 | BoundsCheck=-1 47 | OverflowCheck=-1 48 | FlPointCheck=-1 49 | FDIVCheck=-1 50 | UnroundedFP=-1 51 | StartMode=1 52 | Unattended=0 53 | Retained=0 54 | ThreadPerObject=0 55 | MaxNumberOfThreads=1 56 | DebugStartupOption=0 57 | 58 | [MS Transaction Server] 59 | AutoRefresh=1 60 | 61 | [CodeSMART] 62 | Task_UID=16_09_05_20_06_46 63 | -------------------------------------------------------------------------------- /Plugins/CHTabMDI2/mPublic.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "mPublic" 2 | Option Explicit 3 | 4 | Public Enum enWinVersion 5 | enWin95 = 1 6 | enWinNT = 2 7 | enWin98 = 3 8 | enWin2000 = 4 9 | enWinXP = 5 10 | End Enum 11 | 12 | Function LowWord(lDWord As Long) As Integer 13 | 14 | If lDWord And &H8000& Then 15 | LowWord = lDWord Or &HFFFF0000 16 | Else 17 | LowWord = lDWord And &HFFFF& 18 | End If 19 | 20 | End Function 21 | 22 | Function HiWord(lDWord As Long) As Integer 23 | HiWord = (lDWord And &HFFFF0000) \ &H10000 24 | End Function 25 | 26 | Function GetWinText(hWnd As Long, Optional className As Boolean = False) As String 27 | 'some static vars to speed up things, this func will be called many times 28 | Static sBuffer As String * 128& 'is it safe to use 128 bytes? should be enough.. 29 | Static textLength As Long 30 | 31 | If className Then 32 | textLength = A_GetClassName(hWnd, sBuffer, 129&) 33 | Else 34 | textLength = A_GetWindowText(hWnd, sBuffer, 129&) 35 | End If 36 | 37 | If textLength > 0 Then 38 | GetWinText = Left$(sBuffer, textLength) 39 | End If 40 | 41 | End Function 42 | 43 | Function GetOSVersion() As enWinVersion 44 | 'Get Windows version 45 | Dim tOS As A_OSVERSIONINFO 46 | 47 | tOS.dwOSVersionInfoSize = Len(tOS) 48 | A_GetVersionEx tOS 49 | 50 | If tOS.dwMajorVersion > 4& Then 51 | If tOS.dwMinorVersion > 0& Then 52 | GetOSVersion = enWinXP 53 | ElseIf tOS.dwMinorVersion = 0& Then 54 | GetOSVersion = enWin2000 55 | End If 56 | 57 | Else 58 | 59 | If tOS.dwPlatformId = 1& Then 60 | If tOS.dwMinorVersion > 0& Then 61 | GetOSVersion = enWin98 62 | Else 63 | GetOSVersion = enWin95 64 | End If 65 | 66 | ElseIf tOS.dwPlatformId = 2& Then 67 | GetOSVersion = enWinNT 'Should be check for NT 3.5 but we're not going that far 68 | End If 69 | End If 70 | 71 | End Function 72 | 73 | Public Function MakeDWord(ByVal LowWord As Integer, ByVal HiWord As Integer) As Long 74 | ' by Karl E. Peterson, http://www.mvps.org/vb, 20001207 75 | ' High word is coerced to Long to allow it to 76 | ' overflow limits of multiplication which shifts 77 | ' it left. 78 | MakeDWord = (CLng(HiWord) * &H10000) Or (LowWord And &HFFFF&) 79 | End Function 80 | -------------------------------------------------------------------------------- /CHGlobalLib/CHGlobal.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | Persistable = 0 'NotPersistable 5 | DataBindingBehavior = 0 'vbNone 6 | DataSourceBehavior = 0 'vbNone 7 | MTSTransactionMode = 0 'NotAnMTSObject 8 | END 9 | Attribute VB_Name = "CHHelper" 10 | Attribute VB_GlobalNameSpace = True 11 | Attribute VB_Creatable = True 12 | Attribute VB_PredeclaredId = False 13 | Attribute VB_Exposed = True 14 | Option Explicit 15 | '*********************************** 16 | 'CodeHelp Helper class 17 | '*********************************** 18 | 19 | Private Const ccCFBitmap = 2 20 | Private Const ccCFMetafile = 3 21 | Private Const ccCFDIB = 8 22 | 23 | Private Declare Function CreateIC Lib "gdi32" Alias "CreateICA" _ 24 | (ByVal lpDriverName As String, ByVal lpDeviceName As String, _ 25 | ByVal lpOutput As String, ByVal lpInitData As String) As Long 26 | 27 | 28 | Function GetCHCore(ByVal lPtr As Long) As ICHCore 29 | Dim oTemp As Object 30 | ' Turn the pointer into an illegal, uncounted interface 31 | If lPtr = 0 Then Exit Function 32 | 33 | If IsBadReadPtr(lPtr, ByVal 4) Then Exit Function ' better to be safe 34 | CopyMemory oTemp, lPtr, 4 35 | 36 | ' Assign to legal reference 37 | Set GetCHCore = oTemp 38 | 39 | ' Destroy the illegal reference 40 | CopyMemory oTemp, 0&, 4 41 | End Function 42 | 43 | Sub CopyIconToClipBoardAsBmp(oIcon As StdPicture, oBMP As StdPicture) 44 | Dim Rc As Long 45 | Dim hdc As Long 46 | Dim hdcMem As Long 47 | Dim hBmOld As Long 48 | 49 | hdc = CreateIC("DISPLAY", vbNullChar, vbNullChar, vbNullChar) 50 | hdcMem = CreateCompatibleDC(hdc) 51 | hBmOld = SelectObject(hdcMem, oBMP.Handle) 52 | Rc = DrawIconEx(hdcMem, 0, 0, oIcon.Handle, 16, 16, 0, 0, DI_NORMAL) 53 | SelectObject hdcMem, hBmOld 54 | DeleteDC hdc 55 | DeleteDC hdcMem 56 | 57 | Clipboard.Clear 58 | Clipboard.SetData oBMP, ccCFBitmap 59 | Clipboard.SetData oBMP, ccCFDIB 60 | 61 | End Sub 62 | 63 | Public Function IsKeyDownEvent(lParam As Long) As Boolean 64 | IsKeyDownEvent = (lParam And &H80000000) = 0 65 | End Function 66 | 67 | Sub LogToNotePad(ByVal sMsg As String) 68 | 'Help trace in compiled mode 69 | 'The message will be appended to first notepad instance found 70 | 71 | Dim hNote As Long 72 | hNote = A_FindWindowEx(0, 0, "Notepad", "Untitled - Notepad") 73 | 74 | If hNote <> 0 Then 75 | hNote = A_FindWindowEx(hNote, 0, "Edit", vbNullString) 76 | A_SendMessageStr hNote, EM_REPLACESEL, 0, sMsg 77 | End If 78 | End Sub 79 | -------------------------------------------------------------------------------- /Readme.md: -------------------------------------------------------------------------------- 1 | # Version 3.0 2 | 3 | All code in this repository is released, with permission from Luthfi, under the 4 | [MIT](https://tldrlegal.com/license/mit-license#summary) license unless otherwise noted. 5 | (For example [CHCore/CHook.cls](CHCore/CHook.cls) or [Plugins/CHTabMDI2/mPublic.bas](Plugins/CHTabMDI2/mPublic.bas)::MakeDWord). 6 | An [installer](CodeHelpInstaller.exe?raw=true) is provided and can be built with [NSIS](http://nsis.sourceforge.net/) 2.46. 7 | 8 | ### Features 9 | ##### CHCoder 10 | * Autocomplete templates with Shift+Space 11 | * Use <sel></> to delimit the text that should be selected after the expansion 12 | 13 | ##### CHCodeComplexity 14 | * The panel displays maximum nesting level, 15 | [cyclomatic complexity](http://en.wikipedia.org/wiki/Cyclomatic_complexity), and 16 | [code flow complexity](http://dx.doi.org/10.1109/SCAM.2012.17) 17 | * The panel should update when switching between components, however Ctrl+M will force an update; 18 | useful after making some code changes to see if they reduce complexity greatly 19 | 20 | ##### CHTabMDI 21 | * When component windows are maximized they are displayed in a rudementary tab interface 22 | * Ctrl+1-9 will switch between the first 9 windows 23 | * Ctrl+Enter will maximize the current window 24 | 25 | ##### CHFullScreen 26 | * Shift+Enter will remove almost all the window chrome (similiar to zen mode in many other editors) 27 | 28 | ##### CHMouseWheel 29 | * Like the solution from Microsoft this plugin enables the mouse wheel in VS6, however this version 30 | allows the number of lines that are scrolled to be configured 31 | 32 | ### Extending CodeHelp 33 | If you intend to add/extend any of the components the installer expects to find binaries in 34 | the `CHCore/bin` and `CHCore/bin/Plugins` directories. You should copy the example project in `Plugins/BlankTemplate` to a 35 | new subdirectory and add it to CodeHelp.vbg. 36 | 37 | To compile the project you need to have the `WinAPIForVB` and `chlib` type libraries registered on your machine. They are 38 | located in the CHCore/Interfaces directory. Then you will first need to compile `CHGlobalLib` because `CHCore` and all the 39 | plugins reference `CHGlobalLib`. `CHGlobalLib` and `CHCore` go in `CHCore/bin`, all the plugins go in `CHCore/bin/Plugins` 40 | and must be registered as COM servers. 41 | 42 | *Note:* If you make any changes to `CHGlobalLib` you will need to recompile all of the other dlls (CHCore and all plugins). 43 | 44 | 45 | ##### Contributors 46 | Thanks to Luthfi for developing this initally and allowing it to be revived. 47 | -------------------------------------------------------------------------------- /OldInterface/ICHPlugin.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | Persistable = 0 'NotPersistable 5 | DataBindingBehavior = 0 'vbNone 6 | DataSourceBehavior = 0 'vbNone 7 | MTSTransactionMode = 0 'NotAnMTSObject 8 | END 9 | Attribute VB_Name = "ICHPlugin" 10 | Attribute VB_GlobalNameSpace = False 11 | Attribute VB_Creatable = False 12 | Attribute VB_PredeclaredId = False 13 | Attribute VB_Exposed = True 14 | Option Explicit 15 | 16 | '**************************************** 17 | 'CodeHelp Plugin Interface 18 | '**************************************** 19 | 20 | Property Get Name() As String 21 | 22 | End Property 23 | 24 | Property Get LongName() As String 25 | 26 | End Property 27 | 28 | Property Get Version() As String 29 | 30 | End Property 31 | 32 | Property Get Description() As String 33 | 34 | End Property 35 | 36 | Property Get CopyRight() As String 37 | 38 | End Property 39 | 40 | Sub OnConnection(ByVal ConnectMode As AddInDesignerObjects.ext_ConnectMode, custom() As Variant) 41 | 42 | End Sub 43 | 44 | Sub OnDisconnect(ByVal RemoveMode As AddInDesignerObjects.ext_DisconnectMode, custom() As Variant) 45 | 46 | End Sub 47 | 48 | Sub OnWinProcHook(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long, _ 49 | bHandled As Boolean, placeSubclass As Boolean, before As Boolean) 50 | 'Purpose : 51 | 'CWP Hook and MSG Hook notification, Called by CHCore 52 | 'Params: 53 | '- bHandled, set to true to prevent other plugins from getting the notification 54 | '- placeSublass, set to true to notify CHCore to place a subclass for the window for the particular msg 55 | ' Use this if you want to make modification to the return value, wParam or lParam value 56 | '- before, place the subclass before or after default winproc 57 | End Sub 58 | 59 | Sub OnWinProc(ByVal hWnd As Long, ByVal uMsg As Long, wParam As Long, lParam As Long, bHandled As Boolean, lreturn As Long) 60 | 'Purpose: 61 | 'To allow client plugin to modify the default window message processing 62 | End Sub 63 | 64 | Sub OnKeyHook(bHandled As Boolean, lreturn As Long, wParam As Long, lParam As Long) 65 | 'Purpose: 66 | 'Keyboard hook notification 67 | End Sub 68 | 69 | Property Let CHCore(ByVal value As Long) 70 | 'Purpose: 71 | 'Save the pointer to Parent AddIn Designer object 72 | End Property 73 | 74 | Property Get Enabled() As Boolean 75 | 'Allow enable/disabling the plugin at runtime 76 | End Property 77 | 78 | Property Let Enabled(ByVal value As Boolean) 79 | 'Allow enable/disabling the plugin at runtime 80 | End Property 81 | 82 | Property Get HaveProperties() As Boolean 83 | 84 | End Property 85 | 86 | Sub ShowPropertyDialog() 87 | 88 | End Sub 89 | 90 | Property Get HaveExtendedHelp() As Boolean 91 | 92 | End Property 93 | 94 | Sub ShowHelp() 95 | 96 | End Sub 97 | 98 | -------------------------------------------------------------------------------- /Plugins/CHMWheel/frmProperties.frm: -------------------------------------------------------------------------------- 1 | VERSION 5.00 2 | Begin VB.Form frmProperties 3 | BorderStyle = 3 'Fixed Dialog 4 | Caption = "CodeHelp Mousewheel Options" 5 | ClientHeight = 1200 6 | ClientLeft = 2760 7 | ClientTop = 3750 8 | ClientWidth = 5460 9 | ControlBox = 0 'False 10 | LinkTopic = "Form1" 11 | MaxButton = 0 'False 12 | MinButton = 0 'False 13 | ScaleHeight = 1200 14 | ScaleWidth = 5460 15 | ShowInTaskbar = 0 'False 16 | StartUpPosition = 2 'CenterScreen 17 | Begin VB.TextBox txtNumber 18 | BeginProperty Font 19 | Name = "Tahoma" 20 | Size = 8.25 21 | Charset = 0 22 | Weight = 400 23 | Underline = 0 'False 24 | Italic = 0 'False 25 | Strikethrough = 0 'False 26 | EndProperty 27 | Height = 375 28 | Left = 2025 29 | TabIndex = 1 30 | Text = "3" 31 | Top = 135 32 | Width = 1815 33 | End 34 | Begin VB.CommandButton CancelButton 35 | Cancel = -1 'True 36 | Caption = "Cancel" 37 | BeginProperty Font 38 | Name = "Tahoma" 39 | Size = 8.25 40 | Charset = 0 41 | Weight = 400 42 | Underline = 0 'False 43 | Italic = 0 'False 44 | Strikethrough = 0 'False 45 | EndProperty 46 | Height = 375 47 | Left = 4050 48 | TabIndex = 3 49 | Top = 585 50 | Width = 1215 51 | End 52 | Begin VB.CommandButton OKButton 53 | Caption = "OK" 54 | BeginProperty Font 55 | Name = "Tahoma" 56 | Size = 8.25 57 | Charset = 0 58 | Weight = 400 59 | Underline = 0 'False 60 | Italic = 0 'False 61 | Strikethrough = 0 'False 62 | EndProperty 63 | Height = 375 64 | Left = 4050 65 | TabIndex = 2 66 | Top = 135 67 | Width = 1215 68 | End 69 | Begin VB.Label Label1 70 | AutoSize = -1 'True 71 | Caption = "Number of lines to scroll:" 72 | BeginProperty Font 73 | Name = "Tahoma" 74 | Size = 8.25 75 | Charset = 0 76 | Weight = 400 77 | Underline = 0 'False 78 | Italic = 0 'False 79 | Strikethrough = 0 'False 80 | EndProperty 81 | Height = 195 82 | Left = 135 83 | TabIndex = 0 84 | Top = 180 85 | Width = 1770 86 | End 87 | End 88 | Attribute VB_Name = "frmProperties" 89 | Attribute VB_GlobalNameSpace = False 90 | Attribute VB_Creatable = False 91 | Attribute VB_PredeclaredId = True 92 | Attribute VB_Exposed = False 93 | 94 | Option Explicit 95 | 96 | Private Sub CancelButton_Click() 97 | Hide 98 | End Sub 99 | 100 | Private Sub Form_Load() 101 | A_SetWindowLong txtNumber.hWnd, GWL_STYLE, _ 102 | A_GetWindowLong(txtNumber.hWnd, GWL_STYLE) Or ES_NUMBER 103 | End Sub 104 | 105 | Private Sub OKButton_Click() 106 | Hide 107 | End Sub 108 | -------------------------------------------------------------------------------- /CHCore/HookMonitor.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | Persistable = 0 'NotPersistable 5 | DataBindingBehavior = 0 'vbNone 6 | DataSourceBehavior = 0 'vbNone 7 | MTSTransactionMode = 0 'NotAnMTSObject 8 | END 9 | Attribute VB_Name = "HookMonitor" 10 | Attribute VB_GlobalNameSpace = False 11 | Attribute VB_Creatable = False 12 | Attribute VB_PredeclaredId = False 13 | Attribute VB_Exposed = False 14 | Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes" 15 | Attribute VB_Ext_KEY = "Top_Level" ,"Yes" 16 | Option Explicit 17 | 18 | Private m_KeyHook As HookGate 19 | Private m_CWPHook As HookGate 20 | Private m_MSGHook As HookGate 21 | 22 | Private m_Subclass As cSubclass 23 | Private m_SubClassPlugin As ICHPlugin 24 | 25 | Implements ISubclass 26 | 27 | Sub StartMonitor() 28 | 29 | Set m_KeyHook = New HookGate 30 | m_KeyHook.StartHook WH_KEYBOARD 31 | 32 | Set m_CWPHook = New HookGate 33 | m_CWPHook.StartHook WH_CALLWNDPROC 34 | 35 | Set m_MSGHook = New HookGate 36 | m_MSGHook.StartHook WH_GETMESSAGE 37 | 38 | End Sub 39 | 40 | Sub EndMonitor() 41 | On Error Resume Next 42 | m_KeyHook.EndHook 43 | Set m_KeyHook = Nothing 44 | 45 | m_CWPHook.EndHook 46 | Set m_CWPHook = Nothing 47 | 48 | m_MSGHook.EndHook 49 | Set m_MSGHook = Nothing 50 | 51 | End Sub 52 | 53 | Sub KeyProc(bHandled As Boolean, lReturn As Long, wParam As Long, lParam As Long) 54 | On Error Resume Next 55 | Dim oPlugin As ICHPlugin 56 | 57 | For Each oPlugin In mCHCore.Plugins 58 | 59 | If oPlugin.Enabled Then 60 | If bHandled = False Then 61 | oPlugin.OnKeyHook bHandled, lReturn, wParam, lParam 62 | 63 | End If 64 | End If 65 | Next 66 | End Sub 67 | 68 | Sub CWPMSGProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) 69 | 'On Error Resume Next 70 | Dim oPlugin As ICHPlugin 71 | Dim bHandled As Boolean, placeSubclass As Boolean, before As Boolean 72 | For Each oPlugin In mCHCore.Plugins 73 | 74 | If oPlugin.Enabled Then 75 | 76 | If bHandled = False Then 77 | placeSubclass = False 78 | before = False 79 | oPlugin.OnWinProcHook hwnd, uMsg, wParam, lParam, bHandled, placeSubclass, before 80 | 81 | If placeSubclass Then 82 | Set m_SubClassPlugin = oPlugin 83 | If before Then 84 | SubclassThisWindowMsg hwnd, uMsg, MSG_BEFORE 85 | Else 86 | SubclassThisWindowMsg hwnd, uMsg, MSG_AFTER 87 | End If 88 | Exit For 'currently only support one oPlugin per subclassed msg 89 | End If 90 | End If 91 | End If 92 | Next 93 | End Sub 94 | 95 | Private Sub ISubclass_Proc(ByVal bBefore As Boolean, bHandled As Boolean, lReturn As Long, hwnd As Long, uMsg As Long, wParam As Long, lParam As Long) 96 | If m_SubClassPlugin.Enabled Then 97 | m_SubClassPlugin.OnWinProc hwnd, uMsg, wParam, lParam, bHandled, lReturn 98 | End If 99 | 'we're done so unsubclass right away 100 | 'add reference lock for win98 101 | Set lockSubclass = m_Subclass 102 | m_Subclass.UnSubclass 103 | Set m_Subclass = Nothing 104 | Set m_SubClassPlugin = Nothing 105 | End Sub 106 | 107 | Private Sub SubclassThisWindowMsg(ByVal hwnd As Long, ByVal uMsg As Long, ByVal MsgWhen As enMsgWhen) 108 | Set m_Subclass = New cSubclass 109 | m_Subclass.AddMsg uMsg, MsgWhen 110 | m_Subclass.Subclass hwnd, Me 111 | End Sub 112 | -------------------------------------------------------------------------------- /Plugins/BlankTemplate/Loader.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | Persistable = 0 'NotPersistable 5 | DataBindingBehavior = 0 'vbNone 6 | DataSourceBehavior = 0 'vbNone 7 | MTSTransactionMode = 0 'NotAnMTSObject 8 | END 9 | Attribute VB_Name = "Loader" 10 | Attribute VB_GlobalNameSpace = False 11 | Attribute VB_Creatable = True 12 | Attribute VB_PredeclaredId = False 13 | Attribute VB_Exposed = True 14 | Option Explicit 15 | 16 | 'Plugin const 17 | Private Const CH_LONGNAME As String = "Your Plugin Title" 18 | Private Const CH_DESCRIPTION As String = "Description of what your plugin do" 19 | Private Const CH_COPYRIGHT As String = "Your copyright info" 20 | 21 | Private m_lPtr As Long 22 | private m_bEnabled as boolean 23 | 24 | Implements ICHPlugin 25 | 26 | Private Property Let ICHPlugin_CHCore(ByVal RHS As Long) 27 | 'Save the Pointer for later use 28 | m_lPtr = RHS 29 | End Property 30 | 31 | Private Property Get ICHPlugin_CopyRight() As String 32 | ICHPlugin_CopyRight = CH_COPYRIGHT 33 | End Property 34 | 35 | Private Property Get ICHPlugin_Description() As String 36 | ICHPlugin_Description = CH_DESCRIPTION 37 | End Property 38 | 39 | Private Property Let ICHPlugin_Enabled(ByVal RHS As Boolean) 40 | 'Enable/disable this plugin in plugin manager 41 | 'if disable the ondisconnect method will be called, and the plugin will be excluded from 42 | 'msg processing 43 | m_bEnabled = rhs 44 | End Property 45 | 46 | Private Property Get ICHPlugin_Enabled() As Boolean 47 | 'Enable/disable this plugin in plugin manager 48 | 'if disable the ondisconnect method will be called, and the plugin will be excluded from 49 | 'msg processing 50 | ICHPlugin_Enabled = m_bEnabled 51 | End Property 52 | 53 | Private Property Get ICHPlugin_HaveExtendedHelp() As Boolean 54 | 'Enable/disable help button in plugin manager 55 | End Property 56 | 57 | Private Property Get ICHPlugin_HaveProperties() As Boolean 58 | 'Enable/disable properties button in plugin manager 59 | End Property 60 | 61 | Private Property Get ICHPlugin_LongName() As String 62 | ICHPlugin_LongName = CH_LONGNAME 63 | End Property 64 | 65 | Private Property Get ICHPlugin_Name() As String 66 | ICHPlugin_Name = App.Title 67 | End Property 68 | 69 | Private Sub ICHPlugin_OnConnection(ByVal ConnectMode As CodeHelpDef.ext_ConnectMode, _ 70 | custom() As Variant) 71 | 72 | 'Sample use of the ICHCore pointer 73 | 'It's advisable not to save the ICHCore object itself, always use the helper function to obtain the 74 | 'ICHCore object from the pointer 75 | 76 | Dim dsr As ICHCore 77 | 78 | Set dsr = GetCHCore(m_lPtr) 79 | 80 | 'Do your initializing stuff here 81 | End Sub 82 | 83 | Private Sub ICHPlugin_OnDisconnect(ByVal RemoveMode As CodeHelpDef.ext_DisconnectMode, _ 84 | custom() As Variant) 85 | 'Do your clean up here 86 | End Sub 87 | 88 | Private Sub ICHPlugin_OnKeyHook(bHandled As Boolean, _ 89 | lreturn As Long, _ 90 | wParam As Long, _ 91 | lParam As Long) 92 | 'do any keyboard related code here 93 | End Sub 94 | 95 | Private Sub ICHPlugin_OnWinProc(ByVal hWnd As Long, _ 96 | ByVal uMsg As Long, _ 97 | wParam As Long, _ 98 | lParam As Long, _ 99 | bHandled As Boolean, _ 100 | lreturn As Long) 101 | 'subclassed message goes here 102 | End Sub 103 | 104 | Private Sub ICHPlugin_OnWinProcHook(ByVal hWnd As Long, _ 105 | ByVal uMsg As Long, _ 106 | ByVal wParam As Long, _ 107 | ByVal lParam As Long, _ 108 | bHandled As Boolean, _ 109 | placeSubclass As Boolean, _ 110 | before As Boolean) 111 | 'Hook msg goes here 112 | End Sub 113 | 114 | Private Sub ICHPlugin_ShowHelp() 115 | 'Show help instruction when user click on help button in plugin manager 116 | End Sub 117 | 118 | Private Sub ICHPlugin_ShowPropertyDialog() 119 | 'show property dialog when user click on properties button in plugin manager 120 | End Sub 121 | 122 | Private Property Get ICHPlugin_Version() As String 123 | ICHPlugin_Version = App.Major & "." & App.Minor & "." & App.Revision 124 | End Property 125 | 126 | -------------------------------------------------------------------------------- /Plugins/CHTabMDI2/TabPage/TabItem.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | Persistable = 0 'NotPersistable 5 | DataBindingBehavior = 0 'vbNone 6 | DataSourceBehavior = 0 'vbNone 7 | MTSTransactionMode = 0 'NotAnMTSObject 8 | END 9 | Attribute VB_Name = "TabItem" 10 | Attribute VB_GlobalNameSpace = False 11 | Attribute VB_Creatable = True 12 | Attribute VB_PredeclaredId = False 13 | Attribute VB_Exposed = False 14 | Option Explicit 15 | 16 | 'Tab item class for Tab Pages and buttons 17 | 18 | Private m_sCaption As String 19 | Private m_objIcon As IPictureDisp 20 | Private m_bVisible As Boolean 21 | Private m_tabMgr As TabManager 22 | Private m_lIndex As Long 23 | Private m_lWidth As Long 24 | Private m_IsRightMostItem As Boolean 25 | Private m_IsLeftMostItem As Boolean 26 | Private m_lState As Long 27 | Private m_hWnd As Variant 28 | 29 | Private Sub Class_Terminate() 30 | Set m_objIcon = Nothing 31 | Set m_tabMgr = Nothing 32 | If IsObject(m_hWnd) Then 33 | Set m_hWnd = Nothing 34 | Else 35 | m_hWnd = vbEmpty 36 | End If 37 | End Sub 38 | 39 | Public Property Get Caption() As String 40 | Caption = m_sCaption 41 | End Property 42 | 43 | Public Property Let Caption(ByVal sCaption As String) 44 | If m_sCaption <> sCaption Then 45 | m_sCaption = sCaption 46 | If Not m_tabMgr Is Nothing Then 47 | m_tabMgr.CaptionChanged m_lIndex 48 | End If 49 | End If 50 | End Property 51 | 52 | Public Property Get Icon() As IPictureDisp 53 | Set Icon = m_objIcon 54 | End Property 55 | 56 | Public Property Set Icon(objIcon As IPictureDisp) 57 | Set m_objIcon = objIcon 58 | End Property 59 | 60 | Public Property Get Visible() As Boolean 61 | Visible = m_bVisible 62 | End Property 63 | 64 | Public Property Let Visible(ByVal bVisible As Boolean) 65 | If m_bVisible <> bVisible Then 66 | m_bVisible = bVisible 67 | If Not m_tabMgr Is Nothing Then 68 | m_tabMgr.VisibleChanged m_lIndex 69 | End If 70 | End If 71 | End Property 72 | 73 | Public Property Get Selected() As Boolean 74 | Selected = ((m_lState And ODS_SELECTED) = ODS_SELECTED) 75 | End Property 76 | 77 | Public Property Let Selected(ByVal bSelected As Boolean) 78 | If Me.Selected <> bSelected Then 79 | 80 | If m_bVisible Then 81 | If bSelected Then 82 | m_lState = (m_lState Or ODS_SELECTED) 83 | Else 84 | m_lState = (m_lState And Not ODS_SELECTED) 85 | End If 86 | 87 | If bSelected Then 88 | If Not m_tabMgr Is Nothing Then 89 | Set m_tabMgr.SelectedItem = Me 90 | End If 91 | End If 92 | End If 93 | End If 94 | End Property 95 | 96 | Friend Sub SetActive(ByVal active As Boolean) 97 | If active Then 98 | m_lState = (m_lState Or ODS_SELECTED) 99 | Else 100 | m_lState = (m_lState And Not ODS_SELECTED) 101 | End If 102 | End Sub 103 | 104 | Public Property Get Index() As Long 105 | Index = m_lIndex 106 | End Property 107 | 108 | Public Property Let Index(ByVal lIndex As Long) 109 | m_lIndex = lIndex 110 | End Property 111 | 112 | Friend Property Set Owner(ByVal Value As TabManager) 113 | Set m_tabMgr = Value 114 | End Property 115 | 116 | Friend Property Get Width() As Long 117 | Width = m_lWidth 118 | End Property 119 | 120 | Friend Property Let Width(ByVal lWidth As Long) 121 | m_lWidth = lWidth 122 | End Property 123 | 124 | Friend Property Get RightMostItem() As Boolean 125 | RightMostItem = m_IsRightMostItem 126 | End Property 127 | 128 | Friend Property Let RightMostItem(ByVal bRightMostItem As Boolean) 129 | m_IsRightMostItem = bRightMostItem 130 | End Property 131 | 132 | Friend Property Get LeftMostItem() As Boolean 133 | LeftMostItem = m_IsLeftMostItem 134 | End Property 135 | 136 | Friend Property Let LeftMostItem(ByVal Value As Boolean) 137 | m_IsLeftMostItem = Value 138 | End Property 139 | 140 | Public Property Get Enabled() As Boolean 141 | Enabled = ((m_lState And ODS_DISABLED) <> ODS_DISABLED) 142 | End Property 143 | 144 | Public Property Let Enabled(ByVal bEnabled As Boolean) 145 | If bEnabled Then 146 | m_lState = (m_lState And Not ODS_DISABLED) 147 | Else 148 | m_lState = (m_lState Or ODS_DISABLED) 149 | End If 150 | End Property 151 | 152 | Public Property Get Hovered() As Boolean 153 | Hovered = ((m_lState And ODS_HOTLIGHT) = ODS_HOTLIGHT) 154 | End Property 155 | 156 | Friend Property Let Hovered(ByVal bHovered As Boolean) 157 | If bHovered Then 158 | If Enabled Then 159 | m_lState = (m_lState Or ODS_HOTLIGHT) 160 | End If 161 | Else 162 | m_lState = (m_lState And Not ODS_HOTLIGHT) 163 | End If 164 | End Property 165 | 166 | Public Property Get Pushed() As Boolean 167 | Hovered = ((m_lState And ODS_CHECKED) = ODS_CHECKED) 168 | End Property 169 | 170 | Friend Property Let Pushed(ByVal Value As Boolean) 171 | If Value Then 172 | m_lState = (m_lState Or ODS_CHECKED) 173 | Else 174 | m_lState = (m_lState And Not ODS_CHECKED) 175 | End If 176 | End Property 177 | 178 | Public Property Get ChildhWnd() As Variant 179 | ChildhWnd = m_hWnd 180 | End Property 181 | 182 | Public Property Let ChildhWnd(ByVal hWnd As Variant) 183 | m_hWnd = hWnd 184 | End Property 185 | 186 | -------------------------------------------------------------------------------- /Plugins/CHCodeComplexity/MetricsPanel.dob: -------------------------------------------------------------------------------- 1 | VERSION 5.00 2 | Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "msflxgrd.ocx" 3 | Begin VB.UserDocument MetricsPanel 4 | ClientHeight = 2160 5 | ClientLeft = 0 6 | ClientTop = 0 7 | ClientWidth = 6480 8 | HScrollSmallChange= 225 9 | ScaleHeight = 2160 10 | ScaleWidth = 6480 11 | ScrollBars = 0 'None 12 | VScrollSmallChange= 225 13 | Begin VB.CommandButton btnUpdate 14 | Caption = "Update" 15 | Height = 315 16 | Left = 3960 17 | TabIndex = 1 18 | Top = 0 19 | Width = 2535 20 | End 21 | Begin MSFlexGridLib.MSFlexGrid MetricsGrid 22 | Height = 1815 23 | Left = 0 24 | TabIndex = 0 25 | Top = 360 26 | Width = 6495 27 | _ExtentX = 11456 28 | _ExtentY = 3201 29 | _Version = 393216 30 | Rows = 5 31 | Cols = 4 32 | BackColorBkg = -2147483633 33 | FocusRect = 0 34 | HighLight = 2 35 | GridLinesFixed = 1 36 | ScrollBars = 2 37 | SelectionMode = 1 38 | AllowUserResizing= 1 39 | BorderStyle = 0 40 | Appearance = 0 41 | BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 42 | Name = "Tahoma" 43 | Size = 8.25 44 | Charset = 0 45 | Weight = 400 46 | Underline = 0 'False 47 | Italic = 0 'False 48 | Strikethrough = 0 'False 49 | EndProperty 50 | End 51 | End 52 | Attribute VB_Name = "MetricsPanel" 53 | Attribute VB_GlobalNameSpace = False 54 | Attribute VB_Creatable = True 55 | Attribute VB_PredeclaredId = False 56 | Attribute VB_Exposed = True 57 | Option Explicit 58 | 59 | Private m_IDE As VBE 60 | Private m_Shown As Boolean 61 | Private m_lMetricColWidth As Long 62 | Private m_Analyzer As CodeAnalysis.VBFileAnalyzer 63 | 64 | Public Sub Initalize(IDE As VBE) 65 | Set m_IDE = IDE 66 | End Sub 67 | 68 | Private Sub btnUpdate_Click() 69 | Call CurrentCodeMetrics 70 | End Sub 71 | 72 | Private Sub UserDocument_Initialize() 73 | Dim lRow As Long 74 | Dim sMethodName As String 75 | 76 | m_lMetricColWidth = MetricsGrid.ColWidth(0) 77 | Set m_Analyzer = New CodeAnalysis.VBFileAnalyzer 78 | 79 | With MetricsGrid 80 | .Rows = 1 81 | .Row = 0 82 | .Col = 0 83 | .Text = "Method" 84 | 85 | .Col = 1 86 | .Text = "Nesting" 87 | .CellAlignment = flexAlignRightCenter 88 | 89 | .Col = 2 90 | .Text = "CC" 91 | .CellAlignment = flexAlignRightCenter 92 | 93 | .Col = 3 94 | .Text = "CFC" 95 | .CellAlignment = flexAlignRightCenter 96 | 97 | End With 98 | End Sub 99 | 100 | Private Sub CurrentCodeMetrics() 101 | Dim oActive As CodeModule 102 | 103 | On Error Resume Next 104 | Set oActive = m_IDE.ActiveCodePane.CodeModule 105 | On Error GoTo 0 106 | 107 | Call UpdateCodeMetrics(oActive) 108 | End Sub 109 | 110 | 111 | Public Sub UpdateCodeMetrics(Optional oActive As CodeModule = Nothing) 112 | Dim lRow As Long 113 | Dim sMethodName As String 114 | 115 | If oActive Is Nothing Then Exit Sub 116 | If m_Analyzer Is Nothing Then Exit Sub 117 | Call m_Analyzer.analyzeFileText(oActive.Lines(1, oActive.CountOfLines)) 118 | 119 | With MetricsGrid 120 | .Rows = 1 + m_Analyzer.numberOfMethods 121 | For lRow = 1 To .Rows - 1 122 | .Row = lRow 123 | sMethodName = m_Analyzer.methodNameForIndex(lRow) 124 | 125 | .Col = 0 126 | .Text = sMethodName 127 | 128 | .Col = 1 129 | .Text = m_Analyzer.nestingDepthForMethod(sMethodName) 130 | 131 | .Col = 2 132 | .Text = m_Analyzer.cyclomaticComplexityForMethod(sMethodName) 133 | 134 | .Col = 3 135 | .Text = m_Analyzer.codeFlowComplexityForMethod(sMethodName) 136 | Next 137 | End With 138 | End Sub 139 | 140 | Private Sub UserDocument_Resize() 141 | Call Resize 142 | End Sub 143 | 144 | Private Sub UserDocument_Show() 145 | Call Resize 146 | Call CurrentCodeMetrics 147 | End Sub 148 | 149 | Private Sub Resize() 150 | Const TOP_HEIGHT = 300 151 | Const PADDING = 30 152 | Dim lWidthNoSB As Long 153 | Dim lFuncWidth As Long 154 | 155 | If UserDocument.Width > 0 Then 156 | btnUpdate.Top = 0 157 | btnUpdate.Left = 0 158 | btnUpdate.Width = UserDocument.Width 159 | btnUpdate.Height = TOP_HEIGHT 160 | 161 | MetricsGrid.Top = TOP_HEIGHT + PADDING 162 | MetricsGrid.Left = 0 163 | MetricsGrid.Width = UserDocument.Width 164 | MetricsGrid.Height = UserDocument.Height - MetricsGrid.Top 165 | 166 | lWidthNoSB = UserDocument.ScaleWidth - 240 167 | lFuncWidth = lWidthNoSB * (2 / 3) 168 | If lFuncWidth < 1 Then 169 | Exit Sub 170 | End If 171 | 172 | MetricsGrid.ColWidth(0) = lFuncWidth 173 | MetricsGrid.ColWidth(1) = (lWidthNoSB - lFuncWidth) / 2 174 | MetricsGrid.ColWidth(2) = MetricsGrid.ColWidth(1) / 2 175 | MetricsGrid.ColWidth(3) = MetricsGrid.ColWidth(1) / 2 176 | End If 177 | End Sub 178 | -------------------------------------------------------------------------------- /Plugins/CHCodeComplexity/Loader.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | Persistable = 0 'NotPersistable 5 | DataBindingBehavior = 0 'vbNone 6 | DataSourceBehavior = 0 'vbNone 7 | MTSTransactionMode = 0 'NotAnMTSObject 8 | END 9 | Attribute VB_Name = "Loader" 10 | Attribute VB_GlobalNameSpace = False 11 | Attribute VB_Creatable = True 12 | Attribute VB_PredeclaredId = False 13 | Attribute VB_Exposed = True 14 | Option Explicit 15 | 16 | 'Plugin const 17 | Private Const CH_LONGNAME As String = "Complexity Metrics for VB" 18 | Private Const CH_DESCRIPTION As String = "Calculates various code complexity metrics." 19 | Private Const CH_COPYRIGHT As String = "clayreimann@gmail.com" 20 | 21 | Private Const TOOL_GUID As String = "{7140818C-0E51-4DE8-A2DA-873F6E102D5A}" 22 | 23 | Private m_CHCorePtr As Long 24 | Private m_Enabled As Boolean 25 | 26 | Private m_ToolWindow As Window 27 | Private m_MetricsPanel As MetricsPanel 28 | Private m_LastComponent As VBComponent 29 | Private WithEvents m_ComponentEvents As VBComponentsEvents 30 | Attribute m_ComponentEvents.VB_VarHelpID = -1 31 | 32 | Implements ICHPlugin 33 | 34 | Private Property Let ICHPlugin_CHCore(ByVal RHS As Long) 35 | 'Save the Pointer for later use 36 | m_CHCorePtr = RHS 37 | End Property 38 | 39 | Private Property Get ICHPlugin_CopyRight() As String 40 | ICHPlugin_CopyRight = CH_COPYRIGHT 41 | End Property 42 | 43 | Private Property Get ICHPlugin_Description() As String 44 | ICHPlugin_Description = CH_DESCRIPTION 45 | End Property 46 | 47 | Private Property Let ICHPlugin_Enabled(ByVal RHS As Boolean) 48 | 'Enable/disable this plugin in plugin manager 49 | 'if disable the ondisconnect method will be called, and the plugin will be excluded from 50 | 'msg processing 51 | m_Enabled = RHS 52 | End Property 53 | 54 | Private Property Get ICHPlugin_Enabled() As Boolean 55 | 'Enable/disable this plugin in plugin manager 56 | 'if disable the ondisconnect method will be called, and the plugin will be excluded from 57 | 'msg processing 58 | ICHPlugin_Enabled = m_Enabled 59 | End Property 60 | 61 | Private Property Get ICHPlugin_HaveExtendedHelp() As Boolean 62 | 'Enable/disable help button in plugin manager 63 | End Property 64 | 65 | Private Property Get ICHPlugin_HaveProperties() As Boolean 66 | 'Enable/disable properties button in plugin manager 67 | End Property 68 | 69 | Private Property Get ICHPlugin_LongName() As String 70 | ICHPlugin_LongName = CH_LONGNAME 71 | End Property 72 | 73 | Private Property Get ICHPlugin_Name() As String 74 | ICHPlugin_Name = "CHCodeMetrics" 75 | End Property 76 | 77 | Private Sub ICHPlugin_OnConnection(ByVal ConnectMode As CodeHelpDef.ext_ConnectMode, custom() As Variant) 78 | Dim oActiveWin As Window 79 | Dim oCHCore As ICHCore 80 | 81 | Set oCHCore = GetCHCore(m_CHCorePtr) 82 | 83 | Set m_ComponentEvents = oCHCore.VBE.Events.VBComponentsEvents(Nothing) 84 | Set m_ToolWindow = oCHCore.VBE.Windows.CreateToolWindow(oCHCore.AddInInst, "CHCodeComplexity.MetricsPanel", _ 85 | "Metrics", TOOL_GUID, m_MetricsPanel) 86 | 87 | Call m_MetricsPanel.Initalize(oCHCore.VBE) 88 | m_ToolWindow.Visible = True 89 | 90 | Set oCHCore = Nothing 91 | Set oActiveWin = Nothing 92 | End Sub 93 | 94 | Private Sub ICHPlugin_OnDisconnect(ByVal RemoveMode As CodeHelpDef.ext_DisconnectMode, custom() As Variant) 95 | 'Do your clean up here' 96 | Set m_LastComponent = Nothing 97 | Set m_MetricsPanel = Nothing 98 | Set m_ToolWindow = Nothing 99 | Set m_ComponentEvents = Nothing 100 | End Sub 101 | 102 | ' for a discussion of wParam and lParam see https://msdn.microsoft.com/en-us/library/windows/desktop/ms644984(v=vs.85).aspx 103 | Private Sub ICHPlugin_OnKeyHook(bHandled As Boolean, lReturn As Long, wParam As Long, lParam As Long) 104 | Select Case wParam 105 | Case vbKeyM 106 | If (lParam And &HC0000000) = 0 Then ' check for key down messages only 107 | If GetAsyncKeyState(vbKeyControl) Then 108 | lReturn = 1 109 | bHandled = True 110 | If Not m_LastComponent Is Nothing Then Call m_MetricsPanel.UpdateCodeMetrics(m_LastComponent.CodeModule) 111 | End If 112 | End If 113 | 114 | End Select 115 | End Sub 116 | 117 | Private Sub ICHPlugin_OnWinProc(ByVal hWnd As Long, ByVal uMsg As Long, wParam As Long, lParam As Long, _ 118 | bHandled As Boolean, lReturn As Long) 119 | 'subclassed message goes here 120 | End Sub 121 | 122 | Private Sub ICHPlugin_OnWinProcHook(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long, _ 123 | bHandled As Boolean, placeSubclass As Boolean, before As Boolean) 124 | 'Hook msg goes here 125 | End Sub 126 | 127 | Private Sub ICHPlugin_ShowHelp() 128 | 'Show help instruction when user click on help button in plugin manager 129 | End Sub 130 | 131 | Private Sub ICHPlugin_ShowPropertyDialog() 132 | 'show property dialog when user click on properties button in plugin manager 133 | End Sub 134 | 135 | Private Property Get ICHPlugin_Version() As String 136 | ICHPlugin_Version = App.Major & "." & App.Minor & "." & App.Revision 137 | End Property 138 | 139 | Private Sub m_ComponentEvents_ItemActivated(ByVal VBComponent As VBIDE.VBComponent) 140 | Set m_LastComponent = VBComponent 141 | Call CalculateMetrics(VBComponent) 142 | End Sub 143 | 144 | Private Sub m_ComponentEvents_ItemSelected(ByVal VBComponent As VBIDE.VBComponent) 145 | Set m_LastComponent = VBComponent 146 | Call CalculateMetrics(VBComponent) 147 | End Sub 148 | 149 | Private Sub CalculateMetrics(comp As VBComponent) 150 | Call m_MetricsPanel.UpdateCodeMetrics(comp.CodeModule) 151 | End Sub 152 | -------------------------------------------------------------------------------- /MakeInstaller.nsi: -------------------------------------------------------------------------------- 1 | ; installer written for NSIS version 2.46 2 | !include MUI2.nsh 3 | !include Library.nsh 4 | 5 | Name "Code Help - VB6 IDE Extensions" 6 | Outfile "CodeHelpInstaller.exe" 7 | InstallDir "$ProgramFiles\CodeHelp" 8 | RequestExecutionLevel admin 9 | 10 | Function RegisterDotNet 11 | Exch $R0 12 | Push $R1 13 | 14 | ReadRegStr $R1 HKEY_LOCAL_MACHINE "Software\Microsoft\.NETFramework" "InstallRoot" 15 | 16 | IfFileExists "$R1\v4.0.30319\regasm.exe" FileExists 17 | MessageBox MB_ICONSTOP|MB_OK "Microsoft .NET Framework 4.x was not detected!" 18 | Abort 19 | 20 | FileExists: 21 | ExecWait '"$R1\v4.0.30319\regasm.exe" "$R0" /tlb /codebase /silent' 22 | 23 | Pop $R1 24 | Pop $R0 25 | FunctionEnd 26 | 27 | Function UnregisterDotNet 28 | Exch $R0 29 | Push $R1 30 | 31 | ReadRegStr $R1 HKEY_LOCAL_MACHINE "Software\Microsoft\.NETFramework" "InstallRoot" 32 | 33 | IfFileExists "$R1\v4.0.30319\regasm.exe" FileExists 34 | MessageBox MB_ICONSTOP|MB_OK "Microsoft .NET Framework 4.x was not detected!" 35 | Abort 36 | 37 | FileExists: 38 | ExecWait '"$R1\v4.0.30319\regasm.exe" "$R0" /unregister /silent' 39 | 40 | Pop $R1 41 | Pop $R0 42 | FunctionEnd 43 | 44 | !insertmacro MUI_PAGE_DIRECTORY 45 | !insertmacro MUI_PAGE_COMPONENTS 46 | !insertmacro MUI_PAGE_INSTFILES 47 | 48 | !insertmacro MUI_UNPAGE_CONFIRM 49 | !insertmacro MUI_UNPAGE_INSTFILES 50 | 51 | ; Install the non-optional components 52 | Section 53 | ; create the necessary subdirectories 54 | SetOutPath $InstDir\Interfaces 55 | SetOutPath $InstDir\Plugins 56 | SetOutPath $InstDir 57 | 58 | ; setup the stuff the CHCore depends on 59 | !insertmacro InstallLib RegDllTlb NotShared NoReboot_Protected \ 60 | Interfaces\chlib.tlb $InstDir\Interfaces\CHLib.tlb $SYSDIR 61 | !insertmacro InstallLib RegDllTlb NotShared NoReboot_Protected \ 62 | Interfaces\WinApiForVb.tlb $InstDir\Interfaces\WinApiForVb.tlb $SYSDIR 63 | 64 | ; install CHCore 65 | !insertmacro InstallLib RegDll NotShared NoReboot_Protected \ 66 | CHCore\bin\CHGlobalLib.dll $InstDir\CHGlobalLib.dll $SYSDIR 67 | !insertmacro InstallLib RegDll NotShared NoReboot_Protected \ 68 | CHCore\bin\CHCore.dll $InstDir\CHCore.dll $SYSDIR 69 | 70 | ; install the tabs plugin 71 | !insertmacro InstallLib RegDll NotShared NoReboot_Protected \ 72 | CHCore\bin\Plugins\CHTabMDI2.dll $InstDir\Plugins\CHTabMDI2.dll $SYSDIR 73 | 74 | ; tell windows about the uninstaller 75 | WriteRegStr HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\CodeHelp" \ 76 | "DisplayName" "Code Help - VB6 IDE Extensions" 77 | WriteRegStr HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\CodeHelp" \ 78 | "UninstallString" "$\"$INSTDIR\uninstall.exe$\"" 79 | WriteUninstaller uninstall.exe 80 | SectionEnd 81 | 82 | ; install the fullscreen plugin 83 | Section "Fullscreen" 84 | SetOutPath $InstDir 85 | 86 | !insertmacro InstallLib RegDll NotShared NoReboot_Protected \ 87 | CHCore\bin\Plugins\CHFullScreen.dll $InstDir\Plugins\CHFullScreen.dll $SYSDIR 88 | SectionEnd 89 | 90 | ; install the complexity plugin 91 | Section "Code Complexity" 92 | SetOutPath "$InstDir\3rd Party" 93 | SetOutPath $InstDir 94 | 95 | ; register antlr and the CodeAnalysis library 96 | File "/oname=3rd Party\Antlr4.Runtime.dll" Plugins\CHCodeComplexity\Antlr4.Runtime.dll 97 | File "/oname=3rd Party\CodeAnalysis.dll" Plugins\CHCodeComplexity\CodeAnalysis.dll 98 | Push "$InstDir\3rd Party\CodeAnalysis.dll" 99 | Call RegisterDotNet 100 | 101 | !insertmacro InstallLib RegDll NotShared NoReboot_Protected \ 102 | CHCore\bin\Plugins\CHCodeComplexity.dll $InstDir\Plugins\CHCodeComplexity.dll $SYSDIR 103 | SectionEnd 104 | 105 | ; install the comment plugin 106 | Section "Comment/Uncomment" 107 | SetOutPath $InstDir 108 | 109 | ; !insertmacro InstallLib RegDll NotShared NoReboot_Protected \ 110 | ; CHCore\bin\Plugins\CHFullScreen.dll Plugins\CHFullScreen.dll $SYSDIR 111 | SectionEnd 112 | 113 | ; install the snippets plugin 114 | Section "Snippets" 115 | SetOutPath $InstDir 116 | 117 | !insertmacro InstallLib RegDll NotShared NoReboot_Protected \ 118 | CHCore\bin\Plugins\CHCoder.dll Plugins\CHCoder.dll $SYSDIR 119 | File "/oname=Plugins\code_templates.mdb" CHCore\bin\Plugins\code_templates.mdb 120 | SectionEnd 121 | 122 | 123 | ; uninstall everything 124 | Section "Uninstall" 125 | Delete $InstDir\uninstall.exe 126 | 127 | ; remove interfaces 128 | !insertmacro UninstallLib RegDllTlb NotShared NoReboot_Protected $InstDir\Interfaces\CHLib.tlb 129 | !insertmacro UninstallLib RegDllTlb NotShared NoReboot_Protected $InstDir\Interfaces\WinApiForVb.tlb 130 | Delete "$InstDir\Interfaces\CHLib.tlb" 131 | Delete "$InstDir\Interfaces\WinApiForVb.tlb" 132 | RmDir "$InstDir\Interfaces" 133 | 134 | ; remove CHCore 135 | !insertmacro UninstallLib RegDll NotShared NoReboot_Protected $InstDir\CHCore.dll 136 | !insertmacro UninstallLib RegDll NotShared NoReboot_Protected $InstDir\CHGlobalLib.dll 137 | Delete "$InstDir\CHCore.dll" 138 | Delete "$InstDir\CHGlobalLib.dll" 139 | 140 | ; remove plugins 141 | !insertmacro UninstallLib RegDll NotShared NoReboot_Protected $InstDir\Plugins\CHTabMDI2.dll 142 | !insertmacro UninstallLib RegDll NotShared NoReboot_Protected $InstDir\Plugins\CHFullScreen.dll 143 | !insertmacro UninstallLib RegDll NotShared NoReboot_Protected $InstDir\Plugins\CHCodeComplexity.dll 144 | !insertmacro UninstallLib RegDll NotShared NoReboot_Protected $InstDir\Plugins\CHCoder.dll 145 | !insertmacro UninstallLib RegDll NotShared NoReboot_Protected $InstDir\Plugins\CHComment.dll 146 | 147 | Delete "$InstDir\Plugins\CHTabMDI2.dll" 148 | Delete "$InstDir\Plugins\CHFullScreen.dll" 149 | Delete "$InstDir\Plugins\CHCoder.dll" 150 | Delete "$InstDir\Plugins\CHComment.dll" 151 | Delete "$InstDir\Plugins\CHCodeComplexity.dll" 152 | Delete "$InstDir\Plugins\code_templates.mdb" 153 | RmDir "$InstDir\Plugins" 154 | 155 | Delete "$InstDir\3rd Party\Antlr4.Runtime.dll" 156 | Delete "$InstDir\3rd Party\CodeAnalysis.dll" 157 | Delete "$InstDir\3rd Party\CodeAnalysis.tlb" 158 | RmDir "$InstDir\3rd Party" 159 | SectionEnd 160 | -------------------------------------------------------------------------------- /Plugins/CHMWheel/Loader.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | Persistable = 0 'NotPersistable 5 | DataBindingBehavior = 0 'vbNone 6 | DataSourceBehavior = 0 'vbNone 7 | MTSTransactionMode = 0 'NotAnMTSObject 8 | END 9 | Attribute VB_Name = "Loader" 10 | Attribute VB_GlobalNameSpace = False 11 | Attribute VB_Creatable = True 12 | Attribute VB_PredeclaredId = False 13 | Attribute VB_Exposed = True 14 | Option Explicit 15 | 16 | Private Const SCROLL_CLASS = "ScrollBar" 17 | Private m_lPtr As Long 18 | Private m_hMDIClient As Long 19 | Private m_Enabled As Boolean 20 | 21 | Private scrollLines As Long 22 | 23 | Implements ICHPlugin 24 | 25 | Private Property Let ICHPlugin_CHCore(ByVal RHS As Long) 26 | m_lPtr = RHS 27 | End Property 28 | 29 | Private Property Get ICHPlugin_CopyRight() As String 30 | ICHPlugin_CopyRight = "luthv@yahoo.com" 31 | End Property 32 | 33 | Private Property Get ICHPlugin_Description() As String 34 | ICHPlugin_Description = "Provide support for mousewheel in VB Code editor." 35 | End Property 36 | 37 | Private Property Let ICHPlugin_Enabled(ByVal RHS As Boolean) 38 | m_Enabled = RHS 39 | End Property 40 | 41 | Private Property Get ICHPlugin_Enabled() As Boolean 42 | ICHPlugin_Enabled = m_Enabled 43 | End Property 44 | 45 | Private Property Get ICHPlugin_HaveExtendedHelp() As Boolean 46 | 47 | End Property 48 | 49 | Private Property Get ICHPlugin_HaveProperties() As Boolean 50 | ICHPlugin_HaveProperties = True 51 | End Property 52 | 53 | Private Property Get ICHPlugin_LongName() As String 54 | ICHPlugin_LongName = "CodeHelp MouseWheel Support" 55 | End Property 56 | 57 | Private Property Get ICHPlugin_Name() As String 58 | ICHPlugin_Name = App.Title 59 | End Property 60 | 61 | Private Sub ICHPlugin_OnConnection(ByVal ConnectMode As CodeHelpDef.ext_ConnectMode, custom() As Variant) 62 | Dim Dsr As ICHCore 63 | Set Dsr = GetCHCore(m_lPtr) 64 | m_hMDIClient = Dsr.VBE.MainWindow.hWnd 65 | m_hMDIClient = A_FindWindowEx(m_hMDIClient, 0, "MDIClient", vbNullString) 66 | 67 | scrollLines = GetSetting("CodeHelp", ICHPlugin_Name, "ScrollLines", 3) 68 | End Sub 69 | 70 | Private Sub ICHPlugin_OnDisconnect(ByVal RemoveMode As CodeHelpDef.ext_DisconnectMode, custom() As Variant) 71 | 72 | End Sub 73 | 74 | Private Sub ICHPlugin_OnKeyHook(bHandled As Boolean, lreturn As Long, wParam As Long, lParam As Long) 75 | 76 | End Sub 77 | 78 | Private Sub ICHPlugin_OnWinProc(ByVal hWnd As Long, ByVal uMsg As Long, wParam As Long, lParam As Long, bHandled As Boolean, lreturn As Long) 79 | 80 | End Sub 81 | 82 | Private Sub ICHPlugin_OnWinProcHook(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long, bHandled As Boolean, placeSubclass As Boolean, before As Boolean) 83 | Select Case uMsg 84 | Case WM_MOUSEWHEEL 85 | If hWnd = m_hMDIClient Then OnMouseWheel wParam, lParam 86 | End Select 87 | End Sub 88 | 89 | Private Sub ICHPlugin_ShowHelp() 90 | 91 | End Sub 92 | 93 | Private Sub ICHPlugin_ShowPropertyDialog() 94 | Dim dlg As frmProperties 95 | Dim newLines As Long 96 | 97 | On Error GoTo ERR_HANDLER 98 | 99 | Set dlg = New frmProperties 100 | dlg.txtNumber.Text = scrollLines 101 | dlg.Show vbModal 102 | 103 | newLines = CLng(dlg.txtNumber.Text) 104 | If newLines > 0 Then 105 | If newLines <> scrollLines Then 106 | scrollLines = newLines 107 | SaveSetting "CodeHelp", ICHPlugin_Name, "ScrollLines", CStr(newLines) 108 | End If 109 | End If 110 | 111 | ERR_HANDLER: 112 | If Not dlg Is Nothing Then 113 | On Error Resume Next 114 | Unload dlg 115 | End If 116 | End Sub 117 | 118 | Private Property Get ICHPlugin_Version() As String 119 | ICHPlugin_Version = App.Major & "." & App.Minor & "." & App.Revision 120 | End Property 121 | 122 | Private Sub OnMouseWheel(ByVal wParam As Long, ByVal lParam As Long) 123 | Dim delta As Long 124 | Dim lStep As Long 125 | Dim hActive As Long, hScroll As Long 126 | Dim lStyle As Long 127 | Dim i As Long 128 | 129 | 130 | hActive = A_SendMessage(m_hMDIClient, WM_MDIGETACTIVE, 0, ByVal 0) 131 | 132 | hScroll = GetWindow(hActive, GW_CHILD) 133 | 134 | Do While hScroll <> 0 135 | If GetWinText(hScroll, True) = SCROLL_CLASS Then 136 | lStyle = A_GetWindowLong(hScroll, GWL_STYLE) 137 | If (lStyle And SBS_VERT) = SBS_VERT Then 138 | If (lStyle And WS_VISIBLE) = WS_VISIBLE Then 139 | Exit Do 140 | End If 141 | End If 142 | End If 143 | hScroll = GetWindow(hScroll, GW_HWNDNEXT) 144 | Loop 145 | 146 | If hScroll <> 0 Then 147 | 148 | delta = HiWord(wParam) 149 | 150 | If delta > 0 Then 151 | 'lStart = delta * scrollLines 152 | 'For i = -120 To delta Step 120 153 | For i = 1 To scrollLines 154 | A_SendMessage hActive, WM_VSCROLL, MakeDWord(SB_LINEUP, 0), ByVal hScroll 155 | Next 156 | Else 157 | 'For i = delta - 120 To 0 Step 120 158 | For i = 1 To scrollLines 159 | A_SendMessage hActive, WM_VSCROLL, MakeDWord(SB_LINEDOWN, 0), ByVal hScroll 160 | Next 161 | End If 162 | 163 | End If 164 | End Sub 165 | 166 | Private Function GetWinText(hWnd As Long, Optional className As Boolean = False) As String 167 | 'some static vars to speed up things, this func will be called many times 168 | Static sBuffer As String * 128& 'is it safe to use 128 bytes? should be enough.. 169 | Static textLength As Long 170 | 171 | If className Then 172 | textLength = A_GetClassName(hWnd, sBuffer, 129&) 173 | Else 174 | textLength = A_GetWindowText(hWnd, sBuffer, 129&) 175 | End If 176 | 177 | If textLength > 0 Then 178 | GetWinText = Left$(sBuffer, textLength) 179 | End If 180 | 181 | End Function 182 | 183 | Private Function HiWord(lDWord As Long) As Integer 184 | HiWord = (lDWord And &HFFFF0000) \ &H10000 185 | End Function 186 | 187 | Private Function MakeDWord(ByVal LoWord As Integer, ByVal HiWord As Integer) As Long 188 | ' by Karl E. Peterson, http://www.mvps.org/vb, 20001207 189 | ' High word is coerced to Long to allow it to 190 | ' overflow limits of multiplication which shifts 191 | ' it left. 192 | MakeDWord = (CLng(HiWord) * &H10000) Or (LoWord And &HFFFF&) 193 | End Function 194 | 195 | -------------------------------------------------------------------------------- /Plugins/CHTabMDI2/TabPage/TabPaintManager.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | Persistable = 0 'NotPersistable 5 | DataBindingBehavior = 0 'vbNone 6 | DataSourceBehavior = 0 'vbNone 7 | MTSTransactionMode = 0 'NotAnMTSObject 8 | END 9 | Attribute VB_Name = "TabPaintManager" 10 | Attribute VB_GlobalNameSpace = False 11 | Attribute VB_Creatable = True 12 | Attribute VB_PredeclaredId = False 13 | Attribute VB_Exposed = False 14 | Option Explicit 15 | 16 | Private Const LEFT_NAV = 1 17 | Private Const RIGHT_NAV = 2 18 | 19 | Public Enum CloseButtonPosition 20 | CloseButtonHidden = 1 21 | CloseButtonRightMost = 2 22 | CloseButtonOnActive = 4 23 | End Enum 24 | 25 | Private m_oTheme As ITabPainter 26 | Private m_oOwner As TabManager 27 | Private m_eShowCloseButton As CloseButtonPosition 28 | Private m_Buttons(2) As TabItem 'Nav buttons and close button 29 | 30 | Dim oDC As MemoryDC 'For string measurement 31 | Dim bNavShown As Boolean 32 | 33 | Private Sub Class_Initialize() 34 | Set oDC = New MemoryDC 35 | oDC.CreateDC 1, 1 36 | End Sub 37 | 38 | Private Sub Class_Terminate() 39 | Dim i As Long 40 | For i = 0 To 2 41 | Set m_Buttons(i) = Nothing 42 | Next 43 | Set m_oTheme = Nothing 44 | Set m_oOwner = Nothing 45 | Set oDC = Nothing 46 | 47 | End Sub 48 | 49 | 'Public Property Get TabTheme() As ITabPainter 50 | ' Set TabTheme = m_oTheme 51 | 'End Property 52 | 53 | Public Property Set TabTheme(ByVal objTabTheme As ITabPainter) 54 | Set m_oTheme = objTabTheme 55 | End Property 56 | 57 | Public Property Let ShowCloseButton(ByVal eShowCloseButton As CloseButtonPosition) 58 | If m_eShowCloseButton <> eShowCloseButton Then 59 | m_eShowCloseButton = eShowCloseButton 60 | 61 | m_Buttons(0).Visible = (m_eShowCloseButton <> CloseButtonHidden) 62 | m_oOwner.RecalculateLayout 63 | 64 | If Not m_oOwner.SelectedItem Is Nothing Then 65 | m_oOwner.CaptionChanged m_oOwner.SelectedItem.Index 66 | End If 67 | m_oOwner.RequestRedraw 68 | 69 | End If 70 | End Property 71 | 72 | Public Property Get ShowCloseButton() As CloseButtonPosition 73 | ShowCloseButton = m_eShowCloseButton 74 | End Property 75 | 76 | Friend Function GetTabWidth(ByVal item As TabItem) As Long 77 | GetTabWidth = m_oTheme.CalculateTabWidth(item, oDC) 78 | If item.Selected And m_eShowCloseButton = CloseButtonOnActive Then 79 | GetTabWidth = GetTabWidth + 16& 80 | End If 81 | End Function 82 | 83 | Friend Function GetMaxWidth(ByVal lWidth As Long) As Long 84 | 85 | If m_eShowCloseButton = CloseButtonRightMost Then 86 | lWidth = lWidth - 16& 87 | End If 88 | bNavShown = m_oOwner.GetTotalWidth > lWidth 89 | If bNavShown Then 90 | lWidth = lWidth - 34& 91 | End If 92 | GetMaxWidth = lWidth 93 | End Function 94 | 95 | Friend Property Set Owner(objOwner As TabManager) 96 | Set m_oOwner = objOwner 97 | If m_oTheme Is Nothing Then 98 | Set TabTheme = New DefaultPainter 99 | End If 100 | Set m_Buttons(0) = New TabItem 101 | m_Buttons(0).Caption = "r" 102 | m_Buttons(0).Index = 0 'Close Button 103 | 104 | Set m_Buttons(1) = New TabItem 105 | m_Buttons(LEFT_NAV).Index = -1 'Left Nav Button 106 | m_Buttons(LEFT_NAV).Caption = "3" 107 | 108 | Set m_Buttons(2) = New TabItem 109 | m_Buttons(RIGHT_NAV).Index = -2 'Right Nav Button 110 | m_Buttons(RIGHT_NAV).Caption = "4" 111 | End Property 112 | 113 | Friend Sub DrawItem(ByVal oDC As MemoryDC, bounds As RECT, ByVal item As TabItem, ByVal itemType As TabItemType) 114 | Dim tR As RECT 115 | 'pass a copy of the struct since we can not pass byval and the client may wish to modify the bounds 116 | LSet tR = bounds 117 | 118 | If Not item Is Nothing Then 119 | If item.RightMostItem Then 120 | 121 | ExcludeClipRect oDC.hdc, GetMaxWidth(oDC.Width), 0, oDC.Width, oDC.Height 122 | 123 | End If 124 | End If 125 | m_oTheme.DrawItem oDC, tR, item, itemType 126 | 127 | If itemType = DrawTabItem Then 128 | If m_eShowCloseButton = CloseButtonOnActive Then 129 | If item.Selected Then 130 | tR.Left = bounds.Right - 18& 131 | tR.Right = tR.Left + 14& 132 | tR.Top = bounds.Top + 5& 133 | tR.Bottom = bounds.Bottom - 3& 134 | m_Buttons(0).Width = tR.Left ' Borrow width property to store left coord for hittest 135 | m_oTheme.DrawItem oDC, tR, m_Buttons(0), DrawCloseButton 136 | End If 137 | End If 138 | 139 | ElseIf itemType = DrawBackGround Then 140 | If m_eShowCloseButton = CloseButtonRightMost Then 141 | tR.Left = bounds.Right - 16& 142 | tR.Right = tR.Left + 14& 143 | tR.Top = bounds.Top + 5& 144 | tR.Bottom = bounds.Bottom - 3& 145 | m_Buttons(0).Width = tR.Left ' Borrow width property to store left coord for hittest 146 | m_oTheme.DrawItem oDC, tR, m_Buttons(0), DrawCloseButton 147 | End If 148 | 149 | 150 | If m_Buttons(LEFT_NAV).Visible Then 151 | If m_eShowCloseButton = CloseButtonRightMost Then 152 | tR.Left = bounds.Right - 32& 153 | Else 154 | tR.Left = bounds.Right - 16& 155 | End If 156 | tR.Right = tR.Left + 14& 157 | tR.Top = bounds.Top + 5& 158 | tR.Bottom = bounds.Bottom - 3& 159 | m_Buttons(RIGHT_NAV).Width = tR.Left ' Borrow width property to store left coord for hittest 160 | 161 | m_oTheme.DrawItem oDC, tR, m_Buttons(RIGHT_NAV), DrawNavRightButton 162 | 163 | tR.Left = tR.Left - 16& 164 | tR.Right = tR.Left + 14& 165 | tR.Top = bounds.Top + 5& 166 | tR.Bottom = bounds.Bottom - 3& 167 | m_Buttons(LEFT_NAV).Width = tR.Left ' Borrow width property to store left coord for hittest 168 | m_oTheme.DrawItem oDC, tR, m_Buttons(LEFT_NAV), DrawNavLeftButton 169 | End If 170 | End If 171 | End Sub 172 | 173 | Friend Sub DrawShortcut(ByVal oDC As MemoryDC, bounds As RECT, ByVal item As TabItem, ByVal visibleIndex As Long) 174 | m_oTheme.DrawShortcut oDC, bounds, item, visibleIndex 175 | End Sub 176 | 177 | Friend Function ButtonHittest(ByVal x As Long, ByVal y As Long) As TabItem 178 | Dim i As Long, item As TabItem 179 | Dim tR As RECT 180 | 'iterate only in visible boundary 181 | tR.Top = m_oOwner.Top + 3 182 | tR.Bottom = m_oOwner.Top + 19 183 | 184 | For i = 0 To 2 185 | Set item = m_Buttons(i) 186 | If item.Visible Then 187 | tR.Left = m_oOwner.Left + item.Width 'use width property as left coord 188 | tR.Right = tR.Left + 14& 189 | If PtInRect(tR, x, y) Then 190 | Set ButtonHittest = item 191 | Exit For 192 | End If 193 | End If 194 | Next 195 | End Function 196 | 197 | Friend Sub LayoutChanged() 198 | If bNavShown Then 199 | m_Buttons(RIGHT_NAV).Enabled = False 200 | 201 | 'Check whether it's partially displayed 202 | If m_oOwner.LastItem > 1 Then 203 | If m_oOwner.IsOffScreenToTheRight(m_oOwner.LastItem, GetMaxWidth(m_oOwner.Width)) Then 204 | m_Buttons(RIGHT_NAV).Enabled = True 205 | ElseIf m_oOwner.LastItem < m_oOwner.VisibleTabCount Then 206 | m_Buttons(RIGHT_NAV).Enabled = True 207 | End If 208 | ' End If 209 | End If 210 | 211 | 'Check whether it's partially displayed 212 | 213 | m_Buttons(LEFT_NAV).Enabled = (m_oOwner.StartItem > 1) Or (m_oOwner.LeftItemOffset <> 0) 214 | End If 215 | m_Buttons(LEFT_NAV).Visible = bNavShown 216 | m_Buttons(RIGHT_NAV).Visible = bNavShown 217 | 218 | End Sub 219 | -------------------------------------------------------------------------------- /Plugins/TabIndex/Loader.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | Persistable = 0 'NotPersistable 5 | DataBindingBehavior = 0 'vbNone 6 | DataSourceBehavior = 0 'vbNone 7 | MTSTransactionMode = 0 'NotAnMTSObject 8 | END 9 | Attribute VB_Name = "Loader" 10 | Attribute VB_GlobalNameSpace = False 11 | Attribute VB_Creatable = True 12 | Attribute VB_PredeclaredId = False 13 | Attribute VB_Exposed = True 14 | Option Explicit 15 | 16 | 'Plugin const 17 | Private Const CH_LONGNAME As String = "TabIndex Editor" 18 | Private Const CH_DESCRIPTION As String = "Reorder form's controls tab index" 19 | Private Const CH_COPYRIGHT As String = "luthv@yahoo.com" 20 | 21 | Private Const HH_DISPLAY_TOPIC = &H0 22 | Private Declare Function HtmlHelp Lib "hhctrl.ocx" Alias "HtmlHelpA" (ByVal hwndCaller As Long, ByVal pszFile As String, ByVal uCommand As Long, ByVal dwData As Long) As Long 23 | 24 | Private m_lPtr As Long 25 | Private m_Enabled As Boolean 26 | 27 | Implements ICHPlugin 28 | 29 | Private WithEvents Trap As MouseTrap 30 | Attribute Trap.VB_VarHelpID = -1 31 | Private m_TrapPlaced As Boolean 32 | Private m_MenuItem As CommandBarControl 33 | Private WithEvents codeBarEvents As VBIDE.CommandBarEvents 34 | Attribute codeBarEvents.VB_VarHelpID = -1 35 | 36 | Private Property Let ICHPlugin_CHCore(ByVal RHS As Long) 37 | 'Save the Pointer for later use 38 | m_lPtr = RHS 39 | End Property 40 | 41 | Private Property Get ICHPlugin_CopyRight() As String 42 | ICHPlugin_CopyRight = CH_COPYRIGHT 43 | End Property 44 | 45 | Private Property Get ICHPlugin_Description() As String 46 | ICHPlugin_Description = CH_DESCRIPTION 47 | End Property 48 | 49 | Private Property Get ICHPlugin_HaveExtendedHelp() As Boolean 50 | ICHPlugin_HaveExtendedHelp = True 51 | End Property 52 | 53 | Private Property Get ICHPlugin_HaveProperties() As Boolean 54 | 55 | End Property 56 | 57 | Private Property Get ICHPlugin_LongName() As String 58 | ICHPlugin_LongName = CH_LONGNAME 59 | End Property 60 | 61 | Private Property Get ICHPlugin_Name() As String 62 | ICHPlugin_Name = App.Title 63 | End Property 64 | 65 | Private Sub ICHPlugin_OnConnection(ByVal ConnectMode As CodeHelpDef.ext_ConnectMode, _ 66 | custom() As Variant) 67 | 68 | 'Sample use of the ICHCore pointer 69 | 'It's advisable not to save the ICHCore object itself, always use the helper function to obtain the 70 | 'ICHCore object from the pointer 71 | 72 | Dim dsr As ICHCore 73 | 74 | Set dsr = GetCHCore(m_lPtr) 75 | 76 | 'Do your initializing stuff here 77 | 'create menu item if this is the first onconnect event 78 | If m_MenuItem Is Nothing Then 79 | Set m_MenuItem = dsr.AddToCodeHelpMenu("Tab Order", LoadResPicture(101, vbResIcon)) 80 | 81 | Set codeBarEvents = dsr.VBE.Events.CommandBarEvents(m_MenuItem) 82 | End If 83 | m_MenuItem.Enabled = m_Enabled 84 | End Sub 85 | 86 | Private Sub ICHPlugin_OnDisconnect(ByVal RemoveMode As CodeHelpDef.ext_DisconnectMode, _ 87 | custom() As Variant) 88 | 'Do your clean up here 89 | If Not m_MenuItem Is Nothing Then 90 | m_MenuItem.Enabled = False 91 | Set m_MenuItem = Nothing 92 | End If 93 | End Sub 94 | 95 | Private Sub ICHPlugin_OnKeyHook(bHandled As Boolean, _ 96 | lReturn As Long, _ 97 | wParam As Long, _ 98 | lParam As Long) 99 | 'do any keyboard related code here 100 | If m_TrapPlaced Then 101 | If wParam = vbKeyEscape Then 102 | ShowHideTrap 103 | End If 104 | End If 105 | End Sub 106 | 107 | Private Sub ICHPlugin_OnWinProc(ByVal hwnd As Long, _ 108 | ByVal uMsg As Long, _ 109 | wParam As Long, _ 110 | lParam As Long, _ 111 | bHandled As Boolean, _ 112 | lReturn As Long) 113 | If m_TrapPlaced Then 114 | Trap.TrapProc True, bHandled, lReturn, hwnd, uMsg, wParam, lParam 115 | End If 116 | 117 | End Sub 118 | 119 | Private Sub ICHPlugin_OnWinProcHook(ByVal hwnd As Long, _ 120 | ByVal uMsg As Long, _ 121 | ByVal wParam As Long, _ 122 | ByVal lParam As Long, _ 123 | bHandled As Boolean, _ 124 | placeSubclass As Boolean, _ 125 | before As Boolean) 126 | 'Hook msg goes here 127 | 128 | If m_TrapPlaced Then 129 | If hwnd = Trap.hWndTrap Then 130 | Select Case uMsg 131 | Case WM_NCHITTEST, WM_LBUTTONDOWN, WM_MOUSEMOVE, WM_RBUTTONDOWN, _ 132 | WM_SYSCOMMAND, WM_SETCURSOR 133 | 134 | placeSubclass = True 135 | End Select 136 | 137 | ElseIf hwnd = Trap.hWndForm Then 138 | If uMsg = WM_DESTROY Then 139 | Trap.TrapProc True, False, 0, hwnd, uMsg, wParam, lParam 140 | End If 141 | 142 | ElseIf hwnd = Trap.hWndFormDesigner Then 143 | If uMsg = WM_DRAWITEM Then 144 | placeSubclass = True 145 | before = False 146 | End If 147 | End If 148 | End If 149 | End Sub 150 | 151 | Private Sub ICHPlugin_ShowHelp() 152 | HtmlHelp 0, App.Path & "\" & ICHPlugin_Name & ".chm", HH_DISPLAY_TOPIC, 0 153 | 'MsgBox "Use left mouse button to assign tab index, first control clicked will have " 154 | End Sub 155 | 156 | Private Sub ICHPlugin_ShowPropertyDialog() 157 | 158 | End Sub 159 | 160 | Private Property Get ICHPlugin_Version() As String 161 | ICHPlugin_Version = App.Major & "." & App.Minor & "." & App.Revision 162 | End Property 163 | 164 | Private Property Let ICHPlugin_Enabled(ByVal RHS As Boolean) 165 | m_Enabled = RHS 166 | End Property 167 | 168 | Private Property Get ICHPlugin_Enabled() As Boolean 169 | ICHPlugin_Enabled = m_Enabled 170 | End Property 171 | 'End of ICHPlugin Implementation************************************************ 172 | 173 | 174 | Private Sub Hide() 175 | 176 | On Error Resume Next 177 | If m_TrapPlaced Then 178 | 'Unload Trap 179 | Set Trap = Nothing 180 | m_TrapPlaced = False 181 | End If 182 | 183 | End Sub 184 | 185 | Private Sub Show() 186 | 187 | Dim vbComp As VBComponent 188 | Dim dsr As ICHCore 189 | 190 | Set dsr = GetCHCore(m_lPtr) 191 | 192 | Set vbComp = dsr.VBE.SelectedVBComponent 193 | If Not vbComp Is Nothing Then 194 | If vbComp.HasOpenDesigner Then 195 | Select Case vbComp.Type 196 | 197 | Case vbext_ct_VBForm, vbext_ct_VBMDIForm, vbext_ct_UserControl, vbext_ct_DocObject 198 | 199 | Set Trap = New MouseTrap 200 | 201 | Set Trap.FormDesigner = vbComp.Designer 202 | Set Trap.ParentWindow = vbComp.DesignerWindow 203 | 204 | m_TrapPlaced = True 205 | Trap.ShowTabOrder 206 | End Select 207 | 208 | End If 209 | End If 210 | End Sub 211 | 212 | Private Sub codeBarEvents_Click(ByVal CommandBarControl As Object, handled As Boolean, CancelDefault As Boolean) 213 | ShowHideTrap 214 | End Sub 215 | 216 | Private Sub Trap_Closed() 217 | ShowHideTrap 218 | End Sub 219 | 220 | Private Sub ShowHideTrap() 221 | Dim cbButton As CommandBarButton 222 | Set cbButton = m_MenuItem 223 | If m_TrapPlaced = False Then 224 | Show 225 | If m_TrapPlaced Then cbButton.State = msoButtonDown 226 | Else 227 | Hide 228 | cbButton.State = msoButtonUp 229 | End If 230 | End Sub 231 | -------------------------------------------------------------------------------- /Plugins/CHTabMDI2/TabPage/frmTest.frm: -------------------------------------------------------------------------------- 1 | VERSION 5.00 2 | Begin VB.Form frmTest 3 | Caption = "Form1" 4 | ClientHeight = 3195 5 | ClientLeft = 60 6 | ClientTop = 345 7 | ClientWidth = 4680 8 | LinkTopic = "Form1" 9 | ScaleHeight = 3195 10 | ScaleWidth = 4680 11 | StartUpPosition = 3 'Windows Default 12 | Begin VB.CommandButton cmdVisible 13 | Caption = "Toggle Visible" 14 | Height = 330 15 | Left = 720 16 | TabIndex = 8 17 | Top = 2520 18 | Width = 1215 19 | End 20 | Begin VB.CommandButton cmdAdd 21 | Caption = "Add" 22 | Height = 330 23 | Left = 765 24 | TabIndex = 7 25 | Top = 1350 26 | Width = 1185 27 | End 28 | Begin VB.Frame Frame1 29 | Caption = "Close Button:" 30 | Height = 1365 31 | Left = 2160 32 | TabIndex = 3 33 | Top = 900 34 | Width = 1995 35 | Begin VB.OptionButton optCloseButton 36 | Caption = "On Active Tab" 37 | Height = 285 38 | Index = 4 39 | Left = 180 40 | TabIndex = 6 41 | Top = 900 42 | Width = 1455 43 | End 44 | Begin VB.OptionButton optCloseButton 45 | Caption = "Right Most" 46 | Height = 285 47 | Index = 2 48 | Left = 180 49 | TabIndex = 5 50 | Top = 607 51 | Width = 1230 52 | End 53 | Begin VB.OptionButton optCloseButton 54 | Caption = "Hidden" 55 | Height = 285 56 | Index = 0 57 | Left = 180 58 | TabIndex = 4 59 | Top = 315 60 | Value = -1 'True 61 | Width = 1050 62 | End 63 | End 64 | Begin VB.CommandButton cmdDelete 65 | Caption = "Delete Active" 66 | Height = 330 67 | Left = 720 68 | TabIndex = 2 69 | Top = 2040 70 | Width = 1215 71 | End 72 | Begin VB.CommandButton Command1 73 | Caption = "Activate" 74 | Height = 330 75 | Left = 780 76 | TabIndex = 1 77 | Top = 915 78 | Width = 1185 79 | End 80 | Begin VB.TextBox Text1 81 | Height = 330 82 | Left = 150 83 | TabIndex = 0 84 | Text = "15" 85 | Top = 915 86 | Width = 600 87 | End 88 | Begin VB.Menu mnuPop 89 | Caption = "" 90 | Visible = 0 'False 91 | Begin VB.Menu mnuCloseItem 92 | Caption = "&Close" 93 | End 94 | Begin VB.Menu mnuCloseAll 95 | Caption = "Close &All" 96 | End 97 | Begin VB.Menu mnuCloseButActive 98 | Caption = "Close All &But Active" 99 | End 100 | Begin VB.Menu mnuPopSeparator 101 | Caption = "-" 102 | End 103 | Begin VB.Menu mnuButtons 104 | Caption = "Buttons" 105 | Begin VB.Menu mnuClosePop 106 | Caption = "Close Button" 107 | Begin VB.Menu mnuClosePosition 108 | Caption = "Hidden" 109 | Checked = -1 'True 110 | Index = 0 111 | End 112 | Begin VB.Menu mnuClosePosition 113 | Caption = "Rightmost" 114 | Index = 2 115 | End 116 | Begin VB.Menu mnuClosePosition 117 | Caption = "On Active Tab" 118 | Index = 4 119 | End 120 | End 121 | Begin VB.Menu mnuNavButtons 122 | Caption = "Navigation Buttons" 123 | End 124 | End 125 | End 126 | End 127 | Attribute VB_Name = "frmTest" 128 | Attribute VB_GlobalNameSpace = False 129 | Attribute VB_Creatable = False 130 | Attribute VB_PredeclaredId = True 131 | Attribute VB_Exposed = False 132 | Option Explicit 133 | 134 | Dim WithEvents tabMgr As TabManager 135 | Attribute tabMgr.VB_VarHelpID = -1 136 | 137 | Private Sub cmdAdd_Click() 138 | tabMgr.InsertItem Text1.Text 139 | End Sub 140 | 141 | Private Sub cmdDelete_Click() 142 | tabMgr.RemoveItem tabMgr.SelectedItem 143 | End Sub 144 | 145 | Private Sub cmdVisible_Click() 146 | Dim i As Long 147 | 148 | i = CLng(Text1.Text) 149 | If tabMgr.Items.Exists("#" & i) Then 150 | tabMgr.Items(i).Visible = Not tabMgr.Items(i).Visible 151 | End If 152 | End Sub 153 | 154 | Private Sub Command1_Click() 155 | Dim i As Long 156 | 157 | i = CLng(Text1.Text) 158 | If tabMgr.Items.Exists("#" & i) Then 159 | tabMgr.Items(i).Selected = True 160 | End If 161 | End Sub 162 | 163 | 164 | Private Sub Form_Load() 165 | Set tabMgr = New TabManager 166 | Dim i As Long 167 | Dim item As TabItem 168 | 169 | Form_Resize 170 | 171 | For i = 1 To 100 172 | Set item = tabMgr.InsertItem("Hello " & i) 173 | Next 174 | 175 | tabMgr.Top = 20 176 | 'tabMgr.Items(1).Selected = True 177 | 178 | End Sub 179 | 180 | Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) 181 | If Button = vbLeftButton Then 182 | 'GetKeyState VB 183 | tabMgr.OnLMouseDown ScaleX(x, ScaleMode, vbPixels), ScaleY(y, ScaleMode, vbPixels) 184 | End If 185 | End Sub 186 | 187 | Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) 188 | tabMgr.OnMouseMove Button, ScaleX(x, ScaleMode, vbPixels), ScaleY(y, ScaleMode, vbPixels) 189 | End Sub 190 | 191 | Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single) 192 | 193 | tabMgr.OnMouseUp Button, ScaleX(x, ScaleMode, vbPixels), ScaleY(y, ScaleMode, vbPixels) 194 | 195 | End Sub 196 | 197 | Private Sub Form_Paint() 198 | tabMgr.Refresh hdc 199 | End Sub 200 | 201 | Private Sub Form_Resize() 202 | tabMgr.Width = ScaleX(ScaleWidth, ScaleMode, vbPixels) 203 | 204 | End Sub 205 | 206 | Private Sub Form_Unload(Cancel As Integer) 207 | Set tabMgr = Nothing 208 | End Sub 209 | 210 | Private Sub mnuCloseAll_Click() 211 | 212 | tabMgr.RemoveAll True 213 | 214 | End Sub 215 | 216 | Private Sub mnuCloseButActive_Click() 217 | tabMgr.RemoveAllButActive 218 | End Sub 219 | 220 | Private Sub mnuCloseItem_Click() 221 | Dim item As TabItem 222 | 223 | Set item = tabMgr.Items("#" & mnuCloseItem.Tag) 224 | tabMgr.RemoveItem item 225 | End Sub 226 | 227 | Private Sub mnuClosePosition_Click(Index As Integer) 228 | optCloseButton_Click (Index) 229 | End Sub 230 | 231 | Private Sub optCloseButton_Click(Index As Integer) 232 | Dim i As Long 233 | 234 | For i = 0 To 4 Step 2 235 | optCloseButton(i).Value = (Index = i) 236 | mnuClosePosition(i).Checked = (Index = i) 237 | Next 238 | tabMgr.PaintManager.ShowCloseButton = Index 239 | End Sub 240 | 241 | Private Sub tabMgr_MouseUp(ByVal Button As MouseButtonConstants, ByVal item As TabItem) 242 | If Button = vbRightButton Then 243 | 'item can be nothing if user click on empty space 244 | mnuCloseItem.Enabled = Not (item Is Nothing) 245 | If mnuCloseItem.Enabled Then mnuCloseItem.Tag = item.Index 246 | mnuCloseButActive.Enabled = (tabMgr.Items.Count > 1) 247 | mnuCloseAll.Enabled = mnuCloseButActive.Enabled 248 | PopupMenu mnuPop 249 | End If 250 | End Sub 251 | 252 | Private Sub tabMgr_RequestRedraw(hdc As Long) 253 | hdc = Me.hdc 254 | End Sub 255 | -------------------------------------------------------------------------------- /Plugins/CHTabMDI2/TabPage/cTimer.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | Persistable = 0 'NotPersistable 5 | DataBindingBehavior = 0 'vbNone 6 | DataSourceBehavior = 0 'vbNone 7 | MTSTransactionMode = 0 'NotAnMTSObject 8 | END 9 | Attribute VB_Name = "cTimer" 10 | Attribute VB_GlobalNameSpace = False 11 | Attribute VB_Creatable = True 12 | Attribute VB_PredeclaredId = False 13 | Attribute VB_Exposed = False 14 | '================================================================================================== 15 | 'cTimer - module-less, IDE safe, machine code timer thunk 16 | ' 17 | 'Paul_Caton@hotmail.com 18 | 'Copyright free, use and abuse as you see fit. 19 | ' 20 | 'v1.00 20030107 First cut.......................................................................... 21 | 'v1.01 20031118 Allow control over callback gating 22 | ' Use global memory for the machine code buffer 23 | ' Reform the assembler............................................................... 24 | 'v1.02 20040118 Use EbMode for breakpoint/stop detection rather than callback gating 25 | ' Further reform the assembler for greater speed and smaller size 26 | ' Made InIDE public.................................................................. 27 | 'v1.03 20040210 Added support for an Optional ID to indentify amongst multiple timers.............. 28 | '================================================================================================== 29 | Option Explicit 30 | 31 | Private Declare Function GetProcAddress Lib "kernel32.dll" (ByVal hModule As Long, ByVal lpProcName As String) As Long 32 | 33 | Private nTimerID As Long 'Timer ID 34 | Private nAddrTmr As Long 'The address of our timer thunk 35 | 36 | '============================================ 37 | 'Class creation/destruction 38 | '============================================ 39 | 40 | 'Build the timer thunk into allocated memory 41 | Private Sub Class_Initialize() 42 | Const PATCH_01 As Long = 3 'Code buffer offset to the location of the relative address to EbMode 43 | Const PATCH_05 As Long = 52 'Code buffer offset to the location of the relative address to KillTimer 44 | Const FUNC_EBM As String = "EbMode" 'VBA's EbMode function allows the machine code thunk know if the IDE has stopped or is on a breakpoint 45 | Const FUNC_KIL As String = "KillTimer" 'KillTimer allows the cTimer machine code thunk to kill the timer itself if it detects via the EbMode function that the IDE has stopped 46 | Const MOD_VBA5 As String = "vba5" 'Location of the EbMode function if running VB5 47 | Const MOD_VBA6 As String = "vba6" 'Location of the EbMode function if running VB6 48 | Const MOD_USER As String = "user32" 'Location of the KillTimer function 49 | Dim i As Long 'Loop index 50 | Dim nLen As Long 'String length 51 | Dim sHex As String 'Hex code representation of the machine code 52 | Dim sCode As String 'ASCII string, holds the machine code before copying to allocated memory 53 | 54 | 'Store the hex pair machine code representation in sHex 55 | sHex = "EB0EE8xxxxx01x83F802741E85C0741D68xxxxx02x8B4424142Dxxxxx03x50B8xxxxx04x508B00FF501CC210008B4C240C5150E8xxxxx05xEBF0" 56 | nLen = Len(sHex) 'Length of the hex pair string 57 | 58 | 'Convert the code string from hex pairs to bytes and store in the ASCII string opcode buffer 59 | For i = 1 To nLen Step 2 'For each pair of hex characters 60 | sCode = sCode & ChrB$(Val("&H" & Mid$(sHex, i, 2))) 'Convert a pair of hex characters to a byte and append to the ASCII string 61 | Next i 'Next pair 62 | 63 | nLen = LenB(sCode) 'Get the machine code length 64 | nAddrTmr = GlobalAlloc(0, nLen) 'Allocate fixed memory for for the machine code buffer 65 | 66 | 'Copy the code to allocated memory 67 | Call CopyMemory(ByVal nAddrTmr, ByVal StrPtr(sCode), nLen) 68 | 69 | If InIDE Then 70 | 'Patch the jmp (EB0E) with two nop's (90) enabling the IDE breakpoint/stop checking code 71 | Call CopyMemory(ByVal nAddrTmr, &H9090, 2) 72 | 73 | i = AddrFunc(MOD_VBA6, FUNC_EBM) 'Get the address of EbMode in vba6.dll 74 | If i = 0 Then 'Found? 75 | i = AddrFunc(MOD_VBA5, FUNC_EBM) 'VB5 perhaps, try vba5.dll 76 | End If 77 | 78 | Debug.Assert i 'Ensure the EbMode function was found 79 | Call PatchRel(PATCH_01, i) 'Patch the relative address to the EbMode api function 80 | End If 81 | 82 | Call PatchRel(PATCH_05, AddrFunc(MOD_USER, FUNC_KIL)) 'Patch the relative address to the KillTimer api function 83 | End Sub 84 | 85 | 'Stop the timer and release the allocated memory 86 | Private Sub Class_Terminate() 87 | Call Me.TmrStop 'Kill the timer 88 | Call GlobalFree(nAddrTmr) 'Release the allocated memory 89 | End Sub 90 | 91 | '============================================ 92 | 'Public interface 93 | '============================================ 94 | 95 | 'Return whether we're running in the IDE. Public for general utility purposes 96 | Public Function InIDE() As Boolean 97 | Debug.Assert SetTrue(InIDE) 98 | End Function 99 | 100 | 'Start the timer 101 | Public Function TmrStart(ByVal Owner As ITimer, _ 102 | ByVal nInterval As Long, _ 103 | Optional ByVal nID As Long = 0) As Boolean 104 | Const PATCH_02 As Long = 17 'Timer ID 105 | Const PATCH_03 As Long = 26 'Code buffer offset to the location of the timer start time 106 | Const PATCH_04 As Long = 32 'Code buffer offset to the location of the owner object address 107 | 108 | If nTimerID = 0 Then 109 | Call PatchVal(PATCH_02, nID) 'Set the Timer ID - Allows the programmer to distinguish amongst multiple timers 110 | Call PatchVal(PATCH_03, GetTickCount) 'Set the start time 111 | Call PatchVal(PATCH_04, ObjPtr(Owner)) 'Owner object address for iTimer_Proc 112 | 113 | 'Create the timer 114 | nTimerID = SetTimer(0, 0, nInterval, nAddrTmr) 115 | TmrStart = (nTimerID <> 0) 'nTimer ID is non-zero on success 116 | End If 117 | If TmrStart = False Then 118 | Debug.Print "Timer Failed" 119 | End If 120 | 'Debug.Assert TmrStart 'Let programmer know if TmrStart failed 121 | End Function 122 | 123 | 'Stop the timer 124 | Public Function TmrStop() As Boolean 125 | If nTimerID <> 0 Then 126 | If KillTimer(0, nTimerID) <> 0 Then 'Kill the timer 127 | nTimerID = 0 'Indicate the timer is inactive 128 | TmrStop = True 129 | End If 130 | Else 131 | TmrStop = True 'Timer wasn't running, but that's no cause for complaint 132 | End If 133 | 134 | Debug.Assert TmrStop 'Let programmer know if TmrStop failed 135 | End Function 136 | 137 | '============================================ 138 | 'Private interface 139 | '============================================ 140 | 141 | 'Return the address of the passed function in the passed dll 142 | Private Function AddrFunc(ByVal sDLL As String, _ 143 | ByVal sProc As String) As Long 144 | AddrFunc = GetProcAddress(A_GetModuleHandle(sDLL), sProc) 145 | 146 | 'You may want to comment out the following line if you're using vb5 else the EbMode 147 | 'GetProcAddress will stop here everytime because we look in vba6.dll first 148 | Debug.Assert AddrFunc 149 | End Function 150 | 151 | 'Patch the machine code buffer offset with the relative address to the target address 152 | Private Sub PatchRel(ByVal nOffset As Long, _ 153 | ByVal nTargetAddr As Long) 154 | Call CopyMemory(ByVal (nAddrTmr + nOffset), nTargetAddr - nAddrTmr - nOffset - 4, 4) 155 | End Sub 156 | 157 | 'Patch the machine code buffer offset with the passed value 158 | Private Sub PatchVal(ByVal nOffset As Long, _ 159 | ByVal nValue As Long) 160 | Call CopyMemory(ByVal (nAddrTmr + nOffset), nValue, 4) 161 | End Sub 162 | 163 | 'Worker function for InIDE - will only be called whilst running in the IDE 164 | Private Function SetTrue(ByRef bValue As Boolean) As Boolean 165 | bValue = True 166 | SetTrue = True 167 | End Function 168 | -------------------------------------------------------------------------------- /Plugins/CHFullScreen/FullScreen.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | Persistable = 0 'NotPersistable 5 | DataBindingBehavior = 0 'vbNone 6 | DataSourceBehavior = 0 'vbNone 7 | MTSTransactionMode = 0 'NotAnMTSObject 8 | END 9 | Attribute VB_Name = "FullScreen" 10 | Attribute VB_GlobalNameSpace = False 11 | Attribute VB_Creatable = True 12 | Attribute VB_PredeclaredId = False 13 | Attribute VB_Exposed = True 14 | Option Explicit 15 | 16 | 'Plugin const 17 | Private Const CH_LONGNAME As String = "CodeHelp Full Screen Code Editor" 18 | Private Const CH_DESCRIPTION As String = "Provide Full Screen view capability for VB IDE" 19 | Private Const CH_COPYRIGHT As String = "luthv@yahoo.com" 20 | 21 | Private m_hiddenWindows As Collection 22 | Private m_cmdBar As CommandBar 23 | Private m_MenuItem As CommandBarControl 24 | 25 | Private WithEvents cmdBarEvents As VBIDE.CommandBarEvents 26 | Attribute cmdBarEvents.VB_VarHelpID = -1 27 | Private WithEvents codeBarEvents As VBIDE.CommandBarEvents 28 | Attribute codeBarEvents.VB_VarHelpID = -1 29 | 30 | Private m_hWnd As Long 31 | Private m_CHCorePtr As Long 32 | Private m_IsInFullScreen As Boolean 33 | Private m_IsMaximized As Boolean 34 | Private m_IsEnabled As Boolean 35 | 36 | Implements ICHPlugin 37 | 38 | Private Sub Invoke() 39 | On Error Resume Next 40 | Dim btnMenu As CommandBarButton 41 | 42 | Set btnMenu = m_MenuItem 43 | If m_IsInFullScreen = False Then 44 | Call EnterFullScreen 45 | btnMenu.State = msoButtonDown 46 | Else 47 | Call ExitFullScreen 48 | btnMenu.State = msoButtonUp 49 | End If 50 | 51 | m_IsInFullScreen = Not m_IsInFullScreen 52 | 53 | 'Redraw Frame 54 | Call SetWindowPos(m_hWnd, 0, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE Or SWP_NOZORDER Or SWP_FRAMECHANGED) 55 | 56 | End Sub 57 | 58 | Private Sub EnterFullScreen() 59 | If IsWindow(m_hWnd) = 0 Then Exit Sub 60 | 61 | Dim win As Window 62 | Dim cmb As CommandBar 63 | Dim vbeInst As VBE 64 | Dim oCHCore As ICHCore 65 | 66 | Set m_hiddenWindows = New Collection 67 | 68 | Set oCHCore = GetCHCore(m_CHCorePtr) 69 | Set vbeInst = oCHCore.VBE 70 | 71 | For Each win In vbeInst.Windows 72 | Select Case win.Type 73 | Case vbext_wt_CodeWindow, vbext_wt_Designer 74 | 75 | Case Else 76 | If win.Visible Then 77 | win.Visible = False 78 | Call m_hiddenWindows.Add(win) 79 | End If 80 | 81 | End Select 82 | Next 83 | 84 | For Each cmb In vbeInst.CommandBars 85 | If cmb.Name <> "Menu Bar" Then 86 | If cmb.Visible Then 87 | cmb.Visible = False 88 | Call m_hiddenWindows.Add(cmb) 89 | End If 90 | End If 91 | Next 92 | 93 | If m_cmdBar Is Nothing Then 94 | Dim picIcon As StdPicture 95 | Dim picBmp As StdPicture 96 | 97 | Dim cmdCtl As CommandBarButton 98 | 99 | Set picIcon = LoadResPicture(101, vbResIcon) 100 | 101 | Set m_cmdBar = vbeInst.CommandBars.Add("FullScreen") 102 | m_cmdBar.Position = msoBarFloating 103 | 104 | Set cmdCtl = m_cmdBar.Controls.Add(msoControlButton) 105 | cmdCtl.Caption = "Exit Fullscreen" 106 | cmdCtl.Style = msoButtonIconAndCaption 107 | 108 | On Error Resume Next 'Clipboard could be locked by other application 109 | Call Clipboard.Clear 110 | Call cmdCtl.CopyFace 111 | 112 | Set picBmp = Clipboard.GetData 113 | 114 | Call CopyIconToClipBoardAsBmp(picIcon, picBmp) 115 | Call cmdCtl.PasteFace 116 | Call Clipboard.Clear 117 | 118 | Set picIcon = Nothing 119 | Set picBmp = Nothing 120 | 121 | m_cmdBar.Protection = msoBarNoChangeDock 122 | m_cmdBar.Top = 0 123 | m_cmdBar.Left = (Screen.Width \ Screen.TwipsPerPixelX) - m_cmdBar.Width 124 | Set cmdBarEvents = vbeInst.Events.CommandBarEvents(m_cmdBar.Controls(1)) 125 | 126 | End If 127 | 128 | m_cmdBar.Visible = True 129 | 130 | 'save state 131 | m_IsMaximized = IsZoomed(m_hWnd) 132 | 133 | If Not m_IsMaximized Then Call ShowWindow(m_hWnd, SW_MAXIMIZE) 134 | Call A_SetWindowLong(m_hWnd, GWL_STYLE, A_GetWindowLong(m_hWnd, GWL_STYLE) And Not WS_CAPTION) 135 | End Sub 136 | 137 | Private Sub ExitFullScreen() 138 | Dim item As Variant 139 | 140 | For Each item In m_hiddenWindows 141 | item.Visible = True 142 | Next 143 | 144 | Set cmdBarEvents = Nothing 145 | 146 | Call m_cmdBar.Delete 147 | Set m_cmdBar = Nothing 148 | 149 | Set m_hiddenWindows = Nothing 150 | 151 | If IsWindow(m_hWnd) Then 152 | If m_IsMaximized = False Then 153 | Call ShowWindow(m_hWnd, SW_RESTORE) 154 | End If 155 | 156 | Call A_SetWindowLong(m_hWnd, GWL_STYLE, A_GetWindowLong(m_hWnd, GWL_STYLE) Or WS_CAPTION) 157 | End If 158 | 159 | End Sub 160 | 161 | Private Sub Class_Terminate() 162 | If m_IsInFullScreen Then 163 | Call Invoke 164 | End If 165 | End Sub 166 | 167 | Private Sub cmdBarEvents_Click(ByVal CommandBarControl As Object, handled As Boolean, CancelDefault As Boolean) 168 | Call Invoke 169 | End Sub 170 | 171 | Private Sub codeBarEvents_Click(ByVal CommandBarControl As Object, handled As Boolean, CancelDefault As Boolean) 172 | Call Invoke 173 | End Sub 174 | 175 | Private Property Let ICHPlugin_CHCore(ByVal RHS As Long) 176 | 'Save the Pointer for later use 177 | m_CHCorePtr = RHS 178 | End Property 179 | 180 | Private Property Get ICHPlugin_CopyRight() As String 181 | ICHPlugin_CopyRight = CH_COPYRIGHT 182 | End Property 183 | 184 | Private Property Get ICHPlugin_Description() As String 185 | ICHPlugin_Description = CH_DESCRIPTION 186 | End Property 187 | 188 | Private Property Get ICHPlugin_HaveExtendedHelp() As Boolean 189 | 190 | End Property 191 | 192 | Private Property Get ICHPlugin_HaveProperties() As Boolean 193 | 194 | End Property 195 | 196 | Private Property Get ICHPlugin_LongName() As String 197 | ICHPlugin_LongName = CH_LONGNAME 198 | End Property 199 | 200 | Private Property Get ICHPlugin_Name() As String 201 | ICHPlugin_Name = App.Title 202 | End Property 203 | 204 | Private Sub ICHPlugin_OnConnection(ByVal ConnectMode As CodeHelpDef.ext_ConnectMode, custom() As Variant) 205 | Dim oCHCore As ICHCore 206 | Dim cmdBtn As CommandBarButton 207 | 208 | Set oCHCore = GetCHCore(m_CHCorePtr) 209 | 210 | If Not oCHCore Is Nothing Then 211 | m_hWnd = oCHCore.VBE.MainWindow.hWnd 212 | 213 | 'now it's possible for user to disable a plugin at runtime 214 | 'so we have to check whether the plugin is connected for the first time 215 | If m_MenuItem Is Nothing Then 216 | Set m_MenuItem = oCHCore.AddToCodeHelpMenu("Full Screen", LoadResPicture(101, vbResIcon)) 217 | Set cmdBtn = m_MenuItem 218 | cmdBtn.ShortcutText = "Shift+Enter" 219 | Set codeBarEvents = oCHCore.VBE.Events.CommandBarEvents(m_MenuItem) 220 | End If 221 | 222 | m_MenuItem.Enabled = m_IsEnabled 223 | 224 | End If 225 | End Sub 226 | 227 | Private Sub ICHPlugin_OnDisconnect(ByVal RemoveMode As CodeHelpDef.ext_DisconnectMode, custom() As Variant) 228 | If Not m_MenuItem Is Nothing Then 229 | 'cannot delete menu item, bug in office command bar? 230 | 'so we just disable it 231 | m_MenuItem.Enabled = False 232 | End If 233 | 234 | Call Class_Terminate 235 | 236 | End Sub 237 | 238 | Private Sub ICHPlugin_OnKeyHook(bHandled As Boolean, lReturn As Long, wParam As Long, lParam As Long) 239 | Select Case wParam 240 | Case vbKeyReturn 241 | If (lParam And &HC0000000) = 0 Then 242 | If (GetKeyState(vbKeyShift) And &H8000) <> 0 Then 243 | lReturn = 1 244 | bHandled = True 245 | Call Invoke 246 | End If 247 | End If 248 | 249 | End Select 250 | End Sub 251 | 252 | Private Sub ICHPlugin_OnWinProc(ByVal hWnd As Long, ByVal uMsg As Long, wParam As Long, lParam As Long, _ 253 | bHandled As Boolean, lReturn As Long) 254 | 255 | End Sub 256 | 257 | 258 | Private Sub ICHPlugin_OnWinProcHook(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long, _ 259 | bHandled As Boolean, placeSubclass As Boolean, before As Boolean) 260 | 261 | End Sub 262 | 263 | Private Sub ICHPlugin_ShowHelp() 264 | 265 | End Sub 266 | 267 | Private Sub ICHPlugin_ShowPropertyDialog() 268 | 269 | End Sub 270 | 271 | Private Property Get ICHPlugin_Version() As String 272 | ICHPlugin_Version = App.Major & "." & App.Minor & "." & App.Revision 273 | End Property 274 | 275 | Private Property Let ICHPlugin_Enabled(ByVal RHS As Boolean) 276 | m_IsEnabled = RHS 277 | End Property 278 | 279 | Private Property Get ICHPlugin_Enabled() As Boolean 280 | ICHPlugin_Enabled = m_IsEnabled 281 | End Property 282 | -------------------------------------------------------------------------------- /CHCore/Connect.Dsr: -------------------------------------------------------------------------------- 1 | VERSION 5.00 2 | Begin {AC0714F6-3D04-11D1-AE7D-00A0C90F26F4} Connect 3 | ClientHeight = 12765 4 | ClientLeft = 1740 5 | ClientTop = 1545 6 | ClientWidth = 18000 7 | _ExtentX = 31750 8 | _ExtentY = 22516 9 | _Version = 393216 10 | Description = "CodeHelp Core IDE Extender Framework" 11 | DisplayName = "CodeHelp IDE Extender" 12 | AppName = "Visual Basic" 13 | AppVer = "Visual Basic 98 (ver 6.0)" 14 | LoadName = "Command Line / Startup" 15 | LoadBehavior = 5 16 | RegLocation = "HKEY_CURRENT_USER\Software\Microsoft\Visual Basic\6.0" 17 | CmdLineSupport = -1 'True 18 | End 19 | Attribute VB_Name = "Connect" 20 | Attribute VB_GlobalNameSpace = False 21 | Attribute VB_Creatable = True 22 | Attribute VB_PredeclaredId = False 23 | Attribute VB_Exposed = True 24 | Option Explicit 25 | 26 | Private m_CHCommandBarItem As CommandBarControl 27 | Private m_CHCoreMenuGroup As CommandBarControl 28 | Private WithEvents ctlAbout As CommandBarEvents 29 | Attribute ctlAbout.VB_VarHelpID = -1 30 | Private WithEvents ctlPlugins As CommandBarEvents 31 | Attribute ctlPlugins.VB_VarHelpID = -1 32 | 33 | Private m_VBE As VBIDE.VBE 34 | Private m_AddInInst As Object 35 | 36 | Implements ICHCore 37 | 38 | '------------------------------------------------------ 39 | 'this method adds the Add-In to VB 40 | '------------------------------------------------------ 41 | Private Sub AddinInstance_OnConnection(ByVal Application As Object, ByVal ConnectMode As AddInDesignerObjects.ext_ConnectMode, ByVal AddInInst As Object, custom() As Variant) 42 | Dim cmdNew As CommandBarControl 43 | Dim oPlugin As ICHPlugin 44 | 45 | 'save the vb instance 46 | Set m_VBE = Application 47 | Set m_AddInInst = AddInInst 48 | 49 | 'Use index for International Version of VB, thanks bicio! 50 | Dim menuBar As CommandBar 51 | 52 | On Error GoTo GeneralError 53 | Set menuBar = m_VBE.CommandBars(1) 54 | Set m_CHCommandBarItem = menuBar.Controls.Add(msoControlPopup, , , menuBar.Controls.Count - 1) 55 | m_CHCommandBarItem.Caption = "&CodeHelp" 56 | 57 | Set cmdNew = AddMenuItem("&Plugins Manager...", , False) 58 | Set ctlPlugins = m_VBE.Events.CommandBarEvents(cmdNew) 59 | 60 | Set cmdNew = AddMenuItem("&About...", , False) 61 | Set ctlAbout = m_VBE.Events.CommandBarEvents(cmdNew) 62 | 63 | Call LoadPlugins(ConnectMode, custom) 64 | 'start low level message monitoring 65 | Set HookMon = New HookMonitor 66 | Call HookMon.StartMonitor 67 | 68 | 'tell plugins we're ready 69 | For Each oPlugin In mCHCore.Plugins 70 | If oPlugin.Enabled Then 71 | On Error GoTo PluginConnectFailed 72 | Call oPlugin.OnConnection(ConnectMode, custom) 73 | GoTo NextPlugin 74 | PluginConnectFailed: 75 | Call MsgBox("Error enabling oPlugin: " & oPlugin.Name & " in file " & Err.Source & " on line: " & Erl & vbCrLf _ 76 | & Err.Description, vbInformation, "Couldn't connect oPlugin") 77 | NextPlugin: 78 | End If 79 | Next 80 | 81 | customVar = custom 82 | Exit Sub 83 | 84 | GeneralError: 85 | Call MsgBox(Err.Description, vbInformation, "Error Encountered") 86 | End Sub 87 | 88 | '------------------------------------------------------ 89 | 'this method removes the Add-In from VB 90 | '------------------------------------------------------ 91 | Private Sub AddinInstance_OnDisconnection(ByVal RemoveMode As AddInDesignerObjects.ext_DisconnectMode, custom() As Variant) 92 | On Error Resume Next 93 | 94 | Call EndMonitor 95 | Call RemovePlugins(RemoveMode, custom) 96 | 97 | Set m_CHCoreMenuGroup = Nothing 98 | Set ctlAbout = Nothing 99 | Set ctlPlugins = Nothing 100 | Call m_CHCommandBarItem.Delete 101 | Set m_CHCommandBarItem = Nothing 102 | 103 | Set m_VBE = Nothing 104 | End Sub 105 | 106 | Private Sub ctlAbout_Click(ByVal CommandBarControl As Object, handled As Boolean, CancelDefault As Boolean) 107 | Call frmAbout.Show(vbModal) 108 | End Sub 109 | 110 | Private Sub ctlPlugins_Click(ByVal CommandBarControl As Object, handled As Boolean, CancelDefault As Boolean) 111 | Dim f As frmPlugins 112 | 113 | Set f = New frmPlugins 114 | Set f.Plugins = mCHCore.Plugins 115 | 116 | Call f.Show(vbModal) 117 | Call Unload(f) 118 | 119 | Set f = Nothing 120 | End Sub 121 | 122 | 123 | Private Function AddMenuItem(ByVal Caption As String, Optional ByVal iconPic As stdole.Picture = Nothing, Optional aboveSeparator As Boolean = True) As CommandBarControl 124 | Dim dropDown As CommandBarPopup 125 | Dim newButton As CommandBarButton 126 | Dim iconBmp As StdPicture 127 | 128 | If m_CHCommandBarItem Is Nothing Then Exit Function 129 | 130 | Set dropDown = m_CHCommandBarItem 131 | If aboveSeparator Then 'add menu item above the menuseparator 132 | Set newButton = dropDown.Controls.Add(msoControlButton, , , m_CHCoreMenuGroup.Index) 133 | 134 | Else 'add menu item below the separator 135 | Set newButton = dropDown.Controls.Add(msoControlButton) 136 | If m_CHCoreMenuGroup Is Nothing Then 137 | Set m_CHCoreMenuGroup = newButton 138 | m_CHCoreMenuGroup.BeginGroup = True 'add separator 139 | End If 140 | 141 | End If 142 | 143 | newButton.Caption = Caption 144 | 145 | If Not iconPic Is Nothing Then 146 | On Error GoTo SKIP_FACE 147 | Call Clipboard.Clear 148 | 149 | Call newButton.CopyFace 150 | Set iconBmp = Clipboard.GetData 151 | Call CopyIconToClipBoardAsBmp(iconPic, iconBmp) 152 | Call newButton.PasteFace 153 | 154 | Call Clipboard.Clear 155 | End If 156 | 157 | SKIP_FACE: 158 | Set AddMenuItem = newButton 159 | 160 | End Function 161 | 162 | Private Property Get ICHCore_AddInInst() As Object 163 | Set ICHCore_AddInInst = m_AddInInst 164 | End Property 165 | 166 | Private Function ICHCore_AddToCodeHelpMenu(ByVal Caption As String, Optional ByVal iconBitmap As Variant) As Object 167 | Set ICHCore_AddToCodeHelpMenu = AddMenuItem(Caption, iconBitmap, True) 168 | End Function 169 | 170 | Private Property Get ICHCore_VBE() As VBIDE.VBE 171 | Set ICHCore_VBE = m_VBE 172 | End Property 173 | 174 | Private Sub EndMonitor() 175 | Call HookMon.EndMonitor 176 | Set HookMon = Nothing 177 | End Sub 178 | 179 | Private Sub LoadPlugins(ByVal ConnectMode As AddInDesignerObjects.ext_ConnectMode, custom() As Variant) 180 | Dim sPath As String 181 | Dim sFile As String 182 | 183 | Set mCHCore.Plugins = New Plugins 184 | sPath = App.Path & "\Plugins\" 185 | sFile = Dir(sPath & "*.dll") 186 | Do While Len(sFile) > 0 187 | sFile = sPath & sFile 188 | Call LoadPluginDLL(sFile, ConnectMode, custom) 189 | sFile = Dir() 190 | Loop 191 | End Sub 192 | 193 | Private Sub LoadPluginDLL(ByVal fileName As String, ByVal ConnectMode As ext_ConnectMode, custom() As Variant) 194 | 'ICHPlugin Guid************************************************************** 195 | 'This is defined in CHLib.tlb 196 | 'All plugins must inplements this interface to be succesfully load by CHCore 197 | Const GUID_ID = "{0412CF22-0411-4255-9EE1-57354438E4EB}" 198 | '**************************************************************************** 199 | Dim tliApp As TLIApplication 200 | Dim tliInfo As TypeLibInfo 201 | Dim ccI As CoClassInfo 202 | Dim inf As InterfaceInfo 203 | 204 | Dim oPlugin As ICHPlugin 205 | Dim className As String 206 | 207 | On Error Resume Next 208 | gPtr = ObjPtr(Me) 209 | 210 | Set tliApp = New TLIApplication 211 | Set tliInfo = tliApp.TypeLibInfoFromFile(fileName) 212 | 213 | For Each ccI In tliInfo.CoClasses 214 | For Each inf In ccI.Interfaces 215 | 'more than one class in the dll can implement ICHPlugin 216 | If inf.Guid = GUID_ID Then 217 | 'this class implements ICHPlugin 218 | className = tliInfo.Name & "." & ccI.Name 219 | Set oPlugin = CreateObject(className) 220 | 221 | If Not oPlugin Is Nothing Then 222 | oPlugin.CHCore = gPtr 223 | oPlugin.Enabled = CBool(GetSetting("CodeHelp", oPlugin.Name, "Enabled", True)) 224 | Call mCHCore.Plugins.Add(oPlugin) 225 | 226 | Set oPlugin = Nothing 227 | End If 228 | 229 | Exit For 230 | End If 231 | Next 232 | Next 233 | 234 | End Sub 235 | 236 | Private Sub RemovePlugins(ByVal RemoveMode As AddInDesignerObjects.ext_DisconnectMode, custom() As Variant) 237 | Dim oPlugin As ICHPlugin 238 | Dim oPluginList As Plugins 239 | Dim idx As Long 240 | 241 | Set oPluginList = mCHCore.Plugins 242 | 243 | For Each oPlugin In oPluginList 244 | Call oPlugin.OnDisconnect(RemoveMode, custom) 245 | Next 246 | 247 | 'Delete oPlugin from collection 248 | For idx = 1 To oPluginList.Count 249 | Call oPluginList.Remove(1) 250 | Next 251 | 252 | Set mCHCore.Plugins = Nothing 253 | End Sub 254 | 255 | -------------------------------------------------------------------------------- /CHCore/cHook.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | Persistable = 0 'NotPersistable 5 | DataBindingBehavior = 0 'vbNone 6 | DataSourceBehavior = 0 'vbNone 7 | MTSTransactionMode = 0 'NotAnMTSObject 8 | END 9 | Attribute VB_Name = "cHook" 10 | Attribute VB_GlobalNameSpace = False 11 | Attribute VB_Creatable = True 12 | Attribute VB_PredeclaredId = False 13 | Attribute VB_Exposed = False 14 | Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes" 15 | Attribute VB_Ext_KEY = "Top_Level" ,"Yes" 16 | '================================================================================================== 17 | 'cHook - module-less, IDE safe, machine code hooking thunk 18 | ' 19 | 'Paul_Caton@hotmail.com 20 | 'Copyright free, use and abuse as you see fit. 21 | ' 22 | 'v1.00 20030107 First cut.......................................................................... 23 | 'v1.01 20030901 Changes to allow some global, system-wide hooks.................................... 24 | 'v1.02 20031118 Allow control over callback gating 25 | ' Use global memory for the machine code buffer 26 | ' Reform the assembler............................................................... 27 | 'v1.03 20040118 Use EbMode for breakpoint/stop detection rather than callback gating 28 | ' Further reform the assembler for greater speed and smaller size 29 | ' Made InIDE public.................................................................. 30 | ' 31 | '================================================================================================== 32 | Option Explicit 33 | 34 | Private Declare Function SetWindowsHookEx Lib "user32.dll" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long 35 | Private Declare Function UnhookWindowsHookEx Lib "user32.dll" (ByVal hHook As Long) As Long 36 | 37 | Private nAddrHook As Long 'Address of the hook thunk 38 | Private hHook As Long 'Hook handle 39 | 40 | '============================================ 41 | 'Class creation/destruction 42 | '============================================ 43 | 44 | 'Build the hook thunk into allocated memory 45 | Private Sub Class_Initialize() 46 | Const PATCH_01 As Long = 17 'Code buffer offset to the location of the relative address to EbMode 47 | Const PATCH_03 As Long = 71 'Relative address of UnhookWindowsHookEx 48 | Const PATCH_05 As Long = 101 'Relative address of CallNextHookEx 49 | Const FUNC_EBM As String = "EbMode" 'VBA's EbMode function allows the machine code thunk to know if the IDE has stopped or is on a breakpoint 50 | Const FUNC_UWH As String = "UnhookWindowsHookEx" 'We use CallWindowProc to call the original WndProc 51 | Const FUNC_CNH As String = "CallNextHookEx" 'SetWindowLong allows the cSubclasser machine code thunk to unsubclass the subclasser itself if it detects via the EbMode function that the IDE has stopped 52 | Const MOD_VBA5 As String = "vba5" 'Location of the EbMode function if running VB5 53 | Const MOD_VBA6 As String = "vba6" 'Location of the EbMode function if running VB6 54 | Const MOD_USER As String = "user32" 'Location of the KillTimer function 55 | Dim i As Long 'Loop index 56 | Dim nLen As Long 'String lengths 57 | Dim sHex As String 'Hex code string 58 | Dim sCode As String 'Binary code string 59 | 60 | 'Store the hex pair machine code representation in sHex 61 | sHex = "5589E583C4F831D28955FC8955F8EB0EE8xxxxx01x83F802742085C07423E82A000000837DF800750AE828000000E83A0000008B45FCC9C20C00E817000000EBF268xxxxx02xE8xxxxx03xEBE631D24AE820000000C3FF7510FF750CFF750868xxxxx04xE8xxxxx05x8945FCC331D2E801000000C38D4510508D450C508D4508508D45FC508D45F85052B8xxxxx06x508B00FF501CC3" 62 | nLen = Len(sHex) 'Length of hex pair string 63 | 64 | 'Convert the string from hex pairs to bytes and store in the ASCII string opcode buffer 65 | For i = 1 To nLen Step 2 'For each pair of hex characters 66 | sCode = sCode & ChrB$(Val("&H" & Mid$(sHex, i, 2))) 'Convert a pair of hex characters to a byte and append to the ASCII string 67 | Next i 'Next pair 68 | 69 | nLen = LenB(sCode) 'Get the machine code length 70 | nAddrHook = GlobalAlloc(0, nLen) 'Allocate fixed memory for machine code buffer 71 | 72 | 'Copy the code to allocated memory 73 | Call CopyMemory(ByVal nAddrHook, ByVal StrPtr(sCode), nLen) 74 | 75 | If InIDE Then 76 | 'Patch the jmp (EB0E) with two nop's (90) enabling the IDE breakpoint/stop checking code 77 | Call CopyMemory(ByVal nAddrHook + 14, &H9090, 2) 78 | 79 | i = AddrFunc(MOD_VBA6, FUNC_EBM) 'Get the address of EbMode in vba6.dll 80 | If i = 0 Then 'Found? 81 | i = AddrFunc(MOD_VBA5, FUNC_EBM) 'VB5 perhaps, try vba5.dll 82 | End If 83 | 84 | Debug.Assert i 'Ensure the EbMode function was found 85 | Call PatchRel(PATCH_01, i) 'Patch the relative address to the EbMode api function 86 | End If 87 | 88 | 'Patch the the runtime values that are known 89 | Call PatchRel(PATCH_03, AddrFunc(MOD_USER, FUNC_UWH)) 'Relative address of UnhookWindowsHookEx 90 | Call PatchRel(PATCH_05, AddrFunc(MOD_USER, FUNC_CNH)) 'Relative address of CallNextHookEx 91 | End Sub 92 | 93 | 'Unhook if required and release the allocated memory 94 | Private Sub Class_Terminate() 95 | Call UnHook 'UnHook if the hook thunk is active 96 | Call GlobalFree(nAddrHook) 'Release the allocated memory 97 | End Sub 98 | 99 | '============================================ 100 | 'Public interface 101 | '============================================ 102 | 103 | 'Set the hook 104 | Public Function Hook(ByVal Owner As IHook, ByVal HookType As Long, Optional ByVal bThread As Boolean = True) As Boolean 105 | Const PATCH_02 As Long = 66 'Hook handle for UnhookWindowsHookEx 106 | Const PATCH_04 As Long = 96 'Hook handle for CallNextHookEx 107 | Const PATCH_06 As Long = 139 'Address of the owner object 108 | Dim nThreadID As Long 'App.ThreadID 109 | 110 | If hHook = 0 Then 111 | If bThread Then 'Validate the parameters with regard to hook type vs thread or system hooking 112 | 113 | Select Case HookType 114 | Case WH_JOURNALPLAYBACK, WH_JOURNALRECORD, WH_SYSMSGFILTER 115 | Debug.Assert False 'Inapropriate thread hooks 116 | End Select 117 | 118 | nThreadID = App.ThreadID 119 | End If 120 | 121 | Call PatchVal(PATCH_06, ObjPtr(Owner)) 'Owner object address 122 | 123 | 'Set the hook 124 | hHook = SetWindowsHookEx(HookType, nAddrHook, App.hInstance, nThreadID) 125 | 126 | If hHook <> 0 Then 127 | Hook = True 128 | Call PatchVal(PATCH_02, hHook) 'Hook handle for UnhookWindowsHookEx 129 | Call PatchVal(PATCH_04, hHook) 'Hook handle for CallNextHookEx 130 | End If 131 | End If 132 | 133 | Debug.Assert Hook 134 | End Function 135 | 136 | 'Return whether we're running in the IDE. Public for general utility purposes 137 | Public Function InIDE() As Boolean 138 | #If IN_ADDIN = 0 Then 139 | InIDE = (GetModuleHandle("vba6") <> 0) 140 | #End If 141 | End Function 142 | 143 | 'Call this method to unhook 144 | Public Function UnHook() As Boolean 145 | If hHook <> 0 Then 146 | If UnhookWindowsHookEx(hHook) <> 0 Then 'Unhook the hook 147 | UnHook = True 'Success 148 | hHook = 0 'Hook inactive 149 | End If 150 | End If 151 | End Function 152 | 153 | '============================================ 154 | 'Private interface 155 | '============================================ 156 | 157 | 'Return the address of the passed function in the passed dll 158 | Private Function AddrFunc(ByVal sDLL As String, _ 159 | ByVal sProc As String) As Long 160 | AddrFunc = GetProcAddress(A_GetModuleHandle(sDLL), sProc) 161 | 162 | 'You may want to comment out the following line if you're using vb5 else the EbMode 163 | 'GetProcAddress will stop here everytime because we look in vba6.dll first 164 | Debug.Assert AddrFunc 165 | End Function 166 | 167 | 'Patch the machine code buffer offset with the relative address to the target address 168 | Private Sub PatchRel(ByVal nOffset As Long, ByVal nTargetAddr As Long) 169 | Call CopyMemory(ByVal (nAddrHook + nOffset), nTargetAddr - nAddrHook - nOffset - 4, 4) 170 | End Sub 171 | 172 | 'Patch the machine code buffer offset with the passed value 173 | Private Sub PatchVal(ByVal nOffset As Long, ByVal nValue As Long) 174 | Call CopyMemory(ByVal (nAddrHook + nOffset), nValue, 4) 175 | End Sub 176 | 177 | -------------------------------------------------------------------------------- /Plugins/CHCoder/frmProp.frm: -------------------------------------------------------------------------------- 1 | VERSION 5.00 2 | Begin VB.Form frmProp 3 | BorderStyle = 4 'Fixed ToolWindow 4 | Caption = "CodeHelp Coder Options" 5 | ClientHeight = 6435 6 | ClientLeft = 2760 7 | ClientTop = 3705 8 | ClientWidth = 8805 9 | BeginProperty Font 10 | Name = "Arial" 11 | Size = 8.25 12 | Charset = 0 13 | Weight = 400 14 | Underline = 0 'False 15 | Italic = 0 'False 16 | Strikethrough = 0 'False 17 | EndProperty 18 | LinkTopic = "Form1" 19 | MaxButton = 0 'False 20 | MinButton = 0 'False 21 | ScaleHeight = 6435 22 | ScaleWidth = 8805 23 | ShowInTaskbar = 0 'False 24 | StartUpPosition = 2 'CenterScreen 25 | Begin VB.CommandButton cmdDelete 26 | Caption = "&Delete" 27 | Height = 375 28 | Left = 120 29 | TabIndex = 11 30 | Top = 5880 31 | Width = 1215 32 | End 33 | Begin VB.TextBox txtKey 34 | BorderStyle = 0 'None 35 | Height = 210 36 | Left = 135 37 | MaxLength = 8 38 | TabIndex = 10 39 | Top = 1650 40 | Visible = 0 'False 41 | Width = 1500 42 | End 43 | Begin VB.CommandButton cmdNew 44 | Caption = "&New" 45 | Height = 375 46 | Left = 120 47 | TabIndex = 7 48 | Top = 5400 49 | Width = 1215 50 | End 51 | Begin VB.CommandButton cmdMarker 52 | Caption = "Insert Marker" 53 | Height = 375 54 | Left = 6120 55 | TabIndex = 6 56 | Top = 4995 57 | Width = 1215 58 | End 59 | Begin VB.ComboBox cboMarker 60 | Height = 330 61 | Left = 2430 62 | Style = 2 'Dropdown List 63 | TabIndex = 5 64 | Top = 5025 65 | Width = 3615 66 | End 67 | Begin VB.TextBox txtCode 68 | BeginProperty Font 69 | Name = "Courier New" 70 | Size = 9.75 71 | Charset = 0 72 | Weight = 400 73 | Underline = 0 'False 74 | Italic = 0 'False 75 | Strikethrough = 0 'False 76 | EndProperty 77 | Height = 4380 78 | Left = 1710 79 | MultiLine = -1 'True 80 | ScrollBars = 3 'Both 81 | TabIndex = 3 82 | Top = 570 83 | Width = 6945 84 | End 85 | Begin VB.ListBox lstKey 86 | Height = 4680 87 | Left = 90 88 | TabIndex = 1 89 | ToolTipText = "Double Click to edit" 90 | Top = 570 91 | Width = 1410 92 | End 93 | Begin VB.CommandButton cmdCancel 94 | Cancel = -1 'True 95 | Caption = "Cancel" 96 | Height = 375 97 | Left = 7470 98 | TabIndex = 9 99 | Top = 5880 100 | Width = 1215 101 | End 102 | Begin VB.CommandButton cmdOK 103 | Caption = "OK" 104 | Height = 375 105 | Left = 6120 106 | TabIndex = 8 107 | Top = 5880 108 | Width = 1215 109 | End 110 | Begin VB.Label lblCaption 111 | AutoSize = -1 'True 112 | Caption = "Marker:" 113 | Height = 210 114 | Index = 2 115 | Left = 1710 116 | TabIndex = 4 117 | Top = 5025 118 | Width = 540 119 | End 120 | Begin VB.Label lblCaption 121 | AutoSize = -1 'True 122 | Caption = "Snippet:" 123 | Height = 210 124 | Index = 1 125 | Left = 1755 126 | TabIndex = 2 127 | Top = 300 128 | Width = 585 129 | End 130 | Begin VB.Label lblCaption 131 | AutoSize = -1 'True 132 | Caption = "Shortcut:" 133 | Height = 210 134 | Index = 0 135 | Left = 135 136 | TabIndex = 0 137 | Top = 300 138 | Width = 660 139 | End 140 | End 141 | Attribute VB_Name = "frmProp" 142 | Attribute VB_GlobalNameSpace = False 143 | Attribute VB_Creatable = False 144 | Attribute VB_PredeclaredId = True 145 | Attribute VB_Exposed = False 146 | Option Explicit 147 | 148 | Private Const CLOSE_TAG As String = "" 149 | Dim editMode As Boolean 150 | 151 | Private m_Parent As CHCoder.Loader 152 | Private m_Templates As Recordset 153 | Private m_Markers As Recordset 154 | 155 | Public Sub Initalize(templates As Recordset, markers As Recordset, parent As CHCoder.Loader) 156 | Set m_Templates = templates 157 | Set m_Markers = markers 158 | Set m_Parent = parent 159 | 160 | Call SetupUI 161 | End Sub 162 | 163 | Private Sub SetupUI() 164 | With m_Templates 165 | If .RecordCount > 0 Then 166 | Call .MoveFirst 167 | Do While Not .EOF 168 | Call lstKey.AddItem(.Fields("Key").Value) 169 | Call .MoveNext 170 | Loop 171 | End If 172 | End With 173 | 174 | With m_Markers 175 | If .RecordCount > 0 Then 176 | Call .MoveFirst 177 | Do While Not .EOF 178 | Call cboMarker.AddItem(.Fields(0).Value & " " & .Fields(1).Value) 179 | Call .MoveNext 180 | Loop 181 | End If 182 | End With 183 | End Sub 184 | 185 | 186 | Private Sub cmdDelete_Click() 187 | Call m_Templates.MoveFirst 188 | Call m_Templates.Find(KeyForListItem) 189 | Call m_Templates.Delete(adAffectCurrent) 190 | Call m_Templates.MoveLast 'if we don't MoveLast then everything explodes awfully 191 | 192 | Call lstKey.RemoveItem(lstKey.ListIndex) 193 | txtCode.Text = "" 194 | 195 | Exit Sub 196 | ErrHandler: 197 | Call MsgBox(Err.Description) 198 | End Sub 199 | 200 | Private Sub cmdMarker_Click() 201 | If cboMarker.ListIndex > -1 Then 202 | txtCode.SelText = Split(cboMarker.Text, " ")(0) & CLOSE_TAG 203 | End If 204 | End Sub 205 | 206 | Private Sub cmdNew_Click() 207 | Dim idx As Long 208 | 209 | With txtKey 210 | lstKey.ListIndex = -1 211 | .Text = "New" 212 | 213 | idx = lstKey.TopIndex 214 | idx = lstKey.ListCount - idx 215 | 216 | Call .Move(lstKey.Left + 30, lstKey.Top + (idx * .Height) + 30, lstKey.Width - 60) 217 | 218 | .Visible = True 219 | .SelStart = 0 220 | .SelLength = 3 221 | Call .SetFocus 222 | End With 223 | 224 | editMode = False 225 | End Sub 226 | 227 | Private Sub cmdCancel_Click() 228 | Call Me.Hide 229 | End Sub 230 | 231 | Private Sub cmdOK_Click() 232 | On Error GoTo ERR_HANDLER 233 | Call ValidateData 234 | Call m_Parent.SaveData 235 | Call Me.Hide 236 | 237 | Exit Sub 238 | ERR_HANDLER: 239 | MsgBox Err.Description 240 | End Sub 241 | 242 | Private Sub lstKey_Click() 243 | If m_Templates.RecordCount > 0 Then 244 | Call m_Templates.MoveFirst 245 | Call m_Templates.Find(KeyForListItem) 246 | If Not m_Templates.EOF Then 247 | txtCode.Text = Trim$(m_Templates.Fields("Code").Value & " ") 248 | Else 249 | txtCode.Text = "" 250 | End If 251 | End If 252 | End Sub 253 | 254 | Private Sub lstKey_DblClick() 255 | Dim idx As Long 256 | idx = lstKey.TopIndex 257 | idx = lstKey.ListIndex - idx 258 | Call txtKey.Move(lstKey.Left + 30, lstKey.Top + (idx * txtKey.Height) + 30, lstKey.Width - 60) 259 | 260 | txtKey.Text = lstKey.Text 261 | txtKey.SelStart = 10 262 | txtKey.Visible = True 263 | Call txtKey.SetFocus 264 | 265 | editMode = True 266 | End Sub 267 | 268 | Private Sub lstKey_KeyDown(KeyCode As Integer, Shift As Integer) 269 | If KeyCode = vbKeyF2 Then 270 | Call lstKey_DblClick 271 | End If 272 | End Sub 273 | 274 | Private Sub txtCode_Change() 275 | If m_Templates.EOF = False Then 276 | m_Templates.Fields(1).Value = txtCode.Text 277 | End If 278 | End Sub 279 | 280 | Private Sub txtKey_KeyDown(KeyCode As Integer, Shift As Integer) 281 | If KeyCode = vbKeyReturn Then 282 | If editMode = False Then 283 | Call txtCode.SetFocus 284 | Else 285 | m_Templates.Fields(0).Value = txtKey.Text 286 | txtKey.Visible = False 287 | End If 288 | End If 289 | End Sub 290 | 291 | Private Sub txtKey_LostFocus() 292 | txtKey.Visible = False 293 | Dim newKey As String 294 | 295 | newKey = LCase$(txtKey.Text) 296 | If Len(newKey) > 0 And newKey <> "new" Then 297 | If editMode = False Then 298 | Call lstKey.AddItem(newKey) 299 | Call m_Templates.AddNew 300 | m_Templates.Fields(0).Value = newKey 301 | lstKey.ListIndex = lstKey.ListCount - 1& 302 | Else 303 | lstKey.List(lstKey.ListIndex) = newKey 304 | m_Templates.Fields(0).Value = newKey 305 | End If 306 | End If 307 | End Sub 308 | 309 | Private Function KeyForListItem() As String 310 | KeyForListItem = "Key='" & lstKey.List(lstKey.ListIndex) & "'" 311 | End Function 312 | 313 | Private Sub ValidateData() 314 | With m_Templates 315 | If .RecordCount > 0 Then 316 | .Filter = adRecModified 317 | If .RecordCount > 0 Then 318 | Call .MoveFirst 319 | Do While Not .EOF 320 | Call ParseCode(.Fields(1).Value) 321 | Call .MoveNext 322 | Loop 323 | End If 324 | .Filter = adFilterNone 325 | End If 326 | End With 327 | End Sub 328 | 329 | Private Sub ParseCode(ByVal sCode As String) 330 | 331 | End Sub 332 | -------------------------------------------------------------------------------- /Plugins/CHTabMDI2/TabPage/DefaultPainter.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | Persistable = 0 'NotPersistable 5 | DataBindingBehavior = 0 'vbNone 6 | DataSourceBehavior = 0 'vbNone 7 | MTSTransactionMode = 0 'NotAnMTSObject 8 | END 9 | Attribute VB_Name = "DefaultPainter" 10 | Attribute VB_GlobalNameSpace = False 11 | Attribute VB_Creatable = True 12 | Attribute VB_PredeclaredId = False 13 | Attribute VB_Exposed = False 14 | Option Explicit 15 | 16 | Private Const TEXT_MARGIN As Long = 6& 17 | 18 | Private Type TRIVERTEX 19 | x As Long 20 | y As Long 21 | Red As Integer 22 | Green As Integer 23 | Blue As Integer 24 | Alpha As Integer 25 | End Type 26 | 27 | Private Type GRADIENT_RECT 28 | UpperLeft As Long 29 | LowerRight As Long 30 | End Type 31 | 32 | Private Declare Function GradientFill Lib "msimg32" _ 33 | (ByVal hdc As Long, _ 34 | pVertex As Any, _ 35 | ByVal dwNumVertex As Long, _ 36 | pMesh As Any, _ 37 | ByVal dwNumMesh As Long, _ 38 | ByVal dwMode As Long) As Long 39 | 40 | Private Declare Function OleTranslateColor2 Lib "oleaut32.dll" Alias "OleTranslateColor" _ 41 | (ByVal Clr As Long, _ 42 | ByVal hPal As Long, _ 43 | ByVal lpcolorref As Long) As Long 44 | 45 | Private Declare Function MoveToEx Lib "gdi32.dll" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByRef lpPoint As Any) As Long 46 | 47 | Dim hBrBack As Long 48 | Dim hBrBackSelected As Long 49 | Dim hBrHover As Long 50 | Dim hBrPushed As Long 51 | 52 | Dim hPen As Long 53 | Dim hActivePen As Long 54 | Dim hHoverPen As Long 55 | 56 | Dim myFont As StdFont 57 | Dim shortcutFont As IFont 58 | Dim lClrHover As Long 59 | 60 | Dim lClrHoverDark As Long 61 | 62 | Implements ITabPainter 63 | 64 | Private Sub Class_Initialize() 65 | 66 | 67 | lClrHover = AlphaBlend(vbHighlight, vbWindowBackground, 75&) 68 | lClrHoverDark = AlphaBlend(vbHighlight, vbWindowBackground, 128&) 69 | 70 | hBrBack = GetSysColorBrush(COLOR_3DHILIGHT) 71 | hBrBackSelected = GetSysColorBrush(COLOR_3DFACE) 72 | hPen = CreatePen(PS_SOLID, 1, GetSysColor(COLOR_3DSHADOW)) 73 | hActivePen = CreatePen(PS_SOLID, 1, GetSysColor(COLOR_3DHILIGHT)) 74 | hHoverPen = CreatePen(PS_SOLID, 1, GetSysColor(COLOR_HIGHLIGHT)) 75 | 76 | Set myFont = New StdFont 77 | myFont.Name = "Arial" 78 | myFont.Size = 8 79 | 80 | Set shortcutFont = New StdFont 81 | shortcutFont.Name = "Arial" 82 | shortcutFont.Size = 10 83 | shortcutFont.Bold = True 84 | 85 | hBrHover = CreateSolidBrush(lClrHover) 86 | hBrPushed = CreateSolidBrush(lClrHoverDark) 87 | 88 | End Sub 89 | 90 | Private Sub Class_Terminate() 91 | DeleteObject hPen 92 | DeleteObject hActivePen 93 | DeleteObject hHoverPen 94 | DeleteObject hBrHover 95 | DeleteObject hBrPushed 96 | Set myFont = Nothing 97 | Set shortcutFont = Nothing 98 | End Sub 99 | 100 | Private Function ITabPainter_CalculateTabWidth(ByVal item As TabItem, ByVal oDC As MemoryDC) As Long 101 | Dim tS As SIZEL 102 | Dim textCount As Long 103 | 104 | textCount = Len(item.Caption) 105 | If textCount > 0 Then 106 | 107 | myFont.Bold = item.Selected 108 | myFont.Size = 8 109 | myFont.Name = "Arial" 110 | Set oDC.Font = myFont 111 | A_GetTextExtentPoint oDC.hdc, item.Caption, textCount, tS 112 | ITabPainter_CalculateTabWidth = tS.cx + 2 * TEXT_MARGIN 113 | If item.LeftMostItem Then 114 | 'add small margin for first tabitem 115 | ITabPainter_CalculateTabWidth = ITabPainter_CalculateTabWidth + TEXT_MARGIN 116 | End If 117 | End If 118 | End Function 119 | 120 | Private Sub ITabPainter_DrawItem(ByVal oDC As MemoryDC, bounds As RECT, ByVal item As TabItem, ByVal itemType As TabItemType) 121 | Dim lClr3DFace As Long 122 | Dim lClr3DHilite As Long 123 | 124 | lClr3DFace = GetSysColor(COLOR_3DFACE) 125 | lClr3DHilite = GetSysColor(COLOR_3DHILIGHT) 126 | SetBkMode oDC.hdc, TRANSPARENT 127 | 128 | Select Case itemType 129 | Case DrawBackGround 130 | DrawGradientFill oDC.hdc, bounds.Left, bounds.Top, bounds.Right, bounds.Bottom, _ 131 | lClr3DFace, lClr3DHilite, True 132 | 133 | Case DrawTabItem 134 | oDC.Pen = hPen 135 | 136 | If item.LeftMostItem Then 137 | 'draw small margin 138 | bounds.Left = bounds.Left + 4& 139 | End If 140 | 141 | MoveToEx oDC.hdc, bounds.Left, bounds.Bottom, ByVal 0 142 | bounds.Top = bounds.Top + 3& 143 | bounds.Right = bounds.Right - 2& 144 | 145 | If item.Selected Then 146 | 'FillRect oDC.hDC, bounds, hBrBack 147 | DrawGradientFill oDC.hdc, bounds.Left, bounds.Top, bounds.Right, bounds.Bottom, _ 148 | lClr3DHilite, lClr3DFace, True 149 | SetPixel oDC.hdc, bounds.Left, bounds.Top, lClr3DFace 150 | 151 | oDC.Pen = 0 152 | oDC.Pen = hActivePen 153 | LineTo oDC.hdc, bounds.Left, bounds.Top + 2& 154 | LineTo oDC.hdc, bounds.Left + 2&, bounds.Top 155 | LineTo oDC.hdc, bounds.Right - 2&, bounds.Top 156 | oDC.Pen = hPen 157 | Else 158 | FillRect oDC.hdc, bounds, hBrBackSelected 159 | LineTo oDC.hdc, bounds.Left, bounds.Top + 2& 160 | LineTo oDC.hdc, bounds.Left + 2&, bounds.Top 161 | LineTo oDC.hdc, bounds.Right - 2&, bounds.Top 162 | End If 163 | 164 | LineTo oDC.hdc, bounds.Right, bounds.Top + 2& 165 | LineTo oDC.hdc, bounds.Right, bounds.Bottom - 1& 166 | 167 | If item.Selected = False Then 168 | oDC.Pen = 0 169 | oDC.Pen = hActivePen 170 | MoveToEx oDC.hdc, bounds.Left, bounds.Bottom - 1&, ByVal 0 171 | LineTo oDC.hdc, bounds.Right + 2&, bounds.Bottom - 1& 172 | End If 173 | 174 | 'Draw Text 175 | 176 | If Len(item.Caption) > 0 Then 177 | myFont.Bold = item.Selected 178 | myFont.Name = "Arial" 179 | myFont.Size = 8 180 | Set oDC.Font = myFont 181 | 182 | bounds.Left = bounds.Left + TEXT_MARGIN 183 | 184 | SetTextColor oDC.hdc, GetSysColor(COLOR_BTNTEXT) 185 | OffsetRect bounds, -1, -1 186 | A_DrawText oDC.hdc, item.Caption, -1, bounds, DT_LEFT Or DT_SINGLELINE Or DT_VCENTER 187 | End If 188 | 189 | Case DrawCloseButton, DrawNavLeftButton, DrawNavRightButton 190 | 191 | Dim symFont As IFont, hOldFont As Long 192 | Set symFont = myFont 193 | symFont.Name = "Marlett" 194 | symFont.Bold = False 195 | If itemType <> DrawCloseButton Then 196 | symFont.Size = 12 197 | Else 198 | symFont.Size = 8 199 | End If 200 | 201 | oDC.Brush = 0 202 | oDC.Pen = 0 203 | 204 | If item.Enabled Then 205 | If item.Selected Then 206 | If item.Hovered Then 207 | SetTextColor oDC.hdc, GetSysColor(COLOR_BTNHILIGHT) 208 | Else 209 | SetTextColor oDC.hdc, GetSysColor(COLOR_BTNTEXT) 210 | End If 211 | Else 212 | SetTextColor oDC.hdc, GetSysColor(COLOR_BTNTEXT) 213 | End If 214 | 215 | If item.Selected Then 216 | If item.Index <> 0 Then 217 | oDC.Pen = hHoverPen 218 | oDC.Brush = hBrPushed 219 | Rectangle oDC.hdc, bounds.Left, bounds.Top, bounds.Right, bounds.Bottom 220 | 221 | ElseIf item.Hovered Then 222 | oDC.Pen = hHoverPen 223 | oDC.Brush = hBrPushed 224 | Rectangle oDC.hdc, bounds.Left, bounds.Top, bounds.Right, bounds.Bottom 225 | 226 | End If 227 | 228 | ElseIf item.Hovered Then 229 | oDC.Pen = hHoverPen 230 | oDC.Brush = hBrHover 231 | Rectangle oDC.hdc, bounds.Left, bounds.Top, bounds.Right, bounds.Bottom 232 | End If 233 | 234 | Else 235 | SetTextColor oDC.hdc, GetSysColor(COLOR_GRAYTEXT) 236 | End If 237 | 238 | 239 | hOldFont = SelectObject(oDC.hdc, symFont.hFont) 240 | OffsetRect bounds, 1, 0 241 | A_DrawText oDC.hdc, item.Caption, -1, bounds, DT_CENTER Or DT_SINGLELINE Or DT_VCENTER 242 | SelectObject oDC.hdc, hOldFont 243 | 244 | End Select 245 | oDC.Brush = 0 246 | oDC.Pen = 0 247 | End Sub 248 | 249 | Private Sub DrawGradientFill(ByVal hdc As Long, _ 250 | ByVal lLeft As Long, ByVal lTop As Long, _ 251 | ByVal lRight As Long, ByVal lBottom As Long, _ 252 | ByVal dwColour1 As Long, _ 253 | ByVal dwColour2 As Long, _ 254 | Optional ByVal Vertical As Boolean = False) 255 | 256 | Dim vert(0 To 1) As TRIVERTEX 257 | Dim grRc As GRADIENT_RECT 258 | 259 | 'Colour at upper-left corner 260 | With vert(0) 261 | .x = lLeft 262 | .y = lTop 263 | .Red = LongToSignedShort((dwColour1 And &HFF&) * 256&) 264 | .Green = LongToSignedShort(((dwColour1 And &HFF00&) \ &H100&) * 256&) 265 | .Blue = LongToSignedShort(((dwColour1 And &HFF0000) \ &H10000) * 256&) 266 | End With 267 | 268 | 'Colour at bottom-right corner 269 | With vert(1) 270 | .x = lRight 271 | .y = lBottom 272 | .Red = LongToSignedShort((dwColour2 And &HFF&) * 256&) 273 | .Green = LongToSignedShort(((dwColour2 And &HFF00&) \ &H100&) * 256&) 274 | .Blue = LongToSignedShort(((dwColour2 And &HFF0000) \ &H10000) * 256&) 275 | End With 276 | 277 | With grRc 278 | .LowerRight = 0& 279 | .UpperLeft = 1& 280 | End With 281 | 282 | Call GradientFill(hdc, vert(0), 2&, grRc, 1&, Abs(Vertical)) 283 | End Sub 284 | 285 | Private Function LongToSignedShort(dwUnsigned As Long) As Integer 286 | 287 | 'convert from long to signed short 288 | If dwUnsigned < 32768 Then 289 | LongToSignedShort = CInt(dwUnsigned) 290 | Else 291 | LongToSignedShort = CInt(dwUnsigned - &H10000) 292 | End If 293 | 294 | End Function 295 | 296 | Private Function AlphaBlend(ByVal clrFirst As Long, ByVal clrSecond As Long, ByVal lAlpha As Long) As Long 297 | Dim clrFore As RGBQUAD 298 | Dim clrBack As RGBQUAD 299 | Dim lDif As Long 300 | On Error Resume Next 301 | OleTranslateColor2 clrFirst, 0, VarPtr(clrFore) 302 | OleTranslateColor2 clrSecond, 0, VarPtr(clrBack) 303 | If lAlpha < 0& Then lAlpha = 0& 304 | If lAlpha > 255& Then lAlpha = 255& 305 | With clrFore 306 | lDif = CLng(.rgbRed) - CLng(clrBack.rgbRed) 307 | .rgbRed = (lAlpha * lDif) \ 255 + clrBack.rgbRed 308 | lDif = CLng(.rgbGreen) - CLng(clrBack.rgbGreen) 309 | .rgbGreen = (lAlpha * lDif) \ 255 + clrBack.rgbGreen 310 | lDif = CLng(.rgbBlue) - CLng(clrBack.rgbBlue) 311 | .rgbBlue = (lAlpha * lDif) \ 255 + clrBack.rgbBlue 312 | End With 313 | CopyMemory ByVal VarPtr(AlphaBlend), ByVal VarPtr(clrFore), 4 314 | End Function 315 | 316 | Private Sub ITabPainter_DrawShortcut(ByVal oDC As MemoryDC, bounds As RECT, ByVal item As TabItem, ByVal visibleIndex As Long) 317 | Dim hOldFont As Long 318 | 319 | 320 | hOldFont = SelectObject(oDC.hdc, shortcutFont.hFont) 321 | SetTextColor oDC.hdc, GetSysColor(COLOR_HIGHLIGHTTEXT) 322 | SetBkMode oDC.hdc, OPAQUE 323 | SetBkColor oDC.hdc, GetSysColor(COLOR_HIGHLIGHT) 324 | A_DrawText oDC.hdc, CStr(visibleIndex), -1, bounds, DT_SINGLELINE Or DT_CENTER Or DT_VCENTER 325 | SelectObject oDC.hdc, hOldFont 326 | 327 | End Sub 328 | 329 | -------------------------------------------------------------------------------- /Plugins/CHTabMDI2/TabPage/MemoryDC.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | Persistable = 0 'NotPersistable 5 | DataBindingBehavior = 0 'vbNone 6 | DataSourceBehavior = 0 'vbNone 7 | MTSTransactionMode = 0 'NotAnMTSObject 8 | END 9 | Attribute VB_Name = "MemoryDC" 10 | Attribute VB_GlobalNameSpace = False 11 | Attribute VB_Creatable = True 12 | Attribute VB_PredeclaredId = False 13 | Attribute VB_Exposed = False 14 | Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes" 15 | Attribute VB_Ext_KEY = "Top_Level" ,"Yes" 16 | Option Explicit 17 | 'Modified class from vbaccelerator.com 18 | ' --------------------------------------------------------------------------- 19 | ' vbAccelerator - free, advanced source code for VB programmers. 20 | ' http://vbaccelerator.com 21 | ' ========================================================= 22 | 23 | Private Type PicBmp 24 | Size As Long 25 | lType As Long 26 | hBmp As Long 27 | hPal As Long 28 | Reserved As Long 29 | End Type 30 | 31 | Private Type GUID 32 | Data1 As Long 33 | Data2 As Integer 34 | Data3 As Integer 35 | Data4(7) As Byte 36 | End Type 37 | 38 | Private Type BITMAP 39 | bmType As Long 40 | bmWidth As Long 41 | bmHeight As Long 42 | bmWidthBytes As Long 43 | bmPlanes As Integer 44 | bmBitsPixel As Integer 45 | bmBits As Long 46 | End Type 47 | 48 | Private Declare Function CreateDCAsNull _ 49 | Lib "gdi32" _ 50 | Alias "CreateDCA" (ByVal lpDriverName As String, _ 51 | lpDeviceName As Any, _ 52 | lpOutput As Any, _ 53 | lpInitData As Any) As Long 54 | Private Declare Function OleCreatePictureIndirect _ 55 | Lib "olepro32.dll" (PicDesc As PicBmp, _ 56 | RefIID As GUID, _ 57 | ByVal fPictureOwnsHandle As Long, _ 58 | IPic As IPicture) As Long 59 | Private Declare Function GetObjectAPI _ 60 | Lib "gdi32.dll" _ 61 | Alias "GetObjectA" (ByVal hObject As Long, _ 62 | ByVal nCount As Long, _ 63 | ByRef lpObject As Any) As Long 64 | 65 | Private m_hDC As Long 66 | Private m_hBmpOld As Long 67 | Private m_hBmp As Long 68 | Private m_lWidth As Long 69 | Private m_lheight As Long 70 | Private m_hFont As Long 71 | Private m_hOldFont As Long 72 | Private m_MemoryBrush As Long 73 | Private m_OriginalBrush As Long 74 | Private m_MemoryPen As Long 75 | Private m_OriginalPen As Long 76 | Private m_Created As Boolean 77 | Private m_lClrText As Long 78 | Private m_bVertical As Boolean 79 | Private m_IsBold As Boolean 80 | 81 | Public Sub CreateFromPicture(sPic As IPicture) 82 | Dim tB As BITMAP 83 | Dim lhDCC As Long, lHDC As Long 84 | Dim lhBmpOld As Long 85 | GetObjectAPI sPic.Handle, Len(tB), tB 86 | lhDCC = CreateDCAsNull("DISPLAY", ByVal 0&, ByVal 0&, ByVal 0&) 87 | lHDC = CreateCompatibleDC(lhDCC) 88 | lhBmpOld = SelectObject(lHDC, sPic.Handle) 89 | BitBlt hDC, 0, 0, tB.bmWidth, tB.bmHeight, lHDC, 0, 0, vbSrcCopy 90 | SelectObject lHDC, lhBmpOld 91 | DeleteDC ByVal lHDC 92 | DeleteDC ByVal lhDCC 93 | m_Created = True 94 | End Sub 95 | 96 | Public Sub CreateDC(ByVal Width As Long, _ 97 | ByVal Height As Long) 98 | pDestroy 99 | pCreate Width, Height 100 | m_Created = True 101 | End Sub 102 | 103 | 'Public Sub CreateFromDC(ByVal hOrgDC As Long, Width As Long, Height As Long) 104 | ' Dim tm As TEXTMETRIC 105 | ' Dim sFaceName As String * 80 106 | ' Dim oFnt As StdFont 107 | ' 108 | ' pDestroy 109 | ' m_hDC = CreateCompatibleDC(hOrgDC) 110 | ' If hOrgDC <> 0 Then 111 | ' m_hBmp = CreateCompatibleBitmap(hOrgDC, Width, Height) 112 | ' Else 113 | ' m_hBmp = CreateCompatibleBitmap(m_hDC, Width, Height) 114 | ' End If 115 | ' m_hBmpOld = SelectObject(m_hDC, m_hBmp) 116 | ' If m_hBmpOld = 0 Then 117 | ' pDestroy 118 | ' Err.Raise vbObjectError + 512, "MEM_DC", "Can not create CompatibleDC" 119 | ' Else 120 | ' m_lWidth = Width 121 | ' m_lheight = Height 122 | ' If hOrgDC <> 0& Then 123 | ' If hOrgDC <> 0& Then 124 | ' GetTextMetrics hOrgDC, tm 125 | ' GetTextFace hOrgDC, 79, sFaceName 126 | ' Else 127 | ' GetTextMetrics m_hDC, tm 128 | ' GetTextFace m_hDC, 79, sFaceName 129 | ' End If 130 | ' 131 | ' Set oFnt = New StdFont 132 | ' With oFnt 133 | ' .Name = sFaceName 'StrConv(sFaceName, vbUnicode) 134 | ' .Bold = (tm.tmWeight >= FW_NORMAL) 135 | ' .Charset = tm.tmCharSet 136 | ' .Italic = (tm.tmItalic <> 0) 137 | ' .Strikethrough = (tm.tmStruckOut <> 0) 138 | ' .Underline = (tm.tmUnderlined <> 0) 139 | ' .Weight = tm.tmWeight 140 | ' .Size = (tm.tmHeight - tm.tmInternalLeading) * 72 / tm.tmDigitizedAspectY 141 | ' End With 142 | ' Set Font = oFnt 143 | ' Set oFnt = Nothing 144 | ' End If 145 | ' m_Created = True 146 | ' End If 147 | 'End Sub 148 | 149 | Function CreateBitmapPicture(ByVal hBmp As Long, ByVal hPal As Long) As Picture 150 | Dim R As Long, Pic As PicBmp, IPic As IPicture, IID_IDispatch As GUID 151 | 152 | 'Fill GUID info 153 | With IID_IDispatch 154 | .Data1 = &H20400 155 | .Data4(0) = &HC0 156 | .Data4(7) = &H46 157 | End With 158 | 159 | 'Fill picture info 160 | With Pic 161 | .Size = Len(Pic) ' Length of structure 162 | .lType = vbPicTypeBitmap ' Type of Picture (bitmap) 163 | .hBmp = hBmp ' Handle to bitmap 164 | .hPal = hPal ' Handle to palette (may be null) 165 | End With 166 | 167 | 'Create the picture 168 | R = OleCreatePictureIndirect(Pic, IID_IDispatch, 1, IPic) 169 | 170 | 'Return the new picture 171 | Set CreateBitmapPicture = IPic 172 | End Function 173 | 174 | Public Property Get hDC() As Long 175 | hDC = m_hDC 176 | End Property 177 | 178 | Property Get hBitmap() As Long 179 | 180 | If m_Created = False Then Exit Property 181 | hBitmap = m_hBmp 182 | End Property 183 | 184 | Public Property Get Width() As Long 185 | Width = m_lWidth 186 | End Property 187 | 188 | Public Property Get Height() As Long 189 | Height = m_lheight 190 | End Property 191 | 192 | Public Property Get FontName() As String 193 | 194 | If m_Created = False Then Exit Property 195 | Dim lRetval As Long 196 | FontName = String$(80&, vbNullChar) 197 | lRetval = A_GetTextFace(m_hDC, 81&, FontName) 198 | 199 | FontName = Left$(FontName, lRetval) 200 | 201 | End Property 202 | 203 | Public Property Get fontSize() As Long 204 | 205 | If m_Created = False Then Exit Property 206 | Dim ttM As A_TEXTMETRIC 207 | A_GetTextMetrics m_hDC, ttM 208 | fontSize = (ttM.tmHeight - ttM.tmInternalLeading) * 72& / ttM.tmDigitizedAspectY 209 | End Property 210 | 211 | Public Property Get FontColor() As Long 212 | 213 | If m_Created = False Then Exit Property 214 | FontColor = m_lClrText 215 | End Property 216 | 217 | Public Property Let FontColor(ByVal Value As Long) 218 | 219 | If m_Created = False Then Exit Property 220 | If Value <> m_lClrText Then 221 | m_lClrText = Value 222 | SetTextColor m_hDC, m_lClrText 223 | End If 224 | 225 | End Property 226 | 227 | Property Get FontBold() As Boolean 228 | FontBold = m_IsBold 229 | End Property 230 | 231 | Public Property Get Brush() As Long 232 | Brush = m_MemoryBrush 233 | End Property 234 | 235 | Public Property Let Brush(ByVal lValue As Long) 236 | 237 | '--- state check 238 | If Not m_Created Then Exit Property 239 | If lValue = m_MemoryBrush Then Exit Property 240 | 241 | '--- set new brush (and save original) 242 | If m_OriginalBrush <> 0 Then 243 | SelectObject m_hDC, m_OriginalBrush 244 | m_OriginalBrush = 0& 245 | End If 246 | 247 | m_MemoryBrush = lValue 248 | 249 | If lValue <> 0& Then 250 | m_OriginalBrush = SelectObject(m_hDC, m_MemoryBrush) 251 | End If 252 | 253 | End Property 254 | 255 | 'Purpose: Returns or sets the currently selected GDI pen (HPEN) for the device context of the memoryDC object. 256 | Public Property Get Pen() As Long 257 | Pen = m_MemoryPen 258 | End Property 259 | 260 | Public Property Let Pen(ByVal lValue As Long) 261 | 262 | '--- state check 263 | If Not m_Created Then Exit Property 264 | If lValue = m_MemoryPen Then Exit Property 265 | 266 | '--- set new brush (and save original) 267 | If m_OriginalPen <> 0 Then 268 | SelectObject m_hDC, m_OriginalPen 269 | m_OriginalPen = 0& 270 | End If 271 | 272 | m_MemoryPen = lValue 273 | 274 | If lValue <> 0& Then 275 | m_OriginalPen = SelectObject(m_hDC, m_MemoryPen) 276 | End If 277 | 278 | End Property 279 | 280 | Public Property Get Font() As StdFont 281 | Dim tm As A_TEXTMETRIC 282 | 283 | Dim oFont As StdFont 284 | 285 | '--- state check 286 | If Not m_Created Then 287 | Exit Property 288 | End If 289 | 290 | On Error Resume Next 291 | 292 | A_GetTextMetrics m_hDC, tm 293 | 294 | Set oFont = New StdFont 295 | 296 | With oFont 297 | .Name = FontName 298 | .Bold = (tm.tmWeight > FW_NORMAL) 299 | .Charset = tm.tmCharSet 300 | .Italic = (tm.tmItalic <> 0) 301 | .Strikethrough = (tm.tmStruckOut <> 0) 302 | .Underline = (tm.tmUnderlined <> 0) 303 | .Weight = tm.tmWeight 304 | .Size = (tm.tmHeight - tm.tmInternalLeading) * 72 / tm.tmDigitizedAspectY 305 | End With 306 | 307 | Set Font = oFont 308 | Set oFont = Nothing 309 | End Property 310 | 311 | Public Property Set Font(ByVal oValue As StdFont) 312 | Dim tFont As A_LOGFONT 313 | 314 | '--- state check 315 | If Not m_Created Then Exit Property 316 | 317 | On Error Resume Next 318 | m_IsBold = oValue.Bold 319 | 320 | With tFont 321 | StrToBytes .lfFaceName, oValue.Name 322 | .lfCharSet = oValue.Charset 323 | .lfItalic = (-oValue.Italic) 324 | .lfStrikeOut = (-oValue.Strikethrough) 325 | .lfUnderline = (-oValue.Underline) 326 | .lfWeight = oValue.Weight 327 | .lfHeight = -MulDiv((oValue.Size), (GetDeviceCaps(hDC, LOGPIXELSY)), 72) 328 | 329 | If m_bVertical Then 330 | .lfEscapement = 900 331 | End If 332 | 333 | End With 334 | 335 | If m_hOldFont <> 0& Then 336 | SelectObject m_hDC, m_hOldFont 337 | m_hOldFont = 0& 338 | End If 339 | 340 | If m_hFont <> 0& Then 341 | DeleteObject m_hFont 342 | m_hFont = 0 343 | End If 344 | 345 | m_hFont = A_CreateFontIndirect(tFont) 346 | 347 | If m_hFont <> 0 Then m_hOldFont = SelectObject(m_hDC, m_hFont) 348 | End Property 349 | 350 | Public Property Let FontVertical(ByVal bVertical As Boolean) 351 | m_bVertical = bVertical 352 | End Property 353 | 354 | Private Sub pCreate(ByVal lW As Long, _ 355 | ByVal lH As Long) 356 | Dim lHDC As Long 357 | pDestroy 358 | lHDC = CreateDCAsNull("DISPLAY", ByVal 0&, ByVal 0&, ByVal 0&) 359 | m_hDC = CreateCompatibleDC(lHDC) 360 | m_hBmp = CreateCompatibleBitmap(lHDC, lW, lH) 361 | m_hBmpOld = SelectObject(m_hDC, m_hBmp) 362 | 363 | If m_hBmpOld = 0 Then 364 | pDestroy 365 | Else 366 | m_lWidth = lW 367 | m_lheight = lH 368 | End If 369 | 370 | DeleteDC ByVal lHDC 371 | m_Created = True 372 | End Sub 373 | 374 | Private Sub pDestroy() 375 | 376 | If m_OriginalPen <> 0 Then 377 | Call SelectObject(ByVal m_hDC, ByVal m_OriginalPen) 378 | m_OriginalPen = 0 379 | End If 380 | 381 | If m_OriginalBrush <> 0 Then 382 | Call SelectObject(ByVal m_hDC, ByVal m_OriginalBrush) 383 | m_OriginalBrush = 0 384 | End If 385 | 386 | If m_MemoryPen <> 0 Then 387 | Call DeleteObject(ByVal m_MemoryPen) 388 | m_MemoryPen = 0 389 | End If 390 | 391 | If m_MemoryBrush <> 0 Then 392 | Call DeleteObject(ByVal m_MemoryBrush) 393 | m_MemoryBrush = 0 394 | End If 395 | 396 | If m_hBmpOld <> 0 Then 397 | SelectObject ByVal m_hDC, ByVal m_hBmpOld 398 | m_hBmpOld = 0 399 | End If 400 | 401 | If m_hOldFont <> 0& Then 402 | SelectObject ByVal m_hDC, ByVal m_hOldFont 403 | m_hOldFont = 0& 404 | End If 405 | 406 | If m_hFont <> 0 Then 407 | DeleteObject ByVal m_hFont 408 | m_hFont = 0 409 | End If 410 | 411 | If m_hBmp <> 0 Then 412 | DeleteObject ByVal m_hBmp 413 | m_hBmp = 0 414 | m_lWidth = 0 415 | m_lheight = 0 416 | End If 417 | 418 | If Not m_hDC = 0 Then 419 | DeleteDC ByVal m_hDC 420 | m_hDC = 0 421 | End If 422 | 423 | m_Created = False 424 | End Sub 425 | 426 | Private Sub Class_Terminate() 427 | pDestroy 428 | End Sub 429 | 430 | Private Sub StrToBytes(ab() As Byte, _ 431 | s As String) 432 | Dim cab As Long 433 | ' Copy to existing array, padding or truncating if necessary 434 | cab = UBound(ab) - LBound(ab) + 1 435 | 436 | If Len(s) < cab Then s = s & String$(cab - Len(s), 0) 437 | CopyMemory ab(LBound(ab)), ByVal s, cab 438 | End Sub 439 | 440 | -------------------------------------------------------------------------------- /Plugins/CHCoder/Loader.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | Persistable = 0 'NotPersistable 5 | DataBindingBehavior = 0 'vbNone 6 | DataSourceBehavior = 0 'vbNone 7 | MTSTransactionMode = 0 'NotAnMTSObject 8 | END 9 | Attribute VB_Name = "Loader" 10 | Attribute VB_GlobalNameSpace = False 11 | Attribute VB_Creatable = True 12 | Attribute VB_PredeclaredId = False 13 | Attribute VB_Exposed = True 14 | Option Explicit 15 | 16 | 'Plugin const 17 | Private Const CH_LONGNAME As String = "CodeHelp Code Complete" 18 | Private Const CH_DESCRIPTION As String = "Template based code completion" 19 | Private Const CH_COPYRIGHT As String = "luthv@yahoo.com" 20 | 21 | Private Const VBA_WIN As String = "VbaWindow" 22 | 23 | Private m_CHCorePtr As Long 24 | Private m_IsEnabled As Boolean 25 | Private m_CodeWinFocused As Boolean 26 | 27 | Private m_MenuItem As CommandBarControl 28 | Private WithEvents m_oMenuEvents As VBIDE.CommandBarEvents 29 | Attribute m_oMenuEvents.VB_VarHelpID = -1 30 | 31 | Private m_TemplateDataSet As Recordset 32 | Private m_MarkerDataSet As Recordset 33 | Private m_sConnection As String 34 | 35 | Implements ICHPlugin 36 | 37 | Private Sub Class_Initialize() 38 | Call InitData 39 | 40 | Set m_TemplateDataSet = OpenData("SELECT * FROM Snippet ORDER BY key") 41 | Set m_MarkerDataSet = OpenData("SELECT * FROM Marker") 42 | End Sub 43 | 44 | Private Sub Class_Terminate() 45 | Call CloseData 46 | End Sub 47 | 48 | Private Sub InitData() 49 | m_sConnection = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\code_templates.mdb;" 50 | End Sub 51 | 52 | Private Function GetConnection() As Connection 53 | Set GetConnection = New Connection 54 | GetConnection.ConnectionString = m_sConnection 55 | Call GetConnection.Open 56 | End Function 57 | 58 | Private Function GetRecordSet() As Recordset 59 | Set GetRecordSet = New Recordset 60 | GetRecordSet.CursorLocation = adUseClient 61 | GetRecordSet.CursorType = adOpenStatic 62 | GetRecordSet.LOCKTYPE = adLockBatchOptimistic 63 | End Function 64 | 65 | Private Function OpenData(query As String) As Recordset 66 | Dim oRecords As Recordset 67 | Dim oConnection As Connection 68 | 69 | On Error GoTo EXIT_POINT 70 | Set oConnection = GetConnection 71 | Set oRecords = GetRecordSet 72 | 73 | Set oRecords.ActiveConnection = oConnection 74 | Call oRecords.Open(query) 75 | Set oRecords.ActiveConnection = Nothing 76 | 77 | Set OpenData = oRecords 78 | 79 | EXIT_POINT: 80 | On Error Resume Next 81 | Set oRecords.ActiveConnection = Nothing 82 | 83 | Call oConnection.Close 84 | Set oConnection = Nothing 85 | 86 | If Err.Number <> 0 Then 87 | Call MsgBox("Error while opening code_templates.mdb." & vbCrLf & Err.Description & vbCrLf & _ 88 | "Please make sure that code_templates.mdb file is placed in the same folder as CHCoder.dll", _ 89 | vbInformation, "CodeHelp Coder Error") 90 | 91 | End If 92 | Err.Clear 93 | End Function 94 | 95 | Friend Sub SaveData() 96 | Dim oConnection As Connection 97 | 98 | Set oConnection = GetConnection 99 | Set m_TemplateDataSet.ActiveConnection = oConnection 100 | Call m_TemplateDataSet.UpdateBatch 101 | Set m_TemplateDataSet.ActiveConnection = Nothing 102 | 103 | 104 | Call oConnection.Close 105 | Set oConnection = Nothing 106 | End Sub 107 | 108 | Private Sub CloseData() 109 | Set m_TemplateDataSet = Nothing 110 | Set m_MarkerDataSet = Nothing 111 | End Sub 112 | 113 | 114 | Private Property Let ICHPlugin_CHCore(ByVal RHS As Long) 115 | 'Save the Pointer for later use 116 | m_CHCorePtr = RHS 117 | End Property 118 | 119 | Private Property Get ICHPlugin_CopyRight() As String 120 | ICHPlugin_CopyRight = CH_COPYRIGHT 121 | End Property 122 | 123 | Private Property Get ICHPlugin_Description() As String 124 | ICHPlugin_Description = CH_DESCRIPTION 125 | End Property 126 | 127 | Private Property Let ICHPlugin_Enabled(ByVal Enabled As Boolean) 128 | 'Enable/disable this plugin in plugin manager 129 | 'if disable the ondisconnect method will be called, and the plugin will be excluded from 130 | 'msg processing 131 | m_IsEnabled = Enabled 132 | End Property 133 | 134 | Private Property Get ICHPlugin_Enabled() As Boolean 135 | 'Enable/disable this plugin in plugin manager 136 | 'if disable the ondisconnect method will be called, and the plugin will be excluded from 137 | 'msg processing 138 | ICHPlugin_Enabled = m_IsEnabled 139 | End Property 140 | 141 | Private Property Get ICHPlugin_HaveExtendedHelp() As Boolean 142 | 'Enable/disable help button in plugin manager 143 | End Property 144 | 145 | Private Property Get ICHPlugin_HaveProperties() As Boolean 146 | 'Enable/disable properties button in plugin manager 147 | ICHPlugin_HaveProperties = True 148 | End Property 149 | 150 | Private Property Get ICHPlugin_LongName() As String 151 | ICHPlugin_LongName = CH_LONGNAME 152 | End Property 153 | 154 | Private Property Get ICHPlugin_Name() As String 155 | ICHPlugin_Name = App.Title 156 | End Property 157 | 158 | Private Sub ICHPlugin_OnConnection(ByVal ConnectMode As CodeHelpDef.ext_ConnectMode, custom() As Variant) 159 | 'Sample use of the ICHCore pointer 160 | 'It's advisable not to save the ICHCore object itself, always use the helper function to obtain the 161 | 'ICHCore object from the pointer 162 | Dim hWnd As Long 163 | Dim oCHCore As ICHCore 164 | Dim sMakeItWork As String 165 | 166 | hWnd = GetFocus() 167 | 168 | If GetWinText(hWnd, True) = VBA_WIN Then 169 | If InStr(1, GetWinText(hWnd), "(Code)") Then 170 | m_CodeWinFocused = True 171 | End If 172 | End If 173 | 174 | Set oCHCore = CHHelper.GetCHCore(m_CHCorePtr) 175 | If m_MenuItem Is Nothing Then 176 | sMakeItWork = oCHCore.VBE.Name 177 | Set m_MenuItem = oCHCore.AddToCodeHelpMenu("Snippets", Nothing) 178 | Set m_oMenuEvents = oCHCore.VBE.Events.CommandBarEvents(m_MenuItem) 179 | End If 180 | 181 | Set oCHCore = Nothing 182 | End Sub 183 | 184 | Private Sub ICHPlugin_OnDisconnect(ByVal RemoveMode As CodeHelpDef.ext_DisconnectMode, custom() As Variant) 185 | Call CloseData 186 | End Sub 187 | 188 | Private Function ShiftPressed() As Boolean 189 | ShiftPressed = (GetKeyState(vbKeyShift) And &H8000) <> 0 190 | End Function 191 | 192 | Private Sub ICHPlugin_OnKeyHook(bHandled As Boolean, lReturn As Long, wParam As Long, lParam As Long) 193 | If m_CodeWinFocused Then 194 | If Not ShiftPressed Then Exit Sub 'ignore when the shift key is not down 195 | If wParam = vbKeySpace Then 196 | If CHHelper.IsKeyDownEvent(lParam) Then 'only process keydown 197 | If ProcessLine Then 198 | lReturn = 1 199 | bHandled = True 200 | End If 201 | End If 202 | End If 203 | End If 204 | End Sub 205 | 206 | Private Sub ICHPlugin_OnWinProc(ByVal hWnd As Long, ByVal uMsg As Long, wParam As Long, lParam As Long, _ 207 | bHandled As Boolean, lReturn As Long) 208 | 'subclassed message goes here 209 | End Sub 210 | 211 | Private Sub ICHPlugin_OnWinProcHook(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long, _ 212 | bHandled As Boolean, placeSubclass As Boolean, before As Boolean) 213 | 'Hook msg goes here 214 | Select Case uMsg 215 | Case WM_SETFOCUS 216 | m_CodeWinFocused = False 217 | If GetWinText(hWnd, True) = VBA_WIN Then 218 | If InStr(1, GetWinText(hWnd), "(Code)") Then 219 | m_CodeWinFocused = True 220 | End If 221 | End If 222 | End Select 223 | End Sub 224 | 225 | Private Sub ICHPlugin_ShowHelp() 226 | 'Show help instruction when user click on help button in plugin manager 227 | End Sub 228 | 229 | Private Sub ICHPlugin_ShowPropertyDialog() 230 | Dim frmProperties As frmProp 231 | Set frmProperties = New frmProp 232 | 233 | Call frmProperties.Initalize(m_TemplateDataSet, m_MarkerDataSet, Me) 234 | Call frmProperties.Show(vbModal) 235 | Call Unload(frmProperties) 236 | 237 | Set frmProperties = Nothing 238 | End Sub 239 | 240 | Private Property Get ICHPlugin_Version() As String 241 | ICHPlugin_Version = App.Major & "." & App.Minor & "." & App.Revision 242 | End Property 243 | 244 | Private Sub m_oMenuEvents_Click(ByVal CommandBarControl As Object, handled As Boolean, CancelDefault As Boolean) 245 | Call ICHPlugin_ShowPropertyDialog 246 | End Sub 247 | 248 | 249 | Private Function GetWinText(hWnd As Long, Optional className As Boolean = False) As String 250 | 'some static vars to speed up things, this func will be called many times 251 | Static sBuffer As String * 128& 'is it safe to use 128 bytes? should be enough.. 252 | Static textLength As Long 253 | 254 | If className Then 255 | textLength = A_GetClassName(hWnd, sBuffer, 129&) 256 | Else 257 | textLength = A_GetWindowText(hWnd, sBuffer, 129&) 258 | End If 259 | 260 | If textLength > 0 Then 261 | GetWinText = Left$(sBuffer, textLength) 262 | End If 263 | 264 | End Function 265 | 266 | Private Function ProcessLine() As Boolean 267 | Dim lStartLine As Long, lStartCol As Long 268 | Dim lEndLine As Long, lEndCol As Long 269 | Dim lReplaceLine As Long 270 | Dim sLine As String, sMatch As String 271 | Dim sTemplate As String, sIndent As String 272 | Dim lMatchLength As Long 273 | Dim oActiveCodePane As CodePane 274 | 275 | Set oActiveCodePane = GetCHCore(m_CHCorePtr).VBE.ActiveCodePane 276 | 277 | If m_TemplateDataSet.RecordCount < 1 Then Exit Function 278 | 279 | Call oActiveCodePane.GetSelection(lStartLine, lStartCol, lEndLine, lEndCol) 280 | sLine = oActiveCodePane.CodeModule.Lines(lStartLine, 1) 281 | 282 | 'parse the current line for the target 283 | Do While Mid$(sLine, lStartCol, 1) <> " " And lStartCol > 1 284 | lStartCol = lStartCol - 1 285 | Loop 286 | If Mid$(sLine, lStartCol, 1) = " " Then lStartCol = lStartCol + 1 287 | Do While Mid$(sLine, lEndCol, 1) <> " " _ 288 | And Mid$(sLine, lEndCol, 1) <> vbCr _ 289 | And lEndCol < Len(sLine) 290 | lEndCol = lEndCol + 1 291 | Loop 292 | 293 | sMatch = Mid$(sLine, lStartCol, lEndCol - lStartCol) 294 | lMatchLength = Len(sMatch) 295 | Call m_TemplateDataSet.MoveFirst 296 | Call m_TemplateDataSet.Find("Key='" & sMatch & "'") 297 | 298 | If m_TemplateDataSet.EOF = False Then 299 | sLine = Left$(sLine, Len(sLine) - lMatchLength) 300 | sTemplate = m_TemplateDataSet.Fields(1).Value 301 | 302 | 'match indentation when the template is multi-line 303 | sIndent = vbCrLf & IndentationToMatchLine(sLine) 304 | sTemplate = Replace(sTemplate, vbCrLf, sIndent) 305 | lReplaceLine = lStartLine 306 | 307 | ProcessLine = GetNewSelection(sLine, sTemplate, lStartLine, lStartCol, lEndLine, lEndCol) 308 | sLine = sLine & sTemplate 309 | Call oActiveCodePane.CodeModule.ReplaceLine(lReplaceLine, sLine) 310 | Call oActiveCodePane.SetSelection(lStartLine, lStartCol, lEndLine, lEndCol) 311 | End If 312 | End Function 313 | 314 | 'if GetNewSelection returns true then we don't insert a space 315 | Private Function GetNewSelection(sLine As String, sTemplate As String, lStartLine As Long, lStartCol As Long, _ 316 | lEndLine As Long, lEndCol As Long) As Boolean 317 | Dim lLinePos As Long 318 | Dim lLastLinePos As Long 319 | Dim lFirstLineNum As Long 320 | Dim lSelStart As Long 321 | Dim lSelEnd As Long 322 | 323 | lFirstLineNum = lStartLine 324 | lSelStart = InStr(1, sTemplate, "") 325 | If lSelStart = 0 Then 'if no selection is specified then just do something default 326 | GetNewSelection = False 327 | lStartCol = InStr(1, sTemplate, vbCrLf) 328 | If lSelStart = 0 Then 329 | lStartCol = Len(sLine) + Len(sTemplate) + 1 'move to just after the template 330 | Else 331 | lStartCol = Len(sLine) + lSelStart 'move to the end of the first line inserted 332 | End If 333 | lEndCol = lStartCol 334 | lEndLine = lStartLine 335 | 336 | Else 'figure out where the selection is supposed to go 337 | GetNewSelection = True 338 | sTemplate = Replace(sTemplate, "", "") 'remove the selection start token 339 | 340 | lSelEnd = InStr(1, sTemplate, "") 341 | sTemplate = Replace(sTemplate, "", "") 'remove the selection end token 342 | 343 | lLinePos = InStr(1, sTemplate, vbCrLf) 344 | If lLinePos = 0 Then 'single line template 345 | lEndLine = lStartLine 346 | lStartCol = Len(sLine) + lSelStart 347 | lEndCol = Len(sLine) + lSelEnd 348 | 349 | Else 350 | Dim sclipboardtext As String 351 | 352 | sclipboardtext = "-- sLine --" & vbCrLf & "[" & sLine & "]" & vbCrLf & "-- stemplate --" & vbCrLf & _ 353 | "[" & sTemplate & "]" & vbCrLf & _ 354 | "lSelStart, lSelEnd, lFirstLineNum " & lFirstLineNum & ", " & lSelStart & ", " & lSelEnd & vbCrLf 355 | 356 | 357 | lLastLinePos = lLinePos 358 | Do While lLinePos < lSelStart 359 | lLastLinePos = lLinePos 360 | lLinePos = InStr(lLinePos + 1, sTemplate, vbCrLf) 361 | lStartLine = lStartLine + 1 362 | Loop 363 | lStartCol = lSelStart 364 | If lFirstLineNum = lStartLine Then lStartCol = lStartCol + Len(sLine) 'if the first linebreak is after `` 365 | If lLastLinePos < lSelStart Then lStartCol = lStartCol - lLastLinePos - 1 'adjust the start col to be relative to beginning of line 366 | 367 | sclipboardtext = sclipboardtext & "lStartLine, lStartCol, lEndLine, lEndCol " & _ 368 | lStartLine & ", " & lStartCol & ", " & lEndLine & ", " & lEndCol & vbCrLf & _ 369 | "lLastLinePos, lLinePos " & lLastLinePos & ", " & lLinePos & vbCrLf 370 | 371 | lEndLine = lStartLine 372 | lLastLinePos = lLinePos 373 | Do While lLastLinePos < lSelEnd 374 | lLastLinePos = lLinePos 375 | lLinePos = InStr(lLinePos + 1, sTemplate, vbCrLf) 376 | lEndLine = lEndLine + 1 377 | Loop 378 | lEndCol = lSelEnd 379 | If lLastLinePos < lSelEnd Then lEndCol = lEndCol - lLastLinePos 380 | If lEndLine = lFirstLineNum Then lEndCol = lEndCol + Len(sLine) 381 | 382 | sclipboardtext = sclipboardtext & "lStartLine, lStartCol, lEndLine, lEndCol " & _ 383 | lStartLine & ", " & lStartCol & ", " & lEndLine & ", " & lEndCol & vbCrLf & _ 384 | "lLastLinePos, lLinePos " & lLastLinePos & ", " & lLinePos & vbCrLf 385 | 386 | 387 | Call Clipboard.SetText(sclipboardtext) 388 | End If 389 | 390 | End If 391 | End Function 392 | 393 | Private Function IndentationToMatchLine(sLine As String) As String 394 | Dim sIndent As String 395 | Dim lIndentLevel As Long 396 | 397 | lIndentLevel = 1 398 | Do While Mid$(sLine, lIndentLevel, 1) = " " 399 | lIndentLevel = lIndentLevel + 1 400 | Loop 401 | lIndentLevel = lIndentLevel - 1 'compensate for 1-based indicies 402 | 403 | sIndent = "" 404 | Do While lIndentLevel > 0 405 | sIndent = sIndent & " " 406 | lIndentLevel = lIndentLevel - 1 407 | Loop 408 | 409 | IndentationToMatchLine = sIndent 410 | End Function 411 | 412 | -------------------------------------------------------------------------------- /Plugins/TabIndex/MouseTrap.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | Persistable = 0 'NotPersistable 5 | DataBindingBehavior = 0 'vbNone 6 | DataSourceBehavior = 0 'vbNone 7 | MTSTransactionMode = 0 'NotAnMTSObject 8 | END 9 | Attribute VB_Name = "MouseTrap" 10 | Attribute VB_GlobalNameSpace = False 11 | Attribute VB_Creatable = True 12 | Attribute VB_PredeclaredId = False 13 | Attribute VB_Exposed = False 14 | Option Explicit 15 | Private Const SS_OWNERDRAW As Long = &HD& 16 | Private Const TEXT_FORMAT As Long = DT_CENTER Or DT_SINGLELINE Or DT_VCENTER 17 | 18 | Private Declare Function LoadCursorLong Lib "user32.dll" Alias "LoadCursorA" (ByVal hInstance As Long, ByVal lpCursorName As Long) As Long 19 | Private Declare Function RedrawWindow Lib "user32.dll" (ByVal hwnd As Long, ByRef lprcUpdate As Any, ByVal hrgnUpdate As Long, ByVal fuRedraw As Long) As Long 20 | 21 | Private m_VBForm As VBForm 22 | Private m_ParentWindow As Window 23 | 24 | Private m_hMDIClient As Long 25 | Private m_hDesigner As Long 26 | Private m_hForm As Long 27 | 28 | Private m_tR As RECT 29 | 'Private m_DC As MemoryDC 30 | Private m_highestIdx As Integer 31 | Private m_currentIdx As Integer 32 | Private m_hWnd As Long 33 | Private m_Font As IFont 34 | 'Private m_CtlOver As Object 35 | 36 | Dim tOffset As POINTAPI 37 | Dim hCursor As Long 38 | Event Closed() 39 | 40 | 41 | 'Private Property Set HoveredControl(ByVal value As Object) 42 | ' 43 | ' If Not (value Is m_CtlOver) Then 44 | '' If Not m_CtlOver Is Nothing Then 45 | '' 46 | '' End If 47 | ' Set m_CtlOver = value 48 | ' PostMessage m_hWnd, WM_PAINT, ByVal 0, ByVal 0 49 | ' 'RedrawWindow m_hWnd, ByVal 0, 0, RDW_INVALIDATE Or RDW_UPDATENOW Or RDW_ERASE 50 | ' End If 51 | ' 52 | 'End Property 53 | 54 | Public Property Set FormDesigner(ByVal objFormDesigner As VBForm) 55 | Set m_VBForm = objFormDesigner 56 | End Property 57 | 58 | Public Property Set ParentWindow(ByVal objParentWindow As Window) 59 | Dim hChild As Long 60 | 61 | 'Set m_DC = New MemoryDC 62 | Set m_ParentWindow = objParentWindow 63 | 64 | m_hMDIClient = A_FindWindowEx(m_ParentWindow.VBE.MainWindow.hwnd, 0, "MDIClient", vbNullString) 65 | m_hDesigner = A_FindWindowEx(m_hMDIClient, 0, "DesignerWindow", m_ParentWindow.Caption & vbNullChar) 66 | 67 | If m_hDesigner = 0 Then Err.Raise vbObjectError, "Create", "Can not find Designer Window" 68 | hChild = GetWindow(m_hDesigner, GW_CHILD) 69 | 70 | Do While hChild <> 0 71 | If Left$(GetWinText(hChild, True), 7) = "Thunder" Then 72 | m_hForm = hChild 73 | Exit Do 74 | End If 75 | hChild = GetWindow(hChild, GW_HWNDNEXT) 76 | Loop 77 | 78 | If m_hForm <> 0 Then 79 | CreateTrap 80 | End If 81 | End Property 82 | 83 | Public Property Get hWndTrap() As Long 84 | hWndTrap = m_hWnd 85 | End Property 86 | 87 | Public Property Get hWndFormDesigner() As Long 88 | hWndFormDesigner = m_hDesigner 89 | End Property 90 | 91 | Public Property Get hWndForm() As Long 92 | hWndForm = m_hForm 93 | End Property 94 | 95 | Private Sub CreateTrap() 96 | Dim tCS As CREATESTRUCT 97 | 98 | m_hWnd = A_CreateWindowEx(WS_EX_TRANSPARENT, "Static", "", WS_CHILD Or SS_OWNERDRAW, m_tR.Left, m_tR.Top, _ 99 | m_tR.Right - m_tR.Left, m_tR.Bottom - m_tR.Top, m_hDesigner, 0, App.hInstance, tCS) 100 | 101 | If m_hWnd <> 0 Then 102 | Set m_Font = New StdFont 103 | m_Font.Name = "Arial" 104 | m_Font.Size = 8 105 | m_Font.Bold = True 106 | hCursor = LoadCursorLong(0, IDC_CROSS) 107 | End If 108 | End Sub 109 | 110 | Sub ShowTabOrder() 111 | 112 | SynchContents 113 | SetWindowPos m_hWnd, HWND_TOP, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE Or SWP_SHOWWINDOW Or SWP_NOSENDCHANGING Or SWP_NOACTIVATE 114 | m_highestIdx = m_VBForm.VBControls.Count - 1& 115 | DoEvents 'Allow window to show before redraw 116 | RedrawWindow m_hWnd, ByVal 0, 0, RDW_INVALIDATE Or RDW_UPDATENOW 117 | End Sub 118 | 119 | Private Sub OnMouseDown(Button As MouseButtonConstants, ByVal x As Long, ByVal y As Long) 120 | Dim vbCtl As Object 121 | 122 | If Button = vbLeftButton Then 123 | Set vbCtl = FindControlOnPoint(x, y) 124 | If Not vbCtl Is Nothing Then 125 | vbCtl.TabIndex = m_currentIdx 126 | RedrawWindow m_hWnd, ByVal 0, 0, RDW_INVALIDATE Or RDW_UPDATENOW 127 | m_currentIdx = m_currentIdx + 1 128 | If m_currentIdx > m_highestIdx Then m_currentIdx = 0 129 | End If 130 | Else 131 | m_currentIdx = 0 132 | End If 133 | 134 | End Sub 135 | 136 | Private Sub OnPaint() 137 | 138 | Dim parentForm As Object 139 | 140 | Dim tR As RECT 141 | Dim hDC As Long 142 | Dim hOldBr As Long, hOldPen As Long 143 | Dim hBr As Long, hPen As Long 144 | Dim hOldFont As Long 145 | Dim lPenColor As Long 146 | 147 | tOffset.x = 0 148 | tOffset.y = 0 149 | 150 | hDC = GetDC(m_hWnd) 151 | SetBkMode hDC, TRANSPARENT 152 | 'BitBlt hdc, 0, 0, m_DC.Width, m_DC.Height, m_DC.hdc, 0, 0, vbSrcCopy 153 | 154 | 'Draw Border 155 | lPenColor = GetSysColor(COLOR_HIGHLIGHT) 156 | hPen = CreatePen(PS_SOLID, 2, lPenColor) 157 | hOldPen = SelectObject(hDC, hPen) 158 | 159 | 'Get the form coordinate 160 | GetClientRect m_hForm, tR 161 | MapWindowPoints m_hForm, m_hWnd, tOffset, 1 162 | OffsetRect tR, tOffset.x, tOffset.y 163 | 164 | 'Draw box around the form, as indicator we're in tab order mode 165 | MoveToExNoRet hDC, tR.Left, tR.Top, ByVal 0 166 | LineTo hDC, tR.Right, tR.Top 167 | LineTo hDC, tR.Right, tR.Bottom 168 | LineTo hDC, tR.Left, tR.Bottom 169 | LineTo hDC, tR.Left, tR.Top - 1& 170 | 171 | SelectObject hDC, hOldPen 172 | DeleteObject hPen 173 | 174 | 'Draw quick tip 175 | Dim tipFont As IFont 176 | 177 | Set tipFont = New StdFont 178 | tipFont.Name = "Arial" 179 | tipFont.Size = 8 180 | 181 | hBr = GetSysColorBrush(COLOR_INFOBK) 182 | hOldBr = SelectObject(hDC, hBr) 183 | 184 | hOldFont = SelectObject(hDC, tipFont.hFont) 185 | 'draw tip in caption area 186 | OffsetRect tR, 0, -20 187 | 188 | Rectangle hDC, tR.Left - 1&, tR.Top - 1&, tR.Right + 1&, tR.Top + 18 189 | A_DrawText hDC, " Reset click index to 0 with right click", -1, tR, DT_LEFT 190 | 191 | SelectObject hDC, hOldFont 192 | SelectObject hDC, hOldBr 193 | Set tipFont = Nothing 194 | 195 | OffsetRect tR, 0, 20 196 | 197 | 'Draw tab indexes 198 | hOldFont = SelectObject(hDC, m_Font.hFont) 199 | hBr = GetSysColorBrush(COLOR_HIGHLIGHT) 200 | hOldBr = SelectObject(hDC, hBr) 201 | 202 | lPenColor = GetSysColor(COLOR_HIGHLIGHTTEXT) 203 | hPen = CreatePen(PS_SOLID, 1, lPenColor) 204 | hOldPen = SelectObject(hDC, hPen) 205 | 206 | SetTextColor hDC, lPenColor 207 | 208 | If m_VBForm.ContainedVBControls.Count > 0 Then 209 | 210 | DrawContainedControls hDC, parentForm, Nothing, m_VBForm.ContainedVBControls 211 | 212 | End If 213 | 'Clean up GDI resources 214 | SelectObject hDC, hOldFont 215 | SelectObject hDC, hOldBr 216 | SelectObject hDC, hOldPen 217 | DeleteObject hPen 218 | ReleaseDC m_hWnd, hDC 219 | End Sub 220 | 221 | Private Sub DrawContainedControls(ByVal hDC As Long, ByRef parentForm As Object, ByVal parentCtl As Object, ByVal container As ContainedVBControls) 222 | 223 | On Error Resume Next 224 | 225 | Dim vbCtl As VBControl, ctl As Object 226 | Dim tR As RECT 227 | Dim iIdx As Integer 228 | Dim tPt As POINTAPI 229 | 230 | For Each vbCtl In container 231 | Set ctl = vbCtl.ControlObject 232 | 233 | If parentForm Is Nothing Then 'set the root form object 234 | Set parentForm = ctl.Parent 235 | End If 236 | 237 | iIdx = ctl.TabIndex 238 | 239 | ' tPt.x = ctl.Left 240 | ' tPt.y = ctl.Top 241 | ' 242 | ' If Not (parentCtl Is Nothing) Then 243 | ' If parentForm.ScaleMode <> parentCtl.ScaleMode Then 244 | ' tPt.x = parentForm.ScaleX(tPt.x, parentCtl.ScaleMode, parentForm.ScaleMode) 245 | ' tPt.y = parentForm.ScaleY(tPt.y, parentCtl.ScaleMode, parentForm.ScaleMode) 246 | ' End If 247 | ' 248 | ' tPt.x = tPt.x + parentCtl.Left 249 | ' tPt.y = tPt.y + parentCtl.Top 250 | ' End If 251 | ' 252 | ' tPt.x = parentForm.ScaleX(tPt.x, parentForm.ScaleMode, vbPixels) 253 | ' tPt.y = parentForm.ScaleY(tPt.y, parentForm.ScaleMode, vbPixels) 254 | 255 | tR = GetChildRect(ctl, parentForm) 256 | tR.Left = tR.Left + tOffset.x 257 | tR.Top = tR.Top + tOffset.y 258 | tR.Right = tR.Left + 20& 259 | tR.Bottom = tR.Top + 20& 260 | 261 | Rectangle hDC, tR.Left, tR.Top, tR.Right, tR.Bottom 262 | 263 | A_DrawText hDC, CStr(iIdx), -1, tR, TEXT_FORMAT 264 | 265 | 'recursively draw controls in container 266 | If vbCtl.ContainedVBControls.Count > 0 Then 267 | DrawContainedControls hDC, parentForm, ctl, vbCtl.ContainedVBControls 268 | End If 269 | Next 270 | 271 | End Sub 272 | 273 | Private Sub DestroyTrap() 274 | If m_hWnd <> 0 Then 275 | Set m_VBForm = Nothing 276 | Set m_ParentWindow = Nothing 277 | 278 | A_PostMessage m_hWnd, WM_CLOSE, ByVal 0, ByVal 0 279 | A_PostMessage m_hMDIClient, WM_PAINT, ByVal 0, ByVal 0 280 | A_PostMessage m_hDesigner, WM_PAINT, ByVal 0, ByVal 0 281 | Set m_Font = Nothing 282 | 283 | End If 284 | End Sub 285 | 286 | Private Sub SynchContents() 287 | 288 | GetWindowRect m_hForm, m_tR 289 | InflateRect m_tR, 8, 8 290 | 'convert to client coordinate 291 | MapWindowPoints 0, m_hDesigner, m_tR, 2 292 | 293 | MoveWindow m_hWnd, m_tR.Left, m_tR.Top, m_tR.Right - m_tR.Left, m_tR.Bottom - m_tR.Top, 1 294 | 295 | End Sub 296 | 297 | Private Function GetWinText(hwnd As Long, Optional className As Boolean = False) As String 298 | 'some static vars to speed up things, this func will be called many times 299 | Static sBuffer As String * 128& 300 | Static textLength As Long 301 | 302 | If className Then 303 | textLength = A_GetClassName(hwnd, sBuffer, 129&) 304 | Else 305 | textLength = A_GetWindowText(hwnd, sBuffer, 129&) 306 | End If 307 | 308 | If textLength > 0 Then 309 | GetWinText = Left$(sBuffer, textLength) 310 | End If 311 | 312 | End Function 313 | 314 | Private Function FindControlOnPoint(ByVal x As Long, ByVal y As Long) As Object 315 | 316 | Dim parentForm As Object 317 | 318 | Set FindControlOnPoint = HitTestContainer(x, y, parentForm, Nothing, m_VBForm.ContainedVBControls) 319 | 320 | End Function 321 | 322 | Private Function HitTestContainer(ByVal x As Long, ByVal y As Long, _ 323 | ByRef parentForm As Object, ByVal parentCtl As Object, _ 324 | ByVal container As ContainedVBControls) As Object 325 | 326 | Dim vbCtl As VBControl, ctl As Object 327 | Dim result As Object 328 | Dim tR As RECT 329 | 330 | For Each vbCtl In container 331 | 332 | Set ctl = vbCtl.ControlObject 333 | 334 | If parentForm Is Nothing Then 335 | Set parentForm = ctl.Parent 336 | End If 337 | 338 | If vbCtl.ContainedVBControls.Count > 0 Then 339 | Set result = HitTestContainer(x, y, parentForm, ctl, vbCtl.ContainedVBControls) 340 | End If 341 | 342 | If result Is Nothing Then 343 | tR = GetChildRect(ctl, parentForm) 344 | 345 | If PtInRect(tR, x - tOffset.x, y - tOffset.y) Then 346 | Set result = ctl 347 | Exit For 348 | End If 349 | Else 350 | Exit For 351 | End If 352 | 353 | Next 354 | 355 | Set HitTestContainer = result 356 | End Function 357 | 358 | Private Sub Class_Terminate() 359 | DestroyTrap 360 | End Sub 361 | 362 | Sub TrapProc(ByVal bBefore As Boolean, bHandled As Boolean, lReturn As Long, hwnd As Long, uMsg As Long, wParam As Long, lParam As Long) 363 | 364 | Select Case hwnd 365 | Case m_hForm 366 | RaiseEvent Closed 367 | 368 | Case m_hWnd 369 | Select Case uMsg 370 | Case WM_NCHITTEST 371 | lReturn = HTCLIENT 372 | bHandled = True 373 | 374 | Case WM_LBUTTONDOWN 375 | OnMouseDown vbLeftButton, LoWord(lParam), HiWord(lParam) 376 | 377 | Case WM_RBUTTONDOWN 378 | OnMouseDown vbRightButton, LoWord(lParam), HiWord(lParam) 379 | 380 | Case WM_SYSCOMMAND 381 | If wParam = SC_CLOSE Then 382 | bHandled = True 383 | A_PostMessage m_hWnd, WM_CLOSE, ByVal 0, ByVal 0 384 | A_PostMessage m_hForm, uMsg, ByVal wParam, ByVal lParam 385 | End If 386 | 387 | Case WM_SETCURSOR 388 | SetCursor hCursor 389 | bHandled = True 390 | 391 | ' Case WM_MOUSEMOVE 392 | ' Set HoveredControl = FindControlOnPoint(LoWord(lParam), HiWord(lParam)) 393 | 394 | End Select 395 | 396 | 397 | Case m_hDesigner 398 | OnPaint 399 | End Select 400 | End Sub 401 | 402 | Private Function LoWord(lDWord As Long) As Integer 403 | 404 | If lDWord And &H8000& Then 405 | LoWord = lDWord Or &HFFFF0000 406 | Else 407 | LoWord = lDWord And &HFFFF& 408 | End If 409 | 410 | End Function 411 | 412 | Private Function HiWord(lDWord As Long) As Integer 413 | HiWord = (lDWord And &HFFFF0000) \ &H10000 414 | End Function 415 | 416 | Private Function GetChildRect(ctl As Object, ByVal parentForm As Object) As RECT 417 | Dim tR As RECT 418 | Dim parentCtl As Object, parentOrg As Object 419 | Dim tCtlOffset As POINTAPI 420 | Dim lastParent As Object 421 | 422 | On Error Resume Next 423 | 424 | Set parentCtl = ctl.container 425 | Set parentOrg = parentCtl 426 | 427 | Do While Not (parentCtl Is Nothing) 428 | If Not lastParent Is Nothing Then 429 | tR.Left = tR.Left + GetScaledMeasure(tCtlOffset.x, lastParent, parentForm, True) 430 | tR.Top = tR.Top + GetScaledMeasure(tCtlOffset.y, lastParent, parentForm, False) 431 | End If 432 | 433 | If Not parentCtl Is parentForm Then 434 | tCtlOffset.x = parentCtl.Left 435 | tCtlOffset.y = parentCtl.Top 436 | End If 437 | Set lastParent = parentCtl 438 | Err.Clear 439 | Set parentCtl = parentCtl.container 440 | If Err.Number <> 0 Then 441 | Set parentCtl = Nothing 442 | End If 443 | Loop 444 | 445 | tR.Left = tR.Left + GetScaledMeasure(ctl.Left, parentOrg, parentForm, True) 446 | tR.Top = tR.Top + GetScaledMeasure(ctl.Top, parentOrg, parentForm, False) 447 | tR.Right = tR.Left + GetScaledMeasure(ctl.Width, parentOrg, parentForm, True) 448 | tR.Bottom = tR.Top + GetScaledMeasure(ctl.Height, parentOrg, parentForm, False) 449 | 450 | GetChildRect = tR 451 | End Function 452 | 453 | 454 | Private Function GetScaledMeasure(ByVal value As Long, ByVal container As Object, ByVal parentForm As Object, ByVal isX As Boolean) As Long 455 | On Error Resume Next 456 | 457 | If isX Then 458 | GetScaledMeasure = parentForm.ScaleX(value, container.ScaleMode, vbPixels) 459 | If Err.Number <> 0 Then 460 | GetScaledMeasure = parentForm.ScaleX(value, vbTwips, vbPixels) 461 | End If 462 | Else 463 | GetScaledMeasure = parentForm.ScaleY(value, container.ScaleMode, vbPixels) 464 | If Err.Number <> 0 Then 465 | GetScaledMeasure = parentForm.ScaleY(value, vbTwips, vbPixels) 466 | End If 467 | End If 468 | End Function 469 | --------------------------------------------------------------------------------