frmmain.frm

vb写的一个见面应用

VERSION 5.00
Begin VB.Form frmMain 
   BorderStyle     =   0  'None
   ClientHeight    =   1440
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   1830
   ControlBox      =   0   'False
   Icon            =   "frmMain.frx":0000
   LinkTopic       =   "Form1"
   Picture         =   "frmMain.frx":0CCA
   ScaleHeight     =   1440
   ScaleWidth      =   1830
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  'CenterScreen
   Begin VB.PictureBox picBox 
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      BorderStyle     =   0  'None
      Height          =   570
      Left            =   0
      Picture         =   "frmMain.frx":1E44
      ScaleHeight     =   570
      ScaleWidth      =   570
      TabIndex        =   0
      Top             =   720
      Width           =   570
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim leftx, topy, lngRegion
Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) 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 Const HWND_TOPMOST = -1
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
Private Const FLAGS = SWP_NOMOVE Or SWP_NOSIZE
Private Const RGN_OR = 2
Private Function RegionFromBitmap(picSource As PictureBox, Optional lngTransColor As Long) As Long
If lngTransColor < 1 Then
lngTransColor = GetPixel(picSource.hdc, 0, 0)
End If
lngRgnFinal = CreateRectRgn(0, 0, 0, 0)
For lngRow = 0 To picSource.Height / Screen.TwipsPerPixelY - 1
lngCol = 0
Do While lngCol < picSource.Width / Screen.TwipsPerPixelX
Do While lngCol < picSource.Width / Screen.TwipsPerPixelX And GetPixel(picSource.hdc, lngCol, lngRow) = lngTransColor
lngCol = lngCol + 1
Loop
If lngCol < picSource.Width / Screen.TwipsPerPixelX Then
lngStart = lngCol
Do While lngCol < picSource.Width / Screen.TwipsPerPixelX And GetPixel(picSource.hdc, lngCol, lngRow) <> lngTransColor
lngCol = lngCol + 1
Loop
If lngCol > picSource.Width / Screen.TwipsPerPixelX Then lngCol = picSource.Width / Screen.TwipsPerPixelX
lngRgnTmp = CreateRectRgn(lngStart, lngRow, lngCol, lngRow + 1)
lngRetr = CombineRgn(lngRgnFinal, lngRgnFinal, lngRgnTmp, RGN_OR)
DeleteObject (lngRgnTmp)
End If
Loop
Next
RegionFromBitmap = lngRgnFinal
End Function

Private Sub Form_DblClick()
End
End Sub

Private Sub Form_Load()
SetWindowRgn Me.hwnd, RegionFromBitmap(picBox), True
SetWindowPos Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
leftx = X
topy = Y
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button And 1 Then
Me.Left = Me.Left + X - leftx
Me.Top = Me.Top + Y - topy
End If
End Sub