editor.frm

------ DebugAsm Editor使用说明 ------ 本软件是采用DEUBG作ASM程式设计的工具,采用本人 自创的工程方案,令你的ASM程式设计更方便.

Dim fgCharSet As Integer             '字符集切换标志

Dim fgDigital As Integer             '数字与其它字符切换
Dim fgInstruction As Integer         '指令与其它字符切换

Private Sub about_Click()                                  '关于
  MsgBox Me.Caption, vbOKOnly, "关于"
End Sub

Private Sub Check1_Click()                                 '紧凑模式

  If Check1.Value = vbChecked Then
    SaveSetting App.EXEName, "Setting", "CompactMode", "1"
  Else
    SaveSetting App.EXEName, "Setting", "CompactMode", "0"
  End If
  
End Sub

Private Sub Command1_Click()                               '新建
  Call new_Click
End Sub

Private Sub Command10_Click()                              '设定选中部分色彩
  CommonDialog2.Action = 3
  RichTextBox1.SelColor = CommonDialog2.Color
End Sub

Private Sub copyRTF_Click()                                '复制/剪切时,包含格式(RTF)

  copyRTF.Checked = True
  copyTextOnly.Checked = False
  
  SaveSetting App.EXEName, "Setting", "CopyCut", "0"
  
End Sub

Private Sub copyTextOnly_Click()                           '复制/剪切时,仅包含文本(Text)

  copyRTF.Checked = False
  copyTextOnly.Checked = True
  
  SaveSetting App.EXEName, "Setting", "CopyCut", "1"
   
End Sub

Private Sub meuAutoClearTempFiles_Click()

  If meuAutoClearTempFiles.Checked = True Then
    meuAutoClearTempFiles.Checked = False
  Else
    meuAutoClearTempFiles.Checked = True
  End If
  
  SaveSetting App.EXEName, "Setting", "ClearTempFiles", meuAutoClearTempFiles.Checked

End Sub

Private Sub meuFontColorCharString_Click()
  RichTextBox1.SelColor = QBColor(8)                       '字符标识符 ' or "
End Sub

Private Sub meuFontColorDig_Click()
  RichTextBox1.SelColor = QBColor(12)                      '数字色彩
End Sub

Private Sub meuFontColorListSeparator_Click()
  RichTextBox1.SelColor = QBColor(9)                       '分隔符
End Sub

Private Sub meuFontColorMark_Click()
  RichTextBox1.SelColor = QBColor(3)                       '注释开始色彩
End Sub

Private Sub meuFontColorOther_Click()
  RichTextBox1.SelColor = QBColor(0)                       '其它
End Sub

Private Sub Command11_Click()                              '斜体
  Call meuFontIt_Click
End Sub

Private Sub Command12_Click()                              '加粗
  Call meuFontBold_Click
End Sub

Private Sub Command2_Click()                               '打开文件
  Call open_Click
End Sub

Private Sub Command3_Click()                               '保存文件
  Call save_Click
End Sub

Private Sub Command4_Click()                               '复制
  Call copy_Click
End Sub

Private Sub Command5_Click()                               '剪切
  Call cut_Click
End Sub

Private Sub Command6_Click()                               '粘贴
  Call paste_Click
End Sub

Private Sub Command7_Click()                               '全选
  Call select_Click
End Sub

Private Sub Command8_Click()                               '编译
  Call startLink_Click
End Sub

Private Sub Command9_Click()                               '运行
  Call start_Click
End Sub

Private Sub copy_Click()                                   '复制

  Clipboard.Clear
  
  If copyRTF.Checked = True Then
    Clipboard.SetText RichTextBox1.SelRTF
  Else
    Clipboard.SetText RichTextBox1.SelText
  End If
  
End Sub

Private Sub cut_Click()                                    '剪切

  Clipboard.Clear
  
  If copyRTF.Checked = True Then
    Clipboard.SetText RichTextBox1.SelRTF
  Else
    Clipboard.SetText RichTextBox1.SelText
  End If
  
  RichTextBox1.SelRTF = ""
  
End Sub

Private Sub exit_Click()                                   '退出
  Unload Me
End Sub

Private Sub Form_Unload(Cancel As Integer)                 '退出窗体
  
  If fgFileChange = 1 Then     '如果文件已更改
    
    '提示保存文件
    If MsgBox("文件已更改，是否要保存它？", vbYesNo, "提示") = vbYes Then
      Call save_Click
    End If
    
  End If
  
  '清除临时文件
  If Dir$(App.Path & "\run.bat") <> "" Then
    Kill App.Path & "\run.bat"
  End If
  
End Sub

Private Sub meuFontBold_Click()                            '字体加粗

 If RichTextBox1.SelBold = 0 Then
    meuFontBold.Checked = True
    RichTextBox1.SelBold = 1
 Else
    meuFontBold.Checked = False
    RichTextBox1.SelBold = 0
 End If
 
End Sub

Private Sub meufontColor_Click()                           '设定字体色彩
  Call Command10_Click
End Sub

Private Sub Form_Load()                                    '载入窗体

 Dim temp As String
 Dim i As Integer
 
  fgInstruction = 1                  '默认输入为指令

  SPLT_COLOR = &H808080
  CurrSplitPosY = &H7FFFFFFF
  
  CTRL_OFFSET = Label4.Left + Label4.Width
  
  Me.Caption = Me.Caption & " Ver" & GetAppVer & " by ZHB - http://yxbasic.51.net"
  Label1.Caption = App.Path & "\noname.dap"
  
  For i = 0 To 2                                           '读入历史操作记录
  
    temp = GetSetting(App.EXEName, "History", "file" & Trim$(Str$(i)), "")
    
    If temp <> "" Then
    
      history(i).Visible = True
      aa.Visible = True
      
      history(i).Caption = temp
      fIndex = fIndex + 1
      
    End If
    
  Next
  
  If Val(GetSetting(App.EXEName, "Setting", "CompactMode", "0")) = 1 Then
    Check1.Value = vbChecked
  Else
    Check1.Value = vbUnchecked
  End If
  
  If Val(GetSetting(App.EXEName, "Setting", "CopyCut", "0")) = 0 Then
    copyRTF.Checked = True
    copyTextOnly.Checked = False
  Else
    copyRTF.Checked = False
    copyTextOnly.Checked = True
  End If
  
  If GetSetting(App.EXEName, "Setting", "ClearTempFiles", "True") = "True" Then
    meuAutoClearTempFiles.Checked = True
  Else
    meuAutoClearTempFiles.Checked = False
  End If
  
  RichTextBox1.Font.Size = 12        '默认的字体大小
  
End Sub

Private Sub Form_Resize()                                  '窗体大小变化时

On Error GoTo handle
  
  RichTextBox1.Width = Me.Width - 120
  RichTextBox1.Height = RichTextBox1.Height + 80
 
  List1.Width = Me.Width - 120
  List1.Top = List1.Top + 80
  List1.Height = Me.ScaleHeight - List1.Top
  
  Label4.Top = RichTextBox1.Top + RichTextBox1.Height
   
  Check1.Top = Label4.Top
  Check1.Left = Me.Width - Check1.Width
  
  Splitter.Top = Label4.Top
  Splitter.Width = Check1.Left - CTRL_OFFSET
  
handle:

End Sub

Private Sub help_Click()                                   '打开帮助文件

 If Dir$(App.Path & "\readme.txt") <> "" Then
   Shell "notepad " & App.Path & "\readme.txt", vbNormalFocus
 Else
   MsgBox "找不到帮助文件Readme.txt"
 End If
 
End Sub

Private Sub history_Click(Index As Integer)                '用历史记录打开

  If Me.Caption <> App.Path & "\noname.dap" Then
  
    RichTextBox1.LoadFile (history(Index).Caption)
    Label1.Caption = history(Index).Caption
    
  Else
    MsgBox "未打开任何文件或当前文件尚未保存！"
  End If
  
End Sub

Private Sub meuFontIt_Click()                              '字体倾斜

 If RichTextBox1.SelItalic = 0 Then
    meuFontIt.Checked = True
    RichTextBox1.SelItalic = 1
 Else
    meuFontIt.Checked = False
    RichTextBox1.SelItalic = 0
 End If
 
End Sub

Private Sub meuFontSet_Click()                             '字体设定

 On Error GoTo err
 
  CommonDialog2.Action = 4
  
  RichTextBox1.SelFontName = CommonDialog2.FontName
  RichTextBox1.SelFontSize = CommonDialog2.FontSize
  RichTextBox1.SelBold = CommonDialog2.FontBold
  RichTextBox1.SelItalic = CommonDialog2.FontItalic
  RichTextBox1.SelStrikeThru = CommonDialog2.FontStrikethru
  RichTextBox1.SelUnderline = CommonDialog2.FontUnderline
  
err:
End Sub

Private Sub meuMailtoZhb_Click()
  Call shellexecute(Me.hwnd, "open", "mailto:[e-mail]", "", "", SW_SHOW)
End Sub

Private Sub new_Click()                                    '新建文件

  '初始化RichTextBox
  RichTextBox1.Text = ""
  RichTextBox1.Font.Size = 12        '默认的字体大小
  RichTextBox1.Font.Name = "Tahoma"
  
  '清空编译结果
  List1.Clear
  
  '默认文件名
  Label1.Caption = App.Path & "\noname.dap"
  
  '恢复文件更改标志
  fgFileChange = 0
  
End Sub

Private Sub open_Click()                                   '打开文件

  CommonDialog1.FileName = ""
  CommonDialog1.DialogTitle = "打开文件"
  CommonDialog1.Filter = "DebugAsm工程文件(*.dap)|*.dap|ASM源代码文件(*.asm)|*.asm"
  CommonDialog1.InitDir = GetSetting(App.EXEName, "Setting", "Init_Dir", App.Path & "\project")
  CommonDialog1.ShowOpen
  
  If CommonDialog1.FileName = "" Then
    Exit Sub
  End If
  
  If fIndex >= 3 Then                                      '确定历史记录数量是否已达3个(保存最后3个)
  
    history(0).Caption = history(1).Caption                '之前记录逐个更新
    SaveSetting App.EXEName, "History", "file0", history(1).Caption
    
    history(1).Caption = history(2).Caption
    SaveSetting App.EXEName, "History", "file1", history(2).Caption
    
    fIndex = 2                                             '在最后面添加
    
  End If
  
  history(fIndex).Visible = True                           '允许显示历史记录
  aa.Visible = True                                        '显示分隔线
  
  history(fIndex).Caption = CommonDialog1.FileName
  SaveSetting App.EXEName, "History", "file" & Trim$(Str$(fIndex)), CommonDialog1.FileName
  
  fIndex = fIndex + 1                                      '记录索引加1
  
  '打开文件
  If Dir$(CommonDialog1.FileName) <> "" Then
  
    Call new_Click                                         '先清空,再载入
    
    If LCase$(Right$(CommonDialog1.FileName, 4)) = ".dap" Then
    
      '从工程文件中载入
      FileName = CommonDialog1.FileName
      mainName = Left$(FileName, Len(FileName) - 4)        '取得主文件名
      
      Call LoadASMFile(mainName & ".asm", 1)

    Else
    
      Call LoadASMFile(CommonDialog1.FileName, 0)
      
    End If
    
    Label1.Caption = CommonDialog1.FileName                '显示文件名
    
    fgFileChange = 0
    
  Else
    MsgBox "文件" + CommonDialog1.FileName + "不存在!"
  End If
  
  SaveSetting App.EXEName, "Setting", "Init_Dir", CommonDialog1.FileName
  
End Sub

Sub LoadASMFile(asmfile As String, Saved As Integer)       '载入ASM文件

  Dim a$
  Dim i As Integer
  
  '生成默认的Rich着色文件
  Open App.Path & "\noname.rtf" For Output As #2
  
    'rtf格式定义: rtf1 --- RTF version, ansi --- 字符, deflang1033 --- 语言, fnottbl --- 字体表: f0 --- Tahoma  f1 --- 中文
    Print #2, "{\rtf1\ansi\ansicpg936\deff0\deflang1033\deflangfe2052{\fonttbl{\f0\fnil\fcharset0 Tahoma;}{\f1\fmodern\fprq6\fcharset134 \'cb\'ce\'cc\'e5;}}"
    
    'QBCOLOR 0~15 色彩代码表(cf1~16)
    Print #2, "{\colortbl;\red0\green0\blue0;\red0\green0\blue128;\red0\green128\blue0;\red0\green128\blue128;\red128\green0\blue0;\red128\green0\blue128;\red128\green128\blue0;\red192\green192\blue192;\red128\green128\blue128;\red0\green0\blue255;\red0\green255\blue0;\red0\green255\blue255;\red255\green0\blue0;\red255\green0\blue255;\red255\green255\blue0;\red255\green255\blue255;}"
    
    '默认的色彩，语言，字体等值    |----cf1: \red0\green0\blue0
    Print #2, "\viewkind4\uc1\pard\cf1\lang2052\f0\fs24";
 
    '读入原文件.asm
    Open asmfile For Input As #1
  
      Do

        '读入一行代码
        Line Input #1, a$
        
        '空行，快速跳过自动着色处理
        If Trim$(a$) = "" Then
          GoTo fast
        End If
        
        '自动着色该行
        For i = 1 To Len(a$)
          Call ConvetToRichText(Asc(Mid$(a$, i, 1)))
        Next