cpicanco / stimulus_control

A teaching machine for free behavioral experiments
GNU General Public License v3.0
11 stars 7 forks source link

Inherited Starter for all Trial classes. #7

Closed cpicanco closed 8 years ago

cpicanco commented 9 years ago

To reduce maintenance.

cpicanco commented 9 years ago

It turns out to be more difficult than I expected. Need to find a way to inherit drawings.

Not so difficult...

Here is a quick example:


unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls;

type

  { TParent }

  TParent = class(TCustomControl)
    procedure Paint; override;
  end;

  { TChild }

  TChild = class(TParent)
    procedure Paint; override;
    constructor Create(AOwner: TComponent); override;
  end;

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    MyAtrr : TChield;
  public
    { public declarations }
  end;
  procedure CenteredMarker(Canvas: TCanvas; Width, Height, size: integer);
var
  Form1: TForm1;

implementation

procedure CenteredMarker(Canvas: TCanvas; Width, Height, size: integer);
  var center : TPoint;
begin
      center.X := Round(Width / 2);
      center.Y := Round(Height / 2);

      with Canvas do
        begin
          Brush.Color := clBlack;
          Pen.Mode := pmCopy;
          Pen.Color := clBlack;
          Pen.Width := 2;
          with center do
            begin
              Line(X - X, Y, X + X, Y);
              Line(X, Y - Y, X, Y + Y);
            end;

          Brush.Color := clGreen;
          Brush.Style:= bsClear;
          Pen.Mode := pmCopy;
          Pen.Style:= psSolid;
          Pen.Color := clGreen;
          Pen.Width := 2;
          with center do
            Ellipse(X - size, Y - size, X + size, Y + size);

        end;
end;

{$R *.lfm}

{ TParent }

procedure TParent.Paint;
begin
  inherited Paint;
  CenteredMarker(Canvas, 10, 10, 10)
end;

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
begin
  MyAtrr := TChield.Create(Self);
  MyAtrr.Parent := Self;
  MyAtrr.Show;
end;

{ TChild }

procedure TChild.Paint;
begin
  inherited Paint;
  CenteredMarker(Canvas, Width div 2, Height div 2, 10)
end;

constructor TChild.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Width := TForm(AOwner).Width;
  Height := TForm(AOwner).Height;
  Color := clBlack;
end;

end.
cpicanco commented 8 years ago

done [b3ba48c5a96a9e6cfe1e6bb5d7ba37b7f62ad54e]