tpsystools_4.04/source/StwmDCpy.pas

// Upgraded to Delphi 2009: Sebastian Zierer

(* ***** BEGIN LICENSE BLOCK *****
 * Version: MPL 1.1
 *
 * The contents of this file are subject to the Mozilla Public License Version
 * 1.1 (the "License"); you may not use this file except in compliance with
 * the License. You may obtain a copy of the License at
 * http://www.mozilla.org/MPL/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 * for the specific language governing rights and limitations under the
 * License.
 *
 * The Original Code is TurboPower SysTools
 *
 * The Initial Developer of the Original Code is
 * TurboPower Software
 *
 * Portions created by the Initial Developer are Copyright (C) 1996-2002
 * the Initial Developer. All Rights Reserved.
 *
 * Contributor(s):
 *
 * ***** END LICENSE BLOCK ***** *)

{*********************************************************}
{* SysTools: StWmDCpy.pas 4.04                           *}
{*********************************************************}
{* SysTools: Class for handling WM_COPYDATA exchanges    *}
{*********************************************************}

{$I StDefine.inc}

unit StWmDCpy;

interface

uses
  Windows,
  SysUtils,
  Messages,
  Classes,
  Forms,
  Controls,
  Dialogs,

  StBase;

type
  TStOnDataReceivedEvent = procedure(Sender   : TObject;
                                     CopyData : TCopyDataStruct) of object;

  TStWMDataCopy = class(TStComponent)
  protected {private}
    { Private declarations }
    NewWndProc      : TFarProc;
    PrevWndProc     : TFarProc;
    FOnDataReceived : TStOnDataReceivedEvent;

    procedure AppWndProc(var Msg : TMessage);
    procedure HookForm(Value : Boolean);
  protected
    { Protected declarations }

  public
    { Public declarations }

    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
  published
    { Published declarations }

    property OnDataReceived : TStOnDataReceivedEvent
      read FOnDataReceived
      write FOnDataReceived;
  end;


implementation


constructor TStWMDataCopy.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);

  if not (csDesigning in ComponentState) then begin
{$IFDEF Version6} {$WARN SYMBOL_DEPRECATED OFF} {$ENDIF}
    NewWndProc := MakeObjectInstance(AppWndProc);
{$IFDEF Version6} {$WARN SYMBOL_DEPRECATED ON} {$ENDIF}
    HookForm(True);
  end;
end;

destructor TStWMDataCopy.Destroy;
begin
  if Assigned(NewWndProc) then begin
    HookForm(False);
{$IFDEF Version6} {$WARN SYMBOL_DEPRECATED OFF} {$ENDIF}
    FreeObjectInstance(NewWndProc);
{$IFDEF Version6} {$WARN SYMBOL_DEPRECATED ON} {$ENDIF}
  end;

  inherited Destroy;
end;

procedure TStWMDataCopy.HookForm(Value : Boolean);
begin
  if (not (csDesigning in ComponentState))
      and not (csDestroying in ComponentState) then begin
    if Assigned(PrevWndProc) then
      Exit;
    if Value then begin
      PrevWndProc:= Pointer(
        SetWindowLong(TForm(Owner).Handle, GWL_WNDPROC, LongInt(NewWndProc)))
    end else if Assigned(PrevWndProc) then begin
      SetWindowLong(TForm(Owner).Handle, GWL_WNDPROC, LongInt(PrevWndProc));
      PrevWndProc := nil;
    end;
  end;
end;

procedure TStWMDataCopy.AppWndProc(var Msg : TMessage);
var
  CDS   : TCopyDataStruct;
begin
  with Msg do begin
    if (Msg = WM_COPYDATA) then begin
      CDS := PCopyDataStruct(Pointer(lParam))^;
      if (CDS.dwData = WMCOPYID) then begin
        if (Assigned(FOnDataReceived)) then
          FOnDataReceived(Self, CDS);
      end else
        if Assigned(PrevWndProc) then
          Result :=
            CallWindowProc(PrevWndProc, TForm(Owner).Handle, Msg, wParam, lParam);
    end else
      if Assigned(PrevWndProc) then
        Result :=
          CallWindowProc(PrevWndProc, TForm(Owner).Handle, Msg, wParam, lParam);
  end;
end;

end.
1	// Upgraded to Delphi 2009: Sebastian Zierer
2
3	(* *** BEGIN LICENSE BLOCK ***
4	* Version: MPL 1.1
5	*
6	* The contents of this file are subject to the Mozilla Public License Version
7	* 1.1 (the "License"); you may not use this file except in compliance with
8	* the License. You may obtain a copy of the License at
9	* http://www.mozilla.org/MPL/
10	*
11	* Software distributed under the License is distributed on an "AS IS" basis,
12	* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
13	* for the specific language governing rights and limitations under the
14	* License.
15	*
16	* The Original Code is TurboPower SysTools
17	*
18	* The Initial Developer of the Original Code is
19	* TurboPower Software
20	*
21	* Portions created by the Initial Developer are Copyright (C) 1996-2002
22	* the Initial Developer. All Rights Reserved.
23	*
24	* Contributor(s):
25	*
26	* *** END LICENSE BLOCK *** *)
27
28	{*********************************************************}
29	{* SysTools: StWmDCpy.pas 4.04 *}
30	{*********************************************************}
31	{* SysTools: Class for handling WM_COPYDATA exchanges *}
32	{*********************************************************}
33
34	{$I StDefine.inc}
35
36	unit StWmDCpy;
37
38	interface
39
40	uses
41	Windows,
42	SysUtils,
43	Messages,
44	Classes,
45	Forms,
46	Controls,
47	Dialogs,
48
49	StBase;
50
51	type
52	TStOnDataReceivedEvent = procedure(Sender : TObject;
53	CopyData : TCopyDataStruct) of object;
54
55	TStWMDataCopy = class(TStComponent)
56	protected {private}
57	{ Private declarations }
58	NewWndProc : TFarProc;
59	PrevWndProc : TFarProc;
60	FOnDataReceived : TStOnDataReceivedEvent;
61
62	procedure AppWndProc(var Msg : TMessage);
63	procedure HookForm(Value : Boolean);
64	protected
65	{ Protected declarations }
66
67	public
68	{ Public declarations }
69
70	constructor Create(AOwner : TComponent); override;
71	destructor Destroy; override;
72	published
73	{ Published declarations }
74
75	property OnDataReceived : TStOnDataReceivedEvent
76	read FOnDataReceived
77	write FOnDataReceived;
78	end;
79
80
81	implementation
82
83
84	constructor TStWMDataCopy.Create(AOwner : TComponent);
85	begin
86	inherited Create(AOwner);
87
88	if not (csDesigning in ComponentState) then begin
89	{$IFDEF Version6} {$WARN SYMBOL_DEPRECATED OFF} {$ENDIF}
90	NewWndProc := MakeObjectInstance(AppWndProc);
91	{$IFDEF Version6} {$WARN SYMBOL_DEPRECATED ON} {$ENDIF}
92	HookForm(True);
93	end;
94	end;
95
96	destructor TStWMDataCopy.Destroy;
97	begin
98	if Assigned(NewWndProc) then begin
99	HookForm(False);
100	{$IFDEF Version6} {$WARN SYMBOL_DEPRECATED OFF} {$ENDIF}
101	FreeObjectInstance(NewWndProc);
102	{$IFDEF Version6} {$WARN SYMBOL_DEPRECATED ON} {$ENDIF}
103	end;
104
105	inherited Destroy;
106	end;
107
108	procedure TStWMDataCopy.HookForm(Value : Boolean);
109	begin
110	if (not (csDesigning in ComponentState))
111	and not (csDestroying in ComponentState) then begin
112	if Assigned(PrevWndProc) then
113	Exit;
114	if Value then begin
115	PrevWndProc:= Pointer(
116	SetWindowLong(TForm(Owner).Handle, GWL_WNDPROC, LongInt(NewWndProc)))
117	end else if Assigned(PrevWndProc) then begin
118	SetWindowLong(TForm(Owner).Handle, GWL_WNDPROC, LongInt(PrevWndProc));
119	PrevWndProc := nil;
120	end;
121	end;
122	end;
123
124	procedure TStWMDataCopy.AppWndProc(var Msg : TMessage);
125	var
126	CDS : TCopyDataStruct;
127	begin
128	with Msg do begin
129	if (Msg = WM_COPYDATA) then begin
130	CDS := PCopyDataStruct(Pointer(lParam))^;
131	if (CDS.dwData = WMCOPYID) then begin
132	if (Assigned(FOnDataReceived)) then
133	FOnDataReceived(Self, CDS);
134	end else
135	if Assigned(PrevWndProc) then
136	Result :=
137	CallWindowProc(PrevWndProc, TForm(Owner).Handle, Msg, wParam, lParam);
138	end else
139	if Assigned(PrevWndProc) then
140	Result :=
141	CallWindowProc(PrevWndProc, TForm(Owner).Handle, Msg, wParam, lParam);
142	end;
143	end;
144
145	end.