VB代碼獲得當(dāng)前計(jì)算機(jī)屏幕的分辨率

1、首先：如何獲得當(dāng)前計(jì)算機(jī)屏幕的分辨率？方法一：PrivateConstSPI_GETWORKAREA=48PrivateDeclareFunctionSystemParametersInfoLib"user32"Alias_"SystemParametersInfoA"(ByValuActionAsLong,ByValuParamAsLong,lpvParamAsAny,ByValfuWinIniAsLong)AsLongPublicTypeRECTLeftAsLong'矩形左上角的X坐標(biāo)TopAsLong'矩形左上角的Y坐標(biāo)RightA

2、sLong'矩形右下角的X坐標(biāo)BottomAsLong'矩形右下角的Y坐標(biāo)EndTypePrivateSubCommand0_Click()DimlRetAsLongDimapiRECTAsRECTlRet=SystemParametersInfo(SPI_GETWORKAREAv,bNull,apiRECT,0)MsgBoxapiRECT.Right&"X"&apiRECT.BottomEndSub注意，上述得到的是可視屏幕的分辨率，如果任務(wù)欄可見，則任務(wù)欄的高度排除在外。2.根據(jù)取得的分辨率再循環(huán)所有的控件依次改變控件屬性。方法二：

3、9;*'DECLARATIONSSECTION'*OptionExplicitTypeRECTx1AsLongy1AsLongx2AsLongy2AsLongEndTypeNOTE:Thefollowingdeclarestatementsarecasesensitive.DeclareFunctionGetDesktopWindowLib"User32"()AsLongDeclareFunctionGetWindowRectLib"User32"_(ByValhWndAsLong,rectangleAsRECT)AsLong'*

4、'FUNCTION:GetScreenResolution()''PURPOSE:'Todeterminethecurrentscreensizeorresolution.''RETURN:'Thecurrentscreenresolution.Typicallyoneofthefollowing:'640x480'800x600'1024x768''*FunctionGetScreenResolution()asStringDimRAsRECTDimhWndAsLongDimRetValAsLon

5、ghWnd=GetDesktopWindow()RetVal=GetWindowRect(hWnd,R)GetScreenResolution=(R.x2-R.x1)&"x"&(R.y2-R.y1)EndFunction然后：自動(dòng)適應(yīng)電腦顯示器各種分辨率2例例一、1. DeclareFunctionGetDesktopWindowLib"USER32"()AsLong2. DeclareFunctionGetWindowRectLib"USER32"(ByValhWndAsLong,rectangleAsRECT)As

6、Long3.4. '這個(gè)函數(shù)可以使你開發(fā)的程序適應(yīng)各種分辨率，這是我見過的最完美的解決方案！強(qiáng)列推薦5. '如果你是在1024*768的分辨率下寫的程序，就把下面那句改為6. 'ConstDesignSize=1024，如果是800*600分7. '辨率下寫的，就改為ConstDesignSize=8008. '用法：把下面所有的代碼放在一個(gè)模塊里，在需要適應(yīng)分辨率的窗體的Load事件里加入：9. 'CallFormResiz_OnOpen(Me)10. '11. 'ConstDesignSize=102412. ConstDes

7、ignSize=80013.14. TypeRECT15. x1AsLong16. y1AsLong17. x2AsLong18. y2AsLong19. EndType20.21. PrivatefrmAsForm22. PrivatectrlAsControl23. PrivateprpAsProperty24. PrivateratAsDouble25. PrivateflgSec26. PrivatexAsLong27. PrivateWinHeightAsLong28. PrivatehWndAsLong29. PrivateretAsLong30. PrivateIAsIntege

8、r31. PrivateRAsRECT32. PrivateSizeLAsLong33. PrivateSizeTAsLong34. PrivateSizeWAsLong35. PrivateSizeHAsLong36.37. '38. PublicFunctionFormResiz_OnOpen(parFrmAsForm,OptionalperSizeLAsLong,OptionalperSizeTAsLong,OptionalperSizeWAsLong,OptionalperSizeHAsLong)39. OnErrorResumeNext40. Setfrm=parFrm41.

9、 '窗口駕駛盤的取得42. hWnd=GetDesktopWindow()43. '現(xiàn)在分辨率取得44. ret=GetWindowRect(hWnd,R)45. '比例計(jì)算常例：現(xiàn)在800開發(fā)1024800/1024=0.78加倍46. x=(R.x2-R.x1)47. rat=x/DesignSize48. SizeL=0:SizeT=0:SizeW=0:SizeH=049. IfNotIsEmpty(perSizeL)=TrueThen50. SizeL=perSizeL*rat51. SizeT=perSizeT*rat52. SizeW=perSizeW*ra

10、t53. SizeH=perSizeH*rat54. EndIf55.56. '現(xiàn)在分辨率=開發(fā)分辨率如果終了57. Ifx=DesignSizeThenExitFunction58. Ifx<DesignSizeThen59. '細(xì)小策劃時(shí)、控制部分表單的次序60. CallChangeCtrl61. CallChengeSec62. CallChangeFrm63. Else64. '大掬取時(shí)、表單部分控制的次序65. CallChangeFrm66. CallChengeSec67. CallChangeCtrl68. EndIf69. '最后、表單

11、的使清新70. frm.Refresh71. ExitFunction72. EndFunction73. '74. PrivateSubChangeCtrl()75. OnErrorResumeNext76. ForEachctrlInfrm.Controls77. '選項(xiàng)卡修正，原著沒有這段代碼,后來有個(gè)朋友發(fā)現(xiàn)了這個(gè)BUG就是選項(xiàng)卡的位置會(huì)偏得很厲害78. '所以就加了這段代碼來修正79. '主要是"Top","Height","Left","Width"這幾個(gè)參數(shù)的值，根據(jù)實(shí)

12、際情況適當(dāng)調(diào)整就行了80. Ifctrl.ControlType=123Orctrl.ControlType=124Then81. ForEachprpInctrl.Properties82. SelectC83. Case"FontSize","DatasheetFontHeight"84. prp.Value=Fix(prp.Value*rat+0.5)85. Case"FontWeight"86. prp.Value=Fix(prp.Value*rat)/100)*10087. Case"Top&

13、quot;,"Height"88. prp.Value=Fix(prp.Value*rat*0.85)89. 'prp.value=Fix(prp.value*rat)90. Case"Left"91. prp.Value=Fix(prp.Value*rat*0.9)92. Case"Width"93. prp.Value=Fix(prp.Value*rat*0.7)94. EndSelect95. Next96. Else97. ForEachprpInctrl.Properties98. 大小配置關(guān)于屬性被發(fā)現(xiàn)們壓縮99.

14、 SelectC100. Case"FontSize","DatasheetFontHeight"101. '通常計(jì)算假如行情況之下的+0.5之類的話不需要是但、102. '捆ZoMaft、法。稍微心情壞因?yàn)?0.5103. prp.Value=Fix(prp.Value*rat+0.5)104. Case"FontWeight"105. prp.Value=Fix(prp.Value*rat)/100)*100106. Case"Left","Top",&

15、quot;Width","Height"107. prp.Value=Fix(prp.Value*rat)108. EndSelect109. Next110. EndIf111. Next112. EndSub113. '114. PrivateSubChengeSec()115. OnErrorGoToErr_Disp116. '部分轉(zhuǎn)117. flgSec=True118. I=0119. '不存在部分的參照錯(cuò)誤化驗(yàn)出終了120. DoUntilflgSec=False121. '部分被發(fā)現(xiàn)們高度變更122. frm.Sect

16、ion(I).Height=Fix(frm.Section(I).Height*rat)123. I=I+1124. Loop125. ExitSub126. Err_Disp:127. IfErr=2462Then128. flgSec=False129. ResumeNext130. Else131. MsgBoxErr.Description132. EndIf133. ResumeNext134. EndSub135. '136. PrivateSubChangeFrm()137. OnErrorResumeNext138. IfSizeL>0Then139. DoCmd

17、.MoveSizeSizeL,SizeT,SizeW,SizeH140. Else141. frm.Width=Fix(frm.Width*rat)142. WinHeight=Fix(frm.WindowHeight*rat)143. DoCmd.MoveSize,frm.Width,WinHeight144. EndIf145. EndSub146.例二、窗體在不同的分辨率和屏幕寬度下自動(dòng)調(diào)整大小,并帶動(dòng)其上的控件自動(dòng)調(diào)整大小與相關(guān)間距是一個(gè)問題,經(jīng)過摸索,利用窗體的insidewidth和insideHeight屬性可以實(shí)現(xiàn)該功能,主要代碼如下:'-*-*-*-*-*-*-*-*

18、-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*'本模塊用于實(shí)現(xiàn)窗體自適應(yīng)分辨率和控件自適應(yīng)窗體大小功能'本模塊的核心函數(shù)為gu_SetResize()'開發(fā)和調(diào)試本模塊的時(shí)候，均以窗體最大化為動(dòng)作，其余僅改變分辨率而不修改大小的窗體則沒有'參與調(diào)試'使用方法見相應(yīng)函數(shù),注意在設(shè)計(jì)好后要修改本函數(shù)中的幾個(gè)常數(shù)'-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*

19、-*-*-*-*PrivateDeclareFunctionGetSystemMetricsLib"user32"(ByValnIndexAsLong)AsLongPrivateConstSM_CXSCREEN=0PrivateConstSM_CYSCREEN=1ConstDesignSizeX=1024'根據(jù)實(shí)際情況修改ConstDesignSizeY=768As FormDimtFormDimScaleXAsDoubleDimScaleYAsDoubleDimScaleFAsDoublePublicFunctiongu_SetResize(CurrentForm

20、AsForm,_lngOldWidthAsLong,_lngOldHeightAsLong,_OptionalisFirstAsBoolean=True)'-函數(shù)名稱:gu_SetResize'-功能描述:實(shí)現(xiàn)窗體自適應(yīng)分辨率和控件自適應(yīng)窗體大小'-輸入?yún)?shù):參數(shù)1:CurrentForm要設(shè)置的窗體'參數(shù)2:lngOldWidth對(duì)應(yīng)窗體的窗口寬度'參數(shù)3:lngOldHeight對(duì)應(yīng)窗體的窗口高度'參數(shù)4:isFirst調(diào)整大小的動(dòng)作是否窗體加載引起的（load事件將引起一個(gè)resize事件）''-返回參數(shù):無'-使用

21、示例:首先應(yīng)定義三個(gè)模塊變量，并在load事件與resize事件中分別對(duì)三個(gè)變量賦值'gu_SetResize用于窗體的resize事件中,全部示例如下：'DimoldFormWidthAsLong'DimoldFormHeightAsLong'DimblnIsFirstAsBooleanPrivateSubForm_Load()oldFormWidth=Me.InsideWidtholdFormHeight=Me.InsideHeightblnIsFirst=TrueDoCmd.MaximizeEndSubPrivateSubForm_Resize()gu_S

22、etResizeMe,oldFormWidth,oldFormHeight,blnIsFirstoldFormWidth=Me.InsideWidtholdFormHeight=Me.InsideHeightblnIsFirst=FalseEndSub'-相關(guān)調(diào)用:'-使用注意:1、本函數(shù)本應(yīng)該將在當(dāng)前機(jī)器設(shè)計(jì)時(shí)顯示的當(dāng)窗體加載后的第一次resize事件時(shí)的窗體大小應(yīng)寫入窗體的tag屬性中'但是不知道是何原因，無法寫入，所以需要手工填寫，這是實(shí)現(xiàn)自適應(yīng)分辨率的關(guān)鍵，必須注意'2、函數(shù)主要針對(duì)可調(diào)邊框的窗體，對(duì)其他窗體用處暫不明顯，故程序加有窗體邊框形式的判斷語句

23、'-兼容性:2000'-參考資料:'-作者：ACCES葉國(guó)網(wǎng)友修改：-（保密，呵呵）'-創(chuàng)建日期;2007-3-10'-圖解:As LongAs LongAs IntegerAs StringAs LongAs LongDimXDimYDimiDimstrTagsDimiWidthDimiHeightOnErrorResumeNextSettForm=CurrentForm.Formi=tForm.BorderStyleIfi=0Ori=3ThenExitFunction'取得縱橫比例ScaleX=Round(tForm.InsideWidth/

24、lngOldWidth,3)ScaleY=Round(tForm.InsideHeight/lngOldHeight,3)IfNotisFirstThenIfScaleX=1AndScaleY=1ThenExitFunctionEndIf'取得當(dāng)前分辨率X=GetSystemMetrics(SM_CXSCREEN)Y=GetSystemMetrics(SM_CYSCREEN)'IfX=DesignSizeXAndY=DesignSizeYAndisFirst=TrueThen'tForm.Tag=CStr(tForm.InsideWidth)&"|&q

25、uot;&CStr(tForm.InsideHeight)'EndIf'以下考慮窗體需要調(diào)整大小的情形'分辨率與設(shè)計(jì)相比較有變化且是第一次IfisFirstThenstrTags=tForm.TagIfLen(strTags&"")=0ThenExitFunctioni=InStr(1,strTags,"|",vbTextCompare)iWidth=CLng(Mid(strTags,1,i-1)iHeight=CLng(Mid(strTags,i+1)ScaleX=Round(lngOldWidth/iWidth

26、*ScaleX,3)ScaleY=Round(lngOldHeight/iHeight*ScaleY,3)EndIfIfScaleX=1AndScaleY=1ThenExitFunctionScaleF=(ScaleX+ScaleY)/2'根據(jù)調(diào)整比例決定控件、節(jié)、窗體的變化順序IfScaleX<1OrScaleY<1Then'縮小Callmu_AdjustControlCallmu_AdjustSectionElse'放大Callmu_AdjustSectionCallmu_AdjustControlEndIf'刷新窗體tForm.RefreshS

27、ettForm=NothingEndFunctionPrivateSubmu_AdjustControl()DimkAsIntegerDimiAsIntegerDimcAsControlDimctrlAsControlOnErrorResumeNext'調(diào)整控件ForEachctrlIntForm.Controlsmu_SetCtrolPropertiectrlk=ctrl.ControlTypeSelectCasekCaseacTabCtl'選項(xiàng)卡'對(duì)選項(xiàng)卡而言，要對(duì)其上的每一頁的控件進(jìn)行修訂Dimv1AsTabControlSetv1=ctrl.Objectv1.TabFixedHeight=v1.TabFixedHeight