?
Solved

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

Posted on 2004-04-13
16
Medium Priority
?
446 Views
Last Modified: 2010-05-18
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
Comment
Question by:Palamedes
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 9
  • 7
16 Comments
 
LVL 17

Expert Comment

by:mokule
ID: 10818085
For this purpose You've got

SelectClipRgn function
0
 
LVL 4

Author Comment

by:Palamedes
ID: 10818135
Could you provide an example?
0
 
LVL 17

Accepted Solution

by:
mokule earned 500 total points
ID: 10818264
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
Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

 
LVL 17

Expert Comment

by:mokule
ID: 10818462
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

by:Palamedes
ID: 10819124
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

by:mokule
ID: 10821039

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

by:Palamedes
ID: 10825264
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

by:mokule
ID: 10825552
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

by:Palamedes
ID: 10825954
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

by:Palamedes
ID: 10835389
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
 
LVL 4

Author Comment

by:Palamedes
ID: 10835471
Hrmm this may be a runtime issue.. Not sure.. Either way.. Thanks for your help..
0
 
LVL 17

Expert Comment

by:mokule
ID: 10836364
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
 
LVL 4

Author Comment

by:Palamedes
ID: 10836737
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

by:Palamedes
ID: 10836803
Basically what I need here, is the ability to click a given region and color that region a little.

0
 
LVL 17

Expert Comment

by:mokule
ID: 10836969
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

by:Palamedes
ID: 10837065
AH ha!  

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

Thanks again man.. I do appreciate it.
0

Featured Post

[Webinar] Lessons on Recovering from Petya

Skyport is working hard to help customers recover from recent attacks, like the Petya worm. This work has brought to light some important lessons. New malware attacks like this can take down your entire environment. Learn from others mistakes on how to prevent Petya like worms.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Introduction I have seen many questions in this Delphi topic area where queries in threads are needed or suggested. I know bumped into a similar need. This article will address some of the concepts when dealing with a multithreaded delphi database…
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…
This course is ideal for IT System Administrators working with VMware vSphere and its associated products in their company infrastructure. This course teaches you how to install and maintain this virtualization technology to store data, prevent vuln…
We’ve all felt that sense of false security before—locking down external access to a database or component and feeling like we’ve done all we need to do to secure company data. But that feeling is fleeting. Attacks these days can happen in many w…
Suggested Courses

718 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question