?? frmmain.frm
字號:
Alignment = 2 'Center
Appearance = 0 'Flat
AutoSize = -1 'True
BackColor = &H80000005&
BackStyle = 0 'Transparent
Caption = "<<最近工程"
BeginProperty Font
Name = "宋體"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 360
Index = 2
Left = 10320
TabIndex = 20
Top = 2040
Width = 1380
End
Begin VB.Label lblCmd
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
BackStyle = 0 'Transparent
Caption = "退出"
BeginProperty Font
Name = "宋體"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 360
Index = 5
Left = 10320
TabIndex = 16
Top = 7560
Width = 1440
End
Begin VB.Label lblCmd
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
BackStyle = 0 'Transparent
Caption = "字模文件生成↓"
Enabled = 0 'False
BeginProperty Font
Name = "宋體"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 360
Index = 4
Left = 4800
TabIndex = 15
Top = 7620
Width = 2100
End
Begin VB.Label lblCmd
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
BackStyle = 0 'Transparent
Caption = "輸出文件"
BeginProperty Font
Name = "宋體"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 300
Index = 3
Left = 10320
TabIndex = 14
Top = 3660
Width = 1440
End
Begin VB.Label Label1
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "輸出文件"
BeginProperty Font
Name = "宋體"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 300
Index = 1
Left = 60
TabIndex = 2
Top = 3720
Width = 1380
WordWrap = -1 'True
End
Begin VB.Shape ShapeCmd
BackColor = &H00FFC0C0&
BackStyle = 1 'Opaque
BorderWidth = 2
FillColor = &H00FFC0C0&
Height = 495
Index = 3
Left = 10320
Shape = 2 'Oval
Top = 3540
Width = 1395
End
Begin VB.Shape ShapeCmd
BackColor = &H00FFC0C0&
BackStyle = 1 'Opaque
BorderWidth = 2
FillColor = &H00FFC0C0&
Height = 495
Index = 4
Left = 4770
Shape = 2 'Oval
Top = 7500
Width = 2115
End
Begin VB.Shape ShapeCmd
BackColor = &H00FFC0C0&
BackStyle = 1 'Opaque
BorderWidth = 2
FillColor = &H00FFC0C0&
Height = 495
Index = 5
Left = 10320
Shape = 2 'Oval
Top = 7440
Width = 1395
End
Begin VB.Shape ShapeCmd
BackColor = &H00FFC0C0&
BackStyle = 1 'Opaque
BorderWidth = 2
FillColor = &H00FFC0C0&
Height = 495
Index = 2
Left = 10320
Shape = 2 'Oval
Top = 1920
Width = 1395
End
Begin VB.Shape ShapeCmd
BackColor = &H00FFC0C0&
BackStyle = 1 'Opaque
BorderWidth = 2
FillColor = &H00FFC0C0&
Height = 495
Index = 1
Left = 10320
Shape = 2 'Oval
Top = 1140
Width = 1395
End
Begin VB.Shape ShapeCmd
BackColor = &H00FFC0C0&
BackStyle = 1 'Opaque
BorderWidth = 2
FillColor = &H00FFC0C0&
Height = 495
Index = 0
Left = 10320
Shape = 2 'Oval
Top = 360
Width = 1395
End
Begin VB.Shape ShapeCmd
BackColor = &H00FFC0C0&
BackStyle = 1 'Opaque
BorderWidth = 2
FillColor = &H00FFC0C0&
Height = 495
Index = 6
Left = 10320
Shape = 2 'Oval
Top = 6240
Width = 1395
End
End
End
Attribute VB_Name = "frmChineseFetch"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Const FILE_OPEN As Long = 1
Const FILE_SAVE As Long = 2
Dim ChnCnt As Long
Dim DefaultFntWidth As Long, DefaultFntHeight As Long
Dim FntKinds As Long, EntireStr() As String, sFntsize() As String, FntName() As String, FntWidth() As Long, FntHeight() As Long
Dim ftxtno() As Integer, txtFile() As String, FntCFile() As String, MyAppPath As String
Const SRC_C As Long = 1
Const SRC_TXT As Long = 2
Dim SrcFileType As Long
Dim CurChrInd As Long, OutDstFile As String
Dim Pow2 As Variant
Dim PageStart() As Long, PageInd As Long
Const ZoomX As Long = 2
Const ZoomY As Long = 2
Const FColor As Long = &HFFFF00
Const BColor As Long = &H8000&
Private Sub SaveRecent()
Dim i As Long
Call WritePrivateProfileString("目標文件", "SaveAs", CStr(txtChineseFile.Text), IniFile)
Call WritePrivateProfileString("目標文件", "附加信息", CStr(txtHeader.Text), IniFile)
Call WritePrivateProfileString("源文件類型", "文件類型", CStr(IIf(SrcFileType = SRC_C, 0, 1)), IniFile)
For i = 0 To LstSrcFile.ListCount - 1
Call WritePrivateProfileString("源文件", "Source" + CStr(i + 1), LstSrcFile.List(i), IniFile)
Next i
For i = i To 99
Call WritePrivateProfileString("源文件", "Source" + CStr(i + 1), vbEmpty, IniFile)
Next i
Call WritePrivateProfileString("字體配置", "字體名", ComboFntName.List(ComboFntName.ListIndex), IniFile)
Call WritePrivateProfileString("字體配置", "默認字體大小", CStr(DefaultFntWidth), IniFile)
Call WritePrivateProfileString("字體配置", "使用點陣字體", CStr(chkUseDotFnt.Value), IniFile)
Call WritePrivateProfileString("字體配置", "粗體", CStr(chkFntSpecial(0).Value), IniFile)
Call WritePrivateProfileString("字體配置", "斜體", CStr(chkFntSpecial(1).Value), IniFile)
Call WritePrivateProfileString("字體配置", "下劃線", CStr(chkFntSpecial(2).Value), IniFile)
Call WritePrivateProfileString("字體配置", "刪除線", CStr(chkFntSpecial(3).Value), IniFile)
End Sub
Private Sub ReadRecent()
Dim i As Long, str As String * 2048, Ss As String, StrArray As Variant
i = GetPrivateProfileString("目標文件", "SaveAs", "", str, Len(str), IniFile)
txtChineseFile.Text = Left(str, i)
i = GetPrivateProfileString("目標文件", "附加信息", "", str, Len(str), IniFile)
txtHeader.Text = Left(str, i)
i = GetPrivateProfileInt("源文件類型", "文件類型", 0, IniFile)
If i > 1 Then i = 0
LstSrcFile.Clear
i = GetPrivateProfileSection("源文件", str, Len(str), IniFile)
Ss = Left(str, i)
If InStr(Ss, Chr(0)) > 0 Then
Ss = Left(str, i - 1): StrArray = Split(Ss, Chr(0))
For i = 0 To UBound(StrArray)
Ss = Trim(Mid(StrArray(i), InStrRev(StrArray(i), "=") + 1))
If Ss <> "" Then LstSrcFile.AddItem Ss
Next i
Else
LstSrcFile.AddItem Ss
End If
Call GetPrivateProfileString("字體配置", "字體名", "宋體", str, Len(str), IniFile)
Ss = Left(str, InStr(str, Chr(0)) - 1)
With ComboFntName
For i = 0 To .ListCount - 1
If Ss = .List(i) Then Exit For
Next i
If i < .ListCount Then
.ListIndex = i
Else: .ListIndex = -1 '.AddItem Ss: .ListIndex = .ListCount - 1
End If
End With
i = GetPrivateProfileString("字體配置", "默認字體大小", "16", str, Len(str), IniFile)
Ss = Left(str, InStr(str, Chr(0)) - 1)
If ComboFntName.ListIndex >= 0 Then
With ComboFntSize(ComboFntName.ListIndex)
Ss = Ss + "X" + Ss
For i = 0 To .ListCount - 1
If Ss = .List(i) Then Exit For
Next i
If i < .ListCount Then
.ListIndex = i
ElseIf .Style = vbComboDropdown Then
.Text = Ss
Else: .ListIndex = -1
End If
End With
End If
chkUseDotFnt.Value = GetPrivateProfileInt("字體配置", "使用點陣字體", 1, IniFile)
chkFntSpecial(0).Value = GetPrivateProfileInt("字體配置", "粗體", 0, IniFile)
chkFntSpecial(1).Value = GetPrivateProfileInt("字體配置", "斜體", 0, IniFile)
chkFntSpecial(2).Value = GetPrivateProfileInt("字體配置", "下劃線", 0, IniFile)
chkFntSpecial(3).Value = GetPrivateProfileInt("字體配置", "刪除線", 0, IniFile)
End Sub
Private Sub SetHZDotReader(ByVal FntInd As Long)
Dim ckey As Long
Dim KeyValue(0 To 11) As Long
KeyValue(0) = FntWidth(FntInd) / 2: KeyValue(1) = FntHeight(FntInd)
KeyValue(2) = IIf(chkUseDotFnt.Value = 1, 1, 0)
If chkFntSpecial(0).Enabled Then
KeyValue(3) = IIf(chkFntSpecial(0).Value = 1, &H2BC&, &H190)
KeyValue(4) = IIf(chkFntSpecial(1).Value = 1, 1, 0)
KeyValue(5) = IIf(chkFntSpecial(2).Value = 1, 1, 0)
KeyValue(6) = IIf(chkFntSpecial(3).Value = 1, 1, 0)
End If
KeyValue(9) = 3&
ckey = GetSettingsKey()
If ckey = 0 Then
ckey = RegSetValueEx(HK, "字體名", 0, REG_SZ, ByVal ComboFntName.List(ComboFntName.ListIndex), 5)
ckey = RegSetValueEx(HK, "字寬", 0, REG_DWORD, KeyValue(0), 4)
ckey = RegSetValueEx(HK, "字高", 0, REG_DWORD, KeyValue(1), 4)
ckey = RegSetValueEx(HK, "點陣字庫", 0, REG_DWORD, KeyValue(2), 4)
ckey = RegSetValueEx(HK, "字粗", 0, REG_DWORD, KeyValue(3), 4)
ckey = RegSetValueEx(HK, "傾斜", 0, REG_DWORD, KeyValue(4), 4)
ckey = RegSetValueEx(HK, "下劃線", 0, REG_DWORD, KeyValue(5), 4)
ckey = RegSetValueEx(HK, "刪除線", 0, REG_DWORD, KeyValue(6), 4)
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -