unit1.pas

Delphi 7组件与分布式应用开发源码,介绍了基础的组件应用实例

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, Buttons, Clipbrd;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    Image1: TImage;
    Button1: TButton;
    Button2: TButton;
    SaveDialog1: TSaveDialog;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
  private
    { Private declarations }
    MyBitmap: TBitmap; 			 //保存截获的位图
    View: Boolean; 				 //判断是否显示
    NextViewerHandle: HWND; 	 //下一剪贴板观察器的句柄
    procedure WMDrawClipboard(var Msg:TWMDrawClipboard);
    message WM_DRAWCLIPBOARD;
    procedure WMChangeCBChain(var Msg:TWMChangeCBChain);
    message WM_CHANGECBCHAIN;  //响应Windows的剪贴板消息

  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
    View := False;
    SpeedButton2.Down := True;
    MyBitmap := TBitmap.create;
    Try
      MyBitmap.Width := 0;
      MyBitmap.Height := 0 ;
    Except
      Application.terminate;
    end;
    Clipboard.Clear;
    NextViewerHandle := SetClipboardViewer(Handle);

end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
    ChangeClipboardChain(Handle,NextViewerHandle);
    MyBitmap.Free;

end;

procedure TForm1.WMChangeCBChain(var Msg: TWMChangeCBChain);

begin
   if Msg.Remove = NextViewerHandle then
      NextViewerHandle := Msg.Next
    Else
      if NextViewerHandle <> 0 then
          SendMessage(NextViewerHandle,Msg.Msg,Msg.Remove,Msg.Next);
    Msg.Result := 0;


end;

procedure TForm1.WMDrawClipboard(var Msg: TWMDrawClipboard);
var
  FileName: String;
begin
    If NextViewerHandle <> 0 then
      SendMessage(NextViewerHandle,msg.Msg,0,0);
    If ClipBoard.HasFormat(CF_BITMAP) then
    Begin
      MyBitmap.Assign(Clipboard);
      If SaveDialog1.Execute then
      Begin
        FileName := SaveDialog1.FileName;
        MyBitmap.SaveToFile(FileName);
      end;
      If View then
      Begin
        WindowState := wsNormal;
        Image1.Picture.Bitmap := MyBitmap;
      end;
    end;
    Msg.Result := 0;

end;

procedure TForm1.Button1Click(Sender: TObject);
begin
    Close; 
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
    WindowState := wsMinimized;
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
  View := True;
  Image1.Picture.Bitmap := MyBitmap;

end;

procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
  View := False;
  Image1.Picture.Bitmap := nil;

end;

end.