Limiter la taille d'une fenêtre

Partagez votre expérience de PureBasic avec les autres utilisateurs.
Le Soldat Inconnu
Messages : 4312
Inscription : mer. 28/janv./2004 20:58
Localisation : Clermont ferrand OU Olsztyn
Contact :

Limiter la taille d'une fenêtre

Message par Le Soldat Inconnu »

Encore un code de notre ami Flype
mais je l'ai un poil amélioré

Code : Tout sélectionner

Procedure Resize()
  StartDrawing( WindowOutput() )
  ww.l = WindowWidth()
  wh.l = WindowHeight()
  Box( 0, 0, ww, wh, 0 )
  Box( 50, 50, ww - 100, wh - 100, $A00000 )
  Locate( 55, 55 )
  DrawText( Str(ww) + "x" + Str(wh) )
  StopDrawing()
EndProcedure

; ===============================================================================

Procedure.l WindowProc( HWnd.l, Msg.l, wParam.l, lParam.l )
  ; largeur de la bordure droite, gauche ou basse d'une fenêtre
  ; hauteur de la bordure de titre d'une fenêtre
  ; largeur de la fenêtre
  ; hauteur de la fenêtre
  GetWindowRect_(WindowID(), @Taille_Fenetre.rect)
  Largeur_Fenetre = Taille_Fenetre\Right - Taille_Fenetre\Left
  Hauteur_Fenetre = Taille_Fenetre\Bottom - Taille_Fenetre\top
  Largeur_Bordure = (Largeur_Fenetre - WindowWidth()) / 2
  Hauteur_Titre = Hauteur_Fenetre - WindowHeight() - Largeur_Bordure
  
  
  Result.l = #PB_ProcessPureBasicEvents
  If Msg = #WM_GETMINMAXINFO
    MinMax.MINMAXINFO
    RtlMoveMemory_( @MinMax, lParam, SizeOf(MINMAXINFO) )
    MinMax\ptMinTrackSize\X = 300 + 2 * Largeur_Bordure
    MinMax\ptMinTrackSize\Y = 200 + Largeur_Bordure + Hauteur_Titre
    MinMax\ptMaxTrackSize\X = 600 + 2 * Largeur_Bordure
    MinMax\ptMaxTrackSize\Y = 400 + Largeur_Bordure + Hauteur_Titre
    RtlMoveMemory_( lParam, @MinMax, SizeOf(MINMAXINFO) )
  EndIf
  ProcedureReturn Result
  
EndProcedure

; ===============================================================================

If OpenWindow(0, 0, 0, 400, 300, #PB_Window_ScreenCentered | #PB_Window_SizeGadget | #PB_Window_SystemMenu, "")
  SetWindowCallback( @WindowProc() )
  Repeat
    Select WaitWindowEvent()
      Case #WM_SIZE : Resize()
      Case #WM_PAINT : Resize()
      Case #WM_CLOSE : Quit = #TRUE
    EndSelect
  Until Quit = #TRUE
EndIf
Je ne suis pas à moitié Polonais mais ma moitié est polonaise ... Vous avez suivi ?

[Intel quad core Q9400 2.66mhz, ATI 4870, 4Go Ram, XP (x86) / 7 (x64)]