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