Programmer 7500/MAX_PROGRAMMERS.iso/VISUAL_B/ARQS_ZIP/VBMDIXPL.ZIP/MDIFORM1.FRM

Visual Basic Form | 1993-05-17 | 19.6 KB | 692 lines

VERSION 2.00
Begin MDIForm MDIForm1
   Caption         =   "MDIForm1"
   Height          =   7008
   Left            =   1824
   LinkTopic       =   "MDIForm1"
   Top             =   1704
   Width           =   6696
   Begin SSPanel Statusbar
      Align           =   2  'Align Bottom
      BackColor       =   &H00C0C0C0&
      Height          =   492
      Left            =   0
      TabIndex        =   1
      Top             =   5772
      Width           =   6600
      Begin SSPanel StatusLine
         Alignment       =   1  'Left Justify - MIDDLE
         BackColor       =   &H00C0C0C0&
         BevelOuter      =   1  'Inset
         Caption         =   " This is the Status line ...."
         Height          =   252
         Left            =   120
         TabIndex        =   2
         Top             =   120
         Width           =   6132
      End
   End
   Begin SSPanel Toolbar
      Align           =   1  'Align Top
      BackColor       =   &H00C0C0C0&
      Height          =   492
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   6600
      Begin SSCommand B_Toolbar
         BevelWidth      =   1
         Height          =   336
         Index           =   7
         Left            =   3360
         Picture         =   MDIFORM1.FRX:0000
         TabIndex        =   11
         Top             =   84
         Width           =   348
      End
      Begin SSCommand B_Toolbar
         BevelWidth      =   1
         Height          =   336
         Index           =   6
         Left            =   2520
         Picture         =   MDIFORM1.FRX:029A
         TabIndex        =   10
         Top             =   84
         Width           =   348
      End
      Begin SSCommand B_Toolbar
         BevelWidth      =   1
         Height          =   336
         Index           =   5
         Left            =   2160
         Picture         =   MDIFORM1.FRX:058C
         TabIndex        =   9
         Top             =   84
         Width           =   348
      End
      Begin SSCommand B_Toolbar
         BevelWidth      =   1
         Height          =   336
         Index           =   4
         Left            =   1800
         Picture         =   MDIFORM1.FRX:089A
         TabIndex        =   8
         Top             =   84
         Width           =   348
      End
      Begin SSCommand B_Toolbar
         BevelWidth      =   1
         Height          =   336
         Index           =   3
         Left            =   1440
         Picture         =   MDIFORM1.FRX:0B8C
         TabIndex        =   7
         Top             =   84
         Width           =   348
      End
      Begin SSCommand B_Toolbar
         BevelWidth      =   1
         Height          =   336
         Index           =   0
         Left            =   120
         Picture         =   MDIFORM1.FRX:0E3E
         TabIndex        =   6
         Top             =   84
         Width           =   348
      End
      Begin SSCommand B_Toolbar
         BevelWidth      =   1
         Height          =   336
         Index           =   8
         Left            =   3000
         Picture         =   MDIFORM1.FRX:10D8
         TabIndex        =   5
         Top             =   84
         Width           =   396
      End
      Begin SSCommand B_Toolbar
         BevelWidth      =   1
         Height          =   336
         Index           =   1
         Left            =   480
         Picture         =   MDIFORM1.FRX:13CA
         TabIndex        =   4
         Top             =   84
         Width           =   396
      End
      Begin SSCommand B_Toolbar
         BevelWidth      =   1
         Height          =   336
         Index           =   2
         Left            =   840
         Picture         =   MDIFORM1.FRX:16A0
         TabIndex        =   3
         Top             =   84
         Width           =   384
      End
      Begin CommonDialog CMDialog1
         Prop12          =   ""
         Prop27          =   ""
         Prop28          =   MDIFORM1.FRX:1992
         Action          =   0  'Nothing
         CancelError     =   0   'False
         Color           =   &H00000000&
         Copies          =   0
         DefaultExt      =   ""
         DialogTitle     =   ""
         Filename        =   ""
         Filetitle       =   ""
         Filter          =   ""
         FilterIndex     =   0
         Flags           =   0
         FontBold        =   0   'False
         FontItalic      =   0   'False
         FontName        =   ""
         FontSize        =   8
         FontStrikeThru  =   0   'False
         FontUnderLine   =   0   'False
         FromPage        =   0
         HelpCommand     =   0
         HelpContext     =   0
         HelpFile        =   ""
         HelpKey         =   ""
         InitDir         =   ""
         Max             =   0
         MaxFileSize     =   256
         Min             =   0
         PrinterDefault  =   -1  'True
         ToPage          =   0
      End
   End
   Begin Menu M_File
      Caption         =   "&File"
      Begin Menu M_New
         Caption         =   "&New"
      End
      Begin Menu M_Open
         Caption         =   "&Open ..."
      End
      Begin Menu M_Save
         Caption         =   "&Save"
         Shortcut        =   ^S
      End
      Begin Menu M_SaveAs
         Caption         =   "Save &as ..."
         Shortcut        =   ^A
      End
      Begin Menu M_Close
         Caption         =   "&Close "
      End
      Begin Menu M_Dummy1
         Caption         =   "-"
      End
      Begin Menu M_Print
         Caption         =   "&Print"
         Shortcut        =   ^P
      End
      Begin Menu M_PrinterSetup
         Caption         =   "P&rinter Setup ..."
      End
      Begin Menu M_Dummy4
         Caption         =   "-"
      End
      Begin Menu M_Exit
         Caption         =   "&Exit"
      End
   End
   Begin Menu M_Edit
      Caption         =   "&Edit"
      Begin Menu M_Undo
         Caption         =   "&Undo"
         Shortcut        =   ^Z
      End
      Begin Menu M_Dummy7
         Caption         =   "-"
      End
      Begin Menu M_Cut
         Caption         =   "Cu&t"
         Shortcut        =   ^X
      End
      Begin Menu M_Copy
         Caption         =   "&Copy"
         Shortcut        =   ^C
      End
      Begin Menu M_Paste
         Caption         =   "&Paste"
         Shortcut        =   ^V
      End
      Begin Menu M_Delete
         Caption         =   "&Delete"
         Shortcut        =   {DEL}
      End
   End
   Begin Menu M_Options
      Caption         =   "&Options"
      Begin Menu M_Font
         Caption         =   "&Font"
      End
      Begin Menu M_Color
         Caption         =   "&Color"
      End
      Begin Menu M_Dummy6
         Caption         =   "-"
      End
      Begin Menu M_Toolbar
         Caption         =   "&Toolbar"
         Checked         =   -1  'True
      End
      Begin Menu M_Statusbar
         Caption         =   "&Statusbar"
         Checked         =   -1  'True
      End
      Begin Menu M_FloatingToolbar
         Caption         =   "F&loating Toolbar"
         Checked         =   -1  'True
      End
   End
   Begin Menu M_Window
      Caption         =   "&Window"
      Begin Menu M_Vertical
         Caption         =   "Arrange &Vertical"
      End
      Begin Menu M_Horizontal
         Caption         =   "Arrange &Horizontal"
      End
      Begin Menu M_Icons
         Caption         =   "Arrange &Icons"
      End
      Begin Menu M_Cascade
         Caption         =   "&Cascade"
      End
      Begin Menu M_Dummy5
         Caption         =   "-"
      End
      Begin Menu M_Restore
         Caption         =   "&Restore all"
      End
      Begin Menu M_Minimize
         Caption         =   "&Minimize all"
      End
      Begin Menu M_Dummy2
         Caption         =   "-"
      End
      Begin Menu M_List
         Caption         =   "Window &List ..."
         WindowList      =   -1  'True
      End
   End
   Begin Menu M_Help
      Caption         =   "&Help"
      Begin Menu M_HelpOnHelp
         Caption         =   "&Help on Help"
      End
      Begin Menu M_Contents
         Caption         =   "&Contents"
      End
      Begin Menu M_Search
         Caption         =   "&Search ..."
      End
      Begin Menu M_Dummy3
         Caption         =   "-"
      End
      Begin Menu M_About
         Caption         =   "&About ..."
      End
   End
