среда, 30 сентября 2009 г.

API

'Private Declare Sub GetDWord Lib "MSVBVM50.dll" Alias "GetMem4" (ByVal inSrc As IntPtr, ByRef inDst As Long)
 
'VERSION 1.0 CLASS

BEGIN

MultiUse = -1 'True

Persistable = 0 'NotPersistable

DataBindingBehavior = 0 'vbNone

DataSourceBehavior = 0 'vbNone

MTSTransactionMode = 0 'NotAnMTSObject

END

Attribute VB_Name = "GDI"

Attribute VB_GlobalNameSpace = False

Attribute VB_Creatable = True

Attribute VB_PredeclaredId = False

Attribute VB_Exposed = True

Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"

Attribute VB_Ext_KEY = "Top_Level" ,"Yes"

' ***********************************************

' Déclarations pour le dessin de lignes et formes

' ***********************************************



Public Type POINTAPI

X As Long

Y As Long

End Type



Private Point As POINTAPI

Public Enum ARCDIRECT

AD_CLOCKWISE = 2

AD_COUNTERCLOCKWISE = 1

End Enum



Public Enum POLYFILLMOD

ALTERNATE = 1

WINDING = 2

End Enum



Private Declare Function Arc Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long, ByVal X4 As Long, ByVal Y4 As Long) As Long

Private Declare Function Chord Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long, ByVal X4 As Long, ByVal Y4 As Long) 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 GetActiveWindow Lib "user32" () As Long

Private Declare Function GetCurrentPositionEx Lib "gdi32" (ByVal hdc As Long, lpPoint As POINTAPI) As Long

Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long

Private Declare Function GetPolyFillMode Lib "gdi32" (ByVal hdc As Long) As Long

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 LineTo Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long

Private Declare Function Pie Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long, ByVal X4 As Long, ByVal Y4 As Long) As Long

Private Declare Function PolyBezier Lib "gdi32.dll" (ByVal hdc As Long, lpPoint As POINTAPI, ByVal nCount As Long) As Long

Private Declare Function PolyBezierTo Lib "gdi32.dll" (ByVal hdc As Long, lpPoint As POINTAPI, ByVal nCount As Long) As Long

Private Declare Function Polygon Lib "gdi32" (ByVal hdc As Long, lpPoint As Any, ByVal nCount As Long) As Long

Private Declare Function Polyline Lib "gdi32" (ByVal hdc As Long, lpPoint As POINTAPI, ByVal nCount As Long) As Long

Private Declare Function PolylineTo Lib "gdi32" (ByVal hdc As Long, lpoint As POINTAPI, ByVal nCount As Long) As Long

Private Declare Function PolyPolygon Lib "gdi32.dll" (ByVal hdc As Long, lpPoint As POINTAPI, lpPolyCounts As Long, ByVal nCount As Long) As Long

Private Declare Function PolyPolyline Lib "gdi32.dll" (ByVal hdc As Long, lpoint As POINTAPI, lpdwPolyPoints As Long, ByVal nCount As Long) As Long

Private Declare Function Rectangle 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 RoundRect Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long

