frmmain.frm

1、从Keil C源代码中自动提取中文字符

         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)