Option Explicit 'wymuszenie deklaracji zmiennych
'zmienne globalne przechowujące formaty daty i czasu
Public gstrFormatDaty As String
Public gstrFormatCzasu As String
|
Private Sub Form_Load()
gstrFormatDaty = "Long Date"
gstrFormatCzasu = "Long Time"
'ustawienie wartości początkowych formatów daty i czasu
Call tmrZegar_Timer
'wywołanie procedury zdarzenia Timer kontrolki Timer,
'aby ustalić datę i czas wyświetlane w etykietach
End Sub
|
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbRightButton Then
'jeżeli wciśnięto prawy przycisk myszy
frmZegar.PopupMenu mnuMenu
'rozwinięcie menu pop-up: Menu
End If
End Sub
|
Private Sub Form_Resize()
'ustawienie nowych pozycje etykiet po zmianie rozmiaru
Call UstawEtykiety
End Sub
|
Private Sub lblCzas_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbRightButton Then
'jeżeli wciśnięto prawy przycisk myszy
frmZegar.PopupMenu mnuCzas
'rozwinięcie menu pop-up: Czas
End If
End Sub
|
Private Sub lblData_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbRightButton Then
'jeżeli wciśnięto prawy przycisk myszy
frmZegar.PopupMenu mnuData
'rozwinięcie menu pop-up: Data
End If
End Sub
|
Private Sub mnuCzasCzcionka_Click()
'wywołanie procedury zmieniającej czcionkę etykiety lblCzas
Call ZmienCzcionke(lblCzas)
End Sub
|
Private Sub mnuCzasFormatFormaty_Click(Index As Integer)
Dim bytI As Byte
For bytI = 1 To 3
mnuCzasFormatFormaty(bytI).Checked = False
'ustawienie właściwości Checked wszystkich pozycji menu Czas/Format
'na False i usunięcie wszystkich znaczników V
Next bytI
mnuCzasFormatFormaty(Index).Checked = True
'ustawienie Checked na True dla wybranego formatu czasu
Select Case Index
'w zależności od indeksu wybranego formatu do zmiennej gstrFormatCzasu
'podstawiana jest wartość tekstowa wykorzystywana przez funkcję Format()
'do formatowania czasu
Case 1:
gstrFormatCzasu = "Long Time"
Case 2:
gstrFormatCzasu = "Medium Time"
Case 3:
gstrFormatCzasu = "Short Time"
End Select
Call tmrZegar_Timer
'wyświetlenie czasu w nowym formacie
Call UstawEtykiety
'ustawie pozycji etykiet
End Sub
|
Private Sub mnuCzasPokaz_Click()
mnuCzasPokaz.Checked = Not (mnuCzasPokaz.Checked)
mnuMenuCzas.Checked = mnuCzasPokaz.Checked
'zmiana Checked menu mnuCzasPokaz i mnuMenuCzas, które mają takie samo
'znacznie, na przeciwną
lblCzas.Visible = Not (lblCzas.Visible)
'ukrycie lub pokazanie czasu
Call UstawEtykiety
'ustawienie nowych pozycji etykiet
End Sub
|
Private Sub mnuCzasUstaw_Click()
Dim varCzas As Variant 'zmienna w której będzie pobrany od użytkownika łańcuch znaków
varCzas = InputBox("Podaj nowy czas: ", "Czas: " & lblCzas.Caption, lblCzas.Caption)
If IsDate(varCzas) Then
Time = varCzas
End If
End Sub
|
Private Sub mnuDataCzcionka_Click()
'wywołanie procedury zmieniającej czcionkę etykiety lblData
Call ZmienCzcionke(lblData)
End Sub
|
Private Sub mnuDataFormatFormaty_Click(Index As Integer)
Dim bytI As Byte
For bytI = 1 To 3
mnuDataFormatFormaty(bytI).Checked = False
'ustawienie właściwości Checked wszystkich pozycji menu Data/Format
'na False i usunięcie wszystkich znaczników V
Next bytI
mnuDataFormatFormaty(Index).Checked = True
'ustawienie Checked na True dla wybranego formatu daty
Select Case Index
'w zależności od indeksu wybranego formatu do zmiennej gstrFormatDaty
'podstawiana jest wartość tekstowa wykorzystywana przez funkcję Format()
'do formatowania daty
Case 1:
gstrFormatDaty = "Long Date"
Case 2:
gstrFormatDaty = "Medium Date"
Case 3:
gstrFormatDaty = "Short Date"
End Select
Call tmrZegar_Timer
'wyświetlenie daty w nowym formacie
Call UstawEtykiety
'ustawie pozycji etykiet
End Sub
|
Private Sub mnuDataPokaz_Click()
mnuDataPokaz.Checked = Not (mnuDataPokaz.Checked)
mnuMenuData.Checked = mnuDataPokaz.Checked
'zmiana Checked menu mnuDataPokaz i mnuMenuData, które mają takie samo
'znacznie, na przeciwną
lblData.Visible = Not (lblData.Visible)
'ukrycie lub pokazanie daty
Call UstawEtykiety
'ustawienie nowych pozycji etykiet
End Sub
|
Private Sub mnuDataUstaw_Click()
Dim varData As Variant 'zmienna w której będzie pobrany od użytkownika łańcuch znaków
varData = InputBox("Podaj nową datę: ", "Data: " & lblData.Caption, lblData.Caption)
If IsDate(varData) Then
Date = varCzas
End If
End Sub
|
Private Sub mnuMenuCzas_Click()
Call mnuCzasPokaz_Click
End Sub
|
Private Sub mnuMenuData_Click()
Call mnuDataPokaz_Click
End Sub
|
Private Sub mnuMenuUkryj_Click()
mnuZegar.Visible = Not (mnuZegar.Visible)
mnuData.Visible = Not (mnuData.Visible)
mnuCzas.Visible = Not (mnuCzas.Visible)
'pokazanie lub ukrycie menu
If mnuZegar.Visible = True Then
mnuMenuUkryj.Caption = "&Ukryj menu"
'jeżeli menu jest widoczne to zmiana Caption menu mnuMenuUkryj
'na "Ukryj menu"
Else
mnuMenuUkryj.Caption = "&Pokaż menu"
'jeżeli menu nie jest widoczne to zmiana Caption menu mnuMenuUkryj
'na "Pokaz menu"
End If
End Sub
|
Private Sub mnuZegarKolor_Click()
cdlOknaDialogowe.Color = frmZegar.BackColor
'przekazanie koloru do kontrolki
cdlOknaDialogowe.ShowColor
'wyświetla okno kolorów
frmZegar.BackColor = cdlOknaDialogowe.Color
'ustawienie nowego koloru formy
End Sub
|
Private Sub mnuZegarKoniec_Click()
UnLoad frmZegar
'usunięcie formy frmZegar z pamięci
End Sub
|
Private Sub tmrZegar_Timer()
lblCzas.Caption = Format(Time, gstrFormatCzasu)
'wyświetlenie czasu w określonym formacie
lblData.Caption = Format(Date, gstrFormatDaty)
'wyświetlenie daty w określonym formacie
frmZegar.Caption = "Zegar " & lblCzas.Caption
'wyświetlenie czasu na pasku tytułowym formy
End Sub
|
Public Sub UstawEtykiety()
lblData.Left = (frmZegar.ScaleWidth - lblData.Width) / 2
lblCzas.Left = (frmZegar.ScaleWidth - lblCzas.Width) / 2
'ustalenie położenia etykiet centralnie w połowie szerokości formy
If lblData.Visible = True Then
If lblCzas.Visible = True Then
lblData.Top = (frmZegar.ScaleHeight - lblCzas.Height - lblData.Height - 100) / 2
lblCzas.Top = lblData.Top + lblData.Height + 100
'jeżeli widoczna jest i data i czas, ustalenie położenia etykiet
'centralnie w połowie wysokości formy
Else
lblData.Top = (frmZegar.ScaleHeight - lblData.Height) / 2
'jeżeli widoczna jest tylko data, ustalenie położenia etykiety
'centralnie w połowie wysokości formy
End If
Else
lblCzas.Top = (frmZegar.ScaleHeight - lblCzas.Height) / 2
'jeżeli widoczny jest tylko czas, ustalenie położenia etykiety
'centralnie w połowie wysokości formy
End If
End Sub
|
Public Sub ZmienCzcionke(Kontrolka As Control)
cdlOknaDialogowe.Flags = cdlCFScreenFonts + cdlCFEffects
'ustawienie flag, powodujących wyświetlenie dostępnych czcionek
'ekranowych i opcji Podkreślone i Przekreślone
cdlOknaDialogowe.FontName = Kontrolka.Font.Name
cdlOknaDialogowe.FontSize = Kontrolka.Font.Size
cdlOknaDialogowe.FontBold = Kontrolka.Font.Bold
cdlOknaDialogowe.FontItalic = Kontrolka.Font.Italic
cdlOknaDialogowe.FontStrikethru = Kontrolka.Font.Strikethrough
cdlOknaDialogowe.FontUnderline = Kontrolka.Font.Underline
'przekazanie aktualnie wykorzystywanej czcionki kontrolki
'do kontrolki CommonDialog jako wartości startowej
cdlOknaDialogowe.Color = Kontrolka.ForeColor
'przekazanie koloru czcionki do CommonDialog
cdlOknaDialogowe.ShowFont
'wyświetlenie okna Czcionki
Kontrolka.Font.Name = cdlOknaDialogowe.FontName
Kontrolka.Font.Size = cdlOknaDialogowe.FontSize
Kontrolka.Font.Bold = cdlOknaDialogowe.FontBold
Kontrolka.Font.Italic = cdlOknaDialogowe.FontItalic
Kontrolka.Font.Strikethrough = cdlOknaDialogowe.FontStrikethru
Kontrolka.Font.Underline = cdlOknaDialogowe.FontUnderline
'przekazanie wybranych atrybutów czcionki do kontrolki
Kontrolka.ForeColor = cdlOknaDialogowe.Color
'przekazanie wybranego koloru czcionki do kontrolki
Call UstawEtykiety
'ustawienie pozycji kontrolek
End Sub
|
