PureBasic

Code : Tout sélectionner

;/
;/                             ButtonGadget_RX14
;/                   Programme Eric Ducoulombier ( Erix14 ) 
;/                  Windows XP SP2 - PureBasic 3.93 - jaPBe 2.5.4.22
;/                                   le 10/07/2005 
;/ 
Structure InfoBouton_RX14
     HandleBouton.l
     NumeroBouton.l
     TexteBouton.s
     ThreadID.l
     EtatBouton.b
EndStructure
Global ParentGadget_RX14

Declare BoutonCallBack_RX14(WindowId,message,wParam,lParam)

Procedure EventGadgetID_RX14()
     ProcedureReturn EventwParam()
EndProcedure

Procedure BoutonThread_RX14(WindowId)
     Repeat
          GetCursorPos_(PosCusor.POINT)
          GetWindowRect_(WindowId,WindowRect.RECT)
          If PtInRect_(WindowRect,PosCusor\x,PosCusor\y) = #False
               *MonBouton.InfoBouton_RX14 = GetProp_(WindowId,"InfoBouton_RX14")
               If *MonBouton
                    If *MonBouton\EtatBouton
                         *MonBouton\EtatBouton = 0
                         BoutonCallBack_RX14(WindowId,#WM_PAINT,0,0)
                         If *MonBouton\ThreadID
                              PauseThread(*MonBouton\ThreadID)
                         EndIf
                    EndIf
               EndIf
          EndIf
          Delay(10)
     ForEver
EndProcedure

Procedure BoutonCallBack_RX14(WindowId,message,wParam,lParam)
     *MonBouton.InfoBouton_RX14 = GetProp_(WindowId,"InfoBouton_RX14")
     Select message 
          Case #WM_CREATE
               Global hFontBouton
               If hFontBouton = 0
                    hFontBouton = LoadFont(0,"Times New Roman",12,#PB_Font_HighQuality)
               EndIf
          Case #WM_CLOSE 
               DestroyWindow_(WindowId) 
               ProcedureReturn 0 
          Case #WM_DESTROY 
               UnregisterClass_("Bouton_RX14", GetModuleHandle_(#Null)) 
               RemoveProp_(WindowId,"InfoBouton_RX14")
               PostQuitMessage_(0) 
               ProcedureReturn 0
          Case #WM_MOUSEMOVE
               If *MonBouton\EtatBouton = 0
                    *MonBouton\EtatBouton = 1
                    BoutonCallBack_RX14(WindowId,#WM_PAINT,0,0)
                    If *MonBouton\ThreadID
                         ResumeThread(*MonBouton\ThreadID) 
                    Else
                         *MonBouton\ThreadID = CreateThread(@BoutonThread_RX14(),WindowId)
                    EndIf
               EndIf
          Case #WM_LBUTTONDOWN
               *MonBouton\EtatBouton = 2
               BoutonCallBack_RX14(WindowId,#WM_PAINT,0,0)
               ResumeThread(*MonBouton\ThreadID)
               Parent = GetParent_(WindowId)
               While Parent <> 0
                    OldParent = Parent
                    Parent = GetParent_(Parent)
               Wend
               SendMessage_(OldParent,#wm_command,*MonBouton\NumeroBouton,*MonBouton\HandleBouton)
          Case #WM_LBUTTONUP
               *MonBouton\EtatBouton = 1
               BoutonCallBack_RX14(WindowId,#WM_PAINT,0,0)
          Case #WM_PAINT 
               Hdc.l = GetDC_(WindowId) 
               Select *MonBouton\EtatBouton
                    Case 0
                         CouleurBouton = CreateSolidBrush_(RGB(255,255,255))
                         SetTextColor_(Hdc,RGB(50,50,50))
                    Case 1
                         CouleurBouton = CreateSolidBrush_(RGB(200,200,200))
                         SetTextColor_(Hdc,RGB(0,50,0))
                    Case 2
                         CouleurBouton = CreateSolidBrush_(RGB(150,150,150))
                         SetTextColor_(Hdc,RGB(250,250,250))
               EndSelect
               GetClientRect_(WindowId,WindowRect.RECT) 
               FillRect_(Hdc,WindowRect,CouleurBouton)
               SelectObject_(Hdc, hFontBouton) 
               SetBkMode_(Hdc, #TRANSPARENT)
               DrawText_(Hdc,*MonBouton\TexteBouton,-1,WindowRect,#DT_SINGLELINE|#DT_CENTER|#DT_VCENTER)
               ReleaseDC_(WindowId, Hdc)
               DeleteObject_(CouleurBouton)
               ValidateRect_(WindowId,0)
     EndSelect 
     ProcedureReturn DefWindowProc_(WindowId,message,wParam,lParam)
EndProcedure
Procedure ButtonGadget_RX14(Numero,x,y,Width,Height,Texte.s)
     wc.WNDCLASSEX 
     wc\cbSize = SizeOf(WNDCLASSEX)
     hInstance = GetModuleHandle_(#Null)
     If GetClassInfoEx_(hInstance,@"Bouton_RX14",@wc) = 0
          wc.WNDCLASSEX 
          wc\cbSize = SizeOf(WNDCLASSEX) 
          wc\lpfnWndProc = @BoutonCallBack_RX14() 
          wc\hInstance = hInstance 
          wc\lpszClassName = @"Bouton_RX14" 
          If RegisterClassEx_(@wc) = 0
               ProcedureReturn 0
          EndIf
     EndIf
     If ParentGadget_RX14 = 0
          ParentGadget_RX14 = WindowID()
     EndIf
     HandleBouton = CreateWindowEx_(#Null,"Bouton_RX14","",#WS_CHILD|#WS_CLIPSIBLINGS|#WS_VISIBLE,x,y,Width,Height,ParentGadget_RX14,0,hInstance,0) 
     *MonBouton.InfoBouton_RX14 = AllocateMemory(SizeOf(InfoBouton_RX14))
     *MonBouton.InfoBouton_RX14\HandleBouton = HandleBouton
     *MonBouton\NumeroBouton = Numero
     *MonBouton\TexteBouton = Texte
     *MonBouton\ThreadID = 0
     *MonBouton\EtatBouton = 0
     SetProp_(HandleBouton,"InfoBouton_RX14",*MonBouton)
     ShowWindow_(HandleBouton,#SW_SHOWNORMAL)
     ProcedureReturn HandleBouton
EndProcedure
;/
;-        Exemple ButtonGadget_RX14
;/
If OpenWindow(0,0,0,400,200,#PB_Window_ScreenCentered | #PB_Window_SystemMenu,"Exemple ButtonGadget_RX14")
     CreateGadgetList(WindowID())
     ListViewGadget(0,130,10,250,180)
     ; Par défaut le Handle parent du gadget est WindowID()
     ; Il se trouve dans la variable ParentGadget_RX14
     ButtonGadget_RX14(6,10,160,110,20,"Quitter")
     ParentGadget_RX14 = Frame3DGadget(1,5,10,120,140,"ButtonGadget_RX14")
     ; Maintenant le parent du gadget est le Frame3DGadget
     For t=1 To 5
          ButtonGadget_RX14(t,10,t*21,100,20,"Bouton "+Str(t))
     Next
     
     Repeat 
          Event = WaitWindowEvent()
          Select Event
               Case #PB_Event_Gadget
                    Select EventGadgetID_RX14()
                         Case 1
                              AddGadgetItem(0,-1,"Click sur le bouton 1")
                         Case 2
                              AddGadgetItem(0,-1,"Click sur le bouton 2")
                         Case 3
                              AddGadgetItem(0,-1,"Click sur le bouton 3")
                         Case 4
                              AddGadgetItem(0,-1,"Click sur le bouton 4")
                         Case 5
                              AddGadgetItem(0,-1,"Click sur le bouton 5")
                         Case 6
                              quit = #True
                    EndSelect
               Case #PB_Event_CloseWindow
                    quit = #True
          EndSelect
     Until quit
EndIf