在ReSize事件中处理控件的坐标
解决方案 »
- 一个sql语句
- VB 进制转换问题 在线等 NNNNNN简单
- VB读取文本文件时,怎样判断某行是否含有"("或"/"符号以及该符号在该行中的位置?
- 求三个API,两个结构的用法和意义
- 怎么将 msflexgrid中的已经更新的数据写到数据库中 (注:我用的是 recordset对象 )
- 十万火急!求救!关于存储图片到sql
- 奇怪的控件问题~~~帮忙~~
- 如何把SQL数据库转换成其他数据库,比如DbaseIII、access?
- 急啊~~~~~~求救 !!!!!!!!!!!!!!!!!用winsock摸拟html文件上传,可是在服务器端request.files却得不到文件
- 难题一条
- 关于图形操作的问题(高分)
- 设置activex控件属性的问题
Option Explicit
Dim OldX As Integer, OldY As Integer, Down As Boolean
Private FormOldWidth As Long
'±£´æ´°ÌåµÄԭʼ¿í¶È
Private FormOldHeight As Long
'±£´æ´°ÌåµÄԭʼ¸ß¶È'ÔÚµ÷ÓÃResizeFormÇ°Ïȵ÷Óñ¾º¯Êý
Public Sub ResizeInit(FormName As Form)
Dim Obj As Control
FormOldWidth = FormName.ScaleWidth
FormOldHeight = FormName.ScaleHeight
On Error Resume Next
For Each Obj In FormName
Obj.Tag = Obj.Left & " " & Obj.Top & " " & Obj.Width & " " & Obj.Height & " "
Next
On Error GoTo 0
End Sub'°´±ÈÀý¸Ä±ä±íµ¥ÄÚ¸÷Ôª¼þµÄ´óС£¬ÔÚµ÷ÓÃReSizeFormÇ°Ïȵ÷ÓÃReSizeInitº¯Êý
Public Sub ResizeForm(FormName As Form)
Dim Pos(4) As Double
Dim I As Long, TempPos As Long, StartPos As Long
Dim Obj As Control
Dim ScaleX As Double, ScaleY As Double
ScaleX = FormName.ScaleWidth / FormOldWidth
'±£´æ´°Ìå¿í¶ÈËõ·Å±ÈÀý
ScaleY = FormName.ScaleHeight / FormOldHeight
'±£´æ´°Ìå¸ß¶ÈËõ·Å±ÈÀý
On Error Resume Next
For Each Obj In FormName
StartPos = 1
For I = 0 To 4
'¶ÁÈ¡¿Ø¼þµÄԭʼλÖÃÓë´óС
TempPos = InStr(StartPos, Obj.Tag, " ", vbTextCompare)
If TempPos > 0 Then
Pos(I) = Mid(Obj.Tag, StartPos, TempPos - StartPos)
StartPos = TempPos + 1
Else
Pos(I) = 0
End If
'¸ù¾Ý¿Ø¼þµÄԭʼλÖü°´°Ìå¸Ä±ä´óСµÄ±ÈÀý¶Ô¿Ø¼þÖØж¨Î»Óë¸Ä±ä´óС
Obj.Move Pos(0) * ScaleX, Pos(1) * ScaleY, Pos(2) * ScaleX, Pos(3) * ScaleY
Next I
Next
On Error GoTo 0
End SubPrivate Sub Form_Load()
' SetWindowRgn hWnd, CreateEllipticRgn(0, 0, 300, 200), True
Call ResizeInit(Me) 'ÔÚ³ÌÐò×°Èëʱ±ØÐë¼ÓÈë
End SubPrivate Sub Form_Resize()
Call ResizeForm(Me) 'È·±£´°Ìå¸Ä±äʱ¿Ø¼þËæÖ®¸Ä±ä
End Sub
Option Explicit
Private nFormHeight As Integer
Private nFormWidth As Integer
Private nNumOfControls As Integer
Private nTop() As Integer
Private nLeft() As Integer
Private nHeight() As Integer
Private nWidth() As Integer
Private nFontSize() As Integer
Private nRightMargin() As Integer
Private bFirstTime As Boolean
Private txtH As Double
'--------------------------------------------------------------------------------Sub Init(frm As Form, Optional MDIid As Boolean, Optional nWindState As Variant)
Dim i As Integer
Dim bWinMax As Boolean
bWinMax = Not IsMissing(nWindState)
If MDIid = True Then
nFormHeight = 9000
nFormWidth = 12000
Else
nFormHeight = 8130
nFormWidth = 10305
End If
nNumOfControls = frm.Controls.Count - 1
bFirstTime = True
ReDim nTop(nNumOfControls)
ReDim nLeft(nNumOfControls)
ReDim nHeight(nNumOfControls)
ReDim nWidth(nNumOfControls)
ReDim nFontSize(nNumOfControls)
ReDim nRightMargin(nNumOfControls)
On Error Resume Next
For i = 0 To nNumOfControls
If TypeOf frm.Controls(i) Is Line Then
nTop(i) = frm.Controls(i).Y1
nLeft(i) = frm.Controls(i).X1
nHeight(i) = frm.Controls(i).Y2
nWidth(i) = frm.Controls(i).X2
ElseIf TypeOf frm.Controls(i) Is TextBox Then
nTop(i) = frm.Controls(i).Top
nLeft(i) = frm.Controls(i).Left
nHeight(i) = frm.Controls(i).Height
nWidth(i) = frm.Controls(i).Width
nFontSize(i) = frm.FontSize
nRightMargin(i) = frm.Controls(i).RightMargin
txtH = nHeight(i)
Else
nTop(i) = frm.Controls(i).Top
nLeft(i) = frm.Controls(i).Left
nHeight(i) = frm.Controls(i).Height
nWidth(i) = frm.Controls(i).Width
nFontSize(i) = frm.FontSize
nRightMargin(i) = frm.Controls(i).RightMargin
End If
NextIf MDIid = True Then
frm.Height = Screen.Height
frm.Width = Screen.Width
Else
frm.Height = frm_Sys_Main.Height - frm_Sys_Main.tbToolBar.Top - frm_Sys_Main.tbToolBar.Height - frm_Sys_Main.sbStatusBar.Height
frm.Width = frm_Sys_Main.Width - frm_Sys_Main.MainButt.Width
End If
bFirstTime = True
End Sub'--------------------------------------------------------------------------------
Sub FormResize(frm As Form, Optional MDITofF As Boolean)
Dim i As Integer
Dim nCaptionSize As Integer
Dim dRatioX As Double
Dim dRatioY As Double
Dim nSaveRedraw As Long
Dim txtnh As Double
On Error Resume Next
nSaveRedraw = frm.AutoRedraw
frm.AutoRedraw = True
If bFirstTime Then
bFirstTime = False
Exit Sub
End If
If frm.Height < nFormHeight / 2 Then
frm.Height = nFormHeight / 2
End If
If frm.Width < nFormWidth / 2 Then
frm.Width = nFormWidth / 2
End IfnCaptionSize = 400
nCaptionSize = Int(nFontSize(i) / dRatioX) + Int(nFontSize(i) / dRatioX) Mod 2
dRatioY = 1# * (nFormHeight - nCaptionSize) _
/ (frm.Height - nCaptionSize)
dRatioX = 1# * nFormWidth / frm.Width
If Not MDITofF = True Then
On Error Resume Next
For i = 0 To nNumOfControls
If TypeOf frm.Controls(i) Is TextBox Then
frm.Controls(i).Height = Int(nHeight(i) / dRatioY)
txtnh = frm.Controls(i).Height - txtH
Exit For
End If
Next
End If
On Error Resume Next
For i = 0 To nNumOfControls
If TypeOf frm.Controls(i) Is Line Then
frm.Controls(i).Y1 = Int(nTop(i) / dRatioY) + 25
frm.Controls(i).X1 = Int(nLeft(i) / dRatioX)
frm.Controls(i).Y2 = Int(nHeight(i) / dRatioY) + 25
frm.Controls(i).X2 = Int(nWidth(i) / dRatioX)
Else
frm.Controls(i).Top = Int(nTop(i) / dRatioY) - 25
frm.Controls(i).Left = Int(nLeft(i) / dRatioX)
frm.Controls(i).Height = Int(nHeight(i) / dRatioY)
frm.Controls(i).Width = Int(nWidth(i) / dRatioX)
frm.Controls(i).FontSize = nFontSize(i) + IIf(((nFontSize(i) / dRatioX - nFontSize(i)) / 2) - Int((nFontSize(i) / dRatioX - nFontSize(i)) / 2) = 0, (nFontSize(i) / dRatioX - nFontSize(i)) / 2, Int((nFontSize(i) / dRatioX - nFontSize(i)) / 2) + 1)
frm.Controls(i).RightMargin = Int(nRightMargin(i) / dRatioY)
End If
Next
frm.AutoRedraw = nSaveRedraw
End Sub'使用如下:
'在窗体中定义类:
Private autor As New ControlAutoSize'在From_load过程中加入
autor.Init Me
'在Form_Resize过程中加入
autor.FormResize Me
'这样就一切OK了,不但控件改变了,连线条,字体也改了,是不是很好。