Форум на Исходниках.RU

uses

GDIPOBJ,

GDIPAPI,

GDIPUTIL,

ActiveX;

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);

function GetAdvTagData(const ID: Integer): String;

const

TAG_Title = 40091;

TAG_Comments = 40092;

TAG_Author = 40093;

TAG_KeyWords = 40094;

TAG_Subject = 40095;

begin

case ID of

TAG_Title: Result := 'Title';

TAG_Comments: Result := 'Comments';

TAG_Author: Result := 'Author';

TAG_KeyWords: Result := 'KeyWords';

TAG_Subject: Result := 'Subject';

else

Result := '';

end;

var

GDIImage: TGPImage;

I, ACount, PropSize: Integer;

PropertyesList: array of TPropId;

PropertyItem: PPropertyItem;

PropName: String;

PropValue: WideString;

ByteValue: DWORD;

begin

if OpenDialog1.Execute then

begin

Memo1.Clear;

GDIImage := TGPImage.Create(OpenDialog1.FileName);

try

ACount := GDIImage.GetPropertyCount;

SetLength(PropertyesList, ACount);

GDIImage.GetPropertyIdList(ACount, @PropertyesList[0]);

for I := 0 to ACount - 1 do

begin

PropSize := GDIImage.GetPropertyItemSize(PropertyesList[I]);

GetMem(PropertyItem, PropSize);

try

GDIImage.GetPropertyItem(PropertyesList[I], PropSize, PropertyItem);

PropName := GetAdvTagData(PropertyesList[I]);

if PropName <> '' then

begin

SetLength(PropValue, PropertyItem^.length);

Move(PropertyItem^.value^, PropValue[1], PropertyItem^.length);

end

else

begin

PropName := GetMetaDataIDString(PropertyItem^.id);

ByteValue := 0;

if PropertyItem^.type_ in

[PropertyTagTypeByte, PropertyTagTypeShort,

PropertyTagTypeLong] then

begin

if PropertyItem^.length <= 4 then

begin

Move(PropertyItem^.value^, ByteValue, PropertyItem^.length);

PropValue := IntToStr(ByteValue);

end

else

begin

SetLength(PropValue, PropertyItem^.length);

Move(PropertyItem^.value^, PropValue[1], PropertyItem^.length);

end;

Memo1.Lines.Add(PropName + ' - ' + PropValue);

finally

FreeMem(PropertyItem);

end;

finally

GDIImage.Free;

end;