was ist neu ¦  programmier tips ¦  indy artikel ¦  intraweb artikel ¦  informationen ¦  links ¦  interviews
 sonstiges ¦  tutorials ¦  Add&Win Gewinnspiel

Tips (1548)

Dateien (137)
Datenbanken (90)
Drucken (35)
Grafik (116)
IDE (21)
Indy (5)
Internet / LAN (131)
IntraWeb (0)
Mathematik (76)
Multimedia (45)
Oberfläche (107)
Objekte/
ActiveX (51)

OpenTools API (3)
Sonstiges (127)
Strings (83)
System (268)
VCL (243)

Tips sortiert nach
Komponente


Tip suchen

Tip hinzufügen

Add&Win Gewinnspiel

Werbung

17 Visitors Online


 
...eine Resourcendatei aus den Dateien eines Verzeichnisses erzeugen?
Autor: Max Kleiner
Homepage: http://max.kleiner.com
[ Tip ausdrucken ]  

Tip Bewertung (7):  
     


{
We want to get an output like this in a *.res format:

BMP1 BITMAP "bmp1ueli.bmp"
BMP2 BITMAP "bmp2uml.bmp"
BMP3 BITMAP "bmp3.bmp"
.....

1. We put all the files in a directory
2. We start the scriptResourceFile() procedure
   gets all the files like *.bmp or *.wav in a *.rc format
3. Activate the resource-compiler
}

procedure TStatForm.scriptresourceFile2(restype: string);
var
  
f: textfile;
  ResFile: ShortString;
  resstr: string;
  s: array[0..2048] of Char;
  i, filecount: Byte;
  myResList: TStringList;
begin
  
myresList := TStringList.Create;
  filecount := getfilelist(myResList);
  if filecount > totalPictures then
    
filecount := totalPictures;
  for i := 0 to filecount - 1 do 
  begin
    
resstr := Format('%s%d %s %s%s%s',
      ['bmp', i, restype, '"', myReslist.Strings[i], '"']);
    StrCat(s, PChar(resstr));
    StrCat(s, #13#10);
  end;
  ResFile := 'membmp.rc';
  AssignFile(f, ResFile);
  Rewrite(f);
  Write(f, s);
  closefile(f);
  myResList.Free;
  compileResfile(ResFile);
end;


procedure TStatForm.btnGenClick(Sender: TObject);
begin
  
scriptResourceFile2('Bitmap');
end;


function TStatForm.getFileList(aList: TStringList): Integer;
var
  
DOSerr: Integer;
  fsrch: TsearchRec;
begin
  
Result := 0;
  doserr := FindFirst('*.bmp', faAnyFile, fsrch);
  if (DOSerr = 0) then 
  begin
    while 
(DOSerr = 0) do 
    begin
      
aList.Add(fsrch.Name);
      if (fsrch.attr and faDirectory) = 0 then Inc(Result);
      DOSerr := findnext(fsrch);
    end;
    findClose(fsrch);
  end;
end;


procedure TStatForm.compileResfile(vfile: string);
var 
  
i, iCE: Integer;
begin
  
{$IFDEF MSWINDOWS}
  
iCE := shellapi.shellExecute(0, nil, PChar('BRCC32.exe'),
    PChar(vfile), nil, 0);
  i   := 0;
  repeat
    
Inc(i);
    sleep(600);
    Application.ProcessMessages;
  until i >= 10;
  if iCE <= 32 then ShowMessage('compError Nr. ' + IntToStr(iCE));
  {$ENDIF}
end;


 

Bewerten Sie diesen Tipp:

dürftig
ausgezeichnet


Copyright © by SwissDelphiCenter.ch
All trademarks are the sole property of their respective owners