modmain.bas

办公流程定制

Attribute VB_Name = "modMain"
Option Explicit
Public gControlHwnd As Long


'=====================================================
'//////////////////////////////////////////////////////////////
'//                       INTRODUCTION                       //
'//////////////////////////////////////////////////////////////

'创建异型区域

'//////////////////////////////////////////////////////////////
'//                    CREER DES REGIONS                     //
'//////////////////////////////////////////////////////////////
Public Declare Function SetParent Lib "user32" ( _
ByVal hWndChild As Long, _
ByVal hWndNewParent As Long) As Long

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


Declare Function CreateRectRgn Lib "gdi32" ( _
ByVal X1 As Long, _
ByVal Y1 As Long, _
ByVal X2 As Long, _
ByVal Y2 As Long) _
As Long

Declare Function CreateEllipticRgn Lib "gdi32" ( _
ByVal X1 As Long, _
ByVal Y1 As Long, _
ByVal X2 As Long, _
ByVal Y2 As Long) _
As Long

Declare Function CreatePolygonRgn Lib "gdi32" ( _
lpPoint As POINTAPI, _
ByVal nCount As Long, _
ByVal nPolyFillMode As Long _
) As Long

Public Const ALTERNATE = 1
Public Const WINDING = 2

'//////////////////////////////////////////////////////////////
'//                  COMBINER DES REGIONS                    //
'//////////////////////////////////////////////////////////////

Declare Function CombineRgn Lib "gdi32" ( _
ByVal hDestRgn As Long, _
ByVal hSrcRgn1 As Long, _
ByVal hSrcRgn2 As Long, _
ByVal nCombineMode As CombineMode _
) As Long

'/--------------------------------------------------------\
'|ATTENTION : POUR QUE CELA FONCTIONNE, IL FAUT ABSOLUMENT|
'|QUE LA REGION SOIT DEJA INITIALISEE A L'AIDE D'UNE DES  |
'|FONCTIONS VUE CI-DESSUS.                                |
'\--------------------------------------------------------/


Public Enum CombineMode
    RGN_and = 1
                 
    RGN_COPY = 5
    RGN_DIFF = 4
                 
    RGN_or = 2
    RGN_XOR = 3
              
End Enum


'//////////////////////////////////////////////////////////////
'//                  APPLIQUER DES REGIONS                   //
'//////////////////////////////////////////////////////////////

Declare Function SetWindowRgn Lib "user32" ( _
ByVal hwnd As Long, _
ByVal hRgn As Long, _
ByVal bRedraw As Boolean _
) As Long


'//////////////////////////////////////////////////////////////
'//                  SUPPRIMER DES REGIONS                   //
'//////////////////////////////////////////////////////////////

Declare Function DeleteObject Lib "gdi32" ( _
ByVal hObject As Long _
) As Long

'==========================================================================



Dim leSmiley As Long

Sub Smiley(obj As Object)

'////////////////
'/Initialisation/
'////////////////

Dim X As Long, Y As Long
X = obj.Width / Screen.TwipsPerPixelX
Y = obj.Height / Screen.TwipsPerPixelY

'Formes de bases
Dim Grond As Long
Dim Gsmile As Long
Dim Psmile As Long
Dim Rect As Long
Dim eyeG As Long
Dim eyeD As Long

'Formes complexes
Dim Bouee As Long
Dim leSmile As Long
Dim Yeux As Long
Dim Tete As Long
Dim LesPoints(0 To 4) As POINTAPI

'////////////////////////////////
'/Creation des formes de bases :/
'////////////////////////////////
Grond = CreateEllipticRgn(0, 0, X, Y)
Gsmile = CreateEllipticRgn(Int(X / 10), Int(Y / 10), Int(X * 9 / 10), Int(Y * 9 / 10))
Psmile = CreateEllipticRgn(Int(X * 2 / 10), Int(Y * 4 / 10), Int(X * 8 / 10), Int(Y * 8 / 10))
LesPoints(0).X = 0
LesPoints(0).Y = 0
LesPoints(1).X = X
LesPoints(1).Y = 0
LesPoints(2).X = X
LesPoints(2).Y = Int(Y * 8 / 10)
LesPoints(3).X = Int(X / 2)
LesPoints(3).Y = Int(Y / 2)
LesPoints(4).X = 0
LesPoints(4).Y = Int(Y * 8 / 10)
Rect = CreatePolygonRgn(LesPoints(0), 5, 1)
eyeG = CreateEllipticRgn(Int(X * 2 / 10), Int(Y * 3 / 10), Int(X * 4 / 10), Int(Y * 5 / 10))
eyeD = CreateEllipticRgn(Int(X * 6 / 10), Int(Y * 3 / 10), Int(X * 8 / 10), Int(Y * 5 / 10))


'///////////////////////////////
'/Creation des formes complexes/
'///////////////////////////////

'Initialisation des r間ions
'Bouee = CreateEllipticRgn(0, 0, X, Y)
'leSmile = CreateEllipticRgn(0, 0, X, Y)
'Yeux = CreateEllipticRgn(0, 0, X, Y)
'Tete = CreateEllipticRgn(0, 0, X, Y)
'leSmiley = CreateEllipticRgn(0, 0, X, Y)
leSmiley = CreateRectRgn(0, 200, 400, 250)

Dim test As Long

leSmile = CreateRectRgn(400, 250, 450, 0)

'test = CreateRectRgn(0, 0, 400, 250)

'Compilation des r間ions
'CombineRgn Bouee, Gsmile, Psmile, RGN_DIFF
'CombineRgn leSmile, Bouee, Rect, RGN_DIFF
'CombineRgn Yeux, eyeG, eyeD, RGN_OR
'CombineRgn Tete, Grond, Yeux, RGN_DIFF
'CombineRgn leSmiley, Tete, leSmile, RGN_DIFF
CombineRgn leSmiley, leSmile, leSmiley, RGN_or

'////////////
'/Conclusion/
'////////////

'Suppression des r間ions inutiles
DeleteObject Grond
DeleteObject Gsmile
DeleteObject Psmile
DeleteObject Rect
DeleteObject eyeG
DeleteObject eyeD
DeleteObject Bouee
DeleteObject leSmile
DeleteObject Yeux
DeleteObject Tete

'Application de la r間ion
SetWindowRgn obj.hwnd, leSmiley, True

End Sub