Clut out a region and attach it to another bitmap

This sample works (not in Win95 though):

procedure TForm1.Button1Click(Sender: TObject);
var
  rgn: hrgn;
  br: hbrush;
begin
  // make sure a bitmap exists in image3
  Image3.Picture.Bitmap.Width := 200;
  Image3.Picture.Bitmap.Height := 200;
  // create the source region
  rgn := CreateEllipticRgn(50, 50, 150, 150);
  // create a pattern brush of the source bitmap
  br := CreatePatternBrush(Image1.Picture.Bitmap.Handle);
  // show the ellipse on the source
  Image1.Canvas.Brush.Style := bsClear;
  Image1.Canvas.Pen.Color := clWhite;
  Image1.Canvas.Ellipse(50, 50, 150, 150);
  // now brush the region on the empty bitmap
  FillRgn(Image3.Picture.Bitmap.Canvas.Handle, rgn, br);
  // move the image over to Image2
  Image2.Picture.Bitmap.Canvas.Brush.Style := bsClear;
  Image2.Picture.Bitmap.Canvas.BrushCopy(Rect(10, 10, 110, 110), Image3.Picture.Bitmap, Rect(50, 50, 150, 150), clWhite);
  Image2.Refresh;
end;

make sure you have bitmaps in Image1 and 2 and that Image3 is empty.

Regards Jacco

P.S: By changing the size of the first rectangle in the BrushCopy you can also transform the selected part

It is not working for me.   Imae 3 is the only onee that changes and I am sujrsure taht this is not what you intended.

CAn I email it to you? or is that tooo much to ask?

Phiil

It is not working for me.   Imae 3 is the only onee that changes and I am sujrsure taht this is not what you intended.

CAn I email it to you? or is that tooo much to ask?

Phiil

hello jpedwards, I'm not to sure what you want from your comments?, You say something about
"be able to cut out the region from the rest of it's bitmap and then paste it onto antoher bitmap"
are you asking for methods to use the Clipboard for bitmaps?
Or are you asking about the Clip Region for a bitmap  Device Context?

here is a button click to Limit the "Drawing" of one bitmap to another, this creates a windows "Region" and then sets the bitmap Device Context to have a Clipped region . . . .

procedure TForm1.button_BmpRegionClick(Sender: TObject);
var
SourceBmp, DestBmp: TBitmap;
hRgn1: Cardinal;
aryPnts: Array[0..5] of TPoint;
begin
aryPnts[0].x := 3;
aryPnts[0].y := 3;
  aryPnts[1].x := 33;
  aryPnts[1].y := 3;
aryPnts[2].x := 63;
aryPnts[2].y := 33;
  aryPnts[3].x := 63;
  aryPnts[3].y := 63;
aryPnts[4].x := 33;
aryPnts[4].y := 93;
  aryPnts[5].x := 3;
  aryPnts[5].y := 3;
hRgn1 := CreatePolygonRgn(aryPnts, 6, Winding);
if hRgn1 <> 0 then
  begin
  SourceBmp := TBitmap.Create;
  SourceBmp.Canvas.Brush.Color := clRed;
  SourceBmp.Width := 128;
  SourceBmp.Height := 128;

  DestBmp := TBitmap.Create;
  DestBmp.Canvas.Brush.Color := clGreen;
  DestBmp.Width := 128;
  DestBmp.Height := 128;

  SelectClipRgn(DestBmp.Canvas.Handle, hRgn1);
// you can limit where the Source BMP is drawn on the Dest Bmp with SelectClipRgn
  DestBmp.Canvas.Draw(0,0, SourceBmp);
  SelectClipRgn(DestBmp.Canvas.Handle, 0);
// release the clip region with Zero
  PaintBox4.canvas.Draw(10,10,DestBmp);
  FreeAndNil(SourceBmp);
  FreeAndNil(DestBmp);
  DeleteObject(hRgn1);
  end;
end;

 - - - - - - -  - - - - -  - - - - - - -
