Code : Tout sélectionner
, mais le résultat tient dans une chaine ?;********** on redefini la taille du buffer de chaine$ ****************
#StringLength = 1048576
SetStringManipulationBufferSize(#StringLength)
;********************************************
Procedure SetStringManipulationBufferSize(Bytes)
;***************************************************************
;* Modifie la taille du buffer pour la manipulation de chaînes *
;* par défaut = 63999 octets *
;* A appeler impérativement avant toute utilisation de chaînes *
;***************************************************************
PBStringBase.l = 0
PBMemoryBase.l = 0
!MOV eax, dword [PB_StringBase]
!MOV [esp+4],eax
!MOV eax, dword [PB_MemoryBase]
!MOV [esp+8],eax
HeapReAlloc_(PBMemoryBase, #GMEM_ZEROINIT, PBStringBase, Bytes)
!MOV dword [_PB_StringBase],eax
EndProcedure
Gillou m'a filé un code pour ça !! on verra apresOliv a écrit :ça pourrait aussi être sympa de reprendre les couleurs du fichier de configuration de l'IDE
)
; ***** ICi METTRE le NOM d'une IMAGE PLACe a COTe DU PRG *****
nom_chemin_image$= "navig.png"
; votre image doit etre de la taille de votre ecran (1024*768 ) par exemple !
; *************************************************************
;- Window Constants
;
UsePNGImageDecoder ()
Declare WindowCallback( WindowID ,message,wParam,lParam)
Declare Open_Window_navig()
Enumeration
#Window_navig
EndEnumeration
;- Gadget Constants
;
Enumeration
#String_adresse
#Button_ok
#ButtonImage_retour
#ButtonImage_aller
#ButtonImage_repete
#ButtonImage_stop
#Web_0
EndEnumeration
EcranX = GetSystemMetrics_ ( #SM_CXSCREEN ): ;=largeur de l'ecran
EcranY = GetSystemMetrics_ ( #SM_CYSCREEN ): ;=hauteur de l'ecran
;- Image Plugins
;- Image Globals
Global Image0, EcranX,EcranY
Global Image1
Global Image2
Global Image3
Global bitmap
Global Form1
;- Catch Images
; Image0 = CatchImage(0, ?Image0)
; Image1 = CatchImage(1, ?Image1)
; Image2 = CatchImage(2, ?Image2)
; Image3 = CatchImage(3, ?Image3)
; ;- Images
; DataSection
; Image0:
; IncludeBinary "D:\purebasic\PureBasic\dobro\Dobro creation\colorer\retour.bmp"
; Image1:
; IncludeBinary "D:\purebasic\PureBasic\dobro\Dobro creation\colorer\aller.bmp"
; Image2:
; IncludeBinary "D:\purebasic\PureBasic\dobro\Dobro creation\colorer\repete.bmp"
; Image3:
; IncludeBinary "D:\purebasic\PureBasic\dobro\Dobro creation\colorer\stop.bmp"
; EndDataSection
bitmap= LoadImage (0, nom_chemin_image$) ; change 2nd parameter to the path/filename of your image
Open_Window_navig()
Repeat ; Start of the event loop
Event = WaitWindowEvent () ; This line waits until an event is received from Windows
WindowID = EventWindowID () ; The Window where the event is generated, can be used in the gadget procedures
GadgetID = EventGadgetID () ; Is it a gadget event?
EventType = EventType () ; The event type
;You can place code here, and use the result as parameters for the procedures
If Event = #PB_EventGadget
If GadgetID = #String_adresse ; une adresse a été entrée ?
ElseIf GadgetID = #Button_ok
Adresse$ = GetGadgetText ( #String_adresse ) ; on recup l'adresse
If Adresse$= ""
Adresse$= "http://purebasic.hmt-forum.com/index.php"
EndIf
SetGadgetText ( #Web_0 , Adresse$) ; on la pose dans le webgadget
ElseIf GadgetID = #ButtonImage_retour ; on appuie sur le bouton retour
SetGadgetState ( #Web_0 , #PB_Web_Back ) ; on envoie la commande au webgadget
ElseIf GadgetID = #ButtonImage_aller ; on appuie sur le bouton aller
SetGadgetState ( #Web_0 , #PB_Web_Forward ) ; on envoie la commande au webgadget
ElseIf GadgetID = #ButtonImage_repete ; on appuie sur le bouton repete
SetGadgetState ( #Web_0 , #PB_Web_Refresh ) ; on envoie la commande au webgadget
ElseIf GadgetID = #ButtonImage_stop ; on appuie sur le bouton stop
SetGadgetState ( #Web_0 , #PB_Web_Stop ) ; on envoie la commande au webgadget
ElseIf GadgetID = #Web_0
EndIf
ElseIf Event = #WM_RBUTTONDOWN ; bouton droit
; Event = #PB_EventCloseWindow
ElseIf Event = #WM_LBUTTONDOWN
; SendMessage_(WindowID(), #WM_NCLBUTTONDOWN, #HTCAPTION, 0); bouton gauche deplace la fenetre
EndIf
Until Event = #PB_Event_CloseWindow ; End of the event loop
End
;
Procedure Open_Window_navig()
If OpenWindow ( #Window_navig , 206, 0, EcranX, EcranY, #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_TitleBar|#PB_Window_ScreenCentered|#PB_Window_BorderLess , "navig_colorer" )
Form1= WindowID ( #Window_navig )
If CreateGadgetList ( WindowID ())
StringGadget ( #String_adresse , 40, 30, 600, 20, "http://purebasic.hmt-forum.com/index.php" )
ButtonGadget ( #Button_ok , 650, 20, 50, 30, "OK" )
; ***************** Bouton avec images ************************
; ButtonImageGadget(#ButtonImage_retour, 40, 60, 50, 40, Image0)
; ButtonImageGadget(#ButtonImage_aller, 100, 60, 50, 40, Image1)
; ButtonImageGadget(#ButtonImage_repete, 160, 60, 50, 40, Image2)
; ButtonImageGadget(#ButtonImage_stop, 220, 60, 50, 40, Image3)
; ************************************************************
ButtonGadget ( #ButtonImage_retour , 40, 60, 50, 40, "RET" )
ButtonGadget ( #ButtonImage_aller , 100, 60, 50, 40, "AV" )
ButtonGadget ( #ButtonImage_repete , 160, 60, 50, 40, "REPT" )
ButtonGadget ( #ButtonImage_stop , 220, 60, 50, 40, "STOP" )
; ************************************************************
WebGadget ( #Web_0 , 20, 110, EcranX-50, EcranY-50, "http://purebasic.hmt-forum.com/index.php" ) ;40, 110, 850, 570
EndIf
SetWindowCallback (@WindowCallback())
EndIf
Region = CreateRoundRectRgn_ (5, 0, WindowWidth (), WindowHeight (), 40, 40) ; Création de la région pour faire une fenêtre avec les angles arrondis
; CreateRoundRectRgn_(X1, Y1, X2, Y2, R1, R2)
; X1, Y1 : coordonné du point haut gauche de la region
; X1, Y1 : coordonné du point haut gauche de la region
; R1, R2 : rayon de l'ellipse qui va servir à arrondir les angles de la region
SetWindowRgn_ ( WindowID (), Region, #True ) ; On applique la région
DeleteObject_ (Region) ; On supprime la région
EndProcedure
Procedure WindowCallback( WindowID ,message,wParam,lParam)
res= #PB_ProcessPureBasicEvents
Select message
Case #WM_PAINT
ps.PAINTSTRUCT
hdc= BeginPaint_ (Form1,ps)
hdcMem= CreateCompatibleDC_ (hdc)
SelectObject_ (hdcMem,bitmap)
BitBlt_ (hdc,1,1, WindowWidth (), WindowHeight (),hdcMem,0,0, #SRCCOPY )
ReleaseDC_ ( WindowID ( #Window_navig ),hdc)
DeleteDC_ (hdcMem)
DeleteObject_ (hdcMem)
EndPaint_ (Form1,ps)
ProcedureReturn #True
EndSelect
ProcedureReturn res
EndProcedure
)
