Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/datetime/datetim1.frm

Visual Basic Form | 1995-09-06 | 11.2 KB | 296 lines

VERSION 2.00
Begin Form FullWindow
   BackColor       =   &H00000000&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "DateTime"
   ClientHeight    =   210
   ClientLeft      =   360
   ClientTop       =   630
   ClientWidth     =   2880
   ForeColor       =   &H00FFFFFF&
   Height          =   900
   Icon            =   DATETIM1.FRX:0000
   Left            =   300
   LinkMode        =   1  'Source
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   210
   ScaleWidth      =   2880
   Top             =   0
   Width           =   3000
   Begin Timer Zeitmesser
      Index           =   1
      Interval        =   1000
      Left            =   0
      Top             =   0
   End
   Begin Menu Menu
      Caption         =   "&Menu"
      Begin Menu MenuClick
         Caption         =   "&Click"
      End
      Begin Menu Separator1
         Caption         =   "-"
      End
      Begin Menu MenuFormat
         Caption         =   "dddd ddddd ttttt"
         Checked         =   -1  'True
         Index           =   1
      End
      Begin Menu MenuFormat
         Caption         =   "dddd ddddd hh:mm"
         Index           =   2
      End
      Begin Menu MenuFormat
         Caption         =   "ddd ddddd hh:mm"
         Index           =   3
      End
      Begin Menu MenuFormat
         Caption         =   "dddd d-mmmm-yy h:mm:ss"
         Index           =   4
      End
      Begin Menu MenuFormat
         Caption         =   "ddd dd-mmm-yy hh:mm"
         Index           =   5
      End
      Begin Menu MenuFormat
         Caption         =   "ddd d/m/yy h:mm"
         Index           =   6
      End
      Begin Menu MenuFormat
         Caption         =   "Enter your own format"
         Index           =   7
      End
      Begin Menu Separator2
         Caption         =   "-"
      End
      Begin Menu MenuAbout
         Caption         =   "&About..."
      End
   End
   Begin Menu MenuHelp
      Caption         =   "&Help"
   End
' Program related declarations
Const INIFILENAME$ = "DATETIME.INI"
Dim HelpFilePath$, DTFormat$
Sub Clear_MenuFormat_Checkmarks ()
    For i% = 1 To 7
        MenuFormat(i%).Checked = False
    Next i%
End Sub
Sub Form_Load ()
    Initialize
    ' Get parameters from file (INIFILENAME$):
    Left = GetPrivateProfileInt("DateTime", "Left", 300, INIFILENAME$)
    Top = GetPrivateProfileInt("DateTime", "Top", 0, INIFILENAME$)
    x$ = Space$(256)
    i% = GetPrivateProfileString("DateTime", "Click", "no", x$, 255, INIFILENAME$)
    x$ = Left$(x$, i%) ' Remove trailing Chr$(0) and other stuff
    x$ = LTrim$(RTrim$(x$)) ' Remove leading and trailing blanks
    x$ = UCase$(x$)
    MenuClick.Checked = x$ = "YES" Or x$ = "TRUE" Or x$ = "ON" Or x$ = "1"
    x$ = Space$(256)
    i% = GetPrivateProfileString("DateTime", "FormatString", "Enter your own format", x$, 255, INIFILENAME$)
    x$ = Left$(x$, i%) ' Remove trailing Chr$(0) and other stuff
    x$ = LTrim$(RTrim$(x$)) ' Remove leading and trailing blanks
    MenuFormat(7).Caption = x$
    i% = GetPrivateProfileInt("DateTime", "FormatNumber", 1, INIFILENAME$)
    Clear_MenuFormat_Checkmarks
    ' Determine DTFormat$ and put check mark next to active format:
    DTFormat$ = MenuFormat(i%).Caption
    MenuFormat(i%).Checked = True
    ' Determine own path to find help file later.
    ' First get own path and file name:
    HelpFilePath$ = Space$(128)
    hModule% = GetClassWord(hWnd, GCW_HMODULE)
    i% = GetModuleFileName(hModule%, HelpFilePath$, 127)
    HelpFilePath$ = Left$(HelpFilePath$, i%) ' Remove chr$(0) and other stuff
    ' Remove extension and replace with .WRI:
    Do While Right$(HelpFilePath$, 1) <> "." And Len(HelpFilePath$)
        HelpFilePath$ = Left$(HelpFilePath$, Len(HelpFilePath$) - 1)
    Loop
    HelpFilePath$ = HelpFilePath$ + "WRI"
    ' Initialize display string:
    DatTim$ = "Initializing, one moment please..."
    Load SmallWindow
    ' Load start timer which runs for one second only, then forces
    ' WindowState from MINIMIZED to NORMAL to facilitate loading
    ' from the WIN.INI load= line:
    Load Zeitmesser(2)
    Zeitmesser(2).Interval = 1000
