couleur dans les textGadget et transparence des fonds
couleur dans les textGadget et transparence des fonds
..........................
Dernière modification par Backup le sam. 19/mars/2011 16:42, modifié 3 fois.
-
- Messages : 1092
- Inscription : mer. 28/janv./2004 16:22
- Localisation : 76
- Contact :
Tu es en forme en ce moment, Dobro 

Heis Spiter, webmaster du site http://www.heisspiter.net
Développeur principal et administrateur du projet Bird Chat
Parti courir au bonheur du dév. public et GPL
Développeur principal et administrateur du projet Bird Chat
Parti courir au bonheur du dév. public et GPL

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 !!

Dernière modification par Backup le dim. 29/mai/2005 20:14, modifié 2 fois.
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
EndProcedure
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
EndProcedure
~~~~Règles du forum ~~~~
⋅.˳˳.⋅ॱ˙˙ॱ⋅.˳Ar-S ˳.⋅ॱ˙˙ॱ⋅.˳˳.⋅
W11x64 PB 6.x
Section HORS SUJET : ICI
LDV MULTIMEDIA : Dépannage informatique & mes Logiciels PB
UPLOAD D'IMAGES : Uploader des images de vos logiciels
⋅.˳˳.⋅ॱ˙˙ॱ⋅.˳Ar-S ˳.⋅ॱ˙˙ॱ⋅.˳˳.⋅
W11x64 PB 6.x
Section HORS SUJET : ICI
LDV MULTIMEDIA : Dépannage informatique & mes Logiciels PB
UPLOAD D'IMAGES : Uploader des images de vos logiciels
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+
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