📄 lx1.frm
字号:
VERSION 5.00
Begin VB.Form Form1
BorderStyle = 0 'None
ClientHeight = 1545
ClientLeft = 3870
ClientTop = 2745
ClientWidth = 4620
ControlBox = 0 'False
FillStyle = 2 'Horizontal Line
LinkTopic = "Form1"
ScaleHeight = 1545
ScaleWidth = 4620
ShowInTaskbar = 0 'False
Begin VB.PictureBox Picture1
Height = 345
Left = 20
ScaleHeight = 285
ScaleWidth = 4500
TabIndex = 8
Top = 30
Width = 4560
Begin VB.CommandButton Command1
Height = 300
Index = 13
Left = 4080
Picture = "lx1.frx":0000
Style = 1 'Graphical
TabIndex = 14
TabStop = 0 'False
Top = 0
Width = 315
End
Begin VB.CommandButton Command1
Height = 300
Index = 12
Left = 3780
Picture = "lx1.frx":046A
Style = 1 'Graphical
TabIndex = 13
TabStop = 0 'False
Top = 0
Width = 315
End
Begin VB.CommandButton Command1
Height = 300
Index = 11
Left = 3480
Picture = "lx1.frx":08D4
Style = 1 'Graphical
TabIndex = 12
TabStop = 0 'False
Top = 0
Width = 315
End
Begin VB.CommandButton Command1
Height = 300
Index = 10
Left = 3180
Picture = "lx1.frx":0D3E
Style = 1 'Graphical
TabIndex = 11
TabStop = 0 'False
Top = 0
Width = 315
End
Begin VB.CommandButton Command1
Height = 300
Index = 9
Left = 2880
Picture = "lx1.frx":11A8
Style = 1 'Graphical
TabIndex = 10
TabStop = 0 'False
Top = 0
Width = 315
End
Begin VB.CommandButton Command1
Enabled = 0 'False
Height = 300
Index = 8
Left = 2580
Picture = "lx1.frx":1612
Style = 1 'Graphical
TabIndex = 9
TabStop = 0 'False
Top = 0
Width = 315
End
Begin VB.CommandButton Command1
Height = 300
Index = 7
Left = 2280
Picture = "lx1.frx":1A7C
Style = 1 'Graphical
TabIndex = 7
TabStop = 0 'False
Top = 0
Width = 315
End
Begin VB.CommandButton Command1
Height = 300
Index = 6
Left = 1980
Picture = "lx1.frx":1EE6
Style = 1 'Graphical
TabIndex = 6
TabStop = 0 'False
Top = 0
Width = 315
End
Begin VB.CommandButton Command1
Height = 300
Index = 5
Left = 1680
Picture = "lx1.frx":2350
Style = 1 'Graphical
TabIndex = 5
TabStop = 0 'False
Top = 0
Width = 315
End
Begin VB.CommandButton Command1
Height = 300
Index = 4
Left = 1380
Picture = "lx1.frx":27BA
Style = 1 'Graphical
TabIndex = 4
TabStop = 0 'False
Top = 0
Width = 315
End
Begin VB.CommandButton Command1
Height = 300
Index = 3
Left = 1080
Picture = "lx1.frx":2C24
Style = 1 'Graphical
TabIndex = 3
TabStop = 0 'False
Top = 0
Width = 315
End
Begin VB.CommandButton Command1
Height = 300
Index = 2
Left = 780
Picture = "lx1.frx":308E
Style = 1 'Graphical
TabIndex = 2
TabStop = 0 'False
Top = 0
Width = 315
End
Begin VB.CommandButton Command1
Height = 300
Index = 1
Left = 480
Picture = "lx1.frx":34F8
Style = 1 'Graphical
TabIndex = 1
TabStop = 0 'False
Top = 0
Width = 315
End
Begin VB.CommandButton Command1
Height = 300
Index = 0
Left = 180
Picture = "lx1.frx":392A
Style = 1 'Graphical
TabIndex = 0
TabStop = 0 'False
Top = 0
Width = 315
End
Begin VB.Image Image1
Height = 300
Left = 10
Picture = "lx1.frx":3D94
Top = 0
Width = 150
End
End
Begin VB.Timer Timer2
Interval = 1000
Left = 900
Top = 540
End
Begin VB.Timer Timer1
Left = 420
Top = 540
End
Begin VB.Image Image2
Height = 285
Index = 1
Left = 2040
Picture = "lx1.frx":4056
Top = 1140
Width = 270
End
Begin VB.Image Image2
Height = 285
Index = 0
Left = 1620
Picture = "lx1.frx":44C0
Top = 1140
Width = 270
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'获得鼠标指针在屏幕坐标上的位置
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 PtInRect Lib "user32" (lpRect As RECT, ByVal ptx As Long, ByVal pty As Long) As Long
'准备用来使窗体始终在最前面
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter _
As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
'用来移动窗体
Private Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal X As Long, _
ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Const HWND_TOPMOST = -1
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 Is_Move_B As Boolean '判断指针是否位于移动栏(本例中移动栏位于窗体的侧一小地方)
Private Is_Movestar_B As Boolean '判断移动是否开始
Private MyRect As RECT
Private MyPoint As POINTAPI
Private Movex As Long, Movey As Long '记录窗体移动前，窗体左上角与鼠标指针位置间的纵横距离
Private max As Long '窗口变长以后的尺寸(用户可随意改动)
Private Sub Command1_Click(Index As Integer)
Form1.SetFocus
Select Case Index
Case 0
Form1.PopupMenu Form2.mnu_file, vbPopupMenuLeftAlign, 240, max - 30
Case 1
Case 7
Command1(8).Enabled = Not Command1(8).Enabled
If Command1(8).Enabled = True Then
Command1(7).Picture = Image2(1).Picture
Picture1.Width = 4455
Form1.Width = Form1.Width + 1820
Else
Command1(7).Picture = Image2(0).Picture
Picture1.Width = 2645
Form1.Width = Form1.Width - 1820
End If
Line (0, 0)-(Form1.Width, Form1.Height), vbBlue, BF
Get_Windows_Rect
'......
Case 13
End
' .....
End Select
End Sub
Private Sub Form_Load()
Timer1.Interval = 50: Timer2.Interval = 1000
Form1.BackColor = vbBlue
Get_Windows_Rect
Picture1.Width = 2645
Form1.Width = 2670
End Sub
Sub Get_Windows_Rect()
Dim dl&
max = 390: Form1.Height = max
Form1.Top = 0 '窗体始终放在屏幕顶部
dl& = GetWindowRect(Form1.hwnd, MyRect)
End Sub
Private Sub Form_Paint()
'使窗体始终置于最前面
If PtInRect(MyRect, MyPoint.X, MyPoint.Y) = 0 Then
SetWindowPos Me.hwnd, HWND_TOPMOST, Me.Left / Screen.TwipsPerPixelX, _
Me.Top \ Screen.TwipsPerPixelY, Me.Width \ Screen.TwipsPerPixelX, _
Form1.Height \ Screen.TwipsPerPixelY, 0
End If
End Sub
Private Sub Image1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Is_Move_B Then
Movex = MyPoint.X - MyRect.Left
Movey = MyPoint.Y - MyRect.Top
Is_Movestar_B = True
End If
End Sub
Private Sub Image1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim dl&
If Is_Movestar_B Then
dl& = MoveWindow(Form1.hwnd, MyPoint.X - Movex, MyPoint.Y - Movey, _
MyRect.Right - MyRect.Left, MyRect.Bottom, -1)
End If
End Sub
Private Sub Image1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Get_Windows_Rect
Is_Movestar_B = False
End Sub
Private Sub Timer1_Timer()
Dim dl&
dl& = GetCursorPos(MyPoint)
If (PtInRect(MyRect, MyPoint.X, MyPoint.Y) And _
Form1.Height = max) Or MyPoint.Y <= 3 Then
' If MyPoint.Y <= 3 Then
Form1.BackColor = vbBlue '窗体背景颜色(用户可随意改动)
Form1.Height = max
'判断鼠标指针是否位于窗体拖动区
If MyPoint.X - MyRect.Left <= 10 Or Is_Movestar_B Then
Screen.MousePointer = 15
Is_Move_B = True
Else
Screen.MousePointer = 0
Is_Move_B = False
End If
Else
If Not Is_Movestar_B Then
Form1.Height = 30 '窗体变小
End If
End If
End Sub
Private Sub Timer2_Timer()
Static color As Integer
If color > 64 Then color = 0
Line (0, 0)-(Form1.Width, Form1.Height), QBColor(color Mod 16), BF
color = color + 15
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -