|
| 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