module1.bas

来自「第1章 串口编程调试精灵 第2章 智能安防报警系统 第3章 电子警察拍照管理」· BAS 代码 · 共 142 行

Attribute VB_Name = "Module1"
' *********************************************
' * Code by Robert Wright - <[e-mail]> *
' *********************************************

' *********************************************
' *        -> This code is FREEWARE <-        *
' * You are free to use this any of this VB   *
' * Project (including the images) in your    *
' * own programs.                             *
' *                                           *
' * All I ask is that you vote for me on PSC! *
' *********************************************

' Used to set the shape of the form
Public Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
' Used to create the rounded rectangle region
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
' Used to make the form draggable
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
' Also used to make the form draggable
Public Declare Function ReleaseCapture Lib "user32" () As Long
' Used to make the window always on top
Public Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, Y, ByVal Cx As Long, ByVal Cy As Long, ByVal wFlags As Long) As Long
' Various constants used by the above functions
Public Const HWND_TOPMOST = -1
Public Const HWND_NOTOPMOST = -2
Public Const SWP_NOMOVE = &H2
Public Const SWP_NOSIZE = &H1
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)
' TheForm:  The form you want to make always on top or not
' Toggle:   Boolean (True/False) - True for always on top, False for normal
    
    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)
' TheForm:  The form you want to start dragging
    
    ReleaseCapture
    SendMessage TheForm.hwnd, &HA1, 2, 0&
End Sub

Public Sub MakeWindow(TheForm As Form)
' TheForm:  The form you want to make graphical
    
   ' TheForm.BackColor = RGB(150, 150, 150)
    '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