VB中如何让窗体无法调整大小?

feng_8103 2003-11-01 01:13:29
请教:
VB中如何让窗体无法调整大小?
...全文
922 9 打赏 收藏 转发到动态 举报
写回复
用AI写文章
9 条回复
切换为时间正序
请发表友善的回复…
发表回复
wxrwan 2003-11-01
  • 打赏
  • 举报
回复 1
BordStyle=3
hisofty 2003-11-01
  • 打赏
  • 举报
回复
利用子类处理技术限制窗体的大小
' * * * * * * * * * * 警告 * * * * * * * * * * * * *
' 对以下代码进行修改将有可能导致不可预料的后果,甚至能使您的VB崩溃!
' 在VB IDE环境中运行本程序之前请先保存您的修改
' 不要使用断点调试模式,这将导致VB崩溃!
' * * * * * * * * * * 注意 * * * * * * * * * * * * *
模块:
Option Explicit

Public OldWindowProc As Long
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
'从指定的窗口结构中取得信息
'参数/类型 说明
'hwnd(long): 欲为其获取信息的窗口的句柄
'nIndex(long): 欲取回的信息,可以是下述任何一个常数
'GWL_EXSTYLE:扩展窗口样式
'GWL_STYLE:窗口样式
'GWL_WNDPROC:该窗口的窗口函数的地址
'GWL_HINSTANCE:拥有窗口的实例的句柄
'GWL_HWNDPARENT:该窗口之父的句柄.不要用 SetWindowWord 来改变这个值
'GWL_ID:对话框中一个子窗口的标识符
'GWL_USERDATA:含义由应用程序规定
'对话框亦可指定下列常数
'DWL_DLGPROC:这个窗口的对话框函数地址
'DWL_MSGRESULT:在对话框函数中处理的一条消息返回的值
'DWL_USER:含义由应用程序规定
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
'在窗体结构中为指定的窗口设置信息
'参数/类型 说明
'hwnd(long) 欲为其获取信息的窗口的句柄
'nIndex(long) 参考GetWindowLong函数
'dwNewLong(long) 由nIndex指定的窗口信息的新值
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal ByteLen As Long)
'这就是在VisualBasic中处理指针的"短柄斧"--CopyMemory.你可能在API文档中找不到它,但它确实存在,并且功能异常强大
'参数/类型 说明
'pDest 你想写入字节到其中的任何变量的ByRef参数(地址)
'pSource 要从其中进行复制的ByRef变量
'ByteLen 要复制的字节数
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 Const WM_GETMINMAXINFO = &H24
Type POINTAPI
 x As Long
 y As Long
End Type
' This is the structure that is passed by reference(ByRef)(ie an address) to your message handler(消息侦听器)
' The key items in this structure are ptMinTrackSize and ptMaxTrackSize
Type MINMAXINFO
 ptReserved As POINTAPI
 ptMaxSize As POINTAPI
 ptMaxPosition As POINTAPI
 ptMinTrackSize As POINTAPI
 ptMaxTrackSize As POINTAPI
End Type
Public Function SubClass1_WndMessage(ByVal hwnd As Long, ByVal Msg As Long, ByVal wp As Long, ByVal lp As Long) As Long
' Watch for the pertinent message to come in
 If Msg = WM_GETMINMAXINFO Then
  Dim MinMax As MINMAXINFO
'  This is necessary because the structure was passed by its address and there
'  is currently no intrinsic way to use an address in Visual Basic
  CopyMemory MinMax, ByVal lp, Len(MinMax)
' This is where you set the values of the MinX,MinY,MaxX, and MaxY
' The values placed in the structure must be in pixels. The values
' normally used in Visual Basic are in twips. The conversion is as follows:
'  pixels = twips\twipsperpixel
  MinMax.ptMinTrackSize.x = 3975 \ Screen.TwipsPerPixelX
  MinMax.ptMinTrackSize.y = 1740 \ Screen.TwipsPerPixelY
  MinMax.ptMaxTrackSize.x = Screen.Width \ Screen.TwipsPerPixelX \ 2
  MinMax.ptMaxTrackSize.y = 3480 \ Screen.TwipsPerPixelY
