⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 flexprinter.tcls

📁 汽修厂管理软件
💻 TCLS
📖 第 1 页 / 共 2 页
字号:
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 + -