📄 frmcustom.frm
字号:
VERSION 5.00
Object = "{A964BDA3-3E93-11CF-9A0F-9E6261DACD1C}#2.0#0"; "ReSize32.ocx"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "Comdlg32.ocx"
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Object = "{0B81E4A9-BE4E-4AEF-9272-33AB5B51C6FC}#1.0#0"; "XPControls.ocx"
Begin VB.Form frmCustom
Caption = "自定义体检报表"
ClientHeight = 8775
ClientLeft = 60
ClientTop = 450
ClientWidth = 12765
Icon = "frmCustom.frx":0000
KeyPreview = -1 'True
LinkTopic = "Form1"
LockControls = -1 'True
MDIChild = -1 'True
ScaleHeight = 8775
ScaleWidth = 12765
WindowState = 2 'Maximized
Begin MSComDlg.CommonDialog CommonDialog1
Left = 6135
Top = 4140
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin XPControls.XPCommandButton cmdExit
Height = 405
Left = 9045
TabIndex = 17
Top = 210
Width = 945
_ExtentX = 1667
_ExtentY = 714
Caption = "退 出"
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
End
Begin ResizeLibCtl.ReSize ReSize1
Left = 360
Top = 5880
_Version = 131072
_ExtentX = 741
_ExtentY = 741
_StockProps = 0
Enabled = -1 'True
FormMinWidth = 0
FormMinHeight = 0
FormDesignHeight= 8775
FormDesignWidth = 12765
End
Begin VB.PictureBox Picture1
Height = 225
Left = 12420
ScaleHeight = 165
ScaleWidth = 195
TabIndex = 14
Top = 8460
Width = 255
End
Begin MSComCtl2.FlatScrollBar fsbVertical
Height = 7755
Left = 12420
TabIndex = 13
Top = 720
Width = 255
_ExtentX = 450
_ExtentY = 13679
_Version = 393216
Orientation = 1179648
End
Begin MSComCtl2.FlatScrollBar fsbHorizontal
Height = 255
Left = 1050
TabIndex = 12
Top = 8430
Width = 11415
_ExtentX = 20135
_ExtentY = 450
_Version = 393216
Arrows = 65536
Orientation = 1179649
End
Begin XPControls.XPCommandButton cmdDelete
Height = 405
Left = 7848
TabIndex = 10
Top = 210
Width = 945
_ExtentX = 1667
_ExtentY = 714
Caption = "删 除"
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
End
Begin XPControls.XPCommandButton cmdSave
Height = 405
Left = 6652
TabIndex = 9
Top = 210
Width = 945
_ExtentX = 1667
_ExtentY = 714
Caption = "保 存"
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
End
Begin XPControls.XPCommandButton cmdAdd
Height = 405
Left = 4260
TabIndex = 8
Top = 210
Width = 945
_ExtentX = 1667
_ExtentY = 714
Caption = "添 加"
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
End
Begin VB.ComboBox cmbReport
Height = 315
Left = 1050
Style = 2 'Dropdown List
TabIndex = 7
Top = 240
Width = 2715
End
Begin VB.CheckBox chkShowGrid
BackColor = &H80000018&
Caption = "显示网格"
Height = 435
Left = 10800
TabIndex = 6
Top = 210
Width = 1035
End
Begin VB.PictureBox picParent
BackColor = &H00FFC0C0&
Height = 7725
Left = 1050
ScaleHeight = 135.202
ScaleMode = 6 'Millimeter
ScaleWidth = 199.761
TabIndex = 5
Top = 720
Width = 11385
Begin VB.PictureBox picChild
BackColor = &H00FFFFFF&
BorderStyle = 0 'None
Height = 2595
Left = 3750
ScaleHeight = 45.773
ScaleMode = 6 'Millimeter
ScaleWidth = 50.535
TabIndex = 11
Top = 2460
Visible = 0 'False
Width = 2865
Begin VB.PictureBox picPhoto
AutoRedraw = -1 'True
BackColor = &H00C0FFC0&
BorderStyle = 0 'None
Height = 1305
Index = 0
Left = 120
ScaleHeight = 1305
ScaleWidth = 1830
TabIndex = 20
Top = 1215
Visible = 0 'False
Width = 1830
End
Begin VB.TextBox txtCaption
Appearance = 0 'Flat
BackColor = &H80000014&
BorderStyle = 0 'None
DragIcon = "frmCustom.frx":0CCA
Height = 300
Index = 0
Left = 90
Locked = -1 'True
MultiLine = -1 'True
TabIndex = 16
Text = "frmCustom.frx":0E1C
Top = 150
Visible = 0 'False
Width = 960
End
Begin VB.TextBox txtAuto
DragIcon = "frmCustom.frx":0E25
Height = 330
Index = 0
Left = 90
Locked = -1 'True
MultiLine = -1 'True
TabIndex = 15
Text = "frmCustom.frx":0F77
Top = 780
Visible = 0 'False
Width = 1875
End
Begin VB.Line linLine
Index = 0
Visible = 0 'False
X1 = 1.588
X2 = 15.346
Y1 = 10.054
Y2 = 10.054
End
End
End
Begin VB.Frame fraContainer
BackColor = &H80000018&
Caption = "选择"
Height = 4755
Left = -30
TabIndex = 0
Top = 750
Width = 1005
Begin VB.OptionButton optPhoto
BackColor = &H80000018&
Caption = "图 片"
Height = 915
Left = 60
Style = 1 'Graphical
TabIndex = 18
Top = 3810
Width = 915
End
Begin VB.OptionButton optAuto
BackColor = &H80000018&
Caption = "文 本"
Height = 915
Left = 60
Style = 1 'Graphical
TabIndex = 4
Top = 2910
Width = 915
End
Begin VB.OptionButton optLine
BackColor = &H80000018&
Caption = "线 条"
Height = 915
Left = 60
Style = 1 'Graphical
TabIndex = 3
Top = 2010
Width = 915
End
Begin VB.OptionButton optLabel
BackColor = &H80000018&
Caption = "标 签"
Height = 915
Left = 60
Style = 1 'Graphical
TabIndex = 2
Top = 1110
Width = 915
End
Begin VB.OptionButton optNormal
BackColor = &H80000018&
Caption = "正 常"
Height = 915
Left = 60
Style = 1 'Graphical
TabIndex = 1
Top = 210
Value = -1 'True
Width = 915
End
End
Begin XPControls.XPCommandButton cmdModify
Height = 405
Left = 5456
TabIndex = 19
Top = 210
Width = 945
_ExtentX = 1667
_ExtentY = 714
Caption = "修 改"
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
End
End
Attribute VB_Name = "frmCustom"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim mstrName As String '报表名称
Dim mstrBBID As String '报表ID
Dim mstrTempFile As String '临时图片路径
Dim menuOperation As OperationType
Dim mintLine As Integer '当前欲添加控件的索引
Dim mintText As Integer '当前欲添加控件的索引
Dim mintAuto As Integer '当前欲添加控件的索引
Dim mintPhoto As Integer '当前欲添加控件的索引
Dim msngLeft As Single
Dim msngTop As Single
Dim mblnDown As Boolean
Dim msngRatio As Single
Private Enum SelControl
Line = 0
Text = 1
Auto = 3
Photo = 4
Brank = 5
End Enum
Dim menuSel As SelControl
Dim mintIndex As Integer '当前选中的控件索引
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As POINTAPI, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long
Private Declare Function PtInRegion Lib "gdi32" (ByVal hRgn As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private hreg1 As Long, hreg2 As Long '选取的Line Objec其端点会有两个小正方形
'记录这两个正方形的handle of Region
Private haveSel As Boolean '目前是否有Line Object被选取
Private inReg1 As Boolean '是否在hreg1 的范围
Private inReg2 As Boolean '是否在hreg2 的范围
Private oldPoint As POINTAPI '记录选取到Line Object时的Mouse座标
Private lp1 As POINTAPI, lp2 As POINTAPI
Private aLine As Line
Private NotRefresh As Boolean
Private PI As Double
Private Sub chkShowGrid_Click()
Dim i As Integer
Dim sngWLeave As Single
Dim sngHLeave As Single
Dim sngX As Single
Dim sngY As Single
Dim sngWStep As Integer
Dim sngHStep As Integer
picChild.AutoRedraw = True
If chkShowGrid.Value = 0 Then
picChild.Cls
Else
picChild.ScaleMode = vbMillimeters
picChild.DrawWidth = 1
picChild.ForeColor = RGB(0, 0, 255)
sngWStep = 7.35
sngHStep = 7.42
sngWLeave = 31.5
sngHLeave = 25
'首先画横线
sngY = sngHLeave
Do
picChild.Line (sngWLeave, sngY)-(210 - sngWLeave, sngY)
sngY = sngY + sngHStep
Loop Until sngY > 297 - sngHLeave
'其次画纵线
sngX = sngWLeave
Do
picChild.Line (sngX, sngHLeave)-(sngX, 297 - sngHLeave - 1.8)
sngX = sngX + sngWStep
Loop Until sngX > 210 - sngWLeave
picChild.ScaleMode = vbPixels
End If
picChild.AutoRedraw = False
End Sub
Private Sub cmbReport_Click()
On Error Resume Next
Dim Status
Dim strSQL As String
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -