Basic Univers
;-
;- Description : Dessiner un engrenage en 3D avec une animation
;- Auteur      : Le Soldat Inconnu, Flype.
;- Version     : PureBasic 4.x
;-

EnableExplicit

;-
;- Procédure de tracé
;-

Enumeration 0 ; #ULW_ for use with UpdateLayeredWindow()
  #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
 
  ; x, y         : Position de l'engrenage
  ; Rayon        : Rayon de l'engrenage
  ; RayonAlesage : Rayon du trou au centre de l'engrenage
  ; NbDents      : Nombre de dents
  ; HauteurDent  : Hauteur des dents
  ; Decalage     : Nombre de dents de décalage par rapport à l'origine, utilisé pour faire tourner l'engrenage
  ; Inclinaison  : L'inclinaison de l'engrenage pour l'effet 3D
  ; Epaisseur    : L'épaisseur de l'engrenage
  ; Couleur      : Couleur de l'engrenage
 
  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
     
      ; Point haut gauche de la dent
      PosX1 = Int(PosX + Facteur * LargeurDent / 2 * Sin2 + 0.5)
      PosY1 = Int(PosY - Facteur * LargeurDent / 2 * Cos2 + 0.5)
     
      ; Point haut droit de la dent
      PosX2 = Int(PosX - Facteur * LargeurDent / 2 * Sin2 + 0.5)
      PosY2 = Int(PosY + Facteur * LargeurDent / 2 * Cos2 + 0.5)
     
      ; Point bas gauche de la dent
      PosX3 = Int(PosX + Facteur *(- HauteurDent * Cos2 + LargeurDent * Sin2) + 0.5)
      PosY3 = Int(PosY + Facteur *(- HauteurDent * Sin2 - LargeurDent * Cos2) + 0.5)
     
      ; Point bas droit de la dent
      PosX4 = Int(PosX + Facteur *(- HauteurDent * Cos2 - LargeurDent * Sin2) + 0.5)
      PosY4 = Int(PosY + Facteur *(- HauteurDent * Sin2 + LargeurDent * Cos2) + 0.5)
     
      ; Dessin du contour de la dent
      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

;-
;- Programme de test
;-

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