Skip to content

Commit e1e3c6f

Browse files
committed
Synchronizing Lazarus project
1 parent f42bf3e commit e1e3c6f

File tree

4 files changed

+261
-16
lines changed

4 files changed

+261
-16
lines changed

Packages/FPC/p4dlaz.lpk

Lines changed: 9 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -8,8 +8,8 @@
88
<Version Value="11"/>
99
<PathDelim Value="\"/>
1010
<SearchPaths>
11-
<IncludeFiles Value="..\..\Source\"/>
12-
<OtherUnitFiles Value="..\..\Source\"/>
11+
<IncludeFiles Value="..\..\Source"/>
12+
<OtherUnitFiles Value="..\..\Source;..\..\Source\lcl"/>
1313
<UnitOutputDirectory Value="FPC_Units\$(TargetCPU)-$(TargetOS)-$(LCLWidgetType)"/>
1414
</SearchPaths>
1515
<Parsing>
@@ -22,25 +22,22 @@
2222
<Files Count="10">
2323
<Item1>
2424
<Filename Value="..\..\Source\PythonEngine.pas"/>
25-
<HasRegisterProc Value="True"/>
2625
<UnitName Value="PythonEngine"/>
2726
</Item1>
2827
<Item2>
29-
<Filename Value="..\..\Source\PythonGUIInputOutput.pas"/>
30-
<HasRegisterProc Value="True"/>
31-
<UnitName Value="PythonGUIInputOutput"/>
32-
</Item2>
33-
<Item3>
3428
<Filename Value="..\..\Source\MethodCallBack.pas"/>
3529
<UnitName Value="MethodCallBack"/>
36-
</Item3>
37-
<Item4>
30+
</Item2>
31+
<Item3>
3832
<Filename Value="..\..\Source\VarPyth.pas"/>
3933
<UnitName Value="VarPyth"/>
34+
</Item3>
35+
<Item4>
36+
<Filename Value="..\..\Source\lcl\Lcl.PythonGUIInputOutput.pas"/>
37+
<UnitName Value="Lcl.PythonGUIInputOutput"/>
4038
</Item4>
4139
<Item5>
4240
<Filename Value="..\..\Source\WrapDelphi.pas"/>
43-
<HasRegisterProc Value="True"/>
4441
<UnitName Value="WrapDelphi"/>
4542
</Item5>
4643
<Item6>
@@ -61,6 +58,7 @@
6158
</Item9>
6259
<Item10>
6360
<Filename Value="p4dlaz_register.pas"/>
61+
<HasRegisterProc Value="True"/>
6462
<UnitName Value="P4DLaz_register"/>
6563
</Item10>
6664
</Files>

Packages/FPC/p4dlaz.pas

Lines changed: 2 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -8,17 +8,15 @@
88
interface
99

1010
uses
11-
PythonEngine, PythonGUIInputOutput, MethodCallBack, VarPyth, WrapDelphi,
11+
PythonEngine, MethodCallBack, VarPyth, Lcl.PythonGUIInputOutput, WrapDelphi,
1212
WrapDelphiButtons, WrapDelphiClasses, WrapDelphiControls, WrapDelphiTypes,
1313
P4DLaz_register, LazarusPackageIntf;
1414

1515
implementation
1616

1717
procedure Register;
1818
begin
19-
RegisterUnit('PythonEngine', @PythonEngine.Register);
20-
RegisterUnit('PythonGUIInputOutput', @PythonGUIInputOutput.Register);
21-
RegisterUnit('WrapDelphi', @WrapDelphi.Register);
19+
RegisterUnit('P4DLaz_register', @P4DLaz_register.Register);
2220
end;
2321

2422
initialization

Packages/FPC/p4dlaz_register.pas

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -11,7 +11,7 @@ implementation
1111

1212
uses
1313
PythonEngine,
14-
PythonGUIInputOutput,
14+
Lcl.PythonGUIInputOutput,
1515
WrapDelphi;
1616

