Recent

Author Topic: Layers of TImages, FrameRect not working  (Read 2615 times)

sapper

  • New Member
  • *
  • Posts: 35
Layers of TImages, FrameRect not working
« on: April 17, 2014, 03:10:15 am »
I have four TImages, all same size layered above each other.

The bottom one has a texture atlas loaded as the bitmap and is not transparent.

The top three are transparent with clBlack as the transparent colour.

In the top TImage's (ImageOverlay) MouseDown event I have the following code which is supposed to highlight the individual texture under the mouse pointer with a frame. The frame is to be drawn on the second from top TImage canvas (ImageHilite).

The code only works if I make that TImage not transparent which is no good since the texture atlas bitmap can no longer be seen.

I copied this code from a Delphi program.
I am using Windows 8.1 and CodeTyphon 4.80.

Code: [Select]
var
  wad:TWad;
...
procedure TForm1.ImageOverlayMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  i,index:Integer;
  br : TRect;
begin
    // Nothing to do, exit.
    if wad.numTextures = 0 then exit;

    // Left button only.
    if not ( Button = mbLeft ) then exit;

    // Scan the rectangles list to find the one that includes (x,y).
    index := -1;
    for i := 0 to wad.numTextures - 1 do
    begin
        if PtInRect( wad.SampleRect[i], Point( X, Y ) ) then
        begin index := i; break; end;
    end;

    // Found?
    if index = -1 then begin beep; exit; end;

    br := Rect( 0, 0, Form1.ImageHilite.Width, Form1.ImageHilite.Height );

    ImageHilite.Canvas.Brush.Style := bsSolid;
    ImageHilite.Canvas.Brush.Color := clBlack;
    ImageHilite.Canvas.FillRect( br ); //erases old framerect

    ImageHilite.Canvas.Brush.Color := clLime;
    ImageHilite.Canvas.FrameRect( wad.SampleRect[index] );

end;                     


engkin

  • Hero Member
  • *****
  • Posts: 3112
Re: Layers of TImages, FrameRect not working
« Reply #1 on: April 17, 2014, 06:41:24 am »
I am not sure why it does not work but I believe the mask image needs to be changed as well. For this particular usage you have a better alternative. You can use OnPaint event of ImageAtlas (or whatever you named it).

Code: [Select]
var
  wad:TWad;
  index:Integer;
...

procedure TForm1.ImageOverlayMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  i : Integer;
  br : TRect;
begin
    // Nothing to do, exit.
    if wad.numTextures = 0 then exit;

    // Left button only.
    if not ( Button = mbLeft ) then exit;

    // Scan the rectangles list to find the one that includes (x,y).
    index := -1;
    for i := 0 to wad.numTextures - 1 do
    begin
        if PtInRect( wad.SampleRect[i], Point( X, Y ) ) then
        begin index := i; break; end;
    end;

    // Found?
    if index = -1 then begin beep; exit; end;

    ImageAtlas.Invalidate;
end;

//Draw the frame
procedure TForm1.ImageAtlasPaint(Sender: TObject);
begin
    if index=-1 then exit;
    ImageAtlas.Canvas.Brush.Color := clLime;
    ImageAtlas.Canvas.FrameRect( wad.SampleRect[index] );
end;

sapper

  • New Member
  • *
  • Posts: 35
Re: Layers of TImages, FrameRect not working
« Reply #2 on: April 20, 2014, 02:54:53 am »
Thanks. Yours is a better way to do it.

 

TinyPortal © 2005-2018