Clipboard Size

[Amateurprofi]

@tomkupitz;

Herzlichen Dank.

Das habe ich daraus gemacht:

Delphi-Quellcode:

type
   TClipBoardSize=record
      Format:Cardinal;
      FormatText:String;
      Size:Cardinal;
   end;
   TClipBoardSizes=Array of TClipBoardSize;

Delphi-Quellcode:

PROCEDURE ShowClipBoardSizes(HWND:THandle);
var Fmt,Size,TotalSize:Cardinal; hClipMem:THandle; List:TStrings;
begin
   if OpenClipBoard(HWND) then begin
      List:=TStringList.Create;
      TotalSize:=0;
      Fmt:=0;
      repeat
         Fmt:=EnumClipboardFormats(Fmt);
         if Fmt<>0 then begin
            hClipMem:=GetClipBoardData(Fmt);
            Size:=GlobalSize(hClipMem);
            Inc(TotalSize,Size);
            List.Add(IntToStr(Fmt)+' : '+IntToStr(Size));
         end;
      until Fmt=0;
      CloseClipBoard;
      if List.Count>1 then List.Add('Total : '+IntToStr(TotalSize));
      ShowMessage(List.Text);
      List.Free;
   end;
end;

Delphi-Quellcode:

FUNCTION GetClipBoardSizes(HWND:THandle; var Sizes:TClipBoardSizes):Boolean;
//------------------------------------------------------------------------------
FUNCTION ClipBoardFormatText(Fmt:Cardinal):String;
var Buf:Array[0..255] of Char;
begin
   case Fmt of
      1     :  Result:='CF_TEXT';
      2     :  Result:='CF_BITMAP';
      3     :  Result:='CF_METAFILEPICT';
      4     :  Result:='CF_SYLK';
      5     :  Result:='CF_DIF';
      6     :  Result:='CF_TIFF';
      7     :  Result:='CF_OEMTEXT';
      8     :  Result:='CF_DIB';
      9     :  Result:='CF_PALETTE';
      10    :  Result:='CF_PENDATA';
      11    :  Result:='CF_RIFF';
      12    :  Result:='CF_WAVE';
      13    :  Result:='CF_UNICODETEXT';
      14    :  Result:='CF_ENHMETAFILE';
      15    :  Result:='CF_HDROP';
      16    :  Result:='CF_LOCALE';
      17    :  Result:='CF_DIBV5';
      128   :  Result:='CF_OWNERDISPLAY';
      129   :  Result:='CF_DSPTEXT';
      130   :  Result:='CF_DSPBITMAP';
      131   :  Result:='CF_DSPMETAFILEPICT';
      142   :  Result:='CF_DSPENHMETAFILE';
      else     if GetClipBoardFormatName(Fmt,@Buf,255)=0 then Result:='Unknown'
                  else Result:=Buf;
   end;
end;
//------------------------------------------------------------------------------
var TotalSize:Cardinal;
PROCEDURE AddToSizes(AFmt,ASize:Cardinal; AName:String);
begin
   SetLength(Sizes,Length(Sizes)+1);
   with Sizes[High(Sizes)] do begin
      Format:=AFmt;
      FormatText:=AName;
      Size:=ASize;
   end;
   if AFmt<>0 then Inc(TotalSize,ASize);
end;
//------------------------------------------------------------------------------
var Fmt,Size:Cardinal; HClipMem:THandle;
begin
   Sizes:=Nil;
   if OpenClipBoard(HWND) then begin
      TotalSize:=0;
      Fmt:=0;
      repeat
         Fmt:=EnumClipboardFormats(Fmt);
         if Fmt<>0 then begin
            hClipMem:=GetClipBoardData(Fmt);
            AddToSizes(Fmt,GlobalSize(HClipMem),ClipBoardFormatText(Fmt));
         end;
      until Fmt=0;
      if Assigned(Sizes) then AddToSizes(0,TotalSize,'Total');
      CloseClipBoard;
   end;
   Result:=Assigned(Sizes);
end;

Delphi-Quellcode:

PROCEDURE TMain.Test;
var I:Integer; List:TStrings; Sizes:TClipBoardSizes;
begin
   if GetClipBoardSizes(Self.Handle,Sizes) then begin
      List:=TStringList.Create;
      for I:=0 to High(Sizes) do
         with Sizes[I] do
            List.Add(IntToStr(Format)+' '+FormatText+' '+IntToStr(Size));
      ShowMessage(List.Text);
      List.Free;
   end;
   ShowClipBoardSizes(Self.Handle);
end;