Changeset 4 for trunk/Platform/Base

Timestamp:

Nov 23, 2014, 12:56:33 AM (10 years ago)

Author:

chronos

Message:

• Added: Now applications can write text to serial device which is displayed on form.

File:

• trunk/Platform/Base/UPlatformBase.pas (modified) (5 diffs)

trunk/Platform/Base/UPlatformBase.pas

@@ -6 +6 @@
 
 uses
-  Classes, SysUtils, UFileSystem, UKernel;
+  Classes, SysUtils, UFileSystem, UKernel, syncobjs, UThreadEx, UMemory;
 
 type
   { TCustomThread }
 
-  TCustomThread = class(TThread)
+  TCustomThread = class(TThreadEx)
     Task: TTask;
     procedure Execute; override;
@@ -32 +32 @@
 
   TBaseScheduler = class(TScheduler)
-    function AddTask(Name: string; EntryPoint: TEvent): TTask; override;
+    function AddTask(Name: string; EntryPoint: TBasicEvent): TTask; override;
     constructor Create; override;
+    destructor Destroy; override;
     procedure Start; override;
+    procedure Stop; override;
+  end;
+
+  TReceiveEvent = procedure(Data: TMemory) of object;
+
+  { TBaseSerialDevice }
+
+  TBaseSerialDevice = class(TDevice)
+  private
+    Lock: TCriticalSection;
+    FOnReceiveData: TReceiveEvent;
+  public
+    constructor Create; override;
+    destructor Destroy; override;
+    procedure Service(Index: Integer; DataIn, DataOut: TMemory); override;
+    property OnReceiveData: TReceiveEvent read FOnReceiveData write FOnReceiveData;
   end;
 
 implementation
+
+{ TBaseSerialDevice }
+
+constructor TBaseSerialDevice.Create;
+begin
+  inherited Create;
+  ClassName := 'Serial';
+  Lock := TCriticalSection.Create;
+end;
+
+destructor TBaseSerialDevice.Destroy;
+begin
+  Lock.Free;
+  inherited Destroy;
+end;
+
+procedure TBaseSerialDevice.Service(Index: Integer; DataIn, DataOut: TMemory);
+begin
+  inherited Service(Index, DataIn, DataOut);
+  if Index = 0 then begin
+    Lock.Acquire;
+    if Assigned(FOnReceiveData) then
+      FOnReceiveData(DataIn);
+    Lock.Release;
+  end else raise Exception.Create('Unsupported service ' + IntToStr(Index) + ' for driver ''' + Name + '''');
+end;
 
 { TBaseTask }
@@ -63 +106 @@
 { TBaseScheduler }
 
-function TBaseScheduler.AddTask(Name: string; EntryPoint: TEvent): TTask;
+function TBaseScheduler.AddTask(Name: string; EntryPoint: TBasicEvent): TTask;
 var
   Task: TBaseTask;
@@ -77 +120 @@
 end;
 
+destructor TBaseScheduler.Destroy;
+begin
+  inherited Destroy;
+end;
+
 procedure TBaseScheduler.Start;
 var
@@ -86 +134 @@
 end;
 
+procedure TBaseScheduler.Stop;
+begin
+  inherited Start;
+end;
+
 end.