PC Pro 1999 January

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

/ PC Pro 1999 January / dppcpro0199a.iso / January / Fp98 / SDK / Wizards / Webs / Realest.wiz / Realest.frm (.txt) < prev next >

Wrap

Visual Basic Form | 1997-09-18 | 29.8 KB | 870 lines

VERSION 5.00 Begin VB.Form realest BorderStyle = 3 'Fixed Dialog Caption = "Real Estate Web Wizard" ClientHeight = 8715 ClientLeft = 1200 ClientTop = 1545 ClientWidth = 12090 ForeColor = &H80000008& Icon = "realest.frx":0000 LinkTopic = "Form1" MaxButton = 0 'False MinButton = 0 'False PaletteMode = 1 'UseZOrder ScaleHeight = 8715 ScaleWidth = 12090 ShowInTaskbar = 0 'False Begin VB.PictureBox pg BackColor = &H00C0C0C0& BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 3810 Index = 3 Left = 5040 ScaleHeight = 3750 ScaleWidth = 4455 TabIndex = 14 Tag = "0" Top = 4740 Visible = 0 'False Width = 4515 Begin VB.TextBox txtEmailAddress Height = 285 Left = 675 TabIndex = 18 Top = 1515 Width = 3555 End Begin VB.TextBox txtCompanyName Height = 285 Left = 660 TabIndex = 16 Top = 885 Width = 3555 End Begin VB.Label Label11 Appearance = 0 'Flat BackColor = &H80000005& BackStyle = 0 'Transparent Caption = "Email Address" ForeColor = &H80000008& Height = 195 Left = 675 TabIndex = 11 Top = 1275 Width = 3555 End Begin VB.Label Label10 Appearance = 0 'Flat BackColor = &H00000000& BackStyle = 0 'Transparent Caption = "Company Name" ForeColor = &H80000008& Height = 195 Left = 660 TabIndex = 17 Top = 645 Width = 3555 End Begin VB.Label Label8 Appearance = 0 'Flat BackColor = &H80000005& BackStyle = 0 'Transparent Caption = "Test for web meta-info variables that will be used by Substitution Bots:" ForeColor = &H80000008& Height = 675 Left = 0 TabIndex = 15 Top = 0 Width = 4485 End End Begin VB.PictureBox pg BackColor = &H00C0C0C0& BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 3810 Index = 2 Left = 360 ScaleHeight = 3750 ScaleWidth = 4455 TabIndex = 12 Tag = "0" Top = 4800 Visible = 0 'False Width = 4515 Begin VB.OptionButton optThree Caption = "Option Three" Height = 255 Left = 480 TabIndex = 25 Top = 1680 Width = 3135 End Begin VB.OptionButton optTwo Caption = "Option Two" Height = 255 Left = 480 TabIndex = 24 Top = 1320 Width = 3135 End Begin VB.OptionButton optOne Caption = "Option One" Height = 255 Left = 480 TabIndex = 23 Top = 960 Width = 3135 End Begin VB.Label Label9 Appearance = 0 'Flat BackColor = &H80000005& BackStyle = 0 'Transparent Caption = "This is a test to see how radio buttons behave when INI file settings are restored ..." ForeColor = &H80000008& Height = 675 Left = 0 TabIndex = 13 Top = 0 Width = 4485 End End Begin VB.PictureBox pg BackColor = &H00C0C0C0& BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 3810 Index = 1 Left = 7320 ScaleHeight = 3750 ScaleWidth = 4455 TabIndex = 9 Tag = "0" Top = 165 Visible = 0 'False Width = 4515 Begin VB.CheckBox chkQuestions Caption = "Real Estate Q&&A Feature" Height = 255 Left = 480 TabIndex = 22 Top = 1440 Width = 3075 End Begin VB.CheckBox chkMortgage Caption = "Mortgage Affordability Guide" Height = 255 Left = 480 TabIndex = 21 Top = 1140 Width = 3735 End Begin VB.CheckBox chkRealtors Caption = "Index of Local Realtors" Height = 255 Left = 480 TabIndex = 20 Top = 840 Width = 3615 End Begin VB.CheckBox chkImprove Caption = "Home Improvement" Height = 255 Left = 480 TabIndex = 19 Top = 540 Width = 3735 End Begin VB.Label Label3 Appearance = 0 'Flat BackColor = &H80000005& BackStyle = 0 'Transparent Caption = "Select the main topical areas you want to include in your web:" ForeColor = &H80000008& Height = 495 Left = 0 TabIndex = 10 Top = 0 Width = 4485 End End Begin VB.PictureBox pg BackColor = &H00C0C0C0& BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 3810 Index = 0 Left = 2580 ScaleHeight = 3750 ScaleWidth = 4455 TabIndex = 6 Tag = "0" Top = 165 Visible = 0 'False Width = 4515 Begin VB.Label Label2 Appearance = 0 'Flat BackColor = &H80000005& BackStyle = 0 'Transparent Caption = $"realest.frx":030A ForeColor = &H80000008& Height = 1035 Left = 0 TabIndex = 7 Top = 540 Width = 4485 End Begin VB.Label Label1 Appearance = 0 'Flat BackColor = &H80000005& BackStyle = 0 'Transparent Caption = "This wizard will generate a sample web framework for presenting information about Real Estate." ForeColor = &H80000008& Height = 495 Left = 0 TabIndex = 8 Top = 0 Width = 4485 End End Begin VB.CommandButton btnFinish Appearance = 0 'Flat BackColor = &H80000005& Caption = "Finish" Enabled = 0 'False Height = 375 Left = 6180 TabIndex = 5 TabStop = 0 'False Top = 4080 Width = 915 End Begin VB.CommandButton btnNext Appearance = 0 'Flat BackColor = &H80000005& Caption = "Next >" Height = 375 Left = 4860 TabIndex = 4 TabStop = 0 'False Top = 4080 Width = 915 End Begin VB.CommandButton btnBack Appearance = 0 'Flat BackColor = &H80000005& Caption = "< Back" Enabled = 0 'False Height = 375 Left = 3960 TabIndex = 3 TabStop = 0 'False Top = 4080 Width = 915 End Begin VB.CommandButton btnCancel Appearance = 0 'Flat BackColor = &H80000005& Caption = "Cancel" Height = 375 Left = 2640 TabIndex = 2 TabStop = 0 'False Top = 4080 Width = 915 End Begin VB.CommandButton btnHelp Appearance = 0 'Flat BackColor = &H80000005& Caption = "Help" Height = 375 Left = 180 TabIndex = 1 TabStop = 0 'False Top = 4080 Width = 915 End Begin VB.PictureBox pnlLeft BackColor = &H00C0C0C0& BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 3795 Left = 180 ScaleHeight = 3735 ScaleWidth = 2235 TabIndex = 0 Top = 180 Width = 2295 Begin VB.Image imgMain Appearance = 0 'Flat Height = 3255 Left = 120 Picture = "realest.frx":03FC Stretch = -1 'True Top = 120 Width = 2055 End End Begin VB.Image img Appearance = 0 'Flat Height = 735 Index = 0 Left = 11175 Picture = "realest.frx":E1BE Stretch = -1 'True Top = 4110 Width = 735 End Begin VB.Image img Appearance = 0 'Flat Height = 735 Index = 1 Left = 11190 Picture = "realest.frx":1BF80 Stretch = -1 'True Top = 4950 Width = 795 End Attribute VB_Name = "realest" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False ' ------------------------------------------------------------------- ' File: REALEST.FRM ' Copyright (c) 1995 Vermeer Technologies, Inc. All rights reserved. ' ------------------------------------------------------------------- Option Explicit ' page management variables Dim PageNum As Integer Dim PageMax As Integer ' OLE automation objects Dim webber As Object Dim todo As Object Private Sub btnBack_Click() If PageNum > 0 Then GoToPage PageNum - 1 End If End Sub Private Sub btnCancel_Click() Dim msg As String msg = "If you quit now, the web will not be created," msg = msg & Chr$(10) & "but all wizard settings will be saved." msg = msg & Chr$(10) & "Quit anyway?" If MsgBox(msg, 48 + 4, "Confirm Cancel") = 7 Then ' user says NO Exit Sub End If Unload Me End Sub Private Sub btnCurrent_Click() End Sub Private Sub btnFinish_Click() If Not ValidatePage(PageNum) Then Exit Sub End If Me.Hide DoEvents GenerateWeb ' GenerateWeb should finish, but in case ' somebody forgets to unload us, take care ' of it here Unload Me End Sub Private Sub btnHelp_Click() ' if you need help, invoke it here; ' else get rid of the button MsgBox "Help is not available in this wizard.", 48 End Sub Private Sub btnNext_Click() If PageNum < PageMax Then GoToPage PageNum + 1 End If End Sub Private Sub btnUpdate_Click() Load Realtors CenterFormOnScreen Realtors Realtors.Show 1 End Sub Private Sub ChangePicture(pgnum As Integer) ' load picture appropriate for this page; ' don't load from disk if you don't have to Select Case pgnum Case 1: ' web location input imgMain.Picture = img(1).Picture Case Else ' default image imgMain.Picture = img(0).Picture End Select End Sub Private Sub Form_Load() Dim titleH As Integer Dim i As Integer Dim msg As String Dim obj As String GetFrontPageInfo GetWizardInfo ' IMPORTANT: have to set the highest page number index manually PageMax = 3 ' fetch any previous settings from INI file LoadSettings ' set any initial values on pages InitPages ' shrink-wrap form around controls ' (allows form to be much larger in design mode); ' this part will vary depending on your control ' names and layout titleH = Me.Height - Me.ScaleHeight ' with and without border Me.Width = pg(0).Left + pg(0).Width + pnlLeft.Left Me.Height = titleH + btnHelp.Top + btnHelp.Height + pnlLeft.Left ' since a wizard is supposed to work like a dialog, ' make it centered like a dialog CenterFormOnScreen Me ' initialize page meter control ' meter.value = 0 ' meter.Min = 0 ' meter.Max = PageMax ' set all pages to be same size and location ' (allows them to be spread all over large form in design mode) For i = 0 To PageMax pg(i).Left = pg(0).Left pg(i).Top = pg(0).Top pg(i).Width = pg(0).Width pg(i).Height = pg(0).Height Next i ' set initial conditions and show first page PageNum = -1 GoToPage 0 Exit Sub End Sub Private Sub Form_Unload(Cancel As Integer) ' write current attributes out to INI file SaveSettings End End Sub Private Function GenerateFile(webfile As String, outfile As String) As Integer ' create requested HTML files by calling ' a separate subroutine for each file and ' passing it the name of the temporary file ' where output should go Select Case webfile Case "inc.htm" GenInc outfile GenerateFile = True ' indicate success Case "index.htm" GenIndex outfile GenerateFile = True ' indicate success Case "improve.htm" GenImprove outfile GenerateFile = True ' indicate success Case "realtors.htm" GenRealtors outfile GenerateFile = True ' indicate success Case "mortgage.htm" GenMortgage outfile GenerateFile = True ' indicate success Case "question.htm" GenQuestion outfile GenerateFile = True ' indicate success Case Else ' no match GenerateFile = False ' indicate failure End Select End Function Private Sub GenerateWeb() ' replace this routine with your own version; ' it should generate the HTML pages one-by-one ' in the system-dependent temp directory ' and upload the files to the web server Dim i As Integer Dim tempfile As String Dim curfile As String Dim retval As Long Dim wizname As String Dim wizversion As String Dim tmp As String Dim done As Integer Dim FileList As String Dim URLList As String Dim webURL As String ' put up the hourglass Screen.MousePointer = 11 Set webber = CreateObject(FrontPageExplorerID) webURL = webber.vtiGetWebURL If Len(webURL) = 0 Then MsgBox "The FrontPage Explorer does not have a web open.", vbExclamation Set webber = Nothing Exit Sub End If Set todo = CreateObject(FrontPageToDoListID) ' set tool name for document upload wizname = "Real Estate Web Wizard" wizversion = "0.1" InitFiles ' establish a clean slate for upload list InitMetaVars ' establish a clean slate for meta-info variables ' ----------- ' construct list of required meta-info vars ' ----------- AddMetaVar "CompanyName", CStr(txtCompanyName.text) AddMetaVar "EmailAddress", CStr(txtEmailAddress.text) ' ----------- ' construct list of files to be uploaded ' ----------- ' (AddFile takes name of file as first arg, ' and whether or not file is generated dynamically ' as second arg) ' first add any pre-existing files (such as images) AddFile "masthead.gif", False, "masthead image" ' then add any INCLUDED files (for IncludeBots) ' *BEFORE* the files which will "include" them AddFile "inc.htm", True, "page footer" ' finally any files that must be generated AddFile "index.htm", True, "home page" ' default home page is *REQUIRED* If chkImprove.value Then AddFile "improve.htm", True, "home improvement guide" If chkRealtors.value Then AddFile "realtors.htm", True, "index of Realtors" If chkMortgage.value Then AddFile "mortgage.htm", True, "mortgage guide" If chkQuestions.value Then AddFile "question.htm", True, "answers to common questions" done = nfiles - 1 ' ----------- ' upload any web meta-info variables ' ----------- tmp = PackMetaInfoVars() If tmp <> "" Then retval = webber.vtiPutWebMetaInfo(tmp) If retval <> 1 Then ' failure Set webber = Nothing Set todo = Nothing MsgBox "Warning: " & Chr$(10) & "Wizard failed PutWebMetaInfo call." Exit Sub End If End If ' ----------- ' loop through list of files, generating files and creating upload lists ' ----------- FileList = "" URLList = "" For i = 0 To done If Files(i).IsNew Then ' create temp file where output will go Files(i).path = TempFileName() If Not GenerateFile(Files(i).Name, Files(i).path) Then MsgBox "Couldn't generate file: '" & Files(i).Name & "'." Files(i).path = "" ' couldn't create file End If Else ' generate full path to file Files(i).path = App.path & "\" & Files(i).Name End If If Files(i).path <> "" Then ' TODO: images should go in /images web dir FileList = FileList & Files(i).path URLList = URLList & Files(i).Name ' item separator is newline char FileList = FileList & Chr$(10) URLList = URLList & Chr$(10) End If Next i ' perform upload retval = webber.vtiPutDocuments(FileList, URLList) If retval = 0 Then ' failed MsgBox "Unable to load documents into web." End If ' ----------- ' refresh Explorer's views ' ----------- webber.vtiRefreshWebFromServer ' ----------- ' add any items for To Do List ' ----------- todo.vtiAddTask "Customize home page", 1, wizname, "index.htm", "", "Add local content to reinforce unique identity." ' ----------- ' remove any temp files ' ----------- For i = 0 To done If Files(i).IsNew And Files(i).path <> "" Then Kill Files(i).path End If Next i ' ----------- ' all done ' ----------- Set webber = Nothing Set todo = Nothing ' take down the hourglass Screen.MousePointer = 0 ' all done Unload Me End Sub Private Sub GenImprove(outfile As String) Dim f As Integer ' file number Dim tmp As String ' temporary string f = OpenFile(outfile) OpenDocument f, "Home Improvement Page" WriteImage f, "masthead.gif", "Masthead Image", "", False WriteBreak f WriteHeading f, 1, "Home Improvement Page" WriteRule f WriteParagraph f, "This page has a lot of info about home improvement." CreateIncludeBot tmp, "inc.htm" WriteText f, tmp, False CloseDocument f CloseFile f End Sub Private Sub GenInc(outfile As String) Dim f As Integer ' file number Dim tmp As String ' temporary string Dim bot As String f = OpenFile(outfile) OpenDocument f, "Included page footer" WriteRule f CreateMacroBot bot, "CompanyName" tmp = "<H5>Copyright 1995 " & bot & "<BR>" CreateMacroBot bot, "EmailAddress" tmp = tmp & "For more information contact " & bot & "." WriteHeading f, 5, tmp CloseDocument f CloseFile f End Sub Private Sub GenIndex(outfile As String) Dim f As Integer ' file number Dim tmp As String ' temporary string f = OpenFile(outfile) OpenDocument f, "Real Estate Home Page" WriteImage f, "masthead.gif", "Masthead Image", "", False WriteBreak f WriteHeading f, 1, "Real Estate Home Page" WriteRule f WriteParagraph f, "Welcome to the <I>Real Estate</I> Home Page." WriteParagraph f, "The following articles can be found in our web:" OpenList f, False If chkImprove.value Then CreateLink tmp, "Home Improvement", "improve.htm" WriteListItem f, tmp End If If chkRealtors.value Then CreateLink tmp, "Local Realtors", "realtors.htm" WriteListItem f, tmp End If If chkMortgage.value Then CreateLink tmp, "Mortgage Affordability Guide", "mortgage.htm" WriteListItem f, tmp End If If chkQuestions.value Then CreateLink tmp, "Questions and Answers", "question.htm" WriteListItem f, tmp End If CloseList f, False WriteRule f CreateSearchBot tmp, "", "" WriteText f, tmp, False CreateIncludeBot tmp, "inc.htm" WriteText f, tmp, False CloseDocument f CloseFile f End Sub Private Sub GenMortgage(outfile As String) Dim f As Integer ' file number Dim tmp As String ' temporary string f = OpenFile(outfile) OpenDocument f, "Mortgage Info Page" WriteImage f, "masthead.gif", "Masthead Image", "", False WriteBreak f WriteHeading f, 1, "Mortgage Info Page" WriteRule f WriteParagraph f, "This page has a lot of info about mortgages." CreateIncludeBot tmp, "inc.htm" WriteText f, tmp, False CloseDocument f CloseFile f End Sub Private Sub GenQuestion(outfile As String) Dim f As Integer ' file number Dim tmp As String ' temporary string f = OpenFile(outfile) OpenDocument f, "Real Estate Questions Page" WriteImage f, "masthead.gif", "Masthead Image", "", False WriteBreak f WriteHeading f, 1, "Real Estate Questions Page" WriteRule f WriteParagraph f, "This page has a lot of answers to questions about Real Estate." CreateIncludeBot tmp, "inc.htm" WriteText f, tmp, False CloseDocument f CloseFile f End Sub Private Sub GenRealtors(outfile As String) Dim f As Integer ' file number Dim tmp As String ' temporary string f = OpenFile(outfile) OpenDocument f, "Realtor Guide Page" WriteImage f, "masthead.gif", "Masthead Image", "", False WriteBreak f WriteHeading f, 1, "Realtor Guide Page" WriteRule f WriteParagraph f, "This page has a lot of info about local Realtors." CreateIncludeBot tmp, "inc.htm" WriteText f, tmp, False CloseDocument f CloseFile f End Sub Private Sub GoToPage(num As Integer) If num >= 0 And num <= PageMax Then ' validate and then take down previous page (if any) If PageNum >= 0 And PageNum <= PageMax Then ' check for valid input on the current page If Not ValidatePage(PageNum) Then Exit Sub pg(PageNum).Visible = False End If PageNum = num ChangePicture PageNum pg(PageNum).Visible = True If PageNum = 0 Then btnBack.Enabled = False Else btnBack.Enabled = True End If If PageNum = PageMax Then btnNext.Enabled = False Else btnNext.Enabled = True End If ' meter.value = PageNum SetFinishState ' see if Finish button can be enabled End If End Sub Private Sub InitPages() ' make sure any pages with required values ' (except for the server/web name page) ' are initialized (after INI file has been read) ' page 0 ' (nothing) ' page 1 ' (nothing) ' page 2 ' (nothing) ' page 3 ' (nothing) ' page 4 If txtCompanyName.text = "" Then txtCompanyName.text = "My Company Inc." If txtEmailAddress.text = "" Then txtEmailAddress.text = "info@mycompany.com" End Sub Private Sub LoadSettings() ' read in all persistent values from INI file ' page 1 If GetIniBool("HomeImprovement") Then chkImprove.value = 1 Else chkImprove.value = 0 End If If GetIniBool("RealtorIndex") Then chkRealtors.value = 1 Else chkRealtors.value = 0 End If If GetIniBool("MortgageGuide") Then chkMortgage.value = 1 Else chkMortgage.value = 0 End If If GetIniBool("Questions") Then chkQuestions.value = 1 Else chkQuestions.value = 0 End If ' page 2 optOne.value = GetIniBool("OptionOne") optTwo.value = GetIniBool("OptionTwo") optThree.value = GetIniBool("OptionThree") ' page 3 txtCompanyName.text = GetIniString("CompanyName") txtEmailAddress.text = GetIniString("EmailAddress") End Sub Private Sub ParseCommandLine() ' TODO: read command line and place values in global vars End Sub Private Sub SaveSettings() ' write out all persistent values to INI file ' page 1 SetIniBool "HomeImprovement", chkImprove.value = 1 SetIniBool "RealtorIndex", chkRealtors.value = 1 SetIniBool "MortgageGuide", chkMortgage.value = 1 SetIniBool "Questions", chkQuestions.value = 1 ' page 2 SetIniBool "OptionOne", optOne.value SetIniBool "OptionTwo", optTwo.value SetIniBool "OptionThree", optThree.value ' page 3 SetIniString "CompanyName", CStr(txtCompanyName.text) SetIniString "EmailAddress", CStr(txtEmailAddress.text) End Sub Private Sub SetFinishState() ' make sure all required input has been provided Dim state As Integer state = True ' enabled unless some test fails below If txtCompanyName.text = "" Then state = False If txtEmailAddress.text = "" Then state = False btnFinish.Enabled = state End Sub Private Function ValidatePage(pgnum As Integer) As Integer Dim errtitle As String Dim noisy As Integer ' handle bad input on pages errtitle = "Bad Input" noisy = True ValidatePage = False Select Case pgnum Case 4 ' web meta-info page If txtCompanyName.text = "" Then If noisy Then Beep MsgBox "Company Name field cannot be empty.", 48, errtitle Exit Function End If If txtEmailAddress.text = "" Then If noisy Then Beep MsgBox "Email Address field cannot be empty.", 48, errtitle Exit Function End If End Select ValidatePage = True End Function