Code : Tout sélectionner
#Window = 0
#Width = 600
#Height = 600
Enumeration
#Panel
#Cont
#Button
EndEnumeration
;- Initialisation de DirectX
If InitSprite() = 0 Or InitKeyboard() = 0 Or InitMouse() = 0
MessageRequester("Erreur", "Impossible d'initialiser DirectX", 0)
CloseWindow(#Window) : End
EndIf
;- Ouverture de la fenêtre et de l'écran
hwnd = OpenWindow(#Window, 0, 0, #Width, #Height, "",#PB_Window_TitleBar | #PB_Window_ScreenCentered|#PB_Window_SystemMenu )
If CreateGadgetList(hwnd)
ScrollAreaGadget(#Panel,10, 10,300,300, 1024, 768, 30)
hCont = ContainerGadget(#Cont,10,10,1024,768,#PB_Container_Double)
OpenWindowedScreen(hCont, 0, 0, 1024, 768, 0, 0, 0)
EndIf
If CreateSprite(1000,24,24)
StartDrawing(SpriteOutput(1000))
Box(0,0,24,24,RGB($0,$0,$FF))
StopDrawing()
EndIf
Dep = 8
;- début de la boucle
Repeat
ExamineMouse() ; on demande a purebasic de surveiller les event de souris !
ExamineKeyboard() ; on demande a purebasic de surveiller les event de clavier!
Select WindowEvent()
Case #PB_Event_CloseWindow
End
EndSelect
StartDrawing(ScreenOutput())
DrawText(10, 10, "touche ESC pour quitter" ,RGB(255,255,0),RGB(0,0,0))
StopDrawing()
FlipBuffers() : ClearScreen(RGB(0,0,0))
DisplaySprite(1000, x, 100)
x + Dep
If x >=536 Or x <=0 : Dep = -Dep : EndIf
Until KeyboardPushed(#PB_Key_Escape)
Code : Tout sélectionner
; Code Dobro
; Modifié pour le Purebasic V4
Declare Open_Window()
Declare WindowCallback( WindowID ,message,wParam,lParam)
Global TextGadgetBackground ,TextGadgetForeground
;- 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" )
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)
ProcedureReturn #True
EndIf
; ci-dessous la coloration des gadgets et transparence du fond !!
; la ruse consiste a lire les pixels situé a gauche de chaque text !!!
; a l'aide de "point()"
If message= #WM_CTLCOLORSTATIC And lParam = GadgetID ( #Text_0 )
xg= GadgetX ( #Text_0 )
yg= GadgetY ( #Text_0 )
StartDrawing ( ImageOutput (#Image))
Couleur = Point (xg-5, yg)
StopDrawing ()
TextGadgetBackground = CreateSolidBrush_ (Couleur)
TextGadgetForeground = RGB ($FF,$FF,$00) ; ici la couleur du text !!!
SetTextColor_ (wParam,TextGadgetForeground)
SetBkColor_ (wParam,Couleur ) ; ici la couleur du fond !!!
ProcedureReturn TextGadgetBackground
ElseIf message= #WM_CTLCOLORSTATIC And lParam = GadgetID ( #Text_1 )
xg= GadgetX ( #Text_1 )
yg= GadgetY ( #Text_1 )
StartDrawing ( ImageOutput (#Image))
Couleur = Point (xg-5, yg)
StopDrawing ()
TextGadgetBackground = CreateSolidBrush_ (Couleur)
TextGadgetForeground = RGB ($FF,$FF,$00) ; ici la couleur du text !!!
; SetBkMode_(wParam,#TRANSPARENT )
SetTextColor_ (wParam,TextGadgetForeground)
SetBkColor_ (wParam,Couleur ) ; ici la couleur du fond !!!
ProcedureReturn TextGadgetBackground
ElseIf message= #WM_CTLCOLORSTATIC And lParam = GadgetID ( #Text_2 )
xg= GadgetX ( #Text_2 )
yg= GadgetY ( #Text_2 )
StartDrawing ( ImageOutput (#Image))
Couleur = Point (xg-5, yg)
StopDrawing ()
TextGadgetBackground = CreateSolidBrush_ (Couleur)
TextGadgetForeground = RGB ($FF,$FF,$00) ; ici la couleur du text !!!
;SetBkMode_(wParam,#TRANSPARENT )
SetTextColor_ (wParam,TextGadgetForeground)
SetBkColor_ (wParam,Couleur ) ; ici la couleur du fond !!!
ProcedureReturn TextGadgetBackground
ElseIf message= #WM_CTLCOLORSTATIC And lParam = GadgetID ( #Text_3 )
xg= GadgetX ( #Text_3 )
yg= GadgetY ( #Text_3 )
StartDrawing ( ImageOutput (#Image))
Couleur = Point (xg-5, yg)
StopDrawing ()
TextGadgetBackground = CreateSolidBrush_ (Couleur)
TextGadgetForeground = RGB ($FF,$FF,$00) ; ici la couleur du text !!!
;SetBkMode_(wParam,#TRANSPARENT )
SetTextColor_ (wParam,TextGadgetForeground)
SetBkColor_ (wParam,Couleur ) ; ici la couleur du fond !!!
ProcedureReturn TextGadgetBackground
ElseIf message= #WM_CTLCOLORSTATIC And lParam = GadgetID ( #Text_4 )
xg= GadgetX ( #Text_4 )
yg= GadgetY ( #Text_4 )
StartDrawing ( ImageOutput (#Image))
Couleur = Point (xg-5, yg)
StopDrawing ()
TextGadgetBackground = CreateSolidBrush_ (Couleur)
TextGadgetForeground = RGB ($FF,$FF,$00) ; ici la couleur du text !!!
;SetBkMode_(wParam,#TRANSPARENT )
SetTextColor_ (wParam,TextGadgetForeground)
SetBkColor_ (wParam,Couleur ) ; ici la couleur du fond !!!
ProcedureReturn TextGadgetBackground
ElseIf message= #WM_CTLCOLORSTATIC And lParam = GadgetID ( #Text_5 )
xg= GadgetX ( #Text_5 )
yg= GadgetY ( #Text_5 )
StartDrawing ( ImageOutput (#Image))
Couleur = Point (xg-5, yg)
StopDrawing ()
TextGadgetBackground = CreateSolidBrush_ (Couleur)
TextGadgetForeground = RGB ($FF,$FF,$00) ; ici la couleur du text !!!
;SetBkMode_(wParam,#TRANSPARENT )
SetTextColor_ (wParam,TextGadgetForeground)
SetBkColor_ (wParam,Couleur ) ; ici la couleur du fond !!!
ProcedureReturn TextGadgetBackground
ElseIf message= #WM_CTLCOLORSTATIC And lParam = GadgetID ( #Text_6 )
xg= GadgetX ( #Text_6 )
yg= GadgetY ( #Text_6 )
StartDrawing ( ImageOutput (#Image))
Couleur = Point (xg-5, yg)
StopDrawing ()
TextGadgetBackground = CreateSolidBrush_ (Couleur)
TextGadgetForeground = RGB ($FF,$FF,$00) ; ici la couleur du text !!!
;SetBkMode_(wParam,#TRANSPARENT )
SetTextColor_ (wParam,TextGadgetForeground)
SetBkColor_ (wParam,Couleur ) ; ici la couleur du fond !!!
ProcedureReturn TextGadgetBackground
ElseIf message= #WM_CTLCOLORSTATIC And lParam = GadgetID ( #Text_7 )
xg= GadgetX ( #Text_7 )
yg= GadgetY ( #Text_7 )
StartDrawing ( ImageOutput (#Image))
Couleur = Point (xg-5, yg)
StopDrawing ()
TextGadgetBackground = CreateSolidBrush_ (Couleur)
TextGadgetForeground = RGB ($FF,$FF,$00) ; ici la couleur du text !!!
;SetBkMode_(wParam,#TRANSPARENT )
SetTextColor_ (wParam,TextGadgetForeground)
SetBkColor_ (wParam,Couleur ) ; ici la couleur du fond !!!
ProcedureReturn TextGadgetBackground
ElseIf message= #WM_CTLCOLORSTATIC And lParam = GadgetID ( #Text_8 )
xg= GadgetX ( #Text_8 )
yg= GadgetY ( #Text_8 )
StartDrawing ( ImageOutput (#Image))
Couleur = Point (xg-5, yg)
StopDrawing ()
TextGadgetBackground = CreateSolidBrush_ (Couleur)
TextGadgetForeground = RGB ($FF,$FF,$00) ; ici la couleur du text !!!
;SetBkMode_(wParam,#TRANSPARENT )
SetTextColor_ (wParam,TextGadgetForeground)
SetBkColor_ (wParam,Couleur ) ; ici la couleur du fond !!!
ProcedureReturn TextGadgetBackground
Else
ProcedureReturn #PB_ProcessPureBasicEvents
EndIf
ProcedureReturn res
EndProcedure