fmenu.frm

来自「会员管理系统 功能自己扩展把！ 如果有改进给我发一份quweijie8@12」· FRM 代码 · 共 104 行

VERSION 5.00
Begin VB.Form FMenu 
   AutoRedraw      =   -1  'True
   BackColor       =   &H00D1D8DB&
   BorderStyle     =   0  'None
   ClientHeight    =   9000
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   9285
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   9000
   ScaleWidth      =   9285
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  '窗口缺省
   Tag             =   "0"
   Begin VB.PictureBox p1 
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      BackColor       =   &H00B6C2C8&
      BorderStyle     =   0  'None
      Height          =   240
      Left            =   1320
      Picture         =   "Form1.frx":0000
      ScaleHeight     =   240
      ScaleWidth      =   240
      TabIndex        =   1
      Top             =   2280
      Visible         =   0   'False
      Width           =   240
   End
   Begin VB.PictureBox PP 
      AutoRedraw      =   -1  'True
      BackColor       =   &H00F7F8F9&
      BorderStyle     =   0  'None
      ForeColor       =   &H00000000&
      Height          =   360
      Index           =   0
      Left            =   360
      ScaleHeight     =   360
      ScaleWidth      =   6135
      TabIndex        =   0
      Top             =   1440
      Visible         =   0   'False
      Width           =   6135
   End
End
Attribute VB_Name = "FMenu"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
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)
Private Declare Function SetCapture Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long

Sub Form_Load()

On Error Resume Next

rtn = SetWindowPos(Me.hWnd, -1, 0, 0, 0, 0, 3)
End Sub



Private Sub PP_Click(index As Integer)
PP(index).Cls
PP(index).CurrentX = (360 - TextHeight("a")) / 2
PP(index).CurrentY = 100
PP(index).Print PP(index).Tag
Me.Tag = index
Me.Visible = False
End Sub

Private Sub PP_MouseMove(index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)

    Dim MouseOver As Boolean
     '判断当前鼠标位置是否在Command1上
    MouseOver = (0 <= X) And (X <= PP(index).Width) And (0 <= Y) And (Y <= PP(index).Height)
    
If MouseOver Then

PP(index).Line (20, 20)-(PP(index).Width - 30, PP(index).Height - 30), 13811126, BF
PP(index).Line (20, 20)-(PP(index).Width - 30, PP(index).Height - 30), 6953042, B
PP(index).CurrentX = (360 - TextHeight("a")) / 2
PP(index).CurrentY = 100
PP(index).Print PP(index).Tag


SetCapture PP(index).hWnd
Else

PP(index).Cls
PP(index).CurrentX = (360 - TextHeight("a")) / 2 + 20
PP(index).CurrentY = 120
PP(index).Print PP(index).Tag

ReleaseCapture
End If

End Sub