[Gelöst!]Frage zur Vererbung von Methoden - ich raffs nicht.

[Nimral]

Hi Jungs,

ich brauche einen Anschubs in Richtung OOP mit Lazarus/FPC. Anbei ein Auszug aus einem längeren Projekt, mit dem ich mir den Sonntag um die Ohren geschlagen habe. Obwohl das Programm funktioniert, bin ich mit der Objektstruktur unzufrieden. Ich habe es immerhin gesschafft, die prozedural entwickelte Vorgängerversion des Programms in eine Objektstruktur umzubauen, die auch funktioniert, aber jetzt ginge es noch darum, das Ganze so aufzustellen dass ich viele, viele ähnliche Messgeräte durch Ableitung erzeugen und durch Überschreiben der einen oder anderen Methode an ganz verschiedene Messgeräte anpassen kann.

Das Program sucht ein seriell angesteuertes Messgerät auf dem COM-Ports 0-15, und pollt es dann in einem eigenen Thread. Immer wenn man dem Gerät ein '?' sendet, antwortet es mit einem Messwert, der immer genau 6 Zeichen lang ist. Ich kann jedem Messgerät einen einzigartigen ID-String einspeichern, ich habe dieses 'Serial Gauge Reader' genannt. Schickt man ihm ein '!', kommt der ID String zurück. Das verwende ich, um beim Thread-Start den richtigen Com Port zu suchen. Die selbe Such-Routine wird auch wieder bemüht wenn die Verbindung zum Messgerät verloren geht. Klappt auch, ich kann es ab- und anstecken wie ich will, nach ein paar Sekunden Denkpause kommen wieder Messwerte rein. Um das mal prinzipiell zu visualisieren, habe ich den Rahmen des Ausgabefeldes grün gefärbt wenn ein gültiger Wert empfangen wurde, und er färbt sich rot, wenn die Verbindung verloren geht.

Code: Alles auswählen

 
unit Unit1;
 
{$mode objfpc}{$H+}
{$DEFINE UseCThreads}
 
interface
 
uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls;
 
const
     COM_NAME: string = '\\.\COM';
     COM_BAUD = 115200;
     MAX_BUFFER = 100;
     MIN_COM = 0;
     MAX_COM = 15;
 
const
  CR = #13;
  LF = #10;
  CRLF = CR + LF;
 
type
 
  { TSerialDevice }
 
  TSerialDevice = class (TThread)
    _ComHandle: longint;            // handle to com port 0 = com port not open
    _ComName: string;               // os specific com port name
    _ComReady:boolean;
    _Value:String;
 
  private
    procedure ValueChanged();
    procedure ComReadyChanged();
  protected
     procedure Execute; override;
  public
    constructor create;
    Property Value:String read _Value write SetValue;
    procedure SetValue(AValue: String);
    procedure onValueChanged();
    function isValidValue(S:String):boolean;
    Property ComReady:boolean read _ComReady write SetComReady;
    procedure SetComReady(AValue: boolean);
    procedure onComReadyChanged();
    function ComOpen(ComName:String; ComBaud : longInt) : boolean;
    function ComFindAndOpen(ComNamePrefix: string; ComBaud: longInt): boolean;
    procedure ComSendProbe();
    function ComReadProbeResponse():boolean;
    procedure ComClose();
  end;
 
  { TGauge1Device }
 
  TGauge1Device = class (TSerialDevice)
 
  private
    procedure ValueChanged();
  public
  end;
 
  { TForm1 }
 
  TForm1 = class(TForm)
    GaugeValue: TLabel;
    GaugePanel: TPanel;
    procedure FormActivate(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
 
  private
    var _FirstActivate : boolean;
 
  public
 
  end;
 
var
  Form1: TForm1;
  Gauge1 : TSerialDevice;
 
implementation
 
{$R *.lfm}
 
uses serial;
 
{ TGauge1Device }
 
procedure TGauge1Device.ValueChanged();
 
var
    R : real;
    S : String;
 
  begin
    try
       str(R:6:3,S);
       Form1.GaugeValue.Caption := FloatToStr(R/1000);
    except
    end;
end;
 
{ TGauge1Device }
 
 
{ TSerialDevice }
 
constructor TSerialDevice.create;
 
begin
  FreeOnTerminate := False;
  inherited create(true);     // always create suspended
end;
 
function TSerialDevice.ComOpen(ComName: String; ComBaud: longInt): boolean;
 
begin
  _ComHandle := SerOpen(ComName);
  if _ComHandle <> 0 then
  begin
    SerSetParams(_ComHandle, ComBaud, 8, NoneParity, 1, []);
    Sleep(200);
  end;
  result := _ComHandle <> 0;
end;
 
function TSerialDevice.ComFindAndOpen(ComNamePrefix: string; ComBaud: longInt
  ): boolean;
 
const ProbeString = '!';
  ProbeResponse = 'Digital Gauge Reader' + CRLF;
 
var
  i: integer;
  ComName: string;
  ByteBuffer: array[0..MAX_BUFFER] of byte;
  StringBuffer: ShortString absolute ByteBuffer;
 
begin
  for i := MIN_COM to MAX_COM do
  begin
    ComName := ComNamePrefix + IntToStr(i);
    if ComOpen(ComName, ComBaud) then
      begin
        // probe this port
        StringBuffer := ProbeString;
        SerWrite(_ComHandle, ByteBuffer[1], Length(StringBuffer));
        ByteBuffer[0] := SerReadTimeout(_ComHandle, ByteBuffer[1],length(ProbeResponse),2000);
        if StringBuffer = ProbeResponse then
           begin
           _ComName := ComName;
           ComReady := true;
           break;
           end
        else
           ComClose();
        end;
    end;
    Result := _ComHandle <> 0;
end;
 
procedure TSerialDevice.ComSendProbe();
 
var
  ByteBuffer: array[0..MAX_BUFFER] of byte;
  StringBuffer: ShortString absolute ByteBuffer;
 
begin
  SerFlushInput(_ComHandle);
  StringBuffer := '?';
  SerWrite(_ComHandle,ByteBuffer[1],Length(StringBuffer));
end;
 
function TSerialDevice.ComReadProbeResponse(): boolean;
 
var
  ByteBuffer: array[0..MAX_BUFFER] of byte;
  StringBuffer: ShortString absolute ByteBuffer;
 
begin
  result := false;
  ByteBuffer[0] := SerReadTimeout(_ComHandle, ByteBuffer[1],8,300);
  // Parse the input
  If IsValidValue(StringBuffer) then
     begin
     Value := StringBuffer;
     result := true;
     end;
end;
 
procedure TSerialDevice.ComClose();
begin
  if _ComHandle <> 0 then
    begin
    try
       SerClose(_ComHandle);
    except
    end;
    ComReady := false;
    _ComHandle := 0;
    end;
end;
 
procedure TSerialDevice.onValueChanged();
 
var
  S:String;
 
begin
  Synchronize(@ValueChanged)
end;
 
procedure TSerialDevice.SetValue(AValue: String);
begin
  if _Value=AValue then Exit;
  _Value:=AValue;
  OnValueChanged();
end;
 
procedure TSerialDevice.ValueChanged();
begin
  Form1.GaugeValue.Caption := Value;
end;
 
procedure TSerialDevice.SetComReady(AValue: boolean);
 
begin
  if _ComReady=AValue then Exit;
  _ComReady:=AValue;
  OnComReadyChanged();
end;
 
procedure TSerialDevice.ComReadyChanged();
 
begin
  if ComReady then
    Form1.GaugePanel.BevelColor := clGreen
  else
    Form1.GaugePanel.BevelColor := clRed;
end;
 
procedure TSerialDevice.onComReadyChanged();
 
begin
  Synchronize(@ComReadyChanged);
end;
 
 
procedure TSerialDevice.Execute;
 
var
  S:String;
 
begin
  ComReady := false;
  while not Terminated do
  begin
    // find the device com port
    if _ComHandle = 0 then
      ComFindAndOpen(COM_NAME, COM_BAUD);
    // read values
    if _ComHandle <> 0 then
      begin
      ComSendProbe();
      if not ComReadProbeResponse() then
        ComClose();
      end;
  end;
  // close the com port
  ComClose();
end;
 
function TSerialDevice.isValidValue(S: String): boolean;
 
begin
     isValidValue := length(S) = 8;    // 6 digits + CRLF
end;
 
{ TForm1 }
 
procedure TForm1.FormActivate(Sender: TObject);
 
begin
  if _FirstActivate then
    begin
    Gauge1.Resume;
    _FirstActivate := false;
    end;
end;
 
procedure TForm1.FormCreate(Sender: TObject);
 
begin
  inherited;
  _FirstActivate := true;
  Gauge1:=TSerialDevice.Create;
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
 
begin
  Gauge1.Terminate;
  Gauge1.Free;
  inherited;
end;
 
end.
 
 

Die serielle Kommunikation mit dem Messgerät habe ich also im Griff. Der Code ist, denke ich, schon ziemlich OOP, aber ich schaffe es nicht, ihn so umzubauen, dass ich verschiedene ähnliche Messgeräte von einer Basisklasse TSerialDevice ableiten kann. Derzeit steht der Code des konkreten Testgerätes da drinnen, obwohl er eigentlich in eine abgeleitete Klasse gehören würde. Um das zu verdeutlichen, habe ich einen gescheiterten Versuch (TGauge1Reader) stehen lassen, das zu ändern: wenn setValue einen empfangenen Wert wegspeichert, weil er sich vom Vorgänger unterscheidet, wird onValueChanged angestoßen, der seinerseits wieder per Synchronize das Ausgabefeld im Form1 auf Stand bringt. Wenn ich - um mal irgendwo zu beginnen - das allgemein formulieren müsste, würde onValueChanged und ValueChanged in der Basisklasse gar nicht konkret existieren. SetValue wäre immer gleich, könnte also ruhig Teil der Basisklasse bleiben, aber er müsste sicher gehen, dass onValueChanged implementiert wurde. Ich suche also die richtige Syntax, um das allgemeine gerippe, das allen diesen Geräten gleich ist, in eine Basisklasse zu packen, und die Unterschiede in abgeleitete Klassen zu packen.

Ich habe nun, denke ich, so ziemlich alle Varianten probiert, ValueChanged und onValueChanged in der Basisklasse virtual; oder abstract; oder beides zu markieren, und per override durch eine Methode aus TGaugeThread zu ersetzen, außerdem mit "Procedure of Object" experimentiert, aber außer empörten Fehlermeldungen oder - deshalb hab ich es stehen lassen - blanker Ignoranz nichts aus Lazarus/FPC herausbekommen. Es läuft darauf hinaus wie man in einem Basisobjekt, in dem sich Methoden befinden die sich gegenseitig aufrufen, die Vererbung formuliert, so dass eine von der abgeleiteten Klasse nicht überschriebene Methode statt der Methode in der Grundklasse die Methode der Klasse aufruft, die von ihr ableitet. Bereits das Formulieren des Problems in OOP-Slang macht mir Probleme, daher das Beispiel.

Wer kann mich in die richtige Richtung lenken?

Armin.

P.S. kann man das Code-Tag eigentlich irgendwie so schreiben dass das Code-Sample in einem Scroll-Fenster angezeigt wird?

[Warf]

In deinem beispiel ist ValueChanged private, wenn das so ist, kannst du sie nicht überladen, da private eigentlich nur für die eigene Klasse sichtbar ist. Protected sind Methoden die nur von der Vererbungshirachie gesehen werden können.

Wenn du eine funktion hast die du benutzen willst, ohne zu wissen wie sie implementiert wird, ist virtual; abstract; das richtige. Wenn du eine funktion hast die eine basis funktionalität haben soll, die aber von Nachfolgern überschrieben werden kann wenn sich was ändert, kannst du sie nur virtual; machen. Wenn eine Funktion mit der vererbungs hirachie nix zu tun haben soll, mach sie weder virtual noch abstract. Eine funktion die eine andere überschreibt muss mit override; gekennzeichnet sein. Du kannst nur virtual methoden überschreiben.
Wenn du basisfunktionalität erweitern willst, kannst du die funktion überschreiben und darin inherited aufrufen:

Code: Alles auswählen

procedure Foo;
begin
  // irgendwas
  inherited Foo; // führt funktionalität der Basisklasse aus
  // irgendwas anderes
end;

Z.b. du willst die ID checken, aber Case insensitive:

Code: Alles auswählen

function GetID: String;
begin
  Result := (inherited GetID).ToLowerCase;
end;

Das ist eigentlich so das wichtigste zum Thema vererbung.

P.S. kann man das Code-Tag eigentlich irgendwie so schreiben dass das Code-Sample in einem Scroll-Fenster angezeigt wird?

Ne, gibt soweit ich weiß auch keine Spoiler oder so, dafür ist die Forensoftware glaube ich einfach zu alt (auf der Startseite steht ja Powered by Board3 Portal © 2009 - 2013 Board3 Group). Ich glaub hinter den Kulissen arbeiten aber schon leute von Verein dran das Forum zu updaten, keine ahnung wie der Status ist

[theo]

Eine der "dichtesten" Einführungen in das Thema ist für mich immer noch:
https://www.delphi-treff.de/tutorials/o ... ashkurs/8/

[Nimral]

Hi,

danke euch für eure Hilfsbereitschaft. Aber weiter gebracht hat mich das nicht. Einführungen zu OOP habe ich einige hinter mir, mit Viechern, mit Fahrzeugen, mit Früchten und mit geometrischen Formen waren sicher auch einige dabei. ValueChanged und OnValueChanged in die "Private" Sektion zu schubsen war ein Überrest eines verzweifelten Tests, hast recht, da gehört es nicht hin, kannst es aber auch woanders hinschubsen, das Problem bleibt gleich. So gehört es:

Code: Alles auswählen

 
  { TSerialDevice }
 
  TSerialDevice = class (TThread)
    _ComHandle: longint;            // handle to com port 0 = com port not open
    _ComName: string;               // os specific com port name
    _ComReady:boolean;
    _Value:String;
 
  private
  protected
     procedure Execute; override;
  public
    constructor create;
    procedure ValueChanged(); virtual;  // update the GUI, runs synchronized
    procedure onValueChanged();         // triggered by SetValue if the value <> old value
    procedure SetValue(AValue: String); // processes the last measured value
    Property Value:String read _Value write SetValue;  // last value measured
    function isValidValue(S:String):boolean; // check the serial input if it contains a valid value
    procedure ComReadyChanged();
    procedure onComReadyChanged();
    procedure SetComReady(AValue: boolean);
    Property ComReady:boolean read _ComReady write SetComReady;
    function ComOpen(ComName:String; ComBaud : longInt) : boolean;
    function ComFindAndOpen(ComNamePrefix: string; ComBaud: longInt): boolean;
    procedure ComSendProbe();
    function ComReadProbeResponse():boolean;
    procedure ComClose();
  end;  
 

Konzentrieren wir uns auf eine Teilsequenz.

 

Code: Alles auswählen

 
 
procedure TSerialDevice.ValueChanged();
begin
  Form1.GaugeValue.Caption := Value;
end; 
 
procedure TSerialDevice.onValueChanged();
 
var
  S:String;
 
begin
  Synchronize(@ValueChanged)
end;
 
procedure TSerialDevice.SetValue(AValue: String);
begin
  if _Value=AValue then Exit;
  _Value:=AValue;
  OnValueChanged();
end;
 
 

In meinem Beispiel habe ich nun versucht, ValueChanged zu überschreiben. Das Messgerät liefert 1/1000mm Messwerte, ich möchte eine Anzeige in mm mit 3 Nachkommastellen haben. Also habe ich ValueChanged überschrieben.

Code: Alles auswählen

 
  { TGauge1Device }
 
  TGauge1Device = class (TSerialDevice)
 
  public
    procedure ValueChanged(); override;
  end; 
 
...
 
procedure TGauge1Device.ValueChanged();
 
var
   S : String;
 
  begin
    try
       str((StrToFloat(_Value)/1000):6:3,S);
       Form1.GaugeValue.Caption := S;
    except
    end;
end; 
 

Ich finde da keinen Fehler, weder gedanklich, noch handwerklich. FPC ruft allerdings stur die ValueChanged Methode von TSerialDevice auf. virtual und override ändern daran genau null. Schätze konkret: er hats nicht gerafft, dass da jetzt die überschreibende Methode dran wäre. Würde es klappen, wenn ich auch SetValue() und onValueChanged überschreiben würde? Wahrscheinlich, aber war das mit der Arbeitererleichterung durch OOP denn so gedacht? Ich meine, eher nein.

???

Armin.

[Nimral]

Ich habs gefunden. Der Fehler lag ganz woanders, ich habe es versäumt, die Deklaration von Gauge1 von TSerialDevice auf TGauge1Device zu ändern.

Alles gut!

Armin.

[Nimral]

@Theo: es ist zwar anderthalb Jahre her, und damals hab ich einfach nicht gerafft was Du mir da auf den Tisch gelegt hattest, aber inzwischen bin ich zwar immer noch kein großer Meister der OOP aber doch ein wenig weiter, und Du hattest Recht: die Einführung ist eine der besten, die mir untergekommen ist. Sie kommt einfach meiner Denkweise maximal entgegen.

In dem Sinne, nochmal vielen Dank!

Armin.