PureBasic Forums - English

Posted: **Mon Dec 12, 2005 12:56 pm**

Added text procedures to the first post, thanx to Andreas from the PB German forum.
Also more shapes and a faked rounded rectangle.
Transparency effects are nice, but very slow.
If somebuddy have more examples, welcommed!

Posted: **Mon Dec 12, 2005 2:47 pm**

Just keeps getting better.

Seems I need a #Gdip_LemonChiffon.

Any idea as to what it may look like or where I can find?

cheers

Posted: **Thu Jan 05, 2006 10:50 pm**

I didn't know about GDI+. Nice surprise.
(If I had real 24 hrs a day, reading the forum post by post would be time well spent - sigh)

@einander, @all
The best documentation, in your opinion, on GDI+?
Can it do antialiased bezier or curves in general?

@dagcrack
Any particular reason to find it useless?
(Better solutions for AA etc.)

@rsts
#Gdip_LemonChiffon = $FFFFFACD

Regards

Posted: **Fri Jan 06, 2006 12:29 pm**

@mdp:
GDI+ supports antialiasing for all graphics objects.
Try the example calling GdipInit(1) - Mode 1 =no antialiasing

Interesting article about GDI+ antialiasing limitations:
http://www.codeproject.com/cs/media/Ant ... Issues.asp

There are lots of articles on the web about GDI+ for C# and VB, but I have not found documentation easily applicable to PB.

Regards

Posted: **Sat Jan 14, 2006 6:54 pm**

Improved color handling.
Removed CreatePen procedure.
Changed GdipCreateFromHWND to GdipCreateFromHDC, to allow drawing on Image.
See first post.

Cheers

Posted: **Sat Mar 04, 2006 11:39 am**

Code: Select all

; by einander
; Updated to PB 4.0 may 10 - 2006
; Thanks Andreas from PB German Forum For the Text Procedures
RandomSeed(123)
   
Global _GDIP,_GRAPH,_DRAWING
#GDIP = 0
;Init
Prototype GdiplusStartup(*a,*b,C=0)
Prototype GdipAlloc(Buff)       
Prototype GdipFree(*Buff)
; Pen
Prototype GdipCreatePen1(ARGB,LineWidth.F,n,*Pen)
Prototype GdipDrawLineI(_GRAPH,Pen,X,Y,X1,Y1)  ; functions ended with "i" need integer params
Prototype GdipSetPenStartCap(Pen,StartCap)
Prototype GdipSetPenEndCap(Pen,StartCap)
Prototype GdipDrawRectangle(_GRAPH,Pen,X.F,Y.F,Width.F,Height.F)
Prototype GdipDrawRectangleI(_GRAPH ,  Pen ,  X ,  Y ,  Width ,  Height )
Prototype GdipDrawEllipseI( _GRAPH ,  Pen ,  X ,  Y ,  Width ,  Height ) 
Prototype GdipDeletePen(Pen)
;Font
Prototype GdipCreateFont(Family,FontWSize.F,FontStyle,n,*Font)
Prototype GdipCreateFontFamilyFromName(*Buff,n,*Family)
Prototype GdipDeleteFontFamily(Family)
Prototype GdipDeleteFont(Font)
;Brush
Prototype GdipCreatePathGradientI(*P.POINT,n,M,*Brush)
Prototype GdipSetPathGradientCenterColor(Brush,ARGB)
Prototype GdipGetTextureTransform( Brush ,  Matrix )
Prototype GdipSetPathGradientBlend( Brush , Blend,Pos,Count )
Prototype GdipFillEllipseI(_GRAPH, Brush, X,Y,Width,Height)
Prototype GdipFillRectangleI(_GRAPH, Brush, X,Y,Width,Height)
Prototype GdipSetLinePresetBlend(Brush,*Blend,*Pos,n)
Prototype GdipDrawString(_GRAPH,*Buff,n,Font,R,M,Brush)
Prototype GdipCreateSolidFill(ARGB,*Brush)
Prototype GdipDeleteBrush(Brush)

Structure Gdip_GdiplusStartupInput
    GdiPlusVersion.L
    DebugEventCallback.L
    SuppressBackgroundThread.L
    SuppressExternalCodecs.L
EndStructure

Structure Gdip_RectF
    left.F
    top.F
    Width.F
    Height.F
EndStructure

OpenLibrary(0, "MyLib.dll")
CallFunction(0, "MyLibFunction1", Param1, Param2)
CloseLibrary(0)   

Macro ToARGB(Transparency,RGB) ; convert RGB to Alpha RGB
    Blue(RGB)|Green(RGB)<<8|Red(RGB)<<16|Transparency<<24
EndMacro

Macro GdipInit(Mode) ;- GdipInit(Mode)   ; Mode 1=Fast,2 =HiRes
    If OpenLibrary(#GDIP,"GDIPlus.DLL")
        Gdip.Gdip_GdiplusStartupInput\GdiPlusVersion=1
        GF.GdiplusStartup = GetFunction(#GDIP, "GdiplusStartup") : GF(@_GDIP,@Gdip)
        CallFunction(#GDIP,"GdipCreateFromHDC",_DRAWING,@_GRAPH)
        If Mode=2 : CallFunction(#GDIP,"GdipSetSmoothingMode",_GRAPH,Mode) : EndIf 
    Else
        MessageRequester("Error !","GDIPlus.DLL Not found",0)
    EndIf
EndMacro

Macro SzTiles ;- SzTiles
    If Tiles : Wi=Width/Tiles : He=Height/Tiles
    Else : Wi=Width : He=Height
    EndIf
EndMacro

Macro GdipClose  ;- GdipClose
    CallFunction(#GDIP,"GdipDeleteGraphics",_GRAPH)
    CallFunction(#GDIP,"GdiplusShutdown",_GDIP)
    CloseLibrary(#GDIP)
    _GDIP=0
EndMacro   

Macro BOUND  ;- Bound - assign bounding rectangle to R.Gdip_Rect
    R.Gdip_RectF\left = X  : R\top = Y
    R\Width = Width : R\Height = Height
EndMacro

Macro IsGDIP ;- IsGDIP
    If _GDIP=0
        MessageRequester("Warning !","GDIP+ not initialized !",0)
        ProcedureReturn
    EndIf
EndMacro

Macro FillP ;- FillP - Tile coords
    Dim P.POINT(3) ; 
    P(0)\X = X :P(0)\Y = Y
    P(1)\X = X+Wi : P(1)\Y = Y
    P(2)\X = X+Wi : P(2)\Y = Y+He
    P(3)\X = X : P(3)\Y = Y+He
EndMacro   

Macro Blend3 ;- blend3 ; blend 3 colors
    Dim Blend(2)
    Blend(0) = ARGB1
    Blend(1) = ARGB2
    Blend(2) = ARGB3
EndMacro

Macro Pos2 ;- Pos2
    Dim Pos.F(2)
    ;  Pos(0)=0  ; must be 0
    Pos(1) = Gradient
    Pos(2) = 1     ; must be 1
EndMacro

Macro GdipRoundRect(X,Y,X1,Y1,LineWidth,ARGB) ;- GdipRoundRect
    ;Trick:  this is a false rectangle, actually a line with rounded caps
    ; x,y,x1,y1 are the endings of the central axis of the rectangle
    ; so you can draw diagonal rounded rectangles
    GdipLine(X,Y,X1,Y1,LineWidth,ARGB,2,2)
EndMacro
       
Procedure GdipText(Text.S,X,Y,Width,Height,FontName$,FontWSize.F,FontStyle,ARGB)
    IsGDIP
    Buff = (Len(FontName$)*2)+2
    GF.GdipAlloc = GetFunction(#GDIP, "GdipAlloc") : *Buff=GF(Buff)
    MultiByteToWideChar_(#CP_ACP,0,FontName$,-1,*Buff,Buff)
    GF.GdipCreateFontFamilyFromName=GetFunction(#GDIP,"GdipCreateFontFamilyFromName") : GF(*Buff,#Null,@Family)
    GF.GdipFree = GetFunction(#GDIP, "GdipFree") : GF(*Buff)
    GF.GdipCreateFont=GetFunction(#GDIP,"GdipCreateFont") : GF(Family,FontWSize.F,FontStyle,2,@Font)
    GF.GdipCreateSolidFill=GetFunction(#GDIP,"GdipCreateSolidFill") : GF(ARGB,@Brush)
    BOUND   
    Buff = (Len(Text)*2)+2 
    GF.GdipAlloc = GetFunction(#GDIP, "GdipAlloc") : *Buff=GF(Buff)
    MultiByteToWideChar_(#CP_ACP,0,Text,-1,*Buff,Buff)
    GF.GdipDrawString = GetFunction(#GDIP, "GdipDrawString") : GF(_GRAPH,*Buff,-1,Font,R, #Null,Brush)
    GF.GdipFree = GetFunction(#GDIP, "GdipFree") : GF(*Buff)
    GF.GdipDeleteFontFamily=GetFunction(#GDIP,"GdipDeleteFontFamily") : GF(Family)
    GF.GdipDeleteFont=GetFunction(#GDIP,"GdipDeleteFont") : GF(Font)
    GF.GdipDeleteBrush = GetFunction(#GDIP, "GdipDeleteBrush") : GF(Brush)
EndProcedure

;
Procedure GdipLine(X,Y,X1,Y1,LineWidth.F,ARGB,StartCap,EndCap)
    IsGDIP
    GF.GdipCreatePen1 = GetFunction(#GDIP, "GdipCreatePen1") : GF(ARGB,LineWidth,2,@Pen)
    GF.GdipSetPenStartCap = GetFunction(#GDIP, "GdipSetPenStartCap") : GF(Pen,StartCap)
    GF.GdipSetPenEndCap = GetFunction(#GDIP, "GdipSetPenEndCap") : GF(Pen,EndCap)
    GF.GdipDrawLineI = GetFunction(#GDIP, "GdipDrawLineI") : GF(_GRAPH,Pen,X,Y,X1,Y1)
    GF.GdipDeletePen = GetFunction(#GDIP, "GdipDeletePen") : GF(Pen)
EndProcedure
   
   
Procedure GdipRectangle(X.F,Y.F,Width.F,Height.F,LineWidth.F,ARGB)
    IsGDIP
    GF.GdipCreatePen1 = GetFunction(#GDIP, "GdipCreatePen1") : GF(ARGB,LineWidth,2,@Pen)
    GF.GdipDrawRectangle = GetFunction(#GDIP, "GdipDrawRectangle") : GF(_GRAPH,Pen,X,Y,Width,Height)
    GF.GdipDeletePen = GetFunction(#GDIP, "GdipDeletePen") : GF(Pen)
EndProcedure
   
Procedure GdipRectangleBLEND(X,Y,Width,Height,Gradient.F,Tiles.F,ARGB1,ARGB2,ARGB3)
    IsGDIP: SzTiles: FillP : Pos2 : Blend3    ; blend 3 colors
    GF.GdipCreatePathGradientI = GetFunction(#GDIP, "GdipCreatePathGradientI") : GF(@P(),4,0,@Brush)
    GF.GdipSetLinePresetBlend= GetFunction(#GDIP, "GdipSetLinePresetBlend") : GF(Brush,@Blend.L(),@Pos.F(),3)
    GF.GdipFillRectanglei = GetFunction(#GDIP, "GdipFillRectangleI") : GF(_GRAPH, Brush, X,Y,Width,Height)
    GF.GdipDeleteBrush = GetFunction(#GDIP, "GdipDeleteBrush") : GF(Brush)
EndProcedure

; half of the frame Rim is outside and half inside the bounding rectangle
Procedure GdipRectangleFILL(X,Y,Width,Height,Rim,RimARGB,Gradient.F,Tiles.F,ARGB1,ARGB2,ARGB3)
    IsGDIP: SzTiles: FillP : Pos2
    GF.GdipCreatePen1 = GetFunction(#GDIP, "GdipCreatePen1") : GF(RimARGB,Rim,0,@Pen)
    GF.GdipCreatePathGradientI = GetFunction(#GDIP, "GdipCreatePathGradientI") : GF(@P(),4,0,@Brush)
    GF.GdipFillRectanglei = GetFunction(#GDIP, "GdipFillRectangleI") : GF(_GRAPH, Brush, X,Y,Width,Height)
    GF.GdipDrawRectangleI=GetFunction(#GDIP, "GdipDrawRectangleI") :GF( _GRAPH,Pen,X,Y,Width,Height) ; frame
    GF.GdipDeleteBrush = GetFunction(#GDIP, "GdipDeleteBrush") : GF(Brush)
    GF.GdipDeletePen = GetFunction(#GDIP, "GdipDeletePen") : GF(Pen)
EndProcedure
   
Procedure GdipEllipseBLEND(X,Y,Width,Height,Gradient.F,Tiles.F,ARGB1,ARGB2,ARGB3)
    IsGDIP: SzTiles: FillP : Pos2 :Blend3
    GF.GdipCreatePathGradientI = GetFunction(#GDIP, "GdipCreatePathGradientI") : GF(@P(),4,0,@Brush)
    GF.GdipSetLinePresetBlend= GetFunction(#GDIP, "GdipSetLinePresetBlend") : GF(Brush,@Blend.L(),@Pos.F(),3)
    GF.GdipFillEllipsei = GetFunction(#GDIP, "GdipFillEllipseI") : GF(_GRAPH, Brush, X,Y,Width,Height)
    GF.GdipDeleteBrush = GetFunction(#GDIP, "GdipDeleteBrush") : GF(Brush)
EndProcedure
   
Procedure GdipEllipseGRADIENT(X,Y,Width,Height,Rim,RimARGB,Gradient.F,Tiles.F,ARGB)
    IsGDIP: SzTiles: FillP : Pos2
    GF.GdipCreatePen1 = GetFunction(#GDIP, "GdipCreatePen1") : GF(RimARGB,Rim,2,@Pen)
    GF.GdipCreatePathGradientI = GetFunction(#GDIP, "GdipCreatePathGradientI") : GF(@P(),4,0,@Brush)
    GF.GdipSetPathGradientCenterColor = GetFunction(#GDIP, "GdipSetPathGradientCenterColor") : GF(Brush,ARGB)
    GF.GdipFillEllipsei = GetFunction(#GDIP, "GdipFillEllipseI") : GF(_GRAPH, Brush, X,Y,Width,Height)
    GF.GdipDrawEllipseI=GetFunction(#GDIP, "GdipDrawEllipseI") :GF( _GRAPH,Pen,X,Y,Width,Height) ; frame
    GF.GdipDeleteBrush = GetFunction(#GDIP, "GdipDeleteBrush") : GF(Brush)
    GF.GdipDeletePen = GetFunction(#GDIP, "GdipDeletePen") : GF(Pen)
EndProcedure
   
Procedure GdipRectangleGRADIENT(X,Y,Width,Height,Gradient.F,Tiles.F,ARGB)
    IsGDIP: SzTiles: FillP : Pos2
    GF.GdipCreatePathGradientI = GetFunction(#GDIP, "GdipCreatePathGradientI") : GF(@P(),4,0,@Brush)
    GF.GdipSetPathGradientCenterColor = GetFunction(#GDIP, "GdipSetPathGradientCenterColor") : GF(Brush,ARGB)
    GF.GdipFillRectanglei = GetFunction(#GDIP, "GdipFillRectangleI") : GF(_GRAPH, Brush, X,Y,Width,Height)
    GF.GdipDeleteBrush = GetFunction(#GDIP, "GdipDeleteBrush") : GF(Brush)
EndProcedure
   
    ;<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
    ;Test it
   
hwnd=OpenWindow(0, 50, 50,700,500,"GdiPlus lines and shapes" , #WS_OVERLAPPEDWINDOW | #WS_MAXIMIZE)
CreateImage(0,WindowWidth(0),WindowHeight(0))
_DRAWING=StartDrawing(ImageOutput(0))
  
GdipInit(2)  ; 0 or 1=fast; 2= HighRes
X=100:Y=100:Width=600:Height=250
Gradient.F=1.23   
GdipRectangle(0,0,WindowWidth(0),WindowHeight(0),WindowHeight(0),ToARGB(255,0)) ; clear screen color black
   
ARGB1=ToARGB(127,#Yellow)  ; first param = Transparency
ARGB2=ToARGB(80,Random($FFFFFF))
ARGB3=ToARGB(164,Random($FFFFFF))
Tiles.F=1  ; 0 or 1 no tiles
   
GdipRectangleGRADIENT(X,Y,Width,Height,Gradient,Tiles,ToARGB(127,$33BB22))

Rim=21 : RimARGB=ToARGB(60,#Cyan)
GdipRectangleFILL(X+500,Y+300,Width/3,Height/3,Rim,RimARGB,Gradient,Tiles,ARGB2,ARGB3,ARGB1)
GdipEllipseBLEND(X,Y+300,Width,Height,Gradient,Tiles,ARGB1,ARGB2,ARGB3)

Rim=13
GdipEllipseGRADIENT(X+550,Y+100,Width/4,Height/2,Rim,ToARGB(100,#Yellow),Gradient,Tiles,ToARGB(100,#Blue))
GdipRectangle(200,200,400,100,6,ToARGB(255,Random($FFFFFF)))  ; frame
   
StartCap=2  ;2=Round Cap  ; 0 = No cap
EndCap=20  ;ArrowHead Cap  ; more caps in GDK GDI+ reference
GdipLine(100,50,WindowWidth(0)-200,200,34,ToARGB(127,#Green),EndCap,StartCap)
   
GdipLine(100,500,WindowWidth(0)-200,100,14,ToARGB(127,#Cyan),StartCap,EndCap)
GdipRoundRect(200,200,400,500,100,ToARGB(127,#Magenta))
   
style=0
Text.S="Multiline Text clipped 123456 hola hola testing GdiPluuuuuuuuuus!!!"
GdipText(Text,200,200,400,100,"arial",33,style,ToARGB(127,$850700))
style=2
GdipText("Another Text 123456 hola hola testing GdiPlus is sloooooow++++!!!",200,400,400,100,"tahoma",16,style,$FFFFFACD ) ;#Gdip_LemonChiffon)
   
GdipClose ; don't forget to shutdown and release graphics
StopDrawing()
   
Repeat
    Select WaitWindowEvent()
        Case #WM_NCMOUSEMOVE , #WM_PAINT
            StartDrawing(WindowOutput(0))
            DrawImage(ImageID(0), 0, 0)
            StopDrawing()
        Case #WM_KEYDOWN : _Inkey = EventwParam() 
            If _Inkey=27:End:EndIf 
        Case #PB_Event_CloseWindow : End
    EndSelect
ForEver
End

Posted: **Sat Mar 04, 2006 2:46 pm**

Really nice.

Many thanks for sharing this

cheers

Posted: **Sat Mar 04, 2006 8:10 pm**

I suugest the event loop is changed from:

Code: Select all

Repeat 
    Ev=WindowEvent() 
    If Ev = #WM_PAINT 
        StartDrawing(WindowOutput(0)) 
        DrawImage(ImageID(0), 0, 0) 
        StopDrawing() 
    EndIf 
    Delay(0) 
Until Ev= #PB_Event_CloseWindow

to

Code: Select all

Repeat
  Ev=WaitWindowEvent()
  If Ev=#WM_NCMOUSEMOVE Or Ev=#WM_PAINT
    StartDrawing(WindowOutput(0))
    DrawImage(ImageID(0), 0, 0)
    StopDrawing()
  EndIf
Until Ev=#PB_Event_CloseWindow

as it is much less of a drain on the CPU.

Posted: **Sat Mar 04, 2006 9:21 pm**

Thanx Athony.
Event loop updated.

More functions welcommed!

Posted: **Tue Nov 07, 2006 2:54 pm**

Show hear, a widened lib: http://www.purebasic.fr/german/viewtopi ... sc&start=0

Posted: **Thu Nov 09, 2006 5:34 pm**

Thanks Leonhard.
Meanwhile, here is new code, with more functions and better Prototype and Macro integration. Still much work to do.

Code: Select all

; 
Global _GDIP,_GRAPH,_Drawing
#GDIP = 0

Structure GDIp_GdiplusStartupInput
    GdiPlusVersion.l
    DebugEventCallback.l
    SuppressBackgroundThread.l
    SuppressExternalCodecs.l
EndStructure

#Left=1 : #Top=2 : #Right=4 : #Bottom=8

Structure PointF :  x.f:y.f : EndStructure
Structure RectF :  x.f :  y.f :  Wi.f :  He.f : EndStructure
Structure Tiles :  T.POINT[4] :EndStructure
Structure Blending :  b.l[3] : EndStructure 
Structure PosGrad :  P.f[3] :EndStructure

Macro GName : GetFunction(#GDIP,Name) : EndMacro
Macro GdipDelPen :      M1("GdipDeletePen",GdipPen) :EndMacro
Macro GdipDelBrush :   M1("GdipDeleteBrush",GdipBrush) :EndMacro

;P Code means: 1, 2, 3... number of consecutive integers; (Representing values, pointers, colours...)
;F = one float; FFF = 3 consecutive floats
;U = one p-Unicode
Prototype GdiplusStartup(*a,*b,c=0)
; GDIP Prototypes and Macros for each parameter combination; add more if needed
Prototype P1(A) : Macro M1(Name,A) : GF.P1=GName:GF(A) :EndMacro
Prototype P2(A,b) : Macro M2(Name,A,b) : GF.P2=GName:GF(A,b) :EndMacro
Prototype P3(A,b,c) : Macro M3(Name,A,b,c) : GF.P3=GName:GF(A,b,c) :EndMacro
Prototype P4(A,b,c,D) : Macro M4(Name,A,b,c,D) : GF.P4=GName:GF(A,b,c,D) :EndMacro
Prototype P5(A,b,c,D,E) : Macro M5(Name,A,b,c,D,E) : GF.P5=GName:GF(A,b,c,D,E) :EndMacro
Prototype P6(A,b,c,D,E,F) : Macro M6(Name,A,b,c,D,E,F) : GF.P6=GName:GF(A,b,c,D,E,F) :EndMacro
Prototype P7(A,b,c,D,E,F,G) : Macro M7(Name,A,b,c,D,E,F,G) : GF.P7=GName:GF(A,b,c,D,E,F,G) :EndMacro
;Prototype P8(a,b,c,d,e,f,g,h) : Macro M8(Name,a,b,c,d,e,f,g,h) : GF.P8=GName:GF(a,b,c,d,e,f,g,h) :EndMacro
;Prototype P9(a,b,c,d,e,f,g,h,i) : Macro M9(Name,a,b,c,d,e,f,g,h,i) : GF.P9=GName:GF(a,b,c,d,e,f,g,h,i) :EndMacro
Prototype P10(A,b,c,D,E,F,G,H,i,j) : Macro M10(Name,A,b,c,D,E,F,G,H,i,j) : GF.P10=GName:GF(A,b,c,D,E,F,G,H,i,j) :EndMacro

Prototype P1F2(A,b.f,c,D) : Procedure M1F2(Name$,A,b,c,D) : GF.P1f2=GetFunction(#GDIP,Name$):GF(A,b,c,D) :EndProcedure ;Macro no va<<<<<<
Prototype P1F3(A,b.f,c,D,E) : Macro  M1F3(Name,A,b,c,D,E) : GF.P1f3=GName:GF(A,b,c,D,E) :EndMacro
Prototype P2FFFF(A,b,c.f,D.f,E.f,F.f) : Macro  M2FFFF(Name,A,b,c,D,E,F) : GF.P2FFFF=GName:GF(A,b,c,D,E,F) :EndMacro
Prototype P6FF(A,b,c,D,E,F,G.f,H.f) : Macro  M6FF(Name,A,b,c,D,E,F,G,H) : GF.P6FF=GName:GF(A,b,c,D,E,F,G,H) :EndMacro

Prototype PU1(A.p-unicode,b) : Macro MU1(Name,A,b) : GF.Pu1=GName:GF(A,b) :EndMacro
Prototype PU2(A.p-unicode,b,c) : Macro MU2(Name,A,b,c) : GF.PU2=GName:GF(A,b,c) :EndMacro
Prototype P1U5(A,b.p-unicode,c,D,E,F,G) : : Macro M1U5(Name,A,b,c,D,E,F,G) : GF.P1U5=GName:GF(A,b,c,D,E,F,G) :EndMacro

 
Procedure Way(Way,*P1.PointF,*P2.PointF,x,y,Wi,He) ;  LineBrush orientation 1 to 4 and legal combinations
    Select Way
        Case #Left :     A=x       :b=y+He:c=x+Wi:D=y+He
        Case #Top :     A=x+Wi:b=y       :c=x+Wi:D=y+He
        Case #Right :   A=x+Wi:b=y+He:c=x       :D=y+He
        Case #Bottom :A=x+Wi:b=y+He:c=x+Wi:D=y
        Case #Left|#Top  :A=x:b=y:c=x+Wi:D=y+He
        Case #Top|#Right  :    A=x+Wi       :b=y:c=x:D=y+He
        Case  #Right|#Bottom :A=x+Wi:b=y+He:c=x:D=y
        Case #Bottom|#Left  :A=x:b=y+He:c=x+Wi:D=y
    EndSelect
    *P1\x = A :  *P1\y = b 
    *P2\x =c:  *P2\y = D
EndProcedure 

Macro RGB2ARGB(RGB,Alpha) ; convert RGB to Alpha RGB
    Blue(RGB)|Green(RGB)<<8|Red(RGB)<<16|Alpha<<24
EndMacro

Macro ARGB(RGB=0,Transp=255) ; admitted with or without transparency
    RGB2ARGB(RGB,Transp)
EndMacro 

Macro InRim ;- InRim - set Rim inside bounding rect ;  need x, y, wi, he
    R2=Rim/2
    x+R2:y+R2:Wi-Rim:He-Rim
EndMacro
  
Macro GdipInit(Mode) ;- GdipInit(Mode)   ; Mode 1=Fast,2 =HiRes
    If _GDIP:GdipClose:EndIf
    If OpenLibrary(#GDIP,"GDIPlus.DLL")
        Gdip.Gdip_GdiplusStartupInput\GdiPlusVersion=1
        GF.GdiplusStartup = GetFunction(#GDIP, "GdiplusStartup") : GF(@_GDIP,@Gdip)
        CallFunction(#GDIP,"GdipCreateFromHDC",_Drawing,@_GRAPH)
        If Mode=2 : CallFunction(#GDIP,"GdipSetSmoothingMode",_GRAPH,Mode) : EndIf 
    Else
        MessageRequester("Error !","GDIPlus.DLL Not found",0)
    EndIf
EndMacro
    
Macro GdipClose  ;- GdipClose
    CallFunction(#GDIP,"GdipDeleteGraphics",_GRAPH)
    CallFunction(#GDIP,"GdiplusShutdown",_GDIP)
    CloseLibrary(#GDIP)
    _GDIP=0
EndMacro  

Macro BoundRect(x,y,Wi,He)  ;- BoundRect - assign bounding rectangle to R.RectF
    R.RectF\x = x  : R\y = y
    R\Wi = Wi : R\He = He
EndMacro
   
Macro IsGDIP ;- IsGDIP
    If _GDIP=0
        GdipInit(2)
        ;   MessageRequester("Warning !","GDIP+ not initialized !",0)
    EndIf
EndMacro

Macro SzTiles ;- SzTiles  ; tiles number and size
    If TilesX>1 :  TileWi=Wi/TilesX
    Else : TileWi=Wi
    EndIf
    If TilesY>1 : TileHe=He/TilesY
    Else :  TileHe=He
    EndIf
    TIL.Tiles\T[0]\x = x :TIL\T[0]\y = y
    TIL\T[1]\x = x+TileWi : TIL\T[1]\y = y
    TIL\T[2]\x = x+TileWi : TIL\T[2]\y = y+TileHe
    TIL\T[3]\x = x : TIL\T[3]\y = y+TileHe
EndMacro   
   
Macro Blend3
    blend.Blending\b[0]=ARGB1
    blend\b[1]=ARGB2
    blend\b[2]=ARGB3
EndMacro

Macro PosGradient ;- PosGradient
    ;PG.PosGrad\p[0]=0  ; must be 0
    PG.PosGrad\P[1] = Gradient
    PG\P[2] = 1     ; must be 1
EndMacro
   
Macro GdipFakeRect(x,y,X1,Y1,LineWidth,ARGB,StartCap=0,EndCap=0) ;- GdipFakeRect
    IsGDIP
    ;Trick:  this is a false rectangle, actually a line with optative caps
    ; x,y,x1,y1 are the endings of the central axis of the rectangle
    ; so you can draw diagonal rectangles
    GdipLine(x,y,X1,Y1,LineWidth,ARGB,StartCap,EndCap)
EndMacro
   
Procedure GdipText(Text.s,x,y,Wi,He,FontName.s,FontWSize.f,FontStyle,ARGB)
    IsGDIP
    MU2("GdipCreateFontFamilyFromName",FontName,0,@Family)
    M1F3("GdipCreateFont",Family,FontWSize,FontStyle,2,@Font)
    M2("GdipCreateSolidFill",ARGB(#Yellow,160),@Brush)
    BoundRect(x,y,Wi,He)   
    M1U5("GdipDrawString",_GRAPH,Text,-1,Font,R, #Null,Brush)
    M1("GdipDeleteFontFamily",Family)
    M1("GdipDeleteFont",Font)
    GdipDelBrush
EndProcedure

Procedure GdipLine(x,y,X1,Y1,LineWidth.f=1,ARGB=0,StartCap=0,EndCap=0)
    IsGDIP
    M1F2("GdipCreatePen1",ARGB,LineWidth.f,2,@Pen)
    M2("GdipSetPenStartCap",Pen,StartCap)
    M2("GdipSetPenEndCap",Pen,EndCap)
    M6("GdipDrawLineI",_GRAPH,Pen,x,y,X1,Y1)
    GdipDelPen
EndProcedure
   ; 
Procedure GdipFrame(x.f,y.f,Wi.f,He.f,LineWidth.f,ARGB)
    IsGDIP
    M1F2("GdipCreatePen1",ARGB,LineWidth,2,@Pen)
    M2FFFF("GdipDrawRectangle",_GRAPH,Pen,x,y,Wi,He)
    GdipDelPen
EndProcedure

Procedure GdipRectangle(x,y,Wi,He,Rim,RimARGB,ARGB,ARGB2,Way=1) ; way =  linebrush orientation 
    IsGDIP  :InRim 
    If ARGB2=-1:ARGB2=ARGB:EndIf
    Way(Way,p1.PointF,p2.PointF,x,y,Wi,He)
    M1F2("GdipCreatePen1",RimARGB,Rim,0,@GdipPen)
    M6("GdipCreateLineBrush",p1,p2,ARGB,ARGB2,1,@GdipBrush)
    M6("GdipFillRectangleI",_GRAPH, GdipBrush, x,y,Wi,He)
    M6("GdipDrawRectangleI",_GRAPH,GdipPen,x,y,Wi,He) ; frame
    GdipDelPen :  GdipDelBrush
EndProcedure
   
Procedure GdipRectangleBLEND(x,y,Wi,He,Gradient.f,ARGB1,ARGB2,ARGB3,TilesX=0,TilesY=0)
    IsGDIP: SzTiles: PosGradient : Blend3    ; blend 3 colors
    M4("GdipCreatePathGradientI",@TIL,4,0,@Brush)
    M4("GdipSetLinePresetBlend",Brush,@blend,@PG,3)
    M6("GdipFillRectangleI",_GRAPH, Brush, x,y,Wi,He)
    GdipDelBrush
EndProcedure

Procedure GdipRectangleFILL(x,y,Wi,He,Rim,RimARGB,ARGB1,ARGB2,ARGB3,TilesX=0,TilesY=0)
    IsGDIP: SzTiles 
    M1F2("GdipCreatePen1",RimARGB,Rim,0,@Pen)
    M4("GdipCreatePathGradientI",@TIL,4,0,@Brush)
    M6("GdipFillRectangleI",_GRAPH, Brush, x,y,Wi,He)
    M6("GdipDrawRectangleI",_GRAPH,Pen,x,y,Wi,He) ; frame
    GdipDelBrush :  GdipDelPen
EndProcedure
   
Procedure GdipEllipseBLEND(x,y,Wi,He,Gradient.f,ARGB1,ARGB2,ARGB3,TilesX=0,TilesY=0)
    IsGDIP: SzTiles: PosGradient :Blend3
    M4("GdipCreatePathGradientI",@TIL,4,0,@Brush)
    M4("GdipSetLinePresetBlend",Brush,@blend,@PG,3)
    M6("GdipFillEllipseI",_GRAPH, Brush, x,y,Wi,He)
    GdipDelBrush
EndProcedure
   
Procedure GdipEllipseGRADIENT(x,y,Wi,He,Rim,RimARGB,ARGB,TilesX=0,TilesY=0)
    IsGDIP: SzTiles  
    M1F2("GdipCreatePen1",RimARGB,Rim,0,@Pen)
    M4("GdipCreatePathGradientI",@TIL,4,0,@Brush)
    M2("GdipSetPathGradientCenterColor",Brush,ARGB)
    M6("GdipFillEllipseI",_GRAPH, Brush, x,y,Wi,He)
    M6("GdipDrawEllipseI", _GRAPH,Pen,x,y,Wi,He) ; frame
    GdipDelBrush :  GdipDelPen
EndProcedure
 
Procedure GdipDrawBezierI(x,y,X1,Y1,X2,Y2,X3,Y3,Rim,ARGB,StartCap=2,EndCap=2)
    IsGDIP
    M1F2("GdipCreatePen1",ARGB,Rim,0,@Pen)
    M2("GdipSetPenStartCap",Pen,StartCap)
    M2("GdipSetPenEndCap",Pen,EndCap)
    M10("GdipDrawBezierI",_GRAPH, Pen,x,y,X1,Y1,X2,Y2,X3,Y3)
    GdipDelPen
EndProcedure    

Procedure GDIPLoadImage(IMG$)
    MU1("GdipCreateBitmapFromFile",IMG$, @Image)
    ProcedureReturn Image
EndProcedure 

Procedure GdipDrawPieI(x,y,Wi,He,startAngle.f,sweepAngle.f,Rim=1,ARGB=0)
    IsGDIP:SzTiles
    M1F2("GdipCreatePen1",ARGB,Rim,0,@Pen)
    M4("GdipCreatePathGradientI",@TIL,4,0,@Brush)
    M2("GdipSetPathGradientCenterColor",Brush,ARGB)
    M6FF("GdipFillPieI",_GRAPH,Brush,x,y,Wi,He,startAngle,sweepAngle)
    M6FF("GdipDrawPieI",_GRAPH,Pen,x,y,Wi,He,startAngle,sweepAngle)
    GdipDelBrush :   GdipDelPen
EndProcedure   

Procedure GdipRectangleGRADIENT(x,y,Wi,He,ARGB,TilesX=0,TilesY=0)
    IsGDIP: SzTiles 
    M4("GdipCreatePathGradientI",@TIL,4,0,@Brush)
    M2("GdipSetPathGradientCenterColor",Brush,ARGB)
    M6("GdipFillRectangleI",_GRAPH, Brush, x,y,Wi,He)
    GdipDelBrush
EndProcedure

Procedure GdipEllipse(x,y,Wi,He,Rim,RimARGB,ARGB1,ARGB2,Way=1)
    IsGDIP  :InRim 
    Way(Way,p1.PointF,p2.PointF,x,y,Wi,He)
    M1F2("GdipCreatePen1",RimARGB,Rim,0,@GdipPen)
    M6("GdipCreateLineBrush",p1,p2,ARGB1,ARGB2,1,@GdipBrush)
    M6("GdipFillEllipseI",_GRAPH, GdipBrush, x,y,Wi,He)
    M6("GdipDrawEllipseI", _GRAPH,GdipPen,x,y,Wi,He) ; frame
    GdipDelPen :  GdipDelBrush
EndProcedure

Procedure AquaEllip(Wi,He,RGB,Alpha=0)   
    IsGDIP
    Alpha=255-Alpha
    GdipEllipse(0,0,Wi,He,1,ARGB(RGB,Alpha/2),ARGB(RGB,Alpha),ARGB(RGB,255),#Top)  ; Superficie
    GdipEllipse(Wi/4,He/3,Wi-Wi/2,He/1.6,0,0,ARGB(#White,0),ARGB(#White,50),#Top)  ; reflejo inf
    GdipEllipse(Wi/8,He/20,Wi-Wi/4,He/2+He/20,0,0,ARGB(#White,Alpha),ARGB(RGB,Alpha/2),#Top)  ; reflejo sup
EndProcedure 

Procedure DrawIMGFromFile(IMG$,x,y)
    MU1("GdipCreateBitmapFromFile",IMG$, @IMG)
    M4("GdipDrawImageI",_GRAPH, IMG, x,y)
EndProcedure 

Procedure GdipDrawImage(IMG,x,y,Wi=-1,He=-1)
    If Wi<1 Or He<1
        M4("GdipDrawImageI",_GRAPH, IMG, x,y)
    Else
        M6("GdipDrawImageRectI",_GRAPH, IMG,  x,  y,  Wi,  He)   
    EndIf
EndProcedure 
   
   ;Test it  <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
   
hwnd=OpenWindow(0, 50, 50,700,500,"GdiPlus lines and shapes" , #WS_OVERLAPPEDWINDOW | #WS_MAXIMIZE)
IMG=CreateImage(-1,WindowWidth(0),WindowHeight(0),32)
CreateGadgetList(hwnd)
ImGad=ImageGadget(-1,0,0,0,0,0)
Wi=WindowWidth(0):He=WindowHeight(0)

A$= GetPathPart(ProgramFilename())
IMG$= Left(A$,FindString(A$,"\Compilers",1))+"Examples\Sources\data\PureBasic.bmp"
Gradient.f=1.23   
SetCursorPos_(Wi/2,He/2)
ARGB1=ARGB(Random($FFFFFF),40)  
ARGB2=ARGB(Random($FFFFFF),80)
ARGB3=ARGB(Random($FFFFFF),100)
StartCap=2  ;2=Round Cap  ; 0 = No cap
EndCap=20  ;ArrowHead Cap  ; more caps in GDK GDI+ reference
Text.s="Multiline Text clipped 123456 hola hola testing GdiPluuuuuuuuuus!!!"
style=2
     
Repeat
    EV= WindowEvent()
    If _Drawing  : StopDrawing() : _Drawing=0 : EndIf
    _Drawing=StartDrawing(ImageOutput(IMG))
    GdipInit(2)  ; 0 or 1=fast; 2= HighRes
    
    Img1=GDIPLoadImage(IMG$)  ; or put here your image <<<<<<<<<<<<<<<<<<<
    
    _MX=WindowMouseX(0):_MY=WindowMouseY(0)
    If _MX>1 And _MY>1
        GdipRectangle(0,0,Wi,He,0,0,ARGB(_MX%255),ARGB(_MY%255),2)  ;BACKGROUND
        GdipRectangleFILL(_MX*2,_MY*2,Wi/5,He/4,2,ARGB(#Cyan,80),ARGB2,ARGB3,ARGB1)
        AquaEllip(WindowWidth(0)-100,_MY,#Blue,110)
        AquaEllip(_MX,80,ARGB(#Blue,_MX))
        GdipDrawImage(Img1,_MY,_MX,600,200) ; ojo admite ambos o ningun wi, he <<<<<<<<<<
        GdipEllipseBLEND(_MX,_MY,300,100,Gradient,Tiles,ARGB1,ARGB2,ARGB3)
        GdipEllipseGRADIENT(WindowWidth(0)-300,_MY+300,_MX/4,He/2,24,ARGB2,ARGB3)
        GdipFrame(200,_MY,400,100,6,ARGB($654321,_MX))  ; frame
        GdipLine(200,50,WindowWidth(0)-200,_MX/3,34,ARGB($334455,100),EndCap,StartCap)
        GdipLine(_MY,500,WindowWidth(0)-200,100,14,ARGB3,StartCap,EndCap)
        GdipFakeRect(200,200,400,500,_MY/2,ARGB1,2,2)
        GdipDrawBezierI(_MX,100,_MX,_MY,500,_MY,WindowWidth(0)-_MX,500,25,ARGB(#Red,100))
        GdipDrawPieI(50,200,200,200,_MY,_MX,4,ARGB(#Red,_MX))
        GdipText(Text,200,200,_MX,100,"arial",33,0,ARGB($850700,127))
        GdipRectangle(_MX,_MY,400,200,2,ARGB(#Red),ARGB(#Magenta,155),ARGB(#Green,85))
        GdipText("Another Text 123456 hola hola testing GdiPlus is sloooooow++++!!!",200,400,_MY,100,"arial",16,style,$FFFFFACD ) ;#Gdip_LemonChiffon)
        StopDrawing():_Drawing=0
        SetGadgetState(ImGad,ImageID(IMG))      
    EndIf
Until EV=#WM_CLOSE 
GdipClose
End

Posted: **Thu Nov 09, 2006 8:17 pm**

Looking great already

PureBasic Forums - English

GdiPlus easy

GDI+ updated

GDI+ for PB4