End Sub
Sub Form_Paint ()
    ' DatTim$ is a global variable containing the text to be displayed:
    Cls: Print DatTim$;
    If CurrentX Then
        If CurrentX > 2000 Then
            Width = CurrentX + 32
        Else
            Width = 2000
        End If
        SmallWindow.Width = CurrentX
    End If
    ' SmallWindow shall always follow FullWindow but is hidden
    ' as long FullWindow is active:
    SmallWindow.Left = Left
    SmallWindow.Top = Top
End Sub
Sub Form_Resize ()
    If WindowState <> MINIMIZED Then
        ' Zeitmesser(1) timer when resized from icon to normal:
        If Zeitmesser(1).Interval = 0 Then Zeitmesser(1).Interval = 1000
    Else ' WindowState = MINIMIZED, i.e. an icon
        ' If resized to icon then stop timer to reduce system load,
        ' hide the small form and clear text so it does not display
        ' over the icon:
        Zeitmesser(1).Interval = 0
        SmallWindow.Hide
        SmallWindow.Cls
        Cls
    End If ' WindowState
    ' Let the small form always follow the primary one:
    SmallWindow.WindowState = WindowState
End Sub
Sub Form_Unload (Abbrechen%)
    ' To make sure the parameters of the NORMAL window are saved,
    ' not the ones of the icon in case the form is minimized:
    WindowState = NORMAL
    ' Write all parameters into DATETIME.INI:
    i% = WritePrivateProfileString("DateTime", "Left", Str$(Left), INIFILENAME$)
    i% = WritePrivateProfileString("DateTime", "Top", Str$(Top), INIFILENAME$)
    If MenuClick.Checked Then x$ = "yes" Else x$ = "no"
    i% = WritePrivateProfileString("DateTime", "Click", x$, INIFILENAME$)
    x$ = MenuFormat(7).Caption
    i% = WritePrivateProfileString("DateTime", "FormatString", x$, INIFILENAME$)
    For i% = 1 To 7
        If MenuFormat(i%).Checked Then
            i% = WritePrivateProfileString("DateTime", "FormatNumber", Str$(i%), INIFILENAME$)
            Exit For
        End If
    Next i%
    ' Make sure the other form is unloaded also:
    End
End Sub
Sub Initialize ()
    ' Set general constants that cannot be declared:
    NL$ = Chr$(13) + Chr$(10)
    TB$ = Chr$(9)
End Sub
Sub MenuAbout_Click ()
    Form_Paint
    MsgBox TB$ + "  DateTime" + NL$ + "            Copyright
 1991" + NL$ + "    A.C.I. GmbH MicroSysteme" + NL$ + "          Hans-Georg Michna" + NL$ + "[e-mail]" + NL$ + "      Select Help for more info."
End Sub
Sub MenuClick_Click ()
    MenuClick.Checked = Not MenuClick.Checked
End Sub
Sub MenuFormat_Click (Index%)
    If Index% = 7 Then
        ' Make sure that the window is repainted
        ' which may have been obscured by the unfolding menu:
        Refresh
        ' Ask user for its own format string:
        x$ = "Date and time codes:" + NL$
        x$ = x$ + "Day:" + TB$ + "d..dddd" + NL$
        x$ = x$ + "Month:" + TB$ + "m..mmmm" + NL$
        x$ = x$ + "Year:" + TB$ + "yy or yyyy" + NL$
        x$ = x$ + "Full date: ddddd" + NL$
        x$ = x$ + "Hour:" + TB$ + "h or hh" + NL$
        x$ = x$ + "Minute:" + TB$ + "m or mm" + NL$
        x$ = x$ + "Second: s or ss" + NL$
        x$ = x$ + "Full time: ttttt" + NL$
        x$ = x$ + "Date delimiter: /" + NL$
        x$ = x$ + "Example: d/m/yy h:mm"
        y$ = MenuFormat(7).Caption
        x$ = InputBox$(x$, "Enter Your Own Format", MenuFormat(7).Caption)
        If x$ = "" Then
            MenuFormat(7).Caption = y$
            Exit Sub
        Else
            MenuFormat(7).Caption = x$
        End If
        ' Now try if this string really works:
        Err = 0
        On Error Resume Next
        x$ = Format$(Now, MenuFormat(7).Caption)
        ErrNo% = Err
        On Error GoTo 0
        If ErrNo% Then
            MsgBox "Invalid format string:" + NL$ + TB$ + MenuFormat(7).Caption + NL$ + "First format activated instead. Click on Help to get more information.", MB_OK + MB_ICONSTOP, "Format String Error"
            MenuFormat_Click (1)
            Exit Sub
        End If
    End If
    ' Common procedure for all menu items:
    Clear_MenuFormat_Checkmarks
    MenuFormat(Index%).Checked = True
    DTFormat$ = MenuFormat(Index%).Caption
End Sub
Sub MenuHelp_Click ()
    ' The help file path of DATETIME.WRI has been determined in Sub Form_Load
    Err = 0
    On Error Resume Next
    i% = Shell("WRITE.EXE " + HelpFilePath$, SH_NORMAL_FOCUS)
    ErrNo% = Err
    On Error GoTo 0
    If ErrNo% Or i% = 0 Then
         MsgBox "WRITE.EXE not found." + NL$ + "Install Windows properly.", MB_OK + MB_ICONSTOP, "Error"
    End If
End Sub
Sub Zeitmesser_Timer (iZeitmesser%)
    Static ActiveWindow%, SystemFocus%
    If iZeitmesser% = 2 Then
        ' Start timer, runs only for a short time after loading:
        If WindowState = MINIMIZED Then
            ' Just loaded and a short time passed; time to resize
            ' to NORMAL, but then put focus back to where it was
            ' (presumably Program Manager):
            Wnd% = GetActiveWindow()
            WindowState = NORMAL
            Show
            Wnd% = SetFocusAPI(Wnd%)
        End If
        ' The start timer has fulfilled its purpose and will now be disabled for good:
        Unload Zeitmesser(2)
    Else ' iZeitmesser% = 1, i.e. main seconds timer
        If MenuClick.Checked Then Beep
        ' For repaint purposes the string is kept in the global variable DatTim$
        DatTimOld$ = DatTim$
        DatTim$ = Format$(Now, DTFormat$)

        ' Check if got system focus:
        i% = GetActiveWindow()
        If i% <> ActiveWindow% Then
            ActiveWindow% = i%
            SystemFocus% = GetWindow(ActiveWindow%, GW_OWNER) = GetWindow(hWnd, GW_OWNER)
        End If
        If Visible Then
            ' In case FullWindow was moved put SmallWindow behind again:

            SmallWindow.Left = Left
            SmallWindow.Top = Top
            If SystemFocus% Then ' Still have focus:
                SmallWindow.Hide
                If DatTim$ <> DatTimOld$ Then Refresh
            Else ' Focus was lost:
                ' Replace FullWindow with SmallWindow:
                Hide
                SmallWindow.Refresh
            End If
        Else ' Not visible, i.e. borderless SmallWindow is visible
            If SystemFocus% Then
                SmallWindow.Hide
                Show
                Exit Sub
            End If
            If DatTim$ <> DatTimOld$ Then SmallWindow.Refresh
            ' If necessary, bring to top:
            If GetWindow(SmallWindow.hWnd, GW_HWNDFIRST) <> SmallWindow.hWnd Then
                Const Flags% = SWP_NOMOVE Or SWP_NOSIZE Or SWP_SHOWWINDOW Or SWP_NOACTIVATE
                SetWindowPos SmallWindow.hWnd, 0, 0, 0, 0, 0, Flags%
            End If
        End If ' Visible/Not Visible
    End If 'iZeitmesser% = 1
End Sub