Private Declare Function SetArcDirection Lib "gdi32" (ByVal hdc As Long, ByVal ArcDirection 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 SetPolyFillMode Lib "gdi32" (ByVal hdc As Long, ByVal nPolyFillMode As Long) As Long



' ******************************

' Déclarations pour les stylos

' ******************************



Public Enum VBGPEN

PS_SOLID = 0

PS_DASH = 1

PS_DOT = 2

PS_DASHDOT = 3

PS_DASHDOTDOT = 4

PS_NULL = 5

PS_INSIDEFRAME = 6

End Enum



Public Type LOGPEN

lopnStyle As VBGPEN

lopnWidth As POINTAPI

lopnColor As Long

End Type



Public Enum PENSTYLE

PSE_SOLID = &H0

PSE_DASH = &H1

PSE_DOT = &H2

PSE_DASHDOT = &H3

PSE_DASHDOTDOT = &H4

PSE_NULL = &H5

PSE_INSIDEFRAME = &H6

PSE_USERSTYLE = &H7

PSE_ALTERNATE = &H8

PSE_STYLE_MASK = &HF

PSE_ENDCAP_ROUND = &H0

PSE_ENDCAP_SQUARE = &H100

PSE_ENDCAP_FLAT = &H200

PSE_ENDCAP_MASK = &HF00

PSE_JOIN_ROUND = &H0

PSE_JOIN_BEVEL = &H1000

PSE_JOIN_MITER = &H2000

PSE_JOIN_MASK = &HF000

PSE_COSMETIC = &H0

PSE_GEOMETRIC = &H10000

PSE_TYPE_MASK = &HF0000

End Enum



Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long

Private Declare Function CreatePenIndirect Lib "gdi32" (lpLogPen As LOGPEN) As Long

Private Declare Function ExtCreatePen Lib "gdi32" (ByVal dwPenStyle As Long, ByVal dwWidth As Long, lplb As LOGBRUSH, ByVal dwStyleCount As Long, lpStyle As Long) As Long



' ******************************

' Déclarations pour les brosses

' ******************************



Public Enum BRUSHSTYLE

HS_HORIZONTAL = 0

HS_VERTICAL = 1

HS_BDIAGONAL = 2

HS_FDIAGONAL = 3

HS_CROSS = 4

HS_DIAGCROSS = 5

End Enum



Public Enum LBSTYLES

BS_SOLID = 0

BS_NULL = 1

BS_HOLLOW = 1

BS_HATCHED = 2

BS_PATTERN = 3

BS_INDEXED = 4

BS_DIBPATTERN = 5

BS_DIBPATTERNPT = 6

BS_PATTERN8X8 = 7

BS_DIBPATTERN8X8 = 8

BS_MONOPATTERN = 9

End Enum



Private Type LOGBRUSH

lbStyle As LBSTYLES

lbColor As Long

lbHatch As BRUSHSTYLE

End Type





Private Declare Function CreateBrushIndirect Lib "gdi32" (lpLogBrush As LOGBRUSH) As Long

Private Declare Function CreateHatchBrush Lib "gdi32" (ByVal nIndex As Long, ByVal crColor As Long) As Long

Private Declare Function CreatePatternBrush Lib "gdi32" (ByVal hBitmap As Long) As Long

Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long



' *********************

' Déclaration communes

' *********************



Public Enum BKMODE

TRANSPARENT = 1

OPAQUE = 2

End Enum



Public Enum ROP2

R2_BLACK = 1

R2_NOTMERGEPEN = 2

R2_MASKNOTPEN = 3

R2_NOTCOPYPEN = 4

R2_MASKPENNOT = 5

R2_NOT = 6

R2_XORPEN = 7

R2_NOTMASKPEN = 8

R2_MASKPEN = 9

R2_NOTXORPEN = 10

R2_NOP = 11

R2_MERGENOTPEN = 12

R2_COPYPEN = 13

R2_LAST = 16

R2_MERGEPENNOT = 14

R2_MERGEPEN = 15

R2_WHITE = 16

End Enum



Public Enum DEVICECAPS

DRIVERVERSION = 0

TECHNOLOGY = 2

HORZSIZE = 4

VERTSIZE = 6

HORZRES = 8

VERTRES = 10

BITSPIXEL = 12

PLANES = 14

NUMBRUSHES = 16

NUMPENS = 18

NUMMARKERS = 20

NUMFONTS = 22

NUMCOLORS = 24

PDEVICESIZE = 26

CURVECAPS = 28

LINECAPS = 30

POLYGONALCAPS = 32

TEXTCAPS = 34

CLIPCAPS = 36

RASTERCAPS = 38

ASPECTX = 40

ASPECTY = 42

ASPECTXY = 44

LOGPIXELSX = 88

LOGPIXELSY = 90

SIZEPALETTE = 104

NUMRESERVED = 106

COLORRES = 108

End Enum



Public Enum RASTEROP

SRCCOPY = &HCC0020

SRCPAINT = &HEE0086

SRCAND = &H8800C6

SRCINVERT = &H660046

SRCERASE = &H440328

NOTSRCCOPY = &H330008

NOTSRCERASE = &H1100A6

MERGECOPY = &HC000CA

MERGEPAINT = &HBB0226

PATCOPY = &HF00021

PATPAINT = &HFB0A09

PATINVERT = &H5A0049

DSTINVERT = &H550009

BLACKNESS = &H42

WHITENESS = &HFF0062

End Enum



Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal DWROP As Long) As Long

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

Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long

Private Declare Function GetCurrentObject Lib "gdi32" (ByVal hdc As Long, ByVal nObject As Long) As Long

Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long

Private Declare Function GetDesktopWindow Lib "user32" () As Long

Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long

Private Declare Function GetROP2 Lib "gdi32" (ByVal hdc As Long) As Long

Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long

Private Declare Function MulDiv Lib "kernel32" (ByVal nNumber As Long, ByVal nNumerator As Long, ByVal nDenominator As Long) As Long

Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long

Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long

Private Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long

Private Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long, ByVal nBkMode As Long) As Long

Private Declare Function SetMapMode Lib "gdi32" (ByVal hdc As Long, ByVal nMapMode As Long) As Long

Private Declare Function SetROP2 Lib "gdi32" (ByVal hdc As Long, ByVal nDrawMode As Long) As Long



' *********************************

' Déclarations pour les rectangles

' *********************************



Public Type RECT

Left As Long

Top As Long

Right As Long

Bottom As Long

End Type



Private Declare Function CopyRect Lib "user32" (lpDestRect As RECT, lpSourceRect As RECT) As Long

Private Declare Function EqualRect Lib "user32" (lpSrc1Rect As RECT, lpSrc2Rect As RECT) As Boolean

Private Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long

Private Declare Function FrameRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long

Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long

Private Declare Function InflateRect Lib "user32" (lpRect As RECT, ByVal X As Long, ByVal Y As Long) As Long

Private Declare Function IntersectRect Lib "user32" (lpDestRect As RECT, lpSrc1Rect As RECT, lpSrc2Rect As RECT) As Long

Private Declare Function InvertRect Lib "user32" (ByVal hdc As Long, lpRect As RECT) As Long

Private Declare Function IsRectEmpty Lib "user32" (lpRect As RECT) As Long

