unit Readmain;
interfaceuses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, Menus, StdCtrls;
{ The WM_COPYDATA Windows message is not defined in the 16-bit Messages }{ unit, although it is available to 16-bit applications running under }{ Windows 95 or NT. This message is discussed in the Win32 API online }{ help. }const
WM_COPYDATA = $004A;
type
TMainForm = class(TForm)
ReadMemo: TMemo;
MainMenu1: TMainMenu;
File1: TMenuItem;
Exit1: TMenuItem;
Help1: TMenuItem;
About1: TMenuItem;
procedure Exit1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure About1Click(Sender: TObject);
privateprocedure OnAppMessage(var M: TMsg; var Handled: Boolean);
procedure WMCopyData(var M: TMessage); message WM_COPYDATA;
end;
var
MainForm: TMainForm;
implementation{$R *.DFM}uses RegMsg, AboutU;
type{ The TCopyDataStruct record type is not defined in WinTypes unit, }{ although it is available in the 16-bit Windows API when running }{ under Windows 95 and NT. The lParam of the WM_COPYDATA message }{ points to one of these. }
PCopyDataStruct = ^TCopyDataStruct;
TCopyDataStruct = record
dwData: DWORD;
cbData: DWORD;
lpData: Pointer;
end;
procedure TMainForm.OnAppMessage(var M: TMsg; var Handled: Boolean);
{ OnMessage handler for Application object. }begin{ The DDGM_HandshakeMessage message is received as a broadcast to }{ all applications. The wParam of this message contains the handle }{ of the window which broadcasted the message. We respond by posting }{ the same message back to the sender, with our handle in the wParam. }if M.Message = DDGM_HandshakeMessage thenbegin
PostMessage(M.wParam, DDGM_HandshakeMessage, Handle, 0);
Handled := True;
end;
end;
procedure TMainForm.WMCopyData(var M: TMessage);
{ Handler for WM_COPYDATA message }begin{ Check wParam to ensure we know WHO sent us the WM_COPYDATA message }if PCopyDataStruct(M.lParam)^.dwData = DDGM_HandshakeMessage then{ When WM_COPYDATA message is received, the lParam points to}
ReadMemo.SetTextBuf(PChar(PCopyDataStruct(M.lParam)^.lpData));
end;
procedure TMainForm.Exit1Click(Sender: TObject);
begin
Close;
end;
procedure TMainForm.FormCreate(Sender: TObject);
begin
Application.OnMessage := OnAppMessage;
end;
procedure TMainForm.About1Click(Sender: TObject);
begin
AboutBox;
end;
end.
unit CopyMain;
interfaceuses
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 }protectedprocedure WndProc(varMessage: 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 unitfunction BroadcastSystemMessage(Flags: DWORD; Recipients: PDWORD;
uiMessage: UINT; wParam: WPARAM; lParam: LPARAM): Longint; stdcall;
external "user32.dll";
var
Recipients: DWORD = BSM_APPLICATIONS;
procedure TMainForm.WndProc(varMessage: TMessage);
var
DataBuffer: TCopyDataStruct;
Buf: PChar;
BufSize: Integer;
beginifMessage.Msg = DDGM_HandshakeMessage thenbegin{ Allocate buffer }
BufSize := DataMemo.GetTextLen + (1 * SizeOf(Char));
Buf := AllocMem(BufSize);
{ Copy memo to buffer }
DataMemo.GetTextBuf(Buf, BufSize);
trywith DataBuffer dobegin{ 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;
endelseinherited 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.
Если Вас заинтересовала или понравилась информация по разработке на Delph - "Переслать текст в другую программу", Вы можете поставить закладку в социальной сети или в своём блоге на данную страницу: Так же Вы можете задать вопрос по работе этого модуля или примера через форму обратной связи, в сообщение обязательно указывайте название или ссылку на статью!