Sub B_Toolbar_Click (Index As Integer)
    Select Case Index
       Case 0   ' New clicked
      M_New_Click
       Case 1   ' Open clicked
      M_Open_Click
       Case 2   'save clicked
      M_SaveAs_Click
       Case 3   'Cut clicked
      M_Cut_Click
       Case 4   'Copy clicked
      M_Copy_Click
       Case 5   'Paste clicked
      M_Paste_Click
       Case 6   'Undo clicked
      M_Undo_Click
       Case 7   'Print clicked
      M_Contents_Click
       Case 8   'Help clicked
      M_Print_Click
    End Select
End Sub
Sub CheckFileMenues ()
' Checks File-Menues Print, Close, Save, Save as
' check, if there are other forms active
If Forms.Count > 1 Then  ' not the last one
   M_Close.Enabled = True
   M_Save.Enabled = True
   M_SaveAs.Enabled = True
   M_Print.Enabled = True
Else  ' can
t save or print nothing
   M_Close.Enabled = False
   M_Save.Enabled = False
   M_SaveAs.Enabled = False
   M_Print.Enabled = False
End If
End Sub
Sub M_About_Click ()
   About.Show
End Sub
Sub M_Cascade_Click ()
    Me.Arrange 0
End Sub
Sub M_Close_Click ()
   ' demonstrate closing MDIchild
    ' avoid closing the last MDIchild !!
    If Forms.Count > 1 Then
       If doit("Close " + ActiveForm.Caption) Then
      Unload ActiveForm
      CheckFileMenues
       End If
    End If
