Dan Appleman's Visual Bas…s Guide to the Win32 API/Dan.Applmans.Visual.Basic.5.0.Programmers.Guide.To.The.Win32.API.1997.Ziff-Davis.Press.CD/VB5PG32.mdf/vbpg32/samples4/ch08/ex8a.frm

Visual Basic Form | 1997-02-16 | 5.8 KB | 166 lines

VERSION 4.00
Begin VB.Form frmex8a
   Caption         =   "Additional Examples"
   ClientHeight    =   3240
   ClientLeft      =   1095
   ClientTop       =   1515
   ClientWidth     =   5685
   Height          =   3645
   Left            =   1035
   LinkTopic       =   "Form1"
   ScaleHeight     =   216
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   379
   Top             =   1170
   Width           =   5805
   Begin VB.CommandButton Command4
      Caption         =   "DrawFrameControl"
      Height          =   375
      Left            =   3780
      TabIndex        =   4
      Top             =   1260
      Width           =   1755
   End
   Begin VB.CommandButton Command3
      Caption         =   "DrawEdge"
      Height          =   375
      Left            =   3780
      TabIndex        =   3
      Top             =   900
      Width           =   1755
   End
   Begin VB.CommandButton Command2
      Caption         =   "Pattern Brush"
      Height          =   375
      Left            =   3780
      TabIndex        =   2
      Top             =   540
      Width           =   1755
   End
   Begin VB.PictureBox Picture1
      Height          =   255
      Left            =   5100
      Picture         =   "EX8A.frx":0000
      ScaleHeight     =   225
      ScaleWidth      =   285
      TabIndex        =   1
      Top             =   2940
      Width           =   315
   End
   Begin VB.CommandButton Command1
      Caption         =   "AngleArc"
      Height          =   375
      Left            =   3780
      TabIndex        =   0
      Top             =   180
      Width           =   1755
   End
Attribute VB_Name = "frmex8a"
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
Const pi = 3.141578
Private Const EDGE_BUMP = &H9&
Private Const EDGE_ETCHED = &H6&
Private Const EDGE_RAISED = &H5&
Private Const EDGE_SUNKEN = &HA&
Private Const BF_ADJUST = &H2000
Private Const BF_BOTTOM = &H8
Private Const BF_BOTTOMLEFT = &H9
Private Const BF_BOTTOMRIGHT = &HC
Private Const BF_DIAGONAL = &H10
Private Const BF_FLAT = &H4000
Private Const BF_LEFT = &H1
Private Const BF_MIDDLE = &H800
Private Const BF_MONO = &H8000
Private Const BF_RECT = &HF
Private Const BF_RIGHT = &H4
Private Const BF_SOFT = &H1000
Private Const BF_TOP = &H2
Private Const BF_TOPLEFT = &H3
Private Const BF_TOPRIGHT = &H6
Private Const DFC_BUTTON = 4
Private Const DFC_CAPTION = 1
Private Const DFC_MENU = 2
Private Const DFC_SCROLL = 3
Private Const DFCS_BUTTON3STATE = &H8
Private Const DFCS_BUTTONCHECK = &H0
Private Const DFCS_BUTTONRADIO = &H4
Private Const DFCS_BUTTONRADIOIMAGE = &H1
Private Const DFCS_BUTTONRADIOMASK = &H2
Private Const DFCS_CAPTIONCLOSE = &H0
Private Const DFCS_CAPTIONHELP = &H4
Private Const DFCS_CAPTIONMAX = &H2
Private Const DFCS_CAPTIONMIN = &H1
Private Const DFCS_CAPTIONRESTORE = &H3
Private Const DFCS_CHECKED = &H400
Private Const DFCS_FLAT = &H4000
Private Const DFCS_INACTIVE = &H100
Private Const DFCS_MENUARROW = &H0
Private Const DFCS_MENUARROWRIGHT = &H4
Private Const DFCS_MENUBULLET = &H2
Private Const DFCS_MENUCHECK = &H1
Private Const DFCS_MONO = &H8000
Private Const DFCS_PUSHED = &H200
Private Const DFCS_SCROLLCOMBOBOX = &H5
Private Const DFCS_SCROLLDOWN = &H1
Private Const DFCS_SCROLLLEFT = &H2
Private Const DFCS_SCROLLRIGHT = &H3
Private Const DFCS_SCROLLSIZEGRIP = &H8
Private Const DFCS_SCROLLSIZEGRIPRIGHT = &H10
Private Const DFCS_SCROLLUP = &H0
Private Sub Command1_Click()
    Dim di&
    Dim pt As POINTAPI
    di = MoveToEx(hDC, 0, 0, pt)
    di = AngleArc(hDC, 100, 100, 50, 90, 90)
End Sub
Private Sub Command2_Click()
    Dim rc As RECT
    Dim di&
    Dim newbrush&
    di = GetClientRect(hwnd, rc)
    newbrush = CreatePatternBrush(Picture1.Picture)
    di = FillRect(hDC, rc, newbrush)
    di = DeleteObject(newbrush)
End Sub
Private Sub Command3_Click()
    Dim di&
    Dim rc As RECT
    di = GetClientRect(hwnd, rc)
    di = InflateRect(rc, -5, -5)
    di = DrawEdge(hDC, rc, EDGE_RAISED, BF_TOPLEFT)
    di = DrawEdge(hDC, rc, EDGE_RAISED, BF_BOTTOMRIGHT)
End Sub
Private Sub Command4_Click()
    Dim di&
    Dim rc As RECT
    rc.Left = 20
    rc.Top = 20
    rc.Right = 40
    rc.Bottom = 40
    di = DrawFrameControl(hDC, rc, DFC_BUTTON, DFCS_BUTTONCHECK Or DFCS_CHECKED)
End Sub