Einzelnen Beitrag anzeigen

Joe24

Registriert seit: 21. Dez 2004
Ort: Berlin
51 Beiträge
 
#2

Re: Problem beim Makieren und Herauskopieren eines Rect's be

  Alt 24. Dez 2004, 22:18
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;
  Mit Zitat antworten Zitat