📄 frmdraw.frm
字号:
VERSION 5.00
Object = "{B25498A2-5592-11D3-8644-DA5FB01D9D37}#1.1#0"; "ExRainButton.ocx"
Begin VB.Form frmDraw
BorderStyle = 3 'Fixed Dialog
Caption = "Excalibur RainbowButton Custom Draw Demo"
ClientHeight = 3720
ClientLeft = 45
ClientTop = 330
ClientWidth = 6360
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Icon = "frmDraw.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 248
ScaleMode = 3 'Pixel
ScaleWidth = 424
ShowInTaskbar = 0 'False
StartUpPosition = 2 'CenterScreen
Begin ExRainButton.RainButton cmdDraw3
Height = 975
Left = 3360
TabIndex = 2
Top = 1440
Width = 2295
_ExtentX = 4048
_ExtentY = 1720
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Picture = "frmDraw.frx":000C
Caption = "Custom Drawn Picture"
MouseTrack = -1 'True
End
Begin VB.Timer tmr
Interval = 100
Left = 120
Top = 2880
End
Begin ExRainButton.RainButton cmdDraw1
Height = 855
Left = 120
TabIndex = 0
Top = 120
Width = 2295
_ExtentX = 4048
_ExtentY = 1508
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Caption = "Custom Drawn Caption"
MouseTrack = -1 'True
End
Begin ExRainButton.RainButton cmdDraw2
Height = 975
Left = 120
TabIndex = 1
Top = 1440
Width = 2295
_ExtentX = 4048
_ExtentY = 1720
ForeColor = 16777215
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Picture = "frmDraw.frx":08E6
Caption = "Custom Drawn Background"
MouseTrack = -1 'True
End
Begin VB.Image img
Height = 480
Index = 6
Left = 5520
Picture = "frmDraw.frx":11C0
Top = 3000
Width = 480
End
Begin VB.Image img
Height = 480
Index = 5
Left = 4920
Picture = "frmDraw.frx":1A8A
Top = 3000
Width = 480
End
Begin VB.Image img
Height = 480
Index = 4
Left = 4320
Picture = "frmDraw.frx":2354
Top = 3000
Width = 480
End
Begin VB.Image img
Height = 480
Index = 3
Left = 3720
Picture = "frmDraw.frx":2C1E
Top = 3000
Width = 480
End
Begin VB.Image img
Height = 480
Index = 2
Left = 3120
Picture = "frmDraw.frx":34E8
Top = 3000
Width = 480
End
Begin VB.Image img
Height = 480
Index = 1
Left = 2520
Picture = "frmDraw.frx":3DB2
Top = 3000
Width = 480
End
Begin VB.Image img
Height = 480
Index = 0
Left = 1920
Picture = "frmDraw.frx":467C
Top = 3000
Width = 480
End
End
Attribute VB_Name = "frmDraw"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Implements IRainButtonDraw
Private Type POINTAPI
x As Long
y As Long
End Type
Dim Stars(0 To 10) As POINTAPI
Dim lAniStep As Long
Private Declare Function Ellipse 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 MoveToEx Lib "gdi32" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long, ByVal lpPoint As Long) As Long
Private Declare Function LineTo Lib "gdi32" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long) As Long
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function DrawText Lib "user32" Alias "DrawTextA" _
(ByVal hDC As Long, ByVal lpStr As String, ByVal nCount As Long, _
lpRect As RECT, ByVal wFormat As Long) As Long
Private Const DT_CENTER = &H1
Private Const DT_RIGHT = &H2
Private Const DT_SINGLELINE = &H20
Private Const DT_VCENTER = &H4
Private Const DT_BOTTOM = &H8
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function FillRect Lib "user32" (ByVal hDC As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function SetPixel Lib "gdi32" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function DrawIconEx Lib "user32" (ByVal hDC As Long, _
ByVal xLeft As Long, ByVal yTop As Long, _
ByVal hIcon As Long, ByVal cxWidth As Long, ByVal cyWidth As Long, _
ByVal istepIfAniCur As Long, ByVal hbrFlickerFreeDraw As Long, _
ByVal diFlags As Long) As Long
Private Const DI_NORMAL = 3
Private Sub Form_Load()
Dim i As Long
cmdDraw1.SetCallbackSink Me
cmdDraw2.SetCallbackSink Me
cmdDraw3.SetCallbackSink Me
For i = 0 To 10
Stars(i).x = Rnd * cmdDraw2.Width
Stars(i).y = Rnd * cmdDraw2.Height
Next
End Sub
Private Sub IRainButtonDraw_DrawItem(RainCtrl As ExRainButton.RainButton, ByVal hDC As Long, ByVal nDrawStep As ExRainButton.ButtonPreDrawSteps, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bMouseDown As Boolean, ByVal bHasFocus As Boolean, bDoDefaultDrawing As Boolean)
Dim rct As RECT
Dim x As Long, y As Long
Dim i As Long
Dim hBr As Long
If RainCtrl.Caption = "Custom Drawn Caption" Then
If nDrawStep = btnCaption Then
'Only manually draw the caption
'Default processing is done unless
'we set this parameter:
bDoDefaultDrawing = False
'Check for down state
If bMouseDown = True Then
x = 1
y = 1
End If
'Doodle on surface
MoveToEx hDC, 5 + x, 5 + y, 0
LineTo hDC, 10 + x, nHeight - 10 + y
Ellipse hDC, 20 + x, 5 + y, 50 + x, 35 + y
'Draw caption
rct.Left = (x * 2) + 12
rct.Top = y + 12
rct.Right = nWidth
rct.Bottom = nHeight
DrawText hDC, RainCtrl.Caption, Len(RainCtrl.Caption), _
rct, DT_CENTER
End If
ElseIf RainCtrl.Caption = "Custom Drawn Background" Then
If nDrawStep = btnBackground Then
'Draw only background manually
bDoDefaultDrawing = False
rct.Left = 0
rct.Top = 0
rct.Right = nWidth
rct.Bottom = nHeight
hBr = CreateSolidBrush(vbBlack)
FillRect hDC, rct, hBr
DeleteObject hBr
For i = 0 To 10
SetPixel hDC, Stars(i).x, Stars(i).y, vbWhite
Next
End If
ElseIf RainCtrl.Caption = "Custom Drawn Picture" Then
If bMouseDown = True Then
x = 1
y = 1
End If
If nDrawStep = btnPicture Then
bDoDefaultDrawing = False
DrawIconEx hDC, ((nWidth - 32) \ 2) + x, 6 + y, img(lAniStep).Picture.Handle, _
32, 32, 0, 0, DI_NORMAL
ElseIf nDrawStep = btnCaption Then
'Draw caption, because if we draw the picture
'manually then the PicturePlacement property
'ceases to have effect on the caption's placement.
bDoDefaultDrawing = False
rct.Top = 0
rct.Left = x * 2
rct.Right = nWidth
rct.Bottom = nHeight - 6 + y
DrawText hDC, RainCtrl.Caption, Len(RainCtrl.Caption), _
rct, DT_CENTER Or DT_SINGLELINE Or DT_BOTTOM
End If
End If
End Sub
Private Sub tmr_Timer()
Dim i As Long
For i = 0 To 10
Stars(i).x = Stars(i).x + 2
If Stars(i).x > cmdDraw2.Width Then
Stars(i).x = 0
End If
Stars(i).y = Stars(i).y + 1
If Stars(i).y > cmdDraw2.Height Then
Stars(i).y = 0
End If
Next
cmdDraw2.Refresh
lAniStep = lAniStep + 1
If lAniStep > 6 Then
lAniStep = 0
End If
cmdDraw3.Refresh
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -