📄 flexprinter.tcls
字号:
End If
End Property
Public Property Let RowsTo(ByVal NewValue As Long)
lRowsTo = NewValue
End Property
Public Property Let RowsFrom(ByVal NewValue As Long)
lRowsFrom = NewValue
End Property
Private Sub Class_Initialize()
lRowsFrom = 0: lRowsTo = 1
bGridPrint = True
VSpace = 0: HSpace = 0 'V=Vertical H=Horizontal
RoundCorX = 10: RoundCorY = 10: GridPenStyle = 0
FillColor = vbWhite: bDrawBoarder = True
BoarderStyle = 0: BoarderColor = vbBlack: BoarderWidth = 1: BoarderDistance = 5
PosLeft = 10: PosTop = 10
End Sub
Public Property Get CurX() As Long
CurX = FinalX
End Property
Public Property Get CurY() As Long
CurY = FinalY
End Property
Private Function ValidObj(objOP As Object) As Boolean
Dim Msg As String
If TypeOf objOP Is Form Or TypeOf objOP Is PictureBox Or TypeOf objOP Is Printer Then
ValidObj = True
Else
ValidObj = False
End If
If Not ValidObj Then
Msg = "Invalid object " + vbCrLf
Msg = Msg + vbCrLf + vbCrLf
Msg = Msg + "The valid objects are Printer, PictureBox and Form" + vbCrLf
MsgBox Msg, vbCritical, "Invalid Object"
End If
End Function
Private Sub Class_Terminate()
Set objFlex = Nothing
End Sub
Public Sub DrawRulerH(Obj As Object, x As Long, y As Long, Length As Long, sUnit As String)
Dim Height As Long, Devide As Long
Dim SmallSteps As Long, bSwitch As Boolean
Dim h1 As Long, TwpPerUnit As Long
Dim TmpK1 As Long
Dim K1 As Long, K2 As Long, N As Long
Dim BuFore As Long
Dim BuDrawStyle As Long, BuDrawWidth As Long, BuDrawMode As Long, BuScaleMode As Long
Dim BuFontS As Long
If Not ValidObj(Obj) Then Exit Sub
'Back Up
BuDrawStyle = Obj.DrawStyle: BuDrawWidth = Obj.DrawWidth
BuDrawMode = Obj.DrawMode: BuFontS = Obj.FontSize
BuScaleMode = Obj.ScaleMode
BuFore = Obj.ForeColor
'Set
Obj.DrawStyle = vbSolid: Obj.DrawWidth = 1: Obj.DrawMode = vbCopyPen
Obj.ScaleMode = vbTwips: Obj.FontSize = 8
Obj.FontBold = False: Obj.FontItalic = False
Obj.FontStrikethru = False
Obj.FontUnderline = False
SetTextColor Obj.hDC, vbBlack
x = x * Screen.TwipsPerPixelX
y = y * Screen.TwipsPerPixelY
Height = 400
If UCase(sUnit) = "INCH" Then
TwpPerUnit = 1440
Devide = 20
Else
'CM
TwpPerUnit = 567
Devide = 6
End If
SmallSteps = TwpPerUnit / Devide
If bDrawBoarder Then
y = y - Height - ((BoarderDistance * Screen.TwipsPerPixelX) + 50) 'Top position and borDis leftposition and Bordis
x = x - BoarderDistance * Screen.TwipsPerPixelY
Else
y = y - (Height + 50)
End If
Obj.Line (x, y)-(x + Length, y)
Obj.Line (x, y + Height)-(x + Length, y + Height)
N = -1
For K1 = 0 To Length Step TwpPerUnit
bSwitch = True: N = N + 1
Obj.Line (x + K1, y)-(x + K1, y + Height + 50), vbRed
''''''
Obj.Line (x + K1, y + Height + 50)-(x + K1 - 50, y + Height + 50 - 100), vbRed
Obj.Line (x + K1, y + Height + 50)-(x + K1 + 50, y + Height + 50 - 100), vbRed
Obj.CurrentY = y + 30
Obj.CurrentX = Obj.CurrentX + 20 - Obj.TextWidth(Str(N)) / 2
If K1 = 0 Then Obj.Print "0 " + Mid(sUnit, 1, 2) + "." Else Obj.Print N
Obj.Line (x + K1 + TwpPerUnit / 2, y)-(x + K1 + TwpPerUnit / 2, y + Height)
For K2 = TmpK1 + SmallSteps To K1 - SmallSteps Step SmallSteps
bSwitch = Not bSwitch
If bSwitch Then
Obj.Line (x + K2, y + Height - 200)-(x + K2, y + Height)
Else
Obj.Line (x + K2, y + Height - 100)-(x + K2, y + Height)
End If
Next K2
TmpK1 = K1
Next K1
'restore the things
SetTextColor Obj.hDC, BuFore
Obj.DrawStyle = BuDrawStyle: Obj.DrawWidth = BuDrawWidth: Obj.DrawMode = BuDrawMode
Obj.ScaleMode = BuScaleMode: Obj.FontSize = BuFontS
End Sub
Public Sub DrawRulerV(Obj As Object, x As Long, y As Long, Length As Long, sUnit As String)
Dim Height As Long, Devide As Long
Dim SmallSteps As Long, bSwitch As Boolean
Dim h1 As Long, TwpPerUnit As Long
Dim TmpK1 As Long
Dim K1 As Long, K2 As Long, N As Long
Dim BuDrawStyle As Long, BuDrawWidth As Long, BuDrawMode As Long, BuScaleMode As Long
Dim BuFontS As Long
Dim BuFore As Long
If Not ValidObj(Obj) Then Exit Sub
'Back Up
BuDrawStyle = Obj.DrawStyle: BuDrawWidth = Obj.DrawWidth
BuDrawMode = Obj.DrawMode: BuScaleMode = Obj.ScaleMode
BuFontS = Obj.FontSize
BuFore = Obj.ForeColor
'Set New
Obj.DrawStyle = vbSolid: Obj.DrawWidth = 1: Obj.DrawMode = vbCopyPen
Obj.ScaleMode = vbTwips: Obj.FontSize = 8: Obj.FontBold = False: Obj.FontItalic = False
Obj.FontStrikethru = False
Obj.FontUnderline = False
SetTextColor Obj.hDC, vbBlack
x = x * Screen.TwipsPerPixelX: y = y * Screen.TwipsPerPixelY
Height = 400
Length = Obj.Height
If UCase(sUnit) = "INCH" Then
TwpPerUnit = 1440
Devide = 20
Else
'CM
TwpPerUnit = 567
Devide = 6
End If
SmallSteps = TwpPerUnit / Devide
If bDrawBoarder Then
x = x - Height - ((BoarderDistance * Screen.TwipsPerPixelX) + 50) 'Top position and borDis leftposition and Bordis
y = y - BoarderDistance * Screen.TwipsPerPixelY
Else
x = x - (Height + 50)
End If
Obj.Line (x, y)-(x, y + Length)
Obj.Line (x + Height, y)-(x + Height, y + Length)
N = -1
For K1 = 0 To Length Step TwpPerUnit
bSwitch = True: N = N + 1
Obj.Line (x, y + K1)-(x + Height + 50, y + K1), vbRed
'Aero Heads
Obj.Line (x + Height + 50, y + K1)-(x + Height - 50, y + K1 - 50), vbRed
Obj.Line (x + Height + 50, y + K1)-(x + Height - 50, y + K1 + 50), vbRed
Obj.CurrentX = x - 30 + Obj.TextWidth(Str(N)) / 2
If K1 = 0 Then Obj.Print "0 " + Mid(sUnit, 1, 2) + "." Else Obj.Print N
Obj.Line (x, y + K1 + TwpPerUnit / 2)-(x + Height, y + K1 + TwpPerUnit / 2)
For K2 = TmpK1 + SmallSteps To K1 - SmallSteps Step SmallSteps
bSwitch = Not bSwitch
If bSwitch Then
Obj.Line (x + Height - 200, y + K2)-(x + Height, y + K2)
Else
Obj.Line (x + Height - 100, y + K2)-(x + Height, y + K2)
End If
Next K2
TmpK1 = K1
Next K1
Obj.DrawStyle = BuDrawStyle: Obj.DrawWidth = BuDrawWidth: Obj.DrawMode = BuDrawMode
Obj.ScaleMode = BuScaleMode: Obj.FontSize = BuFontS
SetTextColor Obj.hDC, BuFore
End Sub
Public Sub ColSetupCode()
'Code Generator
Dim C As Long, R As Long
Dim cd As String
cd = cd + "'You can place this code in Form's load event" + vbCrLf + vbCrLf
cd = cd + "'MSFlex Grid Control does not require these code but MSHFlex does" + vbCrLf + vbCrLf
cd = cd + "With " + objFlex.Name + vbCrLf
For C = 0 To objFlex.Cols - 1
R = objFlex.ColWidth(C)
If R < 1 Then cd = cd + "'You must set positive value to follwing line" + vbCrLf
cd = cd + ".ColWidth(" + Str(C) + ") =" + Str(R) + vbCrLf
Next C
cd = cd + "End With"
Clipboard.Clear ' Clear Clipboard.
Clipboard.SetText cd
MsgBox "Column setup code has been copied to cilipboard"
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -