Code : Tout sélectionner
;
; Eyes 1
;
; F.Weil 20040616
;
; The well known "eyes" trick, where the eyes follow the mouse, and some nice effects using a standard window and 2D drawings
; Uses Windows API commands. In case you can't compile Windows API commands, just set #WindowsAPI = #FALSE
;
; Le truc bien connu des "yeux" qui suivent la souris, avec quelques effets intéressants qui n'utilisent qu'une fenêtre standard et le dessin 2D
; Utilisation de commandes Windows API. Dans le cas où vous ne pouvez pas compiler les commandes Windows API, mettez #WindowsAPI = #FALSE
;
#WindowsAPI = #TRUE
Enumeration
#Window_Main
#Font
#Image
EndEnumeration
;
; Label : Draw Text, using FontName/FontSize/Attributes and Color for the drawing font, at x, y position
;
; If Times is set to a value higher than 0 the text is drawn decrementing x and incrementing y
; while the Color value is changed to generate a fading color. This renders a 3D effect of the text.
;
; RStep, GStep, BStep are the values to change Red, Green and Blue of Color while looping.
; =============================================================================
; Label : Dessine Text, en utilisant FontName/FontSize/Attributes et Color pour la police, à la position x, y
;
; Si Times est positionné à une valeur supérieure à 0, le texte est dessiné en décrémentant x et en incrémentant y
; tandis que la couleur est modifiée pour donner un effet de fondu. Cela permet d'obtenir un effet 3D sur le texte.
;
; RStep, GStep et BStep sont les valeurs permettant de changer les composantes Rouge, Vert et Bleu de la couleur.
;
Procedure Label(Text.s, FontName.s, FontSize.l, x.l, y.l, Color.l, Attributes.l, Times.l, RStep.l, GStep.l, BStep.l)
DrawingFont(LoadFont(#Font, FontName, FontSize, Attributes))
DrawingMode(1)
; Iterates if Times > 0
; On boucle si Times > 0
For i = 0 To Times
FrontColor(Red(Color), Green(Color), Blue(Color))
Locate(x - i, y + i)
DrawText(Text)
; Color is $BBGGRR based. This line is like Color = RGB(Red(Color) - RStep, Green(Color) - GStep, Blue(Color) - BStep)
; Color est basée sur une combinaison $BBGGRR. Cette ligne est équivalente à Color = RGB(Red(Color) - RStep, Green(Color) - GStep, Blue(Color) - BStep)
Color - RStep - GStep << 8 - BStep << 16
Next
EndProcedure
;
; Eye : draw a set of circles from largest to smallest in a faded color and a solid circle in black
;
; Circles centers are located on a vector corresponding to a given length in the same direction than the x, y point from cx, cy.
; This makes possible to give this direction the same than the pointer if x, y are mouse coordinates.
; =============================================================================
; Eye : dessine un jeu de cercles concentriques du plus large au plus petit avec une couleur en dégradé, puis un cercle solide en noir.
;
; Les centres des cercles sont calculés comme se trouvant à l'extrémité d'un rayon d'un longueur donnée ayant même direction que x, y depuis cx, cy
; Cela permet par exemple de suivre la direction du pointeur si x, y sont les coordonnées de la souris.
;
Procedure.f Eye(x.l, y.l, cx.l, cy.l, s.l)
; a is the angle between the line containing (x, y) and (cx, cy) and the x axis
; a est l'angle formé par la droite contenant (x, y) et (cx, cy) par rapoort à l'axe des abcisses
a.f = ATan((y - cy) / (x - cx))
; if x < cx the angle is negated. sca and ssa are stored for use in the following lines
; si x < cx on prend la valeur négative de l'angle. sca et ssa sont mémorisées pour usage dans les lignes suivantes
If x < cx
sca = -s * Cos(a)
ssa = -s * Sin(a)
Else
sca = s * Cos(a)
ssa = s * Sin(a)
EndIf
For i = 0 To cy - 20
Circle(sca / 2 + cx, ssa / 2 + cy, cy - i, $D04040 + i *$10000 + 4 * i * $100 + 2 * i)
Next
Circle(sca + cx, ssa + cy, s, $200000)
EndProcedure
;
;
;
WindowXSize = 240
WindowYSize = 100
Quit = #FALSE
If OpenWindow(#Window_Main, 0, 0, WindowXSize, WindowYSize, #PB_Window_BorderLess |#PB_Window_ScreenCentered , "Eyes")
AddKeyboardShortcut(#Window_Main, #PB_Shortcut_Escape, #PB_Shortcut_Escape)
CompilerIf #WindowsAPI = #TRUE
; 2 elliptic regions are created and combined to obtain transparency of the window outside this combined region
; 2 régions elliptiques sont créées et combinées pour obtenir une transparence de la fenêtre à l'extérieur de cette région combinée
Circle1 = CreateEllipticRgn_(0, 0, 3 * WindowXSize / 5, WindowYSize)
Circle2 = CreateEllipticRgn_(2 * WindowXSize / 5, 0, WindowXSize, WindowYSize)
CombineRgn_(Circle1, Circle1, Circle2, #RGN_OR)
SetWindowRgn_(WindowID(#Window_Main), Circle1, #TRUE)
DeleteObject_(Circle1)
DeleteObject_(Circle2)
CompilerEndIf
; The main event loop contains first a check of window close and the drawing part
; La boucle évènementielle principale contient en premier les tests de fermeture de la fenêtre puis la partie dessin
Repeat
WindowEvent = WindowEvent()
If WindowEvent = #PB_Event_CloseWindow Or (WindowEvent = #PB_Event_Menu And EventMenuID() = #PB_Shortcut_Escape)
Quit = #TRUE
EndIf
; All the drawing is based on the window dimension and the cursor position
; L'ensemble du dessin est basé sur les dimensions de la fenêtre et la position de la souris
WindowMouseX = WindowMouseX()
WindowMouseY = WindowMouseY()
; Create an image to draw first inside and copy the image to the window after in order to avoid flickering.
; On créé une image pour y dessiner avant de copier celle-ci dans la fenêtre, ceci permettant d'éviter le scintillement.
ImageID = CreateImage(#Image, WindowXSize, WindowYSize)
StartDrawing(ImageOutput())
; background is drawn with a color that depends on the cursor distance from the window
; un fond de couleur est choisi en fonction de la distance de la souris à la fenêtre
Box(0, 0, WindowXSize, WindowYSize, (255 - Sqr(WindowMouseX * WindowMouseX + WindowMouseY * WindowMouseY) / 5))
; Each 'eye' is drawn using the called procedure
; Chaque oeil est dessiné en faisant appel à la procédure citée
Eye(WindowMouseX, WindowMouseY, WindowXSize / 4, WindowYSize / 2, WindowXSize / 8)
Eye(WindowMouseX, WindowMouseY, 3 * WindowXSize / 4, WindowYSize / 2, WindowXSize / 8)
; If the cursor is within a given rectangle a text is drawn
; Si le curseur est situé dans un périmètre défini un texte est ajouté
If WindowMouseX > 0 And WindowMouseX < 40 And WindowMouseY > 0 And WindowMouseY < 40
Label("Eyes", "Verdana", 24, 15, 9, $FFFFFF, #PB_Font_Bold | #PB_Font_HighQuality, 6, 40, 20, 4)
Label("by F.Weil", "Verdana", 12, 55, 59, $FFFFFF, #PB_Font_Bold | #PB_Font_HighQuality, 3, 80, 60, 5)
EndIf
StopDrawing()
; Copy the image to the window
; Copie de l'image dans la fenêtre
StartDrawing(WindowOutput())
DrawImage(ImageID, 0, 0)
StopDrawing()
; This delay is good enough to have a nice rendering. Maybe a bit short for PCs having a CPU less than 1GHz
; Ce délai est suffisant pour un bon rendu. Peut-être un peu court pour les PCs équipés d'une CPU de moins de 1 GHz
Delay(30)
Until Quit
EndIf
End
