infoma.frm
来自「功能强大的个人工作通讯录」· FRM 代码 · 共 2,184 行 · 第 1/5 页
FRM
2,184 行
End
Begin MSForms.TextBox txtSR
Height = 375
Left = 4620
TabIndex = 21
ToolTipText = "选定文本后按Ctrl+C复制文本"
Top = 960
Width = 2025
VariousPropertyBits= 746604563
ForeColor = 12582912
Size = "3572;661"
Value = "测试"
SpecialEffect = 0
FontName = "楷体_GB2312"
FontEffects = 1073741825
FontHeight = 315
FontCharSet = 134
FontPitchAndFamily= 34
FontWeight = 700
End
Begin MSForms.TextBox txtJG
Height = 390
Left = 10200
TabIndex = 20
ToolTipText = "选定文本后按Ctrl+C复制文本"
Top = 960
Width = 3255
VariousPropertyBits= 746604563
ForeColor = 12582912
Size = "5741;688"
Value = "测试"
SpecialEffect = 0
FontName = "楷体_GB2312"
FontEffects = 1073741825
FontHeight = 315
FontCharSet = 134
FontPitchAndFamily= 34
FontWeight = 700
End
Begin MSForms.TextBox txtFL
Height = 390
Left = 4620
TabIndex = 19
ToolTipText = "选定文本后按Ctrl+C复制文本"
Top = 1530
Width = 2070
VariousPropertyBits= 746604563
ForeColor = 12582912
Size = "3651;688"
Value = "测试"
SpecialEffect = 0
FontName = "楷体_GB2312"
FontEffects = 1073741825
FontHeight = 315
FontCharSet = 134
FontPitchAndFamily= 34
FontWeight = 700
End
Begin MSForms.TextBox txtSS
Height = 390
Left = 10200
TabIndex = 18
ToolTipText = "选定文本后按Ctrl+C复制文本"
Top = 1530
Width = 3255
VariousPropertyBits= 746604563
ForeColor = 12582912
Size = "5741;688"
Value = "测试"
SpecialEffect = 0
FontName = "楷体_GB2312"
FontEffects = 1073741825
FontHeight = 315
FontCharSet = 134
FontPitchAndFamily= 34
FontWeight = 700
End
Begin MSForms.TextBox txtGS
Height = 390
Left = 4620
TabIndex = 17
ToolTipText = "选定文本后按Ctrl+C复制文本"
Top = 2100
Width = 3900
VariousPropertyBits= 746604563
ForeColor = 12582912
Size = "6879;688"
Value = "测试"
SpecialEffect = 0
FontName = "楷体_GB2312"
FontEffects = 1073741825
FontHeight = 315
FontCharSet = 134
FontPitchAndFamily= 34
FontWeight = 700
End
Begin MSForms.TextBox txtZW
Height = 390
Left = 10200
TabIndex = 16
ToolTipText = "选定文本后按Ctrl+C复制文本"
Top = 2130
Width = 3255
VariousPropertyBits= 746604563
ForeColor = 12582912
Size = "5741;688"
Value = "测试"
SpecialEffect = 0
FontName = "楷体_GB2312"
FontEffects = 1073741825
FontHeight = 315
FontCharSet = 134
FontPitchAndFamily= 34
FontWeight = 700
End
Begin MSForms.TextBox txtDZ
Height = 420
Left = 4620
TabIndex = 15
ToolTipText = "选定文本后按Ctrl+C复制文本"
Top = 3945
Width = 8790
VariousPropertyBits= 746604563
ForeColor = 12582912
Size = "15505;741"
Value = "测试"
SpecialEffect = 0
FontName = "楷体_GB2312"
FontEffects = 1073741825
FontHeight = 315
FontCharSet = 134
FontPitchAndFamily= 34
FontWeight = 700
End
Begin MSForms.TextBox txtDH
Height = 435
Left = 4620
TabIndex = 14
ToolTipText = "选定文本后按Ctrl+C复制文本"
Top = 3330
Width = 8790
VariousPropertyBits= 746604563
ForeColor = 12582912
Size = "15505;767"
Value = "测试"
SpecialEffect = 0
FontName = "楷体_GB2312"
FontEffects = 1073741825
FontHeight = 315
FontCharSet = 134
FontPitchAndFamily= 34
FontWeight = 700
End
Begin MSForms.TextBox txtCZ
Height = 435
Left = 4620
TabIndex = 13
ToolTipText = "选定文本后按Ctrl+C复制文本"
Top = 2715
Width = 3870
VariousPropertyBits= 746604563
ForeColor = 12582912
Size = "6826;767"
Value = "测试"
SpecialEffect = 0
FontName = "楷体_GB2312"
FontEffects = 1073741825
FontHeight = 315
FontCharSet = 134
FontPitchAndFamily= 34
FontWeight = 700
End
Begin MSForms.TextBox txtXG
Height = 585
Left = 4620
TabIndex = 12
ToolTipText = "选定文本后按Ctrl+C复制文本"
Top = 4545
Width = 8820
VariousPropertyBits= 746604563
ForeColor = 12582912
Size = "15557;1032"
Value = "测试"
SpecialEffect = 0
FontName = "楷体_GB2312"
FontEffects = 1073741825
FontHeight = 315
FontCharSet = 134
FontPitchAndFamily= 34
FontWeight = 700
End
Begin MSForms.TextBox txtBH
Height = 285
Left = 915
TabIndex = 11
Top = 4815
Width = 1920
VariousPropertyBits= 746604561
Size = "3387;503"
SpecialEffect = 0
FontName = "宋体"
FontEffects = 1073750016
FontHeight = 180
FontCharSet = 134
FontPitchAndFamily= 34
End
Begin VB.Label Label13
BackStyle = 0 'Transparent
Caption = "编号："
Height = 225
Left = 390
TabIndex = 10
Top = 4905
Width = 570
End
Begin VB.Shape Shape3
BackColor = &H00FF80FF&
BorderColor = &H00FF80FF&
Height = 3825
Left = 210
Top = 6150
Width = 13770
End
Begin VB.Menu menuH
Caption = "菜单H"
Begin VB.Menu EditThis
Caption = "修改"
End
Begin VB.Menu fvv
Caption = "-"
End
Begin VB.Menu SelectAllH
Caption = "全选"
End
Begin VB.Menu ddf
Caption = "-"
End
Begin VB.Menu delectAllSelect
Caption = "删除选中来往记录"
End
Begin VB.Menu dfdfd
Caption = "-"
End
Begin VB.Menu RefreshH
Caption = "刷新（显示全部）"
End
Begin VB.Menu ddd
Caption = "-"
End
Begin VB.Menu AddHistroy
Caption = "添加来往记录"
End
End
Begin VB.Menu ImageMenu
Caption = "菜单组I"
Begin VB.Menu Poper
Caption = "适合图像"
End
Begin VB.Menu rr
Caption = "-"
End
Begin VB.Menu picOldSize
Caption = "原始大小"
End
Begin VB.Menu dfa
Caption = "-"
End
Begin VB.Menu lookPath
Caption = "查看原图"
End
Begin VB.Menu ffdfd
Caption = "-"
End
Begin VB.Menu SaveImage
Caption = "保存当前"
End
Begin VB.Menu gh
Caption = "-"
End
Begin VB.Menu picFresh
Caption = "刷新"
End
Begin VB.Menu ggg
Caption = "-"
End
Begin VB.Menu picClear
Caption = "清除"
End
End
End
Attribute VB_Name = "infoma"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function CopyFile Lib "kernel32.dll" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long
Private Type POINTAPI
X As Long
Y As Long
End Type
Dim actF
Dim gx
Dim gy
Dim r
Private Sub cancelAllH_Click()
Dim nitem As ListItem
For n = 1 To lv.ListItems.Count
With lv
.ListItems.Item(n).Checked = False
End With
Next n
End Sub
Private Sub AddHistroy_Click()
cmdAddHistory_Click
End Sub
Private Sub cmd_CZ_Click()
Call bk
On Error GoTo err
lv.ListItems.clear
'-----------------------------当查询条件为“所有项目时"
If Combo1 = "所有项目" Then
Me.lv.ListItems.clear '先清空listview
Call OpenConn
sql = "select * from 来往记录"
rs.Open sql, cn, 3, 3
For i = 0 To rs.Fields.Count - 1
xmmc = rs.Fields(i).Name
Call OpenConn1
sql1 = "select * from 来往记录 where 编号='" & txtBH & "' and " & xmmc & " like '%" & keyword & "%'"
rs1.Open sql1, cn1, 3, 3
If rs1.RecordCount > 0 Then
Do While Not rs1.EOF
Set Item = lv.FindItem(rs1.Fields("记录序号"), , , lvwPartial) '判断是否是重复客户
If Item Is Nothing Then
it = 1
Else
it = 0
End If
If it = 1 Then
Set addlist = lv.ListItems.add(, , IIf(IsNull(rs1.Fields(rs1.Fields(0).Name)), "", rs1.Fields(rs1.Fields(0).Name)), , 0)
For h = 1 To rs1.Fields.Count - 1
addlist.SubItems(h) = IIf(IsNull(rs1.Fields(rs1.Fields(h).Name)), "", rs1.Fields(rs1.Fields(h).Name))
Next h
End If
rs1.MoveNext
Loop
End If
Call CloseConn1
Next i
Call CloseConn
Exit Sub
End If
'-----------------------------当查询条件不为“所有项目时"
Call OpenConn
sql = "select * from 来往记录 where 编号='" & txtBH & "' and " & Combo1 & " like '%" & keyword & "%'"
rs.Open sql, cn, 3, 3
If rs.RecordCount > 0 Then
Do While Not rs.EOF
Set addlist = lv.ListItems.add(, , IIf(IsNull(rs.Fields(rs.Fields(0).Name)), "", rs.Fields(rs.Fields(0).Name)), , 0)
For u = 1 To rs.Fields.Count - 1
addlist.SubItems(u) = IIf(IsNull(rs.Fields(rs.Fields(u).Name)), "", rs.Fields(rs.Fields(u).Name))
Next u
rs.MoveNext
Loop
End If
err:
If err.Description <> "" Then
MsgBox "操作错误，请检查你的查询条件", vbOKOnly, "提示"
End If
End Sub
Private Sub cmdAddHistory_Click()
Call bk
If QX <> "管理员" And TopRight <> "超级管理员" Then
MsgBox "非管理员没有执行此操作的权限", 0 + 64, "提示"
Exit Sub
End If
Dim i As Long
AddNO = txtBH
ReDim infoarr(i)
Set infoarr(i) = New Class1
Set infoarr(i).newForm = New LWJL
Load infoarr(i).newForm
End Sub
Private Sub cmdADDnew_Click()
Call bk
If QX <> "管理员" And TopRight <> "超级管理员" Then
MsgBox "非管理员没有执行此操作的权限", 0 + 64, "提示"
Exit Sub
End If
Dim ff As Form
For Each ff In Forms
If ff.Name = "AddLXR" Then
ff.SetFocus
Else
AddLXR.Show
End If
Next
End Sub
Private Sub cmdDelete_Click()
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?