SelectionBox-Komponente?

[PeterPanino]

Hallo! Kennt oder hat jemand eine gute SelectionBox-Komponente für die Auswahl eines Bildbereiches? Ich meine nicht einen Auswahlrahmen, der beim Loslassen der Maustaste wieder verschwindet, sondern eine schöne Box mit Handles zum Anfassen und Vergrößern, die keine Redraw-Probleme hat und bei allen Farbhintergründen gut sichtbar ist!

Ich suche und bastle jetzt schon seit Tagen, habe aber nichts wirklich Brauchbares gefunden. Wer weiß Rat?

[Bummi]

Als Schnellansatz, wenn Du es brauchbar findest kannst Du es ja in eine Komponente wickeln

Delphi-Quellcode:

unit Test;
//20120830 by Thomas Wassermann
interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls;

type
  TSelection = Class(TGraphicControl)
  private
    FSelRect: Trect;
    FHitRegion: Integer;
    FHitPoint: TPoint;
  protected
    procedure MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure Paint; override;
  public
    Constructor Create(AOwner: TComponent); override;
  End;

  TForm5 = class(TForm)
    procedure FormCreate(Sender: TObject);

  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form5: TForm5;

implementation

uses Math;
{$R *.dfm}
{ TSelection }

Const
  C_SIZE = 20;

procedure TSelection.MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  if ssLeft in Shift then
  begin
    Case FHitRegion of
      - 1:
        begin
          if (X > FSelRect.Left) and (Y > FSelRect.Top) then
          begin
            FSelRect.Right := X;
            FSelRect.Bottom := Y;

          end;
        end;
      0:
        begin
          FSelRect.Left := FSelRect.Left + X - FHitPoint.X;
          FSelRect.Right := FSelRect.Right + X - FHitPoint.X;
          FSelRect.Top := FSelRect.Top + Y - FHitPoint.Y;
          FSelRect.Bottom := FSelRect.Bottom + Y - FHitPoint.Y;
          FHitPoint := Point(X, Y);
        end;
      1:
        begin
          if (X > FSelRect.Left) and (Y > FSelRect.Top) then
            begin
            FSelRect.Right := FSelRect.Right + X - FHitPoint.X;
            FSelRect.Bottom := FSelRect.Bottom + Y - FHitPoint.Y;
            FHitPoint := Point(X, Y);
            end;
        end

    End;
  end
  else
  begin
    FHitRegion := -1;
    if ((X - FSelRect.Left) > 0) and ((X - FSelRect.Left) < C_SIZE) and ((Y - FSelRect.Top) > 0) and ((Y - FSelRect.Top) < C_SIZE) then
    begin
      FHitRegion := 0;

    end
    else if ((FSelRect.Right - X) > 0) and ((FSelRect.Right - X) < C_SIZE) and ((FSelRect.Bottom - Y) > 0) and ((FSelRect.Bottom - Y) < C_SIZE) then
    begin
      FHitRegion := 1;

    end
  end;
  invalidate;
end;

procedure TSelection.Paint;
var
  i: Integer;
  P: Array [0 .. 2] of TPoint;
  Size: Integer;
begin
  inherited;
  Size := Min(FSelRect.Right - FSelRect.Left, FSelRect.Bottom - FSelRect.Top);
  if Size > C_SIZE then
    Size := C_SIZE;
  Canvas.Brush.Style := bsClear;
  Canvas.Rectangle(FSelRect);
  if FHitRegion = 0 then
  begin
    Canvas.Brush.Style := bsSolid;
    Canvas.Brush.Color := clBlack;
    P[0].X := FSelRect.Left;
    P[0].Y := FSelRect.Top;
    P[1].X := FSelRect.Left + Size;
    P[1].Y := FSelRect.Top;
    P[2].X := FSelRect.Left;
    P[2].Y := FSelRect.Top + Size;
    Canvas.Polygon(P);
  end;
  if FHitRegion = 1 then
  begin
    Canvas.Brush.Style := bsSolid;
    Canvas.Brush.Color := clBlue;
    P[0].X := FSelRect.Right - 1;
    P[0].Y := FSelRect.Bottom - 1;
    P[1].X := P[0].X - Size;
    P[1].Y := P[0].Y;
    P[2].X := P[0].X;
    P[2].Y := P[0].Y - Size;
    Canvas.Polygon(P);
  end;

