Les FormRésolu

Question

Salut a tous,

L'un ou l'une d'ente vous saurait-il/elle s'il est possible de parametrer une Form pour qu'on ne puisse pas la 'resizer' mais qu'il soit toujours possible de la REDUIRE (a priori avec les BorderSize si je met un type interdisant le redimentionnement je peux plus redire ma fenetre)

Merci d'avance...

Que le prog soit avec toi...

BriBus...

Gobillot · Accepted Answer

Il y a 4 valeurs, la valeur MinX et MaxX pour la Largeur, et la valeur MinY et MaxY pour la Hauteur.
Quand tu fixes le MinX et le MaxX tu ne peux plus bouger ta Forme en Largeur qu'entre ces 2 valeurs.
Quand MaxX est égal à MinX tu ne peut plus bouger du tout.
ça limite aussi le Maximize, mais ça n'empêche pas le minimize.

tu dois rajouter dans le module: (lignes en rouge)

Public MinX As Long
Public MinY As Long
Public MaxX As Long
Public MaxY As Long

MinMax.ptMinTrackSize.x = MinX
MinMax.ptMinTrackSize.y = MinY
MinMax.ptMaxTrackSize.x = MaxX
MinMax.ptMaxTrackSize.y = MaxY

et dans Form_Load()

MinX = 4800 / Screen.TwipsPerPixelX
MaxX = 5800 / Screen.TwipsPerPixelX
MinY = 3600 / Screen.TwipsPerPixelY
MaxY = 4600 / Screen.TwipsPerPixelY
SauveAdressWinProc = GetWindowLong(Me.hwnd, GWL_WNDPROC)
Call SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf MaWinProc)

Daniel

econs · Answer

Essaye avec ceci :



Dim last_size_X As Long
Dim last_size_Y As Long

Private Sub Form_Load()
    last_size_X = Me.Width
    last_size_Y = Me.Height
End Sub

Private Sub Form_Resize()
    If Me.Width > last_size_X Or Me.Height > last_size_Y Then
        Me.Width = last_size_X
        Me.Height = last_size_Y
    Else
        last_size_X = Me.Width
        last_size_Y = Me.Height
    End If
End Sub



Manu (le prog est avec moi, t'inquiètes pas  :)

econs · Answer

Euh ... BorderSize doit être différent de 0 pour mon code. La fenêtre est en mode 'Dimensionnable'

Manu

cs_AbriBus · Answer

c'est bien le but en effet... je jette un oeil.

econs · Answer

Vas-y, jette  :approve)  !

Manu

cs_AbriBus · Answer

c'est pas mal mais il y a deux problemes (enfin... au niveau du resultat car dans le code, ya un truc un peu etrange):

Quand je redimentionne ma fenetre + grand, ca marche a peu pres sauf que 1/ ca deplace ma fenetre a l'endroit ou se trouve ma souris cad en général dans une opération de redimentionnement dans le coin en bas a droite de l'ecran 2/ le processus prend enormement de resource pour une simple raison :
   =>j'en vien au code
tant que l'utilisateur a pas relaché la souris, le redimentionnement est toujours en cours... soit, si le redimentionnement est > il reaffecte la valeur précédente ce qui cree un redimentionnement... (tu vois ce que je veux dire...?)

n'y a t il pas un moyen plus simple que de passer par des variables globales ? (la methode reste valide mais a travailler...)

econs · Answer

Y'a juste un problème.

Quand le curseur de la souris passe sur une bordure, tu ne sais pas, a priori, si l'utilisateur a l'intention de diminuer ou d'agrandir la feuille.
Tu es obligé d'attendre qu'il ait relaché la souris pour constater ce qu'il veut faire.

Autre point : code gourmand en ressource ??? Alors là, je ne vois pas pourquoi tu dis çà. Franchement, c'est pas 3 lignes de code sans aucun appel de procédures externes qui va bouffer ta CPU.

Manu

Gobillot · Answer

si tu veux j'ai mieux, mais en plus compliqué.

[b]Daniel/b

cs_AbriBus · Answer

je suis partant pour plus compliqué... ;-)

Gobillot · Answer

à mettre dans un module:


Option Explicit

Public Const GWL_WNDPROC As Long = -4
Private Const WM_GETMINMAXINFO As Long = &H24
Public SauveAdressWinProc As Long
Public MinX As Long
Public MinY As Long

Private Type POINTAPI
    x As Long
    y As Long
    End Type

Private Type MINMAXINFO
    ptReserved     As POINTAPI
    ptMaxSize      As POINTAPI
    ptMaxPosition  As POINTAPI
    ptMinTrackSize As POINTAPI
    ptMaxTrackSize As POINTAPI
    End Type

Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
       (ByVal hwnd As Long, ByVal nIndex As Long) As Long

Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
      (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
       (Destination As Any, Source As Any, ByVal Length As Long)

Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" _
       (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, _
        ByVal wParam As Long, ByVal lParam As Long) As Long

Public Function MaWinProc(ByVal hwnd As Long, ByVal uMsg As Long, _
       ByVal wParam As Long, ByVal lParam As Long) As Long
    If uMsg = WM_GETMINMAXINFO Then
        Dim MinMax As MINMAXINFO
        CopyMemory MinMax, ByVal lParam, Len(MinMax)
        MinMax.ptMinTrackSize.x = MinX
        MinMax.ptMinTrackSize.y = MinY
        CopyMemory ByVal lParam, MinMax, Len(MinMax)
        MaWinProc = 1
        Exit Function
    End If
MaWinProc = CallWindowProc(SauveAdressWinProc, hwnd, uMsg, wParam, lParam)
End Function


à mettre dans la Forme:


Private Sub Form_Load()
    MinX = 9600 / Screen.TwipsPerPixelX
    MinY = 7125 / Screen.TwipsPerPixelY
    SauveAdressWinProc = GetWindowLong(Me.hwnd, GWL_WNDPROC)
    Call SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf MaWinProc)
End Sub

'pour terminer proprement le programme:
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Call SetWindowLong(Me.hWnd, GWL_WNDPROC, SauveAdressWinProc)
End Sub


ici j'ai utilisé que les valeurs minimums, tu les définis avec MinX et MinY, il est facile de faire la même chose avec les valeurs maximums.
Ps: en cas de plantage, VB se barre, c'est du subclassing ...

Daniel

cs_AbriBus · Answer

econs> je cherchais le mot tout a l'heure... le code est lourd car il fait ce que l'on appelle des 'appels recurents'... en outre la fonction Form.Resize() est appellée pour chaque redimentionnement de 1pixel de la Frame... (deja en 800*600 ca en fait pas mal mais en plus je travail en 1280*800... :-(

Que la Frame soit avec moi...

Brus...

cs_AbriBus · Answer

daniel> c'est MaxX et MaxY que je dois mettre pour limiter en taille ?

Bus...

cs_AbriBus · Answer

Ca marche nikel-chrome.... C'est pas tres long mais c'est assez touffu... merci pour ce code.

C'est EXACTEMENT ce que je cherchais...

Je vois que la prog est avec toi...

AbriBus...

Les Form

13 réponses

Discussions similaires