Virtual St-Petersburg/VirtualSaint-Petersburg.iso/vivat/tasks/calendar/calendar.frm

Text File | 1996-05-14 | 24KB | 666 lines

VERSION 2.00
Begin Form Calendar
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   0  'None
   ClientHeight    =   5355
   ClientLeft      =   1215
   ClientTop       =   1320
   ClientWidth     =   3975
   ClipControls    =   0   'False
   ControlBox      =   0   'False
   Height          =   5865
   HelpContextID   =   256
   Icon            =   CALENDAR.FRX:0000
   Left            =   1110
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5355
   ScaleWidth      =   3975
   Top             =   915
   Visible         =   0   'False
   Width           =   4185
   Begin SSPanel Container
      BackColor       =   &H00C0C0C0&
      BevelInner      =   1  'Inset
      Font3D          =   0  'None
      Height          =   3555
      Left            =   45
      TabIndex        =   1
      Top             =   480
      Width           =   3855
      Begin SSFrame YearFrame
         Alignment       =   2  'Center
         Caption         =   "Years"
         Font3D          =   1  'Raised w/light shading
         FontBold        =   -1  'True
         FontItalic      =   0   'False
         FontName        =   "Arial"
         FontSize        =   8.25
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         Height          =   765
         Left            =   120
         ShadowStyle     =   1  'Raised
         TabIndex        =   6
         Top             =   2640
         Width           =   3585
         Begin SSRibbon Years
            AutoSize        =   0  'None
            BackColor       =   &H00C0C0C0&
            GroupNumber     =   3
            Height          =   345
            Index           =   0
            Left            =   120
            PictureDnChange =   1  'Dither 'PictureUp' Bitmap
            PictureUp       =   CALENDAR.FRX:0302
            Top             =   300
            Width           =   345
         End
         Begin SSRibbon Years
            AutoSize        =   0  'None
            BackColor       =   &H00C0C0C0&
            GroupNumber     =   3
            Height          =   345
            Index           =   1
            Left            =   450
            PictureDnChange =   1  'Dither 'PictureUp' Bitmap
            PictureUp       =   CALENDAR.FRX:03FC
            Top             =   300
            Width           =   345
         End
         Begin SSRibbon Years
            AutoSize        =   0  'None
            BackColor       =   &H00C0C0C0&
            GroupNumber     =   3
            Height          =   345
            Index           =   2
            Left            =   780
            PictureDnChange =   1  'Dither 'PictureUp' Bitmap
            PictureUp       =   CALENDAR.FRX:04F6
            Top             =   300
            Width           =   345
         End
         Begin SSRibbon Years
            AutoSize        =   0  'None
            BackColor       =   &H00C0C0C0&
            GroupNumber     =   3
            Height          =   345
            Index           =   3
            Left            =   1110
            PictureDnChange =   1  'Dither 'PictureUp' Bitmap
            PictureUp       =   CALENDAR.FRX:05F0
            Top             =   300
            Width           =   345
         End
         Begin SSRibbon Years
            AutoSize        =   0  'None
            BackColor       =   &H00C0C0C0&
            GroupNumber     =   3
            Height          =   345
            Index           =   4
            Left            =   1440
            PictureDnChange =   1  'Dither 'PictureUp' Bitmap
            PictureUp       =   CALENDAR.FRX:06EA
            Top             =   300
            Width           =   345
         End
         Begin SSRibbon Years
            AutoSize        =   0  'None
            BackColor       =   &H00C0C0C0&
            GroupNumber     =   3
            Height          =   345
            Index           =   5
            Left            =   1770
            PictureDnChange =   1  'Dither 'PictureUp' Bitmap
            PictureUp       =   CALENDAR.FRX:07E4
            Top             =   300
            Width           =   345
         End
         Begin SSRibbon Years
            AutoSize        =   0  'None
            BackColor       =   &H00C0C0C0&
            GroupNumber     =   3
            Height          =   345
            Index           =   6
            Left            =   2100
            PictureDnChange =   1  'Dither 'PictureUp' Bitmap
            PictureUp       =   CALENDAR.FRX:08DE
            Top             =   300
            Width           =   345
         End
         Begin SSRibbon Years
            AutoSize        =   0  'None
            BackColor       =   &H00C0C0C0&
            GroupNumber     =   3
            Height          =   345
            Index           =   7
            Left            =   2430
            PictureDnChange =   1  'Dither 'PictureUp' Bitmap
            PictureUp       =   CALENDAR.FRX:09D8
            Top             =   300
            Width           =   345
         End
         Begin SSRibbon Years
            AutoSize        =   0  'None
            BackColor       =   &H00C0C0C0&
            GroupNumber     =   3
            Height          =   345
            Index           =   8
            Left            =   2760
            PictureDnChange =   1  'Dither 'PictureUp' Bitmap
            PictureUp       =   CALENDAR.FRX:0AD2
            Top             =   300
            Width           =   345
         End
         Begin SSRibbon Years
            AutoSize        =   0  'None
            BackColor       =   &H00C0C0C0&
            GroupNumber     =   3
            Height          =   345
            Index           =   9
            Left            =   3090
            PictureDnChange =   1  'Dither 'PictureUp' Bitmap
            PictureUp       =   CALENDAR.FRX:0BCC
            Top             =   300
            Width           =   345
         End
      End
      Begin SSFrame YearTensFrame
         Alignment       =   2  'Center
         Caption         =   "Year Tens"
         Font3D          =   1  'Raised w/light shading
         FontBold        =   -1  'True
         FontItalic      =   0   'False
         FontName        =   "Arial"
         FontSize        =   8.25
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         Height          =   765
         Left            =   120
         ShadowStyle     =   1  'Raised
         TabIndex        =   5
         Top             =   1830
         Width           =   3585
         Begin SSRibbon Tens
            AutoSize        =   0  'None
            BackColor       =   &H00C0C0C0&
            GroupNumber     =   2
            Height          =   345
            Index           =   9
            Left            =   3090
            PictureDnChange =   1  'Dither 'PictureUp' Bitmap
            PictureUp       =   CALENDAR.FRX:0CC6
            Top             =   300
            Width           =   345
         End
         Begin SSRibbon Tens
            AutoSize        =   0  'None
            BackColor       =   &H00C0C0C0&
            GroupNumber     =   2
            Height          =   345
            Index           =   8
            Left            =   2760
            PictureDnChange =   1  'Dither 'PictureUp' Bitmap
            PictureUp       =   CALENDAR.FRX:0DC0
            Top             =   300
            Width           =   345
         End
         Begin SSRibbon Tens
            AutoSize        =   0  'None
            BackColor       =   &H00C0C0C0&
            GroupNumber     =   2
            Height          =   345
            Index           =   7
            Left            =   2430
            PictureDnChange =   1  'Dither 'PictureUp' Bitmap
            PictureUp       =   CALENDAR.FRX:0EBA
            Top             =   300
            Width           =   345
         End
         Begin SSRibbon Tens
            AutoSize        =   0  'None
            BackColor       =   &H00C0C0C0&
            GroupNumber     =   2
            Height          =   345
            Index           =   6
            Left            =   2100
            PictureDnChange =   1  'Dither 'PictureUp' Bitmap
            PictureUp       =   CALENDAR.FRX:0FB4
            Top             =   300
            Width           =   345
         End
         Begin SSRibbon Tens
            AutoSize        =   0  'None
            BackColor       =   &H00C0C0C0&
            GroupNumber     =   2
            Height          =   345
            Index           =   5
            Left            =   1770
            PictureDnChange =   1  'Dither 'PictureUp' Bitmap
            PictureUp       =   CALENDAR.FRX:10AE
            Top             =   300
            Width           =   345
         End
         Begin SSRibbon Tens
            AutoSize        =   0  'None
            BackColor       =   &H00C0C0C0&
            GroupNumber     =   2
            Height          =   345
            Index           =   4
            Left            =   1440
            PictureDnChange =   1  'Dither 'PictureUp' Bitmap
            PictureUp       =   CALENDAR.FRX:11A8
            Top             =   300
            Width           =   345
         End
         Begin SSRibbon Tens
            AutoSize        =   0  'None
            BackColor       =   &H00C0C0C0&
            GroupNumber     =   2
            Height          =   345
            Index           =   3
            Left            =   1110
            PictureDnChange =   1  'Dither 'PictureUp' Bitmap
            PictureUp       =   CALENDAR.FRX:12A2
            Top             =   300
            Width           =   345
         End
         Begin SSRibbon Tens
            AutoSize        =   0  'None
            BackColor       =   &H00C0C0C0&
            GroupNumber     =   2
            Height          =   345
            Index           =   2
            Left            =   780
            PictureDnChange =   1  'Dither 'PictureUp' Bitmap
            PictureUp       =   CALENDAR.FRX:139C
            Top             =   300
            Width           =   345
         End
         Begin SSRibbon Tens
            AutoSize        =   0  'None
            BackColor       =   &H00C0C0C0&
            GroupNumber     =   2
            Height          =   345
            Index           =   1
            Left            =   450
            PictureDnChange =   1  'Dither 'PictureUp' Bitmap
            PictureUp       =   CALENDAR.FRX:1496
            Top             =   300
            Width           =   345
         End
         Begin SSRibbon Tens
            AutoSize        =   0  'None
            BackColor       =   &H00C0C0C0&
            GroupNumber     =   2
            Height          =   345
            Index           =   0
            Left            =   120
            PictureDnChange =   1  'Dither 'PictureUp' Bitmap
            PictureUp       =   CALENDAR.FRX:1590
            Top             =   300
            Width           =   345
         End
      End
      Begin SSFrame CenturyFrame
         Alignment       =   2  'Center
         Caption         =   "Century"
         Font3D          =   1  'Raised w/light shading
         FontBold        =   -1  'True
         FontItalic      =   0   'False
         FontName        =   "Arial"
         FontSize        =   8.25
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         Height          =   765
         Left            =   120
         ShadowStyle     =   1  'Raised
         TabIndex        =   3
         Top             =   1020
         Width           =   3585
         Begin SSRibbon Centuries
            AutoSize        =   0  'None
            BackColor       =   &H00C0C0C0&
            Height          =   345
            Index           =   7
            Left            =   2430
            PictureDnChange =   1  'Dither 'PictureUp' Bitmap
            PictureUp       =   CALENDAR.FRX:168A
            Top             =   300
            Width           =   345
         End
         Begin SSRibbon Centuries
            AutoSize        =   0  'None
            BackColor       =   &H00C0C0C0&
            Height          =   345
            Index           =   8
            Left            =   2760
            PictureDnChange =   1  'Dither 'PictureUp' Bitmap
            PictureUp       =   CALENDAR.FRX:1784
            Top             =   300
            Width           =   345
         End
         Begin SSRibbon Centuries
            AutoSize        =   0  'None
            BackColor       =   &H00C0C0C0&
            Height          =   345
            Index           =   9
            Left            =   3090
            PictureDnChange =   1  'Dither 'PictureUp' Bitmap
            PictureUp       =   CALENDAR.FRX:187E
            Top             =   300
            Width           =   345
         End
         Begin SSPanel Panel3D3
            BackColor       =   &H00C0C0C0&
            BevelWidth      =   2
            BorderWidth     =   1
            Font3D          =   0  'None
            ForeColor       =   &H00000000&
            Height          =   345
            Left            =   120
            Outline         =   -1  'True
            TabIndex        =   4
            Top             =   300
            Width           =   2325
         End
      End
      Begin SSFrame Frame3D5
         Alignment       =   2  'Center
         Font3D          =   1  'Raised w/light shading
         Height          =   885
         Left            =   120
         ShadowStyle     =   1  'Raised
         TabIndex        =   2
         Top             =   90
         Width           =   3585
         Begin SSCommand ExitButton
            Caption         =   "Exit"
            Font3D          =   1  'Raised w/light shading
            FontBold        =   0   'False
            FontItalic      =   0   'False
            FontName        =   "NTHelvetica/Cyrillic"
            FontSize        =   12
            FontStrikethru  =   0   'False
            FontUnderline   =   0   'False
            Height          =   510
            Left            =   1860
            TabIndex        =   9
            Top             =   225
            Width           =   1575
         End
         Begin SSCommand ViewInfo
            Caption         =   "1900"
            Font3D          =   1  'Raised w/light shading
            FontBold        =   0   'False
            FontItalic      =   0   'False
            FontName        =   "NTHelvetica/Cyrillic"
            FontSize        =   12
            FontStrikethru  =   0   'False
            FontUnderline   =   0   'False
            Height          =   510
            Left            =   120
            TabIndex        =   8
            Top             =   225
            Width           =   1635
         End
      End
   End
   Begin Line TitleUnderline
      BorderWidth     =   2
      Visible         =   0   'False
      X1              =   280
      X2              =   404
      Y1              =   354
      Y2              =   354
   End
   Begin Label WindowTitle
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "NTHelvetica/Cyrillic"
      FontSize        =   9.75
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   60
      Left            =   750
      TabIndex        =   7
      Top             =   690
      Width           =   60
      WordWrap        =   -1  'True
   End
   Begin Label BackArea
      BackStyle       =   0  'Transparent
      Height          =   675
      Left            =   60
      TabIndex        =   0
      Top             =   3660
      Width           =   735
   End
End
Option Explicit

Const BACKGROUND_PICTURE = "paper.bmp"

Dim ofOpenFileInfo As OFSTRUCT
Dim szFileName As String

Sub BackArea_Click ()
    Unload Me
    End Sub

Sub BackArea_MouseMove (Button As Integer, Shift As Integer, X As Single, Y As Single)
    ChangeWindowClassCursor hWnd, MC_GOBACK
    ChangeCursor MC_GOBACK
    End Sub

Sub Centuries_Click (Index As Integer, Value As Integer)
    ViewInfo.Caption = Left$(ViewInfo.Caption, 1) + LTrim$(Str$(Index)) + Right$(ViewInfo.Caption, 2)
    TestExisting
    End Sub

Sub Centuries_MouseMove (Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    ChangeWindowClassCursor hWnd, MC_DEFAULTARROW
    ChangeCursor MC_DEFAULTARROW
    End Sub

Sub CenturyFrame_MouseMove (Button As Integer, Shift As Integer, X As Single, Y As Single)
    ChangeWindowClassCursor hWnd, MC_DEFAULTARROW
    ChangeCursor MC_DEFAULTARROW
    End Sub

Sub ExitArea_Click ()
    Unload Calendar
    End Sub

Sub ExitButton_Click ()
    BackArea_Click
    End Sub

Sub Form_KeyDown (nKeyCode As Integer, wShift As Integer)
    If nKeyCode = 27 Or (nKeyCode = 66 Or nKeyCode = 98) And wShift And 4 Then
        Unload Me
        End If
    End Sub

Sub Form_Load ()
    Dim szPicture As String, nSpacePos As Integer, szCommand As String, szSound As String

    ParseData Command$, " "

    szProfileName = LinePart(1)

    If PartsNumber() > 1 Then
        nLanguage = IIf(LinePart(2) = "1", 1, 2)
                         Else
        nLanguage = 1
        End If

    If PartsNumber() > 2 Then
        fNarrations = (LinePart(3) = "+")
                         Else
        fNarrations = False
        End If

    Left = 0
    Top = GetPrivateProfileInt("Window", "Top", 0, szProfileName) * Screen.TwipsPerPixelY
    Width = Screen.Width
    Height = GetPrivateProfileInt("Window", "Height", 200, szProfileName) * Screen.TwipsPerPixelY
    szPicture = ReadProfileString("Window", "Background", szProfileName)
    szPath = ReadProfileString("Special", "Path", szProfileName)
    szFontName = ReadProfileString("Special", "Font", szProfileName)

    ParseLine "Window", "Panel", szProfileName
    Container.Left = CInt(LinePart(1)) * Screen.TwipsPerPixelX
    Container.Top = CInt(LinePart(2)) * Screen.TwipsPerPixelY

    ParseLine "Window", "Title", szProfileName
    WindowTitle.Left = CInt(LinePart(3)) * Screen.TwipsPerPixelX
    WindowTitle.Top = CInt(LinePart(4)) * Screen.TwipsPerPixelY
    WindowTitle = LinePart(nLanguage)
    TitleUnderline.X1 = WindowTitle.Left
    TitleUnderline.Y1 = WindowTitle.Top + WindowTitle.Height + 195
    TitleUnderline.Y2 = TitleUnderline.Y1
    TitleUnderline.X2 = TitleUnderline.X1 + 285 * Screen.TwipsPerPixelX'WindowTitle.Width
    TitleUnderline.Visible = True

    ParseLine "Special", "FileExt", szProfileName
    szExtension(0) = LinePart(1)
    szExtension(1) = LinePart(2)

    ParseLine "Prompts", "100", szProfileName
    CenturyFrame = LinePart(nLanguage)
    CenturyFrame.FontName = szFontName

    ParseLine "Prompts", "10", szProfileName
    YearTensFrame = LinePart(nLanguage)
    YearTensFrame.FontName = szFontName

    ParseLine "Prompts", "1", szProfileName
    YearFrame = LinePart(nLanguage)
    YearFrame.FontName = szFontName

    ParseLine "Prompts", "Exit", szProfileName
    ExitButton.Caption = LinePart(nLanguage)
    ExitButton.FontName = szFontName

    ParseLine "Window", "Back", szProfileName
    BackArea.Width = CInt(LinePart(3)) * Screen.TwipsPerPixelX
    BackArea.Height = CInt(LinePart(4)) * Screen.TwipsPerPixelY
    BackArea.Left = CInt(LinePart(1)) * Screen.TwipsPerPixelX
    BackArea.Top = CInt(LinePart(2)) * Screen.TwipsPerPixelY

    ViewInfo.Caption = "1703"
    Centuries(7) = True
    Tens(0) = True
    Years(3) = True

    ParseLine "Special", "Help", szProfileName
    App.HelpFile = LinePart(nLanguage)

    On Error GoTo WrongPicture

    If Len(szPicture) > 0 Then
        Picture = LoadPicture(szPicture)
        End If

    On Error GoTo 0

    ofOpenFileInfo.cBytes = Chr$(Len(ofOpenFileInfo))

    ClipCursorInWindow hWnd

    Visible = True
    DoEvents

    If fNarrations Then
        ParseLine "MCI", "Sound", szProfileName

        If PartsNumber() > 1 Then
            szSound = LinePart(nLanguage)
                             Else
            szSound = LinePart(1)
            End If

        ModalPlaySound szSound
        End If

    Exit Sub

WrongPicture:
    MsgBox "Unable to load picture " + szPicture, , "Error"
    Resume Next
    End Sub

Sub Form_MouseMove (Button As Integer, Shift As Integer, X As Single, Y As Single)
    ChangeWindowClassCursor hWnd, MC_DEFAULTARROW
    ChangeCursor MC_DEFAULTARROW
    End Sub

Sub Form_Unload (Cancel As Integer)
    ClipCursorInWindow 0&
    End Sub

Sub Frame3D5_MouseMove (Button As Integer, Shift As Integer, X As Single, Y As Single)
    ChangeWindowClassCursor hWnd, MC_DEFAULTARROW
    ChangeCursor MC_DEFAULTARROW
    End Sub

Sub Panel3D2_MouseMove (Button As Integer, Shift As Integer, X As Single, Y As Single)
    ChangeWindowClassCursor hWnd, MC_DEFAULTARROW
    ChangeCursor MC_DEFAULTARROW
    End Sub

Sub Tens_Click (Index As Integer, Value As Integer)
    ViewInfo.Caption = Left$(ViewInfo.Caption, 2) + LTrim$(Str$(Index)) + Right$(ViewInfo.Caption, 1)
    TestExisting
    End Sub

Sub Tens_MouseMove (Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    ChangeWindowClassCursor hWnd, MC_DEFAULTARROW
    ChangeCursor MC_DEFAULTARROW
    End Sub

Sub TestExisting ()
    szFileName = szPath + "\" + ViewInfo.Caption + "." + szExtension(nLanguage - 1)
    ViewInfo.Enabled = (OpenFile(szFileName, ofOpenFileInfo, OF_EXIST) <> HFILE_ERROR)
    End Sub

Sub ViewInfo_Click ()
    TextPopUpWithUserFont szFileName, Container.Left / Screen.TwipsPerPixelX, Container.Top / Screen.TwipsPerPixelY, Container.Width / Screen.TwipsPerPixelX, Container.Height / Screen.TwipsPerPixelY, ForeColor, BackColor, 16, 0, szFontName

    While FindWindow(SWC_TEXTPOPUP, 0&) > 0
        DoEvents
        Wend

    ClipCursorInWindow hWnd
    End Sub

Sub ViewInfo_MouseMove (Button As Integer, Shift As Integer, X As Single, Y As Single)
    ChangeWindowClassCursor hWnd, MC_DEFAULTARROW
    ChangeCursor MC_DEFAULTARROW
    End Sub

Sub YearFrame_MouseMove (Button As Integer, Shift As Integer, X As Single, Y As Single)
    ChangeWindowClassCursor hWnd, MC_DEFAULTARROW
    ChangeCursor MC_DEFAULTARROW
    End Sub

Sub Years_Click (Index As Integer, Value As Integer)
    ViewInfo.Caption = Left$(ViewInfo.Caption, 3) + LTrim$(Str$(Index))
    TestExisting
    End Sub

Sub Years_MouseMove (Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    ChangeWindowClassCursor hWnd, MC_DEFAULTARROW
    ChangeCursor MC_DEFAULTARROW
    End Sub

Sub YearTensFrame_MouseMove (Button As Integer, Shift As Integer, X As Single, Y As Single)
    ChangeWindowClassCursor hWnd, MC_DEFAULTARROW
    ChangeCursor MC_DEFAULTARROW
    End Sub