Gå til innhold

Spørsmål angående Froms og størresler


Anbefalte innlegg

Jeg vil ganske enkelt ha et form som du kan endre størrelsen på, men kun til en viss grad. Jeg vil at viss Formet blir ikke skal kunne bli mindre enn f.eks. 2000 twips i bredden, og 1500 i høyden. Har noen svaret på et så enkelt problem?

 

Jeg har prøvd denne løsningen:

 

Sub Form_Resize()

If Form1.Width < 2000 Then Form1.Width = 2000

If Form1.Width < 2000 Then Form1.Width = 1500

End Sub

 

Eneste problemet er at den kan bli mindre, men så "hopper" pekeren tilbake på 2000,1500, slik jeg vil. Problemet er at dette ser ufattelig stygt ut, og det kan fort involvere en del bugs.

 

Noen som vet hvordan en kan fikse dette på en annen måte? Jeg mener at pekeren ikke skal kunne minske programmet, fordi pekeren blir "låst". En løsning fører til at jeg kan legge deg til på "about"-listen min til server-programmet jeg utvikler. En ære ;)

Lenke til kommentar
Videoannonse
Annonse

Enkelt spørsmål. Vanskelig svar.

Du må avbryte PAINT-eventet før det faktisk skjer.

 

Subclassing av form må til:

 

I form:

Private Sub Form_Load()

   Call Hook(Me.hWnd)

End Sub



Private Sub Form_Unload(Cancel As Integer)

   Call Unhook(Me.hWnd)

End Sub

 

 

I en modul:

 




Option Explicit



Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, _

                                                                           ByVal nIndex As Long, _

                                                                           ByVal dwNewLong As Long) _

                                                                           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

Private Declare Function DefWindowProc Lib "user32" Alias "DefWindowProcA" (ByVal hWnd As Long, _

                                                                           ByVal wMsg As Long, _

                                                                           ByVal wParam As Long, _

                                                                           ByVal lParam As Long) _

                                                                           As Long

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, _

                                                                    Source As Any, _

                                                                    ByVal Length As Long)

Private Const GWL_WNDPROC = (-4)



Private Const WM_SIZING = &H214



Private Const WMSZ_LEFT = 1

Private Const WMSZ_RIGHT = 2

Private Const WMSZ_TOP = 3

Private Const WMSZ_TOPLEFT = 4

Private Const WMSZ_TOPRIGHT = 5

Private Const WMSZ_BOTTOM = 6

Private Const WMSZ_BOTTOMLEFT = 7

Private Const WMSZ_BOTTOMRIGHT = 8



Private Const MIN_WIDTH = 200  'The minimum width in pixels

Private Const MIN_HEIGHT = 200 'The minimum height in pixels

Private Const MAX_WIDTH = 500  'The maximum width in pixels

Private Const MAX_HEIGHT = 500 'The maximum height in pixels



Private Type RECT

   Left   As Long

   Top    As Long

   RIGHT  As Long

   Bottom As Long

End Type



Private mPrevProc As Long



Public Sub Hook(hWnd As Long)

   mPrevProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf NewWndProc)

End Sub



Public Sub Unhook(hWnd As Long)

   

   Call SetWindowLong(hWnd, GWL_WNDPROC, mPrevProc)

   mPrevProc = 0&

   

End Sub



Public Function NewWndProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

On Error Resume Next



Dim r As RECT



   If uMsg = WM_SIZING Then

       Call CopyMemory(r, ByVal lParam, Len(r))

   

       'Keep the form only at least as wide as MIN_WIDTH

       If (r.RIGHT - r.Left < MIN_WIDTH) Then

           Select Case wParam

               Case WMSZ_LEFT, WMSZ_BOTTOMLEFT, WMSZ_TOPLEFT

                   r.Left = r.RIGHT - MIN_WIDTH

               Case WMSZ_RIGHT, WMSZ_BOTTOMRIGHT, WMSZ_TOPRIGHT

                   r.RIGHT = r.Left + MIN_WIDTH

           End Select

       End If

       

       'Keep the form only at least as tall as MIN_HEIGHT

       If (r.Bottom - r.Top < MIN_HEIGHT) Then

           Select Case wParam

               Case WMSZ_TOP, WMSZ_TOPLEFT, WMSZ_TOPRIGHT

                   r.Top = r.Bottom - MIN_HEIGHT

               Case WMSZ_BOTTOM, WMSZ_BOTTOMLEFT, WMSZ_BOTTOMRIGHT

                   r.Bottom = r.Top + MIN_HEIGHT

           End Select

       End If

       

       'Keep the form only as wide as MAX_WIDTH

       If (r.RIGHT - r.Left > MAX_WIDTH) Then

           Select Case wParam

               Case WMSZ_LEFT, WMSZ_BOTTOMLEFT, WMSZ_TOPLEFT

                   r.Left = r.RIGHT - MAX_WIDTH

               Case WMSZ_RIGHT, WMSZ_BOTTOMRIGHT, WMSZ_TOPRIGHT

                   r.RIGHT = r.Left + MAX_WIDTH

           End Select

       End If

       

       'Keep the form only as tall as MAX_HEIGHT

       If (r.Bottom - r.Top > MAX_HEIGHT) Then

           Select Case wParam

               Case WMSZ_TOP, WMSZ_TOPLEFT, WMSZ_TOPRIGHT

                   r.Top = r.Bottom - MAX_HEIGHT

               Case WMSZ_BOTTOM, WMSZ_BOTTOMLEFT, WMSZ_BOTTOMRIGHT

                   r.Bottom = r.Top + MAX_HEIGHT

           End Select

       End If

   

       Call CopyMemory(ByVal lParam, r, Len(r))

       

       NewWndProc = 0&

       Exit Function

   End If

   



   If mPrevProc > 0& Then

       NewWndProc = CallWindowProc(mPrevProc, hWnd, uMsg, wParam, lParam)

   Else

       NewWndProc = DefWindowProc(hWnd, uMsg, wParam, lParam)

   End If



End Function



[/b]

Lenke til kommentar
  • 2 uker senere...

Opprett en konto eller logg inn for å kommentere

Du må være et medlem for å kunne skrive en kommentar

Opprett konto

Det er enkelt å melde seg inn for å starte en ny konto!

Start en konto

Logg inn

Har du allerede en konto? Logg inn her.

Logg inn nå
  • Hvem er aktive   0 medlemmer

    • Ingen innloggede medlemmer aktive
×
×
  • Opprett ny...