关于VB里的ScaleMode问题

我是一个VB初学者,最近苦恼于VB的窗体和控件的ScaleMode问题,VB里默认的ScaleMode是twip,而往往我们希望它是pixel,虽然在属性面板里面能够将ScaleMode改为"3-Pixel",但是我发现在程序中返回某个窗体或控件的属性时还是返回为很大的twips值,比如有一个PictureBox控件picMyPic,那么假如在程序中用另一个变量iWidth来接收控件的宽度:iWidth = picMyPic.Width,则它还是返回一个很大的twip值,比如返回6100,而控件的宽度大概只有两百多像素。
所以请问有没有办法,让它返回一个以像素为单位的数值?twip和pixel之间又是如何转换的?
设置form的scalemode=3只能使
picMyPic.scaleWidth为象素
picMyPic.Width当然为Twip,因为你没有把picMyPic.salemode=3
ScaleX、ScaleY 方法

用以将 Form,PictureBox 或 Printer 的宽度或高度值从一种 ScaleMode 属性的度量单位转换到另一种。不支持命名参数。

语法

object.ScaleX (width, fromscale, toscale)

object.ScaleY (height, fromscale, toscale)

ScaleX 和 ScaleY 方法的语法包含如下部分:

部分 描述
object 可选的。一个对象表达式,其值为“应用于”列表中的一个对象。如果省略 object,则带有焦点的 Form 对象缺省为 object。
width 必需的。为 object 指定被转换的度量单位的数量。
height 必需的。为 object 指定被转换的度量单位的数量。
fromscale 可选的。一个常数或数值,按照下列设置中的描述,指定 object 的 width 或 height 从哪一种坐标系统转换。fromscale 可取的数值与 ScaleMode 属性的数值加上 HiMetric 的新数值相同。
toscale 可选的。一个常数或数值,按照下列“设置值”中的描述,指定 object 的 width 或 height 转换到哪一种坐标系统。toscale 可取的数值与 ScaleMode 属性的数值加上 HiMetric 的新数值相同。

设置值

用于 fromscale 和 toscale 设置值有:

常数 值 描述
vbUser 0 用户定义:指示 object 的宽度和高度设置为自定义值。
vbTwips 1 缇(每逻辑英寸 1440 缇;每逻辑厘米 567 缇)。
vbPoints 2 磅(每逻辑英寸 72 点)。
vbPixels 3 像素 (显示器或打印机分辨率的最小单位)。
vbCharacters 4 字符(水平 = 每单位 120 缇,垂直 = 每单位 240 缇)。
vbInches 5 英寸
vbMillimeters 6 毫米
vbCentimeters 7 厘米
vbHimetric 8 HiMetric。如果省略 fromscale,则 HiMetric 为缺省值。
vbContainerPosition 9 决定控件位置。
vbContainerSize 10 决定控件大小。

说明

ScaleX 和 ScaleY 方法按 fromscale 指定的度量单位取值(width 或 height),并将它转换为 toscale 指定的度量单位下相应的值。

也可以结合 PaintPicture 方法使用 ScaleX 和 ScaleY。
15twip=1pixel
实际上可以用Screen.TwipsPerPixelX和Screen.TwipsPerPixelY作为系数来转换
PixelX = TwipX/Screen.TwipsPerPixelX
PixelY = TwipY/Screen.TwipsPerPixelY

由于使用了一些新的函数,本程序必须在Windows2000下运行。 Option Explicit Public Declare Function GetObjectAPI Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long Public Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long Public Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long Public Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long Public Const RGN_OR = 2 Public Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long Public Declare Function SetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long Public Type BITMAP bmType As Long bmWidth As Long bmHeight As Long bmWidthBytes As Long bmPlanes As Integer bmBitsPixel As Integer bmBits As Long End Type Public Const BITMAP_SIZE = 24 '=Len(BITMAP) Dim bmByte() As Byte Public Declare Function ReleaseCapture Lib "user32" () As Long Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long Public Const HTCAPTION = 2 Public Const WM_NCLBUTTONDOWN = &HA1; Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Public Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long Public Const WS_EX_LAYERED = &H80000; Public Const GWL_EXSTYLE = (-20) Public Const LWA_ALPHA = &H2; Public Const LWA_COLORKEY = &H1; Public Sub SetAutoRgn(hForm As Form, Optional transColor As Byte = vbNull) Dim X As Long, Y As Long Dim Rgn1 As Long, Rgn2 As Long Dim SPos As Long, EPos As Long Dim bm As BITMAP Dim hbm As Long Dim Wid As Long, Hgt As Long Dim xoff As Long, yoff As Long '获取窗体背景图片尺寸 hbm = hForm.Picture GetObjectAPI hbm, Len(bm), bm Wid = bm.bmWidth Hgt = bm.bmHeight With hForm .ScaleMode = vbPixels xoff = (.ScaleX(.Width, vbTwips, vbPixels) - .ScaleWidth) / 2 yoff = .ScaleY(.Height, vbTwips, vbPixels) - .ScaleHeight - xoff '改变窗体尺寸 .Width = (Wid + xoff * 2) * Screen.TwipsPerPixelX .Height = (Hgt + xoff + yoff) * Screen.TwipsPerPixelY End With ReDim bmByte(1 To Wid, 1 To Hgt) GetBitmapBits hbm, Wid * Hgt, bmByte(1, 1) '获取图像数组 '如果没有传入transColor参数,则用第一个像素作为透明色 If transColor = vbNull Then transColor = bmByte(1, 1) Rgn1 = CreateRectRgn(0, 0, 0, 0) For Y = 1 To Hgt '逐行扫描 X = 0 Do X = X + 1 While (bmByte(X, Y) = transColor) And (X < Wid) X = X + 1 '跳过是透明色的点 Wend SPos = X While (bmByte(X, Y) <> transColor) And (X < Wid) X = X + 1 '跳过不是透明色的点 Wend EPos = X - 1 '这一段是合并区域 If SPos <= EPos Then Rgn2 = CreateRectRgn(SPos - 1 + xoff, Y - 1 + yoff, EPos + xoff, Y + yoff) CombineRgn Rgn1, Rgn1, Rgn2, RGN_OR DeleteObject Rgn2 End If Loop Until X >= Wid Next Y SetWindowRgn hForm.hwnd, Rgn1, True '设定窗体形状区域 DeleteObject Rgn1 End Sub Option Explicit Private Sub Form_DblClick() Unload Me End Sub Private Sub Form_Load() 'Me.Show Dim t As Single Dim rtn As Long rtn = GetWindowLong(hwnd, GWL_EXSTYLE) rtn = rtn Or WS_EX_LAYERED SetWindowLong hwnd, GWL_EXSTYLE, rtn SetLayeredWindowAttributes hwnd, 0, 192, LWA_ALPHA '半透明 'SetLayeredWindowAttributes hwnd, &H0;, 0, LWA_COLORKEY '去除透明色 t = Timer If Me.Picture <> 0 Then Call SetAutoRgn(Me) ', 0) End If 'MsgBox "运行时间:" & Timer - t & "秒", vbInformation End Sub Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) If Button = vbLeftButton Then ReleaseCapture SendMessage Me.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0& End If End Sub
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值