lx1.frm
来自「很好的教程原代码！」· FRM 代码 · 共 381 行
FRM
381 行
VERSION 5.00
Begin VB.Form Form1
BorderStyle = 0 'None
Caption = "Form1"
ClientHeight = 1545
ClientLeft = 3870
ClientTop = 2745
ClientWidth = 2670
FillStyle = 2 'Horizontal Line
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 1545
ScaleWidth = 2670
ShowInTaskbar = 0 'False
Begin VB.PictureBox Picture1
Height = 345
Left = 20
ScaleHeight = 285
ScaleWidth = 2580
TabIndex = 8
Top = 30
Width = 2645
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
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
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 + =
减小字号Ctrl + -
显示快捷键?