filtratefrm.frm

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

VERSION 5.00
Object = "{555E8FCC-830E-45CC-AF00-A012D5AE7451}#10.4#0"; "CommandBars.ocx"
Object = "{7802D41A-28B0-43C4-95EA-17B7E32337D1}#1.0#0"; "CellCtrl5.ocx"
Begin VB.Form FiltrateFrm 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Form1"
   ClientHeight    =   5130
   ClientLeft      =   45
   ClientTop       =   450
   ClientWidth     =   4995
   Icon            =   "FiltrateFrm.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5130
   ScaleWidth      =   4995
   StartUpPosition =   2  '屏幕中心
   Begin CELL50Lib.Cell frmCell 
      Height          =   2415
      Left            =   0
      TabIndex        =   0
      Top             =   2400
      Width           =   4695
      _Version        =   65536
      _ExtentX        =   8281
      _ExtentY        =   4260
      _StockProps     =   0
   End
   Begin XtremeCommandBars.ImageManager frmPic 
      Left            =   360
      Top             =   0
      _Version        =   655364
      _ExtentX        =   635
      _ExtentY        =   635
      _StockProps     =   0
      Icons           =   "FiltrateFrm.frx":058A
   End
   Begin XtremeCommandBars.CommandBars frmBar 
      Left            =   0
      Top             =   0
      _Version        =   655364
      _ExtentX        =   635
      _ExtentY        =   635
      _StockProps     =   0
   End
End
Attribute VB_Name = "FiltrateFrm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Form_Load()
 Call InitFormPara
 Call InitActiveX
 Call InitCell
End Sub


Private Sub InitFormPara()
 Dim iLoop As Long
 With Me
  .Caption = "搜索：" & BaseClass.FName
  .width = Screen.width * 0.6
  .Height = Screen.Height * 0.6
 End With
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
 TBarBnt.Visible = False

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

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

 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
 TBarBnt.Visible = False
 '//
 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 frmCell
  .Left = 0
  .Top = RecInfo.Top
  .width = Me.ScaleWidth
  .Height = RecInfo.Bottom - .Top
  SysPara.CellBkBmp = .AddImage(SysPara.ResLibIco & "CellBkJpg.Jpg")
  SysPara.CellPrjFont = .FindFontIndex("黑体", 1)
  SysPara.CellFontColor = .FindColorIndex(RGB(&HFF, &HFF, &HFF), 1)
  SysPara.CellBkColor = .FindColorIndex(RGB(&H0, &H99, &H66), 1)
  SysPara.CellLkFontColor = .FindColorIndex(RGB(&H0, &H99, &H66), 1)
  SysPara.CellLkBkColor = .FindColorIndex(RGB(&HFF, &HFF, &HFF), 1)
  .ShowTopLabel 0, 0
  .ShowSideLabel 0, 0
  .ShowSheetLabel 0, 0
  .SetSelectMode 0, 2
  .ShowPageBreak 0
  .ShowGridLine 0, 0
  .ShowHScroll 1, 0
  .ShowVScroll 1, 0
  .SetGridCursor 0, 1
  .AllowSizeColInGrid = True
  .AllowSizeRowInGrid = True
  .SetBackImage SysPara.CellBkBmp, 0, 0
  .PrintSetPaper 9
  .PrintSetOrient 1
  .PrintSetAlign 1, 1
  .PrintSetMargin 10, 0.5, 10, 0.5
  Call .SetFixedRow(1, 1)
 End With
End Sub

