dlgoption.bas

一个clock的 vb 源码

                
                DrawFrame hDc, 300, 434, 10, 50
                DrawFrame hDc, 216, 434, 60, 270
                
                DrawButton hDc, 194, 268, 275, 298
                DrawButton hDc, 274, 348, 275, 298
                DrawButton hDc, 354, 428, 275, 298
                DrawButton hDc, 216, 278, 19, 41
                
                FRect.Left = 224: FRect.Right = 426
                FRect.Top = 68: FRect.Bottom = 262
         
                hBrush = CreateSolidBrush(&HC0C0C0)
                Call FillRect(hDc, FRect, hBrush)
                Call DeleteObject(hBrush)
                ViewSkin hDc, hwnd
            Call EndPaint(hwnd, lpPaint)
        Case WM_CLOSE
            Call SetWindowAlpha
            If GetWindowsInfo Then
                Call SetLayeredWindowAttributes(hWndMain, 0, TrackBar.Value, LWA_ALPHA)
            End If
            
            If ComboBox.ListCount(hwnd, 7) = 1 Then
                DelRegkey HKEY_CURRENT_USER, "Software\Alarm Clock\Clock Skin", "BlackFile"
            End If
            
            If ComboBox.ListCount(hwnd, 9) = 1 Then
                DelRegkey HKEY_CURRENT_USER, "Software\Alarm Clock\Clock Skin", "TimeFile"
            End If
            
            If ComboBox.ListCount(hwnd, 7) And ComboBox.ListCount(hwnd, 9) = 1 Then
                DelRegkey HKEY_CURRENT_USER, "Software\Alarm Clock", "Clock Skin"
            End If
            
            Set Button = Nothing
            Set Edit = Nothing
            Set TrackBar = Nothing
            Set ComboBox = Nothing
            Set Label = Nothing
            Set DrawTime = Nothing
            Call DeleteObject(hFont)
            Call EndDialog(hwnd, 0)
    End Select
End Function
Public Function SetWindowAlpha()
    Dim AlphaValue As String, bAlpha As Long
        If GetWindowsInfo Then
            AlphaValue = GetKeyValue(HKEY_CURRENT_USER, "Software\Alarm Clock\Load", "Alpha")
                If AlphaValue <> "" And IsNumeric(AlphaValue) Then
                    bAlpha = CLng(AlphaValue)
                Else
                    bAlpha = 188
                End If
                TrackBar.Value = bAlpha
        Else
            TrackBar.Value = 100
            EnableWindow TrackBar.hwnd, False
        End If

End Function
           
Private Function CheckBox_Load(hDlg As Long, ID As Long, strRegKey As String)
    ' 读注册表设置 CheckBox  状态
    Dim strValue As String
    strValue = GetKeyValue(HKEY_CURRENT_USER, "Software\Alarm Clock\Option", strRegKey)
    If strValue <> vbNullString And IsNumeric(strValue) Then
        If CLng(strValue) > 0 Then
            Call SendDlgItemMessage(hDlg, ID, BM_SETCHECK, BST_CHECKED, 0)
        Else
            Call SendDlgItemMessage(hDlg, ID, BM_SETCHECK, BST_UNCHECKED, 0)
        End If
    Else
        Call SendDlgItemMessage(hDlg, ID, BM_SETCHECK, BST_UNCHECKED, 0)
    End If
End Function

Private Function CheckBox_Unload(hDlg As Long, uId As Long, strRegKey As String)
    ' 功能：写入CheckBox 的状态 1为选中,0为未选中
    ' 参数：hDlg (对话框句柄), uID (控制ID), strRegKey (要写入值的注册表项目名)
    If BST_CHECKED = SendDlgItemMessage(hDlg, uId, BM_GETCHECK, 0, 0) Then
        Call CreateRegKey(HKEY_CURRENT_USER, "Software\Alarm Clock\Option", strRegKey, REG_DWORD, 1)
        Select Case uId
            Case Is = 12
                Call CreateRegKey(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Run", "AlarmClock", REG_SZ, App.Path & "\" & App.EXEName & ".exe")
            Case Is = 11
                Call SetWindowPos(hWndMain, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE Or SWP_SHOWWINDOW)
        End Select
    Else
        Call CreateRegKey(HKEY_CURRENT_USER, "Software\Alarm Clock\Option", strRegKey, REG_DWORD, 0)
        Select Case uId
            Case Is = 12
                Call DelRegSubkey(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Run", "AlarmClock")
            Case Is = 11
                Call SetWindowPos(hWndMain, 1, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE Or SWP_SHOWWINDOW)
        End Select
    End If
End Function

Private Function AddBmpFile(hDlg As Long, strFilePath As String)
    ' 功能：查找符合条件的图片文件并将文件名添加进 Combobox
    ' 并写入注册表
    ' 参数： hDlg (对话框句柄), strFilePath 文件夹路径
    Dim MyFile As String, I As Long, N As Long
    Dim BmpType As BITMAP, hBmp As Long
    '--------------------------------------------------------------------------------
    
    MyFile = Dir(strFilePath & "\*.bmp", vbHidden Or vbNormal Or vbSystem)
        Do While MyFile <> ""
            hBmp = LoadImage(0, strFilePath & "\" & MyFile, IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE)
            Call GetObjects(hBmp, Len(BmpType), BmpType)
                If BmpType.bmWidth < 201 And BmpType.bmWidth > 109 And BmpType.bmHeight < 201 And BmpType.bmHeight > 25 Then
                    ComboBox.AddItem hDlg, 7, MyFile
                    I = I + 1
                    Call CreateRegKey(HKEY_CURRENT_USER, "Software\Alarm Clock\Clock Skin\BlackFile", CStr(I), REG_SZ, MyFile)
                End If
                If BmpType.bmWidth = 180 And BmpType.bmHeight = 25 Then
                    ComboBox.AddItem hDlg, 9, MyFile
                    N = N + 1
                    Call CreateRegKey(HKEY_CURRENT_USER, "Software\Alarm Clock\Clock Skin\TimeFile", CStr(N), REG_SZ, MyFile)
                End If
            Call DeleteObject(hBmp)
            MyFile = Dir   ' 第二次调用查找下一个文件。
        Loop
    '--------------------------------------------------------------------------------
End Function

Public Function CommboBox_Load(hDlg As Long, ID As Long, strRegKey As String)
    Dim strValue As String, Index As Long
    strValue = GetKeyValue(HKEY_CURRENT_USER, "Software\Alarm Clock\Option", strRegKey)
    Index = ComboBox.ListCount(hDlg, ID)
    If strValue <> vbNullString And IsNumeric(strValue) Then
        If Index <> 0 And Index > CLng(strValue) Then
            ComboBox.ListIndex hDlg, ID, CLng(strValue)
        Else
            ComboBox.ListIndex hDlg, ID, 0
        End If
    End If
End Function

Private Function ViewSkin(hDcWindow As Long, hDlg As Long)
    Dim hBmpBack As Long, hBmpTime As Long
    Dim hDcMemBack As Long, hDcMemTime As Long
    Dim strBackPath As String, strTimePath As String
    Dim lpObject As BITMAP
            
            Set DrawTime = New clsDrawTime
            strBackPath = Edit.Text(hDlg, 6) & "\" & ComboBox.SelIndexText(hDlg, 7)
            hBmpBack = LoadImage(0, strBackPath, IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE)
            If ComboBox.GetSelItem(hDlg, 7) = 0 Then
                hBmpBack = LoadResImage(App.hInstance, 2, IMAGE_BITMAP, 0, 0, 0)
            End If
            GetObjects hBmpBack, Len(lpObject), lpObject
            hDcMemBack = CreateCompatibleDC(hDcWindow)
            Call SelectObject(hDcMemBack, hBmpBack)

            strTimePath = Edit.Text(hDlg, 6) & "\" & ComboBox.SelIndexText(hDlg, 9)
            hBmpTime = LoadImage(0, strTimePath, IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE)
            If ComboBox.GetSelItem(hDlg, 9) = 0 Then
               hBmpTime = LoadResImage(App.hInstance, 3, IMAGE_BITMAP, 0, 0, 0)
            End If
            hDcMemTime = CreateCompatibleDC(hDcWindow)
            Call SelectObject(hDcMemTime, hBmpTime)
            Call DrawTime.PaintTimePos(hDcMemBack, lpObject.bmWidth, lpObject.bmHeight)
            DrawTime.DrawTime hDcMemBack, hDcMemTime, CStr(Time)
            
            Call TransparentBlt(hDcWindow, (650 - lpObject.bmWidth) / 2, (330 - lpObject.bmHeight) / 2, lpObject.bmWidth, lpObject.bmHeight, hDcMemBack, 0, 0, lpObject.bmWidth, lpObject.bmHeight, GetPixel(hDcMemBack, 0, 0))
            Call DeleteObject(hBmpBack)
            Call DeleteObject(hBmpTime)
            Call DeleteDC(hDcMemBack)
            Call DeleteDC(hDcMemTime)
  End Function