Solved

# Copying a Region of one TPicture to the same Region of another TPicture

Posted on 2004-04-13
436 Views
Whats the best way to do this?  Shouldn't I be able to do something like below?  (Pseudocode.. not tested..)

aaPolyPoints : TPoints;
aaPolyPoint  : [i:integer]: TRealPoint;
aaRegion : hRGN;

aaRegion := CreatePolygonRgn(aaPolyPoints, 4, winding); // sort of assuming only 4 points here.. but this is for testing purposes

for K := 0 to OriginalPicture.bitmap.width do begin
for L := 0 to OriginalPicture.bitmap.height do begin
if PtInRegion(aaRegion, K, L) then begin
NewPicture.bitmap.canvas.pixels[K,L] := OriginalPicture.Bitmap.Canvas.Pixels[K,L];
end;
end;
end;

I would want to be able to color the pixels too so I would end up doing something liek this too;
NewPicture.bitmap.canvas.pixels[K,L] := (OriginalPicture.Bitmap.Canvas.Pixels[K,L] and \$00AAAAAA);

0
Question by:Palamedes
• 9
• 7

LVL 17

Expert Comment

For this purpose You've got

SelectClipRgn function
0

LVL 4

Author Comment

Could you provide an example?
0

LVL 17

Accepted Solution

mokule earned 125 total points
It is without coloring.

var
pt: array[0..3] of TPoint;
begin
pt[0].x := 40;
pt[0].y := 30;
pt[1].x := 80;
pt[1].y := 10;
pt[2].x := 120;
pt[2].y := 30;
pt[3].x := 80;
pt[3].y := 50;
SelectClipRgn(Image1.Picture.Bitmap.Canvas.Handle,
CreatePolygonRgn(pt,4,ALTERNATE));
Image1.Picture.Bitmap.Canvas.Draw(0,0,Image2.Picture.Bitmap);
0

LVL 17

Expert Comment

To achieve coloring effects You can use some CopyMode

SelectClipRgn(Image1.Picture.Bitmap.Canvas.Handle,
CreatePolygonRgn(pt,4,ALTERNATE));
Image1.Picture.Bitmap.Canvas.CopyMode := cmMergePaint;
Image1.Picture.Bitmap.Canvas.Draw(0,0,Image2.Picture.Bitmap);
0

LVL 4

Author Comment

Mokule, I appreciate your help in this matter..

Okay well I tried this and it didn't work....Nothing was copied to Image2...

unit Unit1;

interface

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

type
TForm1 = class(TForm)
Image1: TImage;
Image2: TImage;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{\$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
var
PT : array [0..3] of TPoint;
begin
PT[0].x := 40;
PT[0].y := 30;
PT[1].x := 80;
PT[1].y := 10;
PT[2].x := 120;
PT[2].y := 30;
PT[3].x := 80;
PT[3].y := 50;

SelectClipRgn(Image1.Picture.Bitmap.Canvas.Handle,
CreatePolygonRgn(PT,4,ALTERNATE));

Image1.Picture.Bitmap.Canvas.Draw(0,0,Image2.Picture.Bitmap);

end;

end.
0

LVL 17

Expert Comment

To make this working You must have two Images on a Form with their Pictures (as bitmaps) set.

It is copied from Image2 to Image1.

The bitmaps You set at design time must be big enough so the defined region is within bitmaps.
0

LVL 4

Author Comment

Right,

I had two large TImage components on the form, Image 1 had an image loaded at design time, but Image 2 didn't.. Is that my problem?  (i'm at work so I can't test it.)

0

LVL 17

Expert Comment

Yes.
This example requires both bitmaps to be loaded.
Especially that it is bitmap from image2 copied to image1.
It is possible to create this bitmaps at run time, but it was easier and faster to show the rule.
0

LVL 4

Author Comment

Oh I see.. Yeah I'm going to need to do this all at run time..

What I have is an Image, with various "Hot spots" mapped out on it.. I want to create some mouse overs at run time that are colored based on some stuff the user enters..  So the second image wont have anything in it until runtime..

Let me play with your code a bit.
0

LVL 4

Author Comment

Mokule,

I realize you're working your butt off for these 125 points.. heh but I do very much appreciate it.. And you of course will get those points, so far you have answered all my questions perfectly..

One more though..  Using your bit from above, I'm trying to create the second image dynamically.. thusly;

procedure TForm1.FormCreate(Sender: TObject);
var
K,L : integer;
PT : array [0..3] of TPoint;
begin
PT[0].x := 40;
PT[0].y := 30;
PT[1].x := 80;
PT[1].y := 10;
PT[2].x := 120;
PT[2].y := 30;
PT[3].x := 80;
PT[3].y := 50;

OriginalImage := TPicture.Create;
InverseImage := TPicture.Create;

for K := 0 to OriginalImage.bitmap.width do begin
for L := 0 to OriginalImage.bitmap.height do begin
if PtInRegion(CreatePolygonRgn(PT,4,WINDING), K, L) then begin
InverseImage.bitmap.canvas.pixels[K,L] := (OriginalImage.Bitmap.Canvas.Pixels[K,L] and \$00FF000);
end;
end;
end;

//  InverseImage.Bitmap.LoadFromFile('c:\windows\DELLWPI.BMP');    // As opposed to doing this..
end;

Yet this gives me an error : "Canvas does not allow drawing"..  ANy ideas?
0

LVL 4

Author Comment

Hrmm this may be a runtime issue.. Not sure.. Either way.. Thanks for your help..
0

LVL 17

Expert Comment

There were some bugs in Your code

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, extCtrls;

type
TForm1 = class(TForm)
Button2: TButton;
procedure FormCreate(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
OriginalImage: TImage;
InverseImage: TImage;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{\$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var
bmp: TBitmap;
begin
OriginalImage := TImage.Create(Self);
OriginalImage.Parent := Form1;
InverseImage := TImage.Create(Self);

// after creataing image You must Create also bitmap

InverseImage.Parent := Form1;
InverseImage.Left := OriginalImage.Picture.bitmap.width;
bmp := TBitmap.Create;
bmp.Width := OriginalImage.Picture.bitmap.width;
bmp.height := OriginalImage.Picture.bitmap.height;
InverseImage.Picture.Bitmap.Assign(bmp);
end;

procedure TForm1.Button2Click(Sender: TObject);
var
K,L : integer;
PT : array [0..3] of TPoint;
hrg: HRGN;
begin
PT[0].x := 40;
PT[0].y := 30;
PT[1].x := 80;
PT[1].y := 10;
PT[2].x := 120;
PT[2].y := 30;
PT[3].x := 80;
PT[3].y := 50;

// You created polygon many many times, whilst it should be create only once
hrg := CreatePolygonRgn(PT,4,WINDING);

// this commented code does the same as Your but a lot faster
{
SelectClipRgn(InverseImage.Picture.bitmap.canvas.Handle, hrg);
InverseImage.Picture.bitmap.canvas.Brush.Color := \$00FF000;
InverseImage.Picture.bitmap.canvas.Rectangle(0,0,InverseImage.Picture.bitmap.width,InverseImage.Picture.bitmap.height);
InverseImage.Picture.Bitmap.Canvas.CopyMode := cmMergeCopy; // same as Your AND
InverseImage.Picture.Bitmap.Canvas.Draw(0,0,OriginalImage.Picture.Bitmap);
}

for K := 0 to OriginalImage.Picture.bitmap.width do begin
for L := 0 to OriginalImage.Picture.bitmap.height do begin
if PtInRegion(hrg, K, L) then begin
InverseImage.Picture.bitmap.canvas.pixels[K,L] := (OriginalImage.Picture.Bitmap.Canvas.Pixels[K,L] and \$00FF000);
end;
end;
end;

// You should delete region when You no more need it
DeleteObject(hrg);
end;

end.
0

LVL 4

Author Comment

Your faster mode is.. by far.. WAY faster.. hehe  but it doesn't work exactly the same way my pixel version works..

Or atleast for now it doesn't appear to.. I think the problem is in the copy mode.. Its not coloring the picture at all at this point.. I'm getting a straight one for one copy..

I have a procedure as follows;

procedure TForm1.ColorSegment(S:hRGN;C:TColor);
//var
//   K, L : integer;
//   P : TColor;
begin

// OLD SLOW COLOR METHOD
{
for K := 0 to mapData.OriginalPicture.Width do begin
for L := 0 to mapData.OriginalPicture.Height do begin
if PtInRegion(S, K, L) then begin
P := mapData.OriginalPicture.Bitmap.Canvas.Pixels[K,L];
mainMap.Canvas.Pixels[K,L] := (P and C);
end;
end;
end;
}

with mainMap.Picture.Bitmap.Canvas do begin
SelectClipRgn(Handle, S);
Color := \$00FF0000;
Rectangle(0,0,Width,Height);
CopyMode := cmMergeCopy;
Draw (0,0,OriginalPicture.Picture.Bitmap);
end;

deleteObject(S);
end;

But its a one for one copy of OriginalPicture.. No change at all.. Thoughts?
0

LVL 4

Author Comment

Basically what I need here, is the ability to click a given region and color that region a little.

0

LVL 17

Expert Comment

hehe hehe

This is why I don't like with instruction. You've ve made error and don't see it.

with mainMap.Picture.Bitmap.Canvas do begin
SelectClipRgn(Handle, S);
{hehe}BRUSH.Color := \$00FF0000;
Rectangle(0,0,Width,Height);
CopyMode := cmMergeCopy;
Draw (0,0,OriginalPicture.Picture.Bitmap);
end;
0

LVL 4

Author Comment

AH ha!

It was an operator error.. (Of course.. hehe)

Thanks again man.. I do appreciate it.
0

## Featured Post

### Suggested Solutions

Introduction The parallel port is a very commonly known port, it was widely used to connect a printer to the PC, if you look at the back of your computer, for those who don't have newer computers, there will be a port with 25 pins and a small print…
In my programming career I have only very rarely run into situations where operator overloading would be of any use in my work.  Normally those situations involved math with either overly large numbers (hundreds of thousands of digits or accuracy re…
Access reports are powerful and flexible. Learn how to create a query and then a grouped report using the wizard. Modify the report design after the wizard is done to make it look better. There will be another video to explain how to put the final p…
This demo shows you how to set up the containerized NetScaler CPX with NetScaler Management and Analytics System in a non-routable Mesos/Marathon environment for use with Micro-Services applications.