voici un example d'utilisation de la bibliothèque graphique 'gdiplus.dll' de microsoft.
Pour plus d'informations :
http://msdn.microsoft.com/library/defau ... erence.asp
Code : Tout sélectionner
; test gdiplus.lib for pb4, flype, jul 2006
; http://msdn.microsoft.com/library/default.asp?url=/library/en-us/gdicpp/GDIPlus/GDIPlusreference.asp
Import "gdiplus.lib"
; init
GdiplusStartup(*token, *input, *output)
GdiplusShutdown(*token)
GdipAlloc(Size.l)
GdipFree(*ptr)
; codec
GdipGetImageEncoders(numDecoders.l, Size.l, *decoders)
GdipGetImageEncodersSize(*numDecoders, *Size)
GdipGetImageDecoders(numDecoders.l, Size.l, *decoders)
GdipGetImageDecodersSize(*numDecoders, *Size)
; graphic
GdipCreateFromHDC(*hDC, *graphics)
GdipDeleteGraphics(*graphics)
GdipSetSmoothingMode(*graphics, Mode.l)
GdipGraphicsClear(*graphics, color.l)
GdipDrawBezier(*graphics, *Pen, x1.f, y1.f, x2.f, y2.f, x3.f, y3.f, x4.f, y4.f)
GdipDrawLineI(*graphics, *Pen, x1.l, y1.l, x2.l, y2.l)
GdipDrawEllipseI(*graphics, *Pen, x.l, y.l, Width.l, Height.l)
GdipDrawString(*graphics, string.p-unicode, length.l, *Font, *layoutRect, *stringFormat, *Brush)
; font
GdipCreateFont(*FontFamily, emSize.f, style.l, unit.l, *Font)
GdipCreateFontFamilyFromName(FontName.p-unicode, *FontCollection, *FontFamily)
GdipDeleteFontFamily(*FontFamily)
GdipDeleteFont(*Font)
; brush
GdipCreateHatchBrush(hatchstyle.l, forecol.l, backcol.l, *Brush)
GdipCreateSolidFill(color.l, *Brush)
GdipGetBrushType(*Brush, Type.l)
GdipDeleteBrush(*Brush)
; pen
GdipCreatePen1(color.l, Width.f, unit.l, *Pen)
GdipCreatePen2(Brush.l, Width.f, unit.l, *Pen)
GdipSetPenStartCap(*Pen, customCap.l)
GdipSetPenEndCap(*Pen, customCap.l)
GdipDeletePen(*Pen)
EndImport
Structure RectF
left.f
top.f
Width.f
Height.f
EndStructure
Structure ImageCodecInfo
clsid.CLSID
FormatID.GUID
*CodecName;.s
*DllName;.s
*FormatDescription;.s
*FilenameExtension;.s
*MimeType;.s
flags.l
Version.l
SigCount.l
SigSize.l
*SigPattern
*SigMask
EndStructure
Structure GdipStartupInput
GdiPlusVersion.l
DebugEventCallback.l
SuppressBackgroundThread.l
SuppressExternalCodecs.l
EndStructure
Enumeration 0 ; BrushType
#BrushTypeSolidColor
#BrushTypeHatchFill
#BrushTypeTextureFill
#BrushTypePathGradient
#BrushTypeLinearGradient
EndEnumeration
Enumeration 0 ; FontStyle
#FontStyleRegular = 0
#FontStyleBold = 1
#FontStyleItalic = 2
#FontStyleBoldItalic = 3
#FontStyleUnderline = 4
#FontStyleStrikeout = 8
EndEnumeration
Macro WCHAR(unicode)
PeekS(unicode, -1, #PB_Unicode)
EndMacro
Macro ARGB(Alpha, RGB)
(Blue(RGB)|Green(RGB)<<8|Red(RGB)<<16|Alpha<<24)
EndMacro
;-
Procedure.l SetRectF(*rect.RectF, x.f, y.f, w.f, h.f)
*rect\left = x
*rect\top = y
*rect\Width = w
*rect\Height = h
EndProcedure
Procedure.l GdipImageDecoders()
Protected num.l, Size.l
GdipGetImageDecodersSize(@num, @Size)
Dim info.ImageCodecInfo(Size/SizeOf(ImageCodecInfo))
GdipGetImageDecoders(num, Size, @info(0))
Debug "======================= DECODERS"
For i = 0 To num - 1
Debug WCHAR(info(i)\CodecName)
Debug WCHAR(info(i)\MimeType)
Debug "======================="
Next
ProcedureReturn num
EndProcedure
Procedure.l GdipImageEncoders()
Protected num.l, Size.l
GdipGetImageEncodersSize(@num, @Size)
Dim info.ImageCodecInfo(Size/SizeOf(ImageCodecInfo))
GdipGetImageEncoders(num, Size, @info(0))
Debug "======================= ENCODERS"
For i = 0 To num - 1
Debug WCHAR(info(i)\CodecName)
Debug WCHAR(info(i)\MimeType)
Debug "======================="
Next
ProcedureReturn num
EndProcedure
Procedure.l GdipLine(*graphics, x1.l, y1.l, x2.l, y2.l, w.f, color.l, StartCap.l, EndCap.l)
Protected *Pen
GdipCreatePen1(color, w, 2, @*Pen)
GdipSetPenStartCap(*Pen, StartCap)
GdipSetPenEndCap(*Pen, EndCap)
GdipDrawLineI(*graphics, *Pen, x1, y1, x2, y2)
GdipDeletePen(*Pen)
EndProcedure
Procedure.l GdipBezier(*graphics, x1.f, y1.f, x2.f, y2.f, x3.f, y3.f, x4.f, y4.f, w.f, color.l, StartCap.l, EndCap.l)
Protected *Pen
GdipCreatePen1(color, w, 2, @*Pen)
GdipSetPenStartCap(*Pen, StartCap)
GdipSetPenEndCap(*Pen, EndCap)
GdipDrawBezier(*graphics, *Pen, x1, y1, x2, y2, x3, y3, x4, y4)
GdipDeletePen(*Pen)
EndProcedure
Procedure.l GdipEllipse(*graphics, x.l, y.l, w.l, h.l, color.l)
Protected *Pen
GdipCreatePen1(color, w, 0, @*Pen)
GdipDrawEllipseI(*graphics, *Pen, x, y, w, h)
GdipDeletePen(*Pen)
EndProcedure
Procedure.l GdipString(*graphics, string.s, x.l, y.l, w.l, h.l, fntName.s, fntSize.f, fntStyle.l, color1.l, color2.l)
Protected *Family, *Font, *Brush, layout.RectF
GdipCreateFontFamilyFromName(fntName, #Null, @*Family)
GdipCreateFont(*Family, fntSize, fntStyle, 2, @*Font)
GdipCreateHatchBrush(20, color1, color2, @*Brush)
SetRectF(layout, x, y, w, h)
GdipDrawString(*graphics, string, -1, *Font, layout, #Null, *Brush)
GdipDeleteFontFamily(*Family)
GdipDeleteFont(*Font)
GdipDeleteBrush(*Brush)
EndProcedure
;-
Procedure.l myWindowCallback(*window, message.l, wParam.l, lParam.l)
Protected result.l, *hDC, *graphics
result = #PB_ProcessPureBasicEvents
Select message
Case #WM_MOUSEMOVE
*hDC = StartDrawing(WindowOutput(0))
If *hDC
GdipCreateFromHDC(*hDC, @*graphics)
GdipSetSmoothingMode(*graphics, 2)
For i = 0 To 5
GdipEllipse(*graphics, WindowMouseX(0)+Random(50)-25, WindowMouseY(0)+Random(50)-25, Random(30), Random(30), ARGB(10, #Gray))
Next
GdipDeleteGraphics(*graphics)
StopDrawing()
EndIf
Case #WM_ERASEBKGND
*hDC = StartDrawing(WindowOutput(0))
If *hDC
GdipCreateFromHDC(*hDC, @*graphics)
GdipSetSmoothingMode(*graphics, 2)
GdipGraphicsClear(*graphics, ARGB(255, $222222))
GdipLine(*graphics, 550, 70, 20, 200, 20, ARGB(255, #Yellow), 18, 18)
GdipLine(*graphics, 100, 50, 600, 200, 30, ARGB(127, #Green), 17, 2)
GdipLine(*graphics, 600, 100, 80, 400, 40, ARGB(127, #Blue), 19, 19)
GdipBezier(*graphics, 50, 50, 150, 60, 300, 250, 20, 500, 16, ARGB(127, #Red), 18, 18)
GdipString(*graphics, "GDI+ 1.0 & PB4.0", 280, 280, 380, 200, "Arial", 80, #FontStyleBoldItalic|#FontStyleUnderline, ARGB(10, #Black), ARGB(80, #Blue))
GdipDeleteGraphics(*graphics)
StopDrawing()
EndIf
EndSelect
ProcedureReturn result
EndProcedure
;-
Define *token, input.GdipStartupInput
input\GdiPlusVersion = 1
GdiplusStartup(@*token, @input, #Null)
GdipImageDecoders()
GdipImageEncoders()
If OpenWindow(0, 0, 0, 640, 480, "GdiPlus 1.0", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
SetWindowCallback(@myWindowCallback(), 0)
SendMessage_(WindowID(0), #WM_ERASEBKGND, 0, 0)
Repeat
Until WaitWindowEvent() = #PB_Event_CloseWindow
EndIf
GdiplusShutdown(*token)
;-
End