End Sub
Sub M_Color_Click ()
'Color Dialog Flags
Const CC_RGBINIT = &H1&
Const CC_FULLOPEN = &H2&
Const CC_PREVENTFULLOPEN = &H4&
Const CC_SHOWHELP = &H8&
'Set initial color selection for dialog
On Error GoTo Color_Exit
    CMDialog1.CancelError = True
    CMDialog1.Color = &HFF&
    CMDialog1.Flags = CC_RGBINIT
    'Display color dialog
    CMDialog1.Action = 3
    'Get the color
    MyColor = CMDialog1.Color
    Exit Sub
Color_Exit:
   Exit Sub
End Sub
Sub M_Contents_Click ()
Const HELP_KEY = &H101
Const HELP_INDEX = &H3
    'start Help, set HelpFile property to your file!
    CMDialog1.HelpFile = App.HelpFile ' "VB.HLP"
    'When WinHelp.exe is executed, help for a specified
    'keyword will be displayed.
    CMDialog1.HelpCommand = HELP_INDEX
    'Execute WinHelp.exe
    CMDialog1.Action = 6
End Sub
Sub M_Copy_Click ()
End Sub
Sub M_Cut_Click ()
 ' Demo of MsgBox functions
 Information ("This is a demo of the MsgBox functions")
 warning ("Warning: next box isn
t meant serious")
 critical ("Critical error - 3, 2, 1, ")
 If retry("Try again ? ") Then
    MsgBox ("Again!")
    Action ("You pressed AGAIN")
 End If
 If doit("DoIt ?") Then
    Action ("You pressed YES")
 Else
    Action ("You pressed NO")
 End If
 If YouShure("Realy DoIt ?") Then
    Action ("Boooooom ....")
 End If
End Sub
Sub M_Exit_Click ()
   End
End Sub
Sub M_FloatingToolbar_Click ()
    If M_FloatingToolbar.Checked Then
       M_FloatingToolbar.Checked = False
       FloatingToolbar.Visible = False
    Else
       M_FloatingToolbar.Checked = True
       FloatingToolbar.Visible = True
    End If
End Sub
Sub M_Font_Click ()
'Declarations Section  Choose Font Dialog Flags
Const CF_SCREENFONTS = &H1&
Const CF_PRINTERFONTS = &H2&
Const CF_BOTH = &H3&
Const CF_SHOWHELP = &H4&
Const CF_INITTOLOGFONTSTRUCT = &H40&
Const CF_USESTYLE = &H80&
Const CF_EFFECTS = &H100&
Const CF_APPLY = &H200&
Const CF_ANSIONLY = &H400&
Const CF_NOVECTORFONTS = &H800&
Const CF_NOSIMULATIONS = &H1000&
Const CF_LIMITSIZE = &H2000&
Const CF_FIXEDPITCHONLY = &H4000&
Const CF_WYSIWYG = &H8000&                        'must also have CF_SCREENFONTS & CF_PRINTERFONTS
Const CF_FORCEFONTEXIST = &H10000
Const CF_SCALABLEONLY = &H20000
Const CF_TTONLY = &H40000
Const CF_NOFACESEL = &H80000
Const CF_NOSTYLESEL = &H100000
Const CF_NOSIZESEL = &H200000
    'Set flags
On Error GoTo Font_Exit
    CMDialog1.CancelError = True
    CMDialog1.Flags = CF_BOTH Or CF_EFFECTS Or CF_LIMITSIZE
    'set initial values for the dialog
    CMDialog1.FontSize = 10
    CMDialog1.FontName = "Arial"
    CMDialog1.Min = 4    ' set min-max
    CMDialog1.Max = 40
    'display Choose Font dialog
    CMDialog1.Action = 4
    'change text font according to options selected
    MyFontname = CMDialog1.FontName
    MyFontSize = CMDialog1.FontSize
    MyFontBold = CMDialog1.FontBold
    MyFontItalic = CMDialog1.FontItalic
    MyFontUnderline = CMDialog1.FontUnderLine
    MyFontStrikethru = CMDialog1.FontStrikeThru
    MyForeColor = CMDialog1.Color
    MsgBox ("You choose " + MyFontname + Str$(MyFontSize))
    Exit Sub
Font_Exit:
   Exit Sub
End Sub
Sub M_FP_Close_Click ()
 Unload ActiveForm
End Sub
Sub M_FP_Maximize_Click ()
     ActiveForm.WindowState = 0
End Sub
Sub M_FP_Mimimize_Click ()
     ActiveForm.WindowState = 1
End Sub
Sub M_HelpOnHelp_Click ()
Const HELP_HELPONHELP = &H4        'Display help on using help
    'start Help, set HelpFile property to your file!
    CMDialog1.HelpFile = App.HelpFile ' "VB.HLP"
    CMDialog1.HelpCommand = HELP_HELPONHELP
    'Execute WinHelp.exe
    CMDialog1.Action = 6
End Sub
Sub M_Horizontal_Click ()
    Me.Arrange 1
End Sub
Sub M_Icons_Click ()
    Me.Arrange 3
End Sub
Sub M_Minimize_Click ()
   For i = 1 To Forms.Count - 1 'from 1, skip MDIform !
       If Forms(i).MDIChild = True Then
      Forms(i).WindowState = 1
       End If
   Next
End Sub
Sub M_New_Click ()
Static FormCount
' sample for MDIchild creation
Dim MyNewForm As New form1
FormCount = FormCount + 1
    MyNewForm.Caption = "Form " + Str$(FormCount)
CheckFileMenues
End Sub
Sub M_Open_Click ()
' generic File-Open Dialog
' requires COMMONDLG Control in MDI-Form !
  On Error GoTo Open_exit
    CMDialog1.CancelError = True
    CMDialog1.DialogTitle = "Open File"
    'Set filters
    CMDialog1.Filter = "My Files (*.xxx)|*.xxx|All Files (*.*)|*.*"
    CMDialog1.FilterIndex = 1
    'Display file open dialog
    CMDialog1.Action = 1
    ' your Action here :
    MyFile$ = CMDialog1.Filename
    ' simulate an open:
    Dim MyForm As New form1
    MyForm.Caption = MyFile$
    CheckFileMenues
    Exit Sub
Open_exit:
    Exit Sub
End Sub
Sub M_Paste_Click ()
End Sub
Sub M_Print_Click ()
' generic Print Dialog
' requires COMMONDLG Control in MDI-Form !
'Printer Dialog Flags
Const PD_ALLPAGES = &H0&
Const PD_SELECTION = &H1&
Const PD_PAGENUMS = &H2&
Const PD_NOSELECTION = &H4&
Const PD_NOPAGENUMS = &H8&
Const PD_COLLATE = &H10&
Const PD_PRINTTOFILE = &H20&
Const PD_PRINTSETUP = &H40&
Const PD_NOWARNING = &H80&
Const PD_RETURNDC = &H100&
Const PD_RETURNIC = &H200&
Const PD_RETURNDEFAULT = &H400&
Const PD_SHOWHELP = &H800&
Const PD_USEDEVMODECOPIES = &H40000
Const PD_DISABLEPRINTTOFILE = &H80000
Const PD_HIDEPRINTTOFILE = &H100000
  On Error GoTo Print_exit
    CMDialog1.CancelError = True
    CMDialog1.PrinterDefault = True 'Settings are permanent
    CMDialog1.Flags = PD_ALLPAGES
    'set Flags to your convenience
    ' CMDialog1.Flags = PD_DISABLEPRINTTOFILE
    ' CMDialog1.Flags = PD_NOSELECTION Or PD_NOPAGENUMS
  ' Set pages
    CMDialog1.FromPage = 1
    CMDialog1.Min = 1
    CMDialog1.ToPage = 1
    CMDialog1.Max = 10     ' your maximimun No. pages here !
  ' set Copies
    CMDialog1.Copies = 1
    'Display Print dialog
    CMDialog1.Action = 5
    ' read back values
    MyCopies% = CMDialog1.Copies
    MyFrom% = CMDialog1.FromPage
    MyTo% = CMDialog1.ToPage
    ' your Action here :
    ' evaluate Flags:
    If CMDialog1.Flags And &H20 Then
       MsgBox ("Print to file")
    End If
    If CMDialog1.Flags And &H2 Then
    MsgBox ("Pages " + Str$(MyFrom%) + " to " + Str$(MyTo%))
    Else
    If CMDialog1.Flags And &H1 Then
       MsgBox ("Selection")
    Else
       MsgBox ("All Pages")
    End If
    End If
    If CMDialog1.Flags And PD_COLLATE Then
    MsgBox ("collate Pages ")
    End If

    Exit Sub
Print_exit:
    Exit Sub
End Sub
Sub M_PrinterSetup_Click ()
Const PD_PRINTSETUP = &H40&
  On Error GoTo PrintSetup_Exit
    CMDialog1.CancelError = True
    CMDialog1.PrinterDefault = True 'Settings are permanent
    CMDialog1.Flags = PD_PRINTSETUP
    'Display Print dialog
    CMDialog1.Action = 5
    Exit Sub
PrintSetup_Exit:
  Exit Sub
End Sub
Sub M_Restore_Click ()
   For i = 1 To Forms.Count - 1
       If Forms(i).MDIChild = True Then
      Forms(i).WindowState = 0
       End If
   Next
End Sub
Sub M_SaveAs_Click ()
' generic File-Open Dialog
' requires COMMONDLG Control in MDI-Form !
  On Error GoTo SaveAs_exit
    CMDialog1.CancelError = True
    CMDialog1.DialogTitle = "Save File as"
    ' set default name
    CMDialog1.Filename = "default.xxx"
   'Set filters
    CMDialog1.Filter = "My Files (*.xxx)|*.xxx"
    CMDialog1.FilterIndex = 1
    'Display file save dialog
    CMDialog1.Action = 2
    ' your Action here :
    MyFile$ = CMDialog1.Filename
    Exit Sub
SaveAs_exit:
    Exit Sub
End Sub
Sub M_Search_Click ()
' show specific Help
Const HELP_KEY = &H101
    'start Help, set HelpFile property to your file!
    CMDialog1.HelpFile = App.HelpFile '"VB.HLP"
    'Specify the keyword
    CMDialog1.HelpKey = "MouseDown" ' your Keyword here
    'keyword will be displayed.
    CMDialog1.HelpCommand = HELP_KEY
    'Execute WinHelp.exe
    CMDialog1.Action = 6
End Sub
Sub M_Statusbar_Click ()
    If M_Statusbar.Checked Then
       Statusbar.Visible = False
       M_Statusbar.Checked = False
       ' Resize your Window !
    Else
       Statusbar.Visible = True
       M_Statusbar.Checked = True
       ' Resize your Window !
    End If
End Sub
Sub M_Toolbar_Click ()
    If M_Toolbar.Checked Then
       Toolbar.Visible = False
       M_Toolbar.Checked = False
       ' Resize your Window !
    Else
       Toolbar.Visible = True
       M_Toolbar.Checked = True
       ' Resize your Window !
    End If
End Sub
Sub M_Undo_Click ()
End Sub
Sub M_Vertical_Click ()
    Me.Arrange 2
End Sub
Sub MDIForm_Load ()
On Error GoTo GenericErrorHandler ' set default error handler

     ' Set the Title
     MdiForm1.Caption = App.Title
     ' set About-Menu
     M_About.Caption = "About " + App.Title + " ..."
     ' Set your Helpfile here:
     ' App.HelpFile = "VB.HLP" ' enter your file here
     Exit Sub
GenericErrorHandler:

     warning ("Critical error " + Error$)
     If doit("Try to continue ?") Then
    Resume Next
     Else
     End If
End Sub
Sub MDIForm_QueryUnload (Cancel As Integer, UnloadMode As Integer)
    If Not doit("Exit " + App.Title + " ?") Then
       Cancel = 1
    End If
End Sub
Sub MDIForm_Resize ()
 ' size the Statusline
   Me.StatusLine.Width = Me.Width - 3 * Me.StatusLine.Left
  ' check, if Floating toolbar is visible, on minimize, hide toolbar
   If Me.WindowState = 1 Then
      FloatingToolbar.Visible = False
   Else
      FloatingToolbar.Visible = M_FloatingToolbar.Checked
   End If
End Sub