frmfloat.frm

利用VB＋MAPX 制作浮点图标

VERSION 5.00
Begin VB.Form Frmfloat 
   BorderStyle     =   0  'None
   Caption         =   "Form1"
   ClientHeight    =   1680
   ClientLeft      =   4890
   ClientTop       =   3225
   ClientWidth     =   2715
   LinkTopic       =   "Form1"
   ScaleHeight     =   1680
   ScaleWidth      =   2715
   ShowInTaskbar   =   0   'False
   Begin VB.PictureBox Picture2 
      BorderStyle     =   0  'None
      Height          =   495
      Left            =   960
      Picture         =   "Frmfloat.frx":0000
      ScaleHeight     =   495
      ScaleWidth      =   495
      TabIndex        =   15
      Top             =   600
      Width           =   495
   End
   Begin VB.Timer Timer1 
      Left            =   400
      Top             =   820
   End
   Begin VB.PictureBox Picture1 
      Height          =   345
      Left            =   25
      ScaleHeight     =   285
      ScaleWidth      =   4380
      TabIndex        =   0
      Top             =   15
      Width           =   4447
      Begin VB.CommandButton Command1 
         Height          =   300
         Index           =   0
         Left            =   180
         Picture         =   "Frmfloat.frx":044A
         Style           =   1  'Graphical
         TabIndex        =   14
         TabStop         =   0   'False
         Top             =   0
         Width           =   315
      End
      Begin VB.CommandButton Command1 
         Height          =   300
         Index           =   1
         Left            =   480
         Picture         =   "Frmfloat.frx":08B4
         Style           =   1  'Graphical
         TabIndex        =   13
         TabStop         =   0   'False
         Top             =   0
         Width           =   315
      End
      Begin VB.CommandButton Command1 
         Height          =   300
         Index           =   2
         Left            =   780
         Picture         =   "Frmfloat.frx":0CE6
         Style           =   1  'Graphical
         TabIndex        =   12
         TabStop         =   0   'False
         Top             =   0
         Width           =   315
      End
      Begin VB.CommandButton Command1 
         Height          =   300
         Index           =   3
         Left            =   1080
         Picture         =   "Frmfloat.frx":1150
         Style           =   1  'Graphical
         TabIndex        =   11
         TabStop         =   0   'False
         Top             =   0
         Width           =   315
      End
      Begin VB.CommandButton Command1 
         Height          =   300
         Index           =   4
         Left            =   1380
         Picture         =   "Frmfloat.frx":15BA
         Style           =   1  'Graphical
         TabIndex        =   10
         TabStop         =   0   'False
         Top             =   0
         Width           =   315
      End
      Begin VB.CommandButton Command1 
         Height          =   300
         Index           =   5
         Left            =   1680
         Picture         =   "Frmfloat.frx":1A24
         Style           =   1  'Graphical
         TabIndex        =   9
         TabStop         =   0   'False
         Top             =   0
         Width           =   315
      End
      Begin VB.CommandButton Command1 
         Height          =   300
         Index           =   6
         Left            =   1980
         Picture         =   "Frmfloat.frx":1E8E
         Style           =   1  'Graphical
         TabIndex        =   8
         TabStop         =   0   'False
         Top             =   0
         Width           =   315
      End
      Begin VB.CommandButton Command1 
         Height          =   300
         Index           =   7
         Left            =   2280
         Picture         =   "Frmfloat.frx":22F8
         Style           =   1  'Graphical
         TabIndex        =   7
         TabStop         =   0   'False
         Top             =   0
         Width           =   315
      End
      Begin VB.CommandButton Command1 
         Height          =   300
         Index           =   8
         Left            =   2580
         Picture         =   "Frmfloat.frx":2762
         Style           =   1  'Graphical
         TabIndex        =   6
         TabStop         =   0   'False
         Top             =   0
         Width           =   315
      End
      Begin VB.CommandButton Command1 
         Height          =   300
         Index           =   9
         Left            =   2880
         Picture         =   "Frmfloat.frx":2BCC
         Style           =   1  'Graphical
         TabIndex        =   5
         TabStop         =   0   'False
         Top             =   0
         Width           =   315
      End
      Begin VB.CommandButton Command1 
         Height          =   300
         Index           =   10
         Left            =   3180
         Picture         =   "Frmfloat.frx":3036
         Style           =   1  'Graphical
         TabIndex        =   4
         TabStop         =   0   'False
         Top             =   0
         Width           =   315
      End
      Begin VB.CommandButton Command1 
         Height          =   300
         Index           =   11
         Left            =   3480
         Picture         =   "Frmfloat.frx":34A0
         Style           =   1  'Graphical
         TabIndex        =   3
         TabStop         =   0   'False
         Top             =   0
         Width           =   315
      End
      Begin VB.CommandButton Command1 
         Height          =   300
         Index           =   12
         Left            =   3780
         Picture         =   "Frmfloat.frx":390A
         Style           =   1  'Graphical
         TabIndex        =   2
         TabStop         =   0   'False
         Top             =   0
         Width           =   315
      End
      Begin VB.CommandButton Command1 
         Height          =   300
         Index           =   13
         Left            =   4080
         Picture         =   "Frmfloat.frx":3D74
         Style           =   1  'Graphical
         TabIndex        =   1
         TabStop         =   0   'False
         Top             =   0
         Width           =   315
      End
      Begin VB.Image Image1 
         Height          =   300
         Left            =   15
         Picture         =   "Frmfloat.frx":41DE
         Top             =   0
         Width           =   150
      End
   End
   Begin VB.Image Image2 
      Height          =   285
      Index           =   0
      Left            =   1600
      Picture         =   "Frmfloat.frx":44A0
      Top             =   1120
      Width           =   270
   End
   Begin VB.Image Image2 
      Height          =   285
      Index           =   1
      Left            =   2020
      Picture         =   "Frmfloat.frx":490A
      Top             =   1120
      Width           =   270
   End
