unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Clipbrd, ShlObj, ExtCtrls, ComCtrls, Math;

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    Panel1: TPanel;
    btnRefresh: TButton;
    btnClose: TButton;
    btnClear: TButton;
    Memo1: TMemo;
    Splitter1: TSplitter;
    StatusBar1: TStatusBar;
    procedure btnRefreshClick(Sender: TObject);
    procedure btnCloseClick(Sender: TObject);
    procedure btnClearClick(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

const
  MAX_DATA_TO_DISPLAY = 1024;

resourcestring
  rClipboardEmpty = 'Clipboard Empty';

type
  TVS_FIXEDFILEINFO = record
    dwSignature: DWORD ;
    dwStrucVersion: DWORD ;
    dwFileVersionMS: DWORD ;
    dwFileVersionLS: DWORD ;
    dwProductVersionMS: DWORD ;
    dwProductVersionLS: DWORD ;
    dwFileFlagsMask: DWORD ;
    dwFileFlags: DWORD ;
    dwFileOS: DWORD ;
    dwFileType: DWORD ;
    dwFileSubtype: DWORD ;
    dwFileDateMS: DWORD ;
    dwFileDateLS: DWORD ;
  end;

  TVS_VERSION_INFO = packed record
    Length          :WORD;
    wValueLength    :WORD;
    wType           :WORD;
    szKey:array[0..Length('VS_VERSION_INFO')] of WideChar;
    Padding1        :array[0..0] of Word;
    FixedInfo       :TVS_FIXEDFILEINFO;
  end;

function GetVersion(andRelease: boolean; andBuild: boolean = false): string;
var
  rs: TResourceStream;
  vsvi: TVS_VERSION_INFO;
  buildStr, releaseStr: string;
begin
  result := '';
  releaseStr := '';
  buildStr := '';
  rs := TResourceStream.CreateFromID(hInstance, 1, RT_VERSION);
  try
    rs.read(vsvi, sizeof(vsvi));
    if vsvi.wValueLength <> sizeof(vsvi.FixedInfo) then exit;
    with vsvi.FixedInfo do
    begin
      if andRelease then
        releaseStr := format('.%d', [dwFileVersionLS shr 16]);
      if andBuild then
        buildStr := format(' (build %d)', [dwFileVersionLS and $FFFF]);
      result := format('%d.%d%s%s', [dwFileVersionMS shr 16,
        dwFileVersionMS and $FFFF, releaseStr, buildStr]);
    end;
  finally
    rs.Free;
  end;
end;
//------------------------------------------------------------------------------

procedure TForm1.FormCreate(Sender: TObject);
begin
   StatusBar1.Panels[0].Text := 'ver '+ GetVersion(false);
   btnRefreshClick(nil);
end;
//------------------------------------------------------------------------------

function GetClipboardName(num: integer): string;
var
  buff: array [0..256] of char;
  len: integer;
begin
  len := GetClipboardFormatName(num, buff, 255);
  result := buff;
  setlength(result,len);
end;
//------------------------------------------------------------------------------

procedure TForm1.btnRefreshClick(Sender: TObject);
var
  i,j: Integer;
  format: string;
begin
  ListBox1.clear;
  Memo1.clear;

  for i := 0 to Clipboard.FormatCount-1 do
  begin
    j := Clipboard.Formats[i];
    case j of
      1: format :='CF_TEXT';
      2: format :='CF_BITMAP';
      3: format :='CF_METAFILEPICT';
      4: format :='CF_SYLK';
      5: format :='CF_DIF';
      6: format :='CF_TIFF';
      7: format :='CF_OEMTEXT';
      8: format :='CF_DIB';
      9: format :='CF_PALETTE';
      10: format :='CF_PENDATA';
      11: format :='CF_RIFF';
      12: format :='CF_WAVE';
      13: format :='CF_UNICODETEXT';
      14: format :='CF_ENHMETAFILE';
      15: format :='CF_HDROP';
      16: format :='CF_LOCALE';
      17: format :='CF_DIBV5';
      else format := GetClipboardName(j);
    end;
    ListBox1.Items.Add(format);
  end;

  if ListBox1.Items.count = 0 then
    ListBox1.Items.Add(rClipboardEmpty)
  else
  begin
    ListBox1.ItemIndex := 0;
    ListBox1Click(nil);
    if visible then
      ListBox1.SetFocus;
  end;
end;
//------------------------------------------------------------------------------

procedure TForm1.btnCloseClick(Sender: TObject);
begin
  close;
end;
//------------------------------------------------------------------------------

procedure TForm1.btnClearClick(Sender: TObject);
begin
  Memo1.Clear;
  Listbox1.Clear;
  ListBox1.Items.Add(rClipboardEmpty);
  clipboard.Clear;
end;
//------------------------------------------------------------------------------

procedure TForm1.ListBox1Click(Sender: TObject);
var
  i: Integer;
  DataSize: integer;
  dataHdl: THandle;
  dataPtr, p: PByte;
  dataStr: string;
begin
  StatusBar1.Panels[1].Text := '';
  Memo1.Clear;
  with ListBox1 do
  begin
    if (itemindex < 0) or (Items.Text = rClipboardEmpty + #13#10) then
      Exit;

    Clipboard.Open;
    try
      if items[itemindex] = 'CF_TEXT' then
      begin
        dataHdl := Clipboard.GetAsHandle(CF_TEXT);
        DataSize := GlobalSize(dataHdl);
        dataPtr := GlobalLock(dataHdl);
        dataStr := string(PAnsiChar(dataPtr));
        Memo1.lines.add(dataStr);
        GlobalUnlock(dataHdl);
      end
      else if items[itemindex] = 'CF_OEMTEXT' then
      begin
        dataHdl := Clipboard.GetAsHandle(CF_OEMTEXT);
        DataSize := GlobalSize(dataHdl);
        dataPtr := GlobalLock(dataHdl);
        dataStr := string(PAnsiChar(dataPtr));
        Memo1.lines.add(dataStr);
        GlobalUnlock(dataHdl);
      end
      else if items[itemindex] = 'CF_UNICODETEXT' then
      begin
        dataHdl := Clipboard.GetAsHandle(CF_UNICODETEXT);
        DataSize := GlobalSize(dataHdl);
        dataPtr := GlobalLock(dataHdl);
        dataStr := PWideChar(dataPtr);
        Memo1.lines.add(dataStr);
        GlobalUnlock(dataHdl);
      end else
      begin
          dataHdl := Clipboard.GetAsHandle(Clipboard.Formats[itemindex]);
          dataPtr := GlobalLock(dataHdl);
          if Assigned(dataPtr) then;
          try
            DataSize := GlobalSize(dataHdl);
            dataStr := '';
            p := dataPtr;
            for i := 1 to Min(MAX_DATA_TO_DISPLAY, DataSize) do
            begin
              if (p^ = 0) then
                dataStr := dataStr + #32
              else if (p^ < 32) or (p^ > 126) then
                dataStr := dataStr + #149
              else
                dataStr := dataStr + Char(p^);
              inc(p);
            end;
            if DataSize > MAX_DATA_TO_DISPLAY then
              dataStr := dataStr + ' ...';
            dataStr := dataStr + #13#10#13#10;

            p := dataPtr;
            for i := 1 to Min(MAX_DATA_TO_DISPLAY, DataSize) do
            begin
              dataStr := dataStr + inttohex(p^, 2)+' ';
              inc(p);
            end;
            if DataSize > MAX_DATA_TO_DISPLAY then
              dataStr := dataStr + '...';

            Memo1.lines.add(dataStr);
          finally
            GlobalUnlock(dataHdl);
          end;
      end;
    finally
      Clipboard.Close;
    end;
    Memo1.SelStart := 0;
    SendMessage(Memo1.Handle, EM_SCROLLCARET, 0, 0);
    StatusBar1.Panels[1].Text := Format('%1.0n', [DataSize/1.0]);
  end;
end;
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------

end.

