📄 fmainform.pas
字号:
{: Utility to pack on or many DEM sources into a single HTF.<p>
Note: this is a *basic* tool, error messages are unfriendly and there are
memory leaks if you do any, I know. So, don't do errors ;)
}
unit FMainForm;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, ValEdit, Grids, Menus, StdCtrls, ComCtrls, ToolWin, ExtCtrls,
ActnList, ImgList, HeightTileFile;
type
TSrc = record
fs : TFileStream;
x, y, w, h : Integer;
format : Integer;
end;
PSrc = ^TSrc;
TMainForm = class(TForm)
MainMenu: TMainMenu;
StringGrid: TStringGrid;
File1: TMenuItem;
ActionList: TActionList;
ImageList: TImageList;
ACOpen: TAction;
ACSave: TAction;
ACExit: TAction;
Open1: TMenuItem;
Save1: TMenuItem;
N1: TMenuItem;
Exit1: TMenuItem;
Panel1: TPanel;
Label1: TLabel;
Label2: TLabel;
EDHTFName: TEdit;
EDDEMPath: TEdit;
BUDEMPath: TButton;
Button3: TButton;
ToolBar: TToolBar;
ToolButton1: TToolButton;
ToolButton2: TToolButton;
ToolButton3: TToolButton;
DEMs1: TMenuItem;
ACNewDEM: TAction;
ACRemoveDEM: TAction;
ToolButton4: TToolButton;
ToolButton5: TToolButton;
AddDEMsource1: TMenuItem;
RemoveDEMsource1: TMenuItem;
SDHTF: TSaveDialog;
PopupMenu: TPopupMenu;
AddDEMsource2: TMenuItem;
RemoveDEMsource2: TMenuItem;
MIAbout: TMenuItem;
CBType: TComboBox;
CBFile: TComboBox;
Label3: TLabel;
EDSizeX: TEdit;
EDSizeY: TEdit;
Label4: TLabel;
Label5: TLabel;
EDDefaultZ: TEdit;
ODTerrainPack: TOpenDialog;
SDTerrainPack: TSaveDialog;
ToolButton6: TToolButton;
ACProcess: TAction;
ToolButton7: TToolButton;
N2: TMenuItem;
Process1: TMenuItem;
Panel2: TPanel;
ProgressBar: TProgressBar;
EDTileSize: TEdit;
Label6: TLabel;
ToolButton8: TToolButton;
ACViewer: TAction;
N3: TMenuItem;
HTFViewer1: TMenuItem;
ToolButton9: TToolButton;
ODPath: TOpenDialog;
Label7: TLabel;
EDTileOverlap: TEdit;
Label8: TLabel;
EDZFilter: TEdit;
procedure ACExitExecute(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure BUDEMPathClick(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure MIAboutClick(Sender: TObject);
procedure ActionListUpdate(Action: TBasicAction; var Handled: Boolean);
procedure ACNewDEMExecute(Sender: TObject);
procedure ACRemoveDEMExecute(Sender: TObject);
procedure StringGridSelectCell(Sender: TObject; ACol, ARow: Integer;
var CanSelect: Boolean);
procedure CBTypeChange(Sender: TObject);
procedure ACSaveExecute(Sender: TObject);
procedure ACOpenExecute(Sender: TObject);
procedure EDDEMPathChange(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure EDDefaultZChange(Sender: TObject);
procedure ACProcessExecute(Sender: TObject);
procedure ACViewerExecute(Sender: TObject);
procedure EDZFilterChange(Sender: TObject);
private
{ Private declarations }
sources : array of TSrc;
defaultZ : SmallInt;
filterZ : SmallInt;
procedure Parse;
procedure Cleanup;
procedure SrcExtract(src : PSrc; relX, relY, len : Integer; dest : PSmallInt);
procedure WorldExtract(x, y, len : Integer; dest : PSmallInt);
public
{ Public declarations }
end;
var
MainForm: TMainForm;
implementation
{$R *.dfm}
uses Math, FViewerForm;
procedure TMainForm.FormCreate(Sender: TObject);
var
i : Integer;
begin
with ActionList do
for i:=0 to ActionCount-1 do with TAction(Actions[i]) do
Hint:=Caption;
with StringGrid do begin
Cells[0, 0]:='File Name';
Cells[1, 0]:='World Offset';
Cells[2, 0]:='Size';
Cells[3, 0]:='Data type';
Row:=0;
end;
end;
procedure TMainForm.FormDestroy(Sender: TObject);
begin
Cleanup;
end;
procedure TMainForm.ACExitExecute(Sender: TObject);
begin
Close;
end;
procedure TMainForm.BUDEMPathClick(Sender: TObject);
begin
ODPath.InitialDir:=EDDEMPath.Text;
ODPath.FileName:=EDDEMPath.Text+'pick a dummy.file';
if ODPath.Execute then
EDDEMPath.Text:=ExtractFilePath(ODPath.FileName);
end;
procedure TMainForm.Button3Click(Sender: TObject);
begin
SDHTF.FileName:=EDHTFName.Text;
if SDHTF.Execute then
EDHTFName.Text:=SDHTF.FileName;
end;
procedure TMainForm.MIAboutClick(Sender: TObject);
begin
ShowMessage(Caption+#13#10#13#10
+'HTF Generation Utility'#13#10
+'Part of GLScene library.'#13#10#13#10
+'http://glscene.org');
end;
procedure TMainForm.ActionListUpdate(Action: TBasicAction;
var Handled: Boolean);
begin
ACRemoveDEM.Enabled:=(StringGrid.RowCount>2);
end;
procedure TMainForm.ACNewDEMExecute(Sender: TObject);
begin
StringGrid.RowCount:=StringGrid.RowCount+1;
end;
procedure TMainForm.ACRemoveDEMExecute(Sender: TObject);
var
i : Integer;
begin
with StringGrid do begin
i:=Row;
if i<RowCount-1 then begin
while i<RowCount-1 do begin
Rows[i]:=Rows[i+1];
Inc(i);
end;
end else Row:=i-1;
RowCount:=RowCount-1;
end;
end;
procedure TMainForm.StringGridSelectCell(Sender: TObject; ACol,
ARow: Integer; var CanSelect: Boolean);
procedure SetCB(const cb : TComboBox);
var
r : TRect;
i : Integer;
begin
r:=StringGrid.CellRect(ACol, ARow);
cb.Left:=r.Left+StringGrid.Left;
cb.Top:=r.Top+StringGrid.Top;
cb.Width:=r.Right+1-r.Left;
i:=cb.Items.IndexOf(StringGrid.Cells[ACol, ARow]);
if i>=0 then
cb.ItemIndex:=i
else cb.Text:=StringGrid.Cells[ACol, ARow];
if Visible then
cb.SetFocus;
end;
begin
if ARow>0 then begin
if ACol=0 then begin
CBFile.Visible:=True;
SetCB(CBFile);
end else CBFile.Visible:=False;
if ACol=3 then begin
CBType.Visible:=True;
SetCB(CBType);
end else CBType.Visible:=False;
CanSelect:=True;
end;
end;
procedure TMainForm.CBTypeChange(Sender: TObject);
begin
with StringGrid do
Cells[Col, Row]:=(Sender as TComboBox).Text;
end;
procedure TMainForm.ACSaveExecute(Sender: TObject);
var
i : Integer;
sl, sg : TStringList;
begin
if SDTerrainPack.Execute then begin
sl:=TStringList.Create;
with sl do begin
Values['HTFName']:=EDHTFName.Text;
Values['WorldSizeX']:=EDSizeX.Text;
Values['WorldSizeY']:=EDSizeY.Text;
Values['TileSize']:=EDTileSize.Text;
Values['TileOverlap']:=EDTileOverlap.Text;
Values['DefaultZ']:=EDDefaultZ.Text;
Values['FilterZ']:=EDZFilter.Text;
Values['DEMPath']:=EDDEMPath.Text;
sg:=TStringList.Create;
for i:=1 to StringGrid.RowCount-1 do
sg.Add(StringGrid.Rows[i].CommaText);
Values['DEMs']:=sg.CommaText;
sg.Free;
end;
sl.SaveToFile(SDTerrainPack.FileName);
sl.Free;
end;
end;
procedure TMainForm.ACOpenExecute(Sender: TObject);
var
i : Integer;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -