frmmain.frm

微软msde

   Begin VB.Menu mnuWindow 
      Caption         =   "窗口(&W)"
      WindowList      =   -1  'True
      Begin VB.Menu mnuWindowCascade 
         Caption         =   "层叠(&C)"
      End
      Begin VB.Menu mnuWindowTileHorizontal 
         Caption         =   "横向平铺(&H)"
      End
      Begin VB.Menu mnuWindowTileVertical 
         Caption         =   "纵向平铺(&V)"
      End
   End
   Begin VB.Menu mnuHelp 
      Caption         =   "帮助(&H)"
      Begin VB.Menu mnuHelpAbout 
         Caption         =   "关于(&A) "
      End
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Any) As Long
Const EM_UNDO = &HC7
Dim trs As ADODB.Recordset

Private Sub Combo1_Click()
    If ActiveForm Is Nothing Then
    Else
    ActiveForm.com.CommandText = "use [" + Combo1.Text + "]"
    On Error GoTo err
    ActiveForm.com.Execute , , adCmdText
    ActiveForm.StatusBar1.Panels(4).Text = Combo1.Text
    End If
    Exit Sub
err:
    MsgBox err.Description
End Sub

Private Sub Combo1_DropDown()
    cbtemp = Combo1.Text
End Sub





Private Sub MDIForm_Load()
    Me.Left = GetSetting(App.Title, "Settings", "MainLeft", 1000)
    Me.Top = GetSetting(App.Title, "Settings", "MainTop", 1000)
    Me.Width = GetSetting(App.Title, "Settings", "MainWidth", 6500)
    Me.Height = GetSetting(App.Title, "Settings", "MainHeight", 6500)
    tbToolBar.Enabled = True
    
    
    '根据注册表信息判断开放的权限
    Dim lauth As String
    Dim hKey As Long, ret As Long, lenData As Long, typeData As Long
    Dim Name, s As String
    RegOpenKey HKEY_CURRENT_USER, "ison", hKey
    Name = "key"
    RegQueryValueEx hKey, Name, 0, typeData, ByVal vbNullString, lenData
    s = String(lenData, Chr(0))
    If s <> "" Then
        RegQueryValueEx hKey, Name, 0, typeData, ByVal s, lenData '注意ByVal千万别忘了
        s = Left(s, InStr(s, Chr(0)) - 1)
        RegCloseKey hKey
        If s = "ison_sa" Then
            mnuFile.Visible = True
            mnuEdit.Visible = True
            mnuHelp.Visible = True
            mnuWindow.Visible = True
            tbToolBar.Visible = True
            LoadNewDoc
            Call comboReflash
        Else
            mnuFile.Visible = False
            mnuEdit.Visible = False
            mnuHelp.Visible = False
            mnuWindow.Visible = False
            tbToolBar.Visible = False
            Me.Width = 2865
            Me.Height = 1275
        End If
    Else
        mnuFile.Visible = False
        mnuEdit.Visible = False
        mnuHelp.Visible = False
        mnuWindow.Visible = False
        tbToolBar.Visible = False
        Me.Width = 2865
        Me.Height = 1275
    End If
End Sub


Public Sub LoadNewDoc()
    If ActiveForm Is Nothing Then CMenStaToC
    Dim frmD As frmDocument
    lDocumentCount = lDocumentCount + 1
    Set frmD = New frmDocument
    frmD.Show
    
End Sub


Private Sub MDIForm_Unload(Cancel As Integer)
    If Me.WindowState <> vbMinimized Then
        SaveSetting App.Title, "Settings", "MainLeft", Me.Left
        SaveSetting App.Title, "Settings", "MainTop", Me.Top
        SaveSetting App.Title, "Settings", "MainWidth", Me.Width
        SaveSetting App.Title, "Settings", "MainHeight", Me.Height
    End If
     Unload Me
     End
End Sub

Private Sub mnuEdit_Click()
If ActiveForm Is Nothing Then CMenStaToD
End Sub

Private Sub mnuFile_Click()
If ActiveForm Is Nothing Then CMenStaToD
End Sub

Private Sub mnuHelp_Click()
If ActiveForm Is Nothing Then CMenStaToD
End Sub

Private Sub mnuWindow_Click()
If ActiveForm Is Nothing Then CMenStaToD
End Sub