ask questions if you want info about doing a clipboard format

Specifically what I want to do is to cut the head off of one bitmap and paste it onto the body of another chaaracter in another bitmap and then to be able to move that  new character around.

Phil

PS:
The code that I have can cut out an irregularly-shaped region, Like the shape of character's head.

Phil

you can use the code I showed you to only draw just the head region on another bitmap (body), but to have exact palcement you may need to use CopyRect or use the API BitBlt function for precise positioning of the head on the body, I'm guessing you have an array of TPoints for the outline of the head?

I do not understand what you mean by
"The code that I have can cut out an irregularly-shaped region"
are you using region as a windows system graphics object or region as a "word" to describe an area?

Hi, in my sample image2 changes too. I can email my version to you?

Regards Jacco

That  would be great, Jacco.  My email is:

        pedwards@anedsociety.org

Slick812: I will also look over your notes.  You have been of great help  to me in the past, and I have appreciated it.

What I mean by being able to cut out an irregularly shaped object is that the area does NOT have to be a rectangle.

I am using the word region to refer to an MS Windows region.

I appreciate your help, fellas.
Phil

oKAY, i HAVE TWOunits now


The firsst unit:


interface

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

type
  THotSpotRegion = HRGN;

  THotSpotPoints = Array[0..99] of TPoint;

  THotSpotEditFrm = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    ScrollBox: TScrollBox;
    CancelBtn: TBitBtn;
    ClearBtn: TButton;
    PaintBox: TPaintBox;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure PaintBoxPaint(Sender: TObject);
    procedure PaintBoxMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure PaintBoxMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ClearBtnClick(Sender: TObject);
    procedure CancelBtnClick(Sender: TObject);
  private
    { Private declarations }
    FCurrPt: TPoint;         // Point where the mouse currently is
    FDrawing: Boolean;       // Indicates when we are done drawing
    FHotSpot: THotSpotRegion;// Pointer to a Windows region
    FPicture: TPicture;      // Picture to draw a HotSpot on
    FPoints: THotSpotPoints; // Array of points that outlines the HotSpot
    FPointCount: Integer;    // Number of points added to array of points
    FRect: TRect;            // Dimensions of the PaintBox
    procedure AddPoint(NewPt: TPoint);
    procedure ClearPoints;
    procedure RemoveLastPoint;
  public
    { Public declarations }
  end;

var
  HotSpotEditFrm: THotSpotEditFrm;

implementation

{$R *.DFM}

procedure THotSpotEditFrm.FormCreate(Sender: TObject);
begin
  FDrawing := True;  // Indicate the mode we are in
  ClearPoints; // Procedure that clears all points in FPoints array
  PaintBox.Canvas.Pen.Mode := pmNotXor; // Draw shape transparent in the center

  FPicture := TPicture.Create;
  FPicture.LoadFromFile('athena.bmp');

  // FRect holds the dimensions of the PaintBox for drawing FPicture on it
  FRect.TopLeft.x := 0;
  FRect.TopLeft.y := 0;
  FRect.BottomRight.x := PaintBox.Width;
  FRect.BottomRight.y := PaintBox.Height;
end;

procedure THotSpotEditFrm.FormDestroy(Sender: TObject);
begin
  // Clean up dynamically created objects
  DeleteObject(FHotSpot);
  FPicture.Free;
end;

procedure THotSpotEditFrm.PaintBoxPaint(Sender: TObject);
begin
  PaintBox.Canvas.StretchDraw(FRect, FPicture.Graphic);

  if FDrawing then // Draw the shape (or line) to the current mouse position
  begin
    AddPoint(FCurrPt);
    if FPointCount > 2 then
      Polygon(PaintBox.Canvas.Handle, FPoints, FPointCount)
    else if FPointCount = 2 then
      Polyline(PaintBox.Canvas.Handle, FPoints, FPointCount);
    RemoveLastPoint;
  end
  else // Draw the final shape
    Polygon(PaintBox.Canvas.Handle, FPoints, FPointCount);
end;

procedure THotSpotEditFrm.AddPoint(NewPt: TPoint);
begin
  if FPointCount <= 99 then
  begin
    FPoints[FPointCount].X := NewPt.X;
    FPoints[FPointCount].Y := NewPt.Y;
    Inc(FPointCount);
  end
  else
    ShowMessage('Maximum number of points reached.');
end;

procedure THotSpotEditFrm.ClearPoints;
begin
  FPointCount := 0;
end;

procedure THotSpotEditFrm.RemoveLastPoint;
begin
  Dec(FPointCount);
end;

procedure THotSpotEditFrm.PaintBoxMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
  // The current position of the mouse is used to draw the shape as the
  // cursor is moved and to add a point when the mouse is clicked
  FCurrPt.x := X;
  FCurrPt.Y := Y;

  if FDrawing then
    PaintBox.OnPaint(nil) // Force the PaintBox to paint itself
  else // Done drawing so mimic how HotSpot will behave
  begin
    if PtInRegion(FHotSpot, X, Y) then // The mouse is over the HotSpot
      PaintBox.Cursor := crHandPoint
    else
      PaintBox.Cursor := crCross;
  end;
end;

procedure THotSpotEditFrm.PaintBoxMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if FDrawing then // Only allow adding points if we are drawing
  begin
    // Add points using the left mouse button -
    // a right mouse click finishes the drawing
    if Button = mbLeft then
      AddPoint(FCurrPt)
    else if (Button = mbRight) and (FPointCount > 2) then
    // Finish drawing and create HotSpot region
    begin
      FDrawing := False;
      FHotSpot := CreatePolygonRgn(FPoints, FPointCount, WINDING);
      PaintBox.OnPaint(nil); // Paint the final HotSpot shape
    end;
  end;
end;

procedure THotSpotEditFrm.ClearBtnClick(Sender: TObject);
begin
  if MessageDlg('Do you want to cancel current drawing?', mtWarning, [mbYes, mbNo], 0) = mrYes then
  begin
    ClearPoints;
    DeleteObject(FHotSpot); // Clear the HotSpot, if any
    FDrawing := True; // Allow drawing again
    PaintBox.OnPaint(nil); // Clear the PaintBox
  end;
end;

procedure THotSpotEditFrm.CancelBtnClick(Sender: TObject);
begin
  Close;
end;

end.
interface

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

type
  THotSpotRegion = HRGN;

  THotSpotPoints = Array[0..99] of TPoint;

  THotSpotEditFrm = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    ScrollBox: TScrollBox;
    CancelBtn: TBitBtn;
    ClearBtn: TButton;
    PaintBox: TPaintBox;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure PaintBoxPaint(Sender: TObject);
    procedure PaintBoxMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure PaintBoxMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ClearBtnClick(Sender: TObject);
    procedure CancelBtnClick(Sender: TObject);
  private
    { Private declarations }
    FCurrPt: TPoint;         // Point where the mouse currently is
    FDrawing: Boolean;       // Indicates when we are done drawing
    FHotSpot: THotSpotRegion;// Pointer to a Windows region
    FPicture: TPicture;      // Picture to draw a HotSpot on
    FPoints: THotSpotPoints; // Array of points that outlines the HotSpot
    FPointCount: Integer;    // Number of points added to array of points
    FRect: TRect;            // Dimensions of the PaintBox
    procedure AddPoint(NewPt: TPoint);
    procedure ClearPoints;
    procedure RemoveLastPoint;
  public
    { Public declarations }
  end;

var
  HotSpotEditFrm: THotSpotEditFrm;

implementation

{$R *.DFM}