end;

Procedure TSelection.MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if not PtInRect(FSelRect, Point(X, Y)) then
  begin
    FSelRect.Left := X;
    FSelRect.Top := Y;
    FSelRect.Right := FSelRect.Left;
    FSelRect.Bottom := FSelRect.Top;
    FHitRegion := -1;
    invalidate;
  end
  else
  begin
    if FHitRegion > -1 then
    begin
      FHitPoint := Point(X, Y);
    end;
  end;
end;

constructor TSelection.Create(AOwner: TComponent);
begin
  inherited;
  OnMouseDown := MouseDown;
  OnMouseMove := MouseMove;
end;

procedure TForm5.FormCreate(Sender: TObject);
begin
  With TSelection.Create(self) do
  begin
    parent := self;
    Align := alClient;
  end;
end;

end.

[PeterPanino]

Hallo Bummi, vielen Dank für den tollen Code!

Am liebsten würde ich eine Komponente aus TImage ableiten und den Code dort einbauen - das sollte doch Teil einer Bildkomponente sein!

Es geht nämlich auch darum: Wenn TImage.Center = True und TImage.Proportional = True, ergibt sich ein recht kniffliges Problem: Der Auswahlrahmen sollte nicht über den Rand des angezeigten Bildes hinausgehen. Das ist natürlich leicht, wenn SizeOfTImage > SizeOfTImage.Picture, weil dann seitlich und vertikal Ränder sind, die man leicht berechnen kann. Wenn das Bild jedoch proportional verkleinert ist (also SizeOfTImage < SizeOfTImage.Picture), dann ist entweder rechts oder links vom Bild ein Rand. Man muss dann das Verhältnis der Proportionen von Image und Image.Picture berechnen, um daraus abzuleiten, ob die Ränder vertikal oder seitlich sind, und daraus die Größe des jeweils angezeigten Randes berechnen. Dann erst kann man den Auswahlrahmen auf das Bild beschränken, wenn dieses proportional verkleinert ist. Hab ich gestern mit der SelectionBox-Komponente von Haan* gemacht und war wie gesagt etwas knifflig ...

Man müsste also diese Proportional-Berechnung in TSelection einbauen, aber besser erscheint es mir, TSelection gleich in einen Nachfahren von TImage einzubauen.

Man sollte natürlich die Linien per XOR mit dem Hintergrund verknüpfen, und schöner wäre es, wenn die Handles wie bei DTP-Rahmen immer sichtbar an den Ecken und Mitten sitzen würden.

Werde mich mal daran machen, wenn ich ein bisschen mehr Zeit habe.

---
* Leider hat die SelectionBox-Komponente von Haan so ziemlich einige Macken.

[Bummi]

In dem Fall würde ich Dir raten gleich eine eigene Komponente auf Basis von TGraphic zu erstellen in der zuerst das Bild nach Deinen Vorgaben (gegf. sogar mit Transparenzen dann würdest Du zu malen der Box allerdings GDI+ benötige) streched und centered (hier würde ich an den Ränder ein paar Pixel lassen) gemalt wird un dann die Selection, oder gegf. beides in einem Offscreenbitmap welches dann auch notfalls einen TImage zugewiesen werden kann.

[PeterPanino]

Ich habe die Paint-Methode etwas verändert. So schaut der Rahmen m.E. sehr hübsch aus und ist sowohl vor hellem als auch vor dunklem Hintergrund sehr gut erkennbar:

Delphi-Quellcode:

procedure TSelection.Paint;
var
  i: Integer;
  P: Array [0 .. 2] of TPoint;
  Size: Integer;
