⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 fmainform.pas

📁 都是关于Glscene的实例
💻 PAS
📖 第 1 页 / 共 2 页
字号:
{: 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 + -