fmainform.pas

都是关于Glscene的实例

   sl, sg : TStringList;
begin
   if ODTerrainPack.Execute then begin
      sl:=TStringList.Create;
      sl.LoadFromFile(ODTerrainPack.FileName);
      with sl do begin
         EDHTFName.Text:=Values['HTFName'];
         EDSizeX.Text:=Values['WorldSizeX'];
         EDSizeY.Text:=Values['WorldSizeY'];
         EDTileSize.Text:=Values['TileSize'];
         EDTileOverlap.Text:=Values['TileOverlap'];
         EDDefaultZ.Text:=Values['DefaultZ'];
         EDZFilter.Text:=Values['FilterZ'];
         EDDEMPath.Text:=Values['DEMPath'];
         sg:=TStringList.Create;
         sg.CommaText:=Values['DEMs'];
         StringGrid.RowCount:=sg.Count+1;
         for i:=0 to sg.Count-1 do
            StringGrid.Rows[i+1].CommaText:=sg[i];
         sg.Free;
      end;
      sl.Free;
      SDTerrainPack.FileName:=ODTerrainPack.FileName;
   end;
end;

procedure TMainForm.EDDEMPathChange(Sender: TObject);
var
   f : TSearchRec;
   r : Integer;
begin
   CBFile.Items.Clear;
   r:=FindFirst(EDDEMPath.Text+'\*.*', faAnyFile, f);
   while r=0 do begin
      if (f.Attr and faDirectory)=0 then
         CBFile.Items.Add(f.Name);
      r:=FindNext(f);
   end;
   FindClose(f);
end;

procedure TMainForm.EDDefaultZChange(Sender: TObject);
begin
   defaultZ:=StrToIntDef(EDDefaultZ.Text, 0);
   if EDZFilter.Text='' then
      filterZ:=defaultZ;
end;

procedure TMainForm.EDZFilterChange(Sender: TObject);
begin
   filterZ:=StrToIntDef(EDZFilter.Text, defaultZ);
end;

procedure TMainForm.Parse;
var
   i, p : Integer;
   row : TStrings;
