clipboardmain.pas

类似Wor剪切板收集器的功能。由于时间关系只做了部分剪切板数据的收集

unit ClipBoardMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, StdCtrls, ComCtrls, ClipBoardUtils, Contnrs, CliBoardDate,
  ExtCtrls, jpeg, Buttons;

type
  TForm1 = class(TForm)
    lst1: TListBox;
    procedure FormCreate(Sender: TObject);
    procedure lst1DrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure lst1Click(Sender: TObject);
  private
    FClipData: TClipBoardMgr;
    { Private declarations }
  protected
    procedure ReSetSelection;
    procedure WMDRAWCLIPBOARD(var message: TWMDrawClipboard); message WM_DRAWCLIPBOARD;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses
  Clipbrd;
const
  FormatNameArray: array[1..18] of string = ('字符串', '位图', '元文件', '未知', '未知','未知',
  'OEM字符集文本','设备无关位图','调色板', '未知', '音频', 'WAV音频','Unicode文本','增强元文件','未知','未知','未知','未知');

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  FClipData := TClipBoardMgr.Create;
  lst1.ItemHeight := 50;
  SetClipboardViewer(Handle);
  ReSetSelection
end;

type
   _ClipBoard = Class(TClipboard);

procedure TForm1.WMDRAWCLIPBOARD(var message: TWMDrawClipboard);
begin
  if FClipData.AllowAdd then
  begin
    lst1.Items.Add(FClipData.AddClipBoardData);
  end;
end;

procedure TForm1.lst1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
begin
  lst1.Canvas.Brush.Color := clWhite;
  lst1.Canvas.Font.Color := clBlack;
  lst1.Canvas.FillRect(Rect);
  lst1.Canvas.Brush.Color := TColor($00FFF7F7);
  lst1.Canvas.Pen.Color := TColor($00131315);
  lst1.Canvas.RoundRect(Rect.Left + 1, Rect.Top + 1,
    Rect.Right - 1, Rect.Bottom - 1, 8, 8);
  lst1.Canvas.RoundRect(Rect.Left + 1, Rect.Top + 1,
    Rect.Right - 1, Rect.Bottom - 1, 5, 5);
  if (odSelected in State) then
  begin
    lst1.Canvas.Brush.Color := TColor($00FFB2B5);
    lst1.Canvas.RoundRect(Rect.Left + 1, Rect.Top + 1,
      Rect.Right - 1, Rect.Bottom - 1, 5, 5);
    lst1.Canvas.Font.Color := clBlue;
    lst1.Canvas.DrawFocusRect(Rect);
  end;
  FClipData.MakeDataPreview(lst1.Canvas, Rect, Index);
end;

procedure TForm1.ReSetSelection;
begin
  if lst1.Count > 0 then
  begin
    if (lst1.ItemIndex = -1) then
      lst1.ItemIndex := 0;
    if not lst1.Selected[lst1.ItemIndex] then
      lst1.Selected[lst1.ItemIndex] := True;
  end;
end;

procedure TForm1.lst1Click(Sender: TObject);
var
  bitmap: TBitmap;
begin
  FClipData.StopAdd;
  try
    FClipData.AssignDataToClipBoard(lst1.ItemIndex);
    bitmap := TBitmap.Create;
    FClipData.FetchBitmap(bitmap, lst1.ItemIndex);
  finally
    FClipData.ReStoreAdd;
  end;
end;

end.