End
Attribute VB_Name = "Frmfloat"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

'获得鼠标指针在屏幕坐标上的位置
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 MyRect As RECT
Private MyPoint As POINTAPI

Private Is_Move_B As Boolean            '判断指针是否位于移动栏(本例中移动栏位于窗体的侧一小地方)
Private Is_Movestar_B As Boolean        '判断移动是否开始
Private Movex As Long, Movey As Long    '记录窗体移动前，窗体左上角与鼠标指针位置间的纵横距离
Private max As Long                     '窗口变长以后的尺寸(用户可随意改动)

Private Sub Command1_Click(Index As Integer)
  Frmfloat.SetFocus
  Select Case Index
        Case 0
         Frmfloat.PopupMenu FrmMenu.mnu_file, vbPopupMenuLeftAlign, 240, max - 30
        Case 1
            MsgBox "1"
        Case 2
            MsgBox "2"
        Case 3
            MsgBox "3"
        Case 4
            MsgBox "4"
        Case 5
            MsgBox "5"
        Case 6
            MsgBox "6"
        Case 7
            If Command1(7).Picture = Image2(0).Picture Then
                Command1(7).Picture = Image2(1).Picture
                Picture1.Width = 4430
                Frmfloat.Width = Frmfloat.Width + 1780
            Else
                Command1(7).Picture = Image2(0).Picture
                Picture1.Width = 2620
                Frmfloat.Width = Frmfloat.Width - 1780
            End If
            Line (0, 0)-(Frmfloat.Width, Frmfloat.Height), vbBlue, BF
            Get_Windows_Rect
        Case 8
            MsgBox "8"
        Case 9
            MsgBox "9"
        Case 10
            MsgBox "10"
        Case 11
            MsgBox "11"
        Case 12
            MsgBox "12"
        Case 13
           If MsgBox("真的退出系统吗？", vbQuestion + vbOKCancel, "退出提示") = vbOK Then
              End
           End If
  End Select
End Sub

Private Sub Form_Load()
        Command1(7).Picture = Image2(0).Picture
        Picture1.Width = 2620
        Frmfloat.Width = 2700
        Timer1.Interval = 50
        Frmfloat.BackColor = vbBlue
        Get_Windows_Rect
    
    t.cbSize = Len(t)
    t.hWnd = Picture2.hWnd
    t.uId = 1&
    t.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
    t.ucallbackMessage = WM_MOUSEMOVE
    t.hIcon = Picture2.Picture
    t.szTip = "我的程序例程" & Chr$(0)
    Shell_NotifyIcon NIM_ADD, t

End Sub
Public Sub Get_Windows_Rect()
Dim dl As String
max = 390
Frmfloat.Height = max
Frmfloat.Top = 0       '窗体始终放在屏幕顶部
dl = GetWindowRect(Frmfloat.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, Frmfloat.Height \ Screen.TwipsPerPixelY, 0
End If
End Sub
Public Sub Repaint()
'使窗体始终置于最前面
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, Frmfloat.Height \ Screen.TwipsPerPixelY, 0
End If
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If MsgBox("真的退出系统吗？", vbQuestion + vbOKCancel, "退出提示") = vbOK Then
    End
Else
    Cancel = 1
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 As String
       If Is_Movestar_B Then
            dl = MoveWindow(Frmfloat.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 Picture2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    'If Hex(X) = "1E3C" Then
    If Button = 2 Then
         Frmfloat.PopupMenu FrmMenu.mnu_file, vbPopupMenuLeftAlign
    End If

End Sub

Private Sub Timer1_Timer()
Dim dl As String
dl = GetCursorPos(MyPoint)
If (PtInRect(MyRect, MyPoint.X, MyPoint.Y) And Frmfloat.Height = max) Or MyPoint.Y <= 2 Then
    Frmfloat.BackColor = vbBlue     '窗体背景颜色(用户可随意改动)
    Frmfloat.Height = max
    '判断鼠标指针是否位于窗体拖动区
    If MyPoint.X - MyRect.Left <= 15 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
          Frmfloat.Height = 30   '窗体变小
    End If
End If
End Sub