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.