📄 frmbasiccolorlayout.frm
字号:
VERSION 5.00
Object = "{4932CEF1-2CAA-11D2-A165-0060081C43D9}#2.0#0"; "Actbar2.OCX"
Object = "{0ECD9B60-23AA-11D0-B351-00A0C9055D8E}#6.0#0"; "MSHFLXGD.OCX"
Begin VB.Form frmBasicColorLayout
Caption = "顏色花型"
ClientHeight = 5355
ClientLeft = 60
ClientTop = 345
ClientWidth = 7710
LinkTopic = "Form1"
MDIChild = -1 'True
ScaleHeight = 5355
ScaleWidth = 7710
Begin ActiveBar2LibraryCtl.ActiveBar2 ActiveBar21
Height = 11115
Left = 0
TabIndex = 0
Top = 0
Width = 15240
_LayoutVersion = 1
_ExtentX = 26882
_ExtentY = 19606
_DataPath = ""
Bands = "frmBasicColorLayout.frx":0000
Begin VB.Frame Frame1
Height = 8535
Left = 60
TabIndex = 1
Top = 540
Width = 15015
Begin VB.PictureBox fraFind
Appearance = 0 'Flat
BackColor = &H80000005&
ForeColor = &H80000008&
Height = 3015
Left = 120
ScaleHeight = 2985
ScaleWidth = 5205
TabIndex = 2
ToolTipText = "在查询窗口上单按住鼠标左键，可拖动查询窗口"
Top = 240
Visible = 0 'False
Width = 5235
Begin VB.CommandButton cmdCancel
Caption = "取消 &C"
Height = 315
Left = 3600
TabIndex = 8
Top = 2400
Width = 855
End
Begin VB.CommandButton cmdFind
Caption = "查询 &F"
Height = 315
Left = 2160
TabIndex = 7
Top = 2400
Width = 855
End
Begin VB.CommandButton cmdFindAll
Caption = "全部 &A"
Height = 315
Left = 840
TabIndex = 6
Top = 2400
Width = 855
End
Begin VB.TextBox chkeColorLayout
BackColor = &H00FFFFFF&
Height = 315
Left = 2160
TabIndex = 5
Top = 180
Width = 1995
End
Begin VB.TextBox chkProcess
BackColor = &H00C0FFC0&
Height = 315
Left = 2160
TabIndex = 4
Top = 1080
Width = 1995
End
Begin VB.TextBox chkColorLayout
BackColor = &H00C0FFC0&
Height = 315
Left = 2160
TabIndex = 3
Top = 660
Width = 1995
End
Begin VB.Label Label3
BackColor = &H80000005&
Caption = "顏色花型"
Height = 255
Index = 4
Left = 1020
TabIndex = 13
Top = 660
Width = 1035
End
Begin VB.Label Label3
BackColor = &H80000005&
Caption = "工藝"
Height = 255
Index = 1
Left = 1020
TabIndex = 12
Top = 1080
Width = 1035
End
Begin VB.Label Label11
BackColor = &H80000005&
Caption = "英文名稱"
Height = 255
Left = 1020
TabIndex = 11
Top = 240
Width = 1035
End
Begin VB.Image Image1
Height = 480
Left = 360
Picture = "frmBasicColorLayout.frx":3376
Top = 480
Width = 480
End
Begin VB.Label Label12
BackColor = &H80000005&
Caption = "模糊查询项"
Height = 255
Left = 2400
TabIndex = 10
Top = 1800
Width = 915
End
Begin VB.Label Label15
BackColor = &H00C0FFC0&
Height = 195
Left = 1680
TabIndex = 9
Top = 1800
Width = 375
End
End
Begin MSHierarchicalFlexGridLib.MSHFlexGrid MSHF1
Height = 8115
Left = 120
TabIndex = 14
Top = 240
Width = 14775
_ExtentX = 26061
_ExtentY = 14314
_Version = 393216
AllowUserResizing= 1
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
_NumberOfBands = 1
_Band(0).Cols = 2
End
End
End
End
Attribute VB_Name = "frmBasicColorLayout"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim lngrow As Integer
Dim newItem As Boolean
Private Sub ActiveBar21_ToolClick(ByVal Tool As ActiveBar2LibraryCtl.Tool)
Select Case Tool.Name
Case "cmdAdd":
NewOperatorInf
Case "cmdEdit":
EditOperatorInf
Case "cmdDel":
DelOperatorInf
Case "cmdFind"
fraFind.Visible = True
Case "cmdRefurbish"
FillMshf1 ("select * from tBasicColorLayout")
Case "cmdCancel":
Unload Me
Case "cmdExport":
Dim strFile As String
frmMain.CDFile.ShowOpen
strFile = frmMain.CDFile.FileName
If strFile = "" Then Exit Sub
ExportExcel MSHF1, strFile
End Select
End Sub
Private Function FormatQuery() As String
FormatQuery = "select * from tBasicColorLayout"
If Trim$(chkeColorLayout) = "" Then
FormatQuery = FormatQuery & " where eColorLayout<>''"
Else
FormatQuery = FormatQuery & " where eColorLayout='" & chkeColorLayout & "'"
End If
If Trim$(chkColorLayout) <> "" Then
FormatQuery = FormatQuery & " and ColorLayout" & objDatabase.FormatLikeSQL(Trim(chkColorLayout))
End If
If Trim$(chkProcess) <> "" Then
FormatQuery = FormatQuery & " and Process" & objDatabase.FormatLikeSQL(chkProcess.Text)
End If
End Function
Public Sub FillMshf1(ByVal strSql As String)
Dim rs As ADODB.Recordset
Dim lngrow As Long
Screen.MousePointer = vbHourglass
On Error GoTo errLabel
Set rs = New ADODB.Recordset
With rs
.CursorLocation = adUseClient
.CursorType = adOpenDynamic
.LockType = adLockOptimistic
Set .ActiveConnection = Cn
End With
rs.Open strSql
With MSHF1
.Redraw = False
.Rows = 2
'.FixedRows = 2
.Cols = 7
'.FixedCols = 3
.Clear
'初始化
.WordWrap = False
.TextMatrix(0, 0) = "序号"
.TextMatrix(0, 1) = "英文名稱"
.TextMatrix(0, 2) = "顏色花型"
.TextMatrix(0, 3) = "工藝"
.TextMatrix(0, 4) = "填寫人"
.TextMatrix(0, 5) = "填入日期"
.TextMatrix(0, 6) = ""
.ColWidth(0) = 600
.ColWidth(1) = 3000
.ColWidth(2) = 3000
.ColWidth(3) = 2000
.ColWidth(4) = 2000
.ColWidth(5) = 2000
.ColWidth(6) = 0
'.....................................................
.Rows = rs.RecordCount + 2
On Error Resume Next
For lngrow = 2 To rs.RecordCount + 1
.TextMatrix(lngrow, 0) = lngrow - 1
.TextMatrix(lngrow, 1) = Trim$(NullValue(rs.Fields!eColorLayout))
.TextMatrix(lngrow, 2) = Trim$(NullValue(rs.Fields!ColorLayout))
.TextMatrix(lngrow, 3) = Trim$(NullValue(rs.Fields!Process))
.TextMatrix(lngrow, 4) = Trim$(NullValue(rs.Fields!UpdateOperator))
.TextMatrix(lngrow, 5) = FormatDateStr(Trim$(NullValue(rs.Fields!UpdateDate)), "long")
.TextMatrix(lngrow, 6) = Trim$(NullValue(rs.Fields!ID))
rs.MoveNext
Next
lngrow = 0
.TextMatrix(1, 0) = "总计"
.TextMatrix(1, 1) = .Rows - 2
SetItemBackColor MSHF1
.Redraw = True
End With
rs.Close
remClear:
Set rs = Nothing
Screen.MousePointer = vbDefault
Exit Sub
errLabel:
On Error Resume Next
MSHF1.Redraw = True
GoTo remClear
End Sub
Private Sub cmdCancel_Click()
fraFind.Visible = False
End Sub
Private Sub CmdFind_Click()
FillMshf1 FormatQuery
fraFind.Visible = False
End Sub
Private Sub cmdFindAll_Click()
FillMshf1 ("select * from tBasicColorLayout")
fraFind.Visible = False
End Sub
Private Sub Form_Load()
'设置窗口大小
FormInit Me, True
SetObjectWH Frame1
SetObjectWH MSHF1
FillMshf1 ("select * from tBasicColorLayout")
ActiveBar21.Bands("toolbar").Tools.item("cmdDel").Enabled = False
ActiveBar21.Bands("toolbar").Tools.item("cmdEdit").Enabled = False
InitTitle
HookWheel Me.hwnd
End Sub
Private Sub InitTitle()
Label11.Caption = "英文名稱"
Label3.item(4).Caption = "顏色花型"
Label3.item(1).Caption = "工藝"
Me.Caption = "顏色花型信息"
End Sub
Private Sub NewOperatorInf()
frmBasicColorLayoutInfo.newItem = True
frmBasicColorLayoutInfo.InitInfo ""
frmBasicColorLayoutInfo.Show vbModal
ActiveBar21.Bands("toolbar").Tools.item("cmdDel").Enabled = False
ActiveBar21.Bands("toolbar").Tools.item("cmdEdit").Enabled = False
End Sub
Private Sub EditOperatorInf()
frmBasicColorLayoutInfo.newItem = False
If lngrow = 1 Then Exit Sub
frmBasicColorLayoutInfo.InitInfo MSHF1.TextMatrix(lngrow, 6)
frmBasicColorLayoutInfo.Show vbModal
ActiveBar21.Bands("toolbar").Tools.item("cmdDel").Enabled = False
ActiveBar21.Bands("toolbar").Tools.item("cmdEdit").Enabled = False
End Sub
Private Sub DelOperatorInf()
Dim strSql As String
If lngrow > MSHF1.Rows - 1 Then Exit Sub
If lngrow <= 1 Then
MsgBox "请选中一条要删除的记录！", vbExclamation, "提示"
Exit Sub
End If
On Error GoTo errHandle
If MsgBox("确定要刪除？", vbQuestion + vbYesNo, "询问") = vbNo Then
Exit Sub
Else
strSql = "delete from tBasicColorLayout where id=" & MSHF1.TextMatrix(lngrow, 6)
objDatabase.ExecCmd strSql
MsgBox "刪除成功!", vbInformation, "提示"
End If
FillMshf1 ("select * from tBasicColorLayout")
ActiveBar21.Bands("toolbar").Tools.item("cmdDel").Enabled = False
ActiveBar21.Bands("toolbar").Tools.item("cmdEdit").Enabled = False
Exit Sub
errHandle:
objDatabase.DatabaseError
End Sub
Private Sub MSHF1_Click()
lngrow = Val(MSHF1.row)
If lngrow = 1 Then
MSHF1.Sort = 1
Else
MSHF1.row = lngrow
MSHF1.col = 0
MSHF1.ColSel = MSHF1.Cols - 1
ActiveBar21.Bands("toolbar").Tools.item("cmdDel").Enabled = True
ActiveBar21.Bands("toolbar").Tools.item("cmdEdit").Enabled = True
End If
End Sub
Private Sub MSHF1_DblClick()
EditOperatorInf
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -