Writing a StrPix-like program with Lazarus – 11

We need to add some global variables to the implementation section to store details of the currently selected texture.

implementation

uses TombRaiderWAD, strutils;

{$R *.lfm}

var
  streamWAD: TMemoryStream;
  WADCrawler: TWADCrawler;
  WADParser: TWADParser;
  moveableNames, staticNames: TStringList;
  pagecount: integer;
  currenttexturepage, currenttexture: integer; //NEW
  currenttexturerect: TRect; //NEW 

Initialise these variables in the FormCreate method as follows.

procedure TForm1.FormCreate(Sender: TObject);
var
  s : string;
begin
  s := Application.ExeName;
  s := ExtractFilePath(s);
  s := s + 'data' + DirectorySeparator + 'NGLEObjects.txt';
  if FileExists(s) then
  begin
    moveableNames := TStringList.Create;
    moveableNames.LoadFromFile(s);
    moveableNames.Text := AnsiProperCase(moveableNames.Text, StdWordDelims);
  end;
  s := ExtractFilePath(s);
  s := s + 'NGLEStatics.txt';
  if FileExists(s) then
  begin
    staticNames := TStringList.Create;
    staticNames.LoadFromFile(s);
    staticNames.Text := AnsiProperCase(staticNames.Text, StdWordDelims);
  end;
  currenttexturepage := -1; //NEW
  currenttexture := -1; //NEW
  currenttexturerect := Rect(0,0,0,0); //NEW
end;

Click Image1 on the form or in the Object Inspector to select it and then click on the Events tab in the Object Inspector.

We cannnot use the OnClick event since it doesn’t include information about the position of the mouse pointer.

Click OnMouseDown and then click on the 3 dot button to create the empty method.

IceBerg converts each texinfo to a TRect and stores them in a list in the variable wad.SampleRect so all we need to do is find which rectangle is under the mouse pointer and draw that rectangle.

The rectangles in wad.SampleRect use a Y position coordinate from the complete texture map height and not a page so we have to adjust the rectangle Y position to between 0 and 256.

Add code as follows. (Thanks to members of the Lazarus forum)

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  i, page, texture:integer;
  pagerect: TRect;
begin
  if wad.numTextures = 0 then Exit;
  if not (Button = mbLeft) then Exit;
  if ComboBox1.Items.Count = 0 then Exit;
  page := ComboBox1.ItemIndex;
  // Scan the rectangles list to find the one that includes (x,y).
  texture := -1;
  for i := 0 to wad.numTextures - 1 do
  begin
      if wad.textureTableData[i].page <> page then continue;
      pagerect.Left:=wad.SampleRect[i].Left;
      pagerect.Right:=wad.SampleRect[i].Right;
      pagerect.Top:=wad.SampleRect[i].Top - (page * 256);
      pagerect.Bottom:=pagerect.Top + wad.SampleRect[i].Bottom- wad.SampleRect[i].Top;
      if PtInRect(pagerect, Point(X, Y)) then
      begin
        texture := i;
        break;
      end;
  end;
  // Found?
  if texture = -1 then
    Beep
  else
  begin
    currenttexture := texture;
    currenttexturepage:= page;
    currenttexturerect := pagerect;
  end;
  Image1.Invalidate;
end;

The Invalidate method causes a control to repaint itself on screen so we can highlight the selected texture by adding code to Image1’s OnPaint method.

With Image1 selected, click OnPaint in the Events tab of the Object Inspector.

Click the 3 dot button that appears to create the empty method and add code as shown below.

procedure TForm1.Image1Paint(Sender: TObject);
begin
  if currenttexture < 0 then Exit;
  if currenttexturepage <> ComboBox1.ItemIndex then Exit;
  Image1.Canvas.Brush.Color:= clWhite;
  Image1.Canvas.FrameRect(currenttexturerect);
end;

Build and run the program and open a *.wad file.

When you press the left mouse button down with the mouse pointer over Image1, the first texture that contains the position of the pointer is surrounded with a white rectangle or the PC emits a beep sound if no texture is found.

If Image1 is “scrolled” the highlight rectangle is only visible on the selected texture’s page.





prev | next