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	torben	2671	// 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.