PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

GdiPlus easy

https://www.purebasic.fr/english/viewtopic.php?t=18175

Page 1 of 2

GdiPlus easy

Posted: Sat Dec 10, 2005 6:40 pm
by einander

Code: Select all

; by einander
; Updated january 14 - 2006
; PB 3.94 
; Thanks Andreas from PB German Forum For the Text Procedures
   
Global _GDIP,_GRAPH
#GDIP = 0

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

Structure Gdip_RectF
  Left.f
  Top.f
  Width.f
  Height.f
EndStructure

Procedure ARGB(Transparecy,RGB) ; convert RGB to Alpha RGB
  ProcedureReturn Blue(RGB)|Green(RGB)<<8|Red(RGB)<<16|Transparecy<<24
EndProcedure

Procedure GdipInit(Mode,DC)
  If OpenLibrary(#GDIP,"GDIPlus.DLL")
    Gdip.Gdip_GdiplusStartupInput\GdiPlusVersion=1
    CallFunction(#GDIP,"GdiplusStartup",@_GDIP,@Gdip,0)
    CallFunction(#GDIP,"GdipCreateFromHDC",DC,@_GRAPH)
    If Mode : CallFunction(#GDIP,"GdipSetSmoothingMode",_GRAPH,Mode) : EndIf   ; Mode 1=fast,2 =hires
    ProcedureReturn 1
  EndIf
  ProcedureReturn 0
EndProcedure

!Macro GdipClose
!{
CallFunction(#GDIP,"GdipDeleteGraphics",_GRAPH)
CallFunction(#GDIP,"GdiplusShutdown",_GDIP)
CloseLibrary(#GDIP)
!}

Procedure GdipText(Text$,x,y,Width,Height,FontName$,FontWSize.f,FontStyle,ARGB)
  Buff = (Len(FontName$)*2)+2
  *Buff = CallFunction(#GDIP,"GdipAlloc",Buff)
  MultiByteToWideChar_(#CP_ACP,0,FontName$,-1,*Buff,Buff)
  CallFunction(#GDIP,"GdipCreateFontFamilyFromName",*Buff,#Null,@Family)
  CallFunction(#GDIP,"GdipFree",*Buff)
  CallFunction(#GDIP,"GdipCreateFont",Family,FontWSize,FontStyle,2,@Font)
  CallFunction(#GDIP,"GdipCreateSolidFill",ARGB,@Brush)
  
  R.Gdip_RectF\Left = x  ; bounding rectangle
  R\Top = y
  R\Width = Width
  R\Height = Height
  Buff = Len(Text$)*2
  *Buff = CallFunction(#GDIP,"GdipAlloc",Buff)
  MultiByteToWideChar_(#CP_ACP,0,Text$,-1,*Buff,Buff)
  CallFunction(#GDIP,"GdipDrawString",_GRAPH,*Buff,-1,Font,R, #Null,Brush)
  
  CallFunction(#GDIP,"GdipFree",*Buff)
  CallFunction(#GDIP,"GdipDeleteFontFamily",Family)
  CallFunction(#GDIP,"GdipDeleteFont",Font)
  CallFunction(#GDIP,"GdipDeleteBrush",Brush)
EndProcedure

Procedure GdipLine(x,y,x1,y1,LineWidth.f,ARGB,StartCap,EndCap)
  CallFunction(#GDIP,"GdipCreatePen1",ARGB,LineWidth,2,@Pen)  
  CallFunction(#GDIP,"GdipSetPenStartCap",Pen,StartCap)
  CallFunction(#GDIP,"GdipSetPenEndCap",Pen,EndCap)
  CallFunction(#GDIP,"GdipDrawLineI",_GRAPH,Pen,x,y,x1,y1)
  CallFunction(#GDIP,"GdipDeletePen",Pen)
EndProcedure

Procedure GdipRoundRect(x,y,x1,y1,Width.f,ARGB)
  ; this is a false rectangle, actually a line with rounded caps
  ; x,y,x1,y1 are the ends of the central axis of the rectangle
  ; so you can draw diagonal rounded rectangles
  CallFunction(#GDIP,"GdipCreatePen1",ARGB,Width,2,@Pen)  
  CallFunction(#GDIP,"GdipSetPenStartCap",Pen,2)
  CallFunction(#GDIP,"GdipSetPenEndCap",Pen,2)
  CallFunction(#GDIP,"GdipDrawLineI",_GRAPH,Pen,x,y,x1,y1)
  CallFunction(#GDIP,"GdipDeletePen",Pen)
EndProcedure
 
Procedure GdipRectangle(x.f,y.f,Width.f,Height.f,LineWidth.f,ARGB)
  CallFunction(#GDIP,"GdipCreatePen1",ARGB,LineWidth,2,@Pen)  
  CallFunction(#GDIP,"GdipDrawRectangle",_GRAPH,Pen,x,y,Width,Height)
  CallFunction(#GDIP,"GdipDeletePen",Pen)
EndProcedure

Procedure GdipRectangleBLEND(x,y,Width,Height,Gradient.f,Tiles.f,ARGB1,ARGB2,ARGB3)
  Dim P.POINT(3) ; tile coords
  If Tiles : Wi=Width/Tiles : He=Height/Tiles
  Else : Wi=Width : He=Height
  EndIf
  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
  Dim Blend(2)
  Blend(0) = ARGB1
  Blend(1) = ARGB2
  Blend(2) = ARGB3
  Dim Pos.f(2)
  ;  Pos(0)=0  ; must be 0
  Pos(1) = Gradient
  Pos(2) = 1     ; must be 1
  
  CallFunction(#GDIP,"GdipCreatePathGradientI",@P(),4,0,@Brush)
  CallFunction(#GDIP,"GdipSetLinePresetBlend",Brush,Blend(),Pos(),3)
  CallFunction(#GDIP,"GdipFillRectangleI",_GRAPH, Brush, x,y,Width,Height)
  CallFunction(#GDIP,"GdipDeleteBrush",Brush)
  Dim Blend(0):Dim Pos.f(0)
EndProcedure

Procedure GdipEllipseBLEND(x,y,Width,Height,Gradient.f,Tiles.f,ARGB1,ARGB2,ARGB3)
  Dim P.POINT(3) ; tile coords
  If Tiles : Wi=Width/Tiles : He=Height/Tiles
  Else : Wi=Width : He=Height
  EndIf
  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
  Dim Blend(2)
  Blend(0) = ARGB1
  Blend(1) = ARGB2
  Blend(2) = ARGB3
  Dim Pos.f(2)
  ;  Pos(0)=0  ; must be 0
  Pos(1) = Gradient
  Pos(2) = 1     ; must be 1
  
  CallFunction(#GDIP,"GdipCreatePathGradientI",@P(),4,0,@Brush)
  CallFunction(#GDIP,"GdipSetLinePresetBlend",Brush,Blend(),Pos(),3)
  CallFunction(#GDIP,"GdipFillEllipseI",_GRAPH, Brush, x,y,Width,Height)
  CallFunction(#GDIP,"GdipDeleteBrush",Brush)
  Dim Blend(0):Dim Pos.f(0)
EndProcedure

Procedure GdipEllipseGRADIENT(x,y,Width,Height,Gradient.f,Tiles.f,ARGB)
  Dim P.POINT(3) ; tile coords
  If Tiles : Wi=Width/Tiles : He=Height/Tiles
  Else : Wi=Width : He=Height
  EndIf
  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
  Dim Pos.f(2)
  ;  Pos(0)=0  ; must be 0
  Pos(1) = Gradient
  Pos(2) = 1     ; must be 1
  
  CallFunction(#GDIP,"GdipCreatePathGradientI",@P(),4,0,@Brush)
  CallFunction(#GDIP,"GdipSetPathGradientCenterColor",Brush,ARGB)
  
  CallFunction(#GDIP,"GdipFillEllipseI",_GRAPH, Brush, x,y,Width,Height)
  CallFunction(#GDIP,"GdipDeleteBrush",Brush)
  Dim Blend(0):Dim Pos.f(0)
EndProcedure

Procedure GdipRectangleGRADIENT(x,y,Width,Height,Gradient.f,Tiles.f,ARGB)
  Dim P.POINT(3) ; tile coords
  If Tiles : Wi=Width/Tiles : He=Height/Tiles
  Else : Wi=Width : He=Height
  EndIf
  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
  Dim Pos.f(2)
  ;  Pos(0)=0  ; must be 0
  Pos(1) = Gradient
  Pos(2) = 1     ; must be 1
  
  CallFunction(#GDIP,"GdipCreatePathGradientI",@P(),4,0,@Brush)
  CallFunction(#GDIP,"GdipSetPathGradientCenterColor",Brush,ARGB)
  
  CallFunction(#GDIP,"GdipFillRectangleI",_GRAPH, Brush, x,y,Width,Height)
  CallFunction(#GDIP,"GdipDeleteBrush",Brush)
  Dim Blend(0):Dim Pos.f(0)
EndProcedure

;<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
;Test


_X=GetSystemMetrics_(#SM_CXSCREEN)-8 : _Y=GetSystemMetrics_(#SM_CYSCREEN)-68
hWnd=OpenWindow(0, 50, 50,_X-100,_Y-100 , #WS_OVERLAPPEDWINDOW ,"GdiPlus lines and shapes")
CreateImage(0,WindowWidth(),WindowHeight())

ImgDC=StartDrawing(ImageOutput())

If GdipInit(2,ImgDC)  ; 1=fast; 2= HighRes 
  
  x=100:y=100:Width=600:Height=250
  Gradient.f=1.23    
  GdipRectangle(0,0,WindowWidth(),WindowHeight(),WindowHeight(),ARGB(255,0)) ; clear screen color black
  
  ARGB1=ARGB(127,#yellow)  ; first param = Transparency
  ARGB2=ARGB(80,Random($FFFFFF))
  ARGB3=ARGB(164,Random($FFFFFF))
  Tiles.f=1  ; 0 or 1 no tiles
  
  GdipRectangleGRADIENT(x,y,Width,Height,Gradient,Tiles,ARGB(127,$33BB22))
  
  GdipEllipseBLEND(x,y+300,Width,Height,Gradient,Tiles,ARGB1,ARGB2,ARGB3)
  
  GdipRectangleBLEND(x+500,y+300,Width/3,Height/3,Gradient,Tiles,ARGB2,ARGB3,ARGB1)
  
  GdipEllipseGRADIENT(x+550,y+100,Width/4,Height/2,Gradient,Tiles,ARGB(100,#Blue))
  
  GdipRectangle(200,200,400,100,6,ARGB(255,Random($FFFFFF)))  ; frame
  
  StartCap=2  ;2=Round Cap  ; 0 = No cap
  EndCap=20  ;ArrowHead Cap 
  GdipLine(100,50,WindowWidth()-200,200,34,ARGB(127,#Green),EndCap,StartCap)
  
  GdipLine(100,500,WindowWidth()-200,100,14,ARGB(127,#Cyan),StartCap,EndCap)
  
  GdipRoundRect(200,200,400,500,100,ARGB(127,#Magenta))
  
  Style=0
  GdipText("Multiline Text clipped 123456 hola hola testing GdiPluuuuuuuuuus!!!",200,200,400,100,"arial",33,Style,ARGB(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
Else
  MessageRequester ("Error!","Gdip+ not initialized",0)
EndIf
StopDrawing()

Repeat
  Ev=WindowEvent()
  If Ev = #WM_PAINT
    StartDrawing(WindowOutput())
    DrawImage(UseImage(0), 0, 0)
    StopDrawing()
 EndIf
    Delay(0)
   
  Until Ev= #PB_Event_CloseWindow
End
[/code]

Posted: Sat Dec 10, 2005 11:40 pm
by va!n
Gdip.Gdip_GdiplusStartupInput << line 14, structure not found

Posted: Sun Dec 11, 2005 12:07 am
by dagcrack
Bah who needs GDI+ ...
:wink: (but, you know me, I'm serious even if it sounds like a joke).

Posted: Sun Dec 11, 2005 12:56 am
by Sparkie
@va!n: Here's the missing Structure...

Code: Select all

Structure Gdip_GdiplusStartupInput 
  GdiplusVersion.l 
  DebugEventCallback.l 
  SuppressBackgroundThread.l 
  SuppressExternalCodecs.l 
EndStructure
@dagcrack: I, for one, find GDI+ very useful in some of my projects.

Posted: Sun Dec 11, 2005 1:01 am
by einander
Thanks Sparkie!

I've deleted the structure declaration, because PB Says "Structure already declared".

I add it now to the surce.
Cheers.

Posted: Sun Dec 11, 2005 1:09 am
by dell_jockey
Einander,

thanks a lot for that code! This board keeps amazing me for providing timely solutions to problems I've been struggling with....

Thanks again!

Posted: Sun Dec 11, 2005 1:16 am
by Sparkie
You're welcome einander, and nice use of GDI+ on your part. :)

Posted: Sun Dec 11, 2005 9:35 am
by Blade
Transparencies and anti aliasing! Incredble!
If similar commands would be available cross platform, PB graphic abilities would make a big leap forward... :-)

Posted: Sun Dec 11, 2005 11:02 am
by dell_jockey
Blade wrote:Transparencies and anti aliasing! Incredble!
If similar commands would be available cross platform, PB graphic abilities would make a big leap forward... :-)
cross platform would be even better. I'm trying to program an instrument dial, where multiple elements are moving on multiple graphical planes. The thing should look like an artificial horizon as used in aircraft. No luck so far to get it off the ground.... :)

The GDI+ code revitalized my interest in trying to get it working...

Posted: Sun Dec 11, 2005 11:54 am
by einander
GdipFillRectangle, with and without Transparency

Code: Select all

Procedure GdipFillRectangle(x.f,y.f,Width.f,Height.f,Transparency,RGB)
    Color=ARGB(Transparency,RGB)
    CallFunction(#GDIP,"GdipCreateSolidFill",Color,@Brush)    
    CallFunction(#GDIP,"GdipFillRectangle",_GRAPH,Brush,x,y,Width,Height)
    CallFunction(#GDIP,"GdipDeleteBrush",Brush)
EndProcedure 


Procedure GdipFillRectangleARGB(x.f,y.f,Width.f,Height.f,ARGB)
    CallFunction(#GDIP,"GdipCreateSolidFill",ARGB,@Brush)    
    CallFunction(#GDIP,"GdipFillRectangle",_GRAPH,Brush,x,y,Width,Height)
    CallFunction(#GDIP,"GdipDeleteBrush",Brush)
EndProcedure

Posted: Sun Dec 11, 2005 5:58 pm
by DoubleDutch
Is GDI+ on all versions of windows, if not - which ones is it available with?

Posted: Sun Dec 11, 2005 6:31 pm
by einander
@DoubleDutch:
Supported Operating Systems: Windows 2000; Windows 98; Windows ME; Windows NT; Windows XP

System Requirements: Microsoft® Windows® Millennium Edition (Windows Me), Microsoft Windows® 2000 (Professional or Server), Microsoft Windows NT® version 4.0 (Professional or Server), or Windows 98.

Gdiplus.dll is included with Windows XP.
GDI+ is available as a redistributable for Windows NT 4.0 SP6, Windows 2000, Windows 98, and Windows Me. To download the latest redistributable, see http://www.microsoft.com/msdownload/pla ... redist.htm .
If you are redistributing GDI+ to a downlevel platform or a platform that does not ship with that version of GDI+ natively, install Gdiplus.dll in your application directory. This puts it in your address space, but you should use the linker's /BASE option to rebase the Gdiplus.dll to prevent address space conflict.

Posted: Sun Dec 11, 2005 9:14 pm
by blueznl
that sounds like chinese to me...

Posted: Sun Dec 11, 2005 11:16 pm
by dell_jockey
blueznl wrote:that sounds like chinese to me...
Well, since you're into things Asian... ;)

Posted: Mon Dec 12, 2005 1:42 am
by DoubleDutch
einander: Thanks for the info, I've downloaded the dll for the pre-XP machines - If I add gdi+ code then I will probabily make it optional in the program. If they have the dll then it will just look much nicer/have more functions.

-Anthony
All times are UTC+01:00
Page 1 of 2

Powered by phpBB® Forum Software © phpBB Limited