📄 formdemo.frm
字号:
VERSION 5.00
Begin VB.Form FormDemo
Caption = "打印画线演示"
ClientHeight = 5370
ClientLeft = 60
ClientTop = 345
ClientWidth = 6855
LinkTopic = "Form1"
ScaleHeight = 5370
ScaleWidth = 6855
StartUpPosition = 3 '窗口缺省
Begin VB.CommandButton Command10
Caption = "Command10"
Height = 255
Left = 5475
TabIndex = 16
Top = 4650
Width = 1065
End
Begin VB.CommandButton Command9
Caption = "Scale"
Height = 315
Left = 4395
TabIndex = 15
Top = 4620
Width = 870
End
Begin VB.CommandButton Command8
Caption = "EndDoc演示"
Height = 435
Left = 3045
TabIndex = 14
Top = 4515
Width = 885
End
Begin VB.PictureBox Picture1
Height = 2895
Left = 4245
ScaleHeight = 2835
ScaleWidth = 2520
TabIndex = 13
Top = 1305
Width = 2580
End
Begin VB.Timer Timer1
Left = 390
Top = 540
End
Begin VB.CommandButton Command7
Caption = "ScaleHeight .Width 演示"
Height = 720
Left = 3015
TabIndex = 12
Top = 3555
Width = 915
End
Begin VB.CommandButton Command6
Caption = "寻找端口"
Height = 300
Left = 3030
TabIndex = 11
Top = 3060
Width = 960
End
Begin VB.CommandButton Command5
Caption = "Page"
Height = 285
Left = 3045
TabIndex = 10
Top = 315
Width = 930
End
Begin VB.ComboBox Combo3
Height = 300
Left = 4575
Style = 2 'Dropdown List
TabIndex = 9
Top = 795
Width = 2055
End
Begin VB.CommandButton Command4
Caption = "列表字体"
Height = 315
Left = 3045
TabIndex = 8
Top = 780
Width = 930
End
Begin VB.CommandButton Command3
Caption = "Pset"
Height = 315
Left = 3045
TabIndex = 7
Top = 1305
Width = 915
End
Begin VB.CommandButton Command2
Caption = "终止打印"
Height = 330
Left = 3045
TabIndex = 6
Top = 1860
Width = 930
End
Begin VB.TextBox Text1
Height = 285
Left = 105
TabIndex = 5
Text = "Text1"
Top = 1920
Width = 1815
End
Begin VB.ComboBox Combo2
Height = 300
Left = 120
Style = 2 'Dropdown List
TabIndex = 3
Top = 1530
Width = 1815
End
Begin VB.CommandButton Command1
Caption = "设置默认"
Height = 330
Left = 3045
TabIndex = 1
Top = 2535
Width = 945
End
Begin VB.ComboBox Combo1
Height = 300
Left = 90
Style = 2 'Dropdown List
TabIndex = 0
Top = 2535
Width = 1860
End
Begin VB.Label Label2
Caption = "设置打印分辨率:"
Height = 195
Left = 150
TabIndex = 4
Top = 1245
Width = 1635
End
Begin VB.Label Label1
Caption = "搜索当前打印机"
Height = 270
Left = 90
TabIndex = 2
Top = 2265
Width = 1395
End
End
Attribute VB_Name = "FormDemo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'
Private Sub Combo2_Click()
Text1 = Combo2.Text
'Printer.PrintQuality = Combo1.ListIndex
End Sub
Private Sub Command1_Click()
Dim x As Printer
For Each x In Printers
If x.Orientation = vbPRORPortrait Then
'设定为系统缺省打印机。
Set Printer = x
' 终止查找打印机。
Exit For
End If
Next
End Sub
Private Sub Command10_Click()
Dim HalfWidth, HalfHeight, Msg ' 声明变量。
AutoRedraw = -1 ' 打开AutoRedraw。
BackColor = QBColor(4) ' 设置背景颜色。
ForeColor = QBColor(15) ' 设置前景颜色。
Msg = "Visual Basic" ' 创建信息。
FontSize = 48 ' 设置字体大小。
HalfWidth = TextWidth(Msg) / 2 ' 计算半宽。
HalfHeight = TextHeight(Msg) / 2 ' 计算半高。
CurrentX = ScaleWidth / 2 - HalfWidth ' 设置X。
CurrentY = ScaleHeight / 2 - HalfHeight ' 设置Y。
Print Msg ' 打印信息。
End Sub
Private Sub Command2_Click()
Dim i As Integer
For i = 1 To 40
Printer.CurrentX = 1440 ' 设置左边距。
Printer.CurrentY = (i * 300) ' 进页到下一行。
Printer.Print "This is line" & Str$(i) & " of text."
On Error Resume Next ' 捕获任何打印机错误。
If i = 26 Then
Printer.KillDoc ' 立即终止打印作业。
Printer.EndDoc
End
End If
Next i
End Sub
Private Sub Command3_Click()
Dim CX, CY, Msg, XPos, YPos ' Declare variables.
ScaleMode = 3 ' 设置 ScaleMode 为像素。
DrawWidth = 5 ' 设置 DrawWidth.
ForeColor = QBColor(4) ' 设置前景为红色。
FontSize = 24 ' 设置点的大小。
CX = ScaleWidth / 2 ' 得到水平中点。
CY = ScaleHeight / 2 ' 得到垂直中点。
Cls ' 清窗体。
Msg = "Happy New Year!"
CurrentX = CX - TextWidth(Msg) / 2 ' 水平位置。
CurrentY = CY - TextHeight(Msg) ' 垂直位置。
Print Msg ' 打印消息。
Do
XPos = Rnd * ScaleWidth ' 得到水平位置。
YPos = Rnd * ScaleHeight ' 得到垂直位置。
PSet (XPos, YPos), QBColor(Rnd * 15) ' 画五彩碎纸。
DoEvents ' 进行
Loop ' 其它处理。
End Sub
Private Sub Command4_Click()
Dim i ' 声明变量.
For i = 0 To Printer.FontCount - 1 ' 确定字体数.
Combo3.AddItem Printer.Fonts(i) ' 把每一种字体放进列表框.
Next i
End Sub
Private Sub Command5_Click()
Dim Header, i, Y ' 声明变量。
Print "Now printing..." ' 在窗体上放置注意信息。
Header = "Printing Demo - Page " ' 设置页眉字符串。
For i = 1 To 3
Printer.Print Header; ' 打印页眉。
Printer.Print Printer.Page ' 打印页号。
Y = Printer.CurrentY + 10 ' 设置行位置。
' 画一条跨页横线。
Printer.Line (0, Y)-(Printer.ScaleWidth, Y) ' 画线。
For k = 1 To 50
Printer.Print String(k, " "); ' 打印空格字符串。
Printer.Print "Visual Basic "; ' 打印文本。
Printer.Print Printer.Page ' 打印页号。
Next
Printer.NewPage
Next i
Printer.EndDoc
End
End Sub
Private Sub Command6_Click()
Dim P As Object
For Each P In Printers
If P.Port = "LPT2:" Or P.DeviceName Like "*LaserJet*" Then
Set Printer = P
Exit For
End If
Next P
End Sub
Private Sub Command7_Click()
Dim Radius As Integer ' 声明变量。
ScaleHeight = 100 ' 设置高度的单位值。
ScaleWidth = 100 ' 设置宽度的单位值。
For Radius = 5 To 50 Step 5
FillStyle = 1
Circle (50, 50), Radius ' 画圆。
Next Radius
End Sub
Private Sub Command8_Click()
Dim HWidth, HHeight, i, Msg ' 声明变量。
On Error GoTo ErrorHandler ' 设置错误处理程序。
Msg = "This is printed on page"
For i = 1 To 2 ' 设置 2 个迭代。
HWidth = Printer.TextWidth(Msg) / 2 ' 取得半宽。
HHeight = Printer.TextHeight(Msg) / 2 ' 取得半高。
Printer.CurrentX = Printer.ScaleWidth / 2 - HWidth
Printer.CurrentY = Printer.ScaleHeight / 2 - HHeight
Printer.Print Msg & Printer.Page & "." ' 打印。
Printer.NewPage ' 发送新页。
Next i
Printer.EndDoc ' 打印完成。
Msg = "Two pages, each with a single, centered line of text, "
Msg = Msg & "have been sent to your printer."
MsgBox Msg ' 显示信息。
Exit Sub
ErrorHandler:
MsgBox "There was a problem printing to your printer."
Exit Sub
End Sub
Private Sub Command9_Click()
Dim i, OldFontSize ' 声明变量。
Width = 8640: Height = 5760 ' 按缇设置窗体大小。
Move 100, 100 ' 移动窗体起点。
AutoRedraw = -1 ' 打开AutoRedraw。
OldFontSize = FontSize ' 保持旧的字体大小。
BackColor = QBColor(7) ' 将背景设置为灰色。
Scale (0, 110)-(130, 0) ' 设定自定义座标系统。
For i = 100 To 10 Step -10
Line (0, i)-(2, i) ' 每隔 10 个单位划尺寸标记。
CurrentY = CurrentY + 1.5 ' 移动光标位置。
Print i ' Print scale mark value on left.
Line (ScaleWidth - 2, i)-(ScaleWidth, i)
CurrentY = CurrentY + 1.5 ' 移动光标位置。
CurrentX = ScaleWidth - 9
Print i ' 将尺寸标记值打印在右边。
Next i
' 画条形图。
Line (10, 0)-(20, 45), RGB(0, 0, 255), BF ' 第一个蓝色条。
Line (20, 0)-(30, 55), RGB(255, 0, 0), BF ' 第一个红色条。
Line (40, 0)-(50, 40), RGB(0, 0, 255), BF
Line (50, 0)-(60, 25), RGB(255, 0, 0), BF
Line (70, 0)-(80, 35), RGB(0, 0, 255), BF
Line (80, 0)-(90, 60), RGB(255, 0, 0), BF
Line (100, 0)-(110, 75), RGB(0, 0, 255), BF
Line (110, 0)-(120, 90), RGB(255, 0, 0), BF
CurrentX = 18: CurrentY = 100 ' 移动光标位置。
FontSize = 14 ' 放大标题尺寸。
Print "Widget Quarterly Sales" ' 打印标题。
FontSize = OldFontSize ' 还原字体大小。
CurrentX = 27: CurrentY = 93 ' 移动光标位置。
Print "Planned Vs. Actual" ' 打印子标题。
Line (29, 86)-(34, 88), RGB(0, 0, 255), BF ' 打印图例。
Line (43, 86)-(49, 88), RGB(255, 0, 0), BF
End Sub
Sub Form_Click()
Dim CX, CY, F, F1, F2, i ' 声明变量。
ScaleMode = 3 ' 设置 ScaleMode 为像素。
CX = ScaleWidth / 2 ' 水平中点。
CY = ScaleHeight / 2 ' 垂直中点。
DrawWidth = 8 ' 设置 DrawWidth。
For i = 50 To 0 Step -2
F = i / 50 ' 执行中间步骤。
F1 = 1 - F: F2 = 1 + F ' 计算。
ForeColor = QBColor(i Mod 15) ' 设置前景颜色。
Line (CX * F1, CY * F1)-(CX * F2, CY * F2), , BF
Next i
DoEvents ' 做其它处理。
If CY > CX Then ' 设置 DrawWidth。
DrawWidth = ScaleWidth / 25
Else
DrawWidth = ScaleHeight / 25
End If
For i = 0 To 50 Step 2 ' Set up loop.
F = i / 50 ' 执行中间。
F1 = 1 - F: F2 = 1 + F ' 计算。
Line (CX * F1, CY)-(CX, CY * F1) ' 画左上角。
Line -(CX * F2, CY) ' 画右上角。
Line -(CX, CY * F2) ' 画右下角。
Line -(CX * F1, CY) ' 画左下角。
ForeColor = QBColor(i Mod 15) ' 每次改变颜色。
Next i
DoEvents ' 进行其它处理。
End Sub
Private Sub Form_Load()
Dim x
Combo1.Clear
For Each x In Printers
Combo1.AddItem Printer.DeviceName
Next
Combo1.ListIndex = 0
Combo2.Clear
Combo2.AddItem "草稿分辨率"
Combo2.AddItem "低分辨率"
Combo2.AddItem "中等分辨率"
Combo2.AddItem "高分辨率"
Combo2.ListIndex = 0
Timer1.Interval = 250 ' 设置计时器的间隔。
Picture1.ScaleTop = -1 ' 为网格的顶部设置刻度。
Picture1.ScaleLeft = -1 ' 为网格的左部设置刻度。
Picture1.ScaleWidth = 2 ' 设置刻度范围 （-1 到1）。
Picture1.ScaleHeight = 2
Picture1.Line (-1, 0)-(1, 0) ' 画水平线。
Picture1.Line (0, -1)-(0, 1) ' 画垂直线。
End Sub
Private Sub Timer1_Timer()
Dim i ' 声明变量。
' 在一个范围内随机地画些点。
For i = -1 To 1 Step 0.05
Picture1.PSet (i * Rnd, i * Rnd) ' 画一个点。
Next i
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -