mdlflashfrm.bas

此为水费收费管理系统

Attribute VB_Name = "MdlFlashFrm"
Option Explicit

Public Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, _
    ByVal bRedraw As Boolean) As Long
Public Declare Function CreateRoundRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, _
    ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 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 Const SWP_NOACTIVATE = &H10
Public Const SWP_SHOWWINDOW = &H40
Public Const TOPMOST_FLAGS = SWP_NOMOVE Or SWP_NOSIZE

Public Sub AlwaysOnTop(TheForm As Form, Toggle As Boolean)
    If Toggle = True Then
        SetWindowPos TheForm.hWnd, HWND_TOPMOST, 0, 0, 0, 0, TOPMOST_FLAGS
    Else
        SetWindowPos TheForm.hWnd, HWND_NOTOPMOST, 0, 0, 0, 0, TOPMOST_FLAGS
    End If
End Sub

Public Sub DoDrag(TheForm As Form)
    ReleaseCapture
    SendMessage TheForm.hWnd, &HA1, 2, 0&
End Sub

Public Sub MakeWindow(TheForm As Form)
    TheForm.BackColor = RGB(207, 207, 207)
    TheForm.Caption = TheForm!lblTitle.Caption
    TheForm!lblTitle.Left = 16
    TheForm!lblTitle.Top = 7
    
    With TheForm!imgTitleLeft
        .Top = 0
        .Left = 0
    End With
    
    With TheForm!imgTitleRight
        .Top = 0
        .Left = (TheForm.Width / Screen.TwipsPerPixelX) - 19
    End With
    
    With TheForm!imgTitleMain
        .Top = 0
        .Left = 19
        .Width = (TheForm.Width / Screen.TwipsPerPixelX) - 19
    End With
    
    With TheForm!imgWindowLeft
        .Top = 30
        .Left = 0
        .Height = (TheForm.Height / Screen.TwipsPerPixelY) - 60
    End With
    
    With TheForm!imgWindowBottomLeft
        .Top = (TheForm.Height / Screen.TwipsPerPixelY) - 30
        .Left = 0
    End With
    
    With TheForm!imgWindowBottom
        .Top = (TheForm.Height / Screen.TwipsPerPixelY) - 30
        .Left = 19
        .Width = (TheForm.Width / Screen.TwipsPerPixelX) - 38
    End With
    
    With TheForm!imgWindowBottomRight
        .Top = (TheForm.Height / Screen.TwipsPerPixelY) - 30
        .Left = (TheForm.Width / Screen.TwipsPerPixelX) - 19
    End With
    
    With TheForm!imgWindowRight
        .Top = 30
        .Left = (TheForm.Width / Screen.TwipsPerPixelX) - 19
        .Height = (TheForm.Width / Screen.TwipsPerPixelX) - 38
    End With
    
    With TheForm!imgTitleClose
        .Top = 8
        .Left = (TheForm.Width / Screen.TwipsPerPixelX) - 22
    End With
    
    With TheForm!imgTitleMinimize
        .Top = 8
        .Left = (TheForm.Width / Screen.TwipsPerPixelX) - 39
    End With
    
    With TheForm!imgTitleHelp
        .Top = 8
        .Left = (TheForm.Width / Screen.TwipsPerPixelX) - 56
    End With
    
    DoTransparency TheForm
End Sub

Public Sub DoTransparency(TheForm As Form)
' TheForm:  The form you want to be rounded rectangle shape
    
    Dim TempRegions(6) As Long
    Dim FormWidthInPixels As Long
    Dim FormHeightInPixels As Long
    Dim a
    
' Convert the form's height and width from twips to pixels
    FormWidthInPixels = TheForm.Width / Screen.TwipsPerPixelX
    FormHeightInPixels = TheForm.Height / Screen.TwipsPerPixelY
    
' Make a rounded rectangle shaped region with the dimentions of the form
    a = CreateRoundRectRgn(0, 0, FormWidthInPixels, FormHeightInPixels, 24, 24)
    
' Set this region as the shape for "TheForm"
    a = SetWindowRgn(TheForm.hWnd, a, True)
End Sub