📄 mfrm_bill.frm
字号:
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form mFrm_Bill
BackColor = &H8000000C&
Caption = "Form1"
ClientHeight = 5895
ClientLeft = 60
ClientTop = 345
ClientWidth = 11775
KeyPreview = -1 'True
MDIChild = -1 'True
ScaleHeight = 5895
ScaleWidth = 11775
WindowState = 2 'Maximized
Begin MSComDlg.CommonDialog Cdlg
Left = 240
Top = 3630
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.VScrollBar VS
Height = 3165
LargeChange = 1000
Left = 9540
SmallChange = 100
TabIndex = 5
Top = 1395
Width = 285
End
Begin VB.HScrollBar HS
Height = 285
LargeChange = 1000
Left = 675
SmallChange = 100
TabIndex = 4
Top = 4275
Width = 8250
End
Begin VB.TextBox TxtLab
Alignment = 2 'Center
BorderStyle = 0 'None
Height = 495
Left = 2400
TabIndex = 3
Top = 3930
Visible = 0 'False
Width = 1275
End
Begin VB.PictureBox PicPage
BackColor = &H8000000E&
BorderStyle = 0 'None
Height = 3690
Left = 0
ScaleHeight = 3690
ScaleWidth = 8190
TabIndex = 1
Top = 0
Width = 8190
Begin VB.Image ObjImg
Height = 240
Index = 2000
Left = 1260
Top = 1950
Visible = 0 'False
Width = 240
End
Begin VB.Image PicHD
Appearance = 0 'Flat
Height = 105
Index = 0
Left = 6030
Picture = "mFrm_Bill.frx":0000
Stretch = -1 'True
Top = 810
Visible = 0 'False
Width = 105
End
Begin VB.Line ObjLine
Index = 0
Visible = 0 'False
X1 = 420
X2 = 3240
Y1 = 720
Y2 = 720
End
Begin VB.Label ObjText
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
BackStyle = 0 'Transparent
BorderStyle = 1 'Fixed Single
Caption = "文字"
ForeColor = &H80000008&
Height = 510
Index = 1000
Left = 4950
TabIndex = 2
Top = 1575
Visible = 0 'False
Width = 1335
End
End
Begin VB.PictureBox PicFixHd
Appearance = 0 'Flat
BackColor = &H00C0FFFF&
BorderStyle = 0 'None
FillColor = &H8000000D&
ForeColor = &H80000008&
Height = 195
Index = 0
Left = 9225
ScaleHeight = 195
ScaleWidth = 165
TabIndex = 0
Top = 2925
Visible = 0 'False
Width = 165
End
Begin VB.Image ImgCurLock
Appearance = 0 'Flat
Height = 105
Left = 6240
Picture = "mFrm_Bill.frx":00EA
Top = 1470
Visible = 0 'False
Width = 105
End
Begin VB.Image ImgLock
Appearance = 0 'Flat
Height = 105
Left = 6210
Picture = "mFrm_Bill.frx":01D4
Top = 1650
Visible = 0 'False
Width = 105
End
Begin VB.Image ImgAct
Appearance = 0 'Flat
Height = 105
Left = 6000
Picture = "mFrm_Bill.frx":02BE
Top = 1440
Visible = 0 'False
Width = 105
End
Begin VB.Image ImgCur
Height = 105
Left = 6000
Picture = "mFrm_Bill.frx":03A8
Top = 1650
Visible = 0 'False
Width = 105
End
End
Attribute VB_Name = "mFrm_Bill"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Const PictSet = 0
Public mScreenID As Integer, mID As Integer, mIsDefault As Boolean
Public mRowHeight As Single, mrowcount As Integer, mLandScape As Boolean
Public mColWidth As Single, mcolcount As Integer, mBlnColFirst As Boolean
Public mObjs As New ObjDraws
Dim mFixHdIdx As Integer, mbPageDraw As Boolean, mbMoreMove As Boolean
Dim OldPoint As POINTAPI
Dim mObj_Draw As New ObjDraw, mObjAct As New ObjDraw
Dim mActHd As Integer, mActLab As Long, mbPropLoad As Boolean
Private Sub Form_Activate()
Set g_ActFrm = Me
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Dim strkey As String
If Shift = vbCtrlMask Then
Call RightMenu(False)
Exit Sub
End If
End Sub
Private Sub Form_Load()
Call InitPar
End Sub
Private Sub RightMenu(Optional bShow As Boolean = True)
With mFrm_Main
.mun_Align.Enabled = (mObjs.nActCount > 1)
.mun_SameSize.Enabled = (mObjs.nActCount > 1)
.mun_ObjProp.Enabled = (mObjs.nActCount > 0)
.mun_Delete.Enabled = (mObjs.nActCount > 0)
.mun_Lock.Enabled = .mun_Delete.Enabled
.mun_Clone.Enabled = .mun_Delete.Enabled
If mObjs.nCurID > 0 Then .mun_Lock.Checked = mObjs("Obj" & mObjs.nCurID).Locked
.mun_ObjProp.Enabled = (mObjs.nActCount = 1)
If bShow Then PopupMenu .mun_Right
End With
End Sub
Public Sub SelAll()
If mObjs.Count > 0 Then mObjs.ActiveAll: Set mObjAct = mObjs.Item("Obj" & mObjs.nCurID)
End Sub
Public Sub CloneObj()
If mObjs.nActCount > 0 Then mObjs.CloneActObj
End Sub
Public Sub PreView()
If mObjs.Count = 0 Then
MsgBox "没有发现可打印的内容！", vbExclamation, Me.Caption
Exit Sub
ElseIf mID = 0 Then
MsgBox "请先保存数据！", vbExclamation, Me.Caption
Exit Sub
End If
mBillID = Val(InputBox("请输入单据号？", "单据号", 0))
PreViewBill (mScreenID), (mID), mBillID, 0, True, (mBillID = 0)
End Sub
Public Sub SetObjProp()
On Error GoTo error
If mObjs.nActCount <> 1 Then Exit Sub
If Not mObjAct Is Nothing Then
mFrm_Prop.Init
mFrm_Prop.Show 1
End If
Exit Sub
error:
ErrInfo "设置属性失败！"
End Sub
Public Sub Locked()
Dim tmpobj As ObjDraw
On Error GoTo error
If mObjs.nActCount = 0 Then Exit Sub
mFrm_Main.mun_Lock.Checked = mObjs.Item("Obj" & mObjs.nCurID).Locked
If mObjs.nActCount = 1 Then mObjAct.Locked = Not mObjAct.Locked
If mObjs.nActCount > 1 Then
For Each tmpobj In mObjs
If tmpobj.IsActive Then mObjs.Item("Obj" & tmpobj.nID).Locked = Not mObjAct.Locked
Next
End If
Exit Sub
error:
ErrInfo "设置锁定失败！"
End Sub
Public Sub Delete()
Dim tmpobj As ObjDraw
On Error GoTo error
If mObjs.nActCount = 0 Then Exit Sub
If mObjs.nActCount = 1 Then
mObjAct.Handls.Clear
mObjs.Item("Obj" & mObjs.nCurID).ObjCtl.Visible = False
Else
For Each tmpobj In mObjs
If tmpobj.IsActive Then
tmpobj.ObjCtl.Visible = False
tmpobj.Handls.Clear
End If
Next
End If
mObjs.nActCount = 0
Exit Sub
error:
ErrInfo "删除对象失败！"
End Sub
Public Sub SetSameSize(sizepar As SameSizeCur)
On Error GoTo error
mObjs.MakeSameSize (sizepar)
Exit Sub
error:
ErrInfo "操作失败！"
End Sub
Public Sub SetAlign(alignpar As AlignCur)
On Error GoTo error
mObjs.AlginToCur (alignpar)
Exit Sub
error:
ErrInfo "操作失败！"
End Sub
Private Sub InitPar()
Dim i As Integer
Dim xHandle As Integer, yHandle As Integer
xHandle = 5 * Screen.TwipsPerPixelX
yHandle = 5 * Screen.TwipsPerPixelY
PicFixHd(0).Height = yHandle
PicFixHd(0).Width = xHandle
PicHD(0).Height = yHandle
PicHD(0).Width = xHandle
For i = 1 To 3
Load PicFixHd(i)
PicFixHd(i).Visible = True
PicFixHd(i).Visible = True
PicFixHd(i).ZOrder
Next
HS.ZOrder
VS.ZOrder
PicFixHd(1).MousePointer = vbSizeWE
PicFixHd(2).MousePointer = vbSizeNS
PicFixHd(3).MousePointer = vbSizeNWSE
Call MoveFixHd
End Sub
Public Sub LoadBill(tmpID As Integer)
On Error GoTo Er
mID = tmpID
'
' Call LoadLine(rsLine)
' Call LoadText(rsText)
' Call LoadImage(rsImage)
Exit Sub
Er:
Call ErrInfo
End Sub
Private Sub MoveFixHd()
Dim xFudge As Long, yFudge As Long, nWidth As Long, nHeight As Long
xFudge = (0.5 * Screen.TwipsPerPixelX)
yFudge = (0.5 * Screen.TwipsPerPixelY)
nWidth = (PicFixHd(0).Width \ 2) - 50
nHeight = (PicFixHd(0).Height \ 2) - 50
With PicPage
'Center right
PicFixHd(1).Move .Left + .Width - nWidth - xFudge, .Top + (.Height / 2) - nHeight
'Bottom center
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -