> Hvordan for jeg sendt en tekst fra et program til et andet (egne
> programmer).
SendMessage og PostMessage virker ikke på den måde, som du nok regner med,
for det er ikke tekst meddelser, der er tale om her.
De meddelser, der sendes med SendMessage kunne f.eks. være en besked om at
musen har flyttet sig indenfor vinduet.
Skal man sende tekstmeddelser mellem applikationer, skal der noget specielt
til, da det ene program ikke har adgang til det andets program's hukommelse.
Det kan man løse f.eks. ved at lave noget "delt hukommelse", som begge
programmer har adgang til. Det er formindtlig den hurtigste metode selvom
der ikke er mærkbar hastigheds forskel på de forskellige metoder jeg nævner
her.
En anden måde er via. WM_COPYDATA meddelsen, som Harald også nævner.
Det er en meddelse, som indeholder en pointer til noget hukommelse, som
f.eks. kunne være en tekststreng.
Jeg har lavet et lille chat program til demonstration af WM_COPYDATA og
hvordan man kan sende tekst mellem programmerne. Programmet vil du nok synes
er ret kompliceret, men bare spørg hvis du er i tvivl om noget.
Det skal lige siges at chat programmet ikke er fejlfrit (den crasher f.eks.
efter at vist brugeren en klage over at for mange instanser er aktive).
På programmets form er en TRichEdit og en TEdit - Opret de 2 komponenter og
erstat koden med denne (bemærk rækkefølgen af instruktionerne):
<kode start>
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls;
type
TForm1 = class(TForm)
Edit1: TEdit;
RichEdit1: TRichEdit;
procedure FormCreate(Sender: TObject);
procedure Edit1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure FormDestroy(Sender: TObject);
protected
procedure WndProc(var Message: TMessage); override;
private
applicationID : byte;
{ Private declarations }
chatwnds : tlist;
procedure FindChatWindows;
procedure SendChatMessage ( text : string );
procedure DisposeChatWndsList;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.WndProc(var Message: TMessage);
var
cds : PCopyDataStruct; // pointer til en copydatastruct structure
farve : tcolor;
begin;
// Besvarelse af det "hemmelige" 1024 spørgsmål
if ( ( Message.Msg = WM_USER ) and ( Message.WParam = 1024 ) ) then begin;
Message.Result := 17082003;
exit;
end;
if ( Message.Msg = WM_COPYDATA ) then begin;
cds := PCopyDataStruct (Message.LParam);
if not (cds^.dwData = 17082003 ) then exit; // Magic ID
if (cds^.cbData > 0) then begin;
farve := $ffffff;
case byte (pchar (cds^.lpData) [0]) of
1 : farve := $ffaaaa;
2 : farve := $00ff00;
3 : farve := $0000ff;
4 : farve := $ff00ff;
5 : farve := $ffff00;
6 : farve := $ffffff;
7 : farve := $aaaaaa;
8 : farve := $aaaa00; // Nu gider jeg ikke at definere flere farver
// men det kan du sagtens selv gøre hvis du
vil
end;
RichEdit1.SelStart := -1;
RichEdit1.SelAttributes.Color := farve;
RichEdit1.SelAttributes.Name := 'Verdana';
RichEdit1.SelAttributes.Style := [];
RichEdit1.SelAttributes.Size := 12;
RichEdit1.Lines.Insert ( 0, pchar (cds^.lpData)+1 );
RichEdit1.SelStart := 0;
RichEdit1.SelLength := cds^.cbData - 2;
RichEdit1.SelAttributes.Color := farve;
end;
exit;
end;
inherited;
end;
procedure TForm1.SendChatMessage ( text : string );
var
tekst : pchar;
cds : PCopyDataStruct;
bufsize : cardinal;
wndhandle : ^hwnd;
count : integer;
begin;
count := 0;
while ( count < self.chatwnds.Count ) do begin;
bufsize := length (text) + 2;
getmem ( tekst, bufsize );
tekst [0] := char ( self.applicationID );
strpcopy ( tekst+1, text );
new (cds);
cds^.dwData := 17082003; // Magic ID
cds^.lpData := tekst; // Pointer til tekst
cds^.cbData := bufsize; // Buffer størrelse
wndhandle := self.chatwnds.Items [count];
SendMessage ( wndhandle^, WM_COPYDATA, form1.Handle, integer (cds) );
freemem ( cds^.lpData, cds^.cbData );
inc (count);
end;
end;
function EnumCallBack ( wndhandle : hwnd; lparam : cardinal ) : boolean;
stdcall;
var
chatwnds : tlist;
buf : array [0..511] of char;
handleptr : ^hwnd;
cnt : integer;
begin;
chatwnds := tlist (lparam);
cnt := GetClassName ( wndhandle, buf, 512 );
if ( (cnt > 0 ) and ( buf = 'TForm1' ) ) then begin;
// Når du ændrer navnet (ikke caption!)
// på din form virker programmet ikke
// længere med mindre du ændrer TForm1
til
// det nye navn
// Potentielt vindue fundet
if ( SendMessage ( wndhandle, WM_USER, 1024, 0 ) = 17082003 ) then begin;
// chat vindue fundet
new ( handleptr );
handleptr^ := wndhandle;
chatwnds.Add( handleptr );
end;
end;
result := true;
end;
procedure TForm1.DisposeChatWndsList;
var
handleptr : ^hwnd;
count : integer;
begin;
count := 0;
while ( count < self.chatwnds.Count ) do begin;
handleptr := self.chatwnds.Items [count];
dispose ( handleptr );
inc (count);
end;
end;
procedure TForm1.FindChatWindows;
begin;
DisposeChatWndsList;
self.chatwnds.Clear;
EnumWindows ( @EnumCallBack, longint (self.chatwnds) );
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
richedit1.Clear;
richedit1.Color := clBlack;
edit1.Text := '';
self.chatwnds := tlist.Create;
FindChatWindows;
applicationID := self.chatwnds.Count;
if (applicationID > 8) then begin;
MessageDlg ( 'Der er for mange chat programmer kørende!', MTERROR, [mbok],
0);
application.Destroy;
end;
end;
procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if key=13 then begin;
findchatwindows;
sendchatmessage ( edit1.Text );
edit1.Text := '';
end;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
DisposeChatWndsList;
self.chatwnds.Destroy;
end;
end.
<kode slut>
Håber du kan bruge det til noget.
mvh.
Klaus.