' Here we copy the datastructure back up to the address passed in the parameters
' because Windows will look there for the information.
  CopyMemory ByVal lp, MinMax, Len(MinMax)
' This message tells Windows that the message was handled successfully
  SubClass1_WndMessage = 1
  Exit Function
 End If
' Here, we forward all irrelevant messages on to the default message handler.
 SubClass1_WndMessage = CallWindowProc(OldWindowProc, hwnd, Msg, wp, lp)
End Function

窗体代码:
Option Explicit

Private Const GWL_WNDPROC = (-4)
Private Sub Form_Load()
' First, we need to store the address of the existing Message Handler
 OldWindowProc = GetWindowLong(Me.hwnd, GWL_WNDPROC)
' Now we can tell windows to forward all messages to out own Message Handler
 Call SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf SubClass1_WndMessage)
End Sub

Private Sub Form_Unload(Cancel As Integer)
' We must return control of the messages back to windows before the program exits
Call SetWindowLong(Me.hwnd, GWL_WNDPROC, OldWindowProc)
End Sub
itlive 2003-11-01
  • 打赏
  • 举报
回复
form.borderstyle=fixedsingle
kmzs 2003-11-01
  • 打赏
  • 举报
回复
在form_resize中:
me.height=1000
me.width=1500
since1990 2003-11-01
  • 打赏
  • 举报
回复
up
zyl910 2003-11-01
  • 打赏
  • 举报
回复
注意顺序:

BordStyle=1
MinButton=True
sunnyBelt 2003-11-01
  • 打赏
  • 举报
回复
把窗体的borderstyle属性设置为fixed diaglog,或者屏蔽窗体的最大化和最下化按钮minbutton=false;maxbutton=false并在窗体的resize事件中写上me.height= me.width=
yoki 2003-11-01
  • 打赏
  • 举报
回复
设置窗体的BordStyle=3
ipqn 2003-11-01
  • 打赏
  • 举报
