LGram16
e067522598
Game client codebase including: - CharacterActionControl: Character and creature management - GlobalScript: Network, items, skills, quests, utilities - RYLClient: Main client application with GUI and event handlers - Engine: 3D rendering engine (RYLGL) - MemoryManager: Custom memory allocation - Library: Third-party dependencies (DirectX, boost, etc.) - Tools: Development utilities 🤖 Generated with [Claude Code](https://claude.com/claude-code) Co-Authored-By: Claude <noreply@anthropic.com>
732 lines
24 KiB
Plaintext
732 lines
24 KiB
Plaintext
VERSION 5.00
|
|
Begin VB.Form frmSetup1
|
|
AutoRedraw = -1 'True
|
|
BackColor = &H00400000&
|
|
BorderStyle = 0 'None
|
|
ClientHeight = 1770
|
|
ClientLeft = 225
|
|
ClientTop = 1590
|
|
ClientWidth = 7950
|
|
ClipControls = 0 'False
|
|
DrawStyle = 5 'Transparent
|
|
FillStyle = 0 'Solid
|
|
BeginProperty Font
|
|
Name = "Times New Roman"
|
|
Size = 24
|
|
Charset = 0
|
|
Weight = 700
|
|
Underline = 0 'False
|
|
Italic = -1 'True
|
|
Strikethrough = 0 'False
|
|
EndProperty
|
|
ForeColor = &H00000000&
|
|
HasDC = 0 'False
|
|
Icon = "setup1.frx":0000
|
|
LockControls = -1 'True
|
|
MaxButton = 0 'False
|
|
MinButton = 0 'False
|
|
NegotiateMenus = 0 'False
|
|
PaletteMode = 1 'UseZOrder
|
|
ScaleHeight = 118
|
|
ScaleMode = 3 'Pixel
|
|
ScaleWidth = 530
|
|
WindowState = 2 'Maximized
|
|
Begin VB.Label lblModify
|
|
AutoSize = -1 'True
|
|
BorderStyle = 1 'Fixed Single
|
|
Caption = $"setup1.frx":0442
|
|
BeginProperty Font
|
|
Name = "MS Sans Serif"
|
|
Size = 8.25
|
|
Charset = 0
|
|
Weight = 400
|
|
Underline = 0 'False
|
|
Italic = 0 'False
|
|
Strikethrough = 0 'False
|
|
EndProperty
|
|
Height = 450
|
|
Left = 15
|
|
TabIndex = 1
|
|
Top = 15
|
|
Visible = 0 'False
|
|
Width = 7860
|
|
WordWrap = -1 'True
|
|
End
|
|
Begin VB.Label lblDDE
|
|
AutoSize = -1 'True
|
|
BorderStyle = 1 'Fixed Single
|
|
Caption = "This label is used for DDE connection to the Program Manager"
|
|
BeginProperty Font
|
|
Name = "MS Sans Serif"
|
|
Size = 8.25
|
|
Charset = 0
|
|
Weight = 400
|
|
Underline = 0 'False
|
|
Italic = 0 'False
|
|
Strikethrough = 0 'False
|
|
EndProperty
|
|
Height = 255
|
|
Left = 15
|
|
TabIndex = 0
|
|
Top = 1515
|
|
Visible = 0 'False
|
|
Width = 4485
|
|
End
|
|
End
|
|
Attribute VB_Name = "frmSetup1"
|
|
Attribute VB_GlobalNameSpace = False
|
|
Attribute VB_Creatable = False
|
|
Attribute VB_PredeclaredId = True
|
|
Attribute VB_Exposed = False
|
|
Option Explicit
|
|
|
|
'
|
|
' Can't put this is a resource because it indicated resource load failure, must localize separately
|
|
'
|
|
Private Const mstrRESOURCELOADFAIL$ = "An error occurred while initializing string resources used by Setup."
|
|
|
|
'-----------------------------------------------------------
|
|
' SUB: DrawBackGround
|
|
'
|
|
' Draws the 'blue wash' screen and prints the 'shadowed'
|
|
' app setup title
|
|
'-----------------------------------------------------------
|
|
'
|
|
Private Sub DrawBackGround()
|
|
Const intBLUESTART% = 255
|
|
Const intBLUEEND% = 0
|
|
Const intBANDHEIGHT% = 2
|
|
Const intSHADOWSTART% = 8
|
|
Const intSHADOWCOLOR% = 0
|
|
Const intTEXTSTART% = 4
|
|
Const intTEXTCOLOR% = 15
|
|
Const intRed% = 1
|
|
Const intGreen% = 2
|
|
Const intBlue% = 4
|
|
Const intBackRed% = 8
|
|
Const intBackGreen% = 16
|
|
Const intBackBlue% = 32
|
|
Dim sngBlueCur As Single
|
|
Dim sngBlueStep As Single
|
|
Dim intFormHeight As Integer
|
|
Dim intFormWidth As Integer
|
|
Dim intY As Integer
|
|
Dim iColor As Integer
|
|
Dim iRed As Single, iBlue As Single, iGreen As Single
|
|
|
|
'
|
|
'Get system values for height and width
|
|
'
|
|
intFormHeight = ScaleHeight
|
|
intFormWidth = ScaleWidth
|
|
|
|
If Len(ReadIniFile(gstrSetupInfoFile, gstrINI_SETUP, gstrINI_COLOR)) = 0 Then
|
|
iColor = intBlue
|
|
Else
|
|
iColor = CInt(ReadIniFile(gstrSetupInfoFile, gstrINI_SETUP, gstrINI_COLOR))
|
|
End If
|
|
'Calculate step size and blue start value
|
|
'
|
|
sngBlueStep = intBANDHEIGHT * (intBLUEEND - intBLUESTART) / intFormHeight
|
|
sngBlueCur = intBLUESTART
|
|
|
|
'
|
|
'Paint blue screen
|
|
'
|
|
For intY = 0 To intFormHeight Step intBANDHEIGHT
|
|
If iColor And intBlue Then iBlue = sngBlueCur
|
|
If iColor And intRed Then iRed = sngBlueCur
|
|
If iColor And intGreen Then iGreen = sngBlueCur
|
|
If iColor And intBackBlue Then iBlue = 255 - sngBlueCur
|
|
If iColor And intBackRed Then iRed = 255 - sngBlueCur
|
|
If iColor And intBackGreen Then iGreen = 255 - sngBlueCur
|
|
Line (-1, intY - 1)-(intFormWidth, intY + intBANDHEIGHT), RGB(iRed, iGreen, iBlue), BF
|
|
sngBlueCur = sngBlueCur + sngBlueStep
|
|
Next intY
|
|
|
|
'
|
|
'Print 'shadowed' appname
|
|
'
|
|
CurrentX = intSHADOWSTART
|
|
CurrentY = intSHADOWSTART
|
|
ForeColor = QBColor(intSHADOWCOLOR)
|
|
Print Caption
|
|
CurrentX = intTEXTSTART
|
|
CurrentY = intTEXTSTART
|
|
ForeColor = QBColor(intTEXTCOLOR)
|
|
Print Caption
|
|
End Sub
|
|
Private Sub Form_Load()
|
|
'
|
|
' Most of the work for Setup1 takes place in Form_Load()
|
|
' and is mostly driven by the information found in the
|
|
' SETUP.LST file. To customize the Setup1 functionality,
|
|
' you will generally want to modify SETUP.LST.
|
|
' Particularly, information regarding the files you are
|
|
' installing is all stored in SETUP.LST. Exceptions include
|
|
' the Remote Automation files RacMgr32.Exe and AutMgr32.Exe
|
|
' and special redistributable packages such as mdac_typ.exe.
|
|
' These require special handling below.
|
|
'
|
|
' Some customization can also be done by editing the code
|
|
' below in Form_Load or in other parts of this program.
|
|
' Places that are more likely to need customization are
|
|
' documented with suggestions and examples in the code.
|
|
'
|
|
|
|
'
|
|
'Uncomment these three lines for debugging. To debug:
|
|
'1) Rebuild Setup1.exe and rebuild the cab file
|
|
' to include the new Setup1.exe.
|
|
'2) Run setup.exe against the new cab
|
|
'3) When the message box appears, open the Setup1 project
|
|
' in VB, paste the command line from the clipboard into the
|
|
' Project/Properties/Make/Command Line Arguments field.
|
|
'4) F5 in VB.
|
|
'
|
|
'Clipboard.Clear
|
|
'Clipboard.SetText Command$
|
|
'MsgBox Command$
|
|
|
|
Const fDefCreateGroupUnderWin95 = False
|
|
|
|
Dim strGroupName As String 'Name of Program Group
|
|
Dim oFont As StdFont
|
|
Dim lChar As Long
|
|
Dim cIcons As Integer ' Count of how many icons are required.
|
|
Dim cGroups As Integer ' Count of how many groups are required.
|
|
Dim fCreateGroup As Boolean
|
|
|
|
Dim iLoop As Integer
|
|
Dim sUCASEStartMenuKey As String
|
|
Dim sUCASEProgramsMenuKey As String
|
|
Dim sGroup As String
|
|
|
|
Dim strRemAutGroupName As String
|
|
|
|
Dim strPerAppPath As String
|
|
|
|
Dim iRet As Integer
|
|
|
|
gfRegDAO = False
|
|
|
|
On Error GoTo MainError
|
|
|
|
SetFormFont Me
|
|
'All the controls and the form are sharing the
|
|
'same font object, so create a new font object
|
|
'for the form so that the appearance of all the
|
|
'controls are not changed also
|
|
Set oFont = New StdFont
|
|
With oFont
|
|
.Size = 24
|
|
.Bold = True
|
|
.Italic = True
|
|
.Charset = lblModify.Font.Charset
|
|
.Name = lblModify.Font.Name
|
|
End With
|
|
Set Font = oFont
|
|
'
|
|
'Initialize string resources used by global vars and forms/controls
|
|
'
|
|
GetStrings
|
|
|
|
'
|
|
'Get Windows, Windows\Fonts, and Windows\System directories
|
|
'
|
|
gstrWinDir = GetWindowsDir()
|
|
gstrWinSysDir = GetWindowsSysDir()
|
|
gstrFontDir = GetWindowsFontDir()
|
|
|
|
'
|
|
' If the Windows System directory is a subdirectory of the
|
|
' Windows directory, the proper place for installation of
|
|
' files specified in the setup.lst as $(WinSysDest) is always
|
|
' the Windows \System directory. If the Windows \System
|
|
' directory is *not* a subdirectory of the Windows directory,
|
|
' then the user is running a shared version of Windows. In
|
|
' this case, if the user does not have write access to the
|
|
' shared system directory, we change the system files
|
|
' destination to the windows directory
|
|
'
|
|
' Avoid Option Compare Text and use explicit UCase comparisons because there
|
|
' is a Unicode character (&H818F) which is equal to a path separator when
|
|
' using Option Compare Text.
|
|
If InStr(UCase$(gstrWinSysDir), UCase$(gstrWinDir)) <> 1 Then
|
|
If Not WriteAccess(gstrWinSysDir) Then
|
|
gstrWinSysDir = gstrWinDir
|
|
End If
|
|
End If
|
|
|
|
'
|
|
' The command-line arguments must be processed as early
|
|
' as possible, because without them it is impossible to
|
|
' call the app removal program to clean up after an aborted
|
|
' setup.
|
|
'
|
|
#If SMS Then
|
|
ProcessCommandLine Command$, gfSilent, gstrSilentLog, gfSMS, gstrMIFFile, gstrSrcPath, gstrAppRemovalLog, gstrAppRemovalEXE
|
|
gfNoUserInput = (gfSilent Or gfSMS)
|
|
#Else
|
|
ProcessCommandLine Command$, gfSilent, gstrSilentLog, gstrSrcPath, gstrAppRemovalLog, gstrAppRemovalEXE
|
|
gfNoUserInput = gfSilent
|
|
#End If
|
|
|
|
AddDirSep gstrSrcPath
|
|
|
|
'
|
|
' The Setup Bootstrapper (SETUP.EXE) copies SETUP1.EXE and SETUP.LST to
|
|
' the end user's windows directory. Information required for setup such
|
|
' as setup flags and fileinfo is read from the copy of SETUP.LST found in
|
|
' that directory.
|
|
'
|
|
gstrSetupInfoFile = gstrWinDir & gstrFILE_SETUP
|
|
'Get the Appname (this will be shown on the blue wash screen)
|
|
gstrAppName = ReadIniFile(gstrSetupInfoFile, gstrINI_SETUP, gstrINI_APPNAME)
|
|
gintCabs = CInt(ReadIniFile(gstrSetupInfoFile, gstrINI_BOOT, gstrINI_CABS))
|
|
If Len(gstrAppName) = 0 Then
|
|
MsgError ResolveResString(resNOSETUPLST), vbOKOnly Or vbCritical, gstrSETMSG
|
|
gstrTitle = ResolveResString(resSETUP, gstrPIPE1, gstrAppName)
|
|
ExitSetup Me, gintRET_FATAL
|
|
End If
|
|
|
|
gstrAppExe = ReadIniFile(gstrSetupInfoFile, gstrINI_SETUP, gstrINI_APPEXE)
|
|
gstrTitle = ResolveResString(resSETUP, gstrPIPE1, gstrAppName)
|
|
If gfSilent Then LogSilentMsg gstrTitle & vbCrLf
|
|
|
|
'Get a temporary directory to use
|
|
gsTEMPDIR = String$(255, 0)
|
|
lChar = GetTempPath(255, gsTEMPDIR)
|
|
gsTEMPDIR = Left$(gsTEMPDIR, lChar)
|
|
AddDirSep gsTEMPDIR
|
|
gsTEMPDIR = gsTEMPDIR & ReadIniFile(gstrSetupInfoFile, gstrINI_BOOT, gsINI_TEMPDIR)
|
|
AddDirSep gsTEMPDIR
|
|
'
|
|
' Get the name of the CAB
|
|
'
|
|
gsCABFULLNAME = gstrWinDir & ReadIniFile(gstrSetupInfoFile, gstrINI_BOOT, gstrINI_CABNAME)
|
|
'
|
|
' Display the background "blue-wash" setup screen as soon as we get the title
|
|
'
|
|
ShowMainForm
|
|
'
|
|
' Display the welcome dialog
|
|
'
|
|
ShowWelcomeForm
|
|
'
|
|
' If this flag is set, then the default destination directory is used
|
|
' without question, and the user is never given a chance to change it.
|
|
' This is intended for installing an .EXE/.DLL as a component rather
|
|
' than as an application in an application directory. In this case,
|
|
' having an application directory does not really make sense.
|
|
'
|
|
|
|
If ReadIniFile(gstrSetupInfoFile, gstrINI_SETUP, gstrINI_FORCEUSEDEFDEST) = "1" Then
|
|
gfForceUseDefDest = True
|
|
End If
|
|
'
|
|
' Read default destination directory. If the name specified conflicts
|
|
' with the name of a file, then prompt for a new default directory
|
|
'
|
|
gstrDestDir = ResolveDestDir(ReadIniFile(gstrSetupInfoFile, gstrINI_SETUP, gstrINI_APPDIR))
|
|
Do While FileExists(gstrDestDir) Or Len(gstrDestDir) = 0
|
|
If MsgError(ResolveResString(resBADDEFDIR), vbOKCancel Or vbQuestion, gstrSETMSG) = vbCancel Then
|
|
ExitSetup Me, gintRET_FATAL
|
|
End If
|
|
|
|
If gfNoUserInput Then
|
|
ExitSetup Me, gintRET_FATAL
|
|
Else
|
|
ShowPathDialog
|
|
End If
|
|
Loop
|
|
'
|
|
' Ensure a trailing backslash on the destination directory
|
|
'
|
|
AddDirSep gstrDestDir
|
|
|
|
Do
|
|
'
|
|
' Display install button and default directory. The user
|
|
' can change the destination directory from here.
|
|
'
|
|
ShowBeginForm
|
|
'
|
|
' This would be a good place to display an option dialog, allowing the user
|
|
' a chance to select installation options: samples, docs, help files, etc.
|
|
' Results of this dialog would be checked in the loop below
|
|
'
|
|
'ShowOptionsDialog (Function you could write with option check boxes, etc.)
|
|
'
|
|
|
|
'
|
|
' Initialize "table" of drives used and disk space array
|
|
'
|
|
InitDiskInfo
|
|
|
|
SetMousePtr vbHourglass
|
|
ShowStaticMessageDialog ResolveResString(resDISKSPACE)
|
|
'
|
|
' For every section in SETUP.LST that will be installed, call CalcDiskSpace
|
|
' with the name of the section
|
|
'
|
|
CalcDiskSpace gstrINI_FILES
|
|
'CalcDiskSpace "MySection"
|
|
'CalcDiskSpace "MyOtherSection"
|
|
'
|
|
' If you created an options dialog, you need to check results here to
|
|
' determine whether disk space needs to be calculated (if the option(s)
|
|
' will be installed)
|
|
'
|
|
'If chkInstallSamples.Value then
|
|
' CalcDiskSpace "Samples"
|
|
'End If
|
|
'
|
|
|
|
HideStaticMessageDialog
|
|
SetMousePtr vbDefault
|
|
|
|
'
|
|
' After all CalcDiskSpace calls are complete, call CheckDiskSpace to check
|
|
' the results and display warning form (if necessary). If the user wants
|
|
' to try another destination directory (or cleanup and retry) then
|
|
' CheckDiskSpace will return False
|
|
'
|
|
Loop Until CheckDiskSpace()
|
|
'
|
|
' Starts logging to the setup logfile (will be used for application removal)
|
|
'
|
|
EnableLogging gstrAppRemovalLog
|
|
'
|
|
' Should go ahead and force the application directory to be created,
|
|
' since the application removal logfile will later be copied there.
|
|
'
|
|
MakePath gstrDestDir, False 'User may not ignore errors here
|
|
'
|
|
' Create the main program group if one is wanted/needed.
|
|
'
|
|
'
|
|
' If fDefCreateGroupUnderWin95 is set to False (this is the default), then no
|
|
' program group will be created under Win95 unless it is absolutely necessary.
|
|
'
|
|
' By default under Windows 95, no group should be created, and the
|
|
' single program icon should be placed directly under the
|
|
' Start>Programs menu (unless there are other, user-defined icons to create
|
|
'
|
|
'
|
|
' Read through the SETUP.LST file and determine how many icons are needed.
|
|
'
|
|
cIcons = CountIcons(gsICONGROUP)
|
|
cGroups = CountGroups(gsICONGROUP)
|
|
'
|
|
' Do the same for other sections in SETUP.LST if you've added your own.
|
|
'
|
|
'cIcons = cIcons + CountIcons("MySection")
|
|
'cIcons = cIcons + CountIcons("MyOtherSection")
|
|
|
|
'
|
|
' The following variable determines whether or not we create a program
|
|
' group for icons. It is controlled by fNoGroupUnderWin95,
|
|
' fAdditionalIcons, and FTreatAsWin95().
|
|
'
|
|
fCreateGroup = (cGroups > 0)
|
|
|
|
If fCreateGroup Then
|
|
For iLoop = 0 To cGroups - 1
|
|
sGroup = GetGroup(gsICONGROUP, iLoop)
|
|
strGroupName = vbNullString
|
|
Select Case UCase$(sGroup)
|
|
Case UCase$(gsSTARTMENUKEY), UCase$(gsPROGMENUKEY)
|
|
' Skip start menu and programs - they're already there and don't
|
|
' need to be created.
|
|
Case Else
|
|
strGroupName = frmGroup.GroupName(frmSetup1, sGroup, GetPrivate(gsICONGROUP, iLoop), GetStart(gsICONGROUP, iLoop))
|
|
If UCase$(sGroup) <> UCase$(strGroupName) Then
|
|
SetGroup gsICONGROUP, iLoop, strGroupName
|
|
End If
|
|
End Select
|
|
fMainGroupWasCreated = True
|
|
Next
|
|
End If
|
|
|
|
' Before we begin copying files, check for mdac_typ
|
|
' and if we find it, spawn that off first. We will tell
|
|
' it to never reboot, and check at the end to see if we need to.
|
|
DoEvents
|
|
If CheckDataAccess Then
|
|
'We need to install data access. Display message.
|
|
ShowStaticMessageDialog ResolveResString(resINSTALLADO)
|
|
InstallDataAccess
|
|
HideStaticMessageDialog
|
|
End If
|
|
'
|
|
' Show copy form and set copy gauge percentage to zero
|
|
'
|
|
SetMousePtr vbHourglass
|
|
ShowCopyDialog
|
|
UpdateStatus frmCopy.picStatus, 0, True
|
|
'
|
|
' Always start with Disk #1
|
|
'
|
|
gintCurrentDisk = 1
|
|
'
|
|
' For every section in SETUP.LST that needs to be installed, call CopySection
|
|
' with the name of the section
|
|
'
|
|
|
|
CopySection gstrINI_FILES
|
|
'CopySection "MySection"
|
|
'CopySection "MyOtherSection"
|
|
|
|
'
|
|
' If you created an options dialog, you need to check results here to
|
|
' determine whether to copy the files in the particular section(s).
|
|
'
|
|
'If chkInstallSamples.Value then
|
|
' CopySection "Samples"
|
|
'End If
|
|
'
|
|
UpdateStatus frmCopy.picStatus, 1, True
|
|
|
|
HideCopyDialog
|
|
'
|
|
' Now, do all the 'invisible' update things that are required
|
|
'
|
|
SetMousePtr vbDefault
|
|
ShowStaticMessageDialog ResolveResString(resUPDATING)
|
|
'
|
|
' Register all the files that have been saved in the registration array. The
|
|
' CopySection API adds a registration entry (when required) if a file is copied.
|
|
'
|
|
RegisterFiles
|
|
'
|
|
' Register all the licenses that appear in the [Licenses] section of
|
|
' Setup.lst.
|
|
'
|
|
RegisterLicenses
|
|
'
|
|
' If any DAO files were installed, we need to add some special
|
|
' keys to the registry to support it so that links will work
|
|
' in OLE Database fields.
|
|
'
|
|
If gfRegDAO Then
|
|
RegisterDAO
|
|
End If
|
|
CheckForAndInstallDirectX gstrINI_FILES, Me.hWnd
|
|
|
|
'
|
|
' Create program icons (or links, i.e. shortcuts).
|
|
'
|
|
If fMainGroupWasCreated Or (cIcons > 0) Then
|
|
ShowStaticMessageDialog ResolveResString(resPROGMAN)
|
|
CreateIcons gsICONGROUP
|
|
'
|
|
' Do the same for other sections in SETUP.LST if you've added your own.
|
|
'
|
|
'CreateIcons "MySection"
|
|
'CreateIcons "MyOtherSection"
|
|
'
|
|
End If
|
|
'
|
|
' Create a separate program group and icons for the Remote Automation
|
|
' Connection Manager and the Automation Manager, if either has been
|
|
' installed.
|
|
' This program group is entirely separate from the one created for the
|
|
' application program (if any), because it will be shared by all
|
|
' VB applications which install them.
|
|
'
|
|
' NOTE: This is NOT the place to install additional icons. This is
|
|
' NOTE: handled after the Remote Automation icons have been created.
|
|
'
|
|
ShowStaticMessageDialog ResolveResString(resPROGMAN)
|
|
If Len(gsDest.strAUTMGR32) > 0 Or Len(gsDest.strRACMGR32) > 0 Then
|
|
'At least one of these programs was installed. Go ahead
|
|
'and create the program group.
|
|
strRemAutGroupName = ResolveResString(resREMAUTGROUPNAME)
|
|
'
|
|
' Create the group for the Remote Automation Icons. Note that
|
|
' since the user cannot choose the name of this group, there is
|
|
' no way at this point to correct an error if one occurs. Therefore,
|
|
' fCreateShellGroup will abort setup, without returning, if there
|
|
' is an error.
|
|
'
|
|
fCreateShellGroup strRemAutGroupName, False, False
|
|
|
|
'Now create the icons for AUTMGR32.EXE and RACMGR32.EXE
|
|
If Len(gsDest.strRACMGR32) > 0 Then
|
|
CreateShellLink gsDest.strRACMGR32, strRemAutGroupName, vbNullString, ResolveResString(resRACMGR32ICON), True, gsPROGMENUKEY, False
|
|
End If
|
|
If Len(gsDest.strAUTMGR32) > 0 Then
|
|
CreateShellLink gsDest.strAUTMGR32, strRemAutGroupName, vbNullString, ResolveResString(resAUTMGR32ICON), True, gsPROGMENUKEY, False
|
|
End If
|
|
End If
|
|
'
|
|
'Register the per-app path
|
|
'
|
|
If Len(gstrAppExe) > 0 Then
|
|
strPerAppPath = ReadIniFile(gstrSetupInfoFile, gstrINI_SETUP, gstrINI_APPPATH)
|
|
AddPerAppPath gstrAppExe, gsDest.strAppDir, strPerAppPath
|
|
End If
|
|
|
|
ExitSetup:
|
|
HideStaticMessageDialog
|
|
If fWithinAction() Then
|
|
'By now, all logging actions should have been either aborted or committed.
|
|
MsgError ResolveResString(resSTILLWITHINACTION), vbExclamation Or vbOKOnly, gstrTitle
|
|
ExitSetup Me, gintRET_FATAL
|
|
End If
|
|
MoveAppRemovalFiles strGroupName
|
|
|
|
ExitSetup Me, gintRET_FINISHEDSUCCESS
|
|
|
|
MainError:
|
|
iRet = MsgError(Err.Description & vbLf & vbLf & ResolveResString(resUNEXPECTED), vbRetryCancel Or vbExclamation, gstrTitle)
|
|
If gfNoUserInput Then iRet = vbCancel
|
|
Select Case iRet
|
|
Case vbRetry
|
|
Resume
|
|
Case vbCancel
|
|
ExitSetup Me, gintRET_ABORT
|
|
Resume
|
|
End Select
|
|
End Sub
|
|
|
|
'-----------------------------------------------------------
|
|
' SUB: HideCopyDialog
|
|
'
|
|
' Unloads the copy files status form
|
|
'-----------------------------------------------------------
|
|
'
|
|
Private Sub HideCopyDialog()
|
|
Unload frmCopy
|
|
End Sub
|
|
|
|
'-----------------------------------------------------------
|
|
' SUB: HideStaticMessageDialog
|
|
'
|
|
' Unloads the setup messages form
|
|
'-----------------------------------------------------------
|
|
'
|
|
Private Sub HideStaticMessageDialog()
|
|
Unload frmMessage
|
|
End Sub
|
|
|
|
'-----------------------------------------------------------
|
|
' SUB: ShowBeginForm
|
|
'
|
|
' Displays the begin setup form
|
|
'-----------------------------------------------------------
|
|
'
|
|
Private Sub ShowBeginForm()
|
|
If gfNoUserInput Then
|
|
If Not IsValidDestDir(gstrDestDir) Then
|
|
ExitSetup frmSetup1, gintRET_FATAL
|
|
End If
|
|
Else
|
|
frmBegin.Show vbModal
|
|
End If
|
|
End Sub
|
|
|
|
'-----------------------------------------------------------
|
|
' SUB: ShowCopyDialog
|
|
'
|
|
' Displays the copy files status form
|
|
'-----------------------------------------------------------
|
|
'
|
|
Private Sub ShowCopyDialog()
|
|
CenterForm frmCopy
|
|
If gfNoUserInput Then
|
|
frmCopy.cmdExit.Visible = False
|
|
End If
|
|
frmCopy.Show
|
|
frmCopy.Refresh
|
|
If frmCopy.cmdExit.Visible Then
|
|
frmCopy.cmdExit.SetFocus
|
|
End If
|
|
End Sub
|
|
|
|
'-----------------------------------------------------------
|
|
' SUB: ShowMainForm
|
|
'
|
|
' Displays the main setup 'blue wash' form
|
|
'-----------------------------------------------------------
|
|
'
|
|
Private Sub ShowMainForm()
|
|
Caption = gstrTitle
|
|
Show
|
|
DrawBackGround
|
|
Refresh
|
|
End Sub
|
|
|
|
'-----------------------------------------------------------
|
|
' SUB: ShowStaticMessageDialog
|
|
'
|
|
' Displays a setup message in a 'box' of the appropriate
|
|
' size for the message
|
|
'
|
|
' IN: [strMessage] - message to display
|
|
'-----------------------------------------------------------
|
|
'
|
|
Private Sub ShowStaticMessageDialog(ByVal strMessage As String)
|
|
Dim frm As Form
|
|
|
|
Set frm = frmMessage
|
|
frm.lblMsg.Caption = strMessage
|
|
|
|
'
|
|
'Default height is twice the height of the setup icon.
|
|
'If the height of the message text is greater, then
|
|
'increase the form height to the label height plus
|
|
'half an icon height
|
|
'
|
|
frm.ScaleHeight = frm.imgMsg.Height * 2
|
|
If frm.lblMsg.Height > frm.ScaleHeight Then
|
|
frm.ScaleHeight = frm.lblMsg.Height + frm.imgMsg.Height * 0.5
|
|
End If
|
|
|
|
'
|
|
'Vertically center the icon and label within the form
|
|
'
|
|
frm.imgMsg.Top = frm.ScaleHeight / 2 - frm.imgMsg.Height / 2
|
|
frm.lblMsg.Top = frm.ScaleHeight / 2 - frm.lblMsg.Height / 2
|
|
|
|
CenterForm frm
|
|
|
|
frm.Show
|
|
frm.Refresh
|
|
End Sub
|
|
|
|
'-----------------------------------------------------------
|
|
' SUB: ShowWelcomeForm
|
|
'
|
|
' Displays the welcome to setup form
|
|
'-----------------------------------------------------------
|
|
'
|
|
Private Sub ShowWelcomeForm()
|
|
If Not gfNoUserInput Then
|
|
frmWelcome.Show vbModal
|
|
End If
|
|
End Sub
|
|
|
|
'-----------------------------------------------------------
|
|
' SUB: GetStrings
|
|
'
|
|
' Loads string resources into global vars and forms/controls
|
|
'-----------------------------------------------------------
|
|
'
|
|
Private Sub GetStrings()
|
|
On Error GoTo GSErr
|
|
|
|
gstrSETMSG = ResolveResString(resSETMSG)
|
|
|
|
Exit Sub
|
|
|
|
GSErr:
|
|
MsgError mstrRESOURCELOADFAIL, vbCritical Or vbOKOnly, vbNullString
|
|
ExitSetup Me, gintRET_FATAL
|
|
End Sub
|
|
|
|
Private Sub Form_Unload(Cancel As Integer)
|
|
CleanUpCabs
|
|
End Sub
|