IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)

Sources PureBasic

Sources PureBasicConsultez toutes les sources

Nombre d'auteurs : 41, nombre de sources : 88, dernière mise à jour : 13 août 2011 

 
OuvrirSommaireWindowsGDI+
 
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)

;-

End
Créé 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 I

Et 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_CloseWindow
Créé le 21 juin 2011  par einander

Image non disponible Image non disponible Image non disponible Image non disponible Image non disponible

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

Téléchargez le zip

Les sources présentées sur cette page sont libres de droits et vous pouvez les utiliser à votre convenance. Par contre, la page de présentation constitue une œuvre intellectuelle protégée par les droits d'auteur. Copyright © 2008 Developpez Developpez LLC. Tous droits réservés Developpez LLC. Aucune reproduction, même partielle, ne peut être faite de ce site ni de l'ensemble de son contenu : textes, documents et images sans l'autorisation expresse de Developpez LLC. Sinon vous encourez selon la loi jusqu'à trois ans de prison et jusqu'à 300 000 € de dommages et intérêts.