fNavD.pas 2.0 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192
  1. unit fNavD;
  2. interface
  3. uses
  4. System.SysUtils,
  5. System.Classes,
  6. Vcl.Graphics,
  7. Vcl.Controls,
  8. Vcl.Forms,
  9. Vcl.Dialogs,
  10. GR32_Image,
  11. GR32,
  12. GR32_Layers,
  13. GLS.HeightTileFileHDS;
  14. type
  15. TNavForm = class(TForm)
  16. Image: TImage32;
  17. procedure ImageMouseDown(Sender: TObject; Button: TMouseButton;
  18. Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer);
  19. private
  20. FPickX, FPickY : Integer;
  21. public
  22. function Execute(htf : TGLHeightTileFile) : Boolean;
  23. property PickX : Integer read FPickX;
  24. property PickY : Integer read FPickY;
  25. end;
  26. var
  27. NavForm: TNavForm;
  28. implementation
  29. {$R *.dfm}
  30. uses
  31. fViewerD;
  32. function TNavForm.Execute(htf : TGLHeightTileFile) : Boolean;
  33. var
  34. i, x, y, w, s, wx, wy : Integer;
  35. begin
  36. // Computes scaling so that preview window isn't too small
  37. with htf do begin
  38. wx:=(SizeX+TileSize div 2) div TileSize;
  39. wy:=(SizeY+TileSize div 2) div TileSize;
  40. end;
  41. if wx<wy then
  42. w:=wy
  43. else w:=wx;
  44. s:=1;
  45. while w<256 do begin
  46. w:=w*2;
  47. s:=s*2;
  48. end;
  49. Image.Scale:=s;
  50. // Prepare the world tile map
  51. with Image.Bitmap do begin
  52. Width:=wx;
  53. Height:=wy;
  54. Clear(clGray32);
  55. for i:=0 to htf.TileCount-1 do with htf.Tiles[i]^ do begin
  56. x:=(left+(width div 2)) div htf.TileSize;
  57. y:=(top+(height div 2)) div htf.TileSize;
  58. PixelS[x, y]:=heightColor[average];
  59. end;
  60. end;
  61. // Couldn't get the form's AutoSize to work...
  62. Image.Width:=wx*s;
  63. Image.Height:=wy*s;
  64. Width:=Image.Width;
  65. Height:=Image.Height;
  66. // Show the Nav map
  67. Result:=(ShowModal=mrOk);
  68. // Convert back to world coordinates
  69. if Result then begin
  70. FPickX:=(FPickX*htf.TileSize) div s - htf.TileSize;
  71. FPickY:=(FPickY*htf.TileSize) div s - htf.TileSize;
  72. end;
  73. end;
  74. procedure TNavForm.ImageMouseDown(Sender: TObject; Button: TMouseButton;
  75. Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer);
  76. begin
  77. FPickX:=X;
  78. FPickY:=Y;
  79. ModalResult:=mrOk;
  80. end;
  81. end.