Private Sub tbToolBar_ButtonClick(ByVal Button As MSComctlLib.Button)
    On Error Resume Next
    Select Case Button.Key
        Case "新建"
            LoadNewDoc
            ActiveForm.StatusBar1.Panels(4).Text = Me.Combo1.Text
            comboReflash
        Case "打开"
            mnuFileOpen_Click
        Case "保存"
            mnuFileSave_Click
        Case "打印"
            mnuFilePrint_Click
        Case "剪切"
            mnuEditCut_Click
        Case "复制"
            mnuEditCopy_Click
        Case "粘贴"
            mnuEditPaste_Click
        Case "向前"
            mnuFileRun_click
        Case "dirrun"
        If ActiveForm Is Nothing Then
            MsgBox "请先连接！", 0
        Else
            directrun_Click
        End If
        Case "newdb"
             Dim dlgn As New DialogCreate
             dlgn.Show
        Case "backupdb"
             Dim dlgb As New DialogBackup
             dlgb.Show
        Case "restoredb"
             Dim dlgr As New DialogRestore
             dlgr.Show
        Case "newdevice"
             Dim dlgnd As New DialogNewDevice
             dlgnd.Show
        Case "refresh"
             comboReflash
        Case "deldev"
             Dim ddev As New Dialogdeldev
             ddev.Show
        End Select
End Sub

Private Sub mnuHelpAbout_Click()
    MsgBox "版本 " & App.Major & "." & App.Minor & "." & App.Revision
End Sub

Private Sub mnuWindowArrangeIcons_Click()
    Me.Arrange vbArrangeIcons
End Sub

Private Sub mnuWindowTileVertical_Click()
    Me.Arrange vbTileVertical
End Sub

Private Sub mnuWindowTileHorizontal_Click()
    Me.Arrange vbTileHorizontal
End Sub

Private Sub mnuWindowCascade_Click()
    Me.Arrange vbCascade
End Sub


Private Sub mnuEditPaste_Click()
    On Error Resume Next
    ActiveForm.rtfText.SelRTF = Clipboard.GetText

End Sub

Private Sub mnuEditCopy_Click()
    On Error Resume Next
    Clipboard.SetText ActiveForm.rtfText.SelRTF

End Sub

Private Sub mnuEditCut_Click()
    On Error Resume Next
    Clipboard.SetText ActiveForm.rtfText.SelRTF
    ActiveForm.rtfText.seltext = vbNullString

End Sub

Private Sub mnuEditUndo_Click()
    '应做:添加 'mnuEditUndo_Click' 代码。
    MsgBox "添加 'mnuEditUndo_Click' 代码。"
End Sub


Private Sub mnuFileExit_Click()
   mnuFiledisconnect_Click
    '卸载窗体
    Unload Me
End Sub

Private Sub mnuFilePrint_Click()
    On Error Resume Next
    If ActiveForm Is Nothing Then Exit Sub
    

    With dlgCommonDialog
        .DialogTitle = "Print"
        .CancelError = True
        .Flags = cdlPDReturnDC + cdlPDNoPageNums
        If ActiveForm.rtfText.SelLength = 0 Then
            .Flags = .Flags + cdlPDAllPages
        Else
            .Flags = .Flags + cdlPDSelection
        End If
        .ShowPrinter
        If err <> MSComDlg.cdlCancel Then
            ActiveForm.rtfText.SelPrint .hDC
        End If
    End With

End Sub

Private Sub mnuFileSaveAs_Click()
    Dim sfile As String
    

    If ActiveForm Is Nothing Then Exit Sub
    

    With dlgCommonDialog
        .DialogTitle = "另存为"
        .CancelError = False
        'ToDo: 设置 common dialog 控件的标志和属性
        .ShowSave
        If Len(.FileName) = 0 Then
            Exit Sub
        End If
        sfile = .FileName
    End With
        ActiveForm.Caption = sfile
        r = ActiveForm.rtfText.SaveFile(sfile, 1)

End Sub

Private Sub mnuFileSave_Click()
    Dim sfile As String
    If Left$(Right$(ActiveForm.Caption, 20), 8) = "query-no" Then
        With dlgCommonDialog
            .DialogTitle = "保存"
            .CancelError = False
            'ToDo: 设置 common dialog 控件的标志和属性
            .ShowSave
            If Len(.FileName) = 0 Then
                Exit Sub
            End If
            sfile = .FileName
        End With
        ActiveForm.Caption = sfile
        r = ActiveForm.rtfText.SaveFile(sfile, 1)
    Else
        sfile = ActiveForm.Caption
        r = ActiveForm.rtfText.SaveFile(sfile, 1)
    End If

End Sub

Private Sub mnuFileClose_Click()
    '应做:添加 'mnuFileClose_Click' 代码。
  If ActiveForm Is Nothing Then
  Else
        Unload ActiveForm
     If ActiveForm Is Nothing Then CMenStaToD
  End If
End Sub



Private Sub mnuFileOpen_Click()
    Dim sfile As String
    With dlgCommonDialog
        .DialogTitle = "打开"
        .CancelError = False
        .FileName = ""