回复
gz
VB窗体控件大小窗体大小变化自動調整 有时窗体变化后,如改变分辨率后控件大小却不能随之改变。手工代码调整实在麻烦,下面的模块实现自动查找窗体上控件并使其改变大小以适应窗体变化。 在Form的Resize事件调用函数Resize_All就能实现控件自动调整大小,如: Private Sub Form_Resize() Dim H, i As Integer On Error Resume Next Resize_ALL Me 'Me是窗体名,Form1,Form2等等都可以 End Sub 在模块添加以下代码: Public Type ctrObj Name As String Index As Long Parrent As String Top As Long Left As Long Height As Long Width As Long ScaleHeight As Long ScaleWidth As Long End Type Private FormRecord() As ctrObj Private ControlRecord() As ctrObj Private bRunning As Boolean Private MaxForm As Long Private MaxControl As Long Private Const WM_NCLBUTTONDOWN = &HA1 Private Declare Function SendMessage Lib "USER32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Private Declare Function ReleaseCapture Lib "USER32" () As Long Function ActualPos(plLeft As Long) As Long If plLeft < 0 Then ActualPos = plLeft + 75000 Else ActualPos = plLeft End If End Function Function FindForm(pfrmIn As Form) As Long Dim i As Long FindForm = -1 If MaxForm > 0 Then For i = 0 To (MaxForm - 1) If FormRecord(i).Name = pfrmIn.Name Then FindForm = i Exit Function End If Next i End If End Function Function AddForm(pfrmIn As Form) As Long Dim FormControl As Control Dim i As Long ReDim Preserve FormRecord(MaxForm + 1) FormRecord(MaxForm).Name = pfrmIn.Name FormRecord(MaxForm).Top = pfrmIn.Top FormRecord(MaxForm).Left = pfrmIn.Left FormRecord(MaxForm).Height = pfrmIn.Height FormRecord(MaxForm).Width = pfrmIn.Width FormRecord(MaxForm).ScaleHeight = pfrmIn.ScaleHeight FormRecord(MaxForm).ScaleWidth = pfrmIn.ScaleWidth AddForm = MaxForm MaxForm = MaxForm + 1 For Each FormControl In pfrmIn i = FindControl(FormControl, pfrmIn.Name) If i < 0 Then i = AddControl(FormControl, pfrmIn.Name) End If Next FormControl End Function Function FindControl(inControl As Control, inName As String) As Long Dim i As Long FindControl = -1 For i = 0 To (MaxControl - 1) If ControlRecord(i).Parrent = inName Then If ControlRecord(i).Name = inControl.Name Then On Error Resume Next If ControlRecord(i).Index = inControl.Index Then FindControl = i Exit Function End If On Error GoTo 0 End If End If Next i End Function Function AddControl(inControl As Control, inName As String) As Long ReDim Preserve ControlRecord(MaxControl + 1) On Error Resume Next ControlRecord(MaxControl).Name = inControl.Name ControlRecord(MaxControl).Index = inControl.Index ControlRecord(MaxControl).Parrent = inName If TypeOf inControl Is Line Then ControlRecord(MaxControl).Top = inControl.Y1 ControlRecord(MaxControl).Left = ActualPos(inControl.X1) ControlRecord(MaxControl).Height = inControl.Y2 ControlRecord(MaxControl).Width = ActualPos(inControl.X2) Else ControlRecord(MaxControl).Top = inControl.Top ControlRecord(MaxControl).Left = ActualPos(inControl.Left) ControlRecord(MaxControl).Height = inControl.Height ControlRecord(MaxControl).Width = inControl.Width End If inControl.IntegralHeight = False On Error GoTo 0 AddControl = MaxControl MaxControl = MaxControl + 1 End Function Function PerWidth(pfrmIn As Form) As Long Dim i As Long i = FindForm(pfrmIn) If i < 0 Then i = AddForm(pfrmIn) End If PerWidth = (pfrmIn.ScaleWidth * 100) \ FormRecord(i).ScaleWidth End Function Function PerHeight(pfrmIn As Form) As Double Dim i As Long i = FindForm(pfrmIn) If i < 0 Then i = AddForm(pfrmIn) End If PerHeight = (pfrmIn.ScaleHeight * 100) \ FormRecord(i).ScaleHeight End Function Public Sub ResizeControl(inControl As Control, pfrmIn As Form) On Error Resume Next Dim i As Long Dim widthfactor As Single, heightfactor As Single Dim minFactor As Single Dim yRatio, xRatio, lTop, lLeft, lWidth, lHeight As Long yRatio = PerHeight(pfrmIn) xRatio = PerWidth(pfrmIn) i = FindControl(inControl, pfrmIn.Name) If inControl.Left < 0 Then lLeft = CLng(((ControlRecord(i).Left * xRatio) \ 100) - 75000) Else lLeft = CLng((ControlRecord(i).Left * xRatio) \ 100) End If lTop = CLng((ControlRecord(i).Top * yRatio) \ 100) lWidth = CLng((ControlRecord(i).Width * xRatio) \ 100) lHeight = CLng((ControlRecord(i).Height * yRatio) \ 100) If TypeOf inControl Is Line Then If inControl.X1 < 0 Then inControl.X1 = CLng(((ControlRecord(i).Left * xRatio) \ 100) - 75000) Else inControl.X1 = CLng((ControlRecord(i).Left * xRatio) \ 100) End If inControl.Y1 = CLng((ControlRecord(i).Top * yRatio) \ 100) If inControl.X2 < 0 Then inControl.X2 = CLng(((ControlRecord(i).Width * xRatio) \ 100) - 75000) Else inControl.X2 = CLng((ControlRecord(i).Width * xRatio) \ 100) End If inControl.Y2 = CLng((ControlRecord(i).Height * yRatio) \ 100) Else inControl.Move lLeft, lTop, lWidth, lHeight inControl.Move lLeft, lTop, lWidth inControl.Move lLeft, lTop End If End Sub Public Sub ResizeForm(pfrmIn As Form) Dim FormControl As Control Dim isVisible As Boolean Dim StartX, StartY, MaxX, MaxY As Long Dim bNew As Boolean If Not bRunning Then bRunning = True If FindForm(pfrmIn) < 0 Then bNew = True Else bNew = False End If If pfrmIn.Top < 30000 Then isVisible = pfrmIn.Visible On Error Resume Next If Not pfrmIn.MDIChild Then On Error GoTo 0 ' ' pfrmIn.Visible = False Else If bNew Then StartY = pfrmIn.Height StartX = pfrmIn.Width On Error Resume Next For Each FormControl In pfrmIn If FormControl.Left + FormControl.Width + 200 > MaxX Then MaxX = FormControl.Left + FormControl.Width + 200 End If If FormControl.Top + FormControl.Height + 500 > MaxY Then MaxY = FormControl.Top + FormControl.Height + 500 End If If FormControl.X1 + 200 > MaxX Then MaxX = FormControl.X1 + 200 End If If FormControl.Y1 + 500 > MaxY Then MaxY = FormControl.Y1 + 500 End If If FormControl.X2 + 200 > MaxX Then MaxX = FormControl.X2 + 200 End If If FormControl.Y2 + 500 > MaxY Then MaxY = FormControl.Y2 + 500 End If Next FormControl On Error GoTo 0 pfrmIn.Height = MaxY pfrmIn.Width = MaxX End If On Error GoTo 0 End If For Each FormControl In pfrmIn ResizeControl FormControl, pfrmIn Next FormControl On Error Resume Next If Not pfrmIn.MDIChild Then On Error GoTo 0 pfrmIn.Visible = isVisible Else If bNew Then pfrmIn.Height = StartY pfrmIn.Width = StartX For Each FormControl In pfrmIn ResizeControl FormControl, pfrmIn Next FormControl End If End If On Error GoTo 0 End If bRunning = False End If End Sub Public Sub SaveFormPosition(pfrmIn As Form) Dim i As Long If MaxForm > 0 Then For i = 0 To (MaxForm - 1) If FormRecord(i).Name = pfrmIn.Name Then FormRecord(i).Top = pfrmIn.Top FormRecord(i).Left = pfrmIn.Left FormRecord(i).Height = pfrmIn.Height FormRecord(i).Width = pfrmIn.Width Exit Sub End If Next i AddForm (pfrmIn) End If End Sub Public Sub RestoreFormPosition(pfrmIn As Form) Dim i As Long If MaxForm > 0 Then For i = 0 To (MaxForm - 1) If FormRecord(i).Name = pfrmIn.Name Then If FormRecord(i).Top < 0 Then pfrmIn.WindowState = 2 ElseIf FormRecord(i).Top < 30000 Then pfrmIn.WindowState = 0 pfrmIn.Move FormRecord(i).Left, FormRecord(i).Top, FormRecord(i).Width, FormRecord(i).Height Else pfrmIn.WindowState = 1 End If Exit Sub End If Next i End If End Sub Public Sub Resize_ALL(Form_Name As Form) Dim OBJ As Object For Each OBJ In Form_Name ResizeControl OBJ, Form_Name Next OBJ End Sub Public Sub DragForm(frm As Form) On Local Error Resume Next Call ReleaseCapture Call SendMessage(frm.hwnd, WM_NCLBUTTONDOWN, 2, 0) End Sub

7,771

社区成员

发帖
与我相关
我的任务
社区描述
VB 基础类
社区管理员
  • VB基础类社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