+ -
当前位置:首页 → 问答吧 → sstab内部控件缩放,帮忙写个小函数

sstab内部控件缩放,帮忙写个小函数

时间:2011-07-16

来源:互联网

请教各位老师,SStab容器内控件缩放问题。
在网上找了一段代码,窗体缩放后,SStab容器内控件的控件就乱了,网上也找了解决方法,据说要重新写函数进行处理,代码如下 :
VB code

1、新建一个模块(general.bas),在上面添加两个函数;
Public Type CONTROLRECT
    Left As Single
    Top As Single
    Width As Single
    Height As Single
End Type
Public Const HORZRES = 8
Public Const VERTRES = 10
Public Declare Function GetDesktopWindow Lib "user32" () As Long
Public Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Public Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
'取得界面原始控件的位置及大小,并保存到数组里
Public Sub GetSourcePos(this As Object, rc() As CONTROLRECT, Optional bigFont As Boolean = True)
Dim tempX As Integer, tempY As Integer
tempX = this.ScaleWidth   '1024
tempY = this.ScaleHeight '768
'此处原来如果在1024*768分辨率下显示正常的话,就可以直接赋值1024和768
Dim temp As Control
Dim nSum As Integer
nSum = 0
For Each temp In this
'此处要注意,有些控件没有width,height等属性,在此要做出判断
If TypeOf temp Is ComboBox Then
  
   With rc(nSum)
    .Left = temp.Left / tempX
    .Width = temp.Width / tempX
    .Top = temp.Top / tempY
   End With
' ElseIf TypeOf temp Is MSComm Then
'   'none
' ElseIf TypeOf temp Is StatusBar Then
'   'none
Else
    With rc(nSum)
    .Left = temp.Left / tempX
    .Width = temp.Width / tempX
    .Top = temp.Top / tempY
    .Height = temp.Height / tempY
   End With
End If
nSum = nSum + 1
Next
End Sub
'根据比例调整控件的大小
Public Sub SetNewPos(this As Object, rc() As CONTROLRECT)
    Dim tempX As Integer, tempY As Integer
    tempX = this.ScaleWidth '1024
    tempY = this.ScaleHeight '768
   
'    '如果初始界面显示始终是以最大化的方式显示的话,此处就可以调用系统分辨率进行设置tempx,tempy
'    hwnd = GetDesktopWindow()
'    ' Get the device context for the desktop
'    hdc = GetWindowDC(hwnd)
'    If hdc Then
'        Dim a As Long, b As Long
'        a = GetDeviceCaps(hdc, HORZRES)
'        b = GetDeviceCaps(hdc, VERTRES)
'        tempX = a
'        tempY = b
'    End If
'    ReleaseDC hwnd, hdc
    
     Dim temp As Control '//用于取各种控件
     Dim nSum As Integer
     nSum = 0
     For Each temp In this
      '此处要注意,有些控件没有width,height等属性,在此要做出判断
      If TypeOf temp Is ComboBox Then
        temp.Left = rc(nSum).Left * tempX
        temp.Width = rc(nSum).Width * tempX
        temp.Top = rc(nSum).Top * tempY
    ' ElseIf TypeOf temp Is MSComm Then
    '   'none
    ' ElseIf TypeOf temp Is StatusBar Then
    '   'none
      Else
        temp.Left = rc(nSum).Left * tempX
        temp.Width = rc(nSum).Width * tempX
        temp.Top = rc(nSum).Top * tempY
        temp.Height = rc(nSum).Height * tempY
      End If
       nSum = nSum + 1
     Next
End Sub
2、在form窗体中定义如下变量
Dim oldpos() As CONTROLRECT
Private Sub Form_Load()
ReDim oldpos(Me.Controls.Count)
GetSourcePos Me, oldpos
End Sub
Private Sub Form_Resize()
SetNewPos Me, oldpos
End Sub


作者: long5235   发布时间: 2011-07-16

推荐一个方法,将分辨率固定
http://download.csdn.net/source/3435467

作者: Veron_04   发布时间: 2011-07-16

热门下载

更多