home *** CD-ROM | disk | FTP | other *** search
/ Programmer Plus 2007 / Programmer-Plus-2007.iso / Programming / Microsoft Plateform / Visual Basic 5.0 / Msvb50.ace / msvb50 / MSVB50 / VB / SETUPKIT / SETUP1 / PATH.FRM (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1996-10-07  |  10.8 KB  |  337 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_TemplateDerived = False
  191. Attribute VB_PredeclaredId = True
  192. Attribute VB_Exposed = False
  193. Option Explicit
  194. Option Compare Text
  195. ' Form/Module Variables
  196. Dim mfMustExist As Integer
  197. Dim mfCancelExit As Integer
  198. Private Sub cmdCancel_Click()
  199.     If mfCancelExit = True Then
  200.         ExitSetup Me, gintRET_EXIT
  201.     Else
  202.         gfRetVal = gintRET_CANCEL
  203.         Unload Me
  204.     End If
  205. End Sub
  206. Private Sub cmdOK_Click()
  207.     Dim strPathName As String
  208.     Dim strMsg As String
  209.     Dim intRet As Integer
  210.     SetMousePtr gintMOUSE_HOURGLASS
  211.     strPathName = ResolveDir(txtPath.Text, mfMustExist, True)
  212.     If strPathName <> gstrNULL Then
  213.         If frmSetup1.Tag = gstrDIR_DEST And strPathName <> gstrDestDir Then
  214.             If DirExists(strPathName) = False Then
  215.                 strMsg = ResolveResString(resDESTDIR) & LS$ & strPathName
  216.                 strMsg = strMsg & LS$ & ResolveResString(resCREATE)
  217.                 intRet = MsgFunc(strMsg, MB_YESNO Or MB_ICONQUESTION, gstrTitle)
  218.                 If gfNoUserInput = True Then
  219.                     ExitSetup Me, gintRET_FATAL
  220.                 End If
  221.                 If intRet = IDNO Then
  222.                     txtPath.SetFocus
  223.                     SetMousePtr gintMOUSE_DEFAULT
  224.                     Exit Sub
  225.                 End If
  226.             End If
  227.             If IsValidDestDir(strPathName) = False Then
  228.                 txtPath.SetFocus
  229.                 SetMousePtr gintMOUSE_DEFAULT
  230.                 Exit Sub
  231.             End If
  232.         End If
  233.         frmSetup1.Tag = strPathName
  234.         gfRetVal = gintRET_CONT
  235.         Unload Me
  236.     Else
  237.         txtPath.SetFocus
  238.     End If
  239.     SetMousePtr gintMOUSE_DEFAULT
  240. End Sub
  241. Private Sub dirDirs_Change()
  242.     Static intBusy As Integer
  243.     On Error Resume Next
  244.     If intBusy = False Then
  245.         intBusy = True
  246.         ChDir dirDirs.Path
  247.         If Err = 0 Then
  248.             txtPath.Text = dirDirs.Path
  249.             drvDrives.Drive = Left$(dirDirs.Path, 2)
  250.         Else
  251.             Err = 0
  252.         End If
  253.         intBusy = False
  254.     End If
  255. End Sub
  256. Private Sub drvDrives_Change()
  257.     Static strOldDrive As String
  258.     Static intBusy As Integer
  259.     Dim strDrive As String
  260.     If intBusy = False Then
  261.         intBusy = True
  262.         strDrive = drvDrives.Drive
  263.         If CheckDrive(strDrive, Me.Caption) = True Then
  264.             strOldDrive = strDrive
  265.             dirDirs.Path = strDrive
  266.         Else
  267.             drvDrives.Drive = strOldDrive
  268.         End If
  269.         intBusy = False
  270.     End If
  271. End Sub
  272. Private Sub Form_Load()
  273.     On Error Resume Next
  274.     SetMousePtr gintMOUSE_HOURGLASS
  275.     SetFormFont Me
  276.     cmdOK.Caption = ResolveResString(resBTNOK)
  277.     lblDrives.Caption = ResolveResString(resLBLDRIVES)
  278.     lblDirs.Caption = ResolveResString(resLBLDIRS)
  279.     lblPath.Caption = ResolveResString(resLBLPATH)
  280.     If frmSetup1.Tag = gstrDIR_SRC Then
  281.         Caption = ResolveResString(resINSTFROM)
  282.         lblPrompt.Caption = ResolveResString(resSRCPROMPT, "|1", gstrAppName)
  283.         cmdCancel.Caption = ResolveResString(resBTNEXIT, "|1", gstrAppName)
  284.         mfCancelExit = True
  285.         dirDirs.Path = gstrSrcPath
  286.         If Err > 0 Then
  287.             dirDirs.Path = Left$(App.Path, 3)
  288.         End If
  289.         mfMustExist = True
  290.     Else
  291.         Caption = ResolveResString(resCHANGEDIR)
  292.         lblPrompt.Caption = ResolveResString(resDESTPROMPT)
  293.         cmdCancel.Caption = ResolveResString(resBTNCANCEL)
  294.         mfCancelExit = False
  295.         dirDirs.Path = gstrDestDir
  296.         If Err > 0 Then
  297.             'Next try root of destination drive
  298.             If Len(gstrDestDir) >= 2 Then
  299.                 If Mid$(gstrDestDir, 2, 1) = gstrCOLON Then
  300.                     Err = 0
  301.                     dirDirs.Path = Left$(gstrDestDir, 2) & gstrSEP_DIR
  302.                 End If
  303.             End If
  304.         End If
  305.         If Err > 0 Then
  306.             dirDirs.Path = Left$(App.Path, 3)
  307.         End If
  308.         
  309.         'Init txtPath.Text to gstrDestDir even if this
  310.         '  directory does not (yet) exist.
  311.         txtPath.Text = gstrDestDir
  312.         mfMustExist = False
  313.     End If
  314.     If frmSetup1.Tag = gstrDIR_SRC Then
  315.         txtPath.Text = dirDirs.Path
  316.     End If
  317.     drvDrives.Drive = Left$(dirDirs.Path, 2)
  318.     drvDrives_Change
  319.     SetMousePtr gintMOUSE_DEFAULT
  320.     CenterForm Me
  321.     'Highlight all of txtPath's text so that typing immediately overwrites it
  322.     txtPath.SelStart = 0
  323.     txtPath.SelLength = Len(txtPath.Text)
  324.     Err = 0
  325. End Sub
  326. Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
  327.     If UnloadMode <> 1 Then
  328.         If mfCancelExit = True Then
  329.             ExitSetup Me, gintRET_EXIT
  330.             Cancel = 1
  331.         Else
  332.             gfRetVal = gintRET_CANCEL
  333.             Unload Me
  334.         End If
  335.     End If
  336. End Sub
  337.