home *** CD-ROM | disk | FTP | other *** search
/ Programming Tool Box / SIMS_2.iso / bp_1_94 / vbwin / regdb2 / starter.frm < prev    next >
Text File  |  1993-11-14  |  3KB  |  109 lines
  1. VERSION 2.00
  2. Begin Form Form1 
  3.    BackColor       =   &H00C0C0C0&
  4.    BorderStyle     =   1  'Fixed Single
  5.    Caption         =   "krsStarter"
  6.    ClientHeight    =   5355
  7.    ClientLeft      =   1740
  8.    ClientTop       =   1860
  9.    ClientWidth     =   1740
  10.    Height          =   5760
  11.    Left            =   1680
  12.    LinkTopic       =   "Form1"
  13.    MaxButton       =   0   'False
  14.    ScaleHeight     =   5355
  15.    ScaleWidth      =   1740
  16.    Top             =   1515
  17.    Width           =   1860
  18.    Begin TextBox ddesystem 
  19.       Height          =   285
  20.       Left            =   60
  21.       TabIndex        =   3
  22.       Top             =   4740
  23.       Visible         =   0   'False
  24.       Width           =   1605
  25.    End
  26.    Begin FileListBox File1 
  27.       Height          =   2565
  28.       Left            =   60
  29.       TabIndex        =   2
  30.       Tag             =   "3"
  31.       Top             =   2100
  32.       Width           =   1600
  33.    End
  34.    Begin DirListBox Dir1 
  35.       Height          =   1605
  36.       Left            =   60
  37.       TabIndex        =   1
  38.       Tag             =   "3"
  39.       Top             =   450
  40.       Width           =   1600
  41.    End
  42.    Begin DriveListBox Drive1 
  43.       Height          =   315
  44.       Left            =   60
  45.       TabIndex        =   0
  46.       Tag             =   "3"
  47.       Top             =   60
  48.       Width           =   1600
  49.    End
  50. End
  51. Option Explicit
  52. Dim merk_drv%
  53.  
  54. Sub Dir1_Change ()
  55.     On Error Resume Next
  56.     file1.Path = dir1.Path
  57. End Sub
  58.  
  59. Sub Drive1_Change ()
  60.     On Error Resume Next
  61. retry:
  62.     dir1.Path = drive1.Drive
  63.     Select Case Err
  64.     Case 68
  65.         Select Case MsgBox("Laufwerk nicht bereit.", MB_RETRYCANCEL + MB_ICONSTOP)
  66.         Case IDCANCEL
  67.             ' Ruft die Funktion erneut auf!
  68.             drive1.Drive = Chr$(merk_drv + Asc("A") - 1) & ":"
  69.         Case IDRETRY
  70.             ' Nocheinmal versuchen.
  71.             GoTo retry
  72.         End Select
  73.     Case 0
  74.         ' Alles klar. Neues Laufwerk merken
  75.         merk_drv = Asc(UCase$(drive1)) - Asc("A") + 1
  76.     Case Else
  77.         MsgBox Error$(Err)
  78.     End Select
  79. End Sub
  80.  
  81. Sub File1_DblClick ()
  82.     ' Fⁿr eventuelles DDE wird eine Textbox als Control ⁿbergeben
  83.     If Exec(ddesystem, addbslash(file1.Path) & file1, False) = False Then
  84.         MsgBox "'" & file1 & "' konnte nicht ausgefⁿhrt werden."
  85.     End If
  86. End Sub
  87.  
  88. Sub File1_KeyPress (keyascii As Integer)
  89.     If keyascii = 13 Then
  90.         ' Fⁿr eventuelles DDE wird eine Textbox als Control ⁿbergeben
  91.         If Exec(ddesystem, addbslash(file1.Path) & file1, False) = False Then
  92.             MsgBox "'" & file1 & "' konnte nicht ausgefⁿhrt werden."
  93.         End If
  94.     End If
  95. End Sub
  96.  
  97. Sub Form_Load ()
  98.     Move 0, 0, Width, screen.Height
  99.     file1.Height = scaleheight - file1.Top - drive1.Top
  100.     ' Die aktuelle Einstellung wird fⁿr Drive1_change
  101.     ' gespeichert.
  102.     merk_drv = Asc(UCase$(drive1)) - Asc("A") + 1
  103. End Sub
  104.  
  105. Sub Form_Paint ()
  106.     threed Me
  107. End Sub
  108.  
  109.