1717
procedure Register;
Lines changed: 249 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,249 @@
1+
{$I ..\Definition.Inc}
2+
unit Lcl.PythonGUIInputOutput;
3+
4+
(**************************************************************************)
5+
(* *)
6+
(* Module: Unit 'PythonGUIInputOutput' Copyright (c) 1997 *)
7+
(* *)
8+
(* Dr. Dietmar Budelsky *)
9+
(* dbudelsky@web.de *)
10+
(* Germany *)
11+
(* *)
12+
(* Morgan Martinet *)
13+
(* 4723 rue Brebeuf *)
14+
(* H2J 3L2 MONTREAL (QC) *)
15+
(* CANADA *)
16+
(* e-mail: p4d@mmm-experts.com *)
17+
(* *)
18+
(* look our page at: http://mmm-experts.com/ *)
19+
(**************************************************************************)
20+
(* Functionality: Delphi Components that provide an interface to the *)
21+
(* Python language (see python.txt for more infos on *)
22+
(* Python itself). *)
23+
(* *)
24+
(**************************************************************************)
25+
(* Contributors: *)
26+
(* Mark Watts(mark_watts@hotmail.com) *)
27+
(* Michiel du Toit (micdutoit@hsbfn.com) *)
28+
(**************************************************************************)
29+
(* This source code is distributed with no WARRANTY, for no reason or use.*)
30+
(* Everyone is allowed to use and change this code free for his own tasks *)
31+
(* and projects, as long as this header and its copyright text is intact. *)
32+
(* For changed versions of this code, which are public distributed the *)
33+
(* following additional conditions have to be fullfilled: *)
34+
(* 1) The header has to contain a comment on the change and the author of *)
35+
(* it. *)
36+
(* 2) A copy of the changed source has to be sent to the above E-Mail *)
37+
(* address or my then valid address, if this is possible to the *)
38+
(* author. *)
39+
(* The second condition has the target to maintain an up to date central *)
40+
(* version of the component. If this condition is not acceptable for *)
41+
(* confidential or legal reasons, everyone is free to derive a component *)
42+
(* or to generate a diff file to my or other original sources. *)
43+
(* Dr. Dietmar Budelsky, 1997-11-17 *)
44+
(**************************************************************************)
45+
46+
interface
47+
48+
uses
49+
{$IFDEF MSWINDOWS}
50+
Windows, Messages,
51+
{$ENDIF}
52+
SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
53+
StdCtrls, PythonEngine;
54+
55+
{$IFDEF MSWINDOWS}
56+
const
57+
WM_WriteOutput = WM_USER + 1;
58+
{$ENDIF}
59+
60+
type
61+
{$IF not Defined(FPC) and (CompilerVersion >= 23)}
62+
[ComponentPlatformsAttribute(pidWin32 or pidWin64)]
63+
{$IFEND}
64+
TPythonGUIInputOutput = class(TPythonInputOutput)
65+
private
66+
{ Private declarations }
67+
FCustomMemo : TCustomMemo;
68+
{$IFDEF MSWINDOWS}
69+
FWinHandle : HWND;
70+
{$ENDIF}
71+
protected
72+
{ Protected declarations }
73+
{$IFDEF MSWINDOWS}
74+
procedure pyGUIOutputWndProc (var Message: TMessage);
75+
{$ENDIF}
76+
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
77+
procedure SendData( const Data : AnsiString ); override;
78+
function ReceiveData : AnsiString; override;
79+
procedure SendUniData( const Data : UnicodeString ); override;
80+
function ReceiveUniData : UnicodeString; override;
81+
procedure AddPendingWrite; override;
82+
procedure WriteOutput;
83+
public
84+
{ Public declarations }
85+
constructor Create( AOwner : TComponent ); override;
86+
destructor Destroy; override;
87+
88+
procedure DisplayString( const str : string );
89+
90+
published
91+
{ Published declarations }
92+
property Output : TCustomMemo read FCustomMemo write FCustomMemo;
93+
end;
94+
95+
implementation
96+
97+
{$IFDEF FPC}
98+
{$IFDEF MSWINDOWS}
99+
Uses
100+
InterfaceBase;
101+
{$ENDIF}
102+
{$ENDIF}
103+
104+
{PROTECTED METHODS}
105+
106+
{------------------------------------------------------------------------------}
107+
procedure TPythonGUIInputOutput.Notification(AComponent: TComponent; Operation: TOperation);
108+
begin
109+
inherited;
110+
if Operation = opRemove then
111+
if aComponent = fCustomMemo then
112+
fCustomMemo := nil;
113+
end;
114+
115+
{------------------------------------------------------------------------------}
116+
{$IFDEF MSWINDOWS}
117+
procedure TPythonGUIInputOutput.pyGUIOutputWndProc(var Message: TMessage);
118+
begin
119+
case Message.Msg of
120+
WM_WriteOutput : WriteOutput;
121+
end;{case}
122+
end;
123+
{$ENDIF}
124+
{------------------------------------------------------------------------------}
125+
procedure TPythonGUIInputOutput.SendData( const Data : AnsiString );
126+
begin
127+
if Assigned(FOnSendData) then
128+
inherited
129+
else
130+
DisplayString( string(Data) );
131+
end;
132+
133+
procedure TPythonGUIInputOutput.SendUniData(const Data: UnicodeString);
134+
begin
135+
if Assigned(FOnSendUniData) then
136+
inherited
137+
else
138+
DisplayString( string(Data) );
139+
end;
140+
141+
{------------------------------------------------------------------------------}
142+
function TPythonGUIInputOutput.ReceiveData : AnsiString;
143+
Var
144+
S : string;
145+
begin
146+
if Assigned( FOnReceiveData ) then
147+
Result := inherited ReceiveData
148+
else
149+
begin
150+
InputQuery( 'Query from Python', 'Enter text', S);
151+
Result := AnsiString(S);
152+
end;
153+
end;
154+
155+
function TPythonGUIInputOutput.ReceiveUniData: UnicodeString;
156+
Var
157+
S : string;
158+
begin
159+
if Assigned( FOnReceiveUniData ) then
160+
Result := inherited ReceiveUniData
161+
else
162+
begin
163+
InputQuery( 'Query from Python', 'Enter text', S);
164+
Result := UnicodeString(S);
165+
end;
166+
end;
167+
168+
{------------------------------------------------------------------------------}
169+
procedure TPythonGUIInputOutput.AddPendingWrite;
170+
begin
171+
{$IFDEF MSWINDOWS}
172+
PostMessage( fWinHandle, WM_WriteOutput, 0, 0 );
173+
{$ENDIF}
174+
end;
175+
176+
{------------------------------------------------------------------------------}
177+
procedure TPythonGUIInputOutput.WriteOutput;
178+
var
179+
S : string;
180+
begin
181+
if FQueue.Count = 0 then
182+
Exit;
183+
184+
Lock;
185+
try
186+
while FQueue.Count > 0 do
187+
begin
188+
S := FQueue.Strings[ 0 ];
189+
FQueue.Delete(0);
190+
DisplayString( S );
191+
end;
192+
finally
193+
Unlock;
194+
end;
195+
end;
196+
197+
{PUBLIC METHODS}
198+
199+
{------------------------------------------------------------------------------}
200+
constructor TPythonGUIInputOutput.Create( AOwner : TComponent );
201+
begin
202+
inherited Create(AOwner);
203+
{$IFDEF MSWINDOWS}
204+
// Create an internal window for use in delayed writes
205+
// This will allow writes from multiple threads to be queue up and
206+
// then written out to the associated TCustomMemo by the main UI thread.
207+
{$IFDEF FPC}
208+
fWinHandle := WidgetSet.AllocateHWnd(pyGUIOutputWndProc);
209+
{$ELSE}
210+
fWinHandle := Classes.AllocateHWnd(pyGUIOutputWndProc);
211+
{$ENDIF}
212+
{$ENDIF}
213+
UnicodeIO := True;
214+
end;
215+
216+
{------------------------------------------------------------------------------}
217+
destructor TPythonGUIInputOutput.Destroy;
218+
begin
219+
{$IFDEF MSWINDOWS}
220+
// Destroy the internal window used for Delayed write operations
221+
{$IFDEF FPC}
222+
WidgetSet.DeallocateHWnd(fWinHandle);
223+
{$ELSE}
224+
Classes.DeallocateHWnd(fWinHandle);
225+
{$ENDIF}
226+
{$ENDIF}
227+
inherited Destroy;
228+
end;
229+
230+
{------------------------------------------------------------------------------}
231+
type
232+
TMyCustomMemo = class(TCustomMemo);
233+
234+
procedure TPythonGUIInputOutput.DisplayString( const str : string );
235+
begin
236+
if Assigned(Output) then
237+
begin
238+
if TMyCustomMemo(Output).Lines.Count >= MaxLines then
239+
TMyCustomMemo(Output).Lines.Delete(0);
240+
TMyCustomMemo(Output).Lines.Add(str);
241+
{$IFDEF MSWINDOWS}
242+
SendMessage( Output.Handle, em_ScrollCaret, 0, 0);
243+
{$ENDIF}
244+
end;
245+
end;
246+
247+
{------------------------------------------------------------------------------}
248+
249+
end.

0 commit comments

Comments
 (0)