|
From: Peter T. <pe...@us...> - 2003-08-24 01:00:26
|
Update of /cvsroot/jvcl/dev/JVCL3/devtools/Res2Bmp
In directory sc8-pr-cvs1:/tmp/cvs-serv4702/JVCL3/devtools/Res2Bmp
Added Files:
Res2Bmp.dof Res2Bmp.dpr Res2BmpUtils.pas
Log Message:
- Copied jvcl/devtools and jvcl/examples dev/JVCL3
- Copied JVCLConvert *.dat files to dev/JVCL3/converter
--- NEW FILE: Res2Bmp.dof ---
[Directories]
OutputDir=..\bin
UnitOutputDir=..\dcu
--- NEW FILE: Res2Bmp.dpr ---
program Res2Bmp;
{$APPTYPE CONSOLE}
uses
Res2BmpUtils in 'Res2BmpUtils.pas',
JTools in '..\Common\JTools.pas';
begin
Run;
end.
--- NEW FILE: Res2BmpUtils.pas ---
unit Res2BmpUtils;
interface
procedure Run;
implementation
uses
Windows, SysUtils, Classes, Graphics,
unitResFile, unitResourceGraphics, // get these from
JTools;
procedure ShowHelp;
begin
writeln('');
writeln('');
writeln('Res2Bmp: extracts bitmaps from resource files');
writeln('');
writeln('Usage:');
writeln(ExtractFilename(ParamStr(0)), ' <filemask>');
writeln('<filemask>'#9'the files to extract bitmaps from. Defaults to <curdir>\*.dcr');
writeln('');
writeln('The extracted bitmap files are written to the same folder as the resource file(s)');
end;
procedure ExtractBmpResources(const FileMask: string);
var
fd: TWin32FindData;
H: THandle;
R: TResModule;
i: integer;
P: TPicture;
Folder: string;
begin
H := FindFirstFile(PChar(FileMask), fd);
if H <> INVALID_HANDLE_VALUE then
begin
Folder := ExtractFilePath(FileMask);
R := TResModule.Create;
P := TPicture.Create;
try
repeat
writeln('Reading resources from ', string(fd.cFileName), '...');
R.LoadFromFile(Folder + string(fd.cFileName));
for i := 0 to R.ResourceCount - 1 do
if R.ResourceDetails[i] is TBitmapResourceDetails then
begin
TBitmapResourceDetails(R.ResourceDetails[i]).GetImage(P);
if Assigned(P.Graphic) and not P.Graphic.Empty then
begin
writeln('Writing ', UpperCase(R.ResourceDetails[i].ResourceName), '.BMP...');
P.SaveToFile(Folder + UpperCase(R.ResourceDetails[i].ResourceName) + '.BMP');
end
else
writeln('No bitmaps found in ', string(fd.cFileName));
end;
until not FindNextFile(H, fd);
writeln('Done!');
finally
R.Free;
P.Free;
end;
if H <> INVALID_HANDLE_VALUE then
Windows.FindClose(H);
end;
end;
procedure Run;
var
FileMask: string;
begin
try
if GetCmdSwitchValue('h', ['-', '/'], FileMask, true) or
GetCmdSwitchValue('?', ['-', '/'], FileMask, true) then
begin
ShowHelp;
Exit;
end;
if ParamCount = 0 then
FileMask := ExtractFilePath(ParamStr(0)) + '*.dcr'
else
FileMask := ParamStr(1);
ExtractBmpResources(FileMask);
except
on E: Exception do
writeln('ERROR: ', E.Message);
end;
end;
end.
|