Sources PureBasic
Sources PureBasicConsultez toutes les sources
Nombre d'auteurs : 41, nombre de sources : 88, dernière mise à jour : 13 août 2011
Sommaire→Windows→GDI+
Sélectionnez
; 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)
;-
EndCréé le 20 février 2008 par Flype
Ce code fonctionne sous x86 seulement (en attendant que quelqu'un propose une solution pour x64).
Il permet de tracer une courbe lisse à partir de données pas très régulières. Voici comment sont calculées les données pour l'exemple :
Sélectionnez
For I=1 To #N
X(I)=X(I-1)+Random(1200)/500
Y(I)=Y(I-1)+Sin(I/50)+(Random(1000)-500)/50
Next IEt voici le code complet (windows uniquement) :
Sélectionnez
; Init Data...
#N=4000
Dim X.D(#N)
Dim Y.D(#N)
Dim S.D(#N)
Dim T.D(#N)
X(0)=0
Y(0)=200
RandomSeed(0)
;
For I=1 To #N
X(I)=X(I-1)+Random(1200)/500
Y(I)=Y(I-1)+Sin(I/50)+(Random(1000)-500)/50
Next I
Prototype GdiplusStartup(*A,*B,C=0)
Prototype P1(A)
Prototype P2(A,B)
Prototype P4(A,B,C,D)
Prototype P1F2(A,B.F,C,D)
;
Procedure FastGDIP()
#GDIP=1
Global _Gdip,_Graph,_Drawing,_Linewidth=4,_Transparency=255
Structure Pointf
X.F
Y.F
EndStructure
;
Structure GdiplusStartupInput
GdiPlusVersion.L
DebugEventCallBack.L
SuppressBackgroundThread.L
SuppressExternalCodecs.L
EndStructure
; hay que agregar prototypes y macros que se necesiten <<<<<<<<<<<<<<<<<<<<<<
Macro GName : GetFunction(#GDIP,Name) : EndMacro ;- Gname
Macro M1(Name,A) : GF.P1=GName:GF(A) :EndMacro
Macro M2(Name,A,B) : GF.P2=GName:GF(A,B) :EndMacro
Macro M4(Name,A,B,C,D) : GF.P4=GName:GF(A,B,C,D) :EndMacro
Macro M1F2(Name,A,B,C,D) : GF.P1F2=GName:GF(A,B,C,D) :EndMacro
Macro RGB2ARGB(RGB,Alpha=$FF) ;- RGB2ARGB(RGB,Alpha=$FF) - convert RGB to Alpha RGB
Blue(RGB)|Green(RGB)<<8|Red(RGB)<<16|Alpha<<24
EndMacro
;
Macro ARGB(RGB=0,Alpha=255) ;- ARGB((RGB=0,Transp=255)
RGB2ARGB(RGB,Alpha)
EndMacro
;
If OpenLibrary(#GDIP,"GDIPlus.DLL")
Gdip.GdiplusStartupInput\GdiPlusVersion=1
Gdip\DebugEventCallBack = #Null
Gdip\SuppressBackgroundThread = #False
Gdip\SuppressExternalCodecs = #False
GF.GdiplusStartup = GetFunction(#GDIP, "GdiplusStartup") : GF(@_GDIP,@Gdip)
M2("GdipCreateFromHDC",_DRAWING,@_GRAPH)
M2("GdipSetSmoothingMode",_GRAPH,1)
_GDIP=#True
Else
MessageRequester("Error !","GDIPlus.DLL Not found",0)
EndIf
EndProcedure
;
Procedure Smooth(Array X.D(1),Array Y.D(1),Smoothing,Rgb,Linewidth.f=1)
Dim Pf.Pointf(#N/Smoothing+1)
I=0
Repeat
Pf(N)\X=X(I)
Pf(N)\Y=Y(I)
I+Smoothing
N+1
Until I>=#N
Pf(N)\X=X(#N)
Pf(N)\Y=Y(#N)
M1F2("GdipCreatePen1",Argb(Rgb),Linewidth,0,@GpPen)
M4("GdipDrawCurve",_GRAPH, GpPen,@Pf(),ArraySize(Pf()))
M1("GdipDeletePen",GpPen)
Dim Pf(0)
EndProcedure
;<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
OpenWindow(0, 0, 0, 600, 500, "",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
FastGDIP()
CreateImage(1,600,400)
ImageGadget(1,0,0,0,0,ImageID(1))
TBG=TrackBarGadget(-1,10,410,580,30,1,50,1)
SetGadgetState(tbg,10)
_Drawing=StartDrawing(ImageOutput(1))
M2("GdipCreateFromHDC",_DRAWING, @_GRAPH)
Draw=1
;-----------------
Repeat
If GetAsyncKeyState_(27)&$8000 : End : EndIf
Ev= WaitWindowEvent()
Select Ev
Case #PB_Event_Gadget
Select EventGadget()
Case TBG :Draw=1
EndSelect
EndSelect
If Draw
If _Drawing:StopDrawing():EndIf
_Drawing=StartDrawing(ImageOutput(1))
M2("GdipCreateFromHDC",_DRAWING, @_GRAPH)
M2("GdipGraphicsClear",_GRAPH,ARGB(0))
Smooth(X(),Y(),1,$BBBBBB)
Smooth(X(),Y(),GetGadgetState(Tbg),#Red,2.5)
StopDrawing():_Drawing=0
SetGadgetState(1,ImageID(1))
Draw=0
EndIf
Until Ev=#PB_Event_CloseWindowCréé le 21 juin 2011 par einander
gDrawing est un fichier Include pour Windows qui remplace les fonctions de dessins de la bibliothèque 2DDrawing PureBasic.
Les fonctions suivantes sont disponibles :
gClear(), gPlot(), gBox(), gRoundBox(), gLine(), gLineXY(), gPie(), gPieXY(),
gArc(), gArcXY(), gEllipse(), gEllipseXY(), gCircle(), gCircleXY(), gBezier(),
gCurve(), gClosedCurve(), gTriangle(), gPoly(),
gDrawImage(), gDrawAlphaImage(), gDrawClippedImage(),
gDrawText(), gDrawRotatedText()
gDrawing inclut le Clipping avec gClipBox() et gClipPath().
Avec gDrawing vous pourrez déplacer, dimensionner, tourner chaque élément du dessin.
gDrawing inclut la commande gSetUnit() pour indiquer l'échelle utilisée comme
#UnitMillimeter ou #UnitInch pour dessiner sur votre écran ou l'imprimante.
L'archive contient quelques démos.
Créé le 24 juillet 2011 par Danilo