Programming Tool Box/SIMS_2.iso/bp_2_94/vbwin/apivsvb/apivscod.frm

Text File | 1993-10-25 | 9KB | 340 lines

VERSION 2.00
Begin Form frmMain
   AutoRedraw      =   -1  'True
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   0  'None
   Caption         =   "Windows API vs VB Code"
   ClientHeight    =   3225
   ClientLeft      =   1665
   ClientTop       =   2835
   ClientWidth     =   9045
   ForeColor       =   &H00C0C0C0&
   Height          =   3915
   Icon            =   APIVSCOD.FRX:0000
   Left            =   1605
   LinkMode        =   1  'Source
   MaxButton       =   0   'False
   ScaleHeight     =   3225
   ScaleWidth      =   9045
   Top             =   2205
   Width           =   9165
   Begin SSFrame Frame3D4
      Caption         =   "Einstellungen"
      Font3D          =   3  'Inset w/light shading
      ForeColor       =   &H00000000&
      Height          =   1185
      Left            =   4620
      TabIndex        =   10
      Top             =   1200
      Width           =   1725
      Begin SSCheck chkKopierenAPI
         Caption         =   "kop. mit API"
         Font3D          =   0  'None
         Height          =   345
         Left            =   120
         TabIndex        =   12
         Top             =   660
         Width           =   1455
      End
      Begin SSCheck chkSelektierenAPI
         Caption         =   "selekt. mit API"
         Font3D          =   0  'None
         Height          =   345
         Left            =   120
         TabIndex        =   11
         Top             =   300
         Width           =   1455
      End
   End
   Begin SSFrame Frame3D3
      Caption         =   "Aktion"
      Font3D          =   3  'Inset w/light shading
      ForeColor       =   &H00000000&
      Height          =   1155
      Left            =   4620
      TabIndex        =   7
      Top             =   30
      Width           =   1725
      Begin CommandButton cmdKopieren
         Caption         =   "&Kopieren"
         Height          =   345
         Left            =   120
         TabIndex        =   9
         Top             =   330
         Width           =   1485
      End
      Begin SSCheck chkSelektieren
         Caption         =   " alles selekt. "
         Font3D          =   0  'None
         Height          =   345
         Left            =   120
         TabIndex        =   8
         Top             =   780
         Width           =   1515
      End
   End
   Begin CommandButton cmdESC
      Cancel          =   -1  'True
      Caption         =   "&Abbruch"
      Height          =   345
      Left            =   4830
      TabIndex        =   6
      Top             =   2580
      Width           =   1275
   End
   Begin SSFrame Frame3D2
      Caption         =   "&zu konvertieren"
      Font3D          =   3  'Inset w/light shading
      Height          =   3075
      Left            =   6480
      TabIndex        =   4
      Top             =   30
      Width           =   2475
      Begin CommandButton cmdDeselect
         Caption         =   "D&eselektieren"
         Height          =   345
         Left            =   600
         TabIndex        =   13
         Top             =   2520
         Width           =   1395
      End
      Begin ListBox List1
         Height          =   2175
         Left            =   120
         MultiSelect     =   2  'Extended
         Sorted          =   -1  'True
         TabIndex        =   5
         Top             =   270
         Width           =   2235
      End
   End
   Begin SSFrame Frame3D1
      Caption         =   "Dateiaus&wahl"
      Font3D          =   3  'Inset w/light shading
      Height          =   3075
      Left            =   60
      TabIndex        =   0
      Top             =   30
      Width           =   4455
      Begin DirListBox Dir1
         Height          =   2730
         Left            =   60
         TabIndex        =   2
         Top             =   270
         Width           =   1665
      End
      Begin FileListBox File1
         Archive         =   0   'False
         Height          =   2175
         Left            =   1800
         MultiSelect     =   2  'Extended
         TabIndex        =   3
         Top             =   825
         Width           =   2445
      End
      Begin DriveListBox drv1
         Height          =   315
         Left            =   1800
         TabIndex        =   1
         Top             =   270
         Width           =   2445
      End
   End
   Begin Line Line1
      BorderColor     =   &H00FFFFFF&
      Index           =   3
      X1              =   4200
      X2              =   4965
      Y1              =   1770
      Y2              =   1770
   End
   Begin Line Line1
      BorderColor     =   &H00808080&
      Index           =   2
      X1              =   4200
      X2              =   4950
      Y1              =   1740
      Y2              =   1740
   End
   Begin Line Line1
      BorderColor     =   &H00808080&
      Index           =   1
      X1              =   4200
      X2              =   4950
      Y1              =   540
      Y2              =   540
   End
   Begin Line Line1
      BorderColor     =   &H00FFFFFF&
      Index           =   0
      X1              =   4200
      X2              =   4965
      Y1              =   570
      Y2              =   570
   End
   Begin Menu mnuDatei
      Caption         =   "&Datei"
      Begin Menu mnuProgrammEnde
         Caption         =   "Programm-&Ende"
         Shortcut        =   ^{F4}
      End
   End
   Begin Menu mnu▄ber
      Caption         =   "&▄ber"
   End
End
Option Explicit

Sub Bin_Sort (sEinfueg As String)

Dim iStart As Integer, iMitte As Integer, iEnde As Integer
Dim sListstring As String

iStart = 0: iEnde = List1.ListCount
Do
   iMitte = Int((iEnde + iStart) / 2)
   If iStart > iMitte Then
      List1.AddItem sEinfueg
      Exit Do
   End If
   sListstring = List1.List(iMitte)
   Select Case sEinfueg
      Case Is = sListstring: Exit Do
      Case Is > sListstring: iStart = iMitte + 1
      Case Is < sListstring: iEnde = iMitte - 1
   End Select
Loop
End Sub

Sub CenterForm (frmX As Form)

frmX.Top = Screen.Height / 2 - frmX.Height / 2
frmX.Left = Screen.Width / 2 - frmX.Width / 2

End Sub

Sub chkSelektieren_Click (Value As Integer)
Dim Ix As Integer, iRet As Integer

Screen.MousePointer = HOURGLASS
If chkSelektierenApi.Value Then
   iRet = LockWindowUpdate(File1.hWnd)
End If

For Ix = 0 To File1.ListCount - 1
   File1.Selected(Ix) = Value
Next

If chkSelektierenApi.Value Then
   iRet = LockWindowUpdate(0)
End If
Screen.MousePointer = DEFAULT

End Sub

Sub cmdDeselect_Click ()

List1.Clear

End Sub

Sub cmdESC_Click ()

mnuProgrammEnde_Click

End Sub

Sub cmdKopieren_Click ()
Dim Ix As Integer, ent&

Screen.MousePointer = HOURGLASS

For Ix = 0 To File1.ListCount - 1
If File1.Selected(Ix) Then
   Select Case chkKopierenAPI
   Case True
      ent& = SendMessageBystring&(List1.hWnd, LB_FINDSTRING, 0, File1.List(Ix))
      If ent& < 0 Then List1.AddItem File1.List(Ix)
   Case False
      Bin_Sort (File1.List(Ix))
   End Select
End If
Next
If chkSelektieren.Value = True Then
   chkSelektieren.Value = False
End If
Screen.MousePointer = DEFAULT

End Sub

Sub Dir1_Change ()

File1.Path = Dir1.Path
ChDir Dir1.Path
chkSelektieren.Value = False

End Sub

Sub drv1_Change ()
Static sOldDrive As String

On Error GoTo LW_ERROR

Screen.MousePointer = HOURGLASS
Dir1.Path = Drv1.Drive
ChDrive Drv1.Drive
sOldDrive = Drv1.Drive
List1.Clear
Screen.MousePointer = DEFAULT
Exit Sub

LW_ERROR:
Dim sMsgString As String, iDegDef As Integer, iResponse As Integer

If Err = 68 Then 'device not avail.
   sMsgString = "Laufwerk nicht geschlossen, oder keine Diskette eingelegt !"
   iDegDef = MB_OKCANCEL + MB_ICONQUESTION
   iResponse = MsgBox(sMsgString, iDegDef, "Laufwerksfehler")
   If iResponse = IDOK Then
      Resume
   Else
      Drv1.Drive = CurDir
      Exit Sub
   End If
End If
End Sub

Sub Form_Load ()

CenterForm frmMain

End Sub

Sub Form_Unload (Cancel As Integer)

End

End Sub

Sub mnuProgrammEnde_Click ()

Dim iDegDef As Integer, sTitel As String, iResponse As Integer

iDegDef = MB_ICONQUESTION + MB_YESNO
iResponse = MsgBox("Wollen Sie das Programm wirklich beenden ?", iDegDef, "Programm-Abbruch")
If iResponse = IDYES Then Form_Unload False

End Sub

Sub mnu▄ber_Click ()
Dim iDegDef As Integer, sTitel As String, iResponse As Integer
Dim sNL As String

sNL = Chr$(13) + Chr$(10)
iDegDef = MB_OK
sTitel = "1993 by HBSOFT " + sNL + sNL + "Hans - J. Brender"
iResponse = MsgBox(sTitel, iDegDef, "Copyright")

End Sub