home *** CD-ROM | disk | FTP | other *** search
/ QBasic & Borland Pascal & C / Delphi5.iso / Basic / Visual Basic.60 / VB98 / WIZARDS / PDWIZARD / SETUP1 / PATH.FRM (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1998-06-18  |  10.7 KB  |  336 lines
  1. VERSION 5.00
  2. Begin VB.Form frmPath 
  3.    BorderStyle     =   3  'Fixed Dialog
  4.    Caption         =   "#"
  5.    ClientHeight    =   4710
  6.    ClientLeft      =   150
  7.    ClientTop       =   1530
  8.    ClientWidth     =   5955
  9.    ClipControls    =   0   'False
  10.    BeginProperty Font 
  11.       Name            =   "MS Sans Serif"
  12.       Size            =   8.25
  13.       Charset         =   0
  14.       Weight          =   700
  15.       Underline       =   0   'False
  16.       Italic          =   0   'False
  17.       Strikethrough   =   0   'False
  18.    EndProperty
  19.    Icon            =   "path.frx":0000
  20.    KeyPreview      =   -1  'True
  21.    LinkTopic       =   "Form1"
  22.    LockControls    =   -1  'True
  23.    MaxButton       =   0   'False
  24.    MinButton       =   0   'False
  25.    ScaleHeight     =   4710
  26.    ScaleWidth      =   5955
  27.    Begin VB.CommandButton cmdCancel 
  28.       Cancel          =   -1  'True
  29.       Caption         =   "#"
  30.       BeginProperty Font 
  31.          Name            =   "MS Sans Serif"
  32.          Size            =   8.25
  33.          Charset         =   0
  34.          Weight          =   400
  35.          Underline       =   0   'False
  36.          Italic          =   0   'False
  37.          Strikethrough   =   0   'False
  38.       EndProperty
  39.       Height          =   420
  40.       Left            =   4170
  41.       MaskColor       =   &H00000000&
  42.       TabIndex        =   7
  43.       Top             =   2640
  44.       Width           =   1560
  45.    End
  46.    Begin VB.CommandButton cmdOK 
  47.       Caption         =   "#"
  48.       Default         =   -1  'True
  49.       BeginProperty Font 
  50.          Name            =   "MS Sans Serif"
  51.          Size            =   8.25
  52.          Charset         =   0
  53.          Weight          =   400
  54.          Underline       =   0   'False
  55.          Italic          =   0   'False
  56.          Strikethrough   =   0   'False
  57.       EndProperty
  58.       Height          =   420
  59.       Left            =   4170
  60.       MaskColor       =   &H00000000&
  61.       TabIndex        =   6
  62.       Top             =   1890
  63.       Width           =   1560
  64.    End
  65.    Begin VB.DriveListBox drvDrives 
  66.       BeginProperty Font 
  67.          Name            =   "MS Sans Serif"
  68.          Size            =   8.25
  69.          Charset         =   0
  70.          Weight          =   400
  71.          Underline       =   0   'False
  72.          Italic          =   0   'False
  73.          Strikethrough   =   0   'False
  74.       EndProperty
  75.       Height          =   315
  76.       Left            =   216
  77.       TabIndex        =   5
  78.       Top             =   4140
  79.       Width           =   3510
  80.    End
  81.    Begin VB.DirListBox dirDirs 
  82.       BeginProperty Font 
  83.          Name            =   "MS Sans Serif"
  84.          Size            =   8.25
  85.          Charset         =   0
  86.          Weight          =   400
  87.          Underline       =   0   'False
  88.          Italic          =   0   'False
  89.          Strikethrough   =   0   'False
  90.       EndProperty
  91.       Height          =   1605
  92.       Left            =   204
  93.       TabIndex        =   3
  94.       Top             =   1896
  95.       Width           =   3510
  96.    End
  97.    Begin VB.TextBox txtPath 
  98.       BeginProperty Font 
  99.          Name            =   "MS Sans Serif"
  100.          Size            =   8.25
  101.          Charset         =   0
  102.          Weight          =   400
  103.          Underline       =   0   'False
  104.          Italic          =   0   'False
  105.          Strikethrough   =   0   'False
  106.       EndProperty
  107.       Height          =   288
  108.       Left            =   204
  109.       MaxLength       =   240
  110.       TabIndex        =   1
  111.       Top             =   1056
  112.       Width           =   5532
  113.    End
  114.    Begin VB.Label lblDrives 
  115.       AutoSize        =   -1  'True
  116.       Caption         =   "#"
  117.       BeginProperty Font 
  118.          Name            =   "MS Sans Serif"
  119.          Size            =   8.25
  120.          Charset         =   0
  121.          Weight          =   400
  122.          Underline       =   0   'False
  123.          Italic          =   0   'False
  124.          Strikethrough   =   0   'False
  125.       EndProperty
  126.       Height          =   195
  127.       Left            =   210
  128.       TabIndex        =   4
  129.       Top             =   3870
  130.       Width           =   105
  131.    End
  132.    Begin VB.Label lblDirs 
  133.       AutoSize        =   -1  'True
  134.       Caption         =   "#"
  135.       BeginProperty Font 
  136.          Name            =   "MS Sans Serif"
  137.          Size            =   8.25
  138.          Charset         =   0
  139.          Weight          =   400
  140.          Underline       =   0   'False
  141.          Italic          =   0   'False
  142.          Strikethrough   =   0   'False
  143.       EndProperty
  144.       Height          =   195
  145.       Left            =   210
  146.       TabIndex        =   2
  147.       Top             =   1590
  148.       Width           =   105
  149.    End
  150.    Begin VB.Label lblPath 
  151.       AutoSize        =   -1  'True
  152.       Caption         =   "#"
  153.       BeginProperty Font 
  154.          Name            =   "MS Sans Serif"
  155.          Size            =   8.25
  156.          Charset         =   0
  157.          Weight          =   400
  158.          Underline       =   0   'False
  159.          Italic          =   0   'False
  160.          Strikethrough   =   0   'False
  161.       EndProperty
  162.       Height          =   195
  163.       Left            =   210
  164.       TabIndex        =   0
  165.       Top             =   750
  166.       Width           =   105
  167.    End
  168.    Begin VB.Label lblPrompt 
  169.       AutoSize        =   -1  'True
  170.       Caption         =   "*"
  171.       BeginProperty Font 
  172.          Name            =   "MS Sans Serif"
  173.          Size            =   8.25
  174.          Charset         =   0
  175.          Weight          =   400
  176.          Underline       =   0   'False
  177.          Italic          =   0   'False
  178.          Strikethrough   =   0   'False
  179.       EndProperty
  180.       Height          =   192
  181.       Left            =   204
  182.       TabIndex        =   8
  183.       Top             =   204
  184.       Width           =   5532
  185.       WordWrap        =   -1  'True
  186.    End
  187. Attribute VB_Name = "frmPath"
  188. Attribute VB_GlobalNameSpace = False
  189. Attribute VB_Creatable = False
  190. Attribute VB_PredeclaredId = True
  191. Attribute VB_Exposed = False
  192. Option Explicit
  193. Option Compare Text
  194. ' Form/Module Variables
  195. Dim mfMustExist As Integer
  196. Dim mfCancelExit As Integer
  197. Private Sub cmdCancel_Click()
  198.     If mfCancelExit = True Then
  199.         ExitSetup Me, gintRET_EXIT
  200.     Else
  201.         gfRetVal = gintRET_CANCEL
  202.         Unload Me
  203.     End If
  204. End Sub
  205. Private Sub cmdOK_Click()
  206.     Dim strPathName As String
  207.     Dim strMsg As String
  208.     Dim intRet As Integer
  209.     SetMousePtr vbhourglass
  210.     strPathName = ResolveDir(txtPath.Text, mfMustExist, True)
  211.     If strPathName <> vbnullstring Then
  212.         If frmSetup1.Tag = gstrDIR_DEST And strPathName <> gstrDestDir Then
  213.             If DirExists(strPathName) = False Then
  214.                 strMsg = ResolveResString(resDESTDIR) & vbLf & vbLf & strPathName
  215.                 strMsg = strMsg & vbLf & vbLf & ResolveResString(resCREATE)
  216.                 intRet = MsgFunc(strMsg, vbYesNo Or vbQuestion, gstrTitle)
  217.                 If gfNoUserInput = True Then
  218.                     ExitSetup Me, gintRET_FATAL
  219.                 End If
  220.                 If intRet = vbNo Then
  221.                     txtPath.SetFocus
  222.                     SetMousePtr gintMOUSE_DEFAULT
  223.                     Exit Sub
  224.                 End If
  225.             End If
  226.             If IsValidDestDir(strPathName) = False Then
  227.                 txtPath.SetFocus
  228.                 SetMousePtr gintMOUSE_DEFAULT
  229.                 Exit Sub
  230.             End If
  231.         End If
  232.         frmSetup1.Tag = strPathName
  233.         gfRetVal = gintRET_CONT
  234.         Unload Me
  235.     Else
  236.         txtPath.SetFocus
  237.     End If
  238.     SetMousePtr gintMOUSE_DEFAULT
  239. End Sub
  240. Private Sub dirDirs_Change()
  241.     Static intBusy As Integer
  242.     On Error Resume Next
  243.     If intBusy = False Then
  244.         intBusy = True
  245.         ChDir dirDirs.Path
  246.         If Err = 0 Then
  247.             txtPath.Text = dirDirs.Path
  248.             drvDrives.Drive = Left$(dirDirs.Path, 2)
  249.         Else
  250.             Err = 0
  251.         End If
  252.         intBusy = False
  253.     End If
  254. End Sub
  255. Private Sub drvDrives_Change()
  256.     Static strOldDrive As String
  257.     Static intBusy As Integer
  258.     Dim strDrive As String
  259.     If intBusy = False Then
  260.         intBusy = True
  261.         strDrive = drvDrives.Drive
  262.         If CheckDrive(strDrive, Me.Caption) = True Then
  263.             strOldDrive = strDrive
  264.             dirDirs.Path = strDrive
  265.         Else
  266.             drvDrives.Drive = strOldDrive
  267.         End If
  268.         intBusy = False
  269.     End If
  270. End Sub
  271. Private Sub Form_Load()
  272.     On Error Resume Next
  273.     SetMousePtr vbhourglass
  274.     SetFormFont Me
  275.     cmdOK.Caption = ResolveResString(resBTNOK)
  276.     lblDrives.Caption = ResolveResString(resLBLDRIVES)
  277.     lblDirs.Caption = ResolveResString(resLBLDIRS)
  278.     lblPath.Caption = ResolveResString(resLBLPATH)
  279.     If frmSetup1.Tag = gstrDIR_SRC Then
  280.         Caption = ResolveResString(resINSTFROM)
  281.         lblPrompt.Caption = ResolveResString(resSRCPROMPT, "|1", gstrAppName)
  282.         cmdCancel.Caption = ResolveResString(resBTNEXIT, "|1", gstrAppName)
  283.         mfCancelExit = True
  284.         dirDirs.Path = gstrSrcPath
  285.         If Err > 0 Then
  286.             dirDirs.Path = Left$(App.Path, 3)
  287.         End If
  288.         mfMustExist = True
  289.     Else
  290.         Caption = ResolveResString(resCHANGEDIR)
  291.         lblPrompt.Caption = ResolveResString(resDESTPROMPT)
  292.         cmdCancel.Caption = ResolveResString(resBTNCANCEL)
  293.         mfCancelExit = False
  294.         dirDirs.Path = gstrDestDir
  295.         If Err > 0 Then
  296.             'Next try root of destination drive
  297.             If Len(gstrDestDir) >= 2 Then
  298.                 If Mid$(gstrDestDir, 2, 1) = gstrCOLON Then
  299.                     Err = 0
  300.                     dirDirs.Path = Left$(gstrDestDir, 2) & gstrSEP_DIR
  301.                 End If
  302.             End If
  303.         End If
  304.         If Err > 0 Then
  305.             dirDirs.Path = Left$(App.Path, 3)
  306.         End If
  307.         
  308.         'Init txtPath.Text to gstrDestDir even if this
  309.         '  directory does not (yet) exist.
  310.         txtPath.Text = gstrDestDir
  311.         mfMustExist = False
  312.     End If
  313.     If frmSetup1.Tag = gstrDIR_SRC Then
  314.         txtPath.Text = dirDirs.Path
  315.     End If
  316.     drvDrives.Drive = Left$(dirDirs.Path, 2)
  317.     drvDrives_Change
  318.     SetMousePtr gintMOUSE_DEFAULT
  319.     CenterForm Me
  320.     'Highlight all of txtPath's text so that typing immediately overwrites it
  321.     txtPath.SelStart = 0
  322.     txtPath.SelLength = Len(txtPath.Text)
  323.     Err = 0
  324. End Sub
  325. Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
  326.     If UnloadMode <> 1 Then
  327.         If mfCancelExit = True Then
  328.             ExitSetup Me, gintRET_EXIT
  329.             Cancel = 1
  330.         Else
  331.             gfRetVal = gintRET_CANCEL
  332.             Unload Me
  333.         End If
  334.     End If
  335. End Sub
  336.