Старожил
Сообщения: 459
Благодарности: 27
|
Профиль
|
Отправить PM
| Цитировать
Здравствуйте, у кого есть свободное время сделайте пожалуйста ехе файл
Цитата:
Structure IcoItemHeader
Width.b
Height.b
Colors.b
Reserved.b
Planes.w
BitCount.w
ImageSize.l
EndStructure
Structure IcoItem
Header.IcoItemHeader
Offset.l
EndStructure
Structure IcoHeader
Reserved.w
Typ.w
ItemCount.w
Items.IcoItem[4]
EndStructure
Structure GroupIconDirItem
Header.IcoItemHeader
Id.w
EndStructure
Structure GroupIconDir
Reserved.w
Typ.w
ItemCount.w
Items.GroupIconDirItem[4]
EndStructure
Enumeration
#Window_0
EndEnumeration
;- Gadget Constants
Enumeration
#Text_0
#String_0
#Button_0
#Text_1
#String_1
#Button_1
#Button_2
EndEnumeration
Procedure Open_Window_0()
If OpenWindow(#Window_0, 255, 317, 310, 124, "Заменялка значков в прогах", #PB_Window_MinimizeGadget | #PB_Window_Invisible | #PB_Window_TitleBar | #PB_Window_ScreenCentered )
TextGadget(#Text_0, 5, 5, 270, 15, "Путь к исполняемому файлу:")
StringGadget(#String_0, 5, 20, 270, 20, "")
ButtonGadget(#Button_0, 280, 20, 25, 20, "...")
TextGadget(#Text_1, 5, 45, 270, 15, "Путь к файлу с иконкой:")
StringGadget(#String_1, 5, 60, 270, 20, "")
ButtonGadget(#Button_1, 280, 60, 25, 20, "...")
ButtonGadget(#Button_2, 85, 90, 130, 25, "Заменить значок")
HideWindow(#Window_0,0)
EndIf
EndProcedure
Procedure ReplaceIcon(EXE_File.s, ICON_File.s)
Protected Result=0, File
; EXE_File - Путь к исполняемому файлу
; ICON_File - Путь к файлу иконки
GroupIconDir.GroupIconDir
Ico.IcoHeader
InfoIcon.GroupIconDir
If FileSize(EXE_File)>0 And FileSize(ICON_File)>0 ; Файлы есть на диске
File=ReadFile(#PB_Any,ICON_File) ; Открываем файл с иконкой в режиме "Только чтение"
If File
FileSize=Lof(File) ; Размер файла в байтах
*DataIcon=AllocateMemory(FileSize) ; Память под иконку
If *DataIcon
ReadData(File, *DataIcon, FileSize) ; Копирование в память данных из файла
CloseFile(File)
CopyMemory(*DataIcon, @Ico, SizeOf(IcoHeader))
H = BeginUpdateResource_(@EXE_File, 0)
If H
If Ico\ItemCount>4
Ico\ItemCount=4
EndIf
NewGroupIconDirSize = 20*Ico\ItemCount
InfoIcon\Reserved = Ico\Reserved
InfoIcon\Typ = Ico\Typ
InfoIcon\ItemCount = Ico\ItemCount
For I = 0 To Ico\ItemCount-1
CopyMemory(@Ico\Items[i]\Header, @InfoIcon\Items[i]\Header, SizeOf(IcoItemHeader))
InfoIcon\Items[i]\Id = I+1
UpdateResource_(H, #RT_ICON, I+1, 1033, *DataIcon + Ico\Items[i]\Offset, Ico\Items[i]\Header\ImageSize)
Next i
UpdateResource_(H, #RT_GROUP_ICON, 1, 1033, @InfoIcon, NewGroupIconDirSize)
Result=EndUpdateResource_(H, #False)
EndIf
FreeMemory(*DataIcon)
EndIf
EndIf
EndIf
ProcedureReturn Result
EndProcedure
Open_Window_0()
Repeat
Event=WaitWindowEvent()
If Event=#PB_Event_Gadget
Select EventGadget()
Case #Button_0
File.s=OpenFileRequester("","","Исполняемые файлы (exe)|*.exe|Все файлы|*.*",0)
If File<>""
SetGadgetText(#String_0, File)
EndIf
Case #Button_1
File.s=OpenFileRequester("","","Файлы иконок (ico)|*.ico|Все файлы|*.*",0)
If File<>""
SetGadgetText(#String_1, File)
EndIf
Case #Button_2
EXE.s=GetGadgetText(#String_0)
ICO.s=GetGadgetText(#String_1)
If FileSize(EXE)>0 And FileSize(ICO)>0
If ReplaceIcon(EXE, ICO)<>0
MessageRequester("Все ОК", "Иконка успешно замнена", #MB_OK|#MB_ICONINFORMATION)
Else
MessageRequester("", "Произошла ошибка при замене значка", #MB_OK|#MB_ICONWARNING)
EndIf
Else
MessageRequester("Ошибка", "Не заполнено одно из полей"+Chr(10)+"либо задан не правильный путь к файлу", #MB_OK|#MB_ICONWARNING)
EndIf
EndSelect
EndIf
Until Event=#PB_Event_CloseWindow
End
|
|
