⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 skinmodule.bas

📁 单戗堤截流图解法计算程序使用帮助 操作步骤: 一:输入分流能力数据文本文件 文件格式为上游水位
💻 BAS
字号:
Attribute VB_Name = "SkinModule"
Option Explicit

' xx 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
' xx 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
' xx 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
' xx Also used to make the form draggable
Public Declare Function ReleaseCapture Lib "user32" () As Long
' xx 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
' xx Used to get the cursor position
Public Declare Function GetCursorPos Lib "user32" (lpPoint As PointAPI) As Long
' xx Various bits and pieces 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 Type PointAPI
    X As Long
    Y As Long
End Type

Dim m_intResizable As Integer

Public Sub AlwaysOnTop(p_TheForm As Form, p_blnToggle As Boolean)
    
    If p_blnToggle = True Then
        SetWindowPos p_TheForm.hwnd, HWND_TOPMOST, 0, 0, 0, 0, TOPMOST_FLAGS
    Else
        SetWindowPos p_TheForm.hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, TOPMOST_FLAGS
    End If
    
    
End Sub

Public Sub ChangeState(p_TheForm As Form)
    
    
    If p_TheForm.WindowState = vbNormal Then
        p_TheForm.WindowState = vbMaximized
        p_TheForm!imgTitleMaxRestore.Picture = p_TheForm!imgTitleRestore.Picture
        MakeWindow p_TheForm, False
    Else
        p_TheForm.WindowState = vbNormal
        p_TheForm!imgTitleMaxRestore.Picture = p_TheForm!imgTitleMaximize.Picture
        MakeWindow p_TheForm, IIf(m_intResizable = 1, True, False)
    End If
    
    
End Sub

Public Sub DoDrag(p_TheForm As Form)
    
    
    
    If p_TheForm.WindowState <> vbMaximized Then
        ReleaseCapture
        SendMessage p_TheForm.hwnd, &HA1, 2, 0&
    End If
    
    
End Sub

Public Sub DoTransparency(p_TheForm As Form)

    
    Dim alngTempRegions(6) As Long
    Dim lngFormWidthInPixels As Long
    Dim lngFormHeightInPixels As Long
    Dim varA
    
    '  Convert the form's height and width from twips to pixels
    lngFormWidthInPixels = p_TheForm.Width / Screen.TwipsPerPixelX
    lngFormHeightInPixels = p_TheForm.Height / Screen.TwipsPerPixelY
    
    '  Make a rounded rectangle shaped region with the dimensions of the form
    varA = CreateRoundRectRgn(0, 0, lngFormWidthInPixels, lngFormHeightInPixels, 24, 24)
    
    '  Set this region as the shape for "TheForm"
    varA = SetWindowRgn(p_TheForm.hwnd, varA, True)

    
End Sub

Public Sub LoadSkinz(p_FrmSkin As Form)

    On Error Resume Next
    
    
    Dim strSkin         As String
    Dim ctl             As Control
    
    strSkin = GetSetting(App.Title, "Options", "Current Skin", "Blue")
    
    
    For Each ctl In p_FrmSkin.Controls
        
        If TypeOf ctl Is Image Then
            
            If InStr(1, ctl.Name, "img", vbTextCompare) > 0 Then
                'Debug.Print ctl.Name
                ctl.Picture = LoadPicture(App.Path & "\Skinz\" & strSkin & "\" & ctl.Name & ".gif")
                ctl.Refresh

            End If
            
        End If
        
    Next
    
    
    p_FrmSkin.imgTitleMaxRestore.Picture = p_FrmSkin.imgTitleMaximize.Picture
    DoEvents
    
End Sub

Public Sub MakeWindow(p_TheForm As Form, p_blnIsResizable As Boolean)
  
    
    
    Dim lngFormWidth As Long
    Dim lngFormHeight As Long
    Dim intTemp As Integer
    
    '  Set the Resizable variable
    m_intResizable = IIf(p_blnIsResizable = True, 1, 0)
    
    '  Store the form's width and height in pixels in a variable
    lngFormWidth = (p_TheForm.Width / Screen.TwipsPerPixelX)
    lngFormHeight = (p_TheForm.Height / Screen.TwipsPerPixelY)
    
    '  Set various parameters of the form
    p_TheForm.BackColor = RGB(192, 192, 192)
    p_TheForm.Caption = p_TheForm!lblTitle.Caption
    
    '  Set the position of the title label
    p_TheForm!lblTitle.Left = 16
    p_TheForm!lblTitle.Top = 7
    
    '  Make the form "rounded rectangle" shaped (call to the sub below)
    DoTransparency p_TheForm
    
    '' xx Move the image blocks into place and stretch them accordingly
    With p_TheForm!imgTitleLeft
        .Top = 0
        .Left = 0
    End With
    
    With p_TheForm!imgTitleRight
        .Top = 0
        .Left = lngFormWidth - 19
    End With
    
    With p_TheForm!imgTitleMain
        .Top = 0
        .Left = 19
        .Width = lngFormWidth - 19
    End With
    
    With p_TheForm!imgWindowLeft
        .Top = 30
        .Left = 0
        .Height = lngFormHeight - 60
    End With
    
    With p_TheForm!imgWindowBottomLeft
        .Top = lngFormHeight - 30
        .Left = 0
    End With
    
    With p_TheForm!imgWindowBottom
        .Top = lngFormHeight - 30
        .Left = 19
        .Width = lngFormWidth - 38
    End With
    
    With p_TheForm!imgWindowBottomRight
        .Top = lngFormHeight - 30
        .Left = lngFormWidth - 19
    End With
    
    With p_TheForm!imgWindowRight
        .Top = 30
        .Left = lngFormWidth - 19
        .Height = lngFormHeight - 38
    End With
    
    '  Position the title buttons (close, minimize, help)
    With p_TheForm!imgTitleClose
        .Top = 8
        .Left = lngFormWidth - 22
    End With
    
    With p_TheForm!imgTitleMaxRestore
        .Top = 8
        .Left = lngFormWidth - 39
    End With
    
    With p_TheForm!imgTitleMinimize
        .Top = 8
        .Left = lngFormWidth - 56
    End With
    
    With p_TheForm!imgTitleHelp
        .Top = 8
        .Left = lngFormWidth - 73
    End With
    

    
End Sub

Public Sub ResizeForm(p_TheForm As Form, p_OldCursorPos As PointAPI, p_NewCursorPos As PointAPI, p_intResizeMode As Integer)
    On Error Resume Next
    Dim varDifferenceX
    Dim varDifferenceY
    
    '  Put the difference between the first cursor pos and the second into variables
    varDifferenceX = (p_NewCursorPos.X - p_OldCursorPos.X) * Screen.TwipsPerPixelX
    varDifferenceY = (p_NewCursorPos.Y - p_OldCursorPos.Y) * Screen.TwipsPerPixelY
    
    '  Determine which resizing mode (above) has been called and resize accordingly
    Select Case p_intResizeMode
        Case 0
            p_TheForm.Move p_TheForm.Left + varDifferenceX, p_TheForm.Top, p_TheForm.Width - varDifferenceX, p_TheForm.Height
        Case 1
            p_TheForm.Move p_TheForm.Left, p_TheForm.Top, p_TheForm.Width + varDifferenceX, p_TheForm.Height
        Case 2
            p_TheForm.Move p_TheForm.Left, p_TheForm.Top + varDifferenceY, p_TheForm.Width, p_TheForm.Height - varDifferenceY
        Case 3
            p_TheForm.Move p_TheForm.Left, p_TheForm.Top, p_TheForm.Width, p_TheForm.Height + varDifferenceY
        Case 4
            p_TheForm.Move p_TheForm.Left, p_TheForm.Top, p_TheForm.Width + varDifferenceX, p_TheForm.Height + varDifferenceY
        Case 5
            p_TheForm.Move p_TheForm.Left + varDifferenceX, p_TheForm.Top, p_TheForm.Width - varDifferenceX, p_TheForm.Height + varDifferenceY
        Case 6
            p_TheForm.Move p_TheForm.Left, p_TheForm.Top + varDifferenceY, p_TheForm.Width + varDifferenceX, p_TheForm.Height - varDifferenceY
        Case 7
            p_TheForm.Move p_TheForm.Left + varDifferenceX, p_TheForm.Top + varDifferenceY, p_TheForm.Width - varDifferenceX, p_TheForm.Height - varDifferenceY
    End Select
    
    MakeWindow p_TheForm, True
End Sub

Public Sub SetStateBtn(p_TheForm As Form, p_lngNewState As Long)
    
    
    
    If p_lngNewState <> vbNormal Then
        p_TheForm!imgTitleMaxRestore.Picture = p_TheForm!imgTitleRestore.Picture
    Else
        p_TheForm!imgTitleMaxRestore.Picture = p_TheForm!imgTitleMaximize.Picture
    End If
    
    
    
End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -