frmmain.frm

一套企业设备管理系统源代码,所有的业务单据和流程都可以自定义,业务报表也可以通过SQL的存储过程来定义.

VERSION 5.00
Object = "{555E8FCC-830E-45CC-AF00-A012D5AE7451}#10.4#0"; "CommandBars.ocx"
Object = "{709F7AE3-E049-11D2-9362-00403332E72F}#1.0#0"; "Ledger50.ocx"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MsComctl.ocx"
Begin VB.Form frmMain 
   Caption         =   "Form1"
   ClientHeight    =   4725
   ClientLeft      =   60
   ClientTop       =   465
   ClientWidth     =   7605
   Icon            =   "frmMain.frx":0000
   ScaleHeight     =   4725
   ScaleWidth      =   7605
   StartUpPosition =   2  '屏幕中心
   Begin LEDGER50Lib.Ledger50 frmRpt 
      Height          =   2655
      Left            =   3960
      TabIndex        =   1
      Top             =   960
      Width           =   3855
      _Version        =   65536
      _ExtentX        =   6800
      _ExtentY        =   4683
      _StockProps     =   237
      ForeColor       =   0
      BackColor       =   16777215
   End
   Begin MSComctlLib.ImageList TreePic 
      Left            =   3240
      Top             =   2160
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   16
      ImageHeight     =   16
      MaskColor       =   12632256
      _Version        =   393216
      BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
         NumListImages   =   2
         BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmMain.frx":038A
            Key             =   ""
         EndProperty
         BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmMain.frx":0924
            Key             =   ""
         EndProperty
      EndProperty
   End
   Begin MSComctlLib.TreeView frmTree 
      Height          =   2655
      Left            =   480
      TabIndex        =   0
      Top             =   840
      Width           =   1575
      _ExtentX        =   2778
      _ExtentY        =   4683
      _Version        =   393217
      Sorted          =   -1  'True
      Style           =   7
      SingleSel       =   -1  'True
      ImageList       =   "TreePic"
      BorderStyle     =   1
      Appearance      =   0
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin VB.Image Img 
      Height          =   1410
      Left            =   3960
      Picture         =   "frmMain.frx":0EBE
      Top             =   1680
      Width           =   3165
   End
   Begin XtremeCommandBars.ImageManager frmPic 
      Left            =   3480
      Top             =   1560
      _Version        =   655364
      _ExtentX        =   635
      _ExtentY        =   635
      _StockProps     =   0
      Icons           =   "frmMain.frx":1284
   End
   Begin XtremeCommandBars.CommandBars frmBar 
      Left            =   3000
      Top             =   1560
      _Version        =   655364
      _ExtentX        =   635
      _ExtentY        =   635
      _StockProps     =   0
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private ResSign As Long
Private ErrInfo As String

Private DaCn As New ADODB.Connection
Private DaRs As New ADODB.Recordset
Private Sql As String

Private ItemSelSign As Boolean
Private DataSelSign As Boolean
Private TreeLoadSign As Boolean

Private lKey As Long
Private hB As Long
'//

Private Sub Form_Load()
 Call InitFormPara
 Call InitActiveX
 Call RefreshLdg
End Sub

Private Sub InitFormPara()
 Dim iLoop As Long
 BaseItem.FItemID = BaseDllLib.getUserID
 Call BaseItem.getItemText(ResSign, ErrInfo)
 With Me
  .Caption = "选择：" & BaseClass.FName '// & "::" & BaseClass.FTitle & "|"
  .width = Screen.width * 0.6
  .Height = Screen.Height * 0.6
 End With
 '//打开数据库连接通道
 If DaCn.State = adStateOpen Then DaCn.Close
 DaCn.ConnectionString = BaseDllLib.getConStr
 DaCn.Open
End Sub

Private Sub InitActiveX()
 '//定义工具栏参数
 Dim TBar As CommandBar
 Dim TBarBnt As CommandBarControl
 '//定义状态栏参数
 Dim SBar As XtremeCommandBars.StatusBar
 Dim Pane As StatusBarPane
 Dim iLoop As Long
 '//定义目录树参数
 Dim NodeX As Node
 Dim lngStyle As Long
 '//初始化工具条
 frmPic.Icons.LoadIcon SysPara.ResLibIco & "SelText.Ico", 1, xtpImageNormal
 frmPic.Icons.LoadIcon SysPara.ResLibIco & "Exit.Ico", 2, xtpImageNormal
 frmPic.Icons.LoadIcon SysPara.ResLibIco & "User.Ico", 3, xtpImageNormal
 frmPic.Icons.LoadIcon SysPara.ResLibIco & "Timer.ico", 4, xtpImageNormal
 frmPic.Icons.LoadIcon SysPara.ResLibIco & "NewItem.Ico", 5, xtpImageNormal
 frmPic.Icons.LoadIcon SysPara.ResLibIco & "EditItem.Ico", 6, xtpImageNormal
 frmPic.Icons.LoadIcon SysPara.ResLibIco & "DelItem.Ico", 7, xtpImageNormal
 frmPic.Icons.LoadIcon SysPara.ResLibIco & "Search.Ico", 8, xtpImageNormal
 '//添加工具栏
 Set TBar = frmBar.Add("TBar", xtpBarTop)

 Set TBarBnt = TBar.Controls.Add(xtpControlButton, 5, "新增", -1, False)
 TBarBnt.ToolTipText = "新增" & BaseClass.FName
 TBarBnt.DescriptionText = "新增" & BaseClass.FName

 Set TBarBnt = TBar.Controls.Add(xtpControlButton, 6, "编辑", -1, False)
 TBarBnt.ToolTipText = "编辑" & BaseClass.FName
 TBarBnt.DescriptionText = "编辑" & BaseClass.FName

 Set TBarBnt = TBar.Controls.Add(xtpControlButton, 7, "删除", -1, False)
 TBarBnt.ToolTipText = "删除" & BaseClass.FName
 TBarBnt.DescriptionText = "删除" & BaseClass.FName

 Set TBarBnt = TBar.Controls.Add(xtpControlButton, 8, "搜索", -1, False)
 TBarBnt.BeginGroup = True
 TBarBnt.ToolTipText = "搜索" & BaseClass.FName
 TBarBnt.DescriptionText = "搜索" & BaseClass.FName

 Set TBarBnt = TBar.Controls.Add(xtpControlButton, 1, "选择", -1, False)
 TBarBnt.ToolTipText = "选择" & BaseClass.FName
 TBarBnt.DescriptionText = "选择" & BaseClass.FName
 '//
 Set TBarBnt = TBar.Controls.Add(xtpControlButton, 2, "关闭", -1, False)
 TBarBnt.BeginGroup = True
 TBarBnt.ToolTipText = "关闭选择框"
 TBarBnt.DescriptionText = "关闭选择框"
 '//
 TBar.DefaultButtonStyle = xtpButtonIconAndCaption
 TBar.ShowExpandButton = False
 '//状态参数设置
 Set SBar = frmBar.StatusBar
 SBar.IdleText = "准备就绪"
 '/
 Set Pane = SBar.AddPane(1)
 Pane.Style = SBPS_NOBORDERS
 Pane.Text = BaseItem.FName
 Pane.IconIndex = 3
 Pane.width = 50
 '/
 Set Pane = SBar.AddPane(0)
 Pane.Style = SBPS_NOBORDERS
 Pane.TextColor = RGB(&H0, &H0, &HFF)
 Pane.Alignment = xtpAlignmentCenter
 Pane.Font.Bold = True
 Pane.Text = "准备就绪"
 Pane.width = 350
 '/
 Set Pane = SBar.AddPane(2)
 Pane.Style = SBPS_NOBORDERS
 Pane.Text = BaseDllLib.getServerDate(1)
 Pane.IconIndex = 4
 Pane.width = 80
 '//
 SBar.Visible = True
 '//设置工具条参数
 frmBar.ActiveMenuBar.Visible = False
 frmBar.Icons = frmPic.Icons
 frmBar.VisualTheme = xtpThemeRibbon
 '//区域计算
 Call frmBar.GetClientRect(RecInfo.Left, RecInfo.Top, RecInfo.Right, RecInfo.Bottom)
 '//初始化属性结构
 With frmTree
  .Left = 0
  .Top = RecInfo.Top
  .width = Me.ScaleWidth * 0.35
  .Height = RecInfo.Bottom - .Top
  .LabelEdit = tvwManual
  '//初始化化顶级目录
  Call getTreeData(0)
  If TreeData.Count > 0 Then
   For iLoop = 1 To TreeData.Count
    Set NodeX = frmTree.Nodes.Add(, , "K" & TreeData.Item(iLoop).FItemID, TreeData.Item(iLoop).FName, 1, 2)
    NodeX.BackColor = RGB(&HC0, &HDB, &HFF)
    NodeX.ForeColor = RGB(&HFF, &O33, &H0)
    TreeID.Add TreeData.Item(iLoop).FItemID
   Next
  End If
  Call SendMessage(frmTree.hWnd, TVM_SETBKCOLOR, 0, ByVal RGB(&HC0, &HDB, &HFF))
  lngStyle = GetWindowLong(frmTree.hWnd, GWL_STYLE)
  Call SetWindowLong(frmTree.hWnd, GWL_STYLE, lngStyle - TVS_HASLINES)
  Call SetWindowLong(frmTree.hWnd, GWL_STYLE, lngStyle)
 End With
 '//初始化列表
 '//TreeView的背景图片
 With frmRpt
  .Left = frmTree.Left + frmTree.width
  .Top = frmTree.Top
  .width = Me.ScaleWidth - frmTree.width
  .Height = frmTree.Height
  .Face.Switch(E_LDG_LdgFlag_MultiSel) = SysPara.ChooseMulSign
  .Face.Rows = 2
  .Face.Cols = SysPara.frmInfo.FInfoTitleMax - SysPara.frmInfo.FInfoTitleMin + 1
  .Face.FixedRows = 1
  For iLoop = SysPara.frmInfo.FInfoTitleMin To SysPara.frmInfo.FInfoTitleMax
   .col(iLoop + 1).width = CLng(SysPara.frmInfo.FInfoWidthVar(iLoop))
   Select Case CLng(SysPara.frmInfo.FInfoShowVar(iLoop))
    Case 0
     .col(iLoop + 1).Switch(E_LDG_ColFlag_Hide) = True
    Case 1
     .col(iLoop + 1).Switch(E_LDG_ColFlag_Hide) = False
   End Select
  Next
 End With
End Sub

Private Sub RefreshLdg()
 On Error GoTo ErrHandle
 Sql = getQueryPro
 If DaRs.State = adStateOpen Then DaRs.Close
 DaRs.CursorLocation = adUseClient
 DaRs.Open Sql, DaCn, adOpenStatic, adLockReadOnly
 frmRpt.Merge.UnMergeAll