|
Registriert seit: 8. Aug 2003
124 Beiträge
Delphi 7 Professional
|
Kommentare in Jpg-Dateien - Exif oder IPTC
30. Sep 2007, 18:52
Es hat etwas gedauert, aber jetzt habe ich ein kleines Programm fertig,
mit dem man IPTC-Kommentare lesen und überschreiben kann.
ReadIPTCStream liest vorhandene Kommentare in ein Record
ReplaceIPTCStream schreibt Kommentare zurück in die Jpg-Datei.
ReplaceIPTCStream ersetzt dabei alle alten IPTC-Kommentare. Sollen vorhandene Kommentare erhalten bleiben, müssen diese unbedingt vorher mit ReadIPTCStream in das Record eingelesen werden!
Außerdem beachten: ich habe nur eine Teilauswahl der möglichen IPTC-Felder berücksichtigt. Sollten fremde Jpg´s weiterverarbeitet werden, in denen noch andere Daten-Felder vorhanden sind, werden diese unwiderruflich gelöscht. Daher wird bei ReplaceIPTCStream in eine neue Datei geschrieben. Soll die alte Datei ersetzt werden, einfach OldFilename und NewFilename identisch wählen
Record und Proceduren deklarieren:
Delphi-Quellcode:
unit uFileComment;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, StrUtils;
type IPTCrec = record
Category : string[3]; // $21 =15
Keywords :AnsiString; //max. 2000 Zeichen // $19 =25
Instructions : string[255]; // $28 =40
Date : string[8]; // $37 =55
Version : string[10]; // $46 =70
Author : string[32]; // $50 =80
Title : string[32]; // $55 =85
City : string[32]; // $5A =90
Country : string[64]; // $65 =101
Transmission : string[32]; // $67 =103
Headline : string[255]; // $69 =105
Credit : string[32]; // $6E =110
Source : string[32]; // $73 =115
Copyright : string[128]; // $74 =116
Caption :AnsiString; //max. 2000 Zeichen // $78 =120
Editor : string[32]; // $7A =122
end;
//Tipp: Array-Inhalt initialisieren: fillchar(patrecord, sizeof(patrecord), #0);
type
TForm1 = class(TForm)
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
procedure ReplaceIPTCStream(OldFilename, NewFilename: string; IPTC: IPTCrec);
procedure ReadIPTCStream(Filename: string; var IPTC: IPTCrec);
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
IPTC1 : iptcrec;
implementation
{$R *.dfm}
Daten lesen:
Delphi-Quellcode:
procedure TForm1.Button1Click(Sender: TObject);
begin
ReadIPTCStream(FileName , IPTC1);
ShowMessage(IPTC1.Caption + #13 + IPTC1.Copyright
+ #13 + IPTC1.Headline
+ #13 + IPTC1.Category
+ #13 + IPTC1.Keywords
+ #13 + IPTC1.Date
+ #13 + IPTC1.Version
+ #13 + IPTC1.Author
+ #13 + IPTC1.Title
+ #13 + IPTC1.City
+ #13 + IPTC1.Country
+ #13 + IPTC1.Transmission
+ #13 + IPTC1.Credit
+ #13 + IPTC1.Source
+ #13 + IPTC1.Editor
+ #13 + IPTC1.Instructions);
end;
Kommentare schreiben:
Delphi-Quellcode:
procedure TForm1.Button2Click(Sender: TObject);
begin
IPTC1.Caption := 'Dies ist die Beschriftung';
IPTC1.Copyright := '(c) 2007';
IPTC1.Author := 'Ralf Stehle';
IPTC1.Date := FormatDateTime('yyyymmdd', now); //Datumsformat beachten !
IPTC1.Headline := 'Dies ist die Überschrift';
ReplaceIPTCStream(OldFilename, NewFilename, IPTC1);
end;
Delphi-Quellcode:
procedure TForm1.ReadIPTCStream(Filename: string; var IPTC: IPTCrec);
var
fs: TFileStream;
ba: array of byte;
i, j: integer;
istart, ilen, slen : integer; //Beginn des Abschnittes, Ende des Abschnittes
begin
fillchar(IPTC, sizeof(IPTC), #0);
fs := TFilestream.Create(Filename, fmopenread or fmShareDenyNone);
SetLength(ba, fs.Size);
fs.Read(ba[0], Length(ba));
fs.Free;
{****************************************************************************}
{* alten FF ED-Abschnitt herauschneiden *}
{****************************************************************************}
i := 0; istart:=0; ilen:=0;
While (istart = 0) and (i<Length(ba)) do begin //Position des IPTC-Comment-Abschnittes bestimmen
if (ba[i]=$FF) and (ba[i+1]=$ED) then istart :=i;
inc(i);
end;
if istart>0 then
begin
ilen := (ba[istart+2]*256) + (ba[istart+3]);
end;
for i := iStart to iLen + iStart do
begin
if (ba[i]=$1C) and (ba[i+1]=$02) then
begin
{ $74 Copyright }
if (ba[i+2]=$74) then begin
slen := (ba[i+3]*256) + (ba[i+4]);
for j:=1 +i+4 to slen +i+4 do if ba[j] > 0 then IPTC.Copyright := IPTC.Copyright + Char(ba[j]);
end;
{ $78 Caption }
if (ba[i+2]=$78) then begin
slen := (ba[i+3]*256) + (ba[i+4]);
for j:=1 +i+4 to slen +i+4 do if ba[j] > 0 then IPTC.Caption := IPTC.Caption + Char(ba[j]);
end;
{ $69 Headline }
if (ba[i+2]=$69) then begin
slen := (ba[i+3]*256) + (ba[i+4]);
for j:=1 +i+4 to slen +i+4 do if ba[j] > 0 then IPTC.Headline := IPTC.Headline + Char(ba[j]);
end;
{ $21 Category }
if (ba[i+2]=$21) then begin
slen := (ba[i+3]*256) + (ba[i+4]);
for j:=1 +i+4 to slen +i+4 do if ba[j] > 0 then IPTC.Category := IPTC.Category + Char(ba[j]);
end;
{ $19 Keywords }
if (ba[i+2]=$19) then begin
slen := (ba[i+3]*256) + (ba[i+4]);
for j:=1 +i+4 to slen +i+4 do if ba[j] > 0 then IPTC.Keywords := IPTC.Keywords + Char(ba[j]);
end;
{ $28 Instructions }
if (ba[i+2]=$28) then begin
slen := (ba[i+3]*256) + (ba[i+4]);
for j:=1 +i+4 to slen +i+4 do if ba[j] > 0 then IPTC.Instructions := IPTC.Instructions + Char(ba[j]);
end;
{ $37 Date }
if (ba[i+2]=$37) then begin
slen := (ba[i+3]*256) + (ba[i+4]);
for j:=1 +i+4 to slen +i+4 do if ba[j] > 0 then IPTC.Date := IPTC.Date + Char(ba[j]);
end;
{ $46 Version }
if (ba[i+2]=$46) then begin
slen := (ba[i+3]*256) + (ba[i+4]);
for j:=1 +i+4 to slen +i+4 do if ba[j] > 0 then IPTC.Version := IPTC.Version + Char(ba[j]);
end;
{ $50 Author }
if (ba[i+2]=$50) then begin
slen := (ba[i+3]*256) + (ba[i+4]);
for j:=1 +i+4 to slen +i+4 do if ba[j] > 0 then IPTC.Author := IPTC.Author + Char(ba[j]);
end;
{ $55 Title }
if (ba[i+2]=$55) then begin
slen := (ba[i+3]*256) + (ba[i+4]);
for j:=1 +i+4 to slen +i+4 do if ba[j] > 0 then IPTC.Title := IPTC.Title + Char(ba[j]);
end;
{ $5A City }
if (ba[i+2]=$5A) then begin
slen := (ba[i+3]*256) + (ba[i+4]);
for j:=1 +i+4 to slen +i+4 do if ba[j] > 0 then IPTC.City := IPTC.City + Char(ba[j]);
end;
{ $65 Country }
if (ba[i+2]=$65) then begin
slen := (ba[i+3]*256) + (ba[i+4]);
for j:=1 +i+4 to slen +i+4 do if ba[j] > 0 then IPTC.Country := IPTC.Country + Char(ba[j]);
end;
{ $67 Transmission }
if (ba[i+2]=$67) then begin
slen := (ba[i+3]*256) + (ba[i+4]);
for j:=1 +i+4 to slen +i+4 do if ba[j] > 0 then IPTC.Transmission := IPTC.Transmission + Char(ba[j]);
end;
{ $6E Credit }
if (ba[i+2]=$6E) then begin
slen := (ba[i+3]*256) + (ba[i+4]);
for j:=1 +i+4 to slen +i+4 do if ba[j] > 0 then IPTC.Credit := IPTC.Credit + Char(ba[j]);
end;
{ $73 Source }
if (ba[i+2]=$73) then begin
slen := (ba[i+3]*256) + (ba[i+4]);
for j:=1 +i+4 to slen +i+4 do if ba[j] > 0 then IPTC.Source := IPTC.Source + Char(ba[j]);
end;
{ $7A Editor }
if (ba[i+2]=$7A) then begin
slen := (ba[i+3]*256) + (ba[i+4]);
for j:=1 +i+4 to slen +i+4 do if ba[j] > 0 then IPTC.Editor := IPTC.Editor + Char(ba[j]);
end;
end;
end;
end;
Delphi-Quellcode:
procedure TForm1.ReplaceIPTCStream(OldFilename, NewFilename: string; IPTC: IPTCrec);
var
fs: TFileStream;
ba1, ba2, ba3: array of byte;
i, j, lenSum, istart, ilen: integer; //istart: Beginn des Abschnittes, ilen: Länge (Ende) des Abschnittes
lenCaption,
lenCopyright,
lenHeadline,
lenAuthor,
lenCategory,
lenCity,
lenCountry,
lenCredit,
lenDate,
lenEditor,
lenInstructions,
lenSource,
lenTitle,
lenTransmission,
lenVersion,
lenKeywords: integer;
begin
//ba1 ist Originaldatei
//ba2 sind die neuen IPTC-Daten
//ba3 ist neu zusammengesetzte Daten
fs := TFilestream.Create(OldFilename, fmopenread or fmShareDenyNone);
SetLength(ba1, fs.Size);
fs.Read(ba1[0], Length(ba1));
fs.Free;
{****************************************************************************}
{* alten FF ED-Abschnitt herauschneiden *}
{****************************************************************************}
i := 0; istart:=0; ilen:=0;
While (istart = 0) and (i<Length(ba1)-1) do begin //Position des IPTC-Comment-Abschnittes bestimmen
if (ba1[i]=$FF) and (ba1[i+1]=$ED) then istart :=i;
inc(i);
end;
if istart>0 then
begin
ilen := (ba1[istart+2] div 255) + (ba1[istart+3] mod 255) + 2;
//alle Bytes vom Ende des Abscbnittes auf den Anfang umschichten
for i := (istart+ilen) to High(ba1) do ba1[i-ilen] := ba1[i];//for i := Low(ba1) to High(ba1) do
SetLength(ba1, length(ba1)-ilen);
end;
{****************************************************************************}
{* IPTC-Einträge und Header in ba2 schreiben *}
{****************************************************************************}
lenAuthor := Length(IPTC.Author);
lenCaption := Length(IPTC.Caption);
lenCategory := Length(IPTC.Category);
lenCity := Length(IPTC.City);
lenCopyright := Length(IPTC.Copyright);
lenCountry := Length(IPTC.Country);
lenCredit := Length(IPTC.Credit);
lenDate := Length(IPTC.Date);
lenEditor := Length(IPTC.Editor);
lenHeadline := Length(IPTC.Headline);
lenInstructions := Length(IPTC.Instructions);
lenKeywords := Length(IPTC.Keywords);
lenSource := Length(IPTC.Source);
lenTitle := Length(IPTC.Title);
lenTransmission := Length(IPTC.Transmission);
lenVersion := Length(IPTC.Version);
//if lenCaption + lenCopyright + lenHeadline = 0 then exit; kein Exit, da so die Einträge gelöscht werden könne
//Längenberechnung
lenSum := 28; //Headerlänge
if lenAuthor > 0 then lenSum := lenSum + 5 + lenAuthor; //5 = Art 3, Längenbytes 2
if lenCaption > 0 then lenSum := lenSum + 5 + lenCaption; //5 = Art 3, Längenbytes 2
if lenCategory > 0 then lenSum := lenSum + 5 + lenCategory; //5 = Art 3, Längenbytes 2
if lenCity > 0 then lenSum := lenSum + 5 + lenCity; //5 = Art 3, Längenbytes 2
if lenCopyright > 0 then lenSum := lenSum + 5 + lenCopyright; //5 = Art 3, Längenbytes 2
if lenCountry > 0 then lenSum := lenSum + 5 + lenCountry; //5 = Art 3, Längenbytes 2
if lenCredit > 0 then lenSum := lenSum + 5 + lenCredit; //5 = Art 3, Längenbytes 2
if lenDate > 0 then lenSum := lenSum + 5 + lenDate; //5 = Art 3, Längenbytes 2
if lenEditor > 0 then lenSum := lenSum + 5 + lenEditor; //5 = Art 3, Längenbytes 2
if lenHeadline > 0 then lenSum := lenSum + 5 + lenHeadline; //5 = Art 3, Längenbytes 2
if lenInstructions > 0 then lenSum := lenSum + 5 + lenInstructions; //5 = Art 3, Längenbytes 2
if lenKeywords > 0 then lenSum := lenSum + 5 + lenKeywords; //5 = Art 3, Längenbytes 2
if lenSource > 0 then lenSum := lenSum + 5 + lenSource; //5 = Art 3, Längenbytes 2
if lenTitle > 0 then lenSum := lenSum + 5 + lenTitle; //5 = Art 3, Längenbytes 2
if lenTransmission > 0 then lenSum := lenSum + 5 + lenTransmission; //5 = Art 3, Längenbytes 2
if lenVersion > 0 then lenSum := lenSum + 5 + lenVersion; //5 = Art 3, Längenbytes 2
lenSum := lenSum + 1; //abschließendes 00-Byte
SetLength(ba2, lenSum + 2);
SetLength(ba3, Length(ba1) + Length(ba2) + 2);
i := 0;
{FF ED -> IPTC Tag}
ba2[i+ 0] :=$FF;
ba2[i+ 1] :=$ED;
{Länge des Bereichs incl. Längenbytes bis zum Ende mit abschließendem 00-Byte}
ba2[i+ 2] :=lenSum div 255;
ba2[i+ 3] :=lenSum mod 255;
{IPTC-Header, keine Ahnung was das alles bedeutet}
ba2[i+ 4] :=$50;
ba2[i+ 5] :=$68;
ba2[i+ 6] :=$6F;
ba2[i+ 7] :=$74;
ba2[i+ 8] :=$6F;
ba2[i+ 9] :=$73;
ba2[i+10] :=$68;
ba2[i+11] :=$6F;
ba2[i+12] :=$70;
ba2[i+13] :=$20;
ba2[i+14] :=$33;
ba2[i+15] :=$2E;
ba2[i+16] :=$30;
ba2[i+17] :=$00;
ba2[i+18] :=$38;
ba2[i+19] :=$42;
ba2[i+20] :=$49;
ba2[i+21] :=$4D;
ba2[i+22] :=$04;
ba2[i+23] :=$04;
ba2[i+24] :=$00;
ba2[i+25] :=$00;
ba2[i+26] :=$00;
ba2[i+27] :=$00;
{Längen-Bytes bis zum Ende ohne abschließendes 00-Byte und ohne die 2 Längenbytes mitzuzählen}
ba2[i+28]:= (lenSum-29) div 255;
ba2[i+29]:= (lenSum-29) mod 255;
if lenHeadline>0 then
begin
{Art des IPTC-Eintrages, 1C 02 xx $69 = Headline}
ba2[i+30]:=$1C; ba2[i+31]:=$02; ba2[i+32]:=$69;
{Längen-Bytes ohne die 2 Längenbytes mitzuzählen und ohne abschließendes 00-Byte}
ba2[i+33]:= lenHeadline div 255;
ba2[i+34]:= lenHeadline mod 255;
for j := 1 to lenHeadline do ba2[i+34+j] := Ord(IPTC.Headline[j]);
i := i + 5 + lenHeadline;
end;
if lenCopyright>0 then
begin
{Art des IPTC-Eintrages, 1C 02 xx $74 = Copyright }
ba2[i+30]:=$1C; ba2[i+31]:=$02; ba2[i+32]:=$74;
{Längen-Bytes ohne die 2 Längenbytes mitzuzählen und ohne abschließendes 00-Byte}
ba2[i+33]:= lenCopyright div 255;
ba2[i+34]:= lenCopyright mod 255;
for j := 1 to lenCopyright do ba2[i+34+j] := Ord(IPTC.Copyright[j]);
i := i + 5 + lenCopyright;
end;
if lenCaption>0 then
begin
{Art des IPTC-Eintrages, 1C 02 xx }
ba2[i+30]:=$1C; ba2[i+31]:=$02; ba2[i+32]:=$78;
{Längen-Bytes ohne die 2 Längenbytes mitzuzählen und ohne abschließendes 00-Byte}
ba2[i+33]:= lenCaption div 255;
ba2[i+34]:= lenCaption mod 255;
for j := 1 to lenCaption do ba2[i+34+j] := Ord(IPTC.Caption[j]);
i := i + 5 + lenCaption;
end;
if lenAuthor>0 then
begin
{Art des IPTC-Eintrages, 1C 02 xx }
ba2[i+30]:=$1C; ba2[i+31]:=$02; ba2[i+32]:=$50;
{Längen-Bytes ohne die 2 Längenbytes mitzuzählen und ohne abschließendes 00-Byte}
ba2[i+33]:= lenAuthor div 255;
ba2[i+34]:= lenAuthor mod 255;
for j := 1 to lenAuthor do ba2[i+34+j] := Ord(IPTC.Author[j]);
i := i + 5 + lenAuthor;
end;
if lenCategory>0 then
begin
{Art des IPTC-Eintrages, 1C 02 xx }
ba2[i+30]:=$1C; ba2[i+31]:=$02; ba2[i+32]:=$21;
{Längen-Bytes ohne die 2 Längenbytes mitzuzählen und ohne abschließendes 00-Byte}
ba2[i+33]:= lenCategory div 255;
ba2[i+34]:= lenCategory mod 255;
for j := 1 to lenCategory do ba2[i+34+j] := Ord(IPTC.Category[j]);
i := i + 5 + lenCategory;
end;
if lenCity>0 then
begin
{Art des IPTC-Eintrages, 1C 02 xx }
ba2[i+30]:=$1C; ba2[i+31]:=$02; ba2[i+32]:=$5A;
{Längen-Bytes ohne die 2 Längenbytes mitzuzählen und ohne abschließendes 00-Byte}
ba2[i+33]:= lenCity div 255;
ba2[i+34]:= lenCity mod 255;
for j := 1 to lenCity do ba2[i+34+j] := Ord(IPTC.City[j]);
i := i + 5 + lenCity;
end;
if lenCountry>0 then
begin
{Art des IPTC-Eintrages, 1C 02 xx }
ba2[i+30]:=$1C; ba2[i+31]:=$02; ba2[i+32]:=$65;
{Längen-Bytes ohne die 2 Längenbytes mitzuzählen und ohne abschließendes 00-Byte}
ba2[i+33]:= lenCountry div 255;
ba2[i+34]:= lenCountry mod 255;
for j := 1 to lenCountry do ba2[i+34+j] := Ord(IPTC.Country[j]);
i := i + 5 + lenCountry;
end;
if lenCredit>0 then
begin
{Art des IPTC-Eintrages, 1C 02 xx }
ba2[i+30]:=$1C; ba2[i+31]:=$02; ba2[i+32]:=$6E;
{Längen-Bytes ohne die 2 Längenbytes mitzuzählen und ohne abschließendes 00-Byte}
ba2[i+33]:= lenCredit div 255;
ba2[i+34]:= lenCredit mod 255;
for j := 1 to lenCredit do ba2[i+34+j] := Ord(IPTC.Credit[j]);
i := i + 5 + lenCredit;
end;
if lenDate>0 then
begin
{Art des IPTC-Eintrages, 1C 02 xx }
ba2[i+30]:=$1C; ba2[i+31]:=$02; ba2[i+32]:=$37;
{Längen-Bytes ohne die 2 Längenbytes mitzuzählen und ohne abschließendes 00-Byte}
ba2[i+33]:= lenDate div 255;
ba2[i+34]:= lenDate mod 255;
for j := 1 to lenDate do ba2[i+34+j] := Ord(IPTC.Date[j]);
i := i + 5 + lenDate;
end;
if lenEditor>0 then
begin
{Art des IPTC-Eintrages, 1C 02 xx }
ba2[i+30]:=$1C; ba2[i+31]:=$02; ba2[i+32]:=$7A;
{Längen-Bytes ohne die 2 Längenbytes mitzuzählen und ohne abschließendes 00-Byte}
ba2[i+33]:= lenEditor div 255;
ba2[i+34]:= lenEditor mod 255;
for j := 1 to lenEditor do ba2[i+34+j] := Ord(IPTC.Editor[j]);
i := i + 5 + lenEditor;
end;
if lenInstructions>0 then
begin
{Art des IPTC-Eintrages, 1C 02 xx }
ba2[i+30]:=$1C; ba2[i+31]:=$02; ba2[i+32]:=$28;
{Längen-Bytes ohne die 2 Längenbytes mitzuzählen und ohne abschließendes 00-Byte}
ba2[i+33]:= lenInstructions div 255;
ba2[i+34]:= lenInstructions mod 255;
for j := 1 to lenInstructions do ba2[i+34+j] := Ord(IPTC.Instructions[j]);
i := i + 5 + lenInstructions;
end;
if lenSource>0 then
begin
{Art des IPTC-Eintrages, 1C 02 xx }
ba2[i+30]:=$1C; ba2[i+31]:=$02; ba2[i+32]:=$73;
{Längen-Bytes ohne die 2 Längenbytes mitzuzählen und ohne abschließendes 00-Byte}
ba2[i+33]:= lenSource div 255;
ba2[i+34]:= lenSource mod 255;
for j := 1 to lenSource do ba2[i+34+j] := Ord(IPTC.Source[j]);
i := i + 5 + lenSource;
end;
if lenTitle>0 then
begin
{Art des IPTC-Eintrages, 1C 02 xx }
ba2[i+30]:=$1C; ba2[i+31]:=$02; ba2[i+32]:=$55;
{Längen-Bytes ohne die 2 Längenbytes mitzuzählen und ohne abschließendes 00-Byte}
ba2[i+33]:= lenTitle div 255;
ba2[i+34]:= lenTitle mod 255;
for j := 1 to lenTitle do ba2[i+34+j] := Ord(IPTC.Title[j]);
i := i + 5 + lenTitle;
end;
if lenTransmission>0 then
begin
{Art des IPTC-Eintrages, 1C 02 xx }
ba2[i+30]:=$1C; ba2[i+31]:=$02; ba2[i+32]:=$67;
{Längen-Bytes ohne die 2 Längenbytes mitzuzählen und ohne abschließendes 00-Byte}
ba2[i+33]:= lenTransmission div 255;
ba2[i+34]:= lenTransmission mod 255;
for j := 1 to lenTransmission do ba2[i+34+j] := Ord(IPTC.Transmission[j]);
i := i + 5 + lenTransmission;
end;
if lenVersion>0 then
begin
{Art des IPTC-Eintrages, 1C 02 xx }
ba2[i+30]:=$1C; ba2[i+31]:=$02; ba2[i+32]:=$46;
{Längen-Bytes ohne die 2 Längenbytes mitzuzählen und ohne abschließendes 00-Byte}
ba2[i+33]:= lenVersion div 255;
ba2[i+34]:= lenVersion mod 255;
for j := 1 to lenVersion do ba2[i+34+j] := Ord(IPTC.Version[j]);
i := i + 5 + lenVersion;
end;
if lenKeywords>0 then
begin
{Art des IPTC-Eintrages, 1C 02 xx }
ba2[i+30]:=$1C; ba2[i+31]:=$02; ba2[i+32]:=$19;
{Längen-Bytes ohne die 2 Längenbytes mitzuzählen und ohne abschließendes 00-Byte}
ba2[i+33]:= lenKeywords div 255;
ba2[i+34]:= lenKeywords mod 255;
for j := 1 to lenKeywords do ba2[i+34+j] := Ord(IPTC.Keywords[j]);
i := i + 5 + lenKeywords;
end;
{abschließendes 00-Byte }
ba2[i+30]:=$00;
{****************************************************************************}
{* neue Datei ba3 aus ba1 und ba2 erzeugen *}
{****************************************************************************}
for i := 0 to 1 do //SOF bleibt gleich
ba3[i] := ba1[i];
for i := 0 to High(ba2) do //IPCT-Daten aus ba2 anfügen
ba3[i+2]:= ba2[i];
for i := 2 to High(ba1) do //restliche Bilddaten anschließen
ba3[i+High(ba2)+1]:= ba1[i];
//Buffer ba3 in neues File schreiben
fs := TFileStream.Create(NewFilename, fmCreate);
try
fs.Writebuffer(ba3[0], Length(ba3));
finally
fs.Free;
end;
end;
|