Private Declare Function OffsetRect Lib "user32" (lpRect As RECT, ByVal X As Long, ByVal Y As Long) As Long

Private Declare Function PtInRect Lib "user32" (lpRect As RECT, ByVal X As Long, ByVal Y As Long) As Long

Private Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long

Private Declare Function SetRectEmpty Lib "user32" (lpRect As RECT) As Long

Private Declare Function SubtractRect Lib "user32.dll" (lprcDst As RECT, lprcSrc1 As RECT, lprcSrc2 As RECT) As Long

Private Declare Function UnionRect Lib "user32.dll" (lpDestRect As RECT, lpSrc1Rect As RECT, lpSrc2Rect As RECT) As Long



' *********************************

' Déclarations pour les régions

' *********************************



Public Enum COMBINEMODE

RGN_AND = 1

RGN_OR = 2

RGN_XOR = 3

RGN_DIFF = 4

RGN_COPY = 5

End Enum



Public Enum REGIONFLAGS

ERREUR = 0

NULLREGION = 1

SIMPLEREGION = 2

COMPLEXREGION = 3

End Enum



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

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

Private Declare Function CreateEllipticRgnIndirect Lib "gdi32" (lpRect As RECT) As Long

Private Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As Any, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long

Private Declare Function CreatePolyPolygonRgn Lib "gdi32" (lpPoint As Any, lpPolyCounts As Long, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long

Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) 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) As Long

Private Declare Function CreateRectRgnIndirect Lib "gdi32" (lpRect As RECT) As Long

Private Declare Function EqualRgn Lib "gdi32" (ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long) As Long

Private Declare Function FillRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long, ByVal hBrush As Long) As Long

Private Declare Function FrameRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long, ByVal hBrush As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long

Private Declare Function GetRgnBox Lib "gdi32" (ByVal hRgn As Long, lpRect As RECT) As Long

Private Declare Function InvertRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long) As Long

Private Declare Function OffsetRgn Lib "gdi32" (ByVal hRgn As Long, ByVal X As Long, ByVal Y As Long) As Long

Private Declare Function PaintRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long) As Long

Private Declare Function PtInRegion Lib "gdi32" (ByVal hRgn As Long, ByVal X As Long, ByVal Y As Long) As Long

Private Declare Function RectInRegion Lib "gdi32" (ByVal hRgn As Long, lpRect As RECT) As Long





' *********************************

' Déclarations pour le clipping

' *********************************



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) As Long

Private Declare Function ExtSelectClipRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long, ByVal fnMode As Long) As Long

Private Declare Function GetClipBox Lib "gdi32" (ByVal hdc As Long, lpRect As RECT) As Long

Private Declare Function GetClipRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long) As Long

Private Declare Function IntersectClipRect 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 OffsetClipRgn Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long

Private Declare Function PtVisible Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long

Private Declare Function RectVisible Lib "gdi32" (ByVal hdc As Long, lpRect As RECT) As Long

Private Declare Function SelectClipPath Lib "gdi32" (ByVal hdc As Long, ByVal iMode As Long) As Long

Private Declare Function SelectClipRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long) As Long





' *********************************

' Déclarations pour les PATH

' *********************************



Private Declare Function BeginPath Lib "gdi32" (ByVal hdc As Long) As Long

Private Declare Function CloseFigure Lib "gdi32" (ByVal hdc As Long) As Long

Private Declare Function EndPath Lib "gdi32" (ByVal hdc As Long) As Long

Private Declare Function FillPath Lib "gdi32" (ByVal hdc As Long) As Long

Private Declare Function PathToRegion Lib "gdi32" (ByVal hdc As Long) As Long

Private Declare Function StrokeAndFillPath Lib "gdi32" (ByVal hdc As Long) As Long

Private Declare Function StrokePath Lib "gdi32" (ByVal hdc As Long) As Long





' *********************************

' Déclarations pour le texte

' *********************************



Enum WFORMAT

DT_TOP = &H0

DT_LEFT = &H0

DT_CENTER = &H1

DT_RIGHT = &H2

DT_VCENTER = &H4

DT_BOTTOM = &H8

DT_WORDBREAK = &H10

DT_SINGLELINE = &H20

DT_EXPANDTABS = &H40

DT_TABSTOP = &H80

DT_NOCLIP = &H100

DT_EXTERNALLEADING = &H200

DT_CALCRECT = &H400

DT_NOPREFIX = &H800

DT_INTERNAL = &H1000

DT_EDITCONTROL = &H2000

DT_PATH_ELLIPSIS = &H4000

DT_END_ELLIPSIS = &H8000

DT_MODIFYSTRING = &H10000

DT_RTLREADING = &H20000

DT_WORD_ELLIPSIS = &H40000

End Enum



Enum FUOPTIONS

ETO_OPAQUE = &H2

ETO_CLIPPED = &H4

ETO_GLYPH_INDEX = &H10

ETO_RTLREADING = &H80

ETO_NUMERICSLOCAL = &H400

ETO_NUMERICSLATIN = &H800

ETO_IGNORELANGUAGE = &H1000

End Enum



Enum FMODE

TA_BASELINE = 24

TA_BOTTOM = 8

TA_CENTER = 6

TA_LEFT = 0

TA_NOUPDATECP = 0

