dlgoption.bas

一个clock的 vb 源码

Attribute VB_Name = "DlgOption"
Option Explicit

'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
' 这里是选项对话框
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
Public Declare Function GetDesktopWindow Lib "user32" () As Long

' Dlg Window Style
Public Const DS_MODALFRAME = &H80
Public Const WS_CAPTION = &HC00000

' Combobox Notification Messages
Public Const CBN_SELCHANGE = 1
Private Const CB_ADDSTRING = &H143

' Edit Notification message
Public Const EN_CHANGE = &H300

' TrackBar Notification Messgae
Private Const WM_HSCROLL = &H114
Private Const TB_ENDTRACK = 8

Public Type DLGTEMPLATE
        Style As Long
        dwExtendedStyle As Long
        cdit As Integer
        X As Integer
        Y As Integer
        CX As Integer
        CY As Integer
End Type

' My Declare  Form of Control
Private hFont As Long ' GDI For Delete :)
Private Label As clsLabel
Private Edit As New clsEdit
Private Button As clsButton
Private TrackBar As New clsTrackbar
Private CommonDialog As clsCommonDialog
Private ComboBox As New clsComboBox
Private DrawTime As clsDrawTime
Private DlgOption As New clsDialog
Public Function CreateDlgOption(hWndParent As Long)  'hWndParent As Long
   Call DlgOption.CreateDialog(hWndParent, AddressOf DlgProc)
   Set DlgOption = Nothing
   hFont = 0
End Function

