Proportional distance with GdiPlus

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

Proportional distance with GdiPlus

Post by einander »

Code: Select all

;Proportional distance with GdiPlus
;by einander
; PB 4.02 - may 22 - 2007
;Windows only

Global _Img,_ImGad,_DRAWING,_GDIP,_GRAPH 
#GDIP = 0

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

Structure PointF :  x.f:y.f : EndStructure
Structure RectF :  x.f :  y.f :  Wi.f :  He.f : EndStructure ; obsolleta reemplazar pod PosF

Macro GName : GetFunction(#GDIP,Name) : EndMacro  

Prototype GdiplusStartup(*a,*b,c=0)
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 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 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 PU2(a.p-unicode,b,c) : Macro MU2(Name,a,b,c) : GF.PU2=GName:GF(a,b,c) :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 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

Macro ARGB(RGB=0,Transp=255) ;- ARGB(RGB=0,Transp=255) - admitted with or without transparency
    Blue(RGB)|Green(RGB)<<8|Red(RGB)<<16|Transp<<24
EndMacro

Structure Gradient
    RGB.l
    R.l : G.l :  b.l
EndStructure
RGB.Gradient\RGB=Random(#White)
RGB\R=1:RGB\G=2:RGB\b=-3

    
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


Procedure GdipBallF(x.f,y.f,Radius.f,ARGB1,ARGB2)
    Wi.f=Radius*2 :  He.f=Wi
    X1.f=x+Radius :  Y1.f=y+Radius
    x-Radius :  y-Radius   
    p1.PointF\x = x :  p1\y = y
    p2.PointF\x =x+Wi:  p2\y =y+He
    M6("GdipCreateLineBrush",p1,p2,ARGB1,ARGB2,1,@GdipBrush)
    M2("GdipSetPathGradientGammaCorrection",GdipBrush,1);
    M2FFFF("GdipFillEllipse",_GRAPH, GdipBrush, x,y,Wi,He)
    M1("GdipDeleteBrush",GdipBrush)
EndProcedure

Procedure GdipText(TEXT.S,x,y,Wi,He,FontName.S,FontWSize.f,ARGB1,ARGB2,FontStyle=0,Align=0)
    p1.PointF\x = x :  p1\y = y
    p2.PointF\x =x+Wi:  p2\y =y+He
    
    MU2("GdipCreateFontFamilyFromName",FontName,0,@Family)
    M1F3("GdipCreateFont",Family,FontWSize,FontStyle,2,@Font)
    M6("GdipCreateLineBrush",p1,p2,ARGB1,ARGB2,1,@GdipBrush)
    BoundRect(x,y,Wi,He) ; Hace R.rect    
    M3("GdipCreateStringFormat",0,0,@Format)
    M2("GdipSetStringFormatAlign",Format,Align)
    M1U5("GdipDrawString",_GRAPH,TEXT,Len(TEXT),Font,R, Format,GdipBrush)
    
    M1("GdipDeleteStringFormat",Format)
    M1("GdipDeleteFontFamily",Family)
    M1("GdipDeleteFont",Font)
    M1("GdipDeleteBrush",GdipBrush)
EndProcedure
Procedure  Gradient(*RGB.Gradient)
    With *RGB
        Red=Red(\RGB):Green=Green(\RGB):Blue=Blue(\RGB)
        RA=Random(20)+10
        Select Random(2)
            Case 0:  Red+\R:If Red<RA Or Red>255-RA:\R=-\R:EndIf
            Case 1: Green+\G:If Green<RA Or Green>255-RA:\G=-\G:EndIf
            Case 2 :  Blue+\b:If Blue<RA Or Blue>255-RA:\b=-\b:EndIf
        EndSelect
        \RGB=RGB(Red,Green,Blue)
    EndWith
EndProcedure 

Macro  DistProp(x,y,X1,Y1,Off=0) ; ret distancia proporcional  
    Min(x-Abs(X1-x),y-Abs(Y1-y))-Off
EndMacro 
    
Procedure Min(a,b)
    If a<b:ProcedureReturn a
    Else :  ProcedureReturn b
    EndIf
EndProcedure 

Macro MOU ;-MOU
    M_win=EventWindow()
    _MX=WindowMouseX(M_win) 
    _MY=WindowMouseY(M_win)     
    _MK=Abs(GetAsyncKeyState_(#VK_LBUTTON) +GetAsyncKeyState_(#VK_RBUTTON)*2+GetAsyncKeyState_(#VK_MBUTTON)*3)/$8000   
    If GetAsyncKeyState_(#VK_ESCAPE)
        GdipClose
        End
    EndIf 
EndMacro    

Macro GdipOpen ;- GdipOpen
    If _GDIP : GdipClose : EndIf
    If OpenLibrary(#GDIP,"GDIPlus.DLL")
        Gdip.GdiplusStartupInput\GdiPlusVersion=1
        GF.GdiplusStartup = GetFunction(#GDIP, "GdiplusStartup") : GF(@_GDIP,@Gdip)
        M2("GdipCreateFromHDC",_DRAWING,@_GRAPH)
        M2("GdipSetSmoothingMode",_GRAPH,2) 
    Else
        MessageRequester("Error !","GDIPlus.DLL Not found",0)
        End
    EndIf
EndMacro    

Macro GdipClose  ;- GdipClose
    If _GDIP
        M1("GdipDeleteGraphics",_GRAPH)
        M1("GdiplusShutdown",_GDIP)
        CloseLibrary(#GDIP) : _GDIP=0
    EndIf
EndMacro 

;<<<<<<<<<<<<<<<<<<<<<<<
Title$="Left Button: Text    Right Button: Balls    Left+Right: Clear"
hwnd=OpenWindow(0, 100, 100,700,500 ,Title$, #WS_OVERLAPPEDWINDOW | #WS_MAXIMIZE) 
SetWindowColor(0,0)
StickyWindow(0,1)

Proportion=30   ; choose your value <<<<<<<<<<<<
Wi=WindowWidth(0):He=WindowHeight(0)
Xcenter=Wi/2 : Ycenter=He/2
CreateGadgetList(hwnd)
_Img=CreateImage(-1,Wi,He)
_ImGad=ImageGadget(-1,0,0,0,0,0)
Repeat 
    MOU 
    EV=WaitWindowEvent() 
    If _MK 
        Select EV
            Case #WM_MOUSEMOVE
                Dist.f=DistProp(Xcenter,Ycenter,_MX,_MY)
                Radius.f=Pow(Dist,1.2)/Proportion
                If Radius>0.3 
                    _DRAWING=StartDrawing(ImageOutput(_Img))
                    Gradient(RGB)
                    GdipOpen
                    If _MK=1
                        GdipText(Chr(Random(26)+65),_MX,_MY,Radius,Radius,"arial",Radius,ARGB(RGB\RGB,180),ARGB(#White),0)
                    ElseIf _MK=2
                        GdipBallF(_MX,_MY,Radius,ARGB(RGB\RGB,140),ARGB(#White))
                    ElseIf _MK=3
                        Box(0,0,Wi,He,0)
                        If _DRAWING:StopDrawing():_DRAWING=0:EndIf
                        SetGadgetState(_ImGad,ImageID(_Img))
                        Repeat
                            MOU
                        Until _MK=0
                    EndIf
                    If _DRAWING:StopDrawing():_DRAWING=0:EndIf
                    SetGadgetState(_ImGad,ImageID(_Img))
                EndIf
        EndSelect
        
    EndIf
Until EV=#PB_Event_CloseWindow
GdipClose
End

Last edited by einander on Tue May 22, 2007 1:07 pm, edited 1 time in total.
byo
Enthusiast
Enthusiast
Posts: 635
Joined: Mon Apr 02, 2007 1:43 am
Location: Brazil

Post by byo »

Wow! :D

One thing: the window is not repainted when it looses focus or is resized/minimized. But great demo!
Dare
Addict
Addict
Posts: 1965
Joined: Mon May 29, 2006 1:01 am
Location: Outback

Post by Dare »

Very nice!
Dare2 cut down to size
User avatar
einander
Enthusiast
Enthusiast
Posts: 744
Joined: Thu Jun 26, 2003 2:09 am
Location: Spain (Galicia)

Post by einander »

Thanks!
Fixed the repaint issue (now with ImageGadget); added text draw.
byo
Enthusiast
Enthusiast
Posts: 635
Joined: Mon Apr 02, 2007 1:43 am
Location: Brazil

Post by byo »

This is my desktop. :lol:

Image
dige
Addict
Addict
Posts: 1247
Joined: Wed Apr 30, 2003 8:15 am
Location: Germany
Contact:

Post by dige »

Can't read that short code, but hit the 'compile and run' button
produces an unbelievable output!

Excellent!!! :D
User avatar
einander
Enthusiast
Enthusiast
Posts: 744
Joined: Thu Jun 26, 2003 2:09 am
Location: Spain (Galicia)

Post by einander »

Thanks Dige!
Can't read that short code
I know the prototype part looks ugly, but I love small code.

I'll try to explain in my very bad english the prototype mess:

P1U5 means there are 7 parameters: P=Header (P=dummy-don't count) , 1=1 integer, U=1 Unicode, 5= 5 integers
Numbers are for consecutive integers; (Representing values, pointers, colours, whatever)
U Means p-Unicode: U = one p-Unicode, UU= 2 consecutive unicodes, 5= 5 consecutive integers
P2FFF means there are 5 parameters ;P=Header (dummy), 2=2 consecutive Integers, FFF= 3 consecutive Floats

The trick is the macro GName: on the parameter Name you can pass any GdiPlus procedure name (with exact spelling):

Code: Select all

Macro GName : GetFunction(#GDIP,Name) : EndMacro
the associated macro (M1, M2, M3... ) only needs one parameter for Name, and one more for each parameter on the prototype, to call the Gdip function.

This way you have one Prototype and his associated Macro to wrap any Gdip function that needs this kind of parameters, with only one line of code.

With a few prototypes you can wrap more than 600 GdiPlus functions, because many of them have similar number and type of parameters.
I have this 23 prototypes, 2 of them never used, to call many Gdip functions, and never had troubles with them.
This way is easy to make another OneLiner Prototype to fit any Gdip function.

Code: Select all

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 P14(a,b,c,d,E,F,G,H,i,j,k,L,m,n) : Macro M14(Name,a,b,c,d,E,F,G,H,i,j,k,L,m,n) : GF.P14=GName:GF(a,b,c,d,E,F,G,H,i,j,k,L,m,n) :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 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 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 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 P5F2(a,b,c,d,E,F.f,G.f) : Macro M5F2(Name,a,b,c,d,E,F,G) : GF.P5F2=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
Denis
Enthusiast
Enthusiast
Posts: 704
Joined: Fri Apr 25, 2003 5:10 pm
Location: Doubs - France

Post by Denis »

I like it :D

Excellent
A+
Denis
Post Reply