capfrm.frm

GDI 图形处理

VERSION 5.00
Begin VB.Form Capfrm 
   Caption         =   "CapFrm"
   ClientHeight    =   3180
   ClientLeft      =   60
   ClientTop       =   270
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   ScaleHeight     =   3180
   ScaleWidth      =   4680
End
Attribute VB_Name = "Capfrm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Const HWND_TOPMOST = -1
Const HWND_NOTOPMOST = -2
Const SWP_NOSIZE = &H1
Const SWP_NOMOVE = &H2
Const SWP_NOACTIVATE = &H10
Const SWP_SHOWWINDOW = &H40
Const SWP_DRAWFRAME = &H20
Const SWP_FRAMECHANGED = &H20        '  The frame changed: send WM_NCCALCSIZE
Const MF_BYPOSITION = &H400&
Const MF_REMOVE = &H1000&


Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As _
        Long, lpRECT As RECT) As Long

Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As _
        Long, lpRECT As RECT) As Long

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 ScreenToClient Lib "user32" (ByVal hwnd As _
        Long, lpPoint As POINTAPI) 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 Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, _
        ByVal bRevert As Long) As Long
Private Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function RemoveMenu Lib "user32" (ByVal hMenu As Long, _
        ByVal nPosition As Long, ByVal wFlags As Long) As Long


Const RGN_AND = 1
Const RGN_COPY = 5
Const RGN_DIFF = 4
Const RGN_OR = 2
Const RGN_XOR = 3

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
'Sub DataSamp()
'    Dim ad As Database
'    Dim aserch As QueryDef
'End Sub

Private Sub MakeTransparent(frm As Form)
    Dim rctClient As RECT, rctFrame As RECT
    Dim hClient As Long, hFrame As Long
    
    '获得窗口矩形区域
    GetWindowRect frm.hwnd, rctFrame
    GetClientRect frm.hwnd, rctClient
    
    '将窗口矩形坐标转换为屏幕坐标
    Dim lpTL As POINTAPI, lpBR As POINTAPI
    lpTL.X = rctFrame.Left
    lpTL.Y = rctFrame.Top
    lpBR.X = rctFrame.Right
    lpBR.Y = rctFrame.Bottom
    ScreenToClient frm.hwnd, lpTL
    ScreenToClient frm.hwnd, lpBR
    
    rctFrame.Left = lpTL.X
    rctFrame.Top = lpTL.Y
    rctFrame.Right = lpBR.X
    rctFrame.Bottom = lpBR.Y
    rctClient.Left = Abs(rctFrame.Left)
    rctClient.Top = Abs(rctFrame.Top)
    rctClient.Right = rctClient.Right + Abs(rctFrame.Left)
    rctClient.Bottom = rctClient.Bottom + Abs(rctFrame.Top)
    rctFrame.Right = rctFrame.Right + Abs(rctFrame.Left)
    rctFrame.Bottom = rctFrame.Bottom + Abs(rctFrame.Top)
    rctFrame.Top = 0
    rctFrame.Left = 0
    
    
    hClient = CreateRectRgn(rctClient.Left, rctClient.Top, rctClient.Right, rctClient.Bottom)
    hFrame = CreateRectRgn(rctFrame.Left, rctFrame.Top, rctFrame.Right, rctFrame.Bottom)
    
    CombineRgn hFrame, hClient, hFrame, RGN_XOR
    
    SetWindowRgn frm.hwnd, hFrame, True
    m_WinfraH = Abs(lpTL.Y)
    m_WinfraW = Abs(lpTL.X)
    BmpWidth = Abs(rctClient.Right - m_WinfraW)
    BmpHeight = Abs(rctClient.Bottom - m_WinfraH)
    m_CapfrmW = Abs(rctFrame.Right)
    m_CapfrmH = Abs(rctFrame.Bottom)
    If BmpWidth < m_WinfraW Then
        MsgBox "error"
    End If
    Gray.Text3.Text = BmpWidth & "×" & BmpHeight & m_WinfraW & m_WinfraH
End Sub

Private Sub Form_Activate()
SetWindowPos m_Picfrmhwnd, HWND_TOPMOST, m_DisplayW, 0, m_PicfrmW, m_PicfrmH, SWP_NOACTIVATE Or SWP_SHOWWINDOW 'Or SWP_DRAWFRAME 'Or SWP_NOSIZE Or SWP_NOMOVE
End Sub

'Private Sub Form_Click()
'    MakeTransparent Me
'End Sub

Private Sub Form_Load()

Dim hSysMenu As Long, nCnt As Long
    hSysMenu = GetSystemMenu(Me.hwnd, False)

    If hSysMenu Then
        nCnt = GetMenuItemCount(hSysMenu)
        If nCnt Then
            ' Menu count is based on 0 (0, 1, 2, 3...)
            RemoveMenu hSysMenu, nCnt - 1, MF_BYPOSITION Or MF_REMOVE
            RemoveMenu hSysMenu, nCnt - 2, MF_BYPOSITION Or MF_REMOVE ' Remove the seperator
            DrawMenuBar Me.hwnd
        End If
    End If
m_CapfrmShow = True
SetWindowPos Me.hwnd, HWND_TOPMOST, 0, 0, 100, 124, SWP_NOACTIVATE Or SWP_SHOWWINDOW Or SWP_DRAWFRAME Or SWP_NOSIZE 'Or SWP_NOMOVE
MakeTransparent Me

End Sub

Private Sub Form_LostFocus()
Dim Enc As Long
m_PicfrmW = m_CapfrmW
m_PicfrmH = m_CapfrmH
Enc = SetWindowPos(m_Picfrmhwnd, HWND_TOPMOST, 10, 300, m_PicfrmW, m_PicfrmH, SWP_NOACTIVATE Or SWP_SHOWWINDOW Or SWP_DRAWFRAME Or SWP_NOMOVE) 'Or SWP_NOSIZE
If Enc = 0 Then MsgBox "SetWindowPos Picfrm Error"
End Sub

Private Sub Form_Resize()
MakeTransparent Me
Dim Enc As Long
m_PicfrmW = m_CapfrmW
m_PicfrmH = m_CapfrmH
Enc = SetWindowPos(m_Picfrmhwnd, HWND_TOPMOST, 10, 300, m_PicfrmW, m_PicfrmH, SWP_NOACTIVATE Or SWP_SHOWWINDOW Or SWP_DRAWFRAME Or SWP_NOMOVE) 'Or SWP_NOSIZE
If Enc = 0 Then MsgBox "SetWindowPos Picfrm Error"
End Sub


Private Sub Form_Unload(Cancel As Integer)
m_CapfrmShow = False
End Sub