PureBasic Forums - English

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

Transparent Horloge a track has to follow

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

Page 1 of 1

Transparent Horloge a track has to follow

Posted: Tue Oct 31, 2006 1:48 pm
by dobro
hum ! hum ! :lol: :lol:


Enumeration
     #fenetre
     #rond
     #petitrond
     #moyenrond
     #Image
     #Text_0
     #dobro
EndEnumeration
#CAPTUREBLT = $40000000

Declare.f RotationX(x, angle.f, dist)
Declare.f RotationY(Y, angle.f, dist)
Declare Forme(fenetre,forme)
Declare RemoveFromTaskbar(hwnd)
Declare WindowCallback( WindowID ,message,wParam,lParam)
; *********** initialisation *********
Global rezX=320
Global rezy=240
Global xa=rezy/2
Global ya=rezy/2
Global distance=rezy/2-4
Global Perdu=0 ; defini si l'on perds le focus !!
Global degress,degresm,degresh, tops, topm, toph,Pos_wx,Pos_wy
Structure sprite
    x.l
    Y.l
    vitesse.l
EndStructure


ExamineDesktops ()

    ; ; ****************************PHOTO ***************
;
   ; ; ******************************** on change la taille de la fenetre pour forcer un redraw ************
;
CreateImage ( #Image , DesktopWidth (0), DesktopHeight (0))
dc_bur = GetDC_ (0)
DC_im = StartDrawing ( ImageOutput ( #Image ))
BitBlt_ (DC_im,0,0 , DesktopWidth (0), DesktopHeight (0), dc_bur , 0,0 , #SRCPAINT|#CAPTUREBLT ) ; recup le bureau dans image
StopDrawing ()
ReleaseDC_ (0, dc_bur)


  ; ********************************************************************************************************************************

CallDebugger
If OpenFile (1, "Horloge.ini" )
    Pos_wx= Val ( ReadString (1))
     Debug Pos_wx
    Pos_wy= Val ( ReadString (1))
     Debug Pos_wy
     CloseFile (1)
EndIf

OpenWindow ( #fenetre , 0,0, rezX, rezy, "Horloge" , #PB_Window_BorderLess ) ; on ouvre une fenetre
SetWindowColor ( #fenetre , RGB (0,0,0) )
Handle= WindowID ( #fenetre )

SetWindowCallback (@WindowCallback()) ; un callback pour que le dessin reste sur la fenetre (repaint)

RemoveFromTaskbar( FindWindow_ ( #fenetre , "Horloge" )) ; fait disparaitre la fenetre de la barre des taches
 
Forme ( #fenetre ,2) ; ronde
ResizeWindow ( #fenetre ,Pos_wx,Pos_wy,rezX,rezy)

Repeat ; boucle principale
  
     GetCursorPos_ (Pos.POINT)
    Pos_wx= WindowX ( #fenetre ) : Pos_wy= WindowY ( #fenetre )
    
     If (Pos\x<Pos_wx Or Pos\x>WindowWidth ( #fenetre )) And (Pos\x<Pos_wy Or Pos\x>WindowHeight ( #fenetre ))
        Perdu=0
     EndIf
    
     ; *********************************Copie l'image dans fenetre *******************************************
    Form1= WindowID ( #fenetre )
    bitmap= ImageID ( #Image )
    ps.PAINTSTRUCT
    hdc= BeginPaint_ (Form1,ps)
    hdcMem= CreateCompatibleDC_ (hdc)
     SelectObject_ (hdcMem,bitmap)
     BitBlt_ (hdc,0, 0, WindowWidth ( #fenetre ), WindowHeight ( #fenetre ),hdcMem, WindowX ( #fenetre ), WindowY ( #fenetre ) , #SRCCOPY|#CAPTUREBLT )
     ReleaseDC_ ( WindowID ( #fenetre ),hdc)
     DeleteDC_ (hdcMem)
     DeleteObject_ (hdcMem)
     EndPaint_ (Form1,ps)
     ; *******************************************************************************************************************
     ;
     ; *************************
    
    date = Date ()
    Heure= Hour (date)
     Minute = Minute (date)
    Seconde= Second (date)
    
    Event= WindowEvent () ; on regarde si quelqu'un a cliqué sur la croix pour quitter
     If Event <>0
         Debug Event
     EndIf
     If Event= #WM_MOUSEFIRST Or Event= #PB_Event_ActivateWindow Or Event=49310
         If Perdu=0
            Perdu=1
             ; ****************************PHOTO ***************
            memx= WindowWidth ( #fenetre ) :memy= WindowHeight ( #fenetre )
             ResizeWindow ( #fenetre , -50, -50,0,0)
             Delay (50)
             CreateImage ( #Image , DesktopWidth (0), DesktopHeight (0))
            dc_bur = GetDC_ (0)
            DC_im = StartDrawing ( ImageOutput ( #Image ))
             BitBlt_ (DC_im,0,0 , DesktopWidth (0), DesktopHeight (0), dc_bur , 0,0 , #SRCPAINT|#CAPTUREBLT ) ; recup le bureau dans image
             StopDrawing ()
             ReleaseDC_ (0, dc_bur)
             ; **************************
             ResizeWindow ( #fenetre , Pos_wx, Pos_wy,memx, memy)
             ; *************************************
            
            
            
             ; *********************************Copie l'image dans fenetre *******************************************
            Form1= WindowID ( #fenetre )
            bitmap= ImageID ( #Image )
            ps.PAINTSTRUCT
            hdc= BeginPaint_ (Form1,ps)
            hdcMem= CreateCompatibleDC_ (hdc)
             SelectObject_ (hdcMem,bitmap)
             BitBlt_ (hdc, 0, 0, WindowWidth ( #fenetre ), WindowHeight ( #fenetre ),hdcMem, WindowX ( #fenetre ), WindowY ( #fenetre ) , #SRCCOPY|#CAPTUREBLT )
             ReleaseDC_ ( WindowID ( #fenetre ),hdc)
             DeleteDC_ (hdcMem)
             DeleteObject_ (hdcMem)
             EndPaint_ (Form1,ps)
            
             ; ******************************** on change la taille de la fenetre pour forcer un redraw ************
            memx= WindowWidth ( #fenetre ) :memy= WindowHeight ( #fenetre )
             ResizeWindow ( #fenetre , #PB_Ignore , #PB_Ignore ,memx-1,memy-1)
             ResizeWindow ( #fenetre , #PB_Ignore , #PB_Ignore ,memx, memy)
             ; *******************************************************************************************************************
            
            
            
         EndIf
        
     EndIf
    
     Select Event
         Case #WM_LBUTTONDOWN ; deplace fenetre
             SendMessage_ ( WindowID ( #fenetre ), #WM_NCLBUTTONDOWN , #HTCAPTION , 0)
            
         Case #WM_RBUTTONDOWN
            
             OpenFile (1, "Horloge.ini" )
             WriteStringN (1, Str (Pos_wx))
             WriteStringN (1, Str (Pos_wy))
             CloseFile (1)
             End
     EndSelect
    
     If Memsecond<>Seconde
         SendMessage_ ( WindowID ( #fenetre ), #dobro , #HTCAPTION , 0)
     EndIf
    Memsecond=Seconde
    
    degress=Seconde*6
     ; Ici, le code à executer toutes les secondes
    xs= RotationX(xa, degress-90, distance)
    Ys= RotationY(ya, degress-90, distance)
     ; aiguille des secondes
     StartDrawing ( WindowOutput ( #fenetre ))
     LineXY (xa, ya, xs, Ys , RGB ($E9,$32,$92)) ; les secondes rouge
     For i=-2 To 2
         LineXY (xa+i, ya+i, xs, Ys , RGB ($E9,$32,$92)) ; les secondes rouge
     Next i
     StopDrawing ()
    
     ; Ici, le code à executer toutes les minutes
    degresm = Minute *6
    xm= RotationX(xa, degresm-90, distance-25)
    Ym= RotationY(ya, degresm-90, distance-25)
     ; aiguille des minute
     StartDrawing ( WindowOutput ( #fenetre ))
     LineXY (xa, ya, xm, Ym , RGB ($5,$E2,$B6)) ; les minutes verte
     For i=-2 To 2
         LineXY (xa+i, ya+i, xm, Ym , RGB ($5,$E2,$B6)) ; les secondes rouge
     Next i
     StopDrawing ()
    
     ; Ici, le code à executer toutes les heures
    degresh =Heure*6*5
    xh= RotationX(xa, degresh-90, distance-50)
    Yh= RotationY(ya, degresh-90, distance-50)
     ; aiguille des heures
     StartDrawing ( WindowOutput ( #fenetre ))
     LineXY (xa, ya, xh, Yh , RGB ($F5,$F9,$6A)) ; les heures jaune
     For i=-2 To 2
         LineXY (xa+i, ya+i, xh, Yh , RGB ($F5,$F9,$6A)) ; les secondes rouge
     Next i
     StopDrawing ()
    
     StartDrawing ( WindowOutput ( #fenetre ))
     DrawingMode ( #PB_2DDrawing_Transparent )
     DrawText (xa- TextWidth ( "By Dobro" )/2, rezy/2-100, "By Dobro" , RGB ($7A,$97,$FC), RGB ($0,$0,$0))
     DrawText (ya- TextWidth ( Str (Heure)+ ":" + Str ( Minute )+ ":" + Str (Seconde))/2, rezy/2, Str (Heure)+ ":" + Str ( Minute )+ ":" + Str (Seconde) , RGB ($7A,$97,$FC), RGB ($0,$0,$0))
     StopDrawing ()
    
     ;{ ****************** dessin de l'horloge **********************
    
     For a=1 To 60
        degres =degres+6 : If degres=360:degres=0: EndIf : ; cela fait tourner
        x= RotationX(xa, degres, distance)
        Y= RotationY(ya, degres, distance)
        quart=quart+1
         If quart=15
            quart=0
            
             StartDrawing ( WindowOutput ( #fenetre ))
             Circle (x,Y,8, RGB ($F9,$66,$FD))
             StopDrawing ()
            
         EndIf
        
        min=min+1
         If min<>15
             StartDrawing ( WindowOutput ( #fenetre ))
             Circle (x,Y,4, RGB ($75,$66,$FD))
             StopDrawing ()
         Else
            min=0
         EndIf
        
        min2=min2+1
         If min2=5
             StartDrawing ( WindowOutput ( #fenetre ))
             Circle (x,Y,4, RGB ($E7,$F0,$39))
             StopDrawing ()
            min2=0
         EndIf
     Next a
     ;} ****************************************************************************
    
     ; ***************************************************
     Delay (2)
ForEver ; boucle temps que l'evenement de fenetre n'est pas #PB_Event_CloseWindow (un appuis sur la croix)
; chose qui ne peut pas arrivé sur ce programme !!
Return

Procedure.f RotationX(x, angle.f, dist)
     ProcedureReturn x + Cos (angle.f* #PI /180)*dist
EndProcedure
  
  
Procedure.f RotationY(Y, angle.f, dist)
     ProcedureReturn Y + Sin (angle.f* #PI /180)*dist
EndProcedure


Procedure Forme(fenetre,forme)
     If forme=2 ; si on a choisi la forme 2 Ronde
        Region = CreateEllipticRgn_ ( 0, 0, WindowHeight (fenetre), WindowHeight (fenetre)) ; Création de la région pour faire une fenêtre elliptique
         ;Region2 = CreateEllipticRgn_(20, 20, WindowHeight(fenetre)-20, WindowHeight(fenetre)-20) ; Création de la région pour faire une fenêtre elliptique
         ;CombineRgn_(Region, Region, Region2, #RGN_DIFF) ; On combine les 2 régions
         SetWindowRgn_ ( WindowID (fenetre), Region, #True ) ; On applique la région
         DeleteObject_ (Region) ; On supprime la région
     EndIf
EndProcedure


Procedure RemoveFromTaskbar(hwnd)
     If IsWindow_ (hwnd)
        a=hwnd : b= GetWindowLong_ (a, #GWL_HWNDPARENT ) : If b<>0 : a=b : EndIf ; Needed for "TaskAssign.exe".
         ShowWindow_ (a, #SW_HIDE ) : GetWindowRect_ (a,win.RECT) : w=win\right-win\left : h=win\bottom-win\top
         SetWindowLong_ (a, #GWL_EXSTYLE , #WS_EX_TOOLWINDOW ) : SetWindowPos_ (a,0,0,0,w-1,h-1, #SWP_NOMOVE )
         SetWindowPos_ (a,0,0,0,w,h, #SWP_NOMOVE|#SWP_SHOWWINDOW ) : ProcedureReturn 1
     EndIf
EndProcedure



Procedure WindowCallback( WindowID ,message,wParam,lParam)
    res= #PB_ProcessPureBasicEvents
     If message= #WM_PAINT ; on repaint la fenetre
        
        
         ; *********************************Copie l'image dans fenetre *******************************************
        Form1= WindowID ( #fenetre )
        bitmap= ImageID ( #Image )
        ps.PAINTSTRUCT
        hdc= BeginPaint_ (Form1,ps)
        hdcMem= CreateCompatibleDC_ (hdc)
         SelectObject_ (hdcMem,bitmap)
         BitBlt_ (hdc, 0, 0, WindowWidth ( #fenetre ), WindowHeight ( #fenetre ),hdcMem, WindowX ( #fenetre ), WindowY ( #fenetre ) , #SRCCOPY|#CAPTUREBLT )
         ReleaseDC_ ( WindowID ( #fenetre ),hdc)
         DeleteDC_ (hdcMem)
         DeleteObject_ (hdcMem)
         EndPaint_ (Form1,ps)
        
         ; ******************************** on change la taille de la fenetre pour forcer un redraw ************
        memx= WindowWidth ( #fenetre ) :memy= WindowHeight ( #fenetre )
         ResizeWindow ( #fenetre , #PB_Ignore , #PB_Ignore ,memx-1,memy-1)
         ResizeWindow ( #fenetre , #PB_Ignore , #PB_Ignore ,memx, memy)
         ; *******************************************************************************************************************
        
        
         ProcedureReturn #True
        
     ElseIf message= #WM_MOVE ; au cas ou l'on bouge la fenetre
        
        
         ; ********************************************************************************************************************************
        
         ; *********************************Copie l'image dans fenetre *******************************************
        Form1= WindowID ( #fenetre )
        bitmap= ImageID ( #Image )
        ps.PAINTSTRUCT
        hdc= BeginPaint_ (Form1,ps)
        hdcMem= CreateCompatibleDC_ (hdc)
         SelectObject_ (hdcMem,bitmap)
         BitBlt_ (hdc, 0, 0, WindowWidth ( #fenetre ), WindowHeight ( #fenetre ),hdcMem, WindowX ( #fenetre ), WindowY ( #fenetre ) , #SRCCOPY|#CAPTUREBLT )
         DeleteDC_ (hdcMem)
         DeleteObject_ (hdcMem)
         EndPaint_ (Form1,ps)
         ; ******************************** on change la taille de la fenetre pour forcer un redraw ************
        memx= WindowWidth ( #fenetre ) :memy= WindowHeight ( #fenetre )
         ResizeWindow ( #fenetre , #PB_Ignore , #PB_Ignore ,memx,0)
         ResizeWindow ( #fenetre , #PB_Ignore , #PB_Ignore ,memx, memy)
         ; *******************************************************************************************************************
        
     ElseIf message = #dobro
        
         ; ******************************** on change la taille de la fenetre pour forcer un redraw ************
        memx= WindowWidth ( #fenetre ) :memy= WindowHeight ( #fenetre )
         ResizeWindow ( #fenetre , #PB_Ignore , #PB_Ignore ,0,memy)
         ResizeWindow ( #fenetre , #PB_Ignore , #PB_Ignore ,memx, memy)
         ; *************************************
        
     Else
        
         ProcedureReturn #PB_ProcessPureBasicEvents ; rend la main !
        
     EndIf
EndProcedure

Posted: Tue Oct 31, 2006 2:30 pm
by rsts
Nice and colorful.

And yes, the clock is very nice too. :D

cheers

Posted: Tue Oct 31, 2006 4:41 pm
by netmaestro
Transparent Horloge a track has to follow
No... no... Wait! Yes! I can just see you, a tiny dot way back in the distance... :D

Posted: Tue Oct 31, 2006 7:01 pm
by dobro
code changed manage the background better :D

Posted: Wed Nov 01, 2006 9:07 am
by dobro
code changed: Now save the Windows Position :D
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited