|
|
|
|
| VB问题全功略（31） |
|
［上一页］（31）［下一页］ |
151、如何算出屏幕的分辨率？
152、如何产生一个多行式的提示框
(ToolTipText)？
153、如何改变屏幕的分辨率？
154、如何在程序中启动
NT 的【拨号网络连接】对话框？
155、如何使用 ADO
來压缩或修复 Microsoft Access 文件
151、如何算出屏幕的分辨率？
如果不使用 Third
Party
的控制项，而希望程序的画面能随著屏幕的分辨率而自动调整各个控制项的位置及大小，其中最重要的一件事，便是算出目前执行程序的屏幕之分辨率！
而分辨率要如何算呢？看看以下的程序便可知道！
ResWidth
= Screen.Width \ Screen.TwipsPerPixelX
ResHeight = Screen.Height \
Screen.TwipsPerPixelY
ScreenRes = ResWidth & "x" &
ResHeight
ResWidth 就是指屏幕分辨率中的宽
ResHeight
就是指屏幕分辨率中的长
而最后算出的 ScreenRes，格式会像 800x600 一样！
除了 800x600
之外，可能还有 640x480、1024x768....等。
152、如何产生一个多行式的提示框 (ToolTipText)？
VB5 以后的 VB 版本都有提供一个属性 --
ToolTipText，目的是让使用者在执行阶段，鼠标在物件上徘徊约一秒时，就将该物件的提示字串显示在该物件下面的一个小长方形中，以协助使用者做输入动作。
有时候说明字串太长了，于是就有人想将提示字串分行显示，而且自然而然的使用
vbNewLine (=vbCrLf 或 =vbCr )
来换行，因为根据以往的经验，VB都是这样做换行的，可是这一次很多人都踢到铁板了！
VB 用来显示 ToolTipText
的提示框，其实是一个文字框，而且 MultiLine 属性并没有设为 True，您可以自己用一个单行式的文字框来做测试，就算您用 vbCrLf
来换行也不会有作用的！
既然 VB 提供的 Default
功能不能满足我们的需求，而我们又想提供使用者多行式的提示框，那要怎么办呢？其实也不难，我们自己动手 DIY
一下就有了，而且程序码也不长！
'首先在 Form 上放一个 Timer
(如果需要的话)，以便于叫出突现式说明框
Private Function TimeOut(pInterval As
Single)
Dim sngTimer As Single
sngTimer = Timer
Do While Timer
< sngTimer + pInterval
DoEvents
Loop
End Function
'然后在
Form 上放一个 Label，取名为 lblToolTip，在 MouseMove 中加入以下程序：
Private Sub
Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As
Single)
lbltooltip.Visible = False
End
Sub
'在您想显示说明框的物件加入以下程序码： ( Textbox, listbox etc. )
Private
Sub Text1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As
Single)
TimeOut 0.3 '鼠标移到物件上多久后,要显示提示框
lbltooltip.Caption = "大家好 !!"
& vbCrLf & "" & vbCrLf & _
"您目前看到的黄色标签" & vbCrLf
& "是一个多行式的提示框"
lbltooltip.Left = Text1.Left +
lbltooltip.Width
lbltooltip.Top = Text1.Top +
Text1.Height
lbltooltip.Visible = True
End Sub
153、如何改变屏幕的分辨率？
如果希望使用者在跑我们开发的应用程序时，看到的画面的样子和我们在 Design Time
时一样的话，我们往往需要处理屏幕分辨率的问题，才能使程序的画面能随著屏幕的分辨率而自动调整各个控制项的位置及大小，但是这样子往往会使程序复杂化！
除了以上这样子，将就使用者屏幕分辨率大小的民主式做法之外，您还有一个选择，那就是强制改掉使用者屏幕分辨率大小的暴权式做法，如果真的可以这么做，您根本就不用再去处理分辨率的问题了！
在讨论区中，不时有人问到如何改变屏幕分辨率的大小，这是因为在
VB 32位元的 API 检视员中漏掉了有关 EnumDisplaySettings、ChangeDisplaySettings
的常数及宣告。
'在模组中加入以下宣告、常数、型态：
Declare Function
EnumDisplaySettings Lib "user32" Alias "EnumDisplaySettingsA" (ByVal
lpszDeviceName As Long, ByVal iModeNum As Long, lpDevMode As Any) As
Boolean
Declare Function ChangeDisplaySettings Lib "user32" Alias
"ChangeDisplaySettingsA" (lpDevMode As Any, ByVal dwFlags As Long) As
Long
Declare Function ExitWindowsEx Lib "user32" _
(ByVal uFlags
As Long, ByVal dwReserved As Long) As Long
Public Const EWX_LOGOFF
= 0
Public Const EWX_SHUTDOWN = 1
Public Const EWX_REBOOT =
2
Public Const EWX_FORCE = 4
Public Const CCDEVICENAME =
32
Public Const CCFORMNAME = 32
Public Const DM_BITSPERPEL =
&H40000
Public Const DM_PELSWIDTH = &H80000
Public Const
DM_PELSHEIGHT = &H100000
Public Const CDS_UPDATEREGISTRY =
&H1
Public Const CDS_TEST = &H4
Public Const
DISP_CHANGE_SUCCESSFUL = 0
Public Const DISP_CHANGE_RESTART =
1
Type DEVMODE
dmDeviceName As String *
CCDEVICENAME
dmSpecVersion As Integer
dmDriverVersion As
Integer
dmSize As Integer
dmDriverExtra As Integer
dmFields As
Long
dmOrientation As Integer
dmPaperSize As
Integer
dmPaperLength As Integer
dmPaperWidth As Integer
dmScale
As Integer
dmCopies As Integer
dmDefaultSource As
Integer
dmPrintQuality As Integer
dmColor As Integer
dmDuplex As
Integer
dmYResolution As Integer
dmTTOption As Integer
dmCollate
As Integer
dmFormName As String * CCFORMNAME
dmUnusedPadding As
Integer
dmBitsPerPel As Integer
dmPelsWidth As Long
dmPelsHeight
As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long
End
Type
'假设现在我们希望将分辨率改成 800X600，但是不要改变色板 ，程序如下：
'注：色板指的就是 16色 /
256色 / High Color (16Bit) / True Color (24Bit)
Private Sub
Command1_Click()
Dim DevM As DEVMODE '将取得的讯息存放在 DevM
erg& =
EnumDisplaySettings(0&, 0&, DevM)
DevM.dmFields =
DM_PELSWIDTH Or DM_PELSHEIGHT 'Or DM_BITSPERPEL
DevM.dmPelsWidth = 800
'想要设定的屏幕宽度
DevM.dmPelsHeight = 600
'想要设定的屏幕高度
'我们不更改色板，因为一旦更改色板就必须重新开机！
'DevM.dmBitsPerPel = 32 (could
be 8, 16, 32 or even 4)
'此行可用于改变色板
'以下这行指令会暂时更改屏幕的分辨率，是测试性的，不一定成功，
'不过因为没将设定值写到注册表，所以虽然可能更改成功，
'但是一旦重新开机后，会自动恢复成更改前的设定值
erg&
= ChangeDisplaySettings(DevM,
CDS_TEST)
'上面的指令若成功，而且您想永久性的更改使用者的屏幕分辨率，
'您还必须使用下一行指令，将资料写到注册表
'erg&
= ChangeDisplaySettings(DevM,
CDS_UPDATEREGISTRY)
'但是如果您只是想暂时更改使用者的屏幕分辨率，就不需要了.
'当然并不是您随便设定一个值，就一定会成功的更改屏幕分辨率,
'所以还需要检查是否更改成功！下面的程序就是检查是否更改成功
Select
Case erg&
Case
DISP_CHANGE_RESTART
'通常如果有更改到色板，或者较老的板子，会要求重新开机
an =
MsgBox("您必须重新开机！", vbYesNo + vbSystemModal, "讯息")
If an = vbYes
Then
erg& = ExitWindowsEx(EWX_REBOOT, 0&)
End If
Case
DISP_CHANGE_SUCCESSFUL
'如果更改成功且不需重新开机，您就可以将设定值写到注册表中
erg& =
ChangeDisplaySettings(DevM, CDS_UPDATEREGISTRY)
MsgBox "分辨率更改成功！",
vbOKOnly + vbSystemModal, "成功！"
Case Else
'更改不成功
MsgBox
"不支持此一模式！", vbOKOnly + vbSystemModal, "错误！"
End Select
End
Sub
154、如何在程序中启动 NT 的【拨号网络连接】对话框？
在【问题125】如何在程序中启动【拨号网络连接】对话框？我告诉大家如何在 VB 中用
Shell 去叫出【拨号网络连接】对话框，程序码如下：
Private Sub Command1_Click()
Dim
res
res = Shell("rundll32.exe rnaui.dll,RnaDial " & "拨号网络连接名称",
1)
End Sub
但是有网友反应，用上述的方法只有在 Windows 95/98 中才行得通，一碰到 Windows NT
可就没辄了！今天，我要告诉大家在 Windows NT 中，要如何做到相同的事情。不难，方法如下：
Private Sub
Command1_Click()
Dim res
res = Shell("rasphone.exe [-d 拨号网络连接名称]",
1)
End Sub
155、如何使用 ADO 來压缩或修复 Microsoft Access 文件
以前使用 DAO 時，Microsoft 有提供 CompactDatabase Method 來压缩 Microsoft Access
文件，RepairDatabase Method 來修复损坏的 Microsoft Access 文件，。可是自从 ADO
出來之后，好像忘了提供相对的压缩及修复 Microsoft Access 文件的功能。
現在 Microsoft
发现了这个问题了，也提供了解決方法，不过有版本上的限制！限制說明如下：
ActiveX Data Objects (ADO),
version 2.1
Microsoft OLE DB Provider for Jet, version 4.0
這是
Microsoft 提出的 ADO 的延伸功能：Microsoft Jet OLE DB Provider and Replication
Objects (JRO)
这个功能在 JET OLE DB Provider version 4.0
(Msjetoledb40.dll) 及 JRO version 2.1 (Msjro.dll) 中第一次被提出！
這些必要的 DLL
文件在您安裝了 MDAC 2.1 之后就有了，您可以在以下的网页中下载 MDAC 的最新版本！
Universal Data
Access Web Site
在下载之前先到 VB6 中檢查一下，【控件】【設定引用項目】中的 Microsoft Jet and
Replication Objects X.X library 如果已经是 2.1 以上的版本，您就可以不用下载了！
在您安裝了
MDAC 2.1 或以上的版本之后，您就可以使用 ADO 來压缩或修复 Microsoft Access 文件，下面的步骤告訴您如何使用
CompactDatabase Method 來压缩 Microsoft Access
文件：
1、新建一個新表单，选择功能表中的【控件】【設定引用項目】。
2、加入 Microsoft Jet and
Replication Objects X.X library，其中 ( X.X 大于或等于 2.1
)。
3、在适当的地方加入以下的程序代码，記得要修改 data source 的內容及目地文件的路径：
Dim jro As
jro.JetEngine
Set jro = New jro.JetEngine
jro.CompactDatabase
"Provider=Microsoft.Jet.OLEDB.4.0;Data Source=d:\\nwind2.mdb", _
'來源文件
"Provider=Microsoft.Jet.OLEDB.4.0;Data Source=d:\\abbc2.mdb;Jet
OLEDB:Engine Type=4" '目的文件
在 DAO 3.60 之后，RepairDatabase Method
已经无法使用了，以上的程序代码显示了 ADO CompactDatabase Method 的用法，而它也取代了 DAO 3.5 時的
RepairDatabase method！ |
|