Basic Univers
EnableExplicit
Enumeration 0
#ULW_OPAQUE
#ULW_COLORKEY
#ULW_ALPHA
EndEnumeration
Procedure.l DrawGear(x.f, y.f, Rayon.l, RayonAlesage.l, NbDents.l, HauteurDent.l, Decalage.f, Inclinaison.f, Epaisseur.l, Couleur.l, FillArea.l = #True)
Protected PosX.f, PosY.f, PosX1, PosY1, PosX2, PosY2, PosX3, PosY3, PosX4, PosY4, PosX5, PosY5
Protected x2.f, y2.f, nn.l, LargeurDent.l, Longueur.f, n.l, Facteur.f, Cos.f, Cos2.f, Sin.f, Sin2.f
x2 = x
y2 = y
x = x +( Inclinaison * Cos(#PI / 4) ) * Rayon
y = y +( Inclinaison * Cos(#PI / 4) ) * Rayon
For nn = 0 To Epaisseur
Couleur = RGB(Red(Couleur) * 0.98, Green(Couleur) * 0.98, Blue(Couleur) * 0.98)
If nn = Epaisseur
Couleur = RGB(Red(Couleur) * 0.9, Green(Couleur) * 0.9, Blue(Couleur) * 0.9)
EndIf
LargeurDent = Int(Rayon * 3 / 5 * Sin(#PI / NbDents) + 0.5)
For n = 1 To NbDents + 1
Facteur =(1 - Inclinaison * Cos((n + Decalage) * 2 * #PI / NbDents - #PI / 4))
Sin = Sin((n + Decalage) * 2 * #PI / NbDents)
Cos = Cos((n + Decalage) * 2 * #PI / NbDents)
PosX = x + Facteur * Rayon * Cos
PosY = y + Facteur * Rayon * Sin
Longueur = Sqr(Pow(PosX - x2, 2) + Pow(PosY - y2, 2))
Sin2 =(PosY - y2) / Longueur
Cos2 =(PosX - x2) / Longueur
PosX1 = Int(PosX + Facteur * LargeurDent / 2 * Sin2 + 0.5)
PosY1 = Int(PosY - Facteur * LargeurDent / 2 * Cos2 + 0.5)
PosX2 = Int(PosX - Facteur * LargeurDent / 2 * Sin2 + 0.5)
PosY2 = Int(PosY + Facteur * LargeurDent / 2 * Cos2 + 0.5)
PosX3 = Int(PosX + Facteur *(- HauteurDent * Cos2 + LargeurDent * Sin2) + 0.5)
PosY3 = Int(PosY + Facteur *(- HauteurDent * Sin2 - LargeurDent * Cos2) + 0.5)
PosX4 = Int(PosX + Facteur *(- HauteurDent * Cos2 - LargeurDent * Sin2) + 0.5)
PosY4 = Int(PosY + Facteur *(- HauteurDent * Sin2 + LargeurDent * Cos2) + 0.5)
LineXY(PosX1, PosY1, PosX2, PosY2, Couleur)
LineXY(PosX1, PosY1, PosX3, PosY3, Couleur)
LineXY(PosX4, PosY4, PosX2, PosY2, Couleur)
If n > 1
LineXY(PosX3, PosY3, PosX5, PosY5, Couleur)
EndIf
PosX5 = PosX4
PosY5 = PosY4
Next
If FillArea
FillArea(x, y, Couleur, Couleur)
EndIf
x + 1
y + 1
x2 + 1
y2 + 1
Next
EndProcedure
Procedure.l SetWindowLayeredBitmap(WindowID.l, ImageID.l, ColorKey.l = #White, AlphaValue.l = 255)
Protected hdc.l, hBmp.BITMAP, pt.POINT, blend.BLENDFUNCTION
SetWindowLong_(WindowID(WindowID), #GWL_EXSTYLE, GetWindowLong_(WindowID(WindowID), #GWL_EXSTYLE) | #WS_EX_LAYERED)
If GetObject_(ImageID(ImageID), SizeOf(BITMAP), @hBmp)
hdc = StartDrawing(ImageOutput(ImageID))
If hdc
blend\BlendOp = 0
blend\BlendFlags = 0
blend\AlphaFormat = 0
blend\SourceConstantAlpha = AlphaValue
UpdateLayeredWindow_(WindowID(WindowID), 0, 0, @hBmp\bmWidth, hdc, @pt, ColorKey, @blend, #ULW_COLORKEY|#ULW_ALPHA)
StopDrawing()
EndIf
EndIf
EndProcedure
Define i.l, j.l, w.l = 380, h.l = 380
If OpenWindow(0, 0, 0, w, h, "DrawGear()", #PB_Window_BorderLess | #PB_Window_ScreenCentered | #PB_Window_Invisible )
StickyWindow(0, #True)
LoadFont(0, "Tahoma", 8, #PB_Font_HighQuality)
For i = 0 To 19
If CreateImage(i, w, h)
If StartDrawing(ImageOutput(i))
DrawingFont(FontID(0))
Box(0, 0, w, h, #White)
DrawingMode(#PB_2DDrawing_Default)
DrawGear(340, 320, 20, 5, 10, 5,((17 - i) / 20), 0.2, 16, $22FFFF)
DrawGear(272, 240, 100, 20, 40, 5,(( i - 7) / 20), 0.2, 6, $8AFF8A)
DrawingMode(#PB_2DDrawing_Default)
DrawGear( 80, 200, 38, 7, 8, 10,((17 - i) / 20), 0.2, 25, $4444FF)
DrawGear( 50, 50, 20, 5, 6, 5,( i / 20), 0.2, 99, $666666)
DrawGear(245, 95, 75, 20, 10, 10,((16 - i) / 20), 0.2, 25, $FF4444)
DrawGear(125, 125, 50, 20, 8, 10,( i / 20), 0.2, 25, $DDDDDD)
DrawGear(150, 150, 20, 5, 6, 5,( i / 20), 0.2, 99, $FFFFFF)
DrawingMode(#PB_2DDrawing_Outlined)
Box(10, 10, w - 20, h - 20,(#Black|$F0F0F0))
Box(12, 12, w - 24, h - 24,(#Black|$000000))
DrawingMode(#PB_2DDrawing_Default)
DrawGear(1, 340, 100, 20, 30, 10,(i / 20), 0.01, 8, $FFEEEE)
DrawingMode(#PB_2DDrawing_Transparent)
DrawText( 20, 335, "PureBasic 4.10, Gear Demo", #Black)
DrawText( 20, 350, "Copyright © 2007 Fantaisie Software", #Black)
DrawText(w - 80, 350, "RMB to Exit.", $DDDDDD)
StopDrawing()
EndIf
EndIf
Next
SetTimer_(WindowID(0), 0, 5, 0)
HideWindow(0, #False)
i = 0
Repeat
Select WaitWindowEvent()
Case #WM_CLOSE, #WM_KEYDOWN, #WM_RBUTTONDOWN
Break
Case #WM_LBUTTONDOWN
SendMessage_(WindowID(0), #WM_NCLBUTTONDOWN, #HTCAPTION, 0)
Case #WM_TIMER
SetWindowLayeredBitmap(0, i, #White, 240)
i + 1 : If i > 19 : i = 0 : EndIf
EndSelect
ForEver
KillTimer_(WindowID(0), 0)
EndIf
End