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