uses
ActiveX;
function GetClipboardFormatString(Format: Word):
string;
var
S:
string;
begin
case Format
of
1: S := '
CF_TEXT';
2: S := '
CF_BITMAP';
3: S := '
CF_METAFILEPICT';
4: S := '
CF_SYLK';
5: S := '
CF_DIF';
6: S := '
CF_TIFF';
7: S := '
CF_OEMTEXT';
8: S := '
CF_DIB';
9: S := '
CF_PALETTE';
10: S := '
CF_PENDATA';
11: S := '
CF_RIFF';
12: S := '
CF_WAVE';
13: S := '
CF_UNICODETEXT';
14: S := '
CF_ENHMETAFILE';
15: S := '
CF_HDROP';
16: S := '
CF_LOCALE';
17: S := '
CF_DIBV5';
$0080: S := '
CF_OWNERDISPLAY';
$0081: S := '
CF_DSPTEXT';
$0082: S := '
CF_DSPBITMAP';
$0083: S := '
CF_DSPMETAFILEPICT';
$008E: S := '
CF_DSPENHMETAFILE';
$0200: S := '
CF_PRIVATEFIRST';
$02FF: S := '
CF_PRIVATELAST';
$0300: S := '
CF_GDIOBJFIRST';
$03FF: S := '
CF_GDIOBJLAST';
else
begin
SetLength(S, 255);
SetLength(S, GetClipboardFormatName(Format, PChar(S), 255));
if Length(S) = 0
then
S := '
Unknown, unregistered clipboard format';
Result := S + '
(' + IntToStr(Format) + '
)';
Exit;
end;
end;
Result := '
Standard clipboard format (' + S + '
)';
end;
function GetClipboardFormats:
string;
var
S:
string;
FormatEtc: TFormatEtc;
DataObject: IDataObject;
EnumFormatEtc: IEnumFormatEtc;
begin
Result := '
';
if Succeeded(OleGetClipboard(DataObject))
then
begin
if Succeeded(DataObject.EnumFormatEtc(DATADIR_GET, EnumFormatEtc))
then
begin
S := DupeString('
-', 65) + sLineBreak +
'
Clipboard data formats: ' + sLineBreak +
DupeString('
-', 65) + sLineBreak;
while EnumFormatEtc.Next(1, FormatEtc,
nil) = S_OK
do
S := S + GetClipboardFormatString(FormatEtc.cfFormat) + sLineBreak;
Result := S;
end;
end;
end;
function GetClipboardInfoDIB:
string;
var
S:
string;
ClipboardData: HGLOBAL;
BitmapInfoHeader: PBitmapInfoHeader;
const
BI_JPEG = 4;
BI_PNG = 5;
begin
Result := '
';
if OpenClipboard(0)
then
try
ClipboardData := GetClipboardData(CF_DIB);
if ClipboardData <> 0
then
begin
BitmapInfoHeader := GlobalLock(ClipboardData);
if Assigned(BitmapInfoHeader)
then
try
S := DupeString('
-', 65) + sLineBreak +
'
Clipboard data of CF_DIB format: ' + sLineBreak +
DupeString('
-', 65) + sLineBreak +
'
Width: ' + IntToStr(BitmapInfoHeader.biWidth) + '
px' + sLineBreak +
'
Height: ' + IntToStr(BitmapInfoHeader.biHeight) + '
px' + sLineBreak +
'
Bit depth: ' + IntToStr(BitmapInfoHeader.biBitCount) + '
bpp' + sLineBreak +
'
Compression format: ';
case BitmapInfoHeader.biCompression
of
BI_RGB: S := S + '
Uncompressed format (BI_RGB)';
BI_RLE8: S := S + '
RLE format for bitmaps with 8 bpp (BI_RLE8)';
BI_RLE4: S := S + '
RLE format for bitmaps with 4 bpp (BI_RLE4)';
BI_BITFIELDS: S := S + '
Not compressed with color masks (BI_BITFIELDS)';
BI_JPEG: S := S + '
Compressed using JPEG file format (BI_JPEG)';
BI_PNG: S := S + '
Compressed using PNG file format (BI_PNG)';
end;
S := S + sLineBreak;
Result := S;
finally
GlobalUnlock(ClipboardData);
end;
end;
finally
CloseClipboard;
end;
end;
function GetClipboardInfoDIBV5:
string;
var
S:
string;
ClipboardData: HGLOBAL;
BitmapInfoHeader: PBitmapV5Header;
const
BI_JPEG = 4;
BI_PNG = 5;
begin
Result := '
';
if OpenClipboard(0)
then
try
ClipboardData := GetClipboardData(CF_DIBV5);
if ClipboardData <> 0
then
begin
BitmapInfoHeader := GlobalLock(ClipboardData);
if Assigned(BitmapInfoHeader)
then
try
S := DupeString('
-', 65) + sLineBreak +
'
Clipboard data of CF_DIBV5 format: ' + sLineBreak +
DupeString('
-', 65) + sLineBreak +
'
Width: ' + IntToStr(BitmapInfoHeader.bV5Width) + '
px' + sLineBreak +
'
Height: ' + IntToStr(BitmapInfoHeader.bV5Height) + '
px' + sLineBreak +
'
Bit depth: ' + IntToStr(BitmapInfoHeader.bV5BitCount) + '
bpp' + sLineBreak +
'
Compression format: ';
case BitmapInfoHeader.bV5Compression
of
BI_RGB: S := S + '
Uncompressed format (BI_RGB)';
BI_RLE8: S := S + '
RLE format for bitmaps with 8 bpp (BI_RLE8)';
BI_RLE4: S := S + '
RLE format for bitmaps with 4 bpp (BI_RLE4)';
BI_BITFIELDS: S := S + '
Not compressed with color masks (BI_BITFIELDS)';
BI_JPEG: S := S + '
Compressed using JPEG file format (BI_JPEG)';
BI_PNG: S := S + '
Compressed using PNG file format (BI_PNG)';
end;
S := S + sLineBreak;
Result := S;
finally
GlobalUnlock(ClipboardData);
end;
end;
finally
CloseClipboard;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
S:
string;
begin
S := GetClipboardFormats;
if IsClipboardFormatAvailable(CF_DIB)
then
S := S + sLineBreak + GetClipboardInfoDIB;
if IsClipboardFormatAvailable(CF_DIBV5)
then
S := S + sLineBreak + GetClipboardInfoDIBV5;
ShowMessage(S);
end;