home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Programming Tool Box
/
SIMS_2.iso
/
vb_code2
/
vbmdixpl
/
mdiform1.frm
< prev
next >
Wrap
Text File
|
1993-05-17
|
20KB
|
796 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
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
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