home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / spmate12 / savefile.fr$ / savefile.frm (.txt)
Encoding:
Visual Basic Form  |  1993-07-08  |  4.5 KB  |  173 lines
  1. VERSION 2.00
  2. Begin Form SaveFile 
  3.    BorderStyle     =   3  'Fixed Double
  4.    Caption         =   "Enter File Name for Save"
  5.    Height          =   3480
  6.    Icon            =   0
  7.    Left            =   960
  8.    LinkMode        =   1  'Source
  9.    LinkTopic       =   "Form1"
  10.    ScaleHeight     =   3105
  11.    ScaleWidth      =   4830
  12.    Top             =   1200
  13.    Width           =   4920
  14.    Begin CommandButton Command2 
  15.       Caption         =   "Cancel"
  16.       Height          =   375
  17.       Left            =   3480
  18.       TabIndex        =   7
  19.       Top             =   1800
  20.       Width           =   1095
  21.    End
  22.    Begin DriveListBox Drive1 
  23.       Height          =   315
  24.       Left            =   2025
  25.       TabIndex        =   0
  26.       Top             =   1560
  27.       Width           =   1215
  28.    End
  29.    Begin CommandButton Command1 
  30.       Caption         =   "OK"
  31.       Default         =   -1  'True
  32.       Height          =   375
  33.       Left            =   3465
  34.       TabIndex        =   6
  35.       Top             =   1305
  36.       Width           =   1095
  37.    End
  38.    Begin DirListBox Dir1 
  39.       Height          =   1815
  40.       Left            =   240
  41.       TabIndex        =   1
  42.       Top             =   1080
  43.       Width           =   1575
  44.    End
  45.    Begin TextBox Text1 
  46.       Height          =   315
  47.       Left            =   1200
  48.       TabIndex        =   2
  49.       Text            =   " "
  50.       Top             =   240
  51.       Width           =   3015
  52.    End
  53.    Begin Label Label5 
  54.       AutoSize        =   -1  'True
  55.       Caption         =   "Drives:"
  56.       Height          =   195
  57.       Left            =   2025
  58.       TabIndex        =   5
  59.       Top             =   1335
  60.       Width           =   615
  61.    End
  62.    Begin Label Label1 
  63.       AutoSize        =   -1  'True
  64.       Height          =   195
  65.       Left            =   2160
  66.       TabIndex        =   3
  67.       Top             =   855
  68.       Width           =   2055
  69.    End
  70.    Begin Label Label4 
  71.       AutoSize        =   -1  'True
  72.       Caption         =   "Directories:"
  73.       Height          =   195
  74.       Left            =   240
  75.       TabIndex        =   4
  76.       Top             =   825
  77.       Width           =   990
  78.    End
  79.    Begin Label Label2 
  80.       AutoSize        =   -1  'True
  81.       Caption         =   "File Name:"
  82.       Height          =   195
  83.       Left            =   240
  84.       TabIndex        =   8
  85.       Top             =   240
  86.       Width           =   915
  87.    End
  88. Const TEXTFLAG = 0
  89. Const DIRFLAG = 1
  90. Dim SelectFlag As Integer
  91. Sub Command1_Click ()
  92.    On Error GoTo ErrorTrap
  93.    If SelectFlag = DIRFLAG Then
  94.       Dir1.Path = Dir1.List(Dir1.ListIndex)
  95.       Dir1_Change
  96.       SelectFlag = TEXTFLAG
  97.    ElseIf InStr(Text1.Text, "\") Then
  98.       Tmp$ = Text1.Text
  99.       Do Until Right$(Tmp$, 1) = "\"
  100.          Tmp$ = Left$(Tmp$, Len(Tmp$) - 1)
  101.       Loop
  102.       If Len(Tmp$) > 3 Then
  103.          Tmp$ = Left$(Tmp$, Len(Tmp$) - 1)
  104.       End If
  105.       Dir1.Path = Tmp$
  106.       Do
  107.          Text1.Text = Mid$(Text1.Text, InStr(Text1.Text, "\") + 1)
  108.       Loop While InStr(Text1.Text, "\")
  109.    Else
  110.       Tmp$ = LTrim$(RTrim$(Text1.Text))
  111.       If Tmp$ <> "" Then
  112.          If Right$(Dir1.Path, 1) = "\" Then
  113.             FullFilePath = Dir1.Path + Tmp$
  114.          Else
  115.             FullFilePath = Dir1.Path + "\" + Tmp$
  116.          End If
  117.          Unload SaveFile
  118.       Else
  119.          Beep
  120.          Text1.SetFocus
  121.       End If
  122.    End If
  123.    Exit Sub
  124. ErrorTrap:
  125.    Beep
  126.    Resume Next
  127. End Sub
  128. Sub Command2_Click ()
  129.    Unload SaveFile
  130. End Sub
  131. Sub Dir1_Change ()
  132.    FillLabel1
  133.    Drive1.Drive = Dir1.Path
  134.    SelectFlag = DIRFLAG
  135. End Sub
  136. Sub Dir1_Click ()
  137.    SelectFlag = DIRFLAG
  138. End Sub
  139. Sub Drive1_Change ()
  140.    Dir1.Path = Drive1.Drive
  141.    SelectFlag = DIRFLAG
  142. End Sub
  143. Sub FillLabel1 ()
  144.    Label1.Caption = Dir1.Path
  145.    If Label1.Width > 2055 Then
  146.       a$ = Left$(Dir1.Path, 3)
  147.       b$ = Mid$(Dir1.Path, 4)
  148.       Do While InStr(b$, "\")
  149.          b$ = Mid$(b$, InStr(b$, "\") + 1)
  150.       Loop
  151.       Label1.Caption = a$ + "...\" + b$
  152.    End If
  153. End Sub
  154. Sub Form_Load ()
  155.    SaveFile.Left = (Screen.Width - SaveFile.Width) / 2
  156.    SaveFile.Top = (Screen.Height - SaveFile.Height) / 2
  157.    If FullFilePath <> "" Then
  158.       Tmp$ = FullFilePath
  159.       Do Until Right$(Tmp$, 1) = "\"
  160.          Tmp$ = Left$(Tmp$, Len(Tmp$) - 1)
  161.       Loop
  162.       Tmp$ = Tmp$ + WILDCARD$
  163.    End If
  164.    FillLabel1
  165.    SelectFlag = TEXTFLAG
  166. End Sub
  167. Sub Form_Resize ()
  168.    Text1.SetFocus
  169. End Sub
  170. Sub Text1_Change ()
  171.    SelectFlag = TEXTFLAG
  172. End Sub
  173.