PureBasic Forums - English

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

Proportional distance with GdiPlus

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

Page 1 of 1

Proportional distance with GdiPlus

Posted: Tue May 22, 2007 10:23 am
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

Posted: Tue May 22, 2007 11:48 am
by byo
Wow! :D

One thing: the window is not repainted when it looses focus or is resized/minimized. But great demo!

Posted: Tue May 22, 2007 12:52 pm
by Dare
Very nice!

Posted: Tue May 22, 2007 1:09 pm
by einander
Thanks!
Fixed the repaint issue (now with ImageGadget); added text draw.

Posted: Tue May 22, 2007 1:19 pm
by byo
This is my desktop. :lol:

Image

Posted: Wed May 23, 2007 8:44 am
by dige
Can't read that short code, but hit the 'compile and run' button
produces an unbelievable output!

Excellent!!! :D

Posted: Wed May 23, 2007 12:30 pm
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

Posted: Wed May 23, 2007 7:00 pm
by Denis
I like it :D

Excellent
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited