FormResize

[Шнурок]

Как осуществить ресайз формы (borderStyle=0), при хватании за край формы?

[BV]

Поставить BorderStyle = 2?

[Шнурок]

кхе кхе.... ночной тупняк у меня "BorderStyle = 0" а не appearance

Не выход... из-за того что интерфейс выполнен из графики... например заголовок это растянутый image (MouseDown - DoDrag Me)

[Naked]

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Const WM_NCLBUTTONDOWN = &HA1

Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim nResize As Long

If Button = 1 Then
ReleaseCapture

'nResize = 17 'нижний правый угол
'nResize = 16 'нижний левый угол
'nResize = 15 'низ
'nResize = 14 'верхний правый угол
'nResize = 13 'верхний левый угол
'nResize = 12 'верх
'nResize = 11 'право
'nResize = 10 'лево
'nResize = 2 'перемещаем окно

SendMessage Form1.hwnd, WM_NCLBUTTONDOWN, nResize, 0

End If
End Sub

[Шнурок]

Спасибо! То что надо

...
З.Ы. а можно как-нить сделать что бы картинки не мерцали...

[Naked]

можно
создаешь виртуальное окно, в нем прорисовываешь картинки, потом выводишь на форму или на другой контрол

[Шнурок]

Можно ли сделать "жесткие границы"?

Просто когда перетягиваешь за нижний правый угол в сторону левого верхнего угла до минимума появляется ошибка....
Я попробовал сделать вот так:

Код: Выделить всё

   
If Me.Height < 2000 Then Me.Height = 2000
If Me.Width < 2000 Then Me.Width = 2000


Но в этом случае появляется мерцание + видены мерцающие полу прозрачные очертания формы хотя ошибка больше не появляется...

[Naked]

пиши в модуле

Type POINTAPI
x As Long
y As Long
End Type

Type MINMAXINFO
ptReserved As POINTAPI
ptMaxSize As POINTAPI
ptMaxPosition As POINTAPI
ptMinTrackSize As POINTAPI
ptMaxTrackSize As POINTAPI
End Type

Public Const WM_GETMINMAXINFO = &H24
Public Const GWL_WNDPROC = -4
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
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal ByteLen As Long)

Dim WndProc As Long

Sub HookForm(hWnd As Long)
WndProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub

Sub UnHookForm(hWnd As Long)
Call SetWindowLong(hWnd, GWL_WNDPROC, WndProc)
End Sub

Public Function WindowProc(ByVal hWnd As Long, ByVal message As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Select Case message
Case WM_GETMINMAXINFO
WindowProc = CallWindowProc(WndProc, hWnd, message, wParam, lParam)

Dim MinMax As MINMAXINFO
CopyMemory MinMax, ByVal lParam, Len(MinMax)
MinMax.ptMinTrackSize.x = 200
MinMax.ptMinTrackSize.y = 200
CopyMemory ByVal lParam, MinMax, Len(MinMax)

Case Else
WindowProc = CallWindowProc(WndProc, hWnd, message, wParam, lParam)
End Select
End Function


в модуле формы
Private Sub Form_Load()
Call HookForm(hWnd)
End Sub

Private Sub Form_Unload(Cancel As Integer)
Call UnHookForm(hWnd)
End Sub

[Шнурок]

Работает!
Спасибо!

[Шнурок]

Как сделать, что бы ресайзить можно было бы несколько форм в проекте... а то так тока главная форма изменяется, а все остальные нет....

З.Ы. то же самое с перемещением (DoDrag me)

[Шнурок]

:help:

[Twister]

Весь вышеприведенный код запихни в модуль, сделай функции Public и примени ко всем нужным формам...