Des petits trous au passage de la souris

Programmation d'applications complexes
Le Soldat Inconnu
Messages : 4312
Inscription : mer. 28/janv./2004 20:58
Localisation : Clermont ferrand OU Olsztyn
Contact :

Des petits trous au passage de la souris

Message par Le Soldat Inconnu »

Coucou,

un petit délire

ce code fait des trous dans la fenêtre au passage de la souris

Code : Tout sélectionner

; Auteur : Le Soldat Inconnu
; Version de PB : 4
;
; Explication du programme :
; Pour faire des programmes de test rapidement, il ne reste qu'a rajouter les gadgets et la gestion des évènements.

ProcedureDLL SetLayeredWindow2(WindowID.l, Alpha.l, Color.l) ; Transparence et forme de la fenêtre
  Protected Parametre.l
  SetWindowLong_(WindowID, #GWL_EXSTYLE, GetWindowLong_(WindowID, #GWL_EXSTYLE) | #WS_EX_LAYERED)
  If Alpha > 0
    Parametre | #LWA_ALPHA
  Else
    Alpha = 0
  EndIf
  If Color > 0
    Parametre | #LWA_COLORKEY
  Else
    Color = 0
  EndIf
  SetLayeredWindowAttributes_(WindowID, Color, Alpha, Parametre)
EndProcedure

; Création de la fenêtre et de la GadgetList
If OpenWindow(0, 0, 0, 300, 300, "Test", #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_MinimizeGadget) = 0
  End
EndIf

; La couleur $FF00FF devient totalement transparente
; Donc si on dessine de la couleur $FF00FF sur la fenêtre, on fait des trous
; La veleur 200 est l'effet de transparence globale de la fenêtre, 0 donne invisible, et 255 complètement opaque
SetLayeredWindow2(WindowID(0), 200, $FF00FF)

Repeat
  Event = WaitWindowEvent()
  
  Select Event
    Case #PB_Event_Menu
      Select EventMenu() ; Menus
          
      EndSelect
      
    Case #PB_Event_Gadget
      Select EventGadget() ; Gadgets
          
      EndSelect
      
    Case #WM_MOUSEMOVE
      StartDrawing(WindowOutput(0))
        Circle(WindowMouseX(0), WindowMouseY(0), 8, $FF00FF)
      StopDrawing()
  EndSelect
  
Until Event = #PB_Event_CloseWindow

End
Amusez vous bien
Je ne suis pas à moitié Polonais mais ma moitié est polonaise ... Vous avez suivi ?

[Intel quad core Q9400 2.66mhz, ATI 4870, 4Go Ram, XP (x86) / 7 (x64)]
Ollivier
Messages : 4197
Inscription : ven. 29/juin/2007 17:50
Localisation : Encore ?
Contact :

Message par Ollivier »

Salut LSI

Cool, l'effet buée de 505. J'ai rajouté l'option "Racaillou".

Code : Tout sélectionner

; Auteur : Le Soldat Inconnu
; Modif : Ollivier
; Version de PB : 4
;
; Explication du programme :
; Pour faire des programmes de test rapidement, il ne reste qu'a rajouter les gadgets et la gestion des évènements.

ProcedureDLL SetLayeredWindow2(WindowID.l, Alpha.l, Color.l) ; Transparence et forme de la fenêtre
  Protected Parametre.l
  SetWindowLong_(WindowID, #GWL_EXSTYLE, GetWindowLong_(WindowID, #GWL_EXSTYLE) | #WS_EX_LAYERED)
  If Alpha > 0
    Parametre | #LWA_ALPHA
  Else
    Alpha = 0
  EndIf
  If Color > 0
    Parametre | #LWA_COLORKEY
  Else
    Color = 0
  EndIf
  SetLayeredWindowAttributes_(WindowID, Color, Alpha, Parametre)
EndProcedure

; Création de la fenêtre et de la GadgetList
If OpenWindow(0, 0, 0, 300, 300, "Test", #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_MinimizeGadget) = 0
  End
EndIf
SetLayeredWindow2(WindowID(0), 255, $FF00FF)
; La couleur $FF00FF devient totalement transparente
; Donc si on dessine de la couleur $FF00FF sur la fenêtre, on fait des trous
; La veleur 200 est l'effet de transparence globale de la fenêtre, 0 donne invisible, et 255 complètement opaque

Repeat
  Event = WindowEvent()
   Delay(1)
  Select Event
    Case #PB_Event_Menu
      Select EventMenu() ; Menus
         
      EndSelect
     
    Case #PB_Event_Gadget
      Select EventGadget() ; Gadgets
         
      EndSelect
     
    ;Case #WM_MOUSEMOVE
    ;Default
    Case #WM_LBUTTONDOWN
      Racaillou = 1
    Case #WM_LBUTTONUP
      Racaillou = 0
    Default
      If used < 16
         If used => 15
            W = WindowWidth(0)
            H = WindowHeight(0)
            StartDrawing(WindowOutput(0))
               Box(0, 0, W, H, RGB(255, 0, 0) )
               For Y = 0 To H Step 16
                 Line(0, Y, W, 0, #White)
                 For X = 0 To W Step 48
                  Line(X + (24 * (Y & 16) >> 4 ), Y, 0, 16, #White)
                 Next X
               Next Y
            StopDrawing()      
         EndIf
         used + 1
      EndIf
  EndSelect
   If Racaillou
      X = WindowMouseX(0)
      Y = WindowMouseY(0)
      StartDrawing(WindowOutput(0))
        For N = 0 To 100
           AA.F = Random(200.0 * #PI) / 100.0
           RR.F = Random(32)
           TX.F = Cos(AA) * RR
           TY.F = Sin(AA) * RR
           Box(X + TX, Y + TY, 1, 1, $FF00FF)
        Next
      StopDrawing()
   EndIf
 
Until Event = #PB_Event_CloseWindow

End
Répondre