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

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);





LVL 4
PalamedesAsked:
Who is Participating?
 
mokuleConnect With a Mentor Commented:
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
 
mokuleCommented:
For this purpose You've got

SelectClipRgn function
0
 
PalamedesAuthor Commented:
Could you provide an example?
0
Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
mokuleCommented:
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
 
PalamedesAuthor Commented:
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
 
mokuleCommented:

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
 
PalamedesAuthor Commented:
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
 
mokuleCommented:
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
 
PalamedesAuthor Commented:
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
 
PalamedesAuthor Commented:
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;
  OriginalImage.Bitmap.LoadFromFile('c:\windows\DELLWP.BMP');
  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
 
PalamedesAuthor Commented:
Hrmm this may be a runtime issue.. Not sure.. Either way.. Thanks for your help..
0
 
mokuleCommented:
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;
//  OriginalImage.Bitmap.LoadFromFile('c:\windows\DELLWP.BMP');
  OriginalImage.Picture.Bitmap.LoadFromFile('c:\windows\Kawa.BMP');
  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
 
PalamedesAuthor Commented:
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
 
PalamedesAuthor Commented:
Basically what I need here, is the ability to click a given region and color that region a little.

0
 
mokuleCommented:
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
 
PalamedesAuthor Commented:
AH ha!  

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

Thanks again man.. I do appreciate it.
0
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.

All Courses

From novice to tech pro — start learning today.