17 Ocak 2012 Salı

Dosya Iconlarını Alın

Posted by Unknown On 09:11 No comments

Formumuza 2 adet Label, 2 adet TextBox, 1 adet Picture, 1 adet CommandButton koyalım.
----------------------------------------------------------------------------------------------------------------------------

Private Declare Function ExtractIconEx Lib "shell32.dll" Alias "ExtractIconExA" (ByVal lpszFile As String, ByVal nIconIndex As Long, phiconLarge As Long, phiconSmall As Long, ByVal nIcons As Long) As Long
Private Declare Function DrawIcon Lib "user32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal hIcon As Long) As Long

Private Sub Command1_Click()
Call IconYukle(Picture1, Text1.Text, Text2.Text)
End Sub

Public Sub IconYukle(lPictureBox As PictureBox, lFileName As String, IconIndex As Long)
lPictureBox.Cls
Dim icon As Long
ExtractIconEx lFileName, IconIndex, icon, ByVal 0&, 1
DrawIcon lPictureBox.hdc, 0, 0, icon
End Sub

Private Sub Form_Load()
Label1.Top = 120
Label1.Left = 120
Label1.AutoSize = True
Label1.Caption = "Dosya Adı:"
Label2.Top = 480
Label2.Left = 120
Label2.AutoSize = True
Label2.Caption = "İcon İndexi:"
Text1.Top = 120
Text1.Left = 960
Text1.Width = 2000
Text1.Height = 285
Text1.Text = "shell32.dll"
Text2.Top = 480
Text2.Left = 960
Text2.Width = 2000
Text2.Height = 285
Text2.Text = 0
Picture1.AutoRedraw = True
Picture1.Left = 3000
Picture1.Top = 120
Picture1.Width = 1000
Picture1.Height = 1000
Command1.Left = 120
Command1.Top = 840
Command1.Width = 2775
Command1.Height = 400
Command1.Caption = "İcon Yükle"
Me.Width = 4185
Me.Height = 1700
End Sub

0 yorum:

Yorum Gönder