home *** CD-ROM | disk | FTP | other *** search
- VERSION 4.00
- Begin VB.Form frmPagewiz1
- BorderStyle = 3 'Fixed Dialog
- Caption = "Hello Page Wizard"
- ClientHeight = 4245
- ClientLeft = 1065
- ClientTop = 1515
- ClientWidth = 7455
- Height = 4650
- Left = 1005
- LinkTopic = "Form1"
- MaxButton = 0 'False
- MinButton = 0 'False
- ScaleHeight = 4245
- ScaleWidth = 7455
- ShowInTaskbar = 0 'False
- Top = 1170
- Width = 7575
- Begin VB.Frame grpPage
- BeginProperty Font
- name = "MS Sans Serif"
- charset = 0
- weight = 700
- size = 8.25
- underline = 0 'False
- italic = 0 'False
- strikethrough = 0 'False
- EndProperty
- Height = 3375
- Index = 0
- Left = 2520
- TabIndex = 12
- Top = 120
- Width = 4755
- Begin VB.Label lblInfo
- Caption = $"hello.frx":0000
- BeginProperty Font
- name = "Arial"
- charset = 0
- weight = 400
- size = 8.25
- underline = 0 'False
- italic = -1 'True
- strikethrough = 0 'False
- EndProperty
- Height = 1695
- Left = 180
- TabIndex = 17
- Top = 1560
- Visible = 0 'False
- Width = 4455
- End
- Begin VB.Label Label3
- Caption = $"hello.frx":01C0
- Height = 735
- Left = 180
- TabIndex = 15
- Top = 840
- Width = 4395
- End
- Begin VB.Label Label2
- Caption = "The Hello Page Wizard will guide you through the process of creating a web page that greets visitors to your web site."
- Height = 495
- Left = 180
- TabIndex = 14
- Top = 300
- Width = 4395
- End
- End
- Begin VB.Frame grpPage
- BeginProperty Font
- name = "MS Sans Serif"
- charset = 0
- weight = 700
- size = 8.25
- underline = 0 'False
- italic = 0 'False
- strikethrough = 0 'False
- EndProperty
- Height = 3375
- Index = 1
- Left = 2640
- TabIndex = 13
- Top = 180
- Width = 4755
- Begin VB.Frame Frame1
- Caption = "&Color Scheme"
- Height = 915
- Left = 360
- TabIndex = 8
- Top = 1860
- Width = 4035
- Begin VB.OptionButton optWB
- Caption = "&White on Black"
- Height = 255
- Left = 2220
- TabIndex = 10
- Top = 420
- Width = 1455
- End
- Begin VB.OptionButton optBW
- Caption = "Bl&ack on White"
- Height = 255
- Left = 480
- TabIndex = 9
- Top = 420
- Value = -1 'True
- Width = 1455
- End
- End
- Begin VB.CheckBox chkCredit
- Caption = "&Include production credit"
- Height = 255
- Left = 360
- TabIndex = 11
- Top = 2940
- Value = 1 'Checked
- Width = 3135
- End
- Begin VB.ComboBox cmbStyle
- Height = 300
- Left = 1260
- Style = 2 'Dropdown List
- TabIndex = 7
- Top = 1380
- Width = 3135
- End
- Begin VB.TextBox txtGreeting
- Height = 285
- Left = 1260
- TabIndex = 5
- Text = "Hello, world!"
- Top = 900
- Width = 3075
- End
- Begin VB.Label Label5
- Caption = "&Style:"
- Height = 255
- Left = 360
- TabIndex = 6
- Top = 1440
- Width = 735
- End
- Begin VB.Label Label4
- Caption = "Enter a greeting phrase for your Hello page, and select some appropriate page style settings."
- Height = 495
- Left = 180
- TabIndex = 16
- Top = 300
- Width = 4395
- End
- Begin VB.Label Label1
- Caption = "&Greeting:"
- Height = 255
- Left = 360
- TabIndex = 4
- Top = 960
- Width = 735
- End
- End
- Begin VB.Frame grpPage
- BeginProperty Font
- name = "MS Sans Serif"
- charset = 0
- weight = 700
- size = 8.25
- underline = 0 'False
- italic = 0 'False
- strikethrough = 0 'False
- EndProperty
- Height = 3375
- Index = 2
- Left = 2760
- TabIndex = 18
- Top = 240
- Width = 4755
- Begin VB.TextBox txtTitle
- Height = 315
- Left = 720
- TabIndex = 23
- Text = "My Hello Page"
- Top = 2280
- Width = 3315
- End
- Begin VB.TextBox txtURL
- Height = 315
- Left = 720
- TabIndex = 21
- Text = "hello.htm"
- Top = 1560
- Width = 3315
- End
- Begin VB.Label Label7
- Caption = "Page &Title:"
- Height = 195
- Left = 720
- TabIndex = 22
- Top = 2040
- Width = 1455
- End
- Begin VB.Label Label6
- Caption = "Page &URL:"
- Height = 195
- Left = 720
- TabIndex = 20
- Top = 1320
- Width = 1455
- End
- Begin VB.Label Label8
- Caption = $"hello.frx":027D
- Height = 675
- Left = 180
- TabIndex = 19
- Top = 300
- Width = 4395
- End
- End
- Begin VB.CommandButton btnFinish
- Caption = "&Finish"
- Height = 375
- Left = 6240
- TabIndex = 3
- Top = 3720
- Width = 1035
- End
- Begin VB.CommandButton btnNext
- Caption = "&Next >"
- Height = 375
- Left = 4860
- TabIndex = 0
- Top = 3720
- Width = 1035
- End
- Begin VB.CommandButton btnBack
- Caption = "< &Back"
- Height = 375
- Left = 3840
- TabIndex = 1
- Top = 3720
- Width = 1035
- End
- Begin VB.CommandButton btnCancel
- Cancel = -1 'True
- Caption = "Cancel"
- Height = 375
- Left = 2520
- TabIndex = 2
- Top = 3720
- Width = 1035
- End
- Begin VB.Image imgMain
- BorderStyle = 1 'Fixed Single
- Height = 3270
- Left = 120
- Picture = "hello.frx":032E
- Stretch = -1 'True
- Top = 240
- Width = 2295
- End
- Attribute VB_Name = "frmPagewiz1"
- Attribute VB_Creatable = False
- Attribute VB_Exposed = False
- Option Explicit
- Dim CurPage As Integer
- Dim FirstPage As Integer
- Dim LastPage As Integer
- Private Sub btnBack_Click()
- GoToPage (CurPage - 1)
- End Sub
- Private Sub btnCancel_Click()
- ' set exit status if need to
- If WizardBlocking Then
- SetWizardExitStatus WizardStatusCancel
- End If
- ' all done
- Unload Me
- End Sub
- Private Sub btnFinish_Click()
- Dim explorer As Object
- Dim editor As Object
- Dim newdoc As Object
- Dim pagefile As String
- Dim ret As Long
- Dim weburl As String
- Dim nl As String
- Dim dest As String
- nl = Chr$(13) & Chr$(10)
- ' disable all buttons
- btnCancel.Enabled = False
- btnBack.Enabled = False
- btnNext.Enabled = False
- btnFinish.Enabled = False
- ' put up hourglass
- MousePointer = 11
- ' create page in temp file
- pagefile = TempFileName
- GeneratePage pagefile
- ' set preliminary exit status (can override later)
- SetWizardExitStatus WizardStatusOK
- ' upload page to requested destination
- dest = WizardDestination
- If dest = "" Then dest = "editor"
- Select Case dest
- Case "disk"
- SetWizardFileCount "1"
- SetWizardOutputVar "File1", pagefile
- SetWizardOutputVar "Url1", txtURL
- Case "web"
- Set explorer = CreateObject(FrontPageExplorerID)
- weburl = explorer.vtiGetWebURL
- If weburl = "" Then
- MsgBox "There is no web open in the Explorer." & nl & "Open or create a web and try again."
- GoToPage CurPage ' restore interface
- Set explorer = Nothing
- Kill pagefile
- MousePointer = 0
- Exit Sub
- End If
- If explorer.vtiIsPageInWeb(txtURL) Then
- If MsgBox("A page with the given URL already exists in the current web." & nl & nl & "Overwrite it?", 4 + 32, "Page URL Conflict") = 6 Then
- ret = explorer.vtiPutDocument(pagefile, txtURL, True)
- Else
- ' give user a chance to go back and change it
- GoToPage CurPage ' restore interface
- Set explorer = Nothing
- Kill pagefile
- MousePointer = 0
- Exit Sub
- End If
- Else
- ret = explorer.vtiPutDocument(pagefile, txtURL, True)
- End If
- ' the Explorer will display a message if something goes wrong
- If ret <> 1 Then
- ' override exit status
- SetWizardExitStatus WizardStatusError
- End If
- Set explorer = Nothing
- Case "editor"
- Set editor = CreateObject(FrontPageEditorID)
- Set newdoc = editor.vtiOpenWebPage(pagefile, txtURL, "", "")
- Set newdoc = Nothing
- Set editor = Nothing
- Case Else
- Set editor = CreateObject(FrontPageEditorID)
- Set newdoc = editor.vtiOpenWebPage(pagefile, txtURL, "", "")
- Set newdoc = Nothing
- Set editor = Nothing
- End Select
- ' make sure to delete the generated temp file
- If dest <> "disk" Then Kill pagefile
- ' take down hourglass
- MousePointer = 0
- ' all done
- Unload Me
- End Sub
- Private Sub btnNext_Click()
- GoToPage (CurPage + 1)
- End Sub
- Public Sub InitPages(minpage As Integer, maxpage As Integer)
- Dim i As Integer
- ' align all pages to the location
- ' of the 0th page
- FirstPage = minpage
- LastPage = maxpage
- For i = FirstPage To LastPage
- grpPage(i).Visible = False
- grpPage(i).Caption = ""
- grpPage(i).Left = grpPage(0).Left
- grpPage(i).Top = grpPage(0).Top
- grpPage(i).Width = grpPage(0).Width
- grpPage(i).Height = grpPage(0).Height
- Next i
- CurPage = FirstPage
- End Sub
- Public Sub GoToPage(num As Integer)
- ' clip num to valid range
- If num < FirstPage Then
- num = FirstPage
- ElseIf num > LastPage Then
- num = LastPage
- End If
- ' take down current page
- grpPage(CurPage).Visible = False
- ' reset current page
- CurPage = num
- ' bring up new page
- grpPage(CurPage).Visible = True
- ' set button state
- btnBack.Enabled = (CurPage > FirstPage)
- btnNext.Enabled = (CurPage < LastPage)
- btnFinish.Enabled = (CurPage = LastPage)
- ' label the step (optional); may want
- ' to use static labels instead, or change
- ' the form caption rather than the frame
- grpPage(CurPage).Caption = "Step " & (CurPage + 1) & " of " & (LastPage + 1)
- End Sub
- Private Sub Form_Load()
- Dim maxpage As Integer
- maxpage = 2 ' this includes the page/url dialog
- GetFrontPageInfo
- GetWizardInfo
- LoadSettings
- CenterFormOnScreen Me
- ' last page contains URL/Title info;
- ' don't display it if caller has given
- ' us this info
- If Len(WizardPageURL) > 0 Then
- ' do not include the page/url dialog
- maxpage = 1
- txtURL = WizardPageURL
- End If
- If Len(WizardPageTitle) > 0 Then
- txtTitle = WizardPageTitle
- End If
- InitPages 0, maxpage
- GoToPage 0
- End Sub
- Private Sub Form_Unload(Cancel As Integer)
- SaveSettings
- ' if we were given an arg file, and the caller
- ' is not blocked, then delete it before exiting
- If Not WizardBlocking Then
- If Len(WizardArgFile) > 0 Then Kill WizardArgFile
- End If
- End Sub
- Public Sub SaveSettings()
- ' store current values
- SetIniString "Greeting", txtGreeting
- SetIniInt "Style", cmbStyle.ListIndex
- SetIniBool "BlackOnWhite", optBW
- SetIniBool "WhiteOnBlack", optWB
- SetIniInt "IncludeCredits", chkCredit
- End Sub
- Public Sub LoadSettings()
- ' perform any initialization of control values
- cmbStyle.Clear
- cmbStyle.AddItem "Heading 1"
- cmbStyle.AddItem "Heading 2"
- cmbStyle.AddItem "Heading 3"
- cmbStyle.ListIndex = 0
- ' retrieve any previous values
- If WizardHasPreviousSettings Then
- txtGreeting = GetIniString("Greeting")
- cmbStyle.ListIndex = GetIniInt("Style")
- optBW = GetIniBool("BlackOnWhite")
- optWB = GetIniBool("WhiteOnBlack")
- chkCredit = GetIniInt("IncludeCredits")
- End If
- End Sub
- Public Sub RemoveSettings()
- ' might want to use this to clear
- ' all previous settings and return
- ' to the initial state
- If WizardHasPreviousSettings And Len(WizardIniFile) > 0 Then
- Kill WizardIniFile
- End If
- End Sub
- Private Sub txtURL_Change()
- Static recursing As Boolean
- If recursing Then Exit Sub
- recursing = True
- ValidatePageURLField txtURL
- recursing = False
- End Sub
- Public Sub GeneratePage(pagefile As String)
- Dim fn As Integer
- Dim nl As String
- Dim tag As String
- nl = Chr$(10)
- fn = FreeFile
- On Error GoTo BadFile
- Open pagefile For Output As #fn
- Print #fn, "<HTML>"
- Print #fn, "<HEAD>"
- Print #fn, "<TITLE>" & txtTitle & "</TITLE>"
- Print #fn, "</HEAD>"
- If optBW Then
- Print #fn, "<BODY BGCOLOR=#ffffff TEXT=#000000>"
- Else
- Print #fn, "<BODY BGCOLOR=#000000 TEXT=#ffffff>"
- End If
- tag = "H" & (cmbStyle.ListIndex + 1) ' H1, H2, or H3
- Print #fn, "<" & tag & ">" & txtGreeting & "</" & tag & ">"
- If chkCredit Then
- Print #fn, "<HR>"
- Print #fn, "<P><EM>This page was generated by the Hello Page Wizard.</EM></P>"
- End If
- Print #fn, "</BODY>"
- Print #fn, "</HTML>"
- Close #fn
- BadFile:
- Exit Sub
- End Sub
-