Delphi World - Переслать текст в другую программу
Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Переслать текст в другую программу

Автор: Xavier Pacheco

unit Readmain;

interface

uses
  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);
  private
    procedure 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 then
  begin
    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;

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.
Скачать весь проект
Проект Delphi World © Выпуск 2002 - 2017
Автор проекта: Эксклюзивные курсы программирования