PureBasic Forums - English

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

Gear Demo

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

Page 1 of 1

Gear Demo

Posted: Sun Jul 01, 2007 3:25 pm
by Flype
i put here a old code (2004) by 'le soldat inconnu' to draw gears,

http://www.purebasic.fr/french/viewtopic.php?t=687

i converted the source to PB4.x and enhanced with some stuff.

Code: Select all

;-
;- 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(0), #GWL_EXSTYLE, GetWindowLong_(WindowID(0), #GWL_EXSTYLE) | #WS_EX_LAYERED)
  
  If GetObject_(ImageID(ImageID), SizeOf(BITMAP), @hBmp)
    blend\SourceConstantAlpha = AlphaValue
    hdc = StartDrawing(ImageOutput(ImageID))
    UpdateLayeredWindow_(WindowID(WindowID), 0, 0, @hBmp\bmWidth, hdc, @pt, ColorKey, @blend, #ULW_COLORKEY|#ULW_ALPHA)
    StopDrawing()
  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)
        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, $FFFFFF)
        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

Posted: Sun Jul 01, 2007 3:36 pm
by netmaestro
WOW! Beautiful, just beautiful.

Posted: Sun Jul 01, 2007 4:03 pm
by SCRJ
:shock:

Looks nice :D

Posted: Sun Jul 01, 2007 4:05 pm
by milan1612
very impressive! :shock:

Posted: Sun Jul 01, 2007 4:13 pm
by Derek
Very clever, looks great!

Posted: Sun Jul 01, 2007 4:16 pm
by netmaestro
I hope you don't mind a tiny change to the timer, this version allows for the gears to keep turning while the window is being moved around:

Code: Select all

;- 
;- 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 

#TIME_KILL_SYNCHRONOUS = $100

Global i.l
Define TimerID, j.l, w.l = 380, h.l = 380 

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(0), #GWL_EXSTYLE, GetWindowLong_(WindowID(0), #GWL_EXSTYLE) | #WS_EX_LAYERED) 
  
  If GetObject_(ImageID(ImageID), SizeOf(BITMAP), @hBmp) 
    blend\SourceConstantAlpha = AlphaValue 
    hdc = StartDrawing(ImageOutput(ImageID)) 
    UpdateLayeredWindow_(WindowID(WindowID), 0, 0, @hBmp\bmWidth, hdc, @pt, ColorKey, @blend, #ULW_COLORKEY|#ULW_ALPHA) 
    StopDrawing() 
  EndIf 
  
EndProcedure 

Procedure TimerProc(uID, uMsg, dwUser, dw1, dw2)
  SetWindowLayeredBitmap(0, i, #White, 240) 
  i + 1 : If i > 19 : i = 0 : EndIf 
EndProcedure

;- 
;- Programme de test 
;- 

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) 
        DrawGear( 80, 200,  38,  7,  8, 20, ( (17 - i) / 20), 0.2, 25, $4444FF) 
        DrawGear( 50,  50,  20,  5,  6,  5,        ( i / 20), 0.2, 99, $FFFFFF) 
        DrawGear(245,  95,  75, 20, 10, 20, ( (16 - i) / 20), 0.2, 25, $FF4444) 
        DrawGear(125, 125,  50, 20,  15, 20,        ( 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 
  
  TimerID = timeSetEvent_(15,5,@TimerProc(),0,#TIME_PERIODIC|#TIME_KILL_SYNCHRONOUS)
  
  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) 
        
    EndSelect 
    
  ForEver 
  
  timeKillEvent_(TimerID)
  
EndIf 

;- 
;- 
;- 

End

Posted: Sun Jul 01, 2007 4:24 pm
by Kaeru Gaman
@Flype

impressive! Image

Posted: Sun Jul 01, 2007 8:30 pm
by rsts
Very impressive.
@both of you :D

cheers

Posted: Sun Jul 01, 2007 8:59 pm
by Fluid Byte
WTF!? I just thought "where the hell are the 3D models?".

Can't stop looking at it. Awsome piece of code!

Posted: Sun Jul 01, 2007 10:19 pm
by Flype
@fluid byte

hehe, it's not more than precalculated 2d shapes :wink:


@netmaestro

of course, no problem.

Posted: Mon Jul 02, 2007 1:46 am
by Dare
Wow.

Nice.

Posted: Mon Jul 02, 2007 4:36 am
by JCV
cool!!! :shock: 8)

Posted: Mon Jul 02, 2007 7:59 am
by Heathen
Nice!

Posted: Mon Jul 02, 2007 8:56 am
by DeXtr0
Awesome guys :shock:

Thanks,
DeXtr0
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited