Objekt-Regionen auf einer Canvas

[hansklok]

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.

[Bummi]

Ich habe es nicht ausprobiert aber:
-wo wird SetRegion aufgerufen
-Im Destuctor von TPerson fehlt DeleteObject(Region)

Delphi-Quellcode:

function TPerson.GetRegion(X,Y: Integer): Boolean;
begin
  if PTinRegion(Region,X,Y) then
    Result:= True else Result:= False;
end;

geht auch so
 Result := PTinRegion(Region,X,Y) ; und

Delphi-Quellcode:

 //statt if Select = True then
if Select  then

Ich schau nachher noch mal drüber, im Moment habe ich zu tun ...

[Bummi]

Ich würde einiges anders machen, aber so läuft es erst mal wie gewünscht:

Delphi-Quellcode:

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, LastPos.Y);
end;

procedure TPerson.DrawSelection;
begin
  Canvas.Brush.Style:= bsSolid;
  Canvas.Brush.Color:= clBlue;
  Canvas.Rectangle(FirstPos.X, FirstPos.Y, LastPos.X, LastPos.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));
      SetPerson(Add(Person));
    end;

  TPerson(Self.Items[0]).FirstPos:= Point(10, 10);
  TPerson(Self.Items[0]).LastPos:= Point(200, 50);
  TPerson(Self.Items[0]).SetRegion;
  TPerson(Self.Items[1]).FirstPos:= Point(10, 80);
  TPerson(Self.Items[1]).LastPos:= Point(200, 130);
  TPerson(Self.Items[1]).SetRegion;
  TPerson(Self.Items[2]).FirstPos:= Point(10, 160);
  TPerson(Self.Items[2]).LastPos:= Point(200, 200);
  TPerson(Self.Items[2]).SetRegion;

end;

[hansklok]

...Vielen Dank Bummi. Funktioniert, wie würdest Du das anstellen?

VG hansklok