begin
   Cleanup;
   SetLength(sources, StringGrid.RowCount-1);
   for i:=0 to High(sources) do begin
      row:=StringGrid.Rows[i+1];
      sources[i].fs:=TFileStream.Create(EDDEMPath.Text+'\'+row[0], fmOpenRead+fmShareDenyNone);
      p:=Pos(',', row[1]);
      sources[i].x:=StrToInt(Copy(row[1], 1, p-1));
      sources[i].y:=StrToInt(Copy(row[1], p+1, MaxInt));
      p:=Pos('x', row[2]);
      sources[i].w:=StrToInt(Copy(row[2], 1, p-1));
      sources[i].h:=StrToInt(Copy(row[2], p+1, MaxInt));
      if Pos('non-', row[3])>0 then
         sources[i].format:=1
      else if Pos('BT', row[3])>0 then
         sources[i].format:=2
      else if Pos('FP', row[3])>0 then
         sources[i].format:=4
      else if Pos('BMP', row[3])>0 then
         sources[i].format:=3
      else if Pos('unsigned', row[3])>0 then
         sources[i].format:=5
      else sources[i].format:=0;
   end;
end;

procedure TMainForm.Cleanup;
var
   i : Integer;
begin
   for i:=0 to High(sources) do
      sources[i].fs.Free;
   SetLength(sources, 0);
end;

procedure TMainForm.SrcExtract(src : PSrc; relX, relY, len : Integer; dest : PSmallInt);
var
   i, c : Integer;
   wd : Word;
   buf : array of Single;
   bmp : TBitmap;
begin
   with src^ do begin
      case format of
         0 : begin // 16bits Intel
            fs.Position:=(relX+relY*w)*2;
            fs.Read(dest^, len*2);
         end;
         1 : begin // 16bits non-Intel
            fs.Position:=(relX+relY*w)*2;
            fs.Read(dest^, len*2);
            for i:=0 to len-1 do begin
               wd:=PWord(Integer(dest)+i*2)^;
               PWord(Integer(dest)+i*2)^:=((wd and 255) shl 8)+(wd shr 8);
            end;
         end;
         2 : begin // VTP's BT single
            fs.Position:=(relX+relY*w)*4+256;
            SetLength(buf, len);
            fs.Read(buf[0], len*4);
            for i:=0 to len-1 do
               PSmallInt(Integer(dest)+i*2)^:=Round(buf[i]);
         end;
         3 : begin // windows BMP
            bmp:=TBitmap.Create;
            try
               fs.Position:=0;
               bmp.LoadFromStream(fs);
               for i:=0 to len-1 do begin
                  c:=bmp.Canvas.Pixels[relX+i, bmp.Height-relY-1];
                  PSmallInt(Integer(dest)+i*2)^:=(GetGValue(c)-128) shl 7;
               end;
            finally
               bmp.Free;
            end;
         end;
         4 : begin // 32bits FP Intel
            fs.Position:=(relX+relY*w)*4;
            SetLength(buf, len);
            fs.Read(buf[0], len*4);
            for i:=0 to len-1 do
               PSmallInt(Integer(dest)+i*2)^:=Round((buf[i]-0.5)*32000);
         end;
         5 : begin // 16bits unsigned Intel
            fs.Position:=(relX+relY*w)*2;
            fs.Read(dest^, len*2);
            for i:=0 to len-1 do begin
               wd:=PWord(Integer(dest)+i*2)^;
               PSmallInt(Integer(dest)+i*2)^:=Integer(wd)-32768;
            end;
         end;
      end;
   end;
end;

procedure TMainForm.WorldExtract(x, y, len : Integer; dest : PSmallInt);
var
   i, n, rx, ry : Integer;
   src : PSrc;
begin
   while len>0 do begin
      src:=nil;
      for i:=0 to High(sources) do begin
         if (sources[i].x<=x) and (sources[i].y<=y)
               and (x<sources[i].x+sources[i].w)
               and (y<sources[i].y+sources[i].h) then begin
            src:=@sources[i];
            Break;
         end;
      end;
      if Assigned(src) then begin
         rx:=x-src.x;
         ry:=y-src.y;
         n:=len;
         if rx+n>src.w then
            n:=src.w-rx;
         SrcExtract(src, rx, ry, n, dest);
         if filterZ<>defaultZ then begin
            for i:=0 to n-1 do
               if PSmallIntArray(dest)[i]=filterZ then
                  PSmallIntArray(dest)[i]:=defaultZ;
         end;
         Dec(len, n);
         Inc(dest, n);
         Inc(x, n);
      end else begin
         dest^:=defaultZ;
         Inc(dest);
         Dec(len);
         Inc(x);
      end;
   end;
end;

procedure TMainForm.ACProcessExecute(Sender: TObject);
var
   x, y, wx, wy, ts, tx, ty, i, j, overlap : Integer;
   n, maxN : Cardinal;
   htf : THeightTileFile;
   buf : array of SmallInt;
   f : file of Byte;
begin
   Screen.Cursor:=crHourGlass;

   wx:=StrToInt(EDSizeX.Text);
   wy:=StrToInt(EDSizeY.Text);
   ts:=StrToInt(EDTileSize.Text);
   overlap:=StrToInt(EDTileOverlap.Text);
   Parse;
   SetLength(buf, ts*ts);
   htf:=THeightTileFile.CreateNew(EDHTFName.Text, wx, wy, ts);
   htf.DefaultZ:=defaultZ;
   ProgressBar.Max:=1000;
   maxN:=Ceil(wx/ts)*Ceil(wy/ts);
   n:=0;
   ProgressBar.Position:=0;
   y:=0; while y<wy do begin
      ty:=wy-y;
      if ty>ts then ty:=ts;
      x:=0; while x<wx do begin
         tx:=wx-x;
         if tx>ts then tx:=ts;
         Inc(n);
         ProgressBar.Position:=(n*1000) div maxN;
         for i:=0 to ty-1 do begin
            WorldExtract(x, y+i, tx, @buf[i*ts]);
            if overlap>0 then begin
               for j:=tx to ts-1 do
                  buf[i*ts+j]:=buf[i*ts+tx-1];
            end else begin
               for j:=tx to ts-1 do
                  buf[i*ts+j]:=defaultZ;
            end;
         end;
         if overlap>0 then begin
            for i:=ty to ts-1 do for j:=0 to ts-1 do
               buf[i*ts+j]:=buf[(i-1)*ts+j];
         end else begin
            for i:=ty to ts-1 do for j:=0 to ts-1 do
               buf[i*ts+j]:=defaultZ;
         end;
         htf.CompressTile(x, y, ts, ts, @buf[0]);
         Inc(x, ts-overlap);
         if (n and 15)=0 then begin
            Application.ProcessMessages;
         end;
      end;
      Inc(y, ts-overlap);
   end;
   htf.Free;
   Cleanup;

   Screen.Cursor:=crDefault;

   AssignFile(f, EDHTFName.Text);
   Reset(f);
   i:=FileSize(f);
   CloseFile(f);

   ShowMessage( 'HTF file created.'#13#10#13#10
               +IntToStr(i)+' bytes in file'#13#10
               +'('+IntToStr(wx*wy*2)+' raw bytes)');

end;

procedure TMainForm.ACViewerExecute(Sender: TObject);
var
   viewer : TViewerForm;
begin
   viewer:=TViewerForm.Create(nil);
   try
      viewer.ShowModal;
   finally
      viewer.Free;
   end;
end;

end.