'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function loading_shortucs()
Dim tmp_len As Long
Dim kIn As Integer
Dim I As Integer
Dim j As Integer
Dim h As Integer
Dim kBl As Boolean
Dim tmp_txt$ 'As Single
Dim tmp_txt0$ 'As Single
Dim tmp_txt1$ 'As Single
Dim num_cons As Single
Dim num_icons As Integer
Dim name_of_file As String
For I = 0 To 7
Image2(I).Cls
tmp_txt$ = iconsing(I)
name_of_file = Left$(tmp_txt$, Len(tmp_txt$) - 3)
tmp_txt0$ = Right$(tmp_txt$, 2)
tmp_txt1$ = Left$(tmp_txt0$, 1)
If tmp_txt1$ = " " Then
num_icons = CInt(Right$(tmp_txt0$, 1))
Else
num_icons = CInt(tmp_txt0$)
End If
load_ico_from_file name_of_file, num_icons, I
Next I
'MsgBox num_icons, vbCritical, num_icons
End Function
Public Sub load_ico_from_file(sFileName As String, ico_num As Integer, num_btn As Integer)
On Error GoTo 1
Dim hIcon As Long, infIcon As ICONINFO
Dim nX As Integer, nY As Integer
hIcon = ExtractIcon(0, sFileName, ico_num)
GetIconInfo hIcon, infIcon
Image2(num_btn).Cls
nX = (Image2(num_btn).ScaleWidth \ 2) - infIcon.xHotspot
nY = (Image2(num_btn).ScaleHeight \ 2) - infIcon.yHotspot
DrawIcon Image2(num_btn).hdc, nX, nY, hIcon
DestroyIcon hIcon
Exit Sub
1 End
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
В модули:
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Public Type ICONINFO
fIcon As Long
xHotspot As Long
yHotspot As Long
hbmMask As Long
hbmColor As Long
End Type
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Public Declare Function GetIconInfo Lib "user32" (ByVal hIcon As Long, piconinfo As ICONINFO) As Long
Public Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long
Public Declare Function DestroyIcon Lib "user32" (ByVal hIcon As Long) As Long
Public Declare Function DrawIcon Lib "user32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal hIcon As Long) As Long
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Public Function load_ico_from_file(File_Name As String, ico_num As Integer, num_btn As Integer)
On Error GoTo 1
Dim hIcon As Long, infIcon As ICONINFO
Dim nX As Integer, nY As Integer
hIcon = ExtractIcon(0, File_Name, ico_num)
GetIconInfo hIcon, infIcon
Frmmain.Image2(num_btn).Cls
nX = (Frmmain.Image2(num_btn).ScaleWidth \ 2) - infIcon.xHotspot
nY = (Frmmain.Image2(num_btn).ScaleHeight \ 2) - infIcon.yHotspot
DrawIcon Frmmain.Image2(num_btn).hdc, nX, nY, hIcon
DestroyIcon hIcon
Exit Function
1 End
End Function
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Короче не знаю в чем причина, ошибок ни каких не выдает, но иконки с экзешников не вычерпывает!!!!
одним словом пусто!!!!!!!!!
Чего чего????
