VERSION 5.00
Object = "{0D452EE1-E08F-101A-852E-02608C4D0BB4}#2.0#0"; "FM20.DLL"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form Form1
AutoRedraw = -1 'True
Caption = "Form Size Finder"
ClientHeight = 4230
ClientLeft = 60
ClientTop = 345
ClientWidth = 2760
FillStyle = 0 'Solid
Icon = "Form1.frx":0000
KeyPreview = -1 'True
LinkTopic = "Form1"
ScaleHeight = 4230
ScaleWidth = 2760
StartUpPosition = 2 'CenterScreen
Begin MSComctlLib.StatusBar StatusBar1
Align = 2 'Align Bottom
Height = 300
Left = 0
TabIndex = 18
Top = 3930
Width = 2760
_ExtentX = 4868
_ExtentY = 529
_Version = 393216
BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
NumPanels = 1
BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
AutoSize = 1
Object.Width = 4339
Text = "test"
TextSave = "test"
EndProperty
EndProperty
End
Begin VB.Timer Timer1
Index = 1
Interval = 10
Left = 2040
Top = 1800
End
Begin VB.Frame Frame1
Caption = "Options"
Height = 855
Left = 120
TabIndex = 15
Top = 3000
Width = 2295
Begin VB.CheckBox Check2
Caption = "Show Mouse Coordinates"
Height = 195
Left = 120
TabIndex = 17
Top = 540
Value = 1 'Checked
Width = 2115
End
Begin VB.CheckBox Check1
Caption = "Always on top"
Height = 195
Left = 120
TabIndex = 16
Top = 280
Width = 2055
End
End
Begin VB.Timer Timer1
Index = 0
Interval = 10
Left = 2040
Top = 1320
End
Begin VB.CommandButton cmdButton
Caption = "Go"
Height = 255
Index = 0
Left = 2160
TabIndex = 10
Top = 75
Width = 495
End
Begin VB.CommandButton cmdButton
Caption = "Go"
Height = 255
Index = 1
Left = 2160
TabIndex = 9
Top = 400
Width = 495
End
Begin VB.TextBox Text1
Height = 285
Index = 0
Left = 1320
MaxLength = 4
TabIndex = 8
Text = "250"
Top = 390
Width = 495
End
Begin VB.OptionButton Option1
Caption = "1024 x 768"
Height = 195
Index = 2
Left = 120
TabIndex = 6
Top = 2640
Width = 1095
End
Begin VB.OptionButton Option1
Caption = "800 x 600"
Height = 195
Index = 1
Left = 120
TabIndex = 5
Top = 2325
Width = 1095
End
Begin VB.OptionButton Option1
Caption = "640 x 480"
Height = 195
Index = 0
Left = 120
TabIndex = 4
Top = 1995
Width = 1095
End
Begin VB.TextBox Text1
Height = 285
Index = 1
Left = 1320
MaxLength = 4
TabIndex = 11
Text = "200"
Top = 60
Width = 495
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "Mouse X , Y :"
Height = 195
Index = 5
Left = 120
TabIndex = 14
Top = 1395
Width = 960
End
Begin MSForms.SpinButton SpinButton1
Height = 300
Index = 1
Left = 1830
TabIndex = 13
Top = 375
Width = 255
Size = "450;529"
Orientation = 0
End
Begin MSForms.SpinButton SpinButton1
Height = 300
Index = 0
Left = 1830
TabIndex = 12
Top = 45
Width = 255
Size = "450;529"
Orientation = 0
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "Defaults:"
Height = 195
Index = 4
Left = 120
TabIndex = 7
Top = 1680
Width = 630
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "BOTTOM RIGHT corner:"
Height = 195
Index = 3
Left = 120
TabIndex = 3
Top = 1080
Width = 1785
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "TOP LEFT corner:"
Height = 195
Index = 2
Left = 120
TabIndex = 2
Top = 760
Width = 1305
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "WIDTH:"
Height = 195
Index = 1
Left = 120
TabIndex = 1
Top = 120
Width = 600
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "HEIGHT:"
Height = 195
Index = 0
Left = 120
TabIndex = 0
Top = 440
Width = 660
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, y, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Type POINTAPI
x As Long
y As Long
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Const HWND_TOPMOST = -1
Private Const HWND_NOTOPMOST = -2
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
Private Const TOPMOST_FLAGS = SWP_NOMOVE Or SWP_NOSIZE
Private Const WM_NCLBUTTONDOWN = &HA1
Private Const HTCAPTION = 2
Private somePoint As POINTAPI
Private lastPoint As POINTAPI
Private someRect As RECT
Private lastRect As RECT
'Always On Top checked
Private Sub Check1_Click()
If Check1.Value = 1 Then 'always on top turned on
SetWindowPos Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, TOPMOST_FLAGS
Else 'always on top turned off
SetWindowPos Me.hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, TOPMOST_FLAGS
End If
End Sub
'Show Mouse Coordinates checked
Private Sub Check2_Click()
If Check2.Value = 1 Then 'show mouse coordinates turned on
Timer1(0).Enabled = True
Else 'show mouse coordinates turned off
Timer1(0).Enabled = False
Label1(5).Caption = "Mouse X , Y :"
End If
End Sub
'Go Button pressed
Private Sub cmdButton_Click(index As Integer)
Select Case index
Case 0 'width Go was pressed
Form1.Width = Text1(1).Text * Screen.TwipsPerPixelX
Call CenterInScreen
Case 1 'height Go was pressed
Form1.Height = Text1(0).Text * Screen.TwipsPerPixelY
Call CenterInScreen
End Select
End Sub
Private Sub Form_Activate()
Option1(0).Value = False
Option1(1).Value = False
Option1(2).Value = False
Text1(1).SetFocus
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
Case 37 'left arrow was pressed (move width down)
If Val(Text1(1).Text) > 112 And Me.WindowState = 0 Then
Text1(1).Text = Val(Text1(1).Text) - 1
Form1.Width = Text1(1).Text * Screen.TwipsPerPixelX
Text1(1).SetFocus
End If
Case 38 'up arrow was pressed (move height up)
If Val(Text1(0).Text) < Screen.Height / Screen.TwipsPerPixelY And Me.WindowState = 0 Then
Text1(0).Text = Val(Text1(0).Text) + 1
Form1.Height = Text1(0).Text * Screen.TwipsPerPixelY
Text1(0).SetFocus
End If
Case 39 'right arrow was pressed (move width up)
If Val(Text1(1).Text) < (Screen.Width / Screen.TwipsPerPixelX) + 8 And Me.WindowState = 0 Then
Text1(1).Text = Val(Text1(1).Text) + 1
Form1.Width = Text1(1).Text * Screen.TwipsPerPixelX
Text1(1).SetFocus
End If
Case 40 'down arrow was pressed (move height down)
If Val(Text1(0).Text) > 45 And Me.WindowState = 0 Then
Text1(0).Text = Val(Text1(0).Text) - 1
Form1.Height = Text1(0).Text * Screen.TwipsPerPixelY
Text1(0).SetFocus
End If
End Select
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 1 Then
ReleaseCapture
SendMessage Me.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0
Call FindTopLeftBottomRight
End If
End Sub
Private Sub FindTopLeftBottomRight()
GetWindowRect Me.hwnd, someRect
Label1(2).Caption = "TOP LEFT corner: " & someRect.Left & "," & someRect.Top
Label1(3).Caption = "BOTTOM RIGHT corner: " & someRect.Right & "," & someRect.Bottom
lastRect.Bottom = someRect.Bottom
lastRect.Left = someRect.Left
lastRect.Top = someRect.Top
lastRect.Right = someRect.Right
End Sub
Private Sub Form_Resize()
Call FindTopLeftBottomRight
Label1(0).Caption = "HEIGHT: " & Form1.Height / Screen.TwipsPerPixelY
Label1(1).Caption = "WIDTH: " & Form1.Width / Screen.TwipsPerPixelX
Text1(1).Text = Form1.Width / Screen.TwipsPerPixelX
Text1(0).Text = Form1.Height / Screen.TwipsPerPixelY
StatusBar1.Panels.Clear
StatusBar1.Panels.Add 1, , "W:" & Form1.Width / Screen.TwipsPerPixelX & ", " & "H:" & Form1.Height / Screen.TwipsPerPixelY, 0
StatusBar1.Panels.Item(1).AutoSize = sbrSpring
End Sub
Private Sub Option1_Click(index As Integer)
Select Case index
Case 0 '640x480
Form1.Width = 640 * Screen.TwipsPerPixelX
Form1.Height = 480 * Screen.TwipsPerPixelY
Case 1 '800x600
Form1.Width = 800 * Screen.TwipsPerPixelX
Form1.Height = 600 * Screen.TwipsPerPixelY
Case 2 '1024x768
Form1.Width = 1024 * Screen.TwipsPerPixelX
Form1.Height = 768 * Screen.TwipsPerPixelY
End Select
Call CenterInScreen
End Sub
Private Sub CenterInScreen()
Form1.Left = (Screen.Width - Form1.Width) / 2
Form1.Top = (Screen.Height - Form1.Height) / 2
End Sub
Private Sub SpinButton1_SpinDown(index As Integer)
Select Case index
Case 0 'width spin down pressed
Text1(1).Text = Val(Text1(1)) - 1
Form1.Width = Text1(1).Text * Screen.TwipsPerPixelX
Case 1 'height spin down pressed
Text1(0).Text = Val(Text1(0)) - 1
Form1.Height = Text1(0).Text * Screen.TwipsPerPixelY
End Select
End Sub
Private Sub SpinButton1_SpinUp(index As Integer)
Select Case index
Case 0 'width spin up pressed
Text1(1).Text = Val(Text1(1)) + 1
Form1.Width = Text1(1).Text * Screen.TwipsPerPixelX
Case 1 'height spin up pressed
Text1(0).Text = Val(Text1(0)) + 1
Form1.Height = Text1(0).Text * Screen.TwipsPerPixelY
End Select
End Sub
Private Sub Text1_GotFocus(index As Integer)
Text1(index).SelStart = 0
Text1(index).SelLength = Len(Text1(index))
End Sub
Private Function NeedToUpdate(XorY As Byte) As Boolean
If XorY = 0 Then 'x was passed
If somePoint.x = lastPoint.x Then
NeedToUpdate = False
Else
NeedToUpdate = True
End If
Else 'y was passed
If somePoint.y = lastPoint.y Then
NeedToUpdate = False
Else
NeedToUpdate = True
End If
End If
End Function
Private Sub Text1_KeyPress(index As Integer, KeyAscii As Integer)
Select Case KeyAscii
Case 8
'ok to type backspace
Case 13
If index = 0 Then
Call cmdButton_Click(1)
Else
Call cmdButton_Click(0)
End If
Case 48 To 57
'ok to type numbers
Case Else
'not ok to type anything else
KeyAscii = 0
End Select
End Sub
Private Sub Timer1_Timer(index As Integer)
Select Case index
Case 0
GetCursorPos somePoint
If NeedToUpdate(0) = True Then
If somePoint.x = (Screen.Width / Screen.TwipsPerPixelX) - 1 Then
somePoint.x = somePoint.x + 1
End If
Label1(5).Caption = "Mouse X , Y : " & somePoint.x & "," & lastPoint.y
lastPoint.x = somePoint.x
End If
GetCursorPos somePoint
If NeedToUpdate(1) = True Then
If somePoint.y = (Screen.Height / Screen.TwipsPerPixelY) - 1 Then
somePoint.y = somePoint.y + 1
End If
Label1(5).Caption = "Mouse X , Y : " & lastPoint.x & "," & somePoint.y
lastPoint.y = somePoint.y
End If
Case 1
GetWindowRect Me.hwnd, someRect
If Not someRect.Left = lastRect.Left Then
Label1(2).Caption = "TOP LEFT corner: " & someRect.Left & "," & lastRect.Top
lastRect.Left = someRect.Left
End If
If Not someRect.Top = lastRect.Top Then
Label1(2).Caption = "TOP LEFT corner: " & lastRect.Left & "," & someRect.Top
lastRect.Top = someRect.Top
End If
If Not someRect.Right = lastRect.Right Then
Label1(3).Caption = "BOTTOM RIGHT corner: " & someRect.Right & "," & lastRect.Bottom
lastRect.Right = someRect.Right
End If
If Not someRect.Bottom = lastRect.Bottom Then
Label1(3).Caption = "BOTTOM RIGHT corner: " & lastRect.Right & "," & someRect.Bottom
lastRect.Bottom = someRect.Bottom
End If
End Select
End Sub