mfrmprogram.frm

非常有用得编辑器软件源码

      End
      Begin VB.Menu mnuStart 
         Caption         =   "Startup Manager"
         Shortcut        =   {F2}
      End
      Begin VB.Menu mnu4 
         Caption         =   "-"
      End
      Begin VB.Menu mnuExit 
         Caption         =   "Exit (&X)"
      End
   End
   Begin VB.Menu mnuEdit_Top 
      Caption         =   "Edit (&E)"
      Enabled         =   0   'False
      Begin VB.Menu mnuUndo 
         Caption         =   "Undo (&U)"
      End
      Begin VB.Menu mnuRedo 
         Caption         =   "Redo (&R)"
      End
      Begin VB.Menu mnu3 
         Caption         =   "-"
      End
      Begin VB.Menu mnuCut 
         Caption         =   "&Cut"
         Enabled         =   0   'False
      End
      Begin VB.Menu mnuCopy 
         Caption         =   "&Copy"
         Enabled         =   0   'False
      End
      Begin VB.Menu mnuPaste 
         Caption         =   "&Paste"
         Enabled         =   0   'False
      End
      Begin VB.Menu mnuDelete 
         Caption         =   "&Delete"
         Enabled         =   0   'False
      End
      Begin VB.Menu mnuSelectAll 
         Caption         =   "&Select All"
      End
   End
   Begin VB.Menu mnuView_Top 
      Caption         =   "View (&V)"
      Begin VB.Menu mnuView_menustyle 
         Caption         =   "Menu Style (&M)"
         Begin VB.Menu mnuView_MenuOption 
            Caption         =   "Menu Option... (&O)"
            Begin VB.Menu mnuView_CusMenu 
               Caption         =   "Customize... (&C)"
            End
         End
         Begin VB.Menu mnu5 
            Caption         =   "-"
         End
         Begin VB.Menu mnuView_style 
            Caption         =   "Sky Blue"
            Index           =   1
         End
         Begin VB.Menu mnuView_style 
            Caption         =   "Clear XP Style"
            Index           =   2
         End
      End
      Begin VB.Menu mnuView_Toolbox 
         Caption         =   "Tools Box"
         Checked         =   -1  'True
      End
      Begin VB.Menu mnuView_ProjectMan 
         Caption         =   "Project Manager"
      End
      Begin VB.Menu mnuDetail 
         Caption         =   "Show Detail (&D)"
      End
   End
   Begin VB.Menu mnuInsert 
      Caption         =   "Insert (&I)"
      Enabled         =   0   'False
      Begin VB.Menu mnuISTimage 
         Caption         =   "Image"
      End
      Begin VB.Menu mnuISTlink 
         Caption         =   "Hyperlink"
      End
      Begin VB.Menu mnuISTtarget 
         Caption         =   "Target"
      End
      Begin VB.Menu mnuISTvideo 
         Caption         =   "Video"
      End
   End
   Begin VB.Menu mnuFormat 
      Caption         =   "Format (&O)"
      Enabled         =   0   'False
      Begin VB.Menu mnuFMTpagepro 
         Caption         =   "Page Properties..."
      End
   End
   Begin VB.Menu mnuTools 
      Caption         =   "Tools (&T)"
      Enabled         =   0   'False
      Begin VB.Menu mnuTool_Rainbow 
         Caption         =   "Color-Fading Text"
      End
   End
   Begin VB.Menu mnuCustomize 
      Caption         =   "Customize (&C)"
      Begin VB.Menu mnuCUSpreference 
         Caption         =   "Preference..."
      End
   End
   Begin VB.Menu mnuTable 
      Caption         =   "Table (&A)"
      Enabled         =   0   'False
      Begin VB.Menu mnuTBLnew 
         Caption         =   "Insert Table"
      End
   End
   Begin VB.Menu mnuWindow 
      Caption         =   "Window (&W)"
      WindowList      =   -1  'True
      Begin VB.Menu mnuWindowCascade 
         Caption         =   "Cascade (&C)"
      End
      Begin VB.Menu mnuWindowTileHorizontal 
         Caption         =   "Horizontal (&H)"
      End
      Begin VB.Menu mnuWindowTileVertical 
         Caption         =   "Vertical (&V)"
      End
   End
   Begin VB.Menu mnuHelp_Top 
      Caption         =   "Help (&H)"
      Begin VB.Menu mnuAbout 
         Caption         =   "About"
      End
      Begin VB.Menu mnuPSC 
         Caption         =   "Connect to Planet-Source-Code..."
      End
   End
   Begin VB.Menu mnuExt 
      Caption         =   ""
      Enabled         =   0   'False
      Begin VB.Menu extCut 
         Caption         =   "Cut"
         Enabled         =   0   'False
      End
      Begin VB.Menu extCopy 
         Caption         =   "Copy"
         Enabled         =   0   'False
      End
      Begin VB.Menu extPaste 
         Caption         =   "Paste"
         Enabled         =   0   'False
      End
      Begin VB.Menu extDelete 
         Caption         =   "Delete"
      End
      Begin VB.Menu extAll 
         Caption         =   "Select All"
      End
      Begin VB.Menu ext1 
         Caption         =   "-"
      End
      Begin VB.Menu extProperties 
         Caption         =   "Properties..."
         Begin VB.Menu extPagePro 
            Caption         =   "Page Properties"
         End
         Begin VB.Menu extImagePro 
            Caption         =   "Image Properties"
            Enabled         =   0   'False
         End
         Begin VB.Menu extTablePro 
            Caption         =   "Table Properties"
            Enabled         =   0   'False
         End
         Begin VB.Menu extTDPro 
            Caption         =   "Table Cell Properties"
            Enabled         =   0   'False
         End
         Begin VB.Menu extAPro 
            Caption         =   "Hyperlink Properties"
            Enabled         =   0   'False
         End
         Begin VB.Menu extFontsPro 
            Caption         =   "Fonts Properties"
            Enabled         =   0   'False
         End
      End
      Begin VB.Menu ext2 
         Caption         =   "-"
      End
      Begin VB.Menu extAbs 
         Caption         =   "Absolute Position"
         Enabled         =   0   'False
      End
      Begin VB.Menu extDetail 
         Caption         =   "Show Detail"
      End
      Begin VB.Menu extSnap 
         Caption         =   "Snap to Grid"
      End
      Begin VB.Menu extInHTML 
         Caption         =   "Insert Custom HTML"
      End
      Begin VB.Menu extTableGeneral 
         Caption         =   "Table..."
         Begin VB.Menu extInCol 
            Caption         =   "Insert Colume"
         End
         Begin VB.Menu extInRow 
            Caption         =   "Insert Row"
         End
         Begin VB.Menu extMerge 
            Caption         =   "Merge Cells"
         End
         Begin VB.Menu extSplit 
            Caption         =   "Split Cell"
         End
      End
      Begin VB.Menu extAbsGeneral 
         Caption         =   "Absolute object..."
         Begin VB.Menu extFront 
            Caption         =   "Bring to Front"
         End
         Begin VB.Menu extForeward 
            Caption         =   "Bring Foreward"
         End
         Begin VB.Menu extAboveText 
            Caption         =   "Bring above text"
         End
         Begin VB.Menu extBack 
            Caption         =   "Send to Back"
         End
         Begin VB.Menu extBackward 
            Caption         =   "Send Backward"
         End
         Begin VB.Menu extBelowText 
            Caption         =   "Send below text"
         End
      End
      Begin VB.Menu extGetTag 
         Caption         =   "Get Element TagName"
      End
   End
   Begin VB.Menu mnuCustom 
      Caption         =   "Custom"
      Visible         =   0   'False
      Begin VB.Menu cusDel 
         Caption         =   "Delete Record"
      End
   End
End
Attribute VB_Name = "MfrmProgram"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Dim i As Integer
Dim WithEvents STimer As SSubTimer6.CTimer
Attribute STimer.VB_VarHelpID = -1

Private Sub cobFormat_Click()
On Error Resume Next
If ActiveForm.DHTML1.ExecCommand(DECMD_GETBLOCKFMT) <> cobFormat.Text Then
    ActiveForm.DHTML1.ExecCommand DECMD_SETBLOCKFMT, , cobFormat.Text
End If
End Sub

Private Sub cobSize_Click()
On Error Resume Next
If ActiveForm.DHTML1.ExecCommand(DECMD_GETFONTSIZE) <> cobSize.Text Then
    ActiveForm.DHTML1.ExecCommand DECMD_SETFONTSIZE, , cobSize.Text
End If
End Sub

Private Sub cpBack_Click()
On Error Resume Next
ActiveForm.DHTML1.ExecCommand DECMD_SETBACKCOLOR, , RGB2HTML(cpBack.Color)
ActiveForm.DHTML1.SetFocus
End Sub

Private Sub cpFore_Click()
On Error Resume Next
ActiveForm.DHTML1.ExecCommand DECMD_SETFORECOLOR, , RGB2HTML(cpFore.Color)
ActiveForm.DHTML1.SetFocus
End Sub

Private Sub FileTab_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim dnum As Integer
dnum = CInt(Mid(FileTab.SelectedItem.Key, 4))
Creator(dnum).SetFocus
End Sub

Private Sub Font1_Click()
On Error Resume Next
If ActiveForm.DHTML1.ExecCommand(DECMD_GETFONTNAME) <> Font1.Text Then
    ActiveForm.DHTML1.ExecCommand DECMD_SETFONTNAME, , Font1.Text
End If
End Sub

Private Sub MDIForm_Activate()
ToolBoxTab True, frmToolBox.SSTab1
End Sub

Private Sub MDIForm_Load()

    Me.Hide
    DoEvents
    frmSplash.lbl.Caption = "initializing DHTML Edit Control..."
    DoEvents
    DE1.NewDocument
    
    DoEvents
    frmSplash.lbl.Caption = "initializing Font Select Control..."
    Font1.MakeFonts
    Font1.MakeMeFlat
    
    'Show the Tool Box or not
    DoEvents
    frmSplash.lbl.Caption = "Showing Toolbox..."
    Dim B As Boolean
    B = GetOption("showtoolbox", True)
    mnuView_Toolbox.Checked = B
    If B = True Then
        Load frmToolBox
        ToolBoxTab True, frmToolBox.SSTab1
    End If
    
    DoEvents
    frmSplash.lbl.Caption = "Setting Varibles..."
    'Varible work
    Set STimer = New SSubTimer6.CTimer
    STimer.Interval = 1
    
    FontSizePoint(1) = 8
    FontSizePoint(2) = 10
    FontSizePoint(3) = 12
    FontSizePoint(4) = 14
    FontSizePoint(5) = 18
    FontSizePoint(6) = 24
    FontSizePoint(7) = 36
    
    DoEvents
    frmSplash.lbl.Caption = "Prepare User Interface..."
    PrepareUI
    Me.Show
    frmSplash.Hide
    Unload frmSplash
    Me.SetFocus
    
    Dim Start As String
    Start = GetOption("startup", "true")
    If Start = "true" Then mnuStart_Click

End Sub

Sub PrepareUI()

    cpFore.MakeMeFlat