begin
  inherited;
  Size := Min(FSelRect.Right - FSelRect.Left, FSelRect.Bottom - FSelRect.Top);
  if Size > C_SIZE then
    Size := C_SIZE;
  Canvas.Brush.Style := bsClear;
  Canvas.Pen.Style := psAlternate;
  Canvas.Pen.Color := clFuchsia;
  Canvas.Pen.Mode := pmMergePenNot;
  Canvas.Rectangle(FSelRect);
  if FHitRegion = 0 then
  begin
    Canvas.Brush.Style := bsSolid;
    Canvas.Brush.Color := clBlack;
    Canvas.Pen.Style := psAlternate;
    Canvas.Pen.Mode := pmCopy;
    P[0].X := FSelRect.Left;
    P[0].Y := FSelRect.Top;
    P[1].X := FSelRect.Left + Size;
    P[1].Y := FSelRect.Top;
    P[2].X := FSelRect.Left;
    P[2].Y := FSelRect.Top + Size;
    Canvas.Polygon(P);
  end;
  if FHitRegion = 1 then
  begin
    Canvas.Brush.Style := bsSolid;
    Canvas.Brush.Color := clBlue;
    Canvas.Pen.Style := psAlternate;
    Canvas.Pen.Mode := pmCopy;
    P[0].X := FSelRect.Right - 1;
    P[0].Y := FSelRect.Bottom - 1;
    P[1].X := P[0].X - Size;
    P[1].Y := P[0].Y;
    P[2].X := P[0].X;
    P[2].Y := P[0].Y - Size;
    Canvas.Polygon(P);
  end;
end;

[PeterPanino]

Ich habe jetzt ein paar Sachen hinzugefügt: Man kann die Randlinien nun mit der Maus verschieben und somit die Größe der Auswahlbox auch so verändern. S. Anhang. Macht Spaß!

[PeterPanino]

Update 31.8.2012 05:15: Zwei neue Funktionen hinzugefügt:

1. Beim Ändern der Auswahlrahmen-Größe durch Ziehen der Seitenlinien mit der Maus, wird jetzt in der linken oberen Ecke des Auswahlrahmens die veränderte Größe angezeigt.

2. Wenn beim Ziehen der Seitenlinien mit der Maus die Strg-Taste gehalten wird, erfolgt die Größenänderung des Auswahlrahmens in Schritten zu jeweils 10 Pixel.

[Bummi]

Referenzen auf Instanzen außerhalb der zukünftigen Komponente sind Gift, mach' es besser so....

Delphi-Quellcode:

function TSelection.controlDown: Boolean;
//oder geich
function controlDown: Boolean;

oder was sich an dieser Stelle ohnehin anbietet, statt controlDown

Delphi-Quellcode:

if ssCtrl in Shift then

[PeterPanino]

Du hast recht - vielen Dank für den Hinweis!

[PeterPanino]

Update 31.8.2012 11:30: Eine Verbesserung hinzugefügt:

Beim Ziehen der Seitenlinien mit der Maus kann der Auswahlrahmen nun nicht mehr über die Bildgrenzen hinaus vergrößert werden.

[stahli]

Ich denke mal, Eure Lösung ist eleganter ;-)
Aber ich habe mir vor Jahren mal ein Formular gebastelt, das das Auswählen eines Bildausschnittes ermöglicht. (Recht einfache Umsetzung (mit Images und Shapes), aber gut nutzbar.) Anbei mal ein Bild.

Falls Interesse besteht, kann ich das gern posten.

[PeterPanino]

Update 31.8.2012 19:45: Hurra, die Komponente ist fertig!!! Siehe Demo-Projekt und Komponente PPBSelFrame im Anhang.

Neue Funktion: Das Verschieben und Vergrößern des Auswahlrahmens ist jetzt auf die Bildränder begrenzt, wenn Ränder (vertikal, horizontal oder beide) an gezeigt werden. Das ist der Fall, wenn beim Image die Eigenschaften Proportional und Center auf True gesetzt sind. (Was eigentlich für so gut wie alle Anwendungsfälle zutrifft, bei denen es um Bildbearbeitung geht).

Eine Frage habe ich noch: Ich muss innerhalb der Komponente beim Programmstart einmal die Methode SetSelFrameMargins aufrufen, um die Ränder um den Bildinhalt zu berechnen. Das wird normalerweise von der Methode Resize automatisch ausgeführt. Ich habe aber kein Ereignis von TGraphicControl gefunden, welches dies ermöglicht. Deshalb habe ich als Workaround im CreateForm-Event des Fensters das Fenster um ein Pixel vergrößert, um den Resize-Event auszulösen. Ist aber eben nur ein Workaround.

[PeterPanino]

So, jetzt ist viel Neues dazu gekommen, die Komponente hat ihre vorerst endgültige Form erhalten und es ist ein tolles Demo-Programm dabei! Hier ist die Beschreibung der Komponente:

PPBSelFrame 1.0

Auswahlrahmen zum Aufziehen mit der Maus zur Auswahl eines Bildbereiches
aus einem darunterliegenden [Timage], bei welchem die Eigenschaften Center
und Proportional auf True sowie Align auf alClient gesetzt sind.
Dabei wird der Auswahlrahmen beim Aufziehen, Vergrößern und Verschieben auf den
Bildbereich begrenzt, wenn der Parent-Container größer als der Bildbereich ist.
Die Linien des Auswahlrahmens sind sowohl vor hellem als auch vor dunklem
Bildhintergrund gut sichtbar.

ANWENDUNG
---------

1. TImage (oder einen Nachfahren davon) in einen Container (Formular, Panel, usw.)
legen.

2. Proportional und Center des Image auf True setzen, Align auf alClient setzen.

3. DARÜBER PPBSelection legen.

4. In PPBSelection.TheImage das darunterliegende Bild auswählen.

5. Beim Programmstart bzw. vor der ersten Verwendung einmal PPBSelection.Initialize
aufrufen.

FUNKTIONEN
----------

- AUFZIEHEN eines Auswahlrahmens mit der gedrückt gehaltenen linken Maustaste und
dann Loslassen der Maustaste.

- VERSCHIEBEN des Auswahlrahmens durch Ziehen mit der linken Maustaste im Anfassfeld
in der oberen linken Ecke des Auswahlrahmens.

- VERGRÖßERN des Auswahlrahmens:
- Ziehen mit der linken Maustaste im Anfassfeld in der unteren rechten Ecke des
Auswahlrahmens.
- Ziehen der Seitenlinien des Auswahlrahmens mit der linken Maustaste, wobei
in der oberen linken Ecke des Auswahlrahmens die jeweils veränderte Größe
(in Pixel) angezeigt wird.

- Durch Klicken mit der linken Maustaste auf einen Punkt außerhalb des Auswahlrahmens
wird der Auswahlrahmen AUSGEBLENDET.

Methoden:
=========

- Initialize:
Vor der ersten Verwendung muss einmal die Methode Initialize aufgerufen werden,
um wichtige interne Eigenschaften zu initialisieren.

Eigenschaften:
==============

- TheImage: TImage (Published):
Hier MUSS die Bildkomponente ausgewählt werden: TImage oder ein Nachfahre davon.
Ggf. PPBSelection mit Element -> nach vorne bringen.

- ShowSize: Boolean (Published):
Hiermit kann eingestellt werden, ob beim Verändern der Größe des Auswahlrahmens
durch Ziehen der Seitenlinien in der linken oberen Ecke des Auswahlrahmens die
jeweils veränderte Größe angezeigt wird.

- SelFrameRect: TRect (Public):
Hiermit kann die Größe des Auswahlrahmens ausgelesen werden, NACHDEM das Aufziehen
des Auswahlrahmens beendet wurde, also NACHDEM die linke Maustaste losgelassen wurde.
Wenn der Auswahlrahmen nicht sichtbar ist, sind die Werte (nach der Initialisieung):
Left: -100 Right: -100 Top: -100 Bottom: -100 Width: 0 Height: 0

- ImgReduced: Boolean (Public):
Hiermit kann jederzeit (also während oder nach der Größenveränderung des Container-
Elementes) ausgelesen werden, ob das Bild aktuell VERKLEINERT dargestellt wird (also
ob der dargestellte Bildbereich kleiner ist als das Originalbild). Wichtig, wenn man
etwa den Auswahlbereich in der Originalgröße in die Zwischenablage kopiert, indem
man die Größe des Auswahlrahmens mit dem Verkleinerungsfaktor multipliziert.

- HMargins: Boolean (Public):
-> Nur relevant, wenn der Bildbereich verkleinert dargestellt wird (s. ImgReduced).
Hiermit kann ausgelesen werden, ob HORIZONTALE RÄNDER (links und rechts) oder
VERTIKALE RÄNDER (oben und unten) angezeigt werden. Wichtig, wenn man den
Auswahlbereich dann mit dem jeweiligen Verkleinerungsfaktor multipliziert, um so die
Originalgröße des Auswahlbereiches zu erhalten.

- FactorV, FactorH: Extended (Public):
-> Nur relevant, wenn der Bildbereich verkleinert dargestellt wird (s. ImgReduced).
Hiermit kann der Verkleinerungsfaktor des Bildbereiches ausgelesen werden.
Wichtig, wenn man den Auswahlbereich dann mit dem jeweiligen Verkleinerungsfaktor
multipliziert, um so die Originalgröße des Auswahlbereiches zu erhalten.

Ereignisse:
===========

- OnPPBMouseUp:
Wenn die Maustaste losgelassen wird, ist das Aufziehen bzw. die Größenänderung
des Auswahlrahmens abgeschlossen. Hier kann man also ggf. automatisch Aktionen
ausführen, wenn die Definition des Auswahlrahmens abgeschlossen ist.

-------------------------------------------------------------------------------------------

Entstehung: Ich benötigte eine Komponente zum Aufziehen eines Auswahlrahmens. Thomas
Wassermann hat dafür freundlicherweise ein bereits funktionsfähiges Grundgerüst zur Verfügung
gestellt, das ich noch mit zusätzlichen Funktionen angereichert habe. Danke an Thomas für
seine freundliche Hilfe!

Ihr könnt das wenn ihr wollt gerne in die CodeLib geben!

[PeterPanino]

Hier ist die neue Version 1.1:

- Beim Aufziehen des Auswahlrahmens kann dieser nun nicht mehr über die rechte und untere Begrenzung des Bildbereiches hinaus aufgezogen werden.

- Eigenschaft Active hinzugefügt.

- Flackern des Mauspfeils behoben, wenn dieser sich über einem der Anfassfelder befindet.

- Andere kleinere Verbesserungen.

[PeterPanino]

Die Version 1.2 ist da!

Neue Funktion:

Aufziehen und Vergrößern des Auswahlrahmens im Seitenverhältnis des Goldenen Schnittes:

Wenn beim Aufziehen des Auswahlrahmens die Strg-Taste gedrückt wird, folgt das Seitenverhältnis des Auswahlrahmens dem Goldenen Schnitt* in einem liegenden Rechteck.

Wenn beim Aufziehen des Auswahlrahmens die Umschalt-Taste gedrückt wird, folgt das Seitenverhältnis des Auswahlrahmens dem Goldenen Schnitt* in einem stehenden Rechteck.

Wenn beim Ziehen des Größenänderungs-Anfassfeldes in der unteren rechten Ecke des Auswahlrahmens die Strg-Taste gedrückt wird, folgt das Seitenverhältnis des Auswahlrahmens dem Goldenen Schnitt*.

*Zum Verständnis des Goldenen Schnittes siehe: http://de.wikipedia.org/wiki/Goldener_Schnitt

[Jumpy]

Hallo,

warum verschiebst du das nicht oder stellst das ein unter "Projekte der Mitglieder" oder wie die Rubrik heißt?