PC World Komputer 1999 January

home *** CD-ROM | disk | FTP | other *** search

/ PC World Komputer 1999 January / pcwk_01_1999.iso / Wtestowe / Vistdstd / Install / Data.Z / Mainwnd.FRM (.txt) < prev next >

Wrap

Visual Basic Form | 1996-10-31 | 20.5 KB | 520 lines

VERSION 4.00 Begin VB.Form frmMainWindow Appearance = 0 'Flat BackColor = &H00C0C0C0& BorderStyle = 1 'Fixed Single Caption = "Visio Inventory" ClientHeight = 6000 ClientLeft = 3330 ClientTop = 3720 ClientWidth = 8535 BeginProperty Font name = "MS Sans Serif" charset = 0 weight = 700 size = 8.25 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty ForeColor = &H80000008& Height = 6690 Icon = "MAINWND.frx":0000 Left = 3270 LinkTopic = "Form2" MaxButton = 0 'False ScaleHeight = 6000 ScaleWidth = 8535 Top = 3090 Width = 8655 Begin Threed.SSPanel ctlStatusLine Align = 2 'Align Bottom Height = 375 Left = 0 TabIndex = 2 Top = 5625 Width = 8535 _Version = 65536 _ExtentX = 15055 _ExtentY = 661 _StockProps = 15 Caption = "Ready" BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty BevelInner = 1 RoundedCorners = 0 'False Font3D = 3 Alignment = 1 End Begin VB.ComboBox ctlPageList Appearance = 0 'Flat Height = 300 Left = 1260 Style = 2 'Dropdown List TabIndex = 4 Top = 480 Width = 2715 End Begin VB.ComboBox ctlDocList Appearance = 0 'Flat Height = 300 Left = 1260 Style = 2 'Dropdown List TabIndex = 3 Top = 120 Width = 2715 End Begin VB.ComboBox ctlSortField Appearance = 0 'Flat Height = 300 Left = 1260 Style = 2 'Dropdown List TabIndex = 1 Top = 840 Width = 2715 End Begin Threed.SSPanel Panel3D1 Height = 5655 Left = 0 TabIndex = 5 Top = 0 Width = 8535 _Version = 65536 _ExtentX = 15055 _ExtentY = 9975 _StockProps = 15 BevelInner = 1 Begin MSGrid.Grid ctlQueryGrid Height = 4275 Left = 120 TabIndex = 0 Top = 1200 Width = 8235 _Version = 65536 _ExtentX = 14526 _ExtentY = 7541 _StockProps = 77 BackColor = -2147483643 Cols = 9 FixedCols = 0 End Begin Threed.SSCommand btnReQuery Height = 1035 Left = 6780 TabIndex = 10 Top = 120 Width = 1575 _Version = 65536 _ExtentX = 2778 _ExtentY = 1826 _StockProps = 78 Caption = "ReQuery Visio" Picture = "MAINWND.frx":030A End Begin Threed.SSCommand btnChooseFields Height = 1035 Left = 5100 TabIndex = 9 Top = 120 Width = 1575 _Version = 65536 _ExtentX = 2778 _ExtentY = 1826 _StockProps = 78 Caption = "Choose Fields" Picture = "MAINWND.frx":0624 End Begin VB.Label Label3 Alignment = 1 'Right Justify Appearance = 0 'Flat BackColor = &H00C0C0C0& Caption = "Sort Field:" ForeColor = &H80000008& Height = 195 Left = 300 TabIndex = 7 Top = 900 Width = 915 End Begin VB.Label Label2 Alignment = 1 'Right Justify Appearance = 0 'Flat BackColor = &H00C0C0C0& Caption = "Page:" ForeColor = &H80000008& Height = 195 Left = 420 TabIndex = 8 Top = 540 Width = 795 End Begin VB.Label Label1 Alignment = 1 'Right Justify Appearance = 0 'Flat BackColor = &H00C0C0C0& Caption = "Document:" ForeColor = &H80000008& Height = 195 Left = 180 TabIndex = 6 Top = 180 Width = 1035 End Begin VB.Shape Shape1 BackColor = &H00000000& BackStyle = 1 'Opaque Height = 4275 Left = 180 Top = 1260 Width = 8235 End End Begin VB.Menu FileMenu Caption = "&File" Begin VB.Menu FileExport Caption = "&Export" Shortcut = ^S End Begin VB.Menu FileSep Caption = "-" End Begin VB.Menu FilePrint Caption = "&Print" Enabled = 0 'False End Begin VB.Menu FilePrinterSetup Caption = "Pri&nter Setup" Enabled = 0 'False End Begin VB.Menu FilePageSetup Caption = "Page Se&tup" Enabled = 0 'False End Begin VB.Menu FileSep2 Caption = "-" End Begin VB.Menu FileExit Caption = "E&xit" End End Begin VB.Menu EditMenu Caption = "&Edit" Begin VB.Menu EditCopy Caption = "&Copy" Enabled = 0 'False Shortcut = ^{INSERT} End Begin VB.Menu EditSep1 Caption = "-" End Begin VB.Menu EditSelectAll Caption = "&Select All" End End Begin VB.Menu OptionsMenu Caption = "&Options" Begin VB.Menu ExportSetup Caption = "E&xport Setup" End End Begin VB.Menu HelpMenu Caption = "&Help" Begin VB.Menu HelpContents Caption = "&Contents" Enabled = 0 'False Shortcut = {F1} End Begin VB.Menu HelpSearch Caption = "&Search For Help On" Enabled = 0 'False End Begin VB.Menu HelpSep Caption = "-" End Begin VB.Menu HelpAbout Caption = "&About" End End Attribute VB_Name = "frmMainWindow" Attribute VB_Creatable = False Attribute VB_Exposed = False ' ----------------------------------------------------------------------------- ' Copyright (C) 1993-1996 Visio Corporation. All rights reserved. ' You have a royalty-free right to use, modify, reproduce and distribute ' the Sample Application Files (and/or any modified version) in any way ' you find useful, provided that you agree that Visio has no warranty, ' obligations or liability for any Sample Application Files. ' ----------------------------------------------------------------------------- Option Explicit '-- All Variable Explicit Dim iSortIndex As Integer '-- Sort Field Index Dim iPageIndex As Integer '-- Current Page Index Dim iDocIndex As Integer '-- Current Document Index Private Sub btnChooseFields_Click() '------------------------------------ '--- btnChooseFields_Click ---------- '-- When the Choose Fields is chosen we load the Choose Fields form. After '-- It's done we re-paint the query grid to take into account any changes made. frmChooseFields.Show 1 If Not GetIncludeFlag(iSortIndex) Then iSortIndex = 0 End If UpdateFieldsList RePaint End Sub Private Sub btnReQuery_Click() '------------------------------------ '--- btnReQuery_Click --------------- '-- When the user presses this button we just want to requery the database. UpdateDatabase End Sub Private Sub ctlDocList_Click() '------------------------------------ '--- ctlDocList_Click --------------- '-- When the user clicks a document name we check to see if it's different '-- than our internal index iDocIndex. If so we update the page list and the '-- internal index. If iDocIndex <> ctlDocList.ListIndex Then '-- If Different Indexes... iDocIndex = ctlDocList.ListIndex '-- Update Internal Index Call UpdatePageList '-- Update Page List End If End Sub Private Sub ctlPageList_Click() '------------------------------------ '--- ctlDocList_Change -------------- '-- When the user clicks a page name we check to see if it's different '-- than our internal index iPageIndex. If so we requery the database and '-- size the columns. If iPageIndex <> ctlPageList.ListIndex Then iPageIndex = ctlPageList.ListIndex '-- Update Page Index ReQuery CurDocIndex(), CurPageIndex() RePaint End If End Sub Private Sub ctlQueryGrid_SelChange() '------------------------------------ '--- ctlQueryGrid_SelChange --------- If (ctlQueryGrid.SelEndCol >= ctlQueryGrid.SelStartCol) Then If (ctlQueryGrid.SelEndRow >= ctlQueryGrid.SelStartRow) Then EditCopy.Enabled = True Exit Sub End If End If EditCopy.Enabled = False End Sub Private Sub ctlSortField_Click() '------------------------------------ '--- cstSortField_Click ------------- '-- When the user clicks a sort field name we check to see if it's different '-- than our internal index iSortIndex. If so we process the change and update '-- the internal index. If iSortIndex <> ctlSortField.ListIndex Then iSortIndex = ctlSortField.ListIndex SetSort iSortIndex RePaint End If End Sub Private Function CurDocIndex() As Integer '------------------------------------ '--- CurDocIndex -------------------- '-- Simply returns the collection index of the current document. Note, it '-- returns the collection index, not the control index. Dim iIndex As Integer iIndex = ctlDocList.ListIndex CurDocIndex = GetCollIndex(iIndex) End Function Private Function CurPageIndex() As Integer '------------------------------------ '--- CurPageIndex ------------------- '-- Simply returns the index of the current page. However, it returns the '-- collection index, not the page controls index. CurPageIndex = ctlPageList.ListIndex + 1 '-- Return Index End Function Private Sub EditCopy_Click() '------------------------------------ '--- EditCopy_Click ----------------- '-- Copies the highlighted selection on the grid to the clipboard. Dim iRow As Integer, iCol As Integer, Temp As String Dim iOldRow As Integer, iOldCol As Integer Dim sFieldSep As String sFieldSep = g_FieldSeps(g_iFieldSepIdx) iOldRow = ctlQueryGrid.Row '-- Save Last Row And Column iOldCol = ctlQueryGrid.Col If g_bIncFieldNames Then '-- Include Field Names ctlQueryGrid.Row = 0 '-- Move To Field Row For iCol = ctlQueryGrid.SelStartCol To ctlQueryGrid.SelEndCol ctlQueryGrid.Col = iCol If iCol <> ctlQueryGrid.SelStartCol Then Temp = Temp + sFieldSep End If Temp = Temp + ApplyTextDel(ctlQueryGrid.Text) Next iCol Temp = Temp + Chr$(13) + Chr$(10) '-- Append CR/LF End If For iRow = ctlQueryGrid.SelStartRow To ctlQueryGrid.SelEndRow ctlQueryGrid.Row = iRow For iCol = ctlQueryGrid.SelStartCol To ctlQueryGrid.SelEndCol ctlQueryGrid.Col = iCol If iCol <> ctlQueryGrid.SelStartCol Then Temp = Temp + sFieldSep End If Temp = Temp + ApplyTextDel(ctlQueryGrid.Text) Next iCol Temp = Temp + Chr$(13) + Chr$(10) '-- Append CR/LF Next iRow ctlQueryGrid.Row = iOldRow '-- Restore Last Row And Column ctlQueryGrid.Col = iOldCol Clipboard.Clear '-- Clear Clipboard Contents Clipboard.SetText Temp '-- Put Text On Clipboard End Sub Private Sub EditSelectAll_Click() '------------------------------------ '--- EditSelectAll_Click ------------ '-- Selects all data on the grid. ctlQueryGrid.SelStartCol = ctlQueryGrid.FixedCols ctlQueryGrid.SelStartRow = ctlQueryGrid.FixedRows ctlQueryGrid.SelEndCol = ctlQueryGrid.Cols - 1 ctlQueryGrid.SelEndRow = ctlQueryGrid.Rows - 1 End Sub Private Sub ExportSetup_Click() '------------------------------------ '--- ExportSetup_Click -------------- '-- Displays the export setup dialog. frmExportSetup.Show 1 End Sub Private Sub FileExit_Click() '------------------------------------ '--- FileExit_Click ----------------- '-- When the user chooses to quit we unload the main form and end. Unload frmMainWindow '-- Unload Main Frame End '-- End Program End Sub Private Sub FileExport_Click() '------------------------------------ '--- FileExport_Click --------------- On Error GoTo ExportErrHandler Dim Temp As String Const OFN_HIDEREADONLY = &H4& Const OFN_OVERWRITEPROMPT = &H2& frmSaveAs.CMDialog1.CancelError = True frmSaveAs.CMDialog1.Flags = OFN_HIDEREADONLY Or OFN_OVERWRITEPROMPT frmSaveAs.CMDialog1.Action = 2 Temp = frmSaveAs.CMDialog1.filename ExportToFile Temp Exit Sub ExportErrHandler: Exit Sub Resume Next End Sub Private Sub Form_Activate() '------------------------------------ '--- frmMainWindow:Form_Activate ---- '-- When the window is activated we always update the database in case the '-- user has made any changes in Visio. Need to add a flag to not update after '-- internal form changes. 'Remmed by TDS - must check for internal activates (i.e. About form unloaded) 'UpdateDatabase '-- Update Database Lists End Sub Private Sub Form_Load() '------------------------------------ '--- frmMainWindow:Form_Load -------- '-- Handles application initialization. All we do at first is update the '-- field list. The document and page lists should be handled by the window '-- Activate event. iSortIndex = 0 '-- Default To Name Sort iDocIndex = -1 '-- Default To No Doc iPageIndex = -1 '-- Default To No Page EditCopy.Enabled = False '-- Disable Copy Option InitExportOptions '-- Initialize Export Vars UpdateFieldsList '-- Update Sort Field List End Sub Private Sub Form_Unload(Cancel As Integer) End End Sub Private Sub HelpAbout_Click() frmAboutDialog.Show 1 '-- Show Help About End Sub Private Sub UpdateDatabase() '------------------------------------ '--- UpdateDatabase ----------------- '-- Updates the internal database of valid Visio document which are loaded. '-- Should be called whenever the focus is set or application is activated to '-- make sure the controls reflect Visio's open documents. Only call '-- UpdateDocList because it's click event updates the page list anyways. StatusLineMsg "Querying Visio Documents..." UpdateValidDocList '-- Update Valid Documents StatusLineMsg "Updating Document List..." UpdateDocList '-- Update Document List Box ClearStatusLine End Sub Private Sub UpdateDocList() '------------------------------------ '--- UpdateDocList ------------------ '-- Handles updating the document drop down list on the main form. Uses the '-- Valid Document Interface for retrieving document names. By setting '-- the list box index we guarantee a Click event will occur and iDocIndex '-- to be updated by the boxes Click handler. When this happens it chains '-- down to the page list as well. Dim I As Integer iDocIndex = -1 '-- Force ReQuery ctlDocList.Clear '-- Clear Document List StatusLineMsg "Updating Document List..." '-- Update Status Line If DocCount() > 0 Then '-- Any Documents... For I = 0 To DocCount() - 1 '-- Loop Through Docs... ctlDocList.AddItem StripPath(GetDocName(I)) '-- Add Name Next I ctlDocList.ListIndex = 0 '-- Select First Document '-- And Get Else ctlDocList.ListIndex = -1 '-- No Doc Selected End If ClearStatusLine '-- Clear Status Line End Sub Private Sub UpdateFieldsList() '------------------------------------ '--- UpdateFieldsList --------------- '-- Fills in the main form's Sort Field list box. Dim I As Integer ctlSortField.Clear '-- Clear List For I = 0 To IncludeCount() - 1 '-- Loop Through Used Fields... ctlSortField.AddItem IncludeNames(I) '-- Add Next Field Name Next I ctlSortField.ListIndex = 0 '-- Select First Field End Sub Private Sub UpdatePageList() '------------------------------------ '--- UpdatePageList ----------------- '-- Updates the page drop down list names. Uses the Valid Document Interface '-- to retrieve the current document. By setting the page index to -1 we force '-- a requery when the list box's Click handler gets called. Dim I As Integer, iPageCount As Integer, iCurDoc As Integer Dim pagsPageList As Visio.Pages, docCurDoc As Visio.DOCUMENT iPageIndex = -1 '-- Force ReQuery ctlPageList.Clear '-- Clear Page List iCurDoc = ctlDocList.ListIndex '-- Get Current Doc Index If iCurDoc = -1 Then Exit Sub '-- If No Document Exit StatusLineMsg "Updating Page List..." '-- Updating Page List iCurDoc = GetCollIndex(iCurDoc) '-- Get Collection Index AppConnect Set docCurDoc = g_appVisio.Documents(iCurDoc) '-- Get Current Document iPageCount = docCurDoc.Pages.Count '-- Get Page Count If iPageCount > 0 Then '-- Any Documents.... Set pagsPageList = docCurDoc.Pages '-- Get Page List For I = 1 To iPageCount '-- Loop Through Pages... ctlPageList.AddItem pagsPageList(I).Name '-- Add Name Next I ctlPageList.ListIndex = 0 '-- Set To Active Doc Else ctlPageList.ListIndex = -1 '-- No Selection End If ClearStatusLine '-- Clear Status Line End Sub