u00405.pas

Delphi编程五大妙招源程序

unit U00405;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, registry, Clipbrd, ExtCtrls{监视剪贴板单元};

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Memo1: TMemo;
    Image1: TImage;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
    NextClipHwnd:HWND;//监视剪贴板　观察链中下一个窗口句柄
    procedure WMDrawClipBoard(var AMessage:TMessage); message WM_DRAWCLIPBOARD;//监视剪贴板　处理WM_DRAWCLIPBOARD消息过程
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
var
  THEPCHAR:pchar;
begin
  THEPCHAR:='C:\My Documents\Beautiful.bmp';
  SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, THEPCHAR, SPIF_SENDWININICHANGE);
end;


procedure TForm1.Button2Click(Sender: TObject);
Var
  Reg:Tregistry; //Tregistry 对象在Registry 单元中声明，需用Uses令引用Registry单元
Begin
  Reg:=Tregistry.Create;{创建Tregistry对象的实例}
  Reg.Rootkey:= Hkey_Current_User;{设置根键名称}
  Reg.OpenKey('Control Panel\Desktop',False); {打开Control Panel\Desktop 路径对应的主键}
  Reg.WriteString('TileWallPaper', '0');
  Reg.WriteString('Wallpaper','C:\C:\My Documents\Beautiful.bmp') ; //向TileWallpaper 和Wallpaper串覆盖写入新值
  Systemparametersinfo(SPI_SETDESKWallpaper,0,Nil,SPIF_SendChange);{向Windows发送消息，通知Windows更换壁纸}
  Reg.CloseKey;{将更改内容写入注册表并关闭}
  Reg.Free;{释放对象}
End;

procedure TForm1.WMDrawClipBoard(var AMessage: TMessage);
Var
  Bitmap: TBitmap;
begin
  //将WM_DRAWCLIPBOARD消息传递到下一个观察链中的窗口
  SendMessage(NextClipHwnd,AMessage.Msg,AMessage.WParam,AMessage.LParam);

  //查询剪贴板中特定格式的数据内容
  if (Clipboard.HasFormat(CF_TEXT) or  Clipboard.HasFormat(CF_OEMTEXT)) then
  begin
    //处理剪贴板中文本内容
    Memo1.Lines.Add(Clipboard.asText) ;
  End Else
  if Clipboard.HasFormat(CF_BITMAP) Then
  Begin
    //处理剪贴板中图片内容
    Bitmap := TBitmap.Create;
    try
      Bitmap.Assign(Clipboard);
      Image1.Canvas.Draw(0, 0, Bitmap);
    finally
      Bitmap.Free;
    end;
  End ;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  //获得观察链中下一个窗口句柄
  NextClipHwnd:=SetClipBoardViewer(Handle);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  //从观察链中删除本观察窗口
  ChangeClipboardChain(Handle,NextClipHwnd);

  //将WM_DRAWCLIPBOARD消息传递到下一个观察链中的窗口
  SendMessage(NextClipHwnd,WM_CHANGECBCHAIN,Handle,NextClipHwnd);
end;

end.