大哥们，救救我啊！！！！！！！！！！！

我刚才写了一个程序，没有完全满足你的要求，
1）我的程序整个都是标题栏，你只需要在picture1的鼠标按下的时候判断一下范围就可以了
2）我有两个按钮用来实现关闭和向托盘区显示图标的功能，你可以用图片框或者在picture1.mousemove中实现就行了。
下面是整个源代码，运行的时候需要一个main.bmp，关于按钮的位置的调节没做处理，可以给我发送短消息注明--托盘程序--所取代码
==========================================
systray1.vbpType=Exe
Form=frm1.frm
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\WINDOWS\System32\stdole2.tlb#OLE Automation
Module=mod1; mod1.bas
IconForm="form1"
Startup="form1"
Command32=""
Name="systray1"
HelpContextID="0"
CompatibleMode="0"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
VersionCompanyName="Defence Secondary"
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1[MS Transaction Server]
AutoRefresh=1
mod1.basAttribute VB_Name = "mod1"
Option ExplicitPublic Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long
Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, _
   ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public nfIconData As NOTIFYICONDATA
Private FHandle As Long
Private WndProc As Long
Private Hooking As Boolean
Public Const WM_LBUTTONDOWN = &H201
Public Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long) As Long
Public Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Public Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Public Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function ReleaseCapture Lib "user32" () As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Public Const RGN_OR = 2
Public Const WM_NCLBUTTONDOWN = &HA1
Public Const HTCAPTION = 2
Public Const WM_RBUTTONDOWN = &H204
Public Const WM_RBUTTONUP = &H205
Public Const WM_ACTIVATEAPP = &H1C
Public Const NIF_ICON = &H2
Public Const NIF_MESSAGE = &H1
Public Const NIF_TIP = &H4
Public Const NIM_ADD = &H0
Public Const NIM_DELETE = &H2
Public Const MAX_TOOLTIP As Integer = 64
Public Const GWL_WNDPROC = (-4)
Public Const WM_LBUTTONDBLCLK = &H203Type NOTIFYICONDATA
   cbSize As Long
   hWnd As Long
   uID As Long
   uFlags As Long
   uCallbackMessage As Long
   hIcon As Long
   szTip As String * MAX_TOOLTIP
End Type' Add your application to the system tray.
' Param 1 = Handle of form (which deals with sys tray events)
' Param 2 = Icon (form icon - any icon)
' Param 3 = Handle of icon (form icon - any icon)
' Param 4 = Tip for sys tray icon.
'
' Example - AddIconToTray Me.Hwnd, Me.Icon, Me.Icon.Handle, "This is a test tip"
'
Public Sub AddIconToTray(MeHwnd As Long, MeIcon As Long, MeIconHandle As Long, Tip As String)
With nfIconData
   .hWnd = MeHwnd
   .uID = MeIcon
   .uFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP
   .uCallbackMessage = WM_RBUTTONUP
   .hIcon = MeIconHandle
   .szTip = Tip & Chr$(0)
   .cbSize = Len(nfIconData)
End With
Shell_NotifyIcon NIM_ADD, nfIconData
End Sub' Remove your application from the system tray.
' Call when you quit your application.
'
Public Sub RemoveIconFromTray()
Shell_NotifyIcon NIM_DELETE, nfIconData
End Sub' Call this routine to ensure my app gets notified of all events
' Example - Hook Me.hWnd
'
Public Sub Hook(Lwnd As Long)
    If Hooking = False Then
        FHandle = Lwnd
        WndProc = SetWindowLong(Lwnd, GWL_WNDPROC, AddressOf WindowProc)
        Hooking = True
    End If
End SubPublic Sub Unhook()
    If Hooking = True Then
        SetWindowLong FHandle, GWL_WNDPROC, WndProc
        Hooking = False
    End If
End SubPublic Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    If Hooking = True Then
        If lParam = WM_RBUTTONUP Then
            form1.SysTrayMouseEventHandler
            WindowProc = True
            Exit Function
        End If
        If lParam = WM_LBUTTONDBLCLK Then
            SetForegroundWindow hw
            form1.Show
            RemoveIconFromTray
            Exit Function
        End If
        WindowProc = CallWindowProc(WndProc, hw, uMsg, wParam, lParam) ' Pass it along
    End If
