Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Algorithmen, Datenstrukturen und Klassendesign (https://www.delphipraxis.net/78-algorithmen-datenstrukturen-und-klassendesign/)
-   -   Compare TRect, wie am besten angehen? (https://www.delphipraxis.net/185594-compare-trect-wie-am-besten-angehen.html)

Alter Mann 22. Jun 2015 18:05

Compare TRect, wie am besten angehen?
 
Liste der Anhänge anzeigen (Anzahl: 1)
Hallo,

ich habe ein kleines Compare-Problem.
Ich fülle ein TList via ControllCount und möchte diese
in Abhängigkeit der hinterlegten Rect-Strukturen sortieren.
Delphi-Quellcode:
var
  CL : TList;
...
 CL := TList.Create;
...
  for I := 0 to ControlCount - 1 do
  CL.Add(Controls[I]);
...
 InternalOwner := Self;
 CL.Sort(@CompareTB);
...
 CL.Free;
Delphi-Quellcode:
...
var
  InternalOwner : TControl;

function CompareTopBottom(Item1, Item2 : Pointer) : Integer;
var
  R1, R2 : TRect;
begin
  R1 := TControl(Item1).ClientRect;
  R1.TopLeft := InternalOwner.ScreenToClient(TControl(Item1).ClientToScreen(Point(0, 0)));
  R1.Right  := R1.Left + R1.Right;
  R1.Bottom := R1.Top + R1.Bottom;

  R2 := TControl(Item2).ClientRect;
  R2.TopLeft := InternalOwner.ScreenToClient(TControl(Item2).ClientToScreen(Point(0, 0)));
  R2.Right  := R2.Left + R2.Right;
  R2.Bottom := R2.Top + R2.Bottom;

  if (R1.Top < R2.Top) then Result := -1
  else
  if (R1.Top = R2.Top) then Result := 0
  else
  if (R1.Top > R2.Top) then Result := 1;
end;
Nur Leider ist das Ergebnis 'Suboptimal', siehe Anlage.

Wie könnte ich es anders/besser angehen?

himitsu 22. Jun 2015 21:16

AW: Compare TRect, wie am besten angehen?
 
Ab höheren XE hat TRect und TPoint nette Operatoren und davon auch welche für Vergleiche.

Zitat:

Delphi-Quellcode:
  if (R1.Top < R2.Top) then Result := -1
  else
  if (R1.Top = R2.Top) then Result := 0
  else
  if (R1.Top > R2.Top) then Result := 1;

Delphi-Quellcode:
Result := CompareValue(R1.Top, R2.Top)



Aber die Frage ist auch, wonach die sortiert werden sollen.

Alter Mann 23. Jun 2015 04:28

AW: Compare TRect, wie am besten angehen?
 
Liste der Anhänge anzeigen (Anzahl: 1)
Moin, Moin,

da habe ich etwas unklar ausgedrückt:oops:

Sortiert soll in der Reihenfolge der Rectangles von oben nach unten, d.h. :

TopLeft BottomRight
0, 0 185, 83
0, 83 185, 3
0, 86 185, 105

siehe Grafik.

Links die Ausgabe von ControlCount, Rechts per Hand

hoika 23. Jun 2015 05:09

AW: Compare TRect, wie am besten angehen?
 
Hallo,
wenn ich das richtig verstanden habe, willst du von oben nach unten sortieren
und bei gleichem Top von links nach rechts?
Dann fehlt in deinem Compare das
If Top1=Top2 Then
Begin
if Left1<Left2 Then Result:= -1

usw.


Heiko

stahli 23. Jun 2015 08:38

AW: Compare TRect, wie am besten angehen?
 
Ich habe Deinen Schnipsel noch nicht recht nachvollziehen können.
Wenn alle Controls den gleichen Parent haben, erscheint mir das etwas umständlich. Wenn Du z.B. Right und Bottom nicht auswertest, braucht Du diese eigentlich auch nicht zuweisen.
Aber vielleicht habe ich den Hintergrund nur noch nicht verstanden.

Vielleicht hilft Dir als Anregung meine frühere Lösung: http://www.delphipraxis.net/165177-scrollboxflow.html

himitsu 23. Jun 2015 08:40

AW: Compare TRect, wie am besten angehen?
 
Zitat:

Zitat von hoika (Beitrag 1306195)
wenn ich das richtig verstanden habe, willst du von oben nach unten sortieren
und bei gleichem Top von links nach rechts?

Delphi-Quellcode:
Result := CompareValue(R1.Top, R2.Top);
if Result = 0 then
  Result := CompareValue(R1.Left, R2.Left);

Alter Mann 23. Jun 2015 17:24

AW: Compare TRect, wie am besten angehen?
 
Danke

@stahli
Ja, so in der Art.


In der 2. Grafik kannst du Links ein Panel sehen, auf demr weitere Controls abgelegt sind.
In der 'unsortierten' Liste sieht man die TRect-Werte dazu,
Delphi-Quellcode:
procedure TForm1.ListControlData;
var
  I, J : Integer;
begin
  Memo.Lines.Clear;

  for I := 0 to ControlCount - 1 do
  begin
    AddListControlData(Controls[I]);
    if Controls[I] is TWinControl then
      if TWinControl(Controls[I]).ControlCount > 0 then
      begin
        for J := 0 to TWinControl(Controls[I]).ControlCount - 1 do
          AddListControlData(TWinControl(Controls[I]).Controls[J]);
      end;
  end;
end;

procedure TForm1.AddListControlData(Control : TControl);
var
  R : TRect;
  S : String;
begin
  R        := Control.ClientRect;
  R.TopLeft := Self.ScreenToClient(Control.ClientToScreen(Point(0, 0)));
  R.Right  := R.Left + R.Right;
  R.Bottom := R.Top + R.Bottom;
  if not (Control.Parent = Self) then S := ' ' + Control.Name
                                 else S := Control.Name;
  Memo.Lines.Add(Format('%s : Rect(%d, %d, %d, %d), %s',[S, R.Left, R.Top, R.Right, R.Bottom, AlignToStr(Control.Align)]));
end;
nur leider stimmen sie nicht mit Anordnung überein.
Die 'richtige' Sortierung steht rechts daneben (per Hand).

Wenn jetzt das Align des Panel zur Laufzeit von alLeft auf alTop geändert wird, sollen
die Controls nicht mehr von Top -> Bottom, sondern von Left -> Right ausgerichtet werden.
Und dazu brauche ich die 'richtige' Sortierung.
Erschwerend kommt noch dazu, dass RequestAlign scheinbar mehrfach aufgerufen wird.

stahli 23. Jun 2015 18:19

AW: Compare TRect, wie am besten angehen?
 
Ich kann das aus Zeitgründen nicht genauer nachvollziehen, aber das hier sieht komisch aus:

Delphi-Quellcode:
  R.Right := R.Left + R.Right;
   R.Bottom := R.Top + R.Bottom;
R.Right und R.Bottom sind ja noch nicht richtig zugewiesen. Wolltest Du statt dessen Width und Height verwenden?
Kann das Auswirkungen auf Left und Top haben.?

besser wäre sicher so etwas:

Delphi-Quellcode:
  P := Self.ScreenToClient(Control.ClientToScreen(Point(0, 0)));
  R := TRect.Create(P,X, P,Y, Control.ClientRect.Width, Control.ClientRect.Height);
So fände ich das übersichtlicher.
Ansonsten schau erst mal, ob die Positionen in Bezug auf das Formular überhaupt richtig ermittelt werden.
Bei der Sortierung selbst kann ja dann nicht mehr viel schief gehen.


Dass Align öfter ermittelt wird, damit muss man bei der VCL (und ähnlich auch bei FMX) leben.
Du kannst evtl. selbst einige Werte speichern und beim nächsten Aufruf (vor Deiner Sortierberechnung) prüfen, ob sich an den Ausgangswerten etwas geändert hat. Wenn nicht, einfach nicht neu sortieren.

Alter Mann 24. Jun 2015 18:17

AW: Compare TRect, wie am besten angehen?
 
Liste der Anhänge anzeigen (Anzahl: 1)
Hallo,

Ja das sieht komisch aus, aber dank
Delphi-Quellcode:
R := Control.ClientRect;
werden genau(nur) R.Right und R.Bottom gesetzt.
Nur R.Top und R.Left muss man sich 'umständlich' via
Delphi-Quellcode:
R.TopLeft := Self.ScreenToClient(Control.ClientToScreen(Point(0, 0)));
holen.
Auf Height und Width bin ich in diesem Zusammenhang gar nicht gekommen.

Ich habe aber das ursprüngliche Problem anders gelöst und eine Anleihe bei TObjectList genommen. Heraus gekommen sind:
Delphi-Quellcode:
  TRectEntry   = class(TObject)
  private
    FLeft      : Integer;
    FTop       : Integer;
    FRight     : Integer;
    FBottom    : Integer;
    FControl   : TControl;
  public
    constructor Create(Control : TControl; Rect : TRect);
    destructor Destroy;        override;

    property Left  : Integer  read FLeft;
    property Top   : Integer  read FTop;
    property Right : Integer  read FRight;
    property Bottom : Integer  read FBottom;
    property Control: TControl read FControl;
  end;

  TSortOrder   = (soTopBottom, soLeftRight);

  TRectList    = class(TList)
  private
    FOwnsObjects: Boolean;
    FSortOrder : TSortOrder;
    procedure SetSortOrder(Value : TSortOrder);
  protected
    procedure Notify(Ptr: Pointer; Action: TListNotification); override;
    function GetItem(Index: Integer): TRectEntry;
    function FindNextIndex(X : Integer) : Integer;
  public
    constructor Create;                        overload;
    constructor Create(AOwnsObjects: Boolean); overload;

    function Add(aRectEntry : TRectEntry): Integer;

    property Items[Index: Integer]: TRectEntry read GetItem;
    property OwnsObjects: Boolean   read FOwnsObjects write FOwnsObjects;
    property SortOrder : TSortOrder read FSortOrder   write SetSortOrder default soTopBottom;
  end;
In der RectList sind die beiden Funktionen Add und FindNextIndex, die jenigen, die
bei mir zum Ziel führen:
Delphi-Quellcode:
...
constructor TRectEntry.Create(Control : TControl; Rect : TRect);
begin
  inherited Create;
  FControl := Control;
  FLeft   := Rect.Left;
  FTop    := Rect.Top;
  FRight  := Rect.Right;
  FBottom := Rect.Bottom;
end;
...
function   TRectList.FindNextIndex(X : Integer) : Integer;
var
  I : Integer;
begin
  Result:= -1;
  case SortOrder of
    soTopBottom : begin
                    for I := 0 to Count - 1 do
                    begin
                      if Items[I].Top > X then
                      begin
                        Result := I;
                        Break;
                      end
                      else
                      if Items[I].Bottom = X then
                      begin
                        if I = Count-1 then Result := -1
                                       else Result := I+1;
                        Break;
                      end;
                    end;
                  end;
    soLeftRight : begin
                    for I := 0 to Count - 1 do
                    begin
                      if Items[I].Left > X then
                      begin
                        Result := I;
                        Break;
                      end
                      else
                      if Items[I].Right = X then
                      begin
                        if I = Count-1 then Result := -1
                                       else Result := I+1;
                        Break;
                      end;
                    end;
                  end;
  end;
end;

function   TRectList.Add(aRectEntry : TRectEntry): Integer;
var
  Idx : Integer;
begin
  Result := -1;
  case SortOrder of
    soTopBottom: if Count > 0 then
                 begin
                  Idx := FindNextIndex(aRectEntry.Top);
                  if (Idx > -1) then
                  begin
                    Insert(Idx, aRectEntry);
                    Result := IndexOf(aRectEntry);
                  end
                  else
                    Result := inherited Add(aRectEntry);
                 end
                 else
                 Result := inherited Add(aRectEntry);
    soLeftRight: if Count > 0 then
                 begin
                  Idx := FindNextIndex(aRectEntry.Left);
                  if (Idx > -1) then
                  begin
                    Insert(Idx, aRectEntry);
                    Result := IndexOf(aRectEntry);
                  end
                  else
                    Result := inherited Add(aRectEntry);
                 end
                 else
                 Result := inherited Add(aRectEntry);
  end;
end;
Gefüllt wird die RectList über so:
Delphi-Quellcode:
 
...
  for I := 0 to ControlCount - 1 do
  begin
    R := Controls[I].ClientRect;
    R.TopLeft := ScreenToClient(Controls[I].ClientToScreen(Point(0,0)));
    R.Right  := R.Left + R.Right;
    R.Bottom := R.Top + R.Bottom;
    FRectList.Add(TRectEntry.Create(Controls[I], R));
  end;
Etwas besseres ist mir nicht eingefallen, aber vielleicht weiß ja hier jemand wie
das Problem eleganter gelöst werden kann.


Alle Zeitangaben in WEZ +1. Es ist jetzt 21:19 Uhr.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz