📄 frmquery.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Object = "{38911DA0-E448-11D0-84A3-00DD01104159}#1.1#0"; "COMCT332.OCX"
Begin VB.Form frmQueryResult
Caption = "查询结果"
ClientHeight = 6435
ClientLeft = 60
ClientTop = 345
ClientWidth = 8880
LinkTopic = "Form1"
LockControls = -1 'True
MDIChild = -1 'True
ScaleHeight = 6435
ScaleMode = 0 'User
ScaleWidth = 7893.333
Begin MSComctlLib.ImageList ImlBig
Left = 2520
Top = 4500
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
MaskColor = 12632256
_Version = 393216
End
Begin MSComctlLib.ImageList ImlSmall
Left = 2520
Top = 3825
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 19
ImageHeight = 19
MaskColor = 12632256
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 5
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmQuery.frx":0000
Key = ""
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmQuery.frx":05F6
Key = ""
EndProperty
BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmQuery.frx":0BEC
Key = ""
EndProperty
BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmQuery.frx":103E
Key = ""
EndProperty
BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmQuery.frx":1490
Key = ""
EndProperty
EndProperty
End
Begin VB.Frame frmSplitter
Height = 5835
Left = 2790
MouseIcon = "frmQuery.frx":1612
MousePointer = 99 'Custom
TabIndex = 4
Top = 570
Width = 112
End
Begin ComCtl3.CoolBar CoolBar1
Align = 1 'Align Top
Height = 630
Left = 0
TabIndex = 2
Top = 0
Width = 8880
_ExtentX = 15663
_ExtentY = 1111
BandCount = 1
_CBWidth = 8880
_CBHeight = 630
_Version = "6.0.8169"
Child1 = "Toolbar1"
MinHeight1 = 570
Width1 = 4785
NewRow1 = 0 'False
Begin MSComctlLib.Toolbar Toolbar1
Height = 570
Left = 30
TabIndex = 3
Top = 30
Width = 8760
_ExtentX = 15452
_ExtentY = 1005
ButtonWidth = 1138
ButtonHeight = 1005
Style = 1
ImageList = "ImlSmall"
_Version = 393216
BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628}
NumButtons = 6
BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "大图标"
Key = "BigIcon"
ImageIndex = 1
EndProperty
BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "小图表"
Key = "SmallIcon"
ImageIndex = 2
EndProperty
BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "列表"
Key = "List"
ImageIndex = 3
EndProperty
BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "简报"
Key = "Report"
ImageIndex = 4
EndProperty
BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628}
Style = 3
EndProperty
BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "返回"
Key = "Exit"
ImageIndex = 5
EndProperty
EndProperty
End
End
Begin MSComctlLib.ListView lvwResult
Height = 5775
Left = 3105
TabIndex = 1
Top = 630
Width = 5190
_ExtentX = 9155
_ExtentY = 10186
LabelEdit = 1
LabelWrap = 0 'False
HideSelection = -1 'True
_Version = 393217
Icons = "ImlBig"
SmallIcons = "ImlSmall"
ColHdrIcons = "ImlSmall"
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
NumItems = 0
End
Begin MSComctlLib.TreeView tvwResult
Height = 5775
Left = 90
TabIndex = 0
Top = 630
Width = 2490
_ExtentX = 4392
_ExtentY = 10186
_Version = 393217
Indentation = 695
LabelEdit = 1
Style = 7
Appearance = 1
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin VB.Menu mnuDel
Caption = "删除"
Visible = 0 'False
End
Begin VB.Menu mnuInfo
Caption = "属性"
Visible = 0 'False
End
End
Attribute VB_Name = "frmQueryResult"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public dImportDate1 As Date
Public dImportDate2 As Date
Public strSSSQ1 As String
Public strSSSQ2 As String
Public bCompanyIsEmpty As Boolean
Public bCaseIsEmpty As Boolean
Dim rstImage As ADODB.Recordset
Private EventFlag As String ' 标记所发生的事件。
Dim fShowImg As frmShowImg
Dim mbMoving As Boolean
Const sglSplitLimit = 2000
Private Sub Form_Load()
Me.Height = 7000
Call MakeQueryTree(True, bCompanyIsEmpty, bCaseIsEmpty)
End Sub
Private Sub Form_Resize()
On Error Resume Next
If Me.WindowState = vbMinimized Then
Exit Sub
End If
If Me.Width < sglSplitLimit Then Me.Width = sglSplitLimit
SizeControls frmSplitter.Left
End Sub
Private Sub Form_Unload(Cancel As Integer)
Me.Hide
End Sub
Private Sub frmSplitter_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
With frmSplitter
frmSplitter.Move .Left, .Top, .Width, .Height - 20
End With
mbMoving = True
End Sub
Private Sub frmSplitter_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim sglPos As Single
If mbMoving Then
sglPos = X + frmSplitter.Left
If sglPos < sglSplitLimit Then
frmSplitter.Left = sglSplitLimit
ElseIf sglPos > Me.Width - sglSplitLimit Then
frmSplitter.Left = Me.Width - sglSplitLimit
Else
frmSplitter.Left = sglPos
End If
End If
End Sub
Private Sub frmSplitter_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
SizeControls frmSplitter.Left
mbMoving = False
End Sub
Sub SizeControls(X As Single)
On Error Resume Next
'设置 Width 属性
If X < 1500 Then X = 1500
If X > (Me.Width - 1500) Then X = Me.Width - 1500
tvwResult.Left = 20
tvwResult.Width = X - 15
frmSplitter.Left = X
lvwResult.Left = X + frmSplitter.Width - 35
lvwResult.Width = Me.Width - (tvwResult.Width + 1250)
'设置 Top 属性
tvwResult.Top = CoolBar1.Height
lvwResult.Top = tvwResult.Top
'设置 height 属性
tvwResult.Height = Me.ScaleHeight - CoolBar1.Height
lvwResult.Height = tvwResult.Height
frmSplitter.Top = tvwResult.Top - 85
frmSplitter.Height = tvwResult.Height + 85
End Sub
Private Sub lvwResult_DblClick()
On Error GoTo ErrorHandler
Dim strSQL As String
'生成查询语句
strSQL = "SELECT * FROM sys_Image "
With lvwResult.SelectedItem
If Len(.Tag) > QYBMLength And Left(.Tag, 7) = "Company" Then
strSQL = strSQL & " WHERE QYBM='" & Left(lvwResult.SelectedItem.SubItems(1), QYBMLength) & "'"
strSQL = strSQL & " AND Img_Case_Code='" & Left(lvwResult.SelectedItem.Text, CaseCodeLength) & "'"
ElseIf Left(.Tag, CaseCodeLength) = "Case" Then
strSQL = strSQL & " WHERE Img_Case_Code='" & Left(lvwResult.SelectedItem.SubItems(1), CaseCodeLength) & "'"
strSQL = strSQL & " AND QYBM='" & Left(lvwResult.SelectedItem.Text, QYBMLength) & "'"
End If
If Right(lvwResult.SelectedItem.Tag, 1) <> " " Then
strSQL = strSQL & " AND Img_SSSQ='" & lvwResult.SelectedItem.SubItems(3) & "'"
End If
End With
Set rstImage = New ADODB.Recordset
rstImage.Open strSQL, conCaseMain, 1, 1 ', adCmdText
Set fShowImg = New frmShowImg
Set fShowImg.rstImage = New ADODB.Recordset
Set fShowImg.rstImage = rstImage.Clone
fShowImg.Show 0
Exit Sub
ErrorHandler:
If Err Then
MsgBox Err.Description, vbCritical
Err.Clear
End If
End Sub
Private Sub lvwResult_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then
MsgBox Button
End If
End Sub
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
On Error GoTo ErrorHandler
Select Case Button.Key
Case "BigIcon"
lvwResult.View = lvwIcon
Case "SmallIcon"
lvwResult.View = lvwSmallIcon
Case "List"
lvwResult.View = lvwList
Case "Report"
lvwResult.View = lvwReport
Case "Exit"
If Not rstImage Is Nothing Then
Set rstImage = Nothing
End If
Unload Me
Case "BigIcon"
End Select
Exit Sub
ErrorHandler:
If Err Then
MsgBox Err.Description, vbInformation
Err.Clear
End If
End Sub
Private Sub MakeQueryTree(RootIsQY As Boolean, CompanyArrayIsEmpty As Boolean, CaseArrayIsEmpty As Boolean)
'*************************************************************
'功能：将查询所得结果在frmQueryResult中的tvwResult中建立树形图
'调用：本窗体的StartQuery
'*************************************************************
On Error GoTo ErrorHandler
Dim i As Integer
Dim j As Integer
Dim strTemp As String
Dim nodRoot As Node
Dim idxRoot As Integer
Dim NodCompany As Node
Dim IdxCompany As Integer
Dim nodCase As Node
Dim idxCase As Integer
Dim rstQY As ADODB.Recordset
Dim rstCase As ADODB.Recordset
Dim rstTemp As ADODB.Recordset
Screen.MousePointer = vbHourglass
Set rstTemp = New ADODB.Recordset
'企业数组为空,查询所有企业的选定类型的文书
If CompanyArrayIsEmpty And CaseArrayIsEmpty = False Then
Set nodRoot = tvwResult.Nodes.Add()
nodRoot.Text = "选择的文书"
nodRoot.Tag = "Root"
idxRoot = nodRoot.Index
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -