Skip to content

Commit

Permalink
v1.7
Browse files Browse the repository at this point in the history
1. Rename the add-in from TkinterDesigner to Vb6Tkinter.
2. Add check update feature.
3. If only Python3 code is required, generate better Python3-style code.
4. By default, disable the option "Compatibile with Python 2/3 code".
  • Loading branch information
cdhigh committed Jan 2, 2024
1 parent 8a2b8c4 commit 76669aa
Show file tree
Hide file tree
Showing 40 changed files with 1,424 additions and 705 deletions.
Binary file removed Bin/TkinterDesigner.dll
Binary file not shown.
Binary file removed Bin/TkinterDesigner.exp
Binary file not shown.
Binary file removed Bin/TkinterDesigner.lib
Binary file not shown.
Binary file removed Bin/Vb6_SP6_Fix_for_Win7_and_Upper.exe
Binary file not shown.
4 changes: 0 additions & 4 deletions Bin/Vb6_SP6_Fix_for_Win7_and_Upper.txt

This file was deleted.

Binary file removed Bin/regtlib.exe
Binary file not shown.
79 changes: 78 additions & 1 deletion Common.bas
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
Attribute VB_Name = "Common"
Option Explicit

Public VBE As VBE
Public VbeInst As VBE

Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Expand Down Expand Up @@ -66,6 +66,12 @@ Public g_Comps() As Object '

Public g_bUnicodePrefixU As Boolean '是否在UNICODE字符串前加前缀u
Public g_PythonExe As String '用于GUI预览,保存python.exe全路径
Public g_AppVerString As String

Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Public Const OFFICIAL_SITE As String = "https://github.com/cdhigh/Vb6Tkinter"
Public Const OFFICIAL_RELEASES As String = "https://github.com/cdhigh/Vb6Tkinter/releases"
Public Const OFFICIAL_UPDATE_INFO As String = "https://api.github.com/repos/cdhigh/Vb6Tkinter/releases"

'PYTHON中UNICODE字符串前缀的处理函数,如果字符串中存在双字节字符,则根据选项增加适当的前缀
'否则,只是简单的增加单引号,即使空串也增加一对单引号
Expand Down Expand Up @@ -403,3 +409,74 @@ Public Sub SortWidgets(ByRef aCompsSorted() As Object, ByVal cnt As Long)
Next

End Sub

'将版本号字符串前面和后面非数字部分都删除掉,比如:"v1.6.8 test" 将返回 "1.6.8"
Private Function purifyVerStr(txt As String) As String
Dim maxCnt As Integer, idx As Integer, startIdx As Integer, endIdx As Integer
Dim ch As String
txt = Trim(txt)
maxCnt = Len(txt)
startIdx = 1
endIdx = maxCnt
'开头部分
For idx = 1 To maxCnt
ch = Mid(txt, idx, 1)
If (ch >= "0") And (ch <= "9") Then
startIdx = idx
Exit For
End If
Next
'结尾部分
For idx = maxCnt To 1 Step -1
ch = Mid(txt, idx, 1)
If (ch >= "0") And (ch <= "9") Then
endIdx = idx
Exit For
End If
Next

If startIdx <= endIdx Then
purifyVerStr = Mid(txt, startIdx, endIdx - startIdx + 1)
Else
purifyVerStr = ""
End If
End Function

'比较两个版本号,确定新版本号是否比老版本号更新,
'版本号格式为:1.1.0
Public Function isVersionNewerThan(newVer As String, currVer As String) As Boolean
Dim newArr As Variant, currArr As Variant, idx As Integer, maxCnt As Integer
Dim vn As Integer, vc As Integer
newVer = purifyVerStr(newVer)
currVer = purifyVerStr(currVer)
If Len(newVer) = 0 Or Len(currVer) = 0 Then
isVersionNewerThan = False
Exit Function
End If

newArr = Split(newVer, ".")
currArr = Split(currVer, ".")
maxCnt = UBound(newArr)
If UBound(currArr) < maxCnt Then '两个数组最小的一个
maxCnt = UBound(currArr)
End If

For idx = 0 To maxCnt
vn = Val(newArr(idx))
vc = Val(currArr(idx))
If vn > vc Then
isVersionNewerThan = True
Exit Function
ElseIf vn < vc Then
isVersionNewerThan = False
Exit Function
End If
Next

'如果前面都一样,则长的一个为大
If UBound(newArr) > UBound(currArr) Then
isVersionNewerThan = True
Else
isVersionNewerThan = False
End If
End Function
36 changes: 21 additions & 15 deletions Connect.cls
Original file line number Diff line number Diff line change
Expand Up @@ -11,7 +11,7 @@ Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Attribute VB_Description = "TkinterDesigner"
Attribute VB_Description = "Vb6Tkinter"
Option Explicit

Private mcbMenuItem As Office.CommandBarControl
Expand Down Expand Up @@ -41,7 +41,7 @@ Private Sub IDTExtensibility_OnStartupComplete(custom() As Variant)
End Sub

Private Sub IDTExtensibility_OnConnection(ByVal VBInst As Object, ByVal ConnectMode As VBIDE.vbext_ConnectMode, ByVal AddInInst As VBIDE.AddIn, custom() As Variant)
Set Common.VBE = VBInst
Set VbeInst = VBInst

If ConnectMode = vbext_cm_Startup Or ConnectMode = vbext_cm_AfterStartup Then
AddToMenu (App.Title & "(&T)")
Expand Down Expand Up @@ -84,14 +84,15 @@ End Sub
'在外接程序菜单下增加一个菜单项
Private Sub AddToMenu(sCaption As String)
Dim cbMenuCommandBar As Office.CommandBarControl
Dim cbMenu
Dim cbMenu As Variant

On Error Resume Next

'察看能否找到外接程序菜单
Set cbMenu = VBE.CommandBars("Add-Ins")
Set cbMenu = VbeInst.CommandBars("外接程序")
If cbMenu Is Nothing Then Set cbMenu = VbeInst.CommandBars("Add-Ins")
If cbMenu Is Nothing Then Exit Sub

'添加它到命令栏
Set cbMenuCommandBar = cbMenu.Controls.Add(msoControlButton)
If cbMenuCommandBar Is Nothing Then Exit Sub
Expand All @@ -101,9 +102,13 @@ Private Sub AddToMenu(sCaption As String)
'设置标题
cbMenuCommandBar.Caption = sCaption

'DoEvents
'Clipboard.SetData LoadResPicture(101, vbResBitmap)
'cbMenuCommandBar.PasteFace
'DoEvents

Set mcbMenuItem = cbMenuCommandBar
Set MenuHandler = VBE.Events.CommandBarEvents(mcbMenuItem)

Set MenuHandler = VbeInst.Events.CommandBarEvents(mcbMenuItem)
End Sub

'在工具栏增加一个图标
Expand All @@ -113,26 +118,27 @@ Private Sub AddToToolBox(sCaption As String)

'察看能否找到标准工具栏
On Error Resume Next
Set cbStandard = VBE.CommandBars("标准")
If Err.Number <> 0 Then Set cbStandard = VBE.CommandBars("Standard")

Set cbStandard = VbeInst.CommandBars("标准")
If cbStandard Is Nothing Then Set cbStandard = VbeInst.CommandBars("Standard")
If cbStandard Is Nothing Then Set cbStandard = VbeInst.CommandBars(2)
If cbStandard Is Nothing Then Exit Sub

Err.Clear
On Error GoTo AddToAddInToolboxErr
'On Error GoTo AddToAddInToolboxErr
On Error Resume Next

'添加它到工具栏
Set cbToolboxCommandBar = cbStandard.Controls.Add(msoControlButton, , , cbStandard.Controls.Count)
cbToolboxCommandBar.BeginGroup = True
cbToolboxCommandBar.Caption = sCaption
Set mcbToolBoxItem = cbToolboxCommandBar
DoEvents
Clipboard.SetData LoadResPicture(101, vbResBitmap)
cbToolboxCommandBar.PasteFace
DoEvents

Set ToolBoxHandler = VBE.Events.CommandBarEvents(mcbToolBoxItem)

AddToAddInToolboxErr:

Set ToolBoxHandler = VbeInst.Events.CommandBarEvents(mcbToolBoxItem)
'AddToAddInToolboxErr:
End Sub

Private Sub MenuHandler_Click(ByVal CommandBarControl As Object, handled As Boolean, CancelDefault As Boolean)
Expand Down
Loading

0 comments on commit 76669aa

Please sign in to comment.