clip.frm

是API教程5

VERSION 5.00
Begin VB.Form Form1 
   BorderStyle     =   0  'None
   Caption         =   "Form1"
   ClientHeight    =   4635
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   4860
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   4635
   ScaleWidth      =   4860
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton Command5 
      Caption         =   "退  出"
      Height          =   315
      Left            =   3420
      TabIndex        =   6
      Top             =   4260
      Width           =   1095
   End
   Begin VB.CommandButton Command4 
      Caption         =   "方<->圆"
      Height          =   315
      Left            =   3420
      TabIndex        =   5
      Top             =   60
      Width           =   1095
   End
   Begin VB.PictureBox Picture1 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      BorderStyle     =   0  'None
      ForeColor       =   &H80000008&
      Height          =   1395
      Left            =   1980
      Picture         =   "Clip.frx":0000
      ScaleHeight     =   1395
      ScaleWidth      =   1515
      TabIndex        =   4
      Top             =   120
      Width           =   1515
   End
   Begin VB.CommandButton Command3 
      Caption         =   "五角星"
      Height          =   315
      Left            =   3780
      TabIndex        =   3
      Top             =   3900
      Width           =   735
   End
   Begin VB.CommandButton Command2 
      Caption         =   "没名窗体"
      Height          =   315
      Left            =   120
      TabIndex        =   1
      Top             =   3240
      Width           =   1095
   End
   Begin VB.CommandButton Command1 
      Caption         =   "挖出矩形"
      Height          =   315
      Left            =   120
      TabIndex        =   0
      Top             =   2880
      Width           =   1095
   End
   Begin VB.Label Label1 
      BackStyle       =   0  'Transparent
      Caption         =   "窗体上可用鼠标绘图"
      Height          =   255
      Left            =   240
      TabIndex        =   2
      Top             =   0
      Width           =   2595
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit


Private Declare Function CreatePolygonRgn& Lib "gdi32" (lpPoint As POINTAPI, ByVal nCount As Long, ByVal nPolyFillMode As Long)
Private Declare Function SelectClipRgn& Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long)
Private Declare Function CreateRoundRectRgn& Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long)
Private Declare Function GetWindowRect& Lib "user32" (ByVal hwnd As Long, lpRect As RECT)
Private Declare Function CreateEllipticRgn& Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long)
Private Declare Function CreateRectRgn& Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long)

Private Declare Function GetClipBox& Lib "gdi32" (ByVal hdc As Long, lpRect As RECT)
Private Declare Function SetWindowRgn& Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, _
                         ByVal bRedraw As Long)   'bRedraw=True 时 立即重画窗口
Private Declare Function ExcludeClipRect& Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, _
                         ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long)
Private Declare Function CombineRgn& Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, _
                         ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long)
'nCombineMode 参数
Private Const RGN_AND& = 1           'hDestRgn 被设为 两个区域的交集(共有的部分)
Private Const RGN_COPY& = 5          'hDestRgn 被设为 hSrcRgn1 的拷贝
Private Const RGN_DIFF& = 4          'hDestRgn 被设为 hSrcRgn1中与hSrcRgn2不相交的部分
Private Const RGN_OR& = 2            'hDestRgn 被设为 两个区域的的并集(任一源区域有的部分)
Private Const RGN_XOR& = 3           'hDestRgn 被设为 两个区域OR以外的部分(任意源区域有的部分，但不包括两者共同的部分)

'nPolyFillMode 参数(多边形填充模式)
Private Const ALTERNATE& = 1         '交换填充
Private Const WINDING& = 2           '根据绘图方向填充


Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Type POINTAPI
    x As Long
    y As Long
End Type

Private MyX As Long, MyY As Long
'从剪裁区中挖去一个矩形，该矩形内不能绘图
Private Sub Command1_Click()
   Dim dl&
   Form1.Cls

   dl& = ExcludeClipRect(Form1.hdc, 50, 50, 150, 150)
   PaintCircle
End Sub
'绘图
Private Sub PaintCircle()
    Dim i As Integer
    
    For i = 0 To Form1.ScaleWidth
       If i < 255 Then Form1.ForeColor = RGB(255, i, 0)
       Form1.Circle (0, 0), i
    Next
End Sub

Private Sub Command2_Click()
    Dim dl&
    Dim hR1&, hR2&
    Dim Myrect As RECT
    
    dl& = GetWindowRect(Form1.hwnd, Myrect)
    hR1& = CreateRectRgn(0, 0, Myrect.Right - Myrect.Left, Myrect.Bottom - Myrect.Top)
    hR2& = CreateEllipticRgn(-(Myrect.Right - Myrect.Left), -(Myrect.Bottom - Myrect.Top), _
                             Myrect.Right - Myrect.Left, Myrect.Bottom - Myrect.Top)
    dl& = CombineRgn(hR1&, hR1&, hR2&, RGN_AND)
    hR2& = CreateEllipticRgn(200, 200, 500, 500)
    dl& = CombineRgn(hR1&, hR1&, hR2&, RGN_XOR)
    hR2& = CreateEllipticRgn(150, 150, 200, 200)
    dl& = CombineRgn(hR1&, hR1&, hR2&, RGN_XOR)
    dl& = SetWindowRgn(Form1.hwnd, hR1&, -1)
End Sub

Private Sub Command3_Click()
    Dim dl&
    Dim hR1&, hR2&
    Dim flmDC As Long
    Dim Myrect As RECT
    Dim MyPoint(5) As POINTAPI
    Dim i As Integer, j As Integer
     
    dl& = GetWindowRect(Form1.hwnd, Myrect)
                
                 MyPoint(0).x = 33:     MyPoint(0).y = 19
                 MyPoint(1).x = 12:     MyPoint(1).y = 57
                 MyPoint(2).x = 57:     MyPoint(2).y = 31
                 MyPoint(3).x = 9:      MyPoint(3).y = 31
                 MyPoint(4).x = 44:     MyPoint(4).y = 57
                 MyPoint(5).x = 33:     MyPoint(5).y = 19
    Form1.Cls
    For i = 0 To 3
        hR2& = CreatePolygonRgn(MyPoint(0), 6, WINDING)    '其中 6 指 共6个点
        If hR1 = 0 Then
            hR1 = hR2
        Else
            dl& = CombineRgn(hR1&, hR1&, hR2&, RGN_OR)
        End If
        If i = 3 Then Exit For
        For j = 0 To 5
            MyPoint(j).x = MyPoint(j).x + 40
            MyPoint(j).y = MyPoint(j).y + 40
        Next
    Next
    dl& = SelectClipRgn(Form1.hdc, hR1&)
    Form1.ForeColor = vbRed
    Form1.Line (0, 0)-(Form1.Width, Form1.Height), , BF
End Sub

Private Sub Command4_Click()
    Dim dl&
    Static N As Boolean
    Dim hR As Long

    N = Not N
    If N Then
       hR& = CreateEllipticRgn(0, 0, 90, 90)
    Else
       hR& = CreateRoundRectRgn(0, 0, 90, 90, 20, 20)
    End If
       dl& = SetWindowRgn(Picture1.hwnd, hR, -1)
End Sub

Private Sub Command5_Click()
    Unload Me
End Sub

Private Sub Form_Load()
    Form1.BackColor = vbGreen
    Form1.ScaleMode = vbPixels
    Form1.Width = Form1.Height
    Picture1.ScaleMode = vbPixels
    Picture1.Width = 90
    Picture1.Height = 90
    Form1.AutoRedraw = True
    Form1.Show
    PaintCircle
    Command4_Click
    Move (Screen.Width - Form1.Width) \ 2, (Screen.Height - Form1.Height) \ 2
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    Form1.ForeColor = vbBlue
    MyX = x
    MyY = y
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
   If Button = 1 Then
    Form1.Line (MyX, MyY)-(x, y)
    MyX = x
    MyY = y
  End If
End Sub