Programming Tool Box/SIMS_2.iso/code/system/c_exeico/exeicon.frm

Visual Basic Form | 1995-02-27 | 5.5 KB | 182 lines

VERSION 2.00
Begin Form Form1
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   1  'Nicht
nderbar, einfach
   Caption         =   "Demoprogramm zum Anzeigen von Exe-Icons"
   ClientHeight    =   2610
   ClientLeft      =   1095
   ClientTop       =   1485
   ClientWidth     =   5490
   Height          =   3015
   Icon            =   EXEICON.FRX:0000
   Left            =   1035
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   2610
   ScaleWidth      =   5490
   Top             =   1140
   Width           =   5610
   Begin TextBox txt_index
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   8.25
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   315
      Left            =   720
      TabIndex        =   2
      Top             =   600
      Width           =   360
   End
   Begin CommandButton Befehl1
      Caption         =   "Beenden"
      Height          =   315
      Left            =   60
      TabIndex        =   8
      Top             =   1920
      Width           =   1215
   End
   Begin ListBox Liste1
      Columns         =   4
      Height          =   225
      Left            =   3240
      TabIndex        =   7
      Top             =   2340
      Width           =   2175
   End
   Begin DirListBox Verzeichnis1
      Height          =   1830
      Left            =   1320
      TabIndex        =   6
      Top             =   405
      Width           =   1875
   End
   Begin FileListBox Datei1
      Height          =   2175
      Left            =   3240
      TabIndex        =   5
      Top             =   60
      Width           =   2175
   End
   Begin DriveListBox Laufwerk1
      Height          =   315
      Left            =   1320
      TabIndex        =   4
      Top             =   60
      Width           =   1875
   End
   Begin VScrollBar VBildlauf1
      Height          =   315
      Left            =   1070
      Max             =   0
      Min             =   32767
      TabIndex        =   3
      Top             =   600
      Width           =   160
   End
   Begin PictureBox Bild1
      AutoSize        =   -1  'True
      Height          =   510
      Left            =   720
      ScaleHeight     =   480
      ScaleWidth      =   480
      TabIndex        =   0
      Top             =   60
      Width           =   510
   End
   Begin Label Bezeichnung4
      BackColor       =   &H00C0C0C0&
      Caption         =   "Icon:"
      Height          =   195
      Left            =   120
      TabIndex        =   11
      Top             =   120
      Width           =   555
   End
   Begin Label Bezeichnung3
      BackColor       =   &H00C0C0C0&
      Caption         =   "Klicken Sie auf die Dateiliste, um das Icon zu ent- packen."
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   8.25
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   795
      Left            =   60
      TabIndex        =   10
      Top             =   1020
      Width           =   1215
   End
   Begin Label Bezeichnung2
      BackColor       =   &H00C0C0C0&
      Caption         =   "Dateifilter:"
      Height          =   195
      Left            =   2340
      TabIndex        =   9
      Top             =   2340
      Width           =   915
   End
   Begin Label Bezeichnung1
      BackColor       =   &H00C0C0C0&
      Caption         =   "Index:"
      Height          =   195
      Left            =   120
      TabIndex        =   1
      Top             =   660
      Width           =   555
   End
Option Explicit
Declare Function GetWindowWord Lib "User" (ByVal hWnd As Integer, ByVal nIndex As Integer) As Integer
Declare Function ExtractIcon Lib "Shell" (ByVal hInst As Integer, ByVal lpszExeName As String, ByVal iIcon As Integer) As Integer
Declare Function drawicon Lib "User" (ByVal hDC As Integer, ByVal x As Integer, ByVal Y As Integer, ByVal hIcon As Integer) As Integer
Sub Befehl1_Click ()
End Sub
Sub Datei1_Click ()
txt_index = "0"
vbildlauf1 = 0
If datei1.Pattern <> "*.ico" Then
    make_icon
    bild1 = LoadPicture(datei1.FileName)
End If
End Sub
Sub Form_Load ()
liste1.AddItem "*.*"
liste1.AddItem "*.DLL"
liste1.AddItem "*.EXE"
liste1.AddItem "*.ICO"
liste1.ListIndex = 0
vbildlauf1 = 0
txt_index = Trim$(Str$(vbildlauf1))
End Sub
Sub Laufwerk1_Change ()
verzeichnis1 = laufwerk1
If Err <> 0 Then laufwerk1 = verzeichnis1: Beep
End Sub
Sub Liste1_Click ()
datei1.Pattern = liste1.List(liste1.ListIndex)
End Sub
Sub make_icon ()
Dim hInst As Integer, hIcon As Integer, x As Integer, exename As String
exename = datei1.Path
If Right$(exename, 1) <> "\" Then exename = exename & "\"
exename = exename & datei1.FileName
bild1 = LoadPicture()
hInst = GetWindowWord(form1.hWnd, -6)
hIcon = ExtractIcon(hInst, exename, Val(txt_index))
x = drawicon(bild1.hDC, 0, 0, hIcon)
If x = 0 And Val(txt_index) > 0 Then vbildlauf1 = vbildlauf1 - 1
End Sub
Sub txt_index_Change ()
vbildlauf1 = Val(txt_index)
End Sub
Sub VBildlauf1_Change ()
txt_index = Trim$(Str$(vbildlauf1))
make_icon
End Sub
Sub Verzeichnis1_Change ()
datei1 = verzeichnis1
End Sub