Cropping a Displayed Image and Copying It to a Bitmap (Delphi)

Take the following steps to add code that lets you select an area with a mouse, crop the display to show only that area, and trim the bitmap to match the selected area. (This example uses both cropping and trimming, so that you can see the difference.)

Cropping: Boolean; {The state when the mouse is used for cropping}
StartX: Integer; {Starting X position in screen pixels}
StartY: Integer; {Starting Y position in screen pixels }
EndX: Integer; {Ending X position in screen pixels }
EndY: Integer; {Ending Y position in screen pixels }

procedure TForm1.RectButtonClick(Sender: TObject);

begin
{Initialize cropping so that you can do it more than once}
if Cropping = True Then   
    begin
    {Set the clipping area to match the image.}
    Lead1.SetDstClipRect(Lead1.DstLeft, Lead1.DstTop, 
                     Lead1.DstWidth, Lead1.DstHeight);
    {Display the image}
    Lead1.ForceRepaint
end;

    {Set a form variable to let other events know that you are cropping}
    Cropping := True;

    {Set the pointer to a crosshair}
    Lead1.Cursor := crCross;

end;

procedure TForm1.Lead1MouseDown (Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
{Save the starting position}
StartX := X;
StartY := Y;
{Make the rubberband invisible until the mouse moves}
Lead1.RubberBandVisible := False;
end;

procedure TForm1.Lead1MouseMove (Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
rbX: Integer;
rbY: Integer;
rbHeight: Integer;
rbWidth: Integer;

begin
If (Cropping = True) And (Shift = [ssLeft]) Then
begin
    {Get the current mouse position}
    EndX := X;
    EndY := Y;

    {Determine the origin of the rubberband rectangle,
    regardless of which way the mouse moves.}
    If EndX > StartX Then rbX := StartX Else rbX := EndX;
    If EndY > StartY Then rbY := StartY Else rbY := EndY;

    {Determine the height and width of the rubberband rectangle}
    rbHeight := Abs(StartY - EndY);
    rbWidth := Abs(StartX - EndX);

    {Set the rubberband rectangle};
    Lead1.SetRubberBandRect(rbX, rbY, rbWidth, rbHeight);
        {Alternatively, you could use the following properties to set the
        rubberband rectangle:
        Lead1.RubberBandHeight := rbHeight;
        Lead1.RubberBandLeft := rbX;
        Lead1.RubberBandTop := rbY;
        Lead1.RubberBandWidth := rbWidth; }

    {Make the rubberband rectangle visible}
    Lead1.RubberBandVisible := True;
end;

end;

procedure TForm1.Lead1MouseUp (Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
CropLeft: Integer;
CropTop: Integer;
CropWidth: Integer;
CropHeight: Integer;

begin
{Quit if we are not selecting an area to crop.}
If Cropping = False Then Exit;

{Get the current mouse position}
EndX := X;
EndY := Y;

{Get the origin of the rubberband rectangle.
Allow for different mouse drag directions}
If StartX < EndX Then CropLeft := StartX Else CropLeft := EndX;
If StartY < EndY Then CropTop := StartY Else CropTop := EndY;

{Get the height and width of the cropped area}
CropWidth := Abs(EndX - StartX);
CropHeight := Abs(EndY - StartY);

if (CropWidth < 1) Or (CropHeight < 1) Then
begin
     Lead1.RubberBandVisible := False;
     Exit;
End;

{Crop and repaint the image}
Lead1.SetDstClipRect(CropLeft, CropTop, CropWidth, CropHeight);
Lead1.ForceRepaint;
Lead1.RubberBandVisible := False;
Lead1.Cursor := crDefault; {Default}

End;

procedure TForm1.TrimButtonClick(Sender: TObject);

var
XFactor: Single;
YFactor: Single;
NewTop: Single;
NewLeft: Single;
NewWidth: Single;
NewHeight: Single;
HeightFactor: Single;
WidthFactor: Single;
HeightAllowed: Single;
WidthAllowed: Single;

begin

    Screen.Cursor := crHourglass; {hourglass}

    {Use the clipping rectangle's percentage offsets in the image rectangle}
    {to determine the trimmed rectangle in the bitmap.}
    {Using percentages allows for the possibility that the image is zoomed.}
    XFactor := Lead1.BitmapWidth / Lead1.DstWidth;
    YFactor := Lead1.BitmapHeight / Lead1.DstHeight;
    NewTop := (Lead1.DstClipTop - Lead1.DstTop) * YFactor;
    NewLeft := (Lead1.DstClipLeft - Lead1.DstLeft) * XFactor;
    NewWidth := Lead1.DstClipWidth * XFactor;
    NewHeight := Lead1.DstClipHeight * YFactor;

    {Make sure display rectangles are automatically adjusted.}
    Lead1.AutoSetRects := True;

    {Trim the bitmap.}
    Lead1.Trim(Round(NewLeft), Round(NewTop), Round(NewWidth), Round(NewHeight));

    {Size and redisplay the control, using the new bitmap size.}
    {Set the variables used for preserving the aspect ratio.}
    {Allow for a border of 1/8 of the form size.}
    {The units of measure do not matter, since we are calculating proportions.}
    HeightFactor := Lead1.BitmapHeight;
    WidthFactor := Lead1.BitmapWidth;
    HeightAllowed := ClientHeight - (ClientHeight / 4);
    WidthAllowed := ClientWidth - (ClientWidth / 4);

    {Center the LEAD control on the form, preserving the aspect ratio.}
    {Check to see if using the maximum width will make the image too tall.}
    {Set the dimensions based on the result.}
    if ((WidthAllowed * HeightFactor) / WidthFactor) < HeightAllowed Then
    begin
      Lead1.Left := round(ClientWidth / 8);
      Lead1.Width := round(WidthAllowed);
      Lead1.Height := round((Lead1.Width * HeightFactor) / WidthFactor);
      Lead1.Top := round((ClientHeight - Lead1.Height) / 2);
    end
    Else
    begin
      Lead1.Top := round(ClientHeight / 8);
      Lead1.Height := round(HeightAllowed);
      Lead1.Width := round((Lead1.Height * WidthFactor) / HeightFactor);
      Lead1.Left := round((ClientWidth - Lead1.Width) / 2);
    End;

    {Turn off scroll bars to make sure we use the full client area.}
    Lead1.AutoScroll := False;

    {Set the image display size to match the LEAD control}
    Lead1.SetDstRect(0, 0, Lead1.Width, Lead1.Height);
    Lead1.SetDstClipRect(0, 0, Lead1.Width, Lead1.Height);

    {Display the image}
    Lead1.ForceRepaint;
    Screen.Cursor := crDefault; {Default}

End;