TA_RIGHT = 2

TA_TOP = 0

TA_UPDATECP = 1

TA_MASK = (TA_BASELINE + TA_CENTER + TA_UPDATECP)

End Enum



Public Type TEXTMETRIC

tmHeight As Long

tmAscent As Long

tmDescent As Long

tmInternalLeading As Long

tmExternalLeading As Long

tmAveCharWidth As Long

tmMaxCharWidth As Long

tmWeight As Long

tmOverhang As Long

tmDigitizedAspectX As Long

tmDigitizedAspectY As Long

tmFirstChar As Byte

tmLastChar As Byte

tmDefaultChar As Byte

tmBreakChar As Byte

tmItalic As Byte

tmUnderlined As Byte

tmStruckOut As Byte

tmPitchAndFamily As Byte

tmCharSet As Byte

End Type



Enum FWWEIGHT

FW_DONTCARE = 0

FW_THIN = 100

FW_EXTRALIGHT = 200

FW_LIGHT = 300

FW_NORMAL = 400

FW_MEDIUM = 500

FW_SEMIBOLD = 600

FW_BOLD = 700

FW_EXTRABOLD = 800

FW_HEAVY = 900

FW_BLACK = FW_HEAVY

FW_DEMIBOLD = FW_SEMIBOLD

FW_REGULAR = FW_NORMAL

FW_ULTRABOLD = FW_EXTRABOLD

FW_ULTRALIGHT = FW_EXTRALIGHT

End Enum



Enum FWCHARSET

ANSI_CHARSET = 0

DEFAULT_CHARSET = 1

SYMBOL_CHARSET = 2

SHIFTJIS_CHARSET = 128

HANGEUL_CHARSET = 129

CHINESEBIG5_CHARSET = 136

OEM_CHARSET = 255

End Enum



Enum FWOUTPUTPRECISION

OUT_CHARACTER_PRECIS = 2

OUT_DEFAULT_PRECIS = 0

OUT_DEVICE_PRECIS = 5

End Enum



Enum FWCLIPPRECISION

CLIP_DEFAULT_PRECIS = 0

CLIP_CHARACTER_PRECIS = 1

CLIP_STROKE_PRECIS = 2

End Enum



Enum FWQUALITY

DEFAULT_QUALITY = 0

DRAFT_QUALITY = 1

PROOF_QUALITY = 2

End Enum



Enum FWPITCHANDFAMILY

DEFAULT_PITCH = 0

FIXED_PITCH = 1

VARIABLE_PITCH = 2

End Enum



Public Type LOGFONT

lfHeight As Long

lfWidth As Long

lfEscapement As Long

lfOrientation As Long

lfWeight As Long

lfItalic As Byte

lfUnderline As Byte

lfStrikeOut As Byte

lfCharSet As Byte

lfOutPrecision As Byte

lfClipPrecision As Byte

lfQuality As Byte

lfPitchAndFamily As Byte

lfFaceName(32) As Byte

End Type



Public Type POLYTEXT

X As Long

Y As Long

n As Long

lpStr As String

uiFlags As Long

rcl As RECT

pdx As Long

End Type



Public ColFonts As Collection



Private Declare Function CreateFont Lib "gdi32" Alias "CreateFontA" (ByVal nHeight As Long, ByVal nWidth As Long, ByVal nEscapement As Long, ByVal nOrientation As Long, ByVal fnWeight As Long, ByVal fdwItalic As Boolean, ByVal fdwUnderline As Boolean, ByVal fdwStrikeOut As Boolean, ByVal fdwCharSet As Long, ByVal fdwOutputPrecision As Long, ByVal fdwClipPrecision As Long, ByVal fdwQuality As Long, ByVal fdwPitchAndFamily As Long, ByVal lpszFace As String) As Long

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 Declare Function DrawTextEx Lib "user32" Alias "DrawTextExA" (ByVal hdc As Long, ByVal lpsz As String, ByVal n As Long, lpRect As RECT, ByVal un As Long, ByVal lpDrawTextParams As Any) As Long

Private Declare Function EnumFontFamiliesEx Lib "gdi32" Alias "EnumFontFamiliesExA" (ByVal hdc As Long, lpLogFont As LOGFONT, ByVal lpEnumFontProc As Long, ByVal LParam As Long, ByVal dw As Long) As Long

Private Declare Function ExtTextOut Lib "gdi32" Alias "ExtTextOutA" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal wOptions As Long, lpRect As RECT, ByVal lpString As String, ByVal nCount As Long, lpDx As Long) As Long

Private Declare Function GetTextMetrics Lib "gdi32" Alias "GetTextMetricsA" (ByVal hdc As Long, lpMetrics As TEXTMETRIC) As Long

Private Declare Function GrayString Lib "user32" Alias "GrayStringA" (ByVal hdc As Long, ByVal hBrush As Long, ByVal lpOutputFunc As Long, ByVal lpData As String, ByVal nCount As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long

Private Declare Function PolyTextOut Lib "gdi32" Alias "PolyTextOutA" (ByVal hdc As Long, pptxt As POLYTEXT, ByVal cStrings As Long) As Long

Private Declare Function SetTextAlign Lib "gdi32" (ByVal hdc As Long, ByVal wFlags As Long) As Long

Private Declare Function TabbedTextOut Lib "user32" Alias "TabbedTextOutA" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal lpString As String, ByVal nCount As Long, ByVal nTabPositions As Long, lpnTabStopPositions As Long, ByVal nTabOrigin 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



Sub gBitBlt(hDestDC As Long, X As Long, Y As Long, nWidth As Long, nHeight As Long, hSrcDC As Long, xSrc As Long, ySrc As Long, DWROP As RASTEROP)



BitBlt hDestDC, X, Y, nWidth, nHeight, hSrcDC, xSrc, ySrc, DWROP



End Sub



Sub gSelectClipPath(hdc As Long, iMode As COMBINEMODE)



SelectClipPath hdc, iMode



End Sub



Function gExtCreatePen(hdc As Long, dwPenStyle As PENSTYLE, dwWidth As Long, lbColor As Long, lbHatch As BRUSHSTYLE, lbStyle As LBSTYLES) As Long



Dim LB As LOGBRUSH, hPen As Long

LB.lbColor = lbColor

LB.lbHatch = lbHatch

LB.lbStyle = lbStyle

hPen = ExtCreatePen(dwPenStyle, dwWidth, LB, 0, ByVal 0&)

SelectObject hdc, hPen

gExtCreatePen = hPen



End Function



Sub gPolyTextOut(hdc As Long, pptxt As POLYTEXT, ByVal cStrings As Long)



PolyTextOut hdc, pptxt, cStrings



End Sub



Sub gGrayString(hdc As Long, lpData As String, nCount As Long, X As Long, Y As Long)



GrayString hdc, ByVal 0&, ByVal 0&, lpData, nCount, X, Y, 0, 0



End Sub



'Sub gGetFonts(hdc As Long)



'Dim LF As LOGFONT

'Set hColFonts = New Collection

'EnumFontFamiliesEx hdc, LF, AddressOf EnumFontFamProc, ByVal 0&, 0

'Set ColFonts = hColFonts



'End Sub



Function gCreateFont(nHeight As Long, nWidth As Long, nOrientation As Long, fnWeight As FWWEIGHT, fdwItalic As Boolean, fdwUnderline As Boolean, fdwStrikeOut As Boolean, fdwCharSet As FWCHARSET, fdwOutputPrecision As FWOUTPUTPRECISION, fdwClipPrecision As FWCLIPPRECISION, fdwQuality As FWQUALITY, fdwPitchAndFamily As FWPITCHANDFAMILY, lpszFace As String) As Long



gCreateFont = CreateFont(-MulDiv(nHeight, GetDeviceCaps(GetDC(0), 90), 72), nWidth, nOrientation * 10, nOrientation * 10, fnWeight, fdwItalic, fdwUnderline, fdwStrikeOut, fdwCharSet, fdwOutputPrecision, fdwClipPrecision, fdwQuality, fdwPitchAndFamily, lpszFace)



End Function



Function gGetTextMetrics() As TEXTMETRIC



Dim hdc As Long, hwnd As Long, PrevMapMode As Long, tm As TEXTMETRIC



hwnd = GetDesktopWindow()

hdc = GetWindowDC(hwnd)

If hdc Then

PrevMapMode = SetMapMode(hdc, 1)

GetTextMetrics hdc, tm

PrevMapMode = SetMapMode(hdc, PrevMapMode)

ReleaseDC hwnd, hdc

gGetTextMetrics = tm

End If



End Function



Sub gSetTextAlign(hdc As Long, wFlags As FMODE)



SetTextAlign hdc, wFlags



End Sub



Sub gExtTextOut(hdc As Long, X As Long, Y As Long, wOptions As FUOPTIONS, lpRect As RECT, lpString As String, nCount As Long, lpDx As Long)



ExtTextOut hdc, X, Y, wOptions, lpRect, lpString, nCount, lpDx



End Sub



Sub gDrawTextEx(hdc As Long, lpsz As String, n As Long, lpRect As RECT, un As WFORMAT)



DrawTextEx hdc, lpsz, n, lpRect, un, ByVal 0&



End Sub



Sub gDrawText(hdc As Long, lpStr As String, nCount As Long, lpRect As RECT, uFormat As WFORMAT)



DrawText hdc, lpStr, nCount, lpRect, uFormat



End Sub



Sub gTabbedTextOut(hdc As Long, X As Long, Y As Long, lpString As String, nCount As Long, nTabPositions As Long, lpnTabStopPositions As Long, nTabOrigin As Long)



TabbedTextOut hdc, X, Y, lpString, nCount, nTabPositions, lpnTabStopPositions, nTabOrigin



End Sub



Sub gTextOut(hdc As Long, X As Long, Y As Long, lpString As String, nCount As Long)



TextOut hdc, X, Y, lpString, nCount



End Sub



Sub gCloseFigure(hdc As Long)



CloseFigure hdc



End Sub



Function gPathToRegion(hdc As Long) As Long



gPathToRegion = PathToRegion(hdc)



End Function



Sub gBeginPath(hdc As Long)



BeginPath hdc



End Sub



Sub gEndPath(hdc As Long)



EndPath hdc



End Sub



Sub gStrokePath(hdc As Long)



StrokePath hdc



End Sub



Sub gFillPath(hdc As Long)



FillPath hdc



End Sub



Sub gStrokeAndFillPath(hdc As Long)



StrokeAndFillPath hdc



End Sub



Function gRectVisible(hdc As Long, lpRect As RECT) As Long



gRectVisible = RectVisible(hdc, lpRect)



End Function



Function gPtVisible(hdc As Long, X As Long, Y As Long) As Long



gPtVisible = PtVisible(hdc, X, Y)



End Function



Sub gGetClipBox(hdc As Long, lpRect As RECT)



GetClipBox hdc, lpRect



End Sub



Sub gExtSelectClipRgn(hdc As Long, hRgn As Long, fnMode As COMBINEMODE)



ExtSelectClipRgn hdc, hRgn, fnMode



End Sub



Sub gExcludeClipRect(hdc As Long, X1 As Long, Y1 As Long, X2 As Long, Y2 As Long)



ExcludeClipRect hdc, X1, Y1, X2, Y2



End Sub



Sub gGetClipRgn(hdc As Long, hRgn As Long)



GetClipRgn hdc, hRgn



End Sub



Sub gIntersectClipRect(hdc As Long, X1 As Long, Y1 As Long, X2 As Long, Y2 As Long)



IntersectClipRect hdc, X1, Y1, X2, Y2



End Sub



Sub gOffsetClipRgn(hdc As Long, X As Long, Y As Long)



OffsetClipRgn hdc, X, Y



End Sub



Sub gSelectClipRgn(hdc As Long, hRgn As Long)



SelectClipRgn hdc, hRgn



End Sub



Function gRectInRegion(hRgn As Long, lpRect As RECT) As Long



gRectInRegion = RectInRegion(hRgn, lpRect)



End Function





Function gGetRgnBox(hRgn As Long, lpRect As RECT) As Long



gGetRgnBox = GetRgnBox(hRgn, lpRect)



End Function



Function gEqualRgn(hSrcRgn1 As Long, hSrcRgn2 As Long) As Long



gEqualRgn = EqualRgn(hSrcRgn1, hSrcRgn2)



End Function



Sub gOffsetRgn(hRgn As Long, X As Long, Y As Long)



OffsetRgn hRgn, X, Y



End Sub



Sub gPaintRgn(hdc As Long, hRgn As Long)



PaintRgn hdc, hRgn



End Sub



Function gPtInRegion(hRgn As Long, X As Long, Y As Long) As Long



gPtInRegion = PtInRegion(hRgn, X, Y)



End Function



Function gCreatePolyPolygonRgn(lpPoint As POINTAPI, lpPolyCounts As Long, nCount As Long, nPolyFillMode As POLYFILLMOD) As Long



gCreatePolyPolygonRgn = CreatePolyPolygonRgn(lpPoint, lpPolyCounts, nCount, nPolyFillMode)



End Function



Function gCreatePolygonRgn(lpPoint As POINTAPI, nCount As Long, nPolyFillMode As POLYFILLMOD) As Long



gCreatePolygonRgn = CreatePolygonRgn(lpPoint, nCount, nPolyFillMode)



End Function



Function gCreateEllipticRgnIndirect(lpRect As RECT) As Long



gCreateEllipticRgnIndirect = CreateEllipticRgnIndirect(lpRect)



End Function



Function gCreateRectRgnIndirect(lpRect As RECT) As Long



gCreateRectRgnIndirect = CreateRectRgnIndirect(lpRect)



End Function



Function gCombineRgn(hDestRgn As Long, hSrcRgn1 As Long, hSrcRgn2 As Long, nCombineMode As COMBINEMODE) As REGIONFLAGS



gCombineRgn = CombineRgn(hDestRgn, hSrcRgn1, hSrcRgn2, nCombineMode)



End Function



Function gCreateRoundRectRgn(X1 As Long, Y1 As Long, X2 As Long, Y2 As Long, X3 As Long, Y3 As Long) As Long



gCreateRoundRectRgn = CreateRoundRectRgn(X1, Y1, X2, Y2, X3, Y3)



End Function



Sub gInvertRgn(hdc As Long, hRgn As Long)



InvertRgn hdc, hRgn



End Sub



Sub gFrameRgn(hdc As Long, hRgn As Long, hBrush As Long, nWidth As Long, nHeight As Long)



FrameRgn hdc, hRgn, hBrush, nWidth, nHeight



End Sub



Sub gFillRgn(hdc As Long, hRgn As Long, hBrush As Long)



FillRgn hdc, hRgn, hBrush



End Sub



Function gCreateEllipticRgn(X1 As Long, Y1 As Long, X2 As Long, Y2 As Long) As Long



gCreateEllipticRgn = CreateEllipticRgn(X1, Y1, X2, Y2)



End Function



Function gCreateRectRgn(X1 As Long, Y1 As Long, X2 As Long, Y2 As Long) As Long



gCreateRectRgn = CreateRectRgn(X1, Y1, X2, Y2)



End Function



Sub gGetWindowRect(ByVal hwnd As Long, lpRect As RECT)



GetWindowRect hwnd, lpRect



End Sub



Function gEqualRect(lpSrc1Rect As RECT, lpSrc2Rect As RECT) As Boolean



gEqualRect = EqualRect(lpSrc1Rect, lpSrc2Rect)



End Function



Sub gSubtractRect(lprcDst As RECT, lprcSrc1 As RECT, lprcSrc2 As RECT)



SubtractRect lprcDst, lprcSrc1, lprcSrc2



End Sub



Sub gSetPixel(hdc As Long, X As Long, Y As Long, crColor As Long)



SetPixel hdc, X, Y, crColor



End Sub



Function gGetPixel(hdc As Long, ByVal X As Long, ByVal Y As Long) As Long



gGetPixel = GetPixel(hdc, X, Y)



End Function



Function gPtInRect(lpRect As RECT, X As Long, Y As Long) As Long



gPtInRect = PtInRect(lpRect, X, Y)



End Function



Function gIsRectEmpty(lpRect As RECT) As Long



gIsRectEmpty = IsRectEmpty(lpRect)



End Function



Sub gUnionRect(lpDestRect As RECT, lpSrc1Rect As RECT, lpSrc2Rect As RECT)



UnionRect lpDestRect, lpSrc1Rect, lpSrc2Rect



End Sub



Sub gIntersectRect(lpDestRect As RECT, lpSrc1Rect As RECT, lpSrc2Rect As RECT)



IntersectRect lpDestRect, lpSrc1Rect, lpSrc2Rect



End Sub



Sub gCopyRect(lpDestRect As RECT, lpSourceRect As RECT)



CopyRect lpDestRect, lpSourceRect



End Sub



Sub gSetRectEmpty(lpRect As RECT)



SetRectEmpty lpRect



End Sub



Sub gInflateRect(lpRect As RECT, X As Long, Y As Long)



InflateRect lpRect, X, Y



End Sub



Sub gOffsetRect(lpRect As RECT, X As Long, Y As Long)



OffsetRect lpRect, X, Y



End Sub



Sub gInvertRect(hdc As Long, lpRect As RECT)



InvertRect hdc, lpRect



End Sub



Sub gFrameRect(hdc As Long, lpRect As RECT, hBrush As Long)



FrameRect hdc, lpRect, hBrush



End Sub



Sub gSetRect(lpRect As RECT, X1 As Long, Y1 As Long, X2 As Long, Y2 As Long)



SetRect lpRect, X1, Y1, X2, Y2



End Sub



Sub gDeleteObject(hObject As Long)



DeleteObject hObject



End Sub



Sub gSelectObject(hdc As Long, hObject As Long)



SelectObject hdc, hObject



End Sub



Sub gFillRect(hdc As Long, lpRect As RECT, hBrush As Long)



FillRect hdc, lpRect, hBrush



End Sub



Function gGetDeviceCaps(hdc As Long, nIndex As DEVICECAPS) As Long



gGetDeviceCaps = GetDeviceCaps(hdc, nIndex)



End Function



Function gCreateBrushIndirect(hdc As Long, lbColor As Long, lbHatch As BRUSHSTYLE, lbStyle As LBSTYLES) As Long



Dim hBrush As Long, LB As LOGBRUSH

LB.lbColor = lbColor

LB.lbHatch = lbHatch

LB.lbStyle = lbStyle

hBrush = CreateBrushIndirect(LB)

SelectObject hdc, hBrush

gCreateBrushIndirect = hBrush



End Function



Sub gSetPolyFillMode(hdc As Long, nPolyFillMode As POLYFILLMOD)



SetPolyFillMode hdc, nPolyFillMode



End Sub



Function gGetPolyFillMode(hdc As Long) As Long



gGetPolyFillMode = GetPolyFillMode(hdc)



End Function



Function gGetROP2(hdc As Long) As Long



gGetROP2 = GetROP2(hdc)



End Function



Sub gSetROP2(hdc As Long, ByVal nDrawMode As ROP2)



SetROP2 hdc, nDrawMode



End Sub



Sub gSetBkColor(hdc As Long, crColor As Long)



SetBkColor hdc, crColor



End Sub



Sub gSetBkMode(hdc As Long, nBkMode As BKMODE)



SetBkMode hdc, nBkMode



End Sub



Function gCreatePatternBrush(hdc As Long, ByVal hBitmap As Long) As Long



Dim hBrush As Long

hBrush = CreatePatternBrush(hBitmap)

SelectObject hdc, hBrush

gCreatePatternBrush = hBrush



End Function



Function gCreateHatchBrush(hdc As Long, nIndex As BRUSHSTYLE, crColor As Long) As Long



Dim hBrush As Long

hBrush = CreateHatchBrush(nIndex, crColor)

SelectObject hdc, hBrush

gCreateHatchBrush = hBrush



End Function



Sub gPolyPolygon(hdc As Long, lpPoint As POINTAPI, lpPolyCounts As Long, nCount As Long)



PolyPolygon hdc, lpPoint, lpPolyCounts, nCount



End Sub





Sub gSetArcDirection(hdc As Long, ArcDirection As ARCDIRECT)



SetArcDirection hdc, ArcDirection



End Sub



Sub gPolyPolyline(hdc As Long, lpPoint As POINTAPI, lpdwPolyPoints As Long, nCount As Long)



PolyPolyline hdc, lpPoint, lpdwPolyPoints, nCount



End Sub



Sub gPolyline(hdc As Long, lpPoint As POINTAPI, nCount As Long)



Polyline hdc, lpPoint, nCount



End Sub



Sub gPolygon(hdc As Long, lpPoint As POINTAPI, nCount As Long)



Polygon hdc, lpPoint, nCount



End Sub



Sub gPolylineTo(hdc As Long, lpPoint As POINTAPI, nCount As Long)



PolylineTo hdc, lpPoint, nCount



End Sub



Sub gPolyBezier(hdc As Long, lpPoint As POINTAPI, nCount As Long)



PolyBezier hdc, lpPoint, nCount



End Sub



Sub gPolyBezierTo(hdc As Long, lpPoint As POINTAPI, nCount As Long)



' Attention nombre de points strictement multiple de 3 !

PolyBezierTo hdc, lpPoint, nCount



End Sub



Function gGetCurrentLOGPEN(hdc As Long, ByRef xLogPen As LOGPEN) As LOGPEN



GetObject GetCurrentObject(hdc, 1), Len(xLogPen), xLogPen

gGetCurrentLOGPEN.lopnColor = xLogPen.lopnColor

gGetCurrentLOGPEN.lopnStyle = xLogPen.lopnStyle

gGetCurrentLOGPEN.lopnWidth.X = xLogPen.lopnWidth.X



End Function



Function gCreatePen(hdc As Long, nPenStyle As VBGPEN, nWidth As Long, crColor As Long) As Long



Dim hPen As Long

hPen = CreatePen(nPenStyle, nWidth, crColor)

SelectObject hdc, hPen

gCreatePen = hPen



End Function



'Sub gExtCreatePen(hdc As Long, dwPenStyle As Long, dwWidth As Long, lplb As LOGBRUSH, dwStyleCount As Long, lpStyle As Long)



' Dim hPen As Long

' hPen = ExtCreatePen(dwPenStyle, dwWidth, lplb, dwStyleCount, lpStyle)

' SelectObject hdc, hPen

' gExtCreatePen = hPen



'End Sub



Function gCreateSolidBrush(hdc As Long, crColor As Long) As Long



Dim hBrush As Long

hBrush = CreateSolidBrush(crColor)

SelectObject hdc, hBrush

gCreateSolidBrush = hBrush



End Function

Function gCreatePenIndirect(hdc As Long, LP As LOGPEN) As Long



Dim hPen As Long

hPen = CreatePenIndirect(LP)

SelectObject hdc, hPen

gCreatePenIndirect = hPen



End Function



Sub gLine(hdc As Long, X1 As Long, Y1 As Long, X2 As Long, Y2 As Long)



MoveToEx hdc, X1, Y1, Point

LineTo hdc, X2, Y2



End Sub



Sub gRectangle(hdc As Long, XLeft As Long, YTop As Long, XRight As Long, YBottom As Long)



Rectangle hdc, XLeft, YTop, XRight, YBottom



End Sub



Sub gRoundRect(hdc As Long, XLeft As Long, YTop As Long, XRight As Long, YBottom As Long, XCornerEllipse As Long, YCornerEllipse As Long)



RoundRect hdc, XLeft, YTop, XRight, YBottom, XCornerEllipse, YCornerEllipse



End Sub



Sub gEllipse(hdc As Long, XLeft As Long, YTop As Long, XRight As Long, YBottom As Long)



Ellipse hdc, XLeft, YTop, XRight, YBottom



End Sub

Sub gArc(hdc As Long, XLeft As Long, YTop As Long, XRight As Long, YBottom As Long, XStart As Long, YStart As Long, XEnd As Long, YEnd As Long)



Arc hdc, XLeft, YTop, XRight, YBottom, XStart, YStart, XEnd, YEnd



End Sub



Sub gChord(hdc As Long, XLeft As Long, YTop As Long, XRight As Long, YBottom As Long, XStart As Long, YStart As Long, XEnd As Long, YEnd As Long)



Chord hdc, XLeft, YTop, XRight, YBottom, XStart, YStart, XEnd, YEnd



End Sub



Sub gPie(hdc As Long, XLeft As Long, YTop As Long, XRight As Long, YBottom As Long, XStart As Long, YStart As Long, XEnd As Long, YEnd As Long)



Pie hdc, XLeft, YTop, XRight, YBottom, XStart, YStart, XEnd, YEnd



End Sub



Public Function gGetCurrentX(hdc As Long) As Long



If GetCurrentPositionEx(hdc, Point) Then

gGetCurrentX = Point.X

End If



End Function



Public Function gGetCurrentY(hdc As Long) As Long



If GetCurrentPositionEx(hdc, Point) Then

gGetCurrentY = Point.Y

End If



End Function



Public Sub gLineTo(hdc As Long, X2 As Long, Y2 As Long)



LineTo hdc, X2, Y2



End Sub



Public Sub gMoveTo(hdc As Long, X1 As Long, Y1 As Long)



MoveToEx hdc, X1, Y1, Point


  • End Sub

  • Комментариев нет:

    Отправить комментарий