Gdip 3D Frames

Share your advanced PureBasic knowledge/code with the community.
Post Reply
User avatar
einander
Enthusiast
Enthusiast
Posts: 744
Joined: Thu Jun 26, 2003 2:09 am
Location: Spain (Galicia)

Gdip 3D Frames

Post by einander »

Code: Select all

;Gdiplus 3D Frames
;by einander
;PB 4.20 beta 2 - march 20008

Frame procedure are in the last 40 lines;
;Previous lines are common to many Gdip functions. 
;Most of the prototypes (and associated Macros) are unused here, 
;but are useful to call more Gdip functions.  
;Try angles bigger than sides to see uncommon shapes. 
;--------------------------------------
;Start of Include GdipBlackBoxes 
Global _Img,_ImGad,_DRAWING,_GDIP,_GRAPH ,_Quit
#GDIP=1      

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

Structure RectF : X.f : Y.f : Wi.f : He.f : EndStructure

;Gdip Prototypes and Macros for each parameter combination; add more if needed
;Pn 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)
Macro GName : GetFunction(#GDIP,Name) : EndMacro   ;- Gname

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 P1F1(A,b.f,c)      :Macro M1F1(Name,A,b,c) : GF.P1f1=GName:GF(A,b,c) :EndMacro  
Prototype P1FF(A,b.f,c.f)    :Macro M1FF(Name,A,b,c) : GF.P1ff=GName:GF(A,b,c) :EndMacro  
Prototype P1FF1(A,b.f,c.f,d) : Macro M1FF1(Name,A,b,c,d) : GF.P1ff1=GName:GF(A,b,c,d) :EndMacro 
Prototype P1FFFFFF(A,b.f,c.f,d.f,E.f,F.f,G.f) : Macro M1FFFFFF(Name,A,b,c,d,E,F,G) : GF.P1ffffff=GName:GF(A,b,c,d,E,F,G) :EndMacro  
Prototype P1F2(A,b.f,c,d)    :Macro M1F2(Name,A,b,c,d) : GF.P1f2=GName:GF(A,b,c,d) :EndMacro 
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 P2F(A,b,c.f) :Macro M2F(Name,A,b,c) : GF.P2F=GName:GF(A,b,c) :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 P2FFFFFF(A,b,c.f,d.f,E.f,F.f,G.f,H.f) :Macro  M2FFFFFF(Name,A,b,c,d,E,F,G,H) : GF.P2FFFFFF=GName:GF(A,b,c,d,E,F,G,H) :EndMacro
Prototype P2FFFFFFFF4(A,b,c.f,d.f,E.f,F.f,G.f,H.f,i.f,j.f,K,L,M,n) :Macro  M2FFFFFFFF4(Name,A,b,c,d,E,F,G,H,i,j,K,L,M,n) : GF.P2FFFFFFFF4=GName:GF(A,b,c,d,E,F,G,H,i,j,K,L,M,n) :EndMacro

Prototype P3F(A,b,c,d.f)            :Macro M3F(Name,A,b,c,d) :GF.P3F=GName:GF(A,b,c,d) :EndMacro
Prototype P5FF(A,b,c,d,E,F.f,G.f)   :Macro M5FF(Name,A,b,c,d,E,F,G) : GF.P5FF=GName:GF(A,b,c,d,E,F,G) :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
Prototype P1U7(A,b.p-Unicode,c,d,E,F,G,H,i):Macro M1U7(Name,A,b,c,d,E,F,G,H,i) : GF.P1U7=GName:GF(A,b,c,d,E,F,G,H,i) :EndMacro

Macro GdipDelPen     : M1("GdipDeletePen",GpPen)    :EndMacro 
Macro GdipDelBrush   : M1("GdipDeleteBrush",GpBrush):EndMacro 
Macro GdipDelPath    : M1("GdipDeletePath",GpPath)  :EndMacro 
Macro GdipDelRegion  : M1("GdipDeleteRegion",GpRgn) :EndMacro 

Macro RRGB :Random(#White):EndMacro  ;- RRGB - get Random color

Macro DrawIMG(IMG) ;- DrawIMG(IMG)
If _DRAWING:StopDrawing():EndIf
_DRAWING=StartDrawing(ImageOutput(IMG))
EndMacro

Macro STOPDRAW  ;- StopDraw
If _DRAWING:StopDrawing():_DRAWING=0:EndIf
EndMacro

Macro WaitKey 
   Repeat
      Select WaitWindowEvent()
         Case #WM_KEYDOWN : Break
         Case #WM_CLOSE
            _Quit=#True:Break
      EndSelect
   ForEver
EndMacro
   
Procedure  ClsImg(IMG,RGB=0) ;-ClsImg(IMG,RGB=0) 
   DrawIMG(IMG)
   Box(0,0,ImageWidth(IMG),ImageHeight(IMG),RGB)
EndProcedure 
   
Procedure.f MinF(A.f,b.f)
   If A<b:ProcedureReturn A:EndIf
   ProcedureReturn b
EndProcedure 
   
Macro GdipClose  ;- GdipClose
   If _GDIP
      M1("GdipDeleteGraphics",_GRAPH)
      M1("GdiplusShutdown",_GDIP)
      CloseLibrary(#GDIP)
      _GDIP=0
   EndIf
EndMacro  
   
Macro GdipInit(Mode=2) ;- GdipInit(Mode)   ; Mode 1=Fast,2 =HiRes
   GdipClose
   If OpenLibrary(#GDIP,"GDIPlus.DLL")
      Gdip.GdipStart\GdiPlusVersion=1
      Gdip\DebugEventCallback = 0
      Gdip\SuppressBackgroundThread = 0
      Gdip\SuppressExternalCodecs = 0
      GF.GdiplusStartup = GetFunction(#GDIP, "GdiplusStartup") : GF(@_GDIP,@Gdip)
      M2("GdipCreateFromHDC",_DRAWING,@_GRAPH)
      If Mode=2 :  M2("GdipSetSmoothingMode",_GRAPH,Mode) :  EndIf 
   Else
      MessageRequester("Error !","GDIPlus.DLL Not found",0)
   EndIf
EndMacro
   
Macro IsGDIP : If _GDIP=0 :  GdipInit(2) :  EndIf : EndMacro
   
Macro ARGB(RGB=0,Alpha=255)  ;- ARGB((RGB=0,Transp=255)
   RGB2ARGB(RGB,Alpha)
EndMacro 
   
Macro RGB2ARGB(RGB,Alpha) ;- RGB2ARGB(RGB,Alpha) - convert RGB to Alpha RGB
   Blue(RGB)|Green(RGB)<<8|Red(RGB)<<16|Alpha<<24
EndMacro
   
Macro GPen(ARGB,LineWidth,StartCap=2,EndCap=2) ;- GPen(ARGB,LineWidth,StartCap=2,EndCap=2)
   M1F2("GdipCreatePen1",ARGB,LineWidth,2,@GpPen)
   M2("GdipSetPenStartCap",GpPen,StartCap)
   M2("GdipSetPenEndCap",GpPen,EndCap)
EndMacro    
   
Procedure RoundedAux(X.f,Y.f,Wi.f,He.f,EllipX.f=0.0,EllipY.f=-1)
   ; Roundedaux - Private - RET GpPath for RoundFrame, RoundBox, RoundRect
   If EllipX=<1:EllipX=1:EndIf ;  EllipX, EllipY= Wi, he of ellipse used to draw rounded corners
   If EllipY=<1:EllipY=EllipX:EndIf
   M2("GdipCreatePath",1, @GpPath)
   M1FFFFFF("GdipAddPathArc",GpPath,X,Y,EllipX,EllipY,180.0,90.0) ;left top
   M1FFFFFF("GdipAddPathArc",GpPath,X+Wi-EllipX,Y,EllipX,EllipY,270.0,90.0) ;right top
   M1FFFFFF("GdipAddPathArc",GpPath,X+Wi-EllipX,Y+He-EllipY,EllipX,EllipY,0.0,90.0) ;right bottom
   M1FFFFFF("GdipAddPathArc",GpPath,X,Y+He-EllipY,EllipX,EllipY,90.0,90.0) ;left bottom
   M1("GdipClosePathFigure",GpPath) 
   ProcedureReturn GpPath
EndProcedure

   
Procedure GdipShadowFrame(X.f,Y.f,Wi.f,He.f,Rim.f,ARGB1,ARGB2,EllipX.f=0,EllipY.f=-1)
   IsGDIP 
   If EllipY=-1:EllipY=EllipX:EndIf
   GPen(ARGB1,Rim)
   SetRect_(rc.RectF,0,0,Wi,He)
   M6("GdipCreateLineBrushFromRect",rc, ARGB1,ARGB2, 2 ,3 , @GpBrush)
   GpPath=RoundedAux(X,Y,Wi,He,EllipX,EllipY)   
   M2("GdipSetPenBrushFill",GpPen,GpBrush)
   M3("GdipDrawPath",_GRAPH, GpPen, GpPath)
   GdipDelPen:GdipDelBrush:GdipDelPath
EndProcedure

; End of Include GdipBlackBoxes
;------------------------------
   
Procedure Gdip3DShadowFrame(X,Y,Wi,He,Rim,ARGB,EllipX=0,EllipY=-1)
   If EllipX=0 :EllipX=Wi:EndIf
   If EllipY=-1:  EllipY=He :  EndIf
   R2.f=Rim/2:R4.f=Rim/4
   Shadow=ARGB(0,100)
   GdipShadowFrame(X,Y,Wi,He,Rim,Shadow,ARGB,EllipX,EllipY)
   GdipShadowFrame(X+R4,Y+R4,Wi-R2,He-R2,Rim,ARGB,Shadow,EllipX-R2,EllipY-R2)
   StatusBarText(0,0,"Width :"+Str(Wi)+"---  Height : "+Str(He)+"---  Rim : "+Str(Rim)+"--- EllipX : "+Str(EllipX)+"--- EllipY : "+Str(EllipY)+"--- ARGB= $"+Hex(ARGB) )
EndProcedure 
   
   ;Test it <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
hwnd=OpenWindow(0, 100, 100,700,500 ,"<SPC> to change frame",  #WS_OVERLAPPEDWINDOW | #WS_MAXIMIZE) 
CreateGadgetList(hwnd) 
Wi=WindowWidth(0):He=WindowHeight(0)
CreateStatusBar(0, hwnd)
AddStatusBarField(Wi)
   
_ImGad=ImageGadget(-1,0,0,0,0,0) 
_Img=CreateImage(-1,Wi,He-20,32)
   
Xcenter=Wi/2:Ycenter=He/2
Repeat 
   If GetAsyncKeyState_(#VK_ESCAPE):Break:EndIf
   Ev=WaitWindowEvent() 
   DrawIMG(_Img)
   ClsImg(_Img,0)
   iWi.f=Random(600)+20
   iHe.f=Random(500)+20
   Rim.f=MinF(iWi,iHe)/Random(20)+4
   AngleX=Random(iWi)
   AngleY=Random(iHe)
   Gdip3DShadowFrame(Xcenter-iWi/2,Ycenter-iHe/2,iWi,iHe,Rim,ARGB(RRGB,Random(100)+155),AngleX,AngleY)
   STOPDRAW
   SetGadgetState(_ImGad,ImageID(_Img))
   Delay(200)
   WaitKey
Until Ev=#WM_CLOSE Or _Quit 
GdipClose
  
End
Top
User avatar
DoubleDutch
Addict
Addict
Posts: 3220
Joined: Thu Aug 07, 2003 7:01 pm
Location: United Kingdom
Contact:
Contact DoubleDutch

Post by DoubleDutch »

Looks good. :)
https://deluxepixel.com <- My Business website
https://reportcomplete.com <- School end of term reports system
Top
#NULL
Addict
Addict
Posts: 1499
Joined: Thu Aug 30, 2007 11:54 pm
Location: right here

Post by #NULL »

yes, looks nice. :D
Top
User avatar
Rings
Moderator
Moderator
Posts: 1435
Joined: Sat Apr 26, 2003 1:11 am

Post by Rings »

looks very good, thx for sharing
SPAMINATOR NR.1
Top
Dare
Addict
Addict
Posts: 1965
Joined: Mon May 29, 2006 1:01 am
Location: Outback

Post by Dare »

Nice
Dare2 cut down to size
Top
Poshu
Enthusiast
Enthusiast
Posts: 459
Joined: Tue Jan 25, 2005 7:01 pm
Location: Canada

Post by Poshu »

Wow! some code from the future! I'm impressed people still use PB in 20008. How come it's possible? Did Fred got cryogened? :P
Nice & thanks for sharing ^___^
Top
Post Reply

Return to “Tricks 'n' Tips”