窗本如何随显视器的大小而自动全屏,而内部的控件也同时缩放?
15#显视器窗体就大的很,17#显视器就绰绰有余,而且定义的大了,里面的控件就无法显视。请教大侠指教:………^_^ 问题点数:0、回复次数:18Top
1 楼yangchonglv(瓯越浪子)回复于 2004-08-01 11:34:47 得分 0
窗体的width,height属性设置为screen.width,screen.height,就能使窗体的大小等于显示器的大小了,然后各个控件的大小就可以与窗体的width,heighth计算出来Top
2 楼Thinking_More(思维)回复于 2004-08-01 11:37:30 得分 0
是的,我也这样认为Top
3 楼zcm123(老蝌蚪精 ●~ www.84ren.com 来了就下的源码站)回复于 2004-08-01 11:42:28 得分 0
至于控件方面 xxx.width=width xxx.height=height/2 就是xxx的长度等于窗体的长度
高度等于窗体高度的一半Top
4 楼Thinking_More(思维)回复于 2004-08-01 11:52:21 得分 0
" 控件.长度等于窗体的长度 高度等于窗体高度的一半" 有问题吧?什么道理吗?Top
5 楼gdami(糖米)回复于 2004-08-01 11:57:33 得分 0
他意思是说你窗体变了后,所有的控件都要根据窗体的大小来重新计算和控制大小。
打个比方就是1半吧。其实蛮麻烦的。Top
6 楼5653325(等待开刃的刀)回复于 2004-08-01 13:06:02 得分 0
按比例来进行缩小或者扩大Top
7 楼BlueBeer(1win)回复于 2004-08-01 14:57:07 得分 0
screen.width和screen.height返回屏幕的大小,根据它可以计算屏幕的分辨率,再根据不同的分辨率用代码改变各控件的大小Top
8 楼suolong123(JJ掉了不过碗大个疤)回复于 2004-08-01 15:06:36 得分 0
Me.Width=Screen.Width
Me.Height=Screen.Height
在窗体的Resize事件里写入控件的大小信息Top
9 楼dongge2000(目前叫西西了)回复于 2004-08-01 16:05:00 得分 0
别人写的。
' --- Author, Muhammad Abubakar
' <joehacker@yahoo.com>
' http://go.to/abubakar
'Key codes:
'1 -> top only
'2 -> left only
'3 -> top and left
'4 -> height only
'5 -> width only
'6 -> height and width
'-----------------------
Option Explicit
Enum eParams
RS_TopOnly = 1
RS_LeftOnly = 2
RS_Top_Left = 3
RS_HeightOnly = 4
RS_WidthOnly = 5
RS_Height_Width = 6
End Enum
Private Type cInfo
cControl As Control
cHeight As Integer
cWidth As Integer
cTop As Integer
cLeft As Integer
cInfo As Integer
End Type
Private cArray() As cInfo
Private Count As Integer
Private FormHeight As Integer
Private FormWidth As Integer
Public Property Let hParam(ByVal fh As Integer)
FormHeight = fh
End Property
Public Property Let wParam(ByVal fw As Integer)
FormWidth = fw
End Property
Public Sub Map(rCont As Control, SizeInfo As eParams)
Count = Count + 1
ReDim Preserve cArray(Count)
Set cArray(Count).cControl = rCont
cArray(Count).cInfo = SizeInfo
Select Case SizeInfo
Case 1:
cArray(Count).cTop = FormHeight - rCont.Top
Case 2:
cArray(Count).cLeft = FormWidth - rCont.Left
Case 3:
cArray(Count).cTop = FormHeight - rCont.Top
cArray(Count).cLeft = FormWidth - rCont.Left
Case 4:
cArray(Count).cHeight = FormHeight - rCont.Height
Case 5:
cArray(Count).cWidth = FormWidth - rCont.Width
Case 6:
cArray(Count).cHeight = FormHeight - rCont.Height
cArray(Count).cWidth = FormWidth - rCont.Width
Case Else:
Exit Sub
End Select
End Sub
Public Sub rSize(cForm As Form)
On Error Resume Next
Dim i As Integer, a As Integer, b As Integer
For i = 1 To Count
Select Case cArray(i).cInfo
Case 1:
cArray(i).cControl.Top = cForm.Height - cArray(i).cTop
Case 2:
cArray(i).cControl.Left = cForm.Width - cArray(i).cLeft
Case 3:
cArray(i).cControl.Top = cForm.Height - cArray(i).cTop
cArray(i).cControl.Left = cForm.Width - cArray(i).cLeft
Case 4:
b = cForm.Height - cArray(i).cHeight
If b < 0 Then b = 0
cArray(i).cControl.Height = b 'cForm.Height - cArray(i).cHeight
Case 5:
a = cForm.Width - cArray(i).cWidth
If a < 0 Then a = 0
cArray(i).cControl.Width = a 'cForm.Width - cArray(i).cWidth
Case 6:
a = cForm.Width - cArray(i).cWidth
b = cForm.Height - cArray(i).cHeight
If a < 0 Then a = 0
If b < 0 Then b = 0
cArray(i).cControl.Height = b 'cForm.Height - cArray(i).cHeight
cArray(i).cControl.Width = a 'cForm.Width - cArray(i).cWidth
End Select
Next
Exit Sub
End Sub
Top
10 楼dongge2000(目前叫西西了)回复于 2004-08-01 16:06:01 得分 0
Private Sub Form_Load()
With ClassResize
.hParam = Form1.Height
.wParam = Form1.Width
.Map Command1, RS_Top_Left
.Map Command2, RS_Top_Left
.Map Command3, RS_Top_Left
.Map Label2, RS_TopOnly
.Map Label3, RS_LeftOnly
.Map View1, RS_HeightOnly
.Map View2, RS_HeightOnly
.Map Check1, RS_Top_Left
End With
Form1.Width = 11000
Me.Left = (Screen.Width - Me.Width) / 2
Me.Top = (Screen.Height - Me.Height) / 2
View1.View = lvwReport
With View1.ColumnHeaders
.Add , , "Handle", 1000
.Add , , "Class Name", 1500
.Add , , "Text", 4500
End With
VCount = 1
View2.View = lvwReport
With View2.ColumnHeaders
.Add , , "Handle", 1000
.Add , , "Class Name", 1500
.Add , , "Text", 4500
.Add , , "IsPassword field", 1000
End With
ICount = 1
Options.Visible = False
End Sub
Private Sub Form_Resize()
ClassResize.rSize Form1
'OK now resize if you must!
View2.Left = Int(Form1.Width / 2)
View1.Width = View2.Left - 255
View2.Width = Int(Form1.Width / 2) - 255
End SubTop
11 楼Thinking_More(思维)回复于 2004-08-01 16:37:56 得分 0
不行啊,秋日私语,调试不能通过 这些代码你调试过了吗?Top
12 楼dongyanghai()回复于 2004-08-01 17:28:07 得分 0
好象有点问题呀Top
13 楼ryuginka(一米八五的猪)回复于 2004-08-01 21:06:00 得分 0
有个控件,resize32.ocx,你到网上找找看Top
14 楼WallesCai(女人之美,在于蠢得无怨无悔,男人之美,在于撒谎撒得白日见鬼)回复于 2004-08-02 01:12:05 得分 0
在窗体加载的时候,遍历窗体上的所有控件,将它们的大小和位置都记录下来(top,left,width,height)并且转化成和窗体高度,宽度相关的比例。
然后在窗体的ReSize事件中,读取窗体新的高度和宽度,再次遍历所有控件,按照前面记录的每个控件的相关比例调整大小和位置。
思路就是这样,实现起来也不难,代码就不写了。
需要注意一点,不要单个的设置top,left,width,height这些属性,速度比较慢,使用Move方法可以同时设定这四个属性,速度快。Top
15 楼LGYAN(紫衣随想)回复于 2004-08-02 11:15:04 得分 0
是分辨率大小吧。
Top
16 楼dongge2000(目前叫西西了)回复于 2004-08-03 11:39:19 得分 0
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "CResize"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' THE RESEIZE CLASS
' ~~~~~~~~~~~~~~~~~
'You are free to use this class in your own projects n give
'me some credits when you do. Dont forget to visit my web
'site k?
' --- Author, Muhammad Abubakar
' <joehacker@yahoo.com>
' http://go.to/abubakar
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'Key codes:
'1 -> top only
'2 -> left only
'3 -> top and left
'4 -> height only
'5 -> width only
'6 -> height and width
'-----------------------
Option Explicit
Enum eParams
RS_TopOnly = 1
RS_LeftOnly = 2
RS_Top_Left = 3
RS_HeightOnly = 4
RS_WidthOnly = 5
RS_Height_Width = 6
End Enum
Private Type cInfo
cControl As Control
cHeight As Integer
cWidth As Integer
cTop As Integer
cLeft As Integer
cInfo As Integer
End Type
Private cArray() As cInfo
Private Count As Integer
Private FormHeight As Integer
Private FormWidth As Integer
Public Property Let hParam(ByVal fh As Integer)
FormHeight = fh
End Property
Public Property Let wParam(ByVal fw As Integer)
FormWidth = fw
End Property
Public Sub Map(rCont As Control, SizeInfo As eParams)
Count = Count + 1
ReDim Preserve cArray(Count)
Set cArray(Count).cControl = rCont
cArray(Count).cInfo = SizeInfo
Select Case SizeInfo
Case 1:
cArray(Count).cTop = FormHeight - rCont.Top
Case 2:
cArray(Count).cLeft = FormWidth - rCont.Left
Case 3:
cArray(Count).cTop = FormHeight - rCont.Top
cArray(Count).cLeft = FormWidth - rCont.Left
Case 4:
cArray(Count).cHeight = FormHeight - rCont.Height
Case 5:
cArray(Count).cWidth = FormWidth - rCont.Width
Case 6:
cArray(Count).cHeight = FormHeight - rCont.Height
cArray(Count).cWidth = FormWidth - rCont.Width
Case Else:
Exit Sub
End Select
End Sub
Public Sub rSize(cForm As Form)
On Error Resume Next
Dim i As Integer, a As Integer, b As Integer
For i = 1 To Count
Select Case cArray(i).cInfo
Case 1:
cArray(i).cControl.Top = cForm.Height - cArray(i).cTop
Case 2:
cArray(i).cControl.Left = cForm.Width - cArray(i).cLeft
Case 3:
cArray(i).cControl.Top = cForm.Height - cArray(i).cTop
cArray(i).cControl.Left = cForm.Width - cArray(i).cLeft
Case 4:
b = cForm.Height - cArray(i).cHeight
If b < 0 Then b = 0
cArray(i).cControl.Height = b 'cForm.Height - cArray(i).cHeight
Case 5:
a = cForm.Width - cArray(i).cWidth
If a < 0 Then a = 0
cArray(i).cControl.Width = a 'cForm.Width - cArray(i).cWidth
Case 6:
a = cForm.Width - cArray(i).cWidth
b = cForm.Height - cArray(i).cHeight
If a < 0 Then a = 0
If b < 0 Then b = 0
cArray(i).cControl.Height = b 'cForm.Height - cArray(i).cHeight
cArray(i).cControl.Width = a 'cForm.Width - cArray(i).cWidth
End Select
Next
Exit Sub
End Sub
Top
17 楼dongge2000(目前叫西西了)回复于 2004-08-03 11:39:50 得分 0
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form Form1
Caption = "Enumeration Goes On"
ClientHeight = 5340
ClientLeft = 1650
ClientTop = 2205
ClientWidth = 8070
LinkTopic = "Form1"
ScaleHeight = 5340
ScaleWidth = 8070
Begin VB.CheckBox Check1
Caption = "&Windows with captions"
Height = 195
Left = 1800
TabIndex = 8
Top = 4920
Width = 2295
End
Begin VB.CommandButton Command3
Caption = "&Patch'em"
BeginProperty Font
Name = "Comic Sans MS"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = -1 'True
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 5400
TabIndex = 7
ToolTipText = "Change text of any window :)"
Top = 4800
Width = 1215
End
Begin MSComctlLib.ListView View2
Height = 4215
Left = 4080
TabIndex = 5
ToolTipText = "Child windows"
Top = 480
Width = 3855
_ExtentX = 6800
_ExtentY = 7435
LabelWrap = -1 'True
HideSelection = -1 'True
FullRowSelect = -1 'True
_Version = 393217
ForeColor = 12582912
BackColor = 16777215
BorderStyle = 1
Appearance = 1
NumItems = 0
End
Begin MSComctlLib.ListView View1
Height = 4215
Left = 120
TabIndex = 3
ToolTipText = "Parent windows"
Top = 480
Width = 3855
_ExtentX = 6800
_ExtentY = 7435
LabelWrap = -1 'True
HideSelection = -1 'True
FullRowSelect = -1 'True
_Version = 393217
ForeColor = 12582912
BackColor = 16777215
BorderStyle = 1
Appearance = 1
NumItems = 0
End
Begin VB.CommandButton Command2
Caption = "E&numThem"
Height = 375
Left = 6720
TabIndex = 0
Top = 4800
Width = 1215
End
Begin VB.CommandButton Command1
Caption = "&Leave"
Height = 375
Left = 4080
TabIndex = 1
Top = 4800
Width = 1215
End
Begin VB.Label Label2
Caption = "http://go.to/abubakar"
ForeColor = &H00FF0000&
Height = 255
Left = 120
MousePointer = 99 'Custom
TabIndex = 6
Top = 4920
Width = 1695
End
Begin VB.Label Label1
Caption = "Left or Right click the Handles to see what happens"
Height = 255
Left = 120
TabIndex = 4
Top = 120
Width = 4215
End
Begin VB.Label Label3
BackColor = &H00000000&
Caption = "Enumerating to the Max"
BeginProperty Font
Name = "Comic Sans MS"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = -1 'True
Strikethrough = 0 'False
EndProperty
ForeColor = &H0000FF00&
Height = 255
Left = 5520
TabIndex = 2
Top = 120
Width = 2415
End
Begin VB.Menu Options
Caption = "Options"
Begin VB.Menu Show
Caption = "&Show Window using ShowWindow API"
End
Begin VB.Menu Show_BWTT
Caption = "Show &Winsow using BringWindowToTop API"
End
Begin VB.Menu s3
Caption = "-"
End
Begin VB.Menu Max
Caption = "Ma&ximize"
End
Begin VB.Menu Min
Caption = "Mi&nimize"
End
Begin VB.Menu Restore
Caption = "&Restore"
End
Begin VB.Menu Hide
Caption = "&Hide"
End
Begin VB.Menu Close
Caption = "&Close this Window"
End
Begin VB.Menu s
Caption = "-"
End
Begin VB.Menu SpyMenu
Caption = "Spy the &Menus"
End
End
Begin VB.Menu menu2
Caption = "menu2"
Visible = 0 'False
Begin VB.Menu BnClick
Caption = "&Click"
End
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'------------------------------------
' Author: Muhammad Abubakar
' http://go.to/abubakar
' <joehacker@yahoo.com>
'------------------------------------
Option Explicit
Private ClassResize As New CResize
'API to open the browser
Private Declare Function ShellExecute Lib "shell32.dll" Alias _
"ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As _
String, ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Sub BnClick_Click()
SendMessage Val(View2.SelectedItem), BM_CLICK, 0, 0
End Sub
Top
18 楼dongge2000(目前叫西西了)回复于 2004-08-03 11:40:37 得分 0
Private Sub Close_Click()
'close window code goes here:
Dim lhwnd As Long
On Error Resume Next
lhwnd = Val(View1.SelectedItem)
SendMessage lhwnd, WM_CLOSE, 0, 0
End Sub
Private Sub Command1_Click()
'Free the memory occupied by the Object
Set ClassResize = Nothing
Unload Me
End Sub
Private Sub Command2_Click()
Command2.Caption = "&Refresh"
View1.ListItems.Clear
View2.ListItems.Clear
View1.GridLines = True
Dim myLong As Long
VCount = 1
myLong = EnumWindows(AddressOf WndEnumProc, View1)
End Sub
Private Sub Command3_Click()
Form2.Show vbModal
End Sub
Private Sub Form_Load()
With ClassResize
.hParam = Form1.Height
.wParam = Form1.Width
.Map Command1, RS_Top_Left
.Map Command2, RS_Top_Left
.Map Command3, RS_Top_Left
.Map Label2, RS_TopOnly
.Map Label3, RS_LeftOnly
.Map View1, RS_HeightOnly
.Map View2, RS_HeightOnly
.Map Check1, RS_Top_Left
End With
Form1.Width = 11000
Me.Left = (Screen.Width - Me.Width) / 2
Me.Top = (Screen.Height - Me.Height) / 2
View1.View = lvwReport
With View1.ColumnHeaders
.Add , , "Handle", 1000
.Add , , "Class Name", 1500
.Add , , "Text", 4500
End With
VCount = 1
View2.View = lvwReport
With View2.ColumnHeaders
.Add , , "Handle", 1000
.Add , , "Class Name", 1500
.Add , , "Text", 4500
.Add , , "IsPassword field", 1000
End With
ICount = 1
Options.Visible = False
End Sub
Private Sub Form_Resize()
ClassResize.rSize Form1
'OK now resize if you must!
View2.Left = Int(Form1.Width / 2)
View1.Width = View2.Left - 255
View2.Width = Int(Form1.Width / 2) - 255
End Sub
Private Sub Form_Unload(Cancel As Integer)
Dim i As Integer
For i = Forms.Count - 1 To 1 Step -1
Unload Forms(i)
Next
End Sub
Private Sub Hide_Click()
ShowWindow Val(View1.SelectedItem), SW_HIDE
End Sub
Private Sub Label2_Click()
Dim ret As Long
ret = ShellExecute(Me.hwnd, "Open", "http://go.to/abubakar", "", App.Path, 1)
End Sub
Private Sub Max_Click()
ShowWindow Val(View1.SelectedItem), SW_MAXIMIZE
End Sub
Private Sub Min_Click()
ShowWindow Val(View1.SelectedItem), SW_MINIMIZE
End Sub
Private Sub Restore_Click()
ShowWindow Val(View1.SelectedItem), SW_RESTORE
End Sub
Private Sub Show_BWTT_Click()
Dim lhwnd As Long
On Error GoTo bugging
lhwnd = Val(View1.SelectedItem)
'ShowWindow lhwnd, SW_SHOW
BringWindowToTop lhwnd
Exit Sub
bugging:
Rem Do Nothing
End Sub
Private Sub Show_Click()
'show window code goes here:
Dim lhwnd As Long
On Error Resume Next
lhwnd = Val(View1.SelectedItem)
ShowWindow lhwnd, SW_SHOW
End Sub
Private Sub SpyMenu_Click()
Dim st As RECT
Spy_Form.Show
SpyHwnd = Val(View1.SelectedItem)
Spy_Form.Tree.Nodes.Clear
'If its a MDI type window and its child windows are maximized
'then 'GetMenuItemInfo' crashes the 'EnumerationX'.
'I tried to cascade the windows of other app but that doesnt
'happen, do you know how I can do this?
'MsgBox CascadeWindows(SpyHwnd, MDITILE_SKIPDISABLED, st, 0, 0)
'SendMessage SpyHwnd, WM_MDICASCADE, MDITILE_SKIPDISABLED, 0
'SendMessage SpyHwnd, WM_MDITILE, MDITILE_HORIZONTAL, 0
SMenu GetMenu(SpyHwnd), Spy_Form.Tree
End Sub
Private Sub View1_Click()
GotoChild
End Sub
Private Sub View1_KeyUp(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyUp Or KeyCode = vbKeyDown Then GotoChild
'So that you are able to see child windows easily by
'scrolling through up-down arrow keys instead of
'clicking the parent window handle every time.
End Sub
Private Sub GotoChild()
On Error GoTo HandleErrorPlz
Dim Num As Long
Dim myLong As Long
Num = Val(View1.SelectedItem)
View2.ListItems.Clear
View2.GridLines = True
ICount = 1
myLong = EnumChildWindows(Num, AddressOf WndEnumChildProc, View2)
HandleErrorPlz:
'Exit Sub ' As simple as that :)
End Sub
Private Sub View1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = vbRightButton And View1.ListItems.Count > 0 Then
If GetMenu(Val(View1.SelectedItem)) > 0 Then
SpyMenu.Enabled = True
Else
SpyMenu.Enabled = False
End If
PopupMenu Options
End If
End Sub
Private Sub View2_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = vbRightButton And View2.ListItems.Count > 0 Then
PopupMenu menu2
End If
End Sub
自己看看吧,我只能回三个贴,还有一个模块没贴。Top




