Delphi-PRAXiS - FreePascal Objekt-Regionen auf einer Canvas

Hallo,

ich versuche grade herauszufinden, wie ich mehrere Objekte der Klasse TPerson auf einer Canvas ausgeben kann und beim fahren mit der Maus über diese Canvas aufgrund von Objekt-Regionen die einzelnen Objekte markieren kann (also Farbänderung). Aber eben jeweils nur, wenn sich die Maus über dem Objekt innerhalb der Canvas befindet. Ich habe auch ein bisschen rumgespielt, aber so richtig klappt es nicht. Sobald ich mit der Maus über die PaintBox fahre wird immer als Caption "Ja" angezeigt. Es soll aber eben nur "Ja" sein, wenn sich der Cursor auch tatsächlich über dem Objekt befindet.

Ich freue mich über jeden, der einmal einen Blick auf meinen Code-Salat wirft!

HG hansklok

Delphi-Quellcode:

			unit Unit1; 

{$mode objfpc}{$H+}

interface

uses

  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,

  uFamilyTree;

type

  { TForm1 }

  TForm1 = class(TForm)

    PaintBox1: TPaintBox;

    procedure FormCreate(Sender: TObject);

    procedure FormDestroy(Sender: TObject);

    procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;

      Shift: TShiftState; X, Y: Integer);

    procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,

      Y: Integer);

    procedure PaintBox1Paint(Sender: TObject);

  private

    { private declarations }

  public

    { public declarations }

    Offset: TBitmap;

    Stammbaum: TFamilyTree;

  end; 

var

  Form1: TForm1; 

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);

begin

  Offset:= TBitmap.Create;

  Offset.Width:= PaintBox1.Width;

  Offset.Height:= PaintBox1.Height;

  Stammbaum:= TFamilyTree.Create(Offset, PaintBox1.Canvas);

end;

procedure TForm1.FormDestroy(Sender: TObject);

begin

  Stammbaum.Free;

  Offset.Free;

end;

procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;

  Shift: TShiftState; X, Y: Integer);

begin

  if Stammbaum.ObjektRegion(Point(X, Y), True) = True then

    Stammbaum.Paint(True)

  else

    Stammbaum.Paint(False);

end;

procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,

  Y: Integer);

var

  Person: TPerson;

begin

  if Stammbaum.GetObjekt <> nil then

     Person:= Stammbaum.GetObjekt;

  { Wenn gerade nix aufgebaut wird, soll überprüft werden,

    ob sich der Cursor über einem Objekt befindet }

  if Stammbaum.ObjektRegion(Point(X, Y), False) = True then begin

     TPerson(Stammbaum.GetObjekt).DrawSelection;

      //Person.SetRegion;

      Caption:= 'Ja';

     //Person.MouseOver:= True

  end

  else begin

    //Person.SetRegion;

    Caption:= 'Nein';

     //Person.MouseOver:= False;

  end;

  Stammbaum.Paint(False);

end;

procedure TForm1.PaintBox1Paint(Sender: TObject);

begin

  Stammbaum.Paint(False);

end;

end.

Delphi-Quellcode:

			unit uFamilyTree;

{$mode objfpc}{$H+}

interface

uses

  Classes, Graphics, LCLIntf, SysUtils;

type

  TPerson = class(TObject)

    private

      FirstPos,

      LastPos: TPoint;

      Canvas:  TCanvas;

      Region:  THandle;

    public

      MouseOver:  Boolean;

      constructor Create(ACanvas: TCanvas; AFirstPos: TPoint);

      procedure Draw;

      procedure DrawSelection;

      procedure SetRegion;

      function GetRegion(X,Y: Integer): Boolean;

  end;

  TFamilyTree = class(TList)

    private

      Width,

      Height,

      Objekt: Integer;

      Canvas: TCanvas;

      Offset: TBitmap;

    public

      constructor Create(AOffset: TBitmap; ACanvas: TCanvas);

      procedure Paint(SelectPerson: Boolean);

      procedure SetPerson(Person: Integer);

      function GetObj: Integer;

      function GetObjekt: TPerson;

      function ObjektRegion(Punkt: TPoint; Select: Boolean): Boolean;

  end;

implementation

constructor TPerson.Create(ACanvas: TCanvas; AFirstPos: TPoint);

begin

  Self.Canvas:= ACanvas;

  Self.FirstPos:= AFirstPos;

  Self.LastPos:=  AFirstPos;

end;

procedure TPerson.SetRegion;

begin

  Region:= CreateRectRgn(FirstPos.X, FirstPos.Y, LastPos.X, LastPos.Y);

end;

procedure TPerson.Draw;

begin

  Canvas.Brush.Style:= bsSolid;

  if MouseOver then

    Canvas.Brush.Color:= clYellow else

    Canvas.Brush.Color:= clWhite;

  Canvas.Rectangle(FirstPos.X, FirstPos.Y, (LastPos.X-FirstPos.X), (LastPos.Y-FirstPos.Y));

end;

procedure TPerson.DrawSelection;

begin

  Canvas.Brush.Style:= bsSolid;

  Canvas.Brush.Color:= clBlue;

  Canvas.Rectangle(FirstPos.X, FirstPos.Y, (LastPos.X-FirstPos.X), (LastPos.Y-FirstPos.Y));

end;

function TPerson.GetRegion(X,Y: Integer): Boolean;

begin

  if PTinRegion(Region,X,Y) then

    Result:=  True else Result:=  False;

end;

constructor TFamilyTree.Create(AOffset: TBitmap; ACanvas: TCanvas);

var

  i: Integer;

  Person: TPerson;

begin

  inherited Create;

  Self.Canvas:= ACanvas;

  Self.Offset:= AOffset;

  Self.Offset.PixelFormat:= pf32Bit;

  Self.Width:= 800;

  Self.Height:= 550;

  Self.Objekt:= -1;

  for i:= 0 to 2 do

    begin

      Person:= TPerson.Create(ACanvas, Point(0,0));

      //Person.SetRegion;

      SetPerson(Add(Person));

    end;

  TPerson(Self.Items[1]).FirstPos:= Point(10, 10);

  TPerson(Self.Items[1]).LastPos:= Point(200, 50);

  TPerson(Self.Items[2]).FirstPos:= Point(10, 80);

  TPerson(Self.Items[2]).LastPos:= Point(200, 130);

end;

procedure TFamilyTree.Paint(SelectPerson: Boolean);

var

  i: Integer;

begin

  Self.Offset.Width:= Self.Width;

  Self.Offset.Height:= Self.Height;

  with Self.Offset.Canvas do begin

      Self.Offset.Canvas.Brush.Color:= clGreen;

      //fOffset.Canvas.Rectangle(Rect(0,0,fWidth,fHeight));

    { Wenn wenigstens ein Objekt vorhanden ist }

    if Self.Count > 0 then

      { dann alle der entsprechenden Reihenfolge nach zeichnen }

      for i:= 0 to Self.Count - 1 do

        TPerson(Self[i]).Draw;

    end;

  if SelectPerson = True then

    TPerson(Self[Objekt]).DrawSelection;

  //Self.Canvas.Draw(0, 0, Offset);

end;

procedure TFamilyTree.SetPerson(Person: Integer);

begin

  Self.Objekt:= Person;

end;

function TFamilyTree.GetObj: Integer;

begin

  if Objekt <> - 1 then

     Result:= Objekt;

end;

function TFamilyTree.GetObjekt: TPerson;

begin

  { Wenn überhaupt ein aktuelles Objekt makiert }

  if Objekt <> - 1 then

     Result:= TPerson(Self[Objekt])

   else

     Result:= NIL;

end;

function TFamilyTree.ObjektRegion(Punkt: TPoint; Select: Boolean): Boolean;

var

  i:  Integer;

begin

  Result:=  False;

  i:= Self.Count - 1;

  if Self.Count > 0 then

    repeat

      { wenn gefunden, dann ... }

      if TPerson(Self.items[i]).GetRegion(Punkt.X, Punkt.Y) = True then begin

        if Select = True then Objekt:= i;

           Result:= True;

        end;

        Dec(i);

    until (Result = True) or (i = -1);

end;

end.