GdiPlus easy

einander · Post by **einander** » Sat Dec 10, 2005 6:40 pm

; 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]

va!n · Post by **va!n** » Sat Dec 10, 2005 11:40 pm

Gdip.Gdip_GdiplusStartupInput << line 14, structure not found

dagcrack · Post by **dagcrack** » Sun Dec 11, 2005 12:07 am

Bah who needs GDI+ ...

(but, you know me, I'm serious even if it sounds like a joke).

Sparkie · Post by **Sparkie** » Sun Dec 11, 2005 12:56 am

@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.

einander · Post by **einander** » Sun Dec 11, 2005 1:01 am

Thanks Sparkie!

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

I add it now to the surce.
Cheers.

dell_jockey · Post by **dell_jockey** » Sun Dec 11, 2005 1:09 am

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!

Sparkie · Post by **Sparkie** » Sun Dec 11, 2005 1:16 am

You're welcome einander, and nice use of GDI+ on your part.

Blade · Post by **Blade** » Sun Dec 11, 2005 9:35 am

Transparencies and anti aliasing! Incredble!
If similar commands would be available cross platform, PB graphic abilities would make a big leap forward...

dell_jockey · Post by **dell_jockey** » Sun Dec 11, 2005 11:02 am

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...

einander · Post by **einander** » Sun Dec 11, 2005 11:54 am

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

DoubleDutch · Post by **DoubleDutch** » Sun Dec 11, 2005 5:58 pm

Is GDI+ on all versions of windows, if not - which ones is it available with?

einander · Post by **einander** » Sun Dec 11, 2005 6:31 pm

@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.

blueznl · Post by **blueznl** » Sun Dec 11, 2005 9:14 pm

that sounds like chinese to me...

dell_jockey · Post by **dell_jockey** » Sun Dec 11, 2005 11:16 pm

blueznl wrote:that sounds like chinese to me...

Well, since you're into things Asian...

DoubleDutch · Post by **DoubleDutch** » Mon Dec 12, 2005 1:42 am

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