BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Arial"
Size = 15.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = -1 'True
Strikethrough = 0 'False
EndProperty
Height = 1155
Left = 60
ScaleHeight = 75
ScaleMode = 3 'Pixel
ScaleWidth = 171
TabIndex = 1
Top = 1320
Width = 2595
End
Begin VB.PictureBox Picture1
Height = 1095
Left = 60
Picture = "EX8B.frx":0000
ScaleHeight = 1065
ScaleWidth = 2565
TabIndex = 0
Top = 120
Width = 2595
End
Begin Cbkd.Callback Callback1
Left = 5400
Top = 2160
_Version = 262144
_ExtentX = 847
_ExtentY = 847
_StockProps = 0
Type = 38
End
Begin VB.Label Label1
Caption = "Note: All combinations are using a red brush."
Height = 255
Left = 60
TabIndex = 10
Top = 2520
Width = 3555
End
Attribute VB_Name = "frmex8B"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit
' Copyright
1997 by Desaware Inc. All Rights Reserved
Private Type POINTAPI
x As Long
y As Long
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function AngleArc& Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal dwRadius As Long, ByVal eStartAngle As Single, ByVal eSweepAngle As Single)
Private Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, lpPoint As POINTAPI) As Long
Private Declare Function CreatePatternBrush Lib "gdi32" (ByVal hBitmap As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject 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 GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function DrawEdge& Lib "user32" (ByVal hdc As Long, qrc As RECT, ByVal edge As Long, ByVal grfFlags As Long)
Private Declare Function InflateRect Lib "user32" (lpRect As RECT, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function DrawFrameControl Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal un1 As Long, ByVal un2 As Long) As Long
Private Declare Function DrawState Lib "user32" Alias "DrawStateA" (ByVal hdc As Long, ByVal hBrush As Long, ByVal lpDrawStateProc As Long, ByVal lParam As Long, ByVal wParam As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal n3 As Long, ByVal n4 As Long, ByVal un As Long) As Long
Private Declare Function DrawStateByString Lib "user32" Alias "DrawStateA" (ByVal hdc As Long, ByVal hBrush As Long, ByVal lpDrawStateProc As Long, ByVal lParam As String, ByVal wParam As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal n3 As Long, ByVal n4 As Long, ByVal un As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
Const pi = 3.141578
Private Const DSS_DISABLED = &H20
Private Const DSS_MONO = &H80
Private Const DSS_NORMAL = &H0
Private Const DSS_RIGHT = &H8000
Private Const DSS_UNION = &H10
Private Const DST_BITMAP = &H4
Private Const DST_COMPLEX = &H0
Private Const DST_ICON = &H3
Private Const DST_PREFIXTEXT = &H2
Private Const DST_TEXT = &H1
Private Sub Callback1_cbxLLLLL(lval1 As Long, lval2 As Long, lval3 As Long, lval4 As Long, lval5 As Long, retval As Long)
Dim usebrush&
Dim di&
Dim rc As RECT
rc.Left = 0
rc.Top = 0
rc.Right = lval4 \ 2
rc.Bottom = lval5 \ 2
' We have to draw into the device context provided
' Draw a green rectangle in the upper left corner
usebrush& = CreateSolidBrush(RGB(0, 255, 0))
di = FillRect(lval1, rc, usebrush)
di = DeleteObject(usebrush)
' Just throw some text out
di = TextOut(lval1, 5, 5, "Hello", 5)
' We don't need lparam and wParam here - so they are ignored
' You can pass the values if you wish
Debug.Print lval2, lval3
End Sub
Private Sub Command1_Click()
Dim di&
Dim hbr&
Picture2.Cls
hbr& = CreateSolidBrush(RGB(255, 0, 0))
di = DrawState(Picture2.hdc, hbr&, 0, Picture1.Picture, 0, 0, 0, Picture2.ScaleWidth, Picture2.ScaleHeight, DST_BITMAP Or GetEffect())
End Sub
Public Function GetEffect&()
Dim x%
Dim eff&
If optEffect(0).Value <> 0 Then eff = DSS_NORMAL
If optEffect(1).Value <> 0 Then eff = DSS_UNION
If optEffect(2).Value <> 0 Then eff = DSS_MONO
If optEffect(3).Value <> 0 Then eff = DSS_DISABLED
If chkRight.Value <> 0 Then eff = eff Or DSS_RIGHT
GetEffect = eff
End Function
Private Sub Command2_Click()
Dim di&
Dim hbr&
Picture2.Cls
hbr& = CreateSolidBrush(RGB(255, 0, 0))
di = DrawStateByString(Picture2.hdc, hbr&, 0, "A String", 8, 0, 0, Picture2.ScaleWidth, Picture2.ScaleHeight, DST_TEXT Or GetEffect())
End Sub
Private Sub Command3_Click()
Dim di&
Dim hbr&
Picture2.Cls
hbr& = CreateSolidBrush(RGB(255, 0, 0))
di = DrawState(Picture2.hdc, hbr&, Callback1.ProcAddress, 195, 42, 0, 0, Picture2.ScaleWidth, Picture2.ScaleHeight, DST_COMPLEX Or GetEffect())
(.txt)