Private Sub InitCell()
 Dim ResSign As Long
 Dim ErrInfo As String
 Dim iLoop As Long
 Dim SearchColl As Collection
 Dim BaseSearch As Object
 Dim SearchRows As Long
 Set BaseSearch = CreateObject("BaseDllLib.Search")
 Set SearchColl = BaseDllLib.getSearchInfo(ResSign, ErrInfo, BaseDllLib.getClassID, BaseDllLib.getFormID)
 SearchRows = SearchColl.Count
 '//处理标题
 With frmCell
  .SetCols 7, 0
  .SetRows SearchRows + 2, 0
  .SetCellString 1, 1, 0, "搜索项目"
  .SetColWidth 1, 100, 1, 0
  .SetCellAlign 1, 1, 0, 4 + 32
  .SetCellInput 1, 1, 0, 5
  
  .SetCellString 2, 1, 0, "搜索内容"
  .SetColWidth 1, 100, 2, 0
  .SetCellAlign 2, 1, 0, 4 + 32
  .SetCellInput 2, 1, 0, 5
  
  .SetCellString 3, 1, 0, "搜索值"
  .SetColWidth 1, 100, 3, 0
  .SetCellAlign 3, 1, 0, 4 + 32
  .SetCellInput 3, 1, 0, 5
  
  .SetCellString 4, 1, 0, "搜索序号"
  .SetColWidth 1, 100, 4, 0
  .SetCellAlign 4, 1, 0, 4 + 32
  .SetCellInput 4, 1, 0, 5
  
  .SetCellString 5, 1, 0, "选择类型"
  .SetColWidth 1, 100, 5, 0
  .SetCellAlign 5, 1, 0, 4 + 32
  .SetCellInput 5, 1, 0, 5
  
  .SetCellString 6, 1, 0, "数据类型"
  .SetColWidth 1, 100, 6, 0
  .SetCellAlign 6, 1, 0, 4 + 32
  .SetCellInput 6, 1, 0, 5
  
  For iLoop = 2 To SearchRows + 1
   .SetCellString 1, iLoop, 0, SearchColl.Item(iLoop - 1).FSearchText
   .SetCellAlign 1, iLoop, 0, 2 + 32
   .SetCellInput 1, iLoop, 0, 5
   .SetCellTextColor 1, iLoop, 0, SysPara.CellFontColor
   .SetCellBackColor 1, iLoop, 0, SysPara.CellBkColor
   '//
   .SetCellNumType 2, iLoop, 0, 7
   '//
   .SetCellNumType 3, iLoop, 0, 7
   .SetCellString 3, iLoop, 0, SearchColl.Item(iLoop - 1).FLastRlValue
   '//
   If IsNumeric(SearchColl.Item(iLoop - 1).FSearchValue) Then
    .SetCellDouble 5, iLoop, 0, SearchColl.Item(iLoop - 1).FSearchValue
   End If
   '//
   .SetCellDouble 6, iLoop, 0, SearchColl.Item(iLoop - 1).FSearchType
   Select Case SearchColl.Item(iLoop - 1).FSearchType
    '//手工输入的字符串
    Case 1
    '//选择的数据
    Case 5
     .SetCellInput 2, iLoop, 0, 5
     .SetCellTextColor 2, iLoop, 0, SysPara.CellLkFontColor
     .SetCellBackColor 2, iLoop, 0, SysPara.CellLkBkColor
    '//开关数据
    Case 20
    '//不能够改变的搜索条件
     .SetCellInput 2, iLoop, 0, 5
     .SetCellTextColor 2, iLoop, 0, SysPara.CellLkFontColor
     .SetCellBackColor 2, iLoop, 0, SysPara.CellLkBkColor
    Case 25
     '--.SetRowHidden iLoop, iLoop
    '//不能够改变的搜索条件
    Case 26
     '--.SetRowHidden iLoop, iLoop
   End Select
   '//
   .SetCellDouble 4, iLoop, 0, SearchColl.Item(iLoop - 1).FOrderID
  Next
  .DrawGridLine 1, 1, .GetCols(0), .GetRows(0), 0, 2, -1
 End With
 Set BaseSearch = Nothing
 Set SearchColl = Nothing
End Sub

Private Sub frmCell_MouseDClick(ByVal col As Long, ByVal row As Long)
 Dim ErrInfo As String
 Dim iLoop As Long
 Dim ChoiceObj As Object
 Dim ResObj As Collection
 Select Case col
  Case 2
   Select Case frmCell.GetCellDouble2(6, row, 0)
    Case 5
     Set ChoiceObj = CreateObject("ChoiceItem.BaseLib")
     ChoiceObj.setUserID = BaseDllLib.getUserID
     ChoiceObj.setClassID = frmCell.GetCellDouble2(5, row, 0)
     ChoiceObj.setParentStr = "|0|"
     ChoiceObj.setMapCol = "3|2|0|0|0"
     ChoiceObj.setMapType = "1|1|0|0|0"
     Call ChoiceObj.mShow(ErrInfo, 1)
     Set ResObj = ChoiceObj.getSignRowRes
     If ResObj.Count > 0 Then
      For iLoop = 1 To ResObj.Count
       If ResObj.Item(iLoop).MapCol > 0 Then
        Select Case ResObj.Item(iLoop).FTypeID
         Case 1
          frmCell.SetCellString ResObj.Item(iLoop).MapCol, row, 0, ResObj.Item(iLoop).FValue
         
         Case 2
          frmCell.SetCellDouble ResObj.Item(iLoop).MapCol, row, 0, ResObj.Item(iLoop).FValue
          
        End Select
       End If
      Next
     End If
    Case 39
     Set ChoiceObj = CreateObject("InCommon.BaseLib")
     ChoiceObj.setUserID = BaseDllLib.getUserID
     ChoiceObj.setItemID = 39
     Call ChoiceObj.mShow(ErrInfo, 1)
     frmCell.SetCellString 2, row, 0, ChoiceObj.getItemName
     frmCell.SetCellString 3, row, 0, ChoiceObj.getItemID
   End Select
 End Select
 Set ResObj = Nothing
 Set ChoiceObj = Nothing
End Sub