copymain.pas

《Delphi开发人员指南》配书原码

unit CopyMain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, Menus;

type
  TMainForm = class(TForm)
    DataMemo: TMemo;
    BottomPnl: TPanel;
    BtnPnl: TPanel;
    CloseBtn: TButton;
    CopyBtn: TButton;
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    CopyData1: TMenuItem;
    N1: TMenuItem;
    Exit1: TMenuItem;
    Help1: TMenuItem;
    About1: TMenuItem;
    procedure CloseBtnClick(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure About1Click(Sender: TObject);
    procedure CopyBtnClick(Sender: TObject);
  private
    { Private declarations }
  protected
    procedure WndProc(var Message: TMessage); override;
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.DFM}

uses AboutU, RegMsg;

// The following declaration is necessary because of an error in
// the declaration of BroadcastSystemMessage() in the Windows unit
function BroadcastSystemMessage(Flags: DWORD; Recipients: PDWORD;
  uiMessage: UINT; wParam: WPARAM; lParam: LPARAM): Longint; stdcall;
  external 'user32.dll';

var
  Recipients: DWORD = BSM_APPLICATIONS;

procedure TMainForm.WndProc(var Message: TMessage);
var
  DataBuffer: TCopyDataStruct;
  Buf: PChar;
  BufSize: Integer;
begin
  if Message.Msg = DDGM_HandshakeMessage then begin
    { Allocate buffer }
    BufSize := DataMemo.GetTextLen + (1 * SizeOf(Char));
    Buf := AllocMem(BufSize);
    { Copy memo to buffer }
    DataMemo.GetTextBuf(Buf, BufSize);
    try
      with DataBuffer do begin
        { Fill dwData with registered message as safety check }
        dwData := DDGM_HandshakeMessage;
        cbData := BufSize;
        lpData := Buf;
      end;
      { NOTE: WM_COPYDATA message must be *sent* }
      SendMessage(Message.wParam, WM_COPYDATA, Handle,
        Longint(@DataBuffer));
    finally
      FreeMem(Buf, BufSize);
    end;
  end
  else
    inherited WndProc(Message);
end;

procedure TMainForm.CloseBtnClick(Sender: TObject);
begin
  Close;
end;

procedure TMainForm.FormResize(Sender: TObject);
begin
  BtnPnl.Left := BottomPnl.Width div 2 - BtnPnl.Width div 2;
end;

procedure TMainForm.About1Click(Sender: TObject);
begin
  AboutBox;
end;

procedure TMainForm.CopyBtnClick(Sender: TObject);
begin
  { Call for any listening apps }
  BroadcastSystemMessage(BSF_IGNORECURRENTTASK or BSF_POSTMESSAGE,
    @Recipients, DDGM_HandshakeMessage, Handle, 0);
end;

end.