Private Function DlgProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Select Case uMsg
        Case WM_INITDIALOG
            Dim lpRect As RECT, hDesktop As Long
            hDesktop = GetDesktopWindow
            Call GetWindowRect(hDesktop, lpRect)
            Call MoveWindow(hwnd, (lpRect.Right - 450) / 2, (lpRect.Bottom - 330) / 2, 450, 330, 1)
            Call SendMessage(hwnd, WM_SETTEXT, 0, ByVal "选项")
            
            hFont = CreateFont(12, 0, 0, 0, 400, 0, 0, 0, DEFAULT_CHARSET, _
            OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY, _
            DEFAULT_PITCH Or FF_DONTCARE, "宋体")
        
            Set Button = New clsButton
            Button.CreateButton hwnd, "确定(&O)", 1, 195, 276, 72, 21, hFont, BS_DEFPUSHBUTTON Or WS_GROUP
            Button.CreateButton hwnd, "取消(&C)", 2, 275, 276, 72, 21, hFont
            Button.CreateButton hwnd, "应用(&A)", 3, 355, 276, 72, 21, hFont

            TrackBar.CreateTrackBar hwnd, 4, 310, 17, WS_GROUP
            SetWindowAlpha
            
            Button.CreateButton hwnd, "浏览(&V)", 5, 217, 20, 60, 20, hFont

            Edit.CreateEdit hwnd, 6, 20, 20, 187, 20, hFont
            Call SetFocus(Edit.hwnd(0))
            
            ComboBox.CreateCombox hwnd, 7, 20, 72, 175, 188, hFont
            ComboBox.AddItem hwnd, 7, "缺省"
            
            Button.CreateButton hwnd, "随机跟换背景图片(&B)", 8, 20, 98, 134, 16, hFont, BS_AUTOCHECKBOX

            ComboBox.CreateCombox hwnd, 9, 20, 144, 175, 500, hFont
            ComboBox.AddItem hwnd, 9, "缺省"
            
            Button.CreateButton hwnd, "随机跟换时间图片", 10, 20, 166, 118, 20, hFont, BS_AUTOCHECKBOX
            Button.CreateButton hwnd, "最顶层(&T)", 11, 20, 212, 72, 18, hFont, BS_AUTOCHECKBOX Or WS_GROUP
            Button.CreateButton hwnd, "开机自动运行(&U)", 12, 20, 231, 110, 18, hFont, BS_AUTOCHECKBOX
            Button.CreateButton hwnd, "以图标方式运行(&I)", 13, 20, 249, 122, 18, hFont, BS_AUTOCHECKBOX
           
            Set Label = New clsLabel
            Label.CreateLabel hwnd, "图片目录", 20, 4, hFont
            Label.CreateLabel hwnd, "背景图片", 20, 55, hFont
            Label.CreateLabel hwnd, "时间图片", 20, 126, hFont
            Label.CreateLabel hwnd, "选项", 20, 197, hFont
            '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
            Dim strValue As String
            strValue = GetKeyValue(HKEY_CURRENT_USER, "Software\Alarm Clock\Option", "SkinPath")
                If strValue <> vbNullString And Dir(strValue, vbDirectory) <> "" Then
                    Call Edit.SetEditText(hwnd, 6, strValue)
                    AddBmpFile hwnd, Edit.Text(hwnd, 6)
                Else
                    Call Edit.SetEditText(hwnd, 6, App.Path)
                    AddBmpFile hwnd, Edit.Text(hwnd, 6)
                End If
            '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
            CommboBox_Load hwnd, 7, "SelBackBmp"    ' 初始化 Combobox
            CommboBox_Load hwnd, 9, "SelTimeBmp"
            '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
            CheckBox_Load hwnd, 8, "RndBackBmp"      ' 初始化 CheckBox
            CheckBox_Load hwnd, 10, "RndTimeBmp"
            CheckBox_Load hwnd, 11, "Windowpos"
            CheckBox_Load hwnd, 12, "AutoRun"
            CheckBox_Load hwnd, 13, "IconRun"
            '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
            
        Case WM_COMMAND
            Select Case wParam  ' 没有菜单不用区分ID idButton = LOWORD(wParam) hwndButton = (HWND) lParam
                Case Is = 1     ' 确定按纽
                    Call SendMessage(hwnd, WM_COMMAND, 3, 0)  ' 等于按下应用按钮
                    Call SendMessage(hwnd, WM_CLOSE, 0, ByVal 0)
                Case Is = 2     ' 取消按钮
                     
                    Call SendMessage(hwnd, WM_CLOSE, 0, ByVal 0)
                Case Is = 3     ' 应用按钮
                    Call CreateRegKey(HKEY_CURRENT_USER, "Software\Alarm Clock\Load", "Alpha", REG_DWORD, TrackBar.Value)
                    Call CreateRegKey(HKEY_CURRENT_USER, "Software\Alarm Clock\Option", "SkinPath", REG_SZ, Edit.Text(hwnd, 6))    ' 只有一个编辑框否则
                    Call CreateRegKey(HKEY_CURRENT_USER, "Software\Alarm Clock\Option", "SelBackBmp", REG_DWORD, ComboBox.GetSelItem(hwnd, 7))
                    Call CreateRegKey(HKEY_CURRENT_USER, "Software\Alarm Clock\Option", "SelTimeBmp", REG_DWORD, ComboBox.GetSelItem(hwnd, 9))
                    Call CreateRegKey(HKEY_CURRENT_USER, "Software\Alarm Clock\Load", "BmpBack", REG_SZ, ComboBox.SelIndexText(hwnd, 7))
                    Call CreateRegKey(HKEY_CURRENT_USER, "Software\Alarm Clock\Load", "BmpTime", REG_SZ, ComboBox.SelIndexText(hwnd, 9))
                    Call CheckBox_Unload(hwnd, 8, "RndBackBmp")
                    Call CheckBox_Unload(hwnd, 10, "RndTimeBmp")
                    Call CheckBox_Unload(hwnd, 12, "AutoRun")
                    Call CheckBox_Unload(hwnd, 13, "IconRun")
                    
                    If IsIconic(hWndMain) Then: SendMsgRestore  '如果最是小图标则恢复窗口
                    
                    Call AppInitialize(hWndMain)
                    Call SltBmphDc(hWndMain)
                    Call SetWindowhRgn(hWndMain)
                    Call CheckBox_Unload(hwnd, 11, "Windowpos")
                Case Is = 5
                    Set CommonDialog = New clsCommonDialog
                    Dim StrPath As String
                    StrPath = CommonDialog.BrowsCatalog(hwnd)
                    
                    If StrPath <> vbNullString Then
                        Call Edit.SetEditText(hwnd, 6, StrPath)
                        Call ComboBox.DeleteItem(hwnd, 7)
                        Call ComboBox.DeleteItem(hwnd, 9)
                        Call AddBmpFile(hwnd, StrPath) 'Edit.Text(hWnd, 6)
                    End If
                    
                End Select
                
                Dim ReRect As RECT
                ReRect.Left = 224: ReRect.Right = 426
                ReRect.Top = 68: ReRect.Bottom = 262

                If HIWord(wParam) = CBN_SELCHANGE Then  'HiWord Code Combobox Notification Messages
                   InvalidateRect hwnd, ReRect, 0
                End If
        Case WM_HSCROLL
                If wParam = TB_ENDTRACK Then
                    Call SetLayeredWindowAttributes(hWndMain, 0, TrackBar.Value, LWA_ALPHA)
                End If
        Case WM_PAINT
        Dim lpPaint As PAINTSTRUCT, FRect As RECT
        Dim hDc As Long, hBrush As Long
  
            hDc = BeginPaint(hwnd, lpPaint)
                DrawFrame hDc, 10, 290, 10, 50
                DrawFrame hDc, 10, 207, 60, 120
                DrawFrame hDc, 10, 207, 131, 190
                DrawFrame hDc, 10, 207, 202, 270