ctrl_transparetform.ctl

简单的餐厅POS收银软件

VERSION 5.00
Begin VB.UserControl ctrl_TransparetForm 
   BackStyle       =   0  '透明
   ClientHeight    =   510
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   510
   ScaleHeight     =   510
   ScaleWidth      =   510
   ToolboxBitmap   =   "ctrl_TransparetForm.ctx":0000
End
Attribute VB_Name = "ctrl_TransparetForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'****************************************************************************
'人人为我，我为人人
'枕善居汉化收藏整理
'发布日期：05/06/12
'描  述：超强换肤控件
'网  站：http://www.mndsoft.com/
'收  集：http://www.codefans.net/
'e-mail：[e-mail]
'OICQ  : 88382850
'****************************************************************************
Option Explicit

Private Type POINTAPI
    X As Long
    Y As Long
End Type
    
Private Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As POINTAPI, ByVal nCount As Long, ByVal nPolyFillMode 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 CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function Polygon Lib "gdi32" (ByVal hdc As Long, lpPoint As POINTAPI, ByVal nCount As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long

Const WINDING = 2
Const PS_SOLID = 0

Public Sub ShapeForm(m_Form As Form, m_SkinPath As String, m_Active As Boolean)
    Dim v_iLoop As Integer
    Dim v_iPtsCount As Integer
    Dim v_lStatus As Long
    Dim a_tPts() As POINTAPI
    Dim v_lRgn As Long
    Dim v_lOld_rgn As Long
    Dim v_lPen As Long
    Dim v_lOld_pen As Long
    Dim v_lRtn As Long
    Dim v_sString As String
    Dim v_sTemp, v_sStr As String
    
    If m_Active = True Then
    
    v_sString = Space(255)
    v_lRtn = GetPrivateProfileString("TRANAPARENY", "PtsCount", "", v_sString, Len(v_sString), m_SkinPath & "\Transparency.ini")
    v_iPtsCount = Val(TrimString(v_sString))
    
    ReDim Preserve a_tPts(v_iPtsCount)
    For v_iLoop = 1 To v_iPtsCount
        v_sString = Space(255)
        v_lRtn = GetPrivateProfileString("TRANAPARENY", "X(" & v_iLoop & ")", "", v_sString, Len(v_sString), m_SkinPath & "\Transparency.ini")
        v_sStr = TrimString(v_sString)
        If Left(v_sStr, 2) = "FW" Then
            If Len(v_sStr) = 2 Then
                a_tPts(v_iLoop).X = m_Form.Width / Screen.TwipsPerPixelX
            ElseIf Mid(v_sStr, 3, 1) = "-" Then
                v_sTemp = Right(v_sStr, Len(v_sStr) - 3)
                a_tPts(v_iLoop).X = m_Form.Width / Screen.TwipsPerPixelX - Val(v_sTemp)
            Else
                v_sTemp = Right(v_sStr, Len(v_sStr) - 3)
                a_tPts(v_iLoop).X = m_Form.Width / Screen.TwipsPerPixelX + Val(v_sTemp)
            End If
        Else
            a_tPts(v_iLoop).X = Val(v_sStr)
        End If
        
        v_sString = Space(255)
        v_lRtn = GetPrivateProfileString("TRANAPARENY", "Y(" & v_iLoop & ")", "", v_sString, Len(v_sString), m_SkinPath & "\Transparency.ini")
        v_sStr = TrimString(v_sString)
        If Left(v_sStr, 2) = "FH" Then
            If Len(v_sStr) = 2 Then
                a_tPts(v_iLoop).Y = m_Form.Height / Screen.TwipsPerPixelY
            ElseIf Mid(v_sStr, 3, 1) = "-" Then
                v_sTemp = Right(v_sStr, Len(v_sStr) - 3)
                a_tPts(v_iLoop).Y = m_Form.Height / Screen.TwipsPerPixelY - Val(v_sTemp)
            Else
                v_sTemp = Right(v_sStr, Len(v_sStr) - 3)
                a_tPts(v_iLoop).Y = m_Form.Height / Screen.TwipsPerPixelY - Val(v_sTemp)
            End If
        Else
            a_tPts(v_iLoop).Y = Val(v_sStr)
        End If
    Next v_iLoop

    If v_iPtsCount > 0 Then

    ' Set the form region.
    v_lRgn = CreatePolygonRgn(a_tPts(1), v_iPtsCount, WINDING)
    v_lOld_rgn = SetWindowRgn(m_Form.hWnd, v_lRgn, True)

    ' Create a pen to draw the region edge.
    v_lPen = CreatePen(PS_SOLID, 2, vbBlack)
    v_lOld_pen = SelectObject(m_Form.hdc, v_lPen)
    
    v_lStatus = Polygon(m_Form.hdc, a_tPts(1), v_iPtsCount)
    
    v_lPen = SelectObject(m_Form.hdc, v_lOld_pen)
    v_lStatus = DeleteObject(v_lPen)
    
    End If
    
    Else
    
    ReDim Preserve a_tPts(4)
    a_tPts(1).X = 0
    a_tPts(1).Y = 0
    a_tPts(2).X = m_Form.Width / Screen.TwipsPerPixelX
    a_tPts(2).Y = 0
    a_tPts(3).X = m_Form.Width / Screen.TwipsPerPixelX
    a_tPts(3).Y = m_Form.Height / Screen.TwipsPerPixelY
    a_tPts(4).X = 0
    a_tPts(4).Y = m_Form.Height / Screen.TwipsPerPixelY
    
    ' Set the form region.
    v_lRgn = CreatePolygonRgn(a_tPts(1), v_iPtsCount, WINDING)
    v_lOld_rgn = SetWindowRgn(m_Form.hWnd, v_lRgn, True)

    ' Create a pen to draw the region edge.
    v_lPen = CreatePen(PS_SOLID, 2, vbBlack)
    v_lOld_pen = SelectObject(m_Form.hdc, v_lPen)
    
    v_lStatus = Polygon(m_Form.hdc, a_tPts(1), v_iPtsCount)
    
    v_lPen = SelectObject(m_Form.hdc, v_lOld_pen)
    v_lStatus = DeleteObject(v_lPen)
    
    End If
End Sub

Public Function TrimString(m_Str As String) As String
    m_Str = RTrim$(m_Str)
    m_Str = Left(m_Str, Len(m_Str) - 1)
    TrimString = m_Str
End Function