couleur dans les textGadget et transparence des fonds
Publié : dim. 29/mai/2005 19:27
..........................
PureBasic
Forums PureBasic - Français
http://forums.purebasic.com/french/
couleur dans les textGadget et transparence des fonds
Page 1 sur 1
Publié : dim. 29/mai/2005 19:38
Tu es en forme en ce moment, Dobro
Publié : dim. 29/mai/2005 19:43
Vraiment du joli travail !
C'est vrai qu'en ce moment il fourni à tout va le Dobro.
C'est vrai qu'en ce moment il fourni à tout va le Dobro.
Publié : dim. 29/mai/2005 19:59
Merci ! 
voici comment seron mes aplications dorenavent !!
ci-dessous mon verifficateur d'euro-million !
http://michel.dobro.free.fr//Purebasic/euro_million.zip
et mon verificateur de jeux de loto
http://michel.dobro.free.fr//Purebasic/loto.zip
ps : pour ceux qui utilisai deja mes petits utilitaires , j'ai fait en sorte que ces
deux programme enregistre le Path des fichier qu'ils sauve et qu'ils lisent !!
parceque c'etait pas pratique d'avoir a rechercher systematiquement les fichier sauvegardé dans une grande arborescence !!
voici comment seron mes aplications dorenavent !!
ci-dessous mon verifficateur d'euro-million !
http://michel.dobro.free.fr//Purebasic/euro_million.zip
et mon verificateur de jeux de loto
http://michel.dobro.free.fr//Purebasic/loto.zip
ps : pour ceux qui utilisai deja mes petits utilitaires , j'ai fait en sorte que ces
deux programme enregistre le Path des fichier qu'ils sauve et qu'ils lisent !!
parceque c'etait pas pratique d'avoir a rechercher systematiquement les fichier sauvegardé dans une grande arborescence !!
Publié : dim. 29/mai/2005 20:08
Sympatique , Sinon on peut aussi faire ça avec un image gadget sans bords et figé (rein que ça) je l'avais déjà posté
Sinon les posts sont limmités en nombre de caractères, donc ton Simulateur d'euromillion n'est pas en entier
, Sinon on peut aussi faire ça avec un image gadget sans bords et figé (rein que ça) je l'avais déjà posté Sinon les posts sont limmités en nombre de caractères, donc ton Simulateur d'euromillion n'est pas en entier
Publié : dim. 29/mai/2005 20:11
j'ai mis des liens vers les appli modifié !!
c'est plus simple !
c'est plus simple !
Publié : dim. 29/mai/2005 20:43
chapeau Dobro
Publié : mer. 30/août/2006 16:20
code modifié pour le purebasic V4
Publié : jeu. 31/août/2006 8:00
Pour info, voici la version pour PureCOLOR : plus court et transparence parfaite.
Code : Tout sélectionner
; Code Dobro
; Modifié pour le Purebasic V4
; Modifié pour PureCOLOR par gnozal
Declare Open_Window()
Declare WindowCallback( WindowID ,message,wParam,lParam)
;- Window Constants
;
Enumeration
#Window
EndEnumeration
;- Gadget Constants
;
Enumeration
#Text_0
#Text_1
#Text_2
#Text_3
#Text_4
#Text_5
#Text_6
#Text_7
#Text_8
#exit
#Image
EndEnumeration
; creer l'image qui va recevoir le dessin du fond !
CreateImage ( #Image , 242, 383) ; ici format de 471*518 mais il faut respecter la taille de ta fenetre !!
image_id= ImageID (#Image)
;- Fonts
;
Global FontID1
FontID1 = LoadFont (1, "Arial" , 14, #PB_Font_Bold )
Open_Window()
; boucle principale !
Repeat
Event = WaitWindowEvent ()
If Event = #PB_Event_Gadget
GadgetID = EventGadget ()
If GadgetID = #exit
DeleteObject_ (TextGadgetBackground)
End
EndIf
EndIf
Until Event = #PB_Event_CloseWindow
End
;
Procedure Open_Window()
If OpenWindow ( #Window , 356, 99, 242, 383,"New window ( 0 )", #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_TitleBar )
SetWindowCallback (@WindowCallback()) ; un callback pour que le dessin reste sur la fenetre (repaint)
;*************************dessine dans l'image notre fond ! ici un degradé violet ****************
StartDrawing ( ImageOutput (#Image))
coul.f=0
For y=0 To WindowHeight (#Window)+30
coul=coul+0.5
LineXY (0, y, WindowWidth (#Window), y, RGB (coul,0,coul))
Next y
StopDrawing ()
; *******************************************************************************
If CreateGadgetList ( WindowID (#Window))
TextGadget ( #Text_0 , 84, 0, 69, 30, "TEXT " )
SetGadgetFont ( #Text_0 , FontID1)
TextGadget ( #Text_1 , 84, 36, 69, 30, "TEXT " )
SetGadgetFont ( #Text_1 , FontID1)
TextGadget ( #Text_2 , 84, 72, 69, 30, "TEXT " )
SetGadgetFont ( #Text_2 , FontID1)
TextGadget ( #Text_3 , 84, 108, 69, 30, "TEXT " )
SetGadgetFont ( #Text_3 , FontID1)
TextGadget ( #Text_4 , 87, 150, 69, 30, "TEXT " )
SetGadgetFont ( #Text_4 , FontID1)
TextGadget ( #Text_5 , 87, 195, 69, 30, "TEXT " )
SetGadgetFont ( #Text_5 , FontID1)
TextGadget ( #Text_6 , 87, 234, 69, 30, "TEXT " )
SetGadgetFont ( #Text_6 , FontID1)
TextGadget ( #Text_7 , 84, 276, 69, 30, "TEXT " )
SetGadgetFont ( #Text_7 , FontID1)
TextGadget ( #Text_8 , 84, 318, 69, 30, "TEXT " )
SetGadgetFont ( #Text_8 , FontID1)
ButtonGadget ( #exit , 69, 351, 93, 30, "ok" )
;
; Ajouter les couleurs
For i = #Text_0 To #Text_8
PureCOLOR_SetGadgetColor(i, RGB ($FF,$FF,$00), #PureCOLOR_DontSetBackColor)
Next
; Mise à jour de l'affichage la 1ère fois
InvalidateRect_(WindowID(#Window),0, #False)
; C'est terminé
;
EndIf
EndIf
EndProcedure
Procedure WindowCallback( WindowID ,message,wParam,lParam)
res= #PB_ProcessPureBasicEvents
If message= #WM_PAINT
Form1= WindowID ( #Window )
bitmap= ImageID (#Image)
ps.PAINTSTRUCT
hdc= BeginPaint_ (Form1,ps)
hdcMem= CreateCompatibleDC_ (hdc)
SelectObject_ (hdcMem,bitmap)
BitBlt_ (hdc,1,1, WindowWidth (#Window ), WindowHeight (#Window )+30,hdcMem,0,0, #SRCCOPY )
ReleaseDC_ ( WindowID (#Window ),hdc)
DeleteDC_ (hdcMem)
DeleteObject_ (hdcMem)
EndPaint_ (Form1,ps)
res = #True
EndIf
ProcedureReturn res
EndProcedurePublié : jeu. 31/août/2006 10:41
Merci Gnozal
Publié : lun. 04/sept./2006 3:14
Merci pour le code Dobro.
Publié : dim. 09/août/2009 17:16
Allez, hop, je déterre le topic!
J'utilise purecolor pour mes textgadgets transparents... Mais j'ai un soucis: si je met à jour le contenu de mon textgadget, j'ai superposition des texts, en gros j'arrive pas à effacer la couche de texte précédente... Comment qu'on fait?
J'utilise purecolor pour mes textgadgets transparents... Mais j'ai un soucis: si je met à jour le contenu de mon textgadget, j'ai superposition des texts, en gros j'arrive pas à effacer la couche de texte précédente... Comment qu'on fait?
Publié : lun. 10/août/2009 0:34
C'est bien jolie 
Par contre vous aimez bien répéter
Par contre vous aimez bien répéter
Code : Tout sélectionner
SetGadgetFont (.....)Code : Tout sélectionner
; Code Dobro
; Modifié pour le Purebasic V4
; Modifié pour PureCOLOR par gnozal
Declare Open_Window()
Declare WindowCallback( WindowID ,message,wParam,lParam)
;
Enumeration
#Window
#Text_0 : #Text_1 : #Text_2 : #Text_3 : #Text_4 : #Text_5 : #Text_6 : #Text_7 : #Text_8 : #exit : #Image
EndEnumeration
; creer l'image qui va recevoir le dessin du fond !
CreateImage ( #Image , 242, 383) ; ici format de 471*518 mais il faut respecter la taille de ta fenetre !!
image_id= ImageID (#Image)
;- Fonts
;
Global FontID1
FontID1 = LoadFont (1, "Arial" , 14, #PB_Font_Bold )
SetGadgetFont(#PB_Default, FontID(1)) ; *ajout d'Ar-S - Par defaut comme ça on évite d'atribuer la fonte à chaque bouton
Open_Window()
; boucle principale !
Repeat
Event = WaitWindowEvent ()
If Event = #PB_Event_Gadget
GadgetID = EventGadget ()
If GadgetID = #exit
DeleteObject_ (TextGadgetBackground)
End
EndIf
EndIf
Until Event = #PB_Event_CloseWindow
End
Procedure Open_Window()
If OpenWindow ( #Window , 356, 99, 242, 383,"New window ( 0 )", #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_TitleBar )
SetWindowCallback (@WindowCallback()) ; un callback pour que le dessin reste sur la fenetre (repaint)
;*************************dessine dans l'image notre fond ! ici un degradé violet ****************
StartDrawing ( ImageOutput (#Image))
coul.f=0
For y=0 To WindowHeight (#Window)+30
coul=coul+0.5
LineXY (0, y, WindowWidth (#Window), y, RGB (coul,0,coul))
Next y
StopDrawing ()
; *******************************************************************************
If CreateGadgetList ( WindowID (#Window))
TextGadget ( #Text_0 , 84, 0, 69, 30, "TEXT " )
TextGadget ( #Text_1 , 84, 36, 69, 30, "TEXT " )
TextGadget ( #Text_2 , 84, 72, 69, 30, "TEXT " )
TextGadget ( #Text_3 , 84, 108, 69, 30, "TEXT " )
TextGadget ( #Text_4 , 87, 150, 69, 30, "TEXT " )
TextGadget ( #Text_5 , 87, 195, 69, 30, "TEXT " )
TextGadget ( #Text_6 , 87, 234, 69, 30, "TEXT " )
TextGadget ( #Text_7 , 84, 276, 69, 30, "TEXT " )
TextGadget ( #Text_8 , 84, 318, 69, 30, "TEXT " )
ButtonGadget ( #exit , 69, 351, 93, 30, "ok" )
;
; Ajouter les couleurs
For i = #Text_0 To #Text_8
PureCOLOR_SetGadgetColor(i, RGB ($FF,$FF,$00), #PureCOLOR_DontSetBackColor)
Next
; Mise à jour de l'affichage la 1ère fois
InvalidateRect_(WindowID(#Window),0, #False)
; C'est terminé
;
EndIf
EndIf
EndProcedure
Procedure WindowCallback( WindowID ,message,wParam,lParam)
res= #PB_ProcessPureBasicEvents
If message= #WM_PAINT
Form1= WindowID ( #Window )
bitmap= ImageID (#Image)
ps.PAINTSTRUCT
hdc= BeginPaint_ (Form1,ps)
hdcMem= CreateCompatibleDC_ (hdc)
SelectObject_ (hdcMem,bitmap)
BitBlt_ (hdc,1,1, WindowWidth (#Window ), WindowHeight (#Window )+30,hdcMem,0,0, #SRCCOPY )
ReleaseDC_ ( WindowID (#Window ),hdc)
DeleteDC_ (hdcMem)
DeleteObject_ (hdcMem)
EndPaint_ (Form1,ps)
res = #True
EndIf
ProcedureReturn res
EndProcedurePublié : lun. 10/août/2009 21:42
Bonjour à tous
et avec des zones qui clignotent
Ou sans utiliser PURECOLOR
Si l'on a qu'une zone qui clignote les mutex(s) ne sont pas indispensables
A+
et avec des zones qui clignotent
Code : Tout sélectionner
Structure gadcol
gd.l
rgb_t1.l
rgb_f1.l
rgb_t2.l
rgb_f2.l
t_1.l
t_2.l
EndStructure
Procedure thread_col1(*gad.gadcol)
Shared mutex
Repeat
LockMutex(Mutex)
PureCOLOR_SetGadgetColor(*gad\gd, *gad\rgb_t1, *gad\rgb_f1)
UnlockMutex(Mutex)
Delay(*gad\t_1)
LockMutex(Mutex)
PureCOLOR_SetGadgetColor(*gad\gd, *gad\rgb_t2, *gad\rgb_f2)
UnlockMutex(Mutex)
Delay(*gad\t_2)
ForEver
EndProcedure
If OpenWindow(0,0,0,270,160,"TextGadget",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
Define thr_col1.gadcol
With thr_col1
\gd.l=3
\rgb_t1.l=RGB(255,0,0)
\rgb_f1.l=RGB(0,0,0)
\rgb_t2.l=RGB(255,0,0)
\rgb_f2.l=RGB(255,255,255)
\t_1.l=500
\t_2.l=300
EndWith
Define thr_col2.gadcol
With thr_col2
\gd.l=1
\rgb_t1.l=RGB(255,255,0)
\rgb_f1.l=RGB(0,0,0)
\rgb_t2.l=RGB(255,0,0)
\rgb_f2.l=RGB(255,255,255)
\t_1.l=500
\t_2.l=300
EndWith
Debug f_n(thr_col1\gd)+f_n(thr_col1\rgb_t1)+f_n(thr_col1\rgb_f1)+f_n(thr_col1\rgb_T2)+f_n(thr_col1\rgb_f2)+f_n(thr_col1\t_1)+f_n(thr_col1\t_2)
Debug f_n(thr_col2\gd)+f_n(thr_col2\rgb_t1)+f_n(thr_col2\rgb_f1)+f_n(thr_col2\rgb_T2)+f_n(thr_col2\rgb_f2)+f_n(thr_col2\t_1)+f_n(thr_col2\t_2)
TextGadget(0, 10, 10,250,20,"Gadget texte standard (texte aligné à gauche)")
TextGadget(1, 10, 40,250,20,"Gadget texte (texte aligné à droite)",#PB_Text_Right)
TextGadget(2, 10, 70,250,20,"Gadget texte (texte centré)",#PB_Text_Center)
TextGadget(3, 10,100,250,20,"Gadget texte avec bordure",#PB_Text_Border)
TextGadget(4, 10,130,250,20,"Gadget texte (texte centré) + bordure",#PB_Text_Center|#PB_Text_Border)
Mutex = CreateMutex()
Thread1 = CreateThread(@thread_col1(), @thr_col1)
Delay(25)
Thread2 = CreateThread(@thread_col1(), @thr_col2)
Repeat
Until WaitWindowEvent()=#PB_Event_CloseWindow
EndIf
Code : Tout sélectionner
Structure gadcol
gd.l
rgb_t1.l
rgb_f1.l
rgb_t2.l
rgb_f2.l
t_1.l
t_2.l
EndStructure
Procedure thread_col1(*gad.gadcol)
Shared mutex
Repeat
LockMutex(Mutex)
SetGadgetColor(*gad\gd, #PB_Gadget_BackColor, *gad\rgb_f1)
SetGadgetColor(*gad\gd, #PB_Gadget_FrontColor,*gad\rgb_t1)
; PureCOLOR_SetGadgetColor(*gad\gd, *gad\rgb_t1, *gad\rgb_f1)
UnlockMutex(Mutex)
Delay(*gad\t_1)
LockMutex(Mutex)
; PureCOLOR_SetGadgetColor(*gad\gd, *gad\rgb_t2, *gad\rgb_f2)
SetGadgetColor(*gad\gd, #PB_Gadget_BackColor, *gad\rgb_f2)
SetGadgetColor(*gad\gd, #PB_Gadget_FrontColor,*gad\rgb_t2)
UnlockMutex(Mutex)
Delay(*gad\t_2)
ForEver
EndProcedure
If OpenWindow(0,0,0,270,160,"TextGadget",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
Define thr_col1.gadcol
With thr_col1
\gd.l=3
\rgb_t1.l=RGB(255,0,0)
\rgb_f1.l=RGB(0,0,0)
\rgb_t2.l=RGB(255,0,0)
\rgb_f2.l=RGB(255,255,255)
\t_1.l=500
\t_2.l=300
EndWith
Define thr_col2.gadcol
With thr_col2
\gd.l=1
\rgb_t1.l=RGB(255,255,0)
\rgb_f1.l=RGB(0,0,0)
\rgb_t2.l=RGB(255,0,0)
\rgb_f2.l=RGB(0,0,255)
\t_1.l=500
\t_2.l=300
EndWith
Debug f_n(thr_col1\gd)+f_n(thr_col1\rgb_t1)+f_n(thr_col1\rgb_f1)+f_n(thr_col1\rgb_T2)+f_n(thr_col1\rgb_f2)+f_n(thr_col1\t_1)+f_n(thr_col1\t_2)
Debug f_n(thr_col2\gd)+f_n(thr_col2\rgb_t1)+f_n(thr_col2\rgb_f1)+f_n(thr_col2\rgb_T2)+f_n(thr_col2\rgb_f2)+f_n(thr_col2\t_1)+f_n(thr_col2\t_2)
TextGadget(0, 10, 10,250,20,"Gadget texte standard (texte aligné à gauche)")
TextGadget(1, 10, 40,250,20,"Gadget texte (texte aligné à droite)",#PB_Text_Right)
TextGadget(2, 10, 70,250,20,"Gadget texte (texte centré)",#PB_Text_Center)
TextGadget(3, 10,100,250,20,"Gadget texte avec bordure",#PB_Text_Border)
TextGadget(4, 10,130,250,20,"Gadget texte (texte centré) + bordure",#PB_Text_Center|#PB_Text_Border)
Mutex = CreateMutex()
Thread1 = CreateThread(@thread_col1(), @thr_col1)
Delay(25)
Thread2 = CreateThread(@thread_col1(), @thr_col2)
Repeat
Until WaitWindowEvent()=#PB_Event_CloseWindow
EndIf
Si l'on a qu'une zone qui clignote les mutex(s) ne sont pas indispensables
A+
Publié : jeu. 13/août/2009 11:50
Bonjour à tous
j'ai ajouté un clignotement au code de Dobro modifié par Gnozal
j'ai choisi le gadget N° 5 et j'ai gardé la transparence
La structure que je passe au Thread est plus complexe qu'il est
nécessaire mais cette structure me sert pour d'autre essai de clignotement
et je n'ai pas voulu la modifier
Ou avec 2 gadgets N°2 et N°5
A+
j'ai ajouté un clignotement au code de Dobro modifié par Gnozal
j'ai choisi le gadget N° 5 et j'ai gardé la transparence
La structure que je passe au Thread est plus complexe qu'il est
nécessaire mais cette structure me sert pour d'autre essai de clignotement
et je n'ai pas voulu la modifier
Code : Tout sélectionner
; Pour info, voici la version pour PureCOLOR : plus court et transparence parfaite.
;
; Code:
; Code Dobro Gnozal modif PP pour clignotement gadget N°5 ou un autre au choix tout en gardant la transparence
; Modifié pour le Purebasic V4
; Modifié pour PureCOLOR par gnozal
Structure gadcol
gd.l
rgb_t.l
rgb_f.l
t_dnv.l ; temps deb non verrouillé
t_dv.l ; temps deb verrouillé
t_fv.l ; temps fin non verrouillé
t_fnv.l ; temps fin verrouillé
EndStructure
Declare Open_Window()
Declare WindowCallback(WindowID,message,wParam,lParam)
Declare clignote(*gad.gadcol)
;- Window Constants
;
Enumeration
#Window
EndEnumeration
;- Gadget Constants
;
Enumeration
#Text_0
#Text_1
#Text_2
#Text_3
#Text_4
#Text_5
#Text_6
#Text_7
#Text_8
#exit
#Image
EndEnumeration
; creer l'image qui va recevoir le dessin du fond !
CreateImage(#Image,242,383) ; ici format de 471*518 mais il faut respecter la taille de ta fenetre !!
image_id=ImageID(#Image)
;- Fonts
;
Global FontID1
FontID1=LoadFont(1,"Arial",14,#PB_Font_Bold)
Open_Window()
Define thr_col11.gadcol
With thr_col11
\gd=5
; \rgb_t=Couleur=GetGadgetColor(thr_col11\gd,#PB_Gadget_FrontColor)
\rgb_t=RGB($FF,$FF,0)
\rgb_f=RGB($FF,0,0)
\t_dnv=200
\t_dv=100
\t_fv=200
\t_fnv=100
EndWith
mutex=CreateMutex()
TH1=CreateThread(@clignote(),@thr_col11)
; boucle principale !
Repeat
Event = WaitWindowEvent ()
If Event = #PB_Event_Gadget
GadgetID = EventGadget ()
If GadgetID = #exit
DeleteObject_ (TextGadgetBackground)
End
EndIf
EndIf
Until Event = #PB_Event_CloseWindow
End
;
Procedure Open_Window()
If OpenWindow(#Window,356,99,242,383,"New window ( 0 )",#PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_TitleBar)
SetWindowCallback(@WindowCallback()) ; un callback pour que le dessin reste sur la fenetre (repaint)
;*************************dessine dans l'image notre fond ! ici un degradé violet ****************
StartDrawing(ImageOutput(#Image))
coul.f=0
For y=0 To WindowHeight(#Window)+30
coul=coul+0.5
LineXY(0,y,WindowWidth(#Window),y,RGB(coul,0,coul))
Next y
StopDrawing()
; *******************************************************************************
If UseGadgetList(WindowID(#Window))
TextGadget(#Text_0,84,0,69,30,"TEXT0 ")
SetGadgetFont(#Text_0,FontID1)
TextGadget(#Text_1,84,36,69,30,"TEXT1 ")
SetGadgetFont(#Text_1,FontID1)
TextGadget(#Text_2,84,72,69,30,"TEXT2 ")
SetGadgetFont(#Text_2,FontID1)
TextGadget(#Text_3,84,108,69,30,"TEXT3 ")
SetGadgetFont(#Text_3,FontID1)
TextGadget(#Text_4,87,150,69,30,"TEXT4 ")
SetGadgetFont(#Text_4,FontID1)
TextGadget(#Text_5,87,195,69,30,"TEXT5 ")
SetGadgetFont(#Text_5,FontID1)
TextGadget(#Text_6,87,234,69,30,"TEXT6 ")
SetGadgetFont(#Text_6,FontID1)
TextGadget(#Text_7,84,276,69,30,"TEXT7 ")
SetGadgetFont(#Text_7,FontID1)
TextGadget(#Text_8,84,318,69,30,"TEXT8 ")
SetGadgetFont(#Text_8,FontID1)
ButtonGadget(#exit,69,351,93,30,"ok")
;
; Ajouter les couleurs
For i=#Text_0 To #Text_8
PureCOLOR_SetGadgetColor(i,RGB($FF,$FF,$00),#PureCOLOR_DontSetBackColor)
Next
; Mise à jour de l'affichage la 1ère fois
InvalidateRect_(WindowID(#Window),0,#False)
; C'est terminé
;
EndIf
EndIf
EndProcedure
Procedure WindowCallback(WindowID,message,wParam,lParam)
res=#PB_ProcessPureBasicEvents
If message=#WM_PAINT
Form1=WindowID(#Window)
bitmap=ImageID(#Image)
ps.PAINTSTRUCT
hdc=BeginPaint_(Form1,ps)
hdcMem=CreateCompatibleDC_(hdc)
SelectObject_(hdcMem,bitmap)
BitBlt_(hdc,1,1,WindowWidth(#Window),WindowHeight(#Window)+30,hdcMem,0,0,#SRCCOPY)
ReleaseDC_(WindowID(#Window),hdc)
DeleteDC_(hdcMem)
DeleteObject_(hdcMem)
EndPaint_(Form1,ps)
res=#True
EndIf
ProcedureReturn res
EndProcedure
Procedure clignote (*gad.gadcol)
; Structure gadcol
; gd.l
; rgb_t.l
; rgb_f.l
; t_dnv.l ; temps deb non verrouillé
; t_dv.l ; temps deb verrouillé
; t_fv.l ; temps fin non verrouillé
; t_fnv.l ; temps fin verrouillé
; EndStructure
Shared mutex
Repeat
Delay(*gad\t_dnv)
LockMutex(Mutex)
Delay(*gad\t_dv)
PureCOLOR_SetGadgetColor(*gad\gd,*gad\rgb_t,#PureCOLOR_DontSetBackColor)
Delay(*gad\t_fv)
UnlockMutex(Mutex)
Delay(*gad\t_fnv)
Delay(*gad\t_dnv)
LockMutex(Mutex)
Delay(*gad\t_dv)
PureCOLOR_SetGadgetColor(*gad\gd,*gad\rgb_f,#PureCOLOR_DontSetBackColor)
Delay(*gad\t_fv)
UnlockMutex(Mutex)
Delay(*gad\t_fnv)
ForEver
EndProcedure
Code : Tout sélectionner
; Pour info, voici la version pour PureCOLOR : plus court et transparence parfaite.
;
; Code:
; Code Dobro Gnozal modif PP pour clignotement gadget N°5 et N°2 ou un autre au choix tout en gardant la transparence
; Modifié pour le Purebasic V4
; Modifié pour PureCOLOR par gnozal
Structure gadcol
gd.l
rgb_t.l
rgb_f.l
t_dnv.l ; temps deb non verrouillé
t_dv.l ; temps deb verrouillé
t_fv.l ; temps fin non verrouillé
t_fnv.l ; temps fin verrouillé
EndStructure
Declare Open_Window()
Declare WindowCallback(WindowID,message,wParam,lParam)
Declare clignote(*gad.gadcol)
;- Window Constants
;
Enumeration
#Window
EndEnumeration
;- Gadget Constants
;
Enumeration
#Text_0
#Text_1
#Text_2
#Text_3
#Text_4
#Text_5
#Text_6
#Text_7
#Text_8
#exit
#Image
EndEnumeration
; creer l'image qui va recevoir le dessin du fond !
CreateImage(#Image,242,383) ; ici format de 471*518 mais il faut respecter la taille de ta fenetre !!
image_id=ImageID(#Image)
;- Fonts
;
Global FontID1
FontID1=LoadFont(1,"Arial",14,#PB_Font_Bold)
Open_Window()
Define thr_col11.gadcol
With thr_col11
\gd=5
; \rgb_t=PureCOLOR_GetGadgetColor(thr_col11\gd,TextColor)
\rgb_f=RGB($FF,$FF,0)
\rgb_t=RGB($FF,0,$FF)
\t_dnv=200
\t_dv=100
\t_fv=200
\t_fnv=100
EndWith
Define thr_col12.gadcol
With thr_col12
\gd=2
; \rgb_t=PureCOLOR_GetGadgetColor(thr_col11\gd,TextColor)
\rgb_f=RGB($FF,$FF,0)
\rgb_t=RGB(0,$FF,$FF)
\t_dnv=200
\t_dv=100
\t_fv=200
\t_fnv=100
EndWith
mutex=CreateMutex()
TH1=CreateThread(@clignote(),@thr_col11)
TH2=CreateThread(@clignote(),@thr_col12)
; boucle principale !
Repeat
Event = WaitWindowEvent ()
If Event = #PB_Event_Gadget
GadgetID = EventGadget ()
If GadgetID = #exit
DeleteObject_ (TextGadgetBackground)
End
EndIf
EndIf
Until Event = #PB_Event_CloseWindow
End
;
Procedure Open_Window()
If OpenWindow(#Window,356,99,242,383,"New window ( 0 )",#PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_TitleBar)
SetWindowCallback(@WindowCallback()) ; un callback pour que le dessin reste sur la fenetre (repaint)
;*************************dessine dans l'image notre fond ! ici un degradé violet ****************
StartDrawing(ImageOutput(#Image))
coul.f=0
For y=0 To WindowHeight(#Window)+30
coul=coul+0.5
LineXY(0,y,WindowWidth(#Window),y,RGB(coul,0,coul))
Next y
StopDrawing()
; *******************************************************************************
If UseGadgetList(WindowID(#Window))
TextGadget(#Text_0,84,0,69,30,"TEXT0 ")
SetGadgetFont(#Text_0,FontID1)
TextGadget(#Text_1,84,36,69,30,"TEXT1 ")
SetGadgetFont(#Text_1,FontID1)
TextGadget(#Text_2,84,72,69,30,"TEXT2 ")
SetGadgetFont(#Text_2,FontID1)
TextGadget(#Text_3,84,108,69,30,"TEXT3 ")
SetGadgetFont(#Text_3,FontID1)
TextGadget(#Text_4,87,150,69,30,"TEXT4 ")
SetGadgetFont(#Text_4,FontID1)
TextGadget(#Text_5,87,195,69,30,"TEXT5 ")
SetGadgetFont(#Text_5,FontID1)
TextGadget(#Text_6,87,234,69,30,"TEXT6 ")
SetGadgetFont(#Text_6,FontID1)
TextGadget(#Text_7,84,276,69,30,"TEXT7 ")
SetGadgetFont(#Text_7,FontID1)
TextGadget(#Text_8,84,318,69,30,"TEXT8 ")
SetGadgetFont(#Text_8,FontID1)
ButtonGadget(#exit,69,351,93,30,"ok")
;
; Ajouter les couleurs
For i=#Text_0 To #Text_8
PureCOLOR_SetGadgetColor(i,RGB($FF,$FF,$00),#PureCOLOR_DontSetBackColor)
Next
; Mise à jour de l'affichage la 1ère fois
InvalidateRect_(WindowID(#Window),0,#False)
; C'est terminé
;
EndIf
EndIf
EndProcedure
Procedure WindowCallback(WindowID,message,wParam,lParam)
res=#PB_ProcessPureBasicEvents
If message=#WM_PAINT
Form1=WindowID(#Window)
bitmap=ImageID(#Image)
ps.PAINTSTRUCT
hdc=BeginPaint_(Form1,ps)
hdcMem=CreateCompatibleDC_(hdc)
SelectObject_(hdcMem,bitmap)
BitBlt_(hdc,1,1,WindowWidth(#Window),WindowHeight(#Window)+30,hdcMem,0,0,#SRCCOPY)
ReleaseDC_(WindowID(#Window),hdc)
DeleteDC_(hdcMem)
DeleteObject_(hdcMem)
EndPaint_(Form1,ps)
res=#True
EndIf
ProcedureReturn res
EndProcedure
Procedure clignote (*gad.gadcol)
; Structure gadcol
; gd.l
; rgb_t.l
; rgb_f.l
; t_dnv.l ; temps deb non verrouillé
; t_dv.l ; temps deb verrouillé
; t_fv.l ; temps fin non verrouillé
; t_fnv.l ; temps fin verrouillé
; EndStructure
Shared mutex
Repeat
Delay(*gad\t_dnv)
LockMutex(Mutex)
Delay(*gad\t_dv)
PureCOLOR_SetGadgetColor(*gad\gd,*gad\rgb_t,#PureCOLOR_DontSetBackColor)
Delay(*gad\t_fv)
UnlockMutex(Mutex)
Delay(*gad\t_fnv)
Delay(*gad\t_dnv)
LockMutex(Mutex)
Delay(*gad\t_dv)
PureCOLOR_SetGadgetColor(*gad\gd,*gad\rgb_f,#PureCOLOR_DontSetBackColor)
Delay(*gad\t_fv)
UnlockMutex(Mutex)
Delay(*gad\t_fnv)
ForEver
EndProcedure