Horloge dans fenêtre transparente

Partagez votre expérience de PureBasic avec les autres utilisateurs.
Avatar de l’utilisateur
microdevweb
Messages : 1798
Inscription : mer. 29/juin/2011 14:11
Localisation : Belgique

Horloge dans fenêtre transparente

Message par microdevweb »

Demo:

Image

Note: Ce code est repris de Lloyd Gallant (netmaestro) réalisé avec Purebasic 4.0 Il est ici adapté pour purebasic 5.40 et la librairie Vector

:arrow: Etape 1
Copiez, sauvegardez et exécutez le code ci-dessous dans le répertoire de travail pour charger les images nécessaires

Code : Tout sélectionner

If InitNetwork()
      If FileSize("back.png")=-1
            ReceiveHTTPFile("http://www.microdevweb.com/source/watch/back.png","back.png")
      EndIf
      If FileSize("highlight.png")=-1
            ReceiveHTTPFile("http://www.microdevweb.com/source/watch/highlight.png","highlight.png")
      EndIf
EndIf
:arrow: Etape 2
Copiez, sauvegardez et exécutez le code ci-dessous dans le même répertoire de travail. Vous pouvez déplacer l'horloge avec un clique maintenu sur son fond et en déplaçant la souris. Le code est intégré dans un module afin de pouvoir être utilisé dans tous vos projet Window. Si vous voulez faire faire fonctionner ce code sous d'autres Os désactivez ou supprimez les lignes suivante

Code : Tout sélectionner

SetWindowLong_(WindowID( gMyWatch(0)), #GWL_EXSTYLE, #WS_EX_LAYERED) 
SetLayeredWindowAttributes_(WindowID( gMyWatch(0)), RGB(173, 216, 230), 0, #LWA_COLORKEY)    
Code du module et code teste

Code : Tout sélectionner

;*******************************************************************************************************
; Name: Watch
; Author: MicrodevWeb
; Use: Pb 5.40
;*******************************************************************************************************
DeclareModule Watch
     Declare OpenWatchForm() 
EndDeclareModule
Module Watch
      UsePNGImageDecoder()
      EnableExplicit
      Global Dim gMyWatch(1)
      Global gAlphaColor.q=$FFE6D8AD
      Global Dim gImg(1)
      Global gClicOn.b=#False
      Structure Pos
            X.i
            Y.i
      EndStructure
      Global myMouse.Pos,gOldMouse.Pos
      gImg(0)=CatchImage(#PB_Any,?back)
      gImg(1)=CatchImage(#PB_Any,?highlight)
      Procedure DrawWatch() 
            Protected pMinute=Minute(Date())
            Protected pHour=Hour(Date())
             Protected pSeconde=Second(Date())
            Protected RadMinute.f
            Protected RadHour.f
            Protected RadSecond.f
            RadMinute=180+(pMinute*6)
            If pHour>=12
                  pHour-12
            ElseIf  pHour<0
                  pHour+12
            EndIf
            RadHour=(180+pHour * 30 +(pMinute/60 * 30))
            RadSecond=180+(pSeconde*6)
            StartVectorDrawing(CanvasVectorOutput(gMyWatch(1)))
            VectorSourceColor(gAlphaColor)
            FillVectorOutput()
            ; Dessin du cadran
            MovePathCursor(0,0)
            DrawVectorImage(ImageID(gImg(0)))
            VectorSourceColor($FF000000)
            ; Dessin des heures
            RotateCoordinates(196/2,196/2,RadHour)
            MovePathCursor(196/2,196/2)
            AddPathLine(196/2,142)
            StrokePath(4)
            ResetCoordinates()
            ; Dessin des minutes
            RotateCoordinates(196/2,196/2,RadMinute)
            MovePathCursor(196/2,196/2)
            AddPathLine(196/2,170)
            StrokePath(4)
            ResetCoordinates()
            ; Dessin des secondes
            VectorSourceColor($FF2A2AA5)
            RotateCoordinates(196/2,196/2,RadSecond,#PB_Coordinate_User)
            MovePathCursor(196/2,196/2)
            AddPathLine(196/2,170)
            StrokePath(1)
            ResetCoordinates()
            MovePathCursor(0,0)
            DrawVectorImage(ImageID(gImg(1)))
            StopVectorDrawing()
      EndProcedure
      Procedure EventCanvas()
            Protected Dep.Pos,New.Pos
            Select EventType()
                  Case #PB_EventType_MouseMove
                        myMouse\X=GetGadgetAttribute(gMyWatch(1),#PB_Canvas_MouseX)
                        myMouse\Y=GetGadgetAttribute(gMyWatch(1),#PB_Canvas_MouseY)
                        If gClicOn
                              Dep\X=myMouse\X-gOldMouse\X
                              Dep\Y=myMouse\Y-gOldMouse\Y
                              New\X=WindowX(gMyWatch(0))+Dep\X
                              New\Y=WindowY(gMyWatch(0))+Dep\Y
                              ResizeWindow(gMyWatch(0),New\X,New\Y,#PB_Ignore,#PB_Ignore)
                        EndIf
                  Case #PB_EventType_LeftButtonDown
                        If Not gClicOn
                              gOldMouse\X=GetGadgetAttribute(gMyWatch(1),#PB_Canvas_MouseX)
                              gOldMouse\Y=GetGadgetAttribute(gMyWatch(1),#PB_Canvas_MouseY)
                              gClicOn=#True
                        EndIf
                        SetGadgetAttribute( gMyWatch(1),#PB_Canvas_Cursor,#PB_Cursor_Arrows)
                  Case #PB_EventType_LeftButtonUp
                        gClicOn=#False
                        SetGadgetAttribute( gMyWatch(1),#PB_Canvas_Cursor,#PB_Cursor_Default)
            EndSelect
      EndProcedure
      Procedure OpenWatchForm()
            Protected Flag=#PB_Window_BorderLess
            gMyWatch(0)=OpenWindow(#PB_Any,0,0,196,196,"",Flag)
            SetWindowLong_(WindowID( gMyWatch(0)), #GWL_EXSTYLE, #WS_EX_LAYERED) 
            SetLayeredWindowAttributes_(WindowID( gMyWatch(0)), RGB(173, 216, 230), 0, #LWA_COLORKEY)    
            gMyWatch(1)=CanvasGadget(#PB_Any,0,0,196,196,#PB_Canvas_Keyboard)
            DrawWatch()
            AddWindowTimer(gMyWatch(0),0,1)
            BindEvent(#PB_Event_Timer,@DrawWatch(),gMyWatch(0))
            BindGadgetEvent(gMyWatch(1),@EventCanvas())
      EndProcedure
      DataSection
      back: : IncludeBinary "back.png"
      highlight: : IncludeBinary "highlight.png"
EndDataSection
EndModule
Watch::OpenWatchForm()
Repeat :WaitWindowEvent() :ForEver


Windows 10 64 bits PB: 5.70 ; 5.72 LST
Work at Centre Spatial de Liège