procedure THotSpotEditFrm.FormCreate(Sender: TObject);
begin
  FDrawing := True;  // Indicate the mode we are in
  ClearPoints; // Procedure that clears all points in FPoints array
  PaintBox.Canvas.Pen.Mode := pmNotXor; // Draw shape transparent in the center

  FPicture := TPicture.Create;
  FPicture.LoadFromFile('athena.bmp');

  // FRect holds the dimensions of the PaintBox for drawing FPicture on it
  FRect.TopLeft.x := 0;
  FRect.TopLeft.y := 0;
  FRect.BottomRight.x := PaintBox.Width;
  FRect.BottomRight.y := PaintBox.Height;
end;

procedure THotSpotEditFrm.FormDestroy(Sender: TObject);
begin
  // Clean up dynamically created objects
  DeleteObject(FHotSpot);
  FPicture.Free;
end;

procedure THotSpotEditFrm.PaintBoxPaint(Sender: TObject);
begin
  PaintBox.Canvas.StretchDraw(FRect, FPicture.Graphic);

  if FDrawing then // Draw the shape (or line) to the current mouse position
  begin
    AddPoint(FCurrPt);
    if FPointCount > 2 then
      Polygon(PaintBox.Canvas.Handle, FPoints, FPointCount)
    else if FPointCount = 2 then
      Polyline(PaintBox.Canvas.Handle, FPoints, FPointCount);
    RemoveLastPoint;
  end
  else // Draw the final shape
    Polygon(PaintBox.Canvas.Handle, FPoints, FPointCount);
end;

procedure THotSpotEditFrm.AddPoint(NewPt: TPoint);
begin
  if FPointCount <= 99 then
  begin
    FPoints[FPointCount].X := NewPt.X;
    FPoints[FPointCount].Y := NewPt.Y;
    Inc(FPointCount);
  end
  else
    ShowMessage('Maximum number of points reached.');
end;

procedure THotSpotEditFrm.ClearPoints;
begin
  FPointCount := 0;
end;

procedure THotSpotEditFrm.RemoveLastPoint;
begin
  Dec(FPointCount);
end;

procedure THotSpotEditFrm.PaintBoxMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
  // The current position of the mouse is used to draw the shape as the
  // cursor is moved and to add a point when the mouse is clicked
  FCurrPt.x := X;
  FCurrPt.Y := Y;

  if FDrawing then
    PaintBox.OnPaint(nil) // Force the PaintBox to paint itself
  else // Done drawing so mimic how HotSpot will behave
  begin
    if PtInRegion(FHotSpot, X, Y) then // The mouse is over the HotSpot
      PaintBox.Cursor := crHandPoint
    else
      PaintBox.Cursor := crCross;
  end;
end;

procedure THotSpotEditFrm.PaintBoxMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if FDrawing then // Only allow adding points if we are drawing
  begin
    // Add points using the left mouse button -
    // a right mouse click finishes the drawing
    if Button = mbLeft then
      AddPoint(FCurrPt)
    else if (Button = mbRight) and (FPointCount > 2) then
    // Finish drawing and create HotSpot region
    begin
      FDrawing := False;
      FHotSpot := CreatePolygonRgn(FPoints, FPointCount, WINDING);
      PaintBox.OnPaint(nil); // Paint the final HotSpot shape
    end;
  end;
end;

procedure THotSpotEditFrm.ClearBtnClick(Sender: TObject);
begin
  if MessageDlg('Do you want to cancel current drawing?', mtWarning, [mbYes, mbNo], 0) = mrYes then
  begin
    ClearPoints;
    DeleteObject(FHotSpot); // Clear the HotSpot, if any
    FDrawing := True; // Allow drawing again
    PaintBox.OnPaint(nil); // Clear the PaintBox
  end;
end;

procedure THotSpotEditFrm.CancelBtnClick(Sender: TObject);
begin
  Close;
end;

end.



//******************************************************************
And I have the SECOND unit from Slick812, which loooks like it  is doing what I want, but just has color instead of pictures:

The picturrre up above is the Athena pict that comes with Delphi.  How can I lop off Athena's head and put it onto antoher figure?   I still don't quite get it.

Did you get my email?

you are not suppose to do Email here at EE, a EE support person will come around and delete any Email addresses