Clut out a region and attach it to another bitmap

I got some code from a friend, which can outline a "region".   I would like to be able to cut out the region from the rest of it's bitmap and then paste it onto antoher bitmap contaiining an invisible color. "Anybody know how to do that?

Phil
jpedwardsAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

JaccoCommented:
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
0
jpedwardsAuthor Commented:
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

0
jpedwardsAuthor Commented:
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

0
Cloud Class® Course: C++ 11 Fundamentals

This course will introduce you to C++ 11 and teach you about syntax fundamentals.

Slick812Commented:
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
0
jpedwardsAuthor Commented:
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
0
jpedwardsAuthor Commented:
PS:
The code that I have can cut out an irregularly-shaped region, Like the shape of character's head.

Phil
0
Slick812Commented:
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?
0
JaccoCommented:
Hi, in my sample image2 changes too. I can email my version to you?

Regards Jacco
0
jpedwardsAuthor Commented:
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
0
jpedwardsAuthor Commented:
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.




0
JaccoCommented:
Did you get my email?
0
Slick812Commented:
you are not suppose to do Email here at EE, a EE support person will come around and delete any Email addresses
0
Slick812Commented:
OK, here is some code to use a windows system "Region" graphic object to limit where a bitmap is drawn on another bitmap. Like your code this uses a TPaintBox to draw on and I use an Array of TPoint to store the mouse move positions. There is a TPaintBox, PaintBox1, and two buttons. The button_LoadBmp Button just loads 2 bitmaps form files a Head and body bitmap, The button_ApplyHead button will take the aryPnts make a region and the draw the head Pic on the body pic and then draw the Body Pic in the paint box



    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure button_LoadBmpClick(Sender: TObject);
    procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure button_ApplyHeadClick(Sender: TObject);
  private
    { Private declarations }
    HeadPic, BodyPic: TBitmap;
    Drawing: Boolean;
    aryPnts: Array of TPoint;


procedure TForm1.FormCreate(Sender: TObject);
begin
Drawing := False;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
FreeAndNil(HeadPic);
FreeAndNil(BodyPic);
end;

procedure TForm1.sbut_LoadBmpClick(Sender: TObject);
var
i: Integer;
begin
if Assigned(HeadPic) then Exit;
HeadPic := TBitmap.Create;
HeadPic.LoadFromFile('E:\face1.bmp');
PaintBox1.Width := HeadPic.Width;
PaintBox1.Height := HeadPic.Height;
PaintBox1.Canvas.Draw(0,0,HeadPic);
BodyPic := TBitmap.Create;
BodyPic.LoadFromFile('E:\body1.bmp');
end;


procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
PaintBox1.Canvas.Brush.Color := clwhite;
PaintBox1.Canvas.Rectangle(PaintBox1.ClientRect);
if Assigned(HeadPic) and not HeadPic.Empty then
  PaintBox1.Canvas.Draw(0,0,HeadPic);
{DO NOT USE ANY STRETCH DRAW METHOD
it is important to match the aryPnts position to the Bitmap pixel
positions, if you stretch draw, the aryPnts position will NOT
match the Bitmap pixel postions}

if Length(aryPnts) > 1 then
  begin
  PaintBox1.Canvas.Pen.Mode := pmNot;
  Polyline(PaintBox1.Canvas.Handle, aryPnts[0], Length(aryPnts));
  PaintBox1.Canvas.Pen.Mode := pmCopy;
  end;
end;

procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
Drawing := True;
{I use Drawing to allow mouse move painting}
SetLength(aryPnts, 1);
{with any Mouse Down, the aryPnts is ReSet}
aryPnts[0].x := X;
aryPnts[0].y := Y;
PaintBox1.Canvas.Pen.Mode := pmNot;
{change PenMode}
end;

procedure TForm1.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
Drawing := False;
PaintBox1.Canvas.Pen.Mode := pmCopy;
{restore PenMode}
end;

procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
if Drawing then
  begin
  SetLength(aryPnts, Length(aryPnts)+1);
  {add members to aryPnts}
  aryPnts[High(aryPnts)].x := X;
  aryPnts[High(aryPnts)].y := Y;
{each mouse move adds a Point}
  PaintBox1.Canvas.MoveTo(aryPnts[High(aryPnts)-1].x, aryPnts[High(aryPnts)-1].y);
  PaintBox1.Canvas.LineTo(aryPnts[High(aryPnts)].x, aryPnts[High(aryPnts)].y);
{you do NOT need to paint the whole paintbox on a mouse move, just draw One line}
  end;
end;

procedure TForm1.sbut_ApplyHeadClick(Sender: TObject);
var
hRgn1: Integer;
begin
if (Length(aryPnts) < 3) or Not Assigned(HeadPic) then
  begin
  ShowMessage('Can NOT do a Head placement');
  Exit;
  end;
if (aryPnts[0].x <> aryPnts[High(aryPnts)].x) or
   (aryPnts[0].y <> aryPnts[High(aryPnts)].y) then
  begin
  SetLength(aryPnts, Length(aryPnts)+1);
  aryPnts[High(aryPnts)] := aryPnts[0];
  end;
hRgn1 := CreatePolygonRgn(aryPnts[0], Length(aryPnts), WINDING);
if hRgn1 = 0 then
  begin
  ShowMessage('Can NOT do a Region');
  Exit;
  end;

{Here is the code that accually limits the drawing of the headPic on the bodyPic
since I will move the HeadPic to match the head position of the bodyPic, I will need
to OffSet the region the same amount}
OffSetRgn(hRgn1, 96, 39);
SelectClipRgn(BodyPic.Canvas.Handle, hRgn1);
{select the region}
BodyPic.Canvas.Draw(96,39, HeadPic);
{when the headpic is drawn on the BodyPic, just the area in the region is drawn}
SelectClipRgn(BodyPic.Canvas.Handle, 0);
DeleteObject(hRgn1);
{be sure to Delete ALL system graphic object you create}
PaintBox1.Width := BodyPic.Width;
PaintBox1.Height := BodyPic.Height;
Application.Processmessages;
PaintBox1.Canvas.Draw(0,0, BodyPic);
{now you can see the Body Pic in the paint box with a New head}
end;

 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

hope this helps you out
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Fonts Typography

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.