不同分辨率自动调整画面大小 - 实在点好工控博客工控论坛

胡先生

学历：大学本科

职称：工程师

年龄：40岁

新闻信息(1/0)

工作图片(0)

技术论文(0/0)

交流论坛(64/54)

留言信箱(4)

浏览人次：12305

发表人：ifixonline

发表时间：2009/9/28 10:29:00

发表新论题

本栏论题：

不同分辨率自动调整画面大小 [7525]

    画面属性"RuntimeVisible"需设置成"TRUE"，画面初始化的时候需要调用下面的"undoautoscale"函数。

    相关代码如下:

    Option Explicit
    Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
    Const SM_CXSCREEN = 0
    Const SM_CYSCREEN = 1

    ' 参数为画面对象
    Public Sub undoautoscale(iPicture As Object)
    Dim lXpix As Long
    Dim lYpix As Long
    Dim lOrigWidth As Long
    Dim lOrigHeight As Long
    Dim dblWidthAdj As Double
    Dim dblHeightAdj As Double

    '获得当前系统分辨率
    lXpix = GetSystemMetrics(SM_CXSCREEN)
    lYpix = GetSystemMetrics(SM_CYSCREEN)

    '保存当前画面的尺寸
    lOrigWidth = iPicture.OriginalScreenWidth
    lOrigHeight = iPicture.OriginalScreenHeight

    ' 计算调整率
    If lXpix > lOrigWidth Then
    dblWidthAdj = lXpix / lOrigWidth
    dblHeightAdj = lYpix / lOrigHeight
    Else
    dblWidthAdj = lOrigWidth / lXpix
    dblHeightAdj = lOrigHeight / lYpix
    End If

    '调整
    iPicture.WindowHeightPercentage = iPicture.WindowHeightPercentage * dblHeightAdj
    iPicture.WindowWidthPercentage = iPicture.WindowWidthPercentage * dblWidthAdj
    iPicture.FitDocumentToWindow
    End Sub

    '画面初始化
    Private Sub CFixPicture_Initialize()
    undoautoscale Me
    Me.RuntimeVisible = True
    End Sub

    杭州集益科技有限公司是美国通用电气GE Fanuc公司中国地区指定分销商,特价销售9030、9070、PAC RX3i、PAC RX7i、Versamax系列PLC，特价销售Proficy iFIX组态软件。
    联系人:胡有玉
    联系电话：15067103350
    传真号码:0571-88227248
    QQ号码:283479963
    公司地址：杭州市西湖区文三路555号9层
    公司网址：http://www.jiyitech.com/
    http://www.ifixonline.com/

    GE_PLC_Trainning2
    huyouyuwangshaopei
    huyouyuw@126.com

以下是关于《不同分辨率自动调整画面大小》论题的回复（共1篇）

回复人：ouxy780123

回复时间：2009/10/30 8:37:00

好的该大家分享！！！感谢楼主！！！