End Function
Public Function MakeRegion(picSkin As PictureBox) As Long

   Dim X As Long, Y As Long, StartLineX As Long
   Dim FullRegion As Long, LineRegion As Long
   Dim TransparentColor As Long
   Dim InFirstRegion As Boolean
   Dim InLine As Boolean
   Dim hDC As Long
   Dim PicWidth As Long
   Dim PicHeight As Long

   hDC = picSkin.hDC
   PicWidth = picSkin.ScaleWidth
   PicHeight = picSkin.ScaleHeight

   InFirstRegion = True: InLine = False
   X = Y = StartLineX = 0

   TransparentColor = GetPixel(hDC, 0, 0)

   For Y = 0 To PicHeight - 1
       For X = 0 To PicWidth - 1

           If GetPixel(hDC, X, Y) = TransparentColor Or X = PicWidth Then
               If InLine Then
                   InLine = False
                   LineRegion = CreateRectRgn(StartLineX, Y, X, Y + 1)

                   If InFirstRegion Then
                       FullRegion = LineRegion
                       InFirstRegion = False
                   Else
                       CombineRgn FullRegion, FullRegion, LineRegion, RGN_OR
                       DeleteObject LineRegion
                   End If
               End If
           Else
               If Not InLine Then
                   InLine = True
                   StartLineX = X
               End If
           End If
       Next
   Next

   MakeRegion = FullRegion
End Function
frm1.frmVERSION 5.00
Begin VB.Form form1
   Appearance      =   0  'Flat
   BackColor       =   &H80000005&
   BorderStyle     =   0  'None
   ClientHeight    =   825
   ClientLeft      =   120
   ClientTop       =   120
   ClientWidth     =   2385
   ControlBox      =   0   'False
   BeginProperty Font
      Name            =   "宋体"
      Size            =   9
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   825
   ScaleWidth      =   2385
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  'Windows Default
   Begin VB.PictureBox Picture1
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      BorderStyle     =   0  'None
      ForeColor       =   &H80000008&
      Height          =   255
      Left            =   0
      ScaleHeight     =   255
      ScaleWidth      =   870
      TabIndex        =   2
      Top             =   0
      Width           =   870
   End
   Begin VB.CommandButton Command2
      Caption         =   "X"
      Height          =   195
      Left            =   2100
      TabIndex        =   1
      Top             =   30
      Width           =   240
   End
   Begin VB.CommandButton Command1
      Caption         =   "-"
      Height          =   195
      Left            =   1860
      TabIndex        =   0
      Top             =   30
      Width           =   240
   End
   Begin VB.Menu RCPopup
      Caption         =   "RCPopup"
      Visible         =   0   'False
      Begin VB.Menu Rest1
         Caption         =   "Restart"
      End
      Begin VB.Menu msg1
         Caption         =   "Msgbox"
      End
   End
End
Attribute VB_Name = "form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option ExplicitPrivate Sub Command1_Click()
    Hook Me.hWnd
    AddIconToTray Me.hWnd, Me.Icon, Me.Icon.Handle, "This is a test tip"
    Me.Hide
End SubPublic Sub SysTrayMouseEventHandler()
    SetForegroundWindow Me.hWnd
    PopupMenu RCPopup, vbPopupMenuRightButton
End SubPrivate Sub Command2_Click()
    Unhook
    Unload Me
End SubPrivate Sub Form_Load()
    Dim WindowRegion As Long

    Picture1.Left = -15
    Picture1.Top = -15
    Picture1.Appearance = 0
    Picture1.BorderStyle = 0
    Picture1.ScaleMode = vbPixels
    Picture1.AutoRedraw = True
    Picture1.AutoSize = True

    Set Picture1.Picture = LoadPicture(App.Path & "\main.bmp")

    Me.Width = Picture1.Width
    Me.Height = Picture1.Height

    WindowRegion = MakeRegion(Picture1)
    SetWindowRgn Me.hWnd, WindowRegion, True
    Command1.ZOrder 0
    Command2.ZOrder 0
End SubPrivate Sub msg1_Click()
    MsgBox "This is a test message", vbOKOnly, "Hello"
End SubPrivate Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
     ReleaseCapture
     SendMessage Me.hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&
End SubPrivate Sub Rest1_Click()
    Unhook
    Me.Show
    RemoveIconFromTray
End Sub

调试易

大哥们，救救我啊！！！！！！！！！！！

解决方案 »