用户登录  |  用户注册
首 页商业源码原创产品编程论坛
当前位置:PB创新网文章中心编程技巧VisualBasic

常见问题:自动调整窗口内控间的大小

减小字体 增大字体 作者:佚名  来源:本站整理  发布时间:2009-03-16 19:46:14

这是一个类模块:
1. 建立一个新的类模块,加入下列代码,并给类模块起名(例:autosize)
2. 加入一个窗口并且加入:Private el as new autosize
3. 在 Form_Load 事件中加入 el.init me
4. 在 Form_Resize 事件中加入 el.formresize me


Option ExplicitPrivate nFormHeight      As IntegerPrivate nFormWidth       As IntegerPrivate nNumOfControls   As IntegerPrivate nTop()           As IntegerPrivate nLeft()          As IntegerPrivate nHeight()        As IntegerPrivate nWidth()         As IntegerPrivate nFontSize()      As IntegerPrivate nRightMargin()   As IntegerPrivate bFirstTime       As Boolean

Sub Init(frm As Form, Optional nWindState As Variant)   Dim I          As Integer   Dim bWinMax    As Boolean   bWinMax = Not IsMissing(nWindState)   nFormHeight = frm.Height   nFormWidth = frm.Width   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      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   Next   If bWinMax Or frm.WindowState = 2 Then      frm.Height = Screen.Height      frm.Width = Screen.Width   Else      frm.Height = frm.Height * Screen.Height / 7290      frm.Width = frm.Width * Screen.Width / 9690   End If   bFirstTime = TrueEnd Sub

Sub FormResize(frm As Form)   Dim I             As Integer   Dim nCaptionSize  As Integer   Dim dRatioX       As Double   Dim dRatioY       As Double   Dim nSaveRedraw   As Long   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   Endif   If frm.Width < nFormWidth / 2 Then      frm.Width = nFormWidth / 2   Endif     nCaptionSize = 400   dRatioY = 1# * (nFormHeight - nCaptionSize) _    / (frm.Height - nCaptionSize)   dRatioX = 1# * nFormWidth / frm.Width   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)         frm.Controls(I).X1 = Int(nLeft(I) / dRatioX)         frm.Controls(I).Y2 = Int(nHeight(I) / dRatioY)         frm.Controls(I).X2 = Int(nWidth(I) / dRatioX)      Else         frm.Controls(I).Top = Int(nTop(I) / dRatioY)         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 = Int(nFontSize(I) / _        dRatioX) + Int(nFontSize(I) / dRatioX) Mod 2         frm.Controls(I).RightMargin = Int(nRightMargin(I) / dRatioY)      End If   Next   frm.AutoRedraw = nSaveRedrawEnd Sub

Tags:

作者:佚名

文章评论评论内容只代表网友观点,与本站立场无关!

   评论摘要(共 0 条,得分 0 分,平均 0 分) 查看完整评论
PB创新网ourmis.com】Copyright © 2000-2009 . All Rights Reserved .
页面执行时间:4,156.25000 毫秒
Email:ourmis@126.com QQ:2322888 蜀ICP备05006790号