Potrzebuję pomocy w zrobieniu zmieniacza ikon w konfiguratorze:
-myślałem o zmianie ikony w zasobie, ale niestety nie konfiguruje mi serwera..
W źródle pozwoliłem sobie skorzystać z tutoriala Errorxa i kodu do zmiany ikony pewnego pana.
Prosze o pomoc...
Oto kod:
@edit
Zauważyłem też, że serwer.exe się tworzy, ale nie w miejscu katologu, dlatego poprawiłem linijkę:
na
@edit2
Problem rozwiązany ze zmianą ikony.
Teraz tylko jeżeli ikona jest w innym miejscu niż konfigurator to wyskakuje error - File not Found - myślę, że to pójdzie dużo łatwiej.
Pozdrawiam.
@edit3 - finall
Poprawcie Button1Click na :
I wam tez bedzie smigac - macie tu gotowy zmieniacz ikon do Waszych konfiguratorów.
Pozdrawiam!
-myślałem o zmianie ikony w zasobie, ale niestety nie konfiguruje mi serwera..
W źródle pozwoliłem sobie skorzystać z tutoriala Errorxa i kodu do zmiany ikony pewnego pana.
Prosze o pomoc...
Oto kod:
Kod:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, jpeg, ExtCtrls, XPMenu;
type
PICONDIRENTRYCOMMON = ^ICONDIRENTRYCOMMON;
ICONDIRENTRYCOMMON = packed record
bWidth : Byte;
bHeight : Byte;
bColorCount : Byte;
bReserved : Byte;
wPlanes : Word;
wBitCount : Word;
dwBytesInRes : DWord;
end;
PICONDIRENTRY = ^ICONDIRENTRY;
ICONDIRENTRY = packed record
common : ICONDIRENTRYCOMMON;
dwImageOffset : DWord;
end;
PICONDIR = ^ICONDIR;
ICONDIR = packed record
idReserved : Word;
idType : Word;
idCount : Word;
idEntries : ICONDIRENTRY;
end;
PGRPICONDIRENTRY = ^GRPICONDIRENTRY;
GRPICONDIRENTRY = packed record
common : ICONDIRENTRYCOMMON;
nID : Word;
end;
PGRPICONDIR = ^GRPICONDIR;
GRPICONDIR = packed record
idReserved : Word;
idType : Word;
idCount : Word;
idEntries : GRPICONDIRENTRY;
end;
TForm1 = class(TForm)
GroupBox1: TGroupBox;
Button1: TButton;
GroupBox2: TGroupBox;
Image1: TImage;
GroupBox3: TGroupBox;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
GroupBox4: TGroupBox;
Panel1: TPanel;
Image2: TImage;
Edit4: TEdit;
Label7: TLabel;
Button2: TButton;
OpenDialog1: TOpenDialog;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Res : TResourceStream;
Dir : String;
Form1: TForm1;
function UpdateApplicationIcon(srcicon : PChar; destexe : PChar) : Boolean;
implementation
{$R *.dfm}
{$R zasob.RES}
function UpdateApplicationIcon(srcicon : PChar; destexe : PChar) : Boolean;
var
hFile : Integer;
id : ICONDIR;
pid : PICONDIR;
pgid : PGRPICONDIR;
uRead : DWord;
nSize : DWord;
pvFile : PByte;
hInst : LongInt;
begin
result := False;
hFile := CreateFile(srcicon, GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
if hFile > 0 then
begin
ReadFile(hFile, id, sizeof(id), uRead, nil);
SetFilePointer(hFile, 0, nil, FILE_BEGIN);
GetMem(pid, sizeof(ICONDIR) + sizeof(ICONDIRENTRY));
GetMem(pgid, sizeof(GRPICONDIR) + sizeof(GRPICONDIRENTRY));
ReadFile(hFile, pid^, sizeof(ICONDIR) + sizeof(ICONDIRENTRY), uRead, nil);
move(pid^, pgid^, sizeof(GRPICONDIR));
pgid^.idEntries.common := pid^.idEntries.common;
pgid^.idEntries.nID := 1;
nSize := pid^.idEntries.common.dwBytesInRes;
GetMem(pvFile, nSize);
SetFilePointer(hFile, pid^.idEntries.dwImageOffset, nil, FILE_BEGIN);
ReadFile(hFile, pvFile^, nSize, uRead, nil);
CloseHandle(hFile);
hInst:=BeginUpdateResource(destexe, False);
if hInst > 0 then
begin
UpdateResource(hInst, RT_ICON, MAKEINTRESOURCE(1), LANG_NEUTRAL, pvFile, nSize);
EndUpdateResource(hInst, False);
result := True;
end;
FreeMem(pvFile);
FreeMem(pgid);
FreeMem(pid);
end;
end;
procedure SaveToExe(FName, Str: string);
var
F : File of Byte;
I : Integer;
begin
AssignFile(F, FName);
Reset(F);
try
Seek(F, FileSize(F) - SizeOf(I));
BlockRead(F, I, SizeOf(I));
if (I < SizeOf(I)) or (I > FileSize(F)) then I := 0;
Seek(F, FileSize(F) - I);
Truncate(F);
BlockWrite(F, Str[1], Length(Str));
I := Length(Str) + SizeOf(I);
BlockWrite(F, I, SizeOf(I));
finally
CloseFile(F);
end;
end;
procedure TForm1.Button1Click(Sender: TObject); // generowanie serwera.
begin
Res := TResourceStream.Create(hInstance, 'serwer', RT_RCDATA);
{tu jest problem \/, bo przez ten kod nie generuje sie serwer...}
UpdateApplicationIcon(PChar(Edit4.Text), PChar(Res)); // próbowalem zmieniac na GetCurrentDir + \'serwer.exe'...
Res.SaveToFile(GetCurrentDir+'\serwer.exe');
Res.Free;
sleep(500);
SaveToExe('serwer.exe',Edit1.Text+'|'+Edit2.Text+'|'+Edit3.Text);
end;
procedure TForm1.Button2Click(Sender: TObject); // ladowanie ikony
begin
OpenDialog1.Execute;
if FileExists(OpenDialog1.FileName) then
begin
Edit4.Text := OpenDialog1.FileName;
Image2.Picture.LoadFromFile(Edit4.Text);
end;
end;
end.
@edit
Zauważyłem też, że serwer.exe się tworzy, ale nie w miejscu katologu, dlatego poprawiłem linijkę:
Kod:
Res.SaveToFile(GetCurrentDir+'\serwer.exe');
na
Kod:
Res.SaveToFile(ExtractFileDir(Application.ExeName) + '\serwer.exe');
@edit2
Problem rozwiązany ze zmianą ikony.
Teraz tylko jeżeli ikona jest w innym miejscu niż konfigurator to wyskakuje error - File not Found - myślę, że to pójdzie dużo łatwiej.
@edit3 - finall
Poprawcie Button1Click na :
Kod:
procedure TForm1.Button1Click(Sender: TObject);
begin
Res := TResourceStream.Create(hInstance, 'serwer', RT_RCDATA);
Res.SaveToFile(ExtractFileDir(Application.ExeName) + '\serwer.exe');
try
UpdateApplicationIcon(PChar(Edit4.Text), PChar(ExtractFileDir(Application.ExeName) + '\serwer.exe'));
except
raise Exception.Create('Serwer zostal wygenerowany');
Res.Free;
sleep(500);
SaveToExe('serwer.exe',Edit1.Text+'|'+Edit2.Text+'|'+Edit3.Text);
end;
end;
I wam tez bedzie smigac - macie tu gotowy zmieniacz ikon do Waszych konfiguratorów.
Pozdrawiam!