Problem beim Makieren und Herauskopieren eines Rect's bei ei

[PhilGo]

Hallo!
Also ich habe eine TIMage mit geladenem Bild. Nun will ich mit der Maus einen Teilbereich(Rect) herauskopieren und nur diesen dann auf meiner Image darstellen(und speichern).
Könnt ihr mir weiterhelfen?


Gruß
PhilGo

[Joe24]

Probier es mal mit einer Instanz dieser Klasse.
Übergebe dein ZielImage einfach dem Property DestImage.
Bei mir hat es funktioniert.

Delphi-Quellcode:

  TCaptureImage = class( TImage)
   private
    FIsCapture : Boolean;
    FCaptureRect : TRect;
    FDestImage : TImage;
    function ClientRectToParentForm( aClientRect : TRect) : TRect;
    function ConvertToOutRect( aCaptureRect : TRect) : TRect;
    procedure SetDestImage( aImage : TImage);
   protected
    procedure MouseDown( Button: TMouseButton; Shift: TShiftState; X, Y: Integer);   
        override;
    procedure MouseMove( Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp( Button: TMouseButton; Shift: TShiftState; X, Y: Integer); 
        override;
   public
    constructor Create( aOwner : TComponent); override;
    property IsCapture : Boolean read FIsCapture;
    property CaptureRect : TRect read FCaptureRect;
   published 
    property DestImage : TImage read FDestImage write SetDestImage;
  end;

constructor TCaptureImage.Create( aOwner : TComponent);
begin
  inherited Create( aOwner);
  FIsCapture := FALSE;
  {if aOwner is TWinControl then
    Parent := TWinControl( aOwner);}
end;

function TCaptureImage.ClientRectToParentForm( aClientRect : TRect) : TRect;
begin
  result.TopLeft := ClientToParent( aClientRect.TopLeft, GetParentForm( self));
  result.BottomRight := ClientToParent( aClientRect.BottomRight, GetParentForm( self));
end;

function TCaptureImage.ConvertToOutRect( aCaptureRect : TRect) : TRect;
begin
  with aCaptureRect do
    result := Rect( 0, 0, Right -Left, Bottom -Top);
end;

procedure TCaptureImage.SetDestImage( aImage : TImage);
begin
  if Assigned( FDestImage) then
    FDestImage.Assign( aImage) else
    FDestImage := aImage;
end;

procedure TCaptureImage.MouseDown( Button: TMouseButton; Shift: TShiftState; 
    X, Y: Integer);
begin
    if ( ssLeft in Shift) and
       not IsCapture then
      begin
        Cursor := crCross;
        Perform(WM_SETCURSOR, Parent.Handle, HTCLIENT);
        FIsCapture := TRUE;
        FCaptureRect.TopLeft := Point( X, Y);
        FCaptureRect.BottomRight := FCaptureRect.TopLeft;
      end;
  inherited MouseDown( Button, Shift, X, Y);
end;

procedure TCaptureImage.MouseMove( Shift: TShiftState; X, Y: Integer);
begin
  if ( ssLeft in Shift) and
     IsCapture and
     ( ( X <> FCaptureRect.Right) or
       ( Y <> FCaptureRect.Bottom)) then
    begin
      with FCaptureRect do
        begin
          if X > Width then
            Right := Width else
            Right := X;
          if Y > Height then
            Bottom := Height else
            Bottom := Y;
          Repaint;
          GetParentForm( self).Canvas.DrawFocusRect( ClientRectToParentForm( 
              FCaptureRect));
        end;
    end;
  inherited MouseMove( Shift, X, Y);
end;

procedure TCaptureImage.MouseUp( Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
   if IsCapture then
      begin
        if Assigned( FDestImage) then
         FDestImage.Canvas.CopyRect( ConvertToOutRect( FCaptureRect), Canvas,      
             FCaptureRect);
        Cursor := crDefault;
        Perform(WM_SETCURSOR, Parent.Handle, HTCLIENT);
        FIsCapture := FALSE;
        Invalidate; 
      end;
  inherited MouseUp( Button, Shift, X, Y);
end;

[PhilGo]

Danke schön für den Code!
Werde ich gleich mal ausprobieren! :wink:


Gruß
PhilGo