paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2026-01-06 23:21:03 +01:00
Code Issues Packages Projects Releases Wiki Activity

fpvectorial: Starts adding support for converting 3d point arrays to height maps

Browse Source 
git-svn-id: trunk@35568 -
This commit is contained in:
sekelsenmat 2012-02-23 16:48:37 +00:00
parent a53a3ffb36
commit a9c8726408
3 changed files with 73 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
components/fpvectorial/examples/fpv3d_mainform.lfm
View File

@ -92,4 +92,13 @@ object formFPV3D: TformFPV3D
OnClick = buttonCutFileClick
TabOrder = 7
end
object btnConvert3DPointArrayToHeightMap: TButton
Left = 178
Height = 25
Top = 72
Width = 278
Caption = 'Convert 3D point array to height map'
OnClick = btnConvert3DPointArrayToHeightMapClick
TabOrder = 8
end
end

23
components/fpvectorial/examples/fpv3d_mainform.pas
View File

@ -14,6 +14,7 @@ type
TformFPV3D = class(TForm)
Button1: TButton;
btnConvert3DPointArrayToHeightMap: TButton;
buttonCutFile: TButton;
buttonRotZ: TButton;
buttonZoomIn: TButton;
@ -21,6 +22,7 @@ type
buttonZoomOut: TButton; buttonLoad: TButton;
editFileName: TFileNameEdit;
glControl: TOpenGLControl;
procedure btnConvert3DPointArrayToHeightMapClick(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure buttonCutFileClick(Sender: TObject);
procedure buttonLoadClick(Sender: TObject);
@ -142,6 +144,27 @@ begin
glControl.Invalidate;
end;
procedure TformFPV3D.btnConvert3DPointArrayToHeightMapClick(Sender: TObject);
var
lRasterImage: TvRasterImage;
lPage: TvVectorialPage;
lFile: TFileStream;
x, y: Integer;
begin
lRasterImage := TvRasterImage.Create;
lPage := VecDoc.GetPage(0);
lPage.AddEntity(lRasterImage);
lRasterImage.InitializeWithConvertionOf3DPointsToHeightMap(lPage, 1024, 1024);
lFile := TFileStream.Create('Terrain.raw', fmCreate);
for x := 0 to 1023 do
for y := 0 to 1023 do
lFile.WriteByte(Byte(lRasterImage.RasterImage.Colors[x, y].Red div $FF));
lFile.Free;
end;
procedure TformFPV3D.buttonCutFileClick(Sender: TObject);
var
lPage: TvVectorialPage;

42
components/fpvectorial/fpvectorial.pas
View File

@ -295,10 +295,14 @@ type
RasterImage should be filled with either a FPImage.TFPMemoryImage or with
a TLazIntfImage. The property RasterImage might be nil.
}
TvRasterImage = class(TvEntityWithPenAndBrush)
{ TvRasterImage }
TvRasterImage = class(TvEntity)
public
RasterImage: TFPCustomImage;
Top, Left, Width, Height: Double;
procedure InitializeWithConvertionOf3DPointsToHeightMap(APage: TvVectorialPage; AWidth, AHeight: Integer);
end;
{ TvPoint }
@ -560,6 +564,42 @@ begin
Result.Z := 0;
end;
{ TvRasterImage }
procedure TvRasterImage.InitializeWithConvertionOf3DPointsToHeightMap(APage: TvVectorialPage; AWidth, AHeight: Integer);
var
lEntity: TvEntity;
i: Integer;
lPos: TPoint;
lValue: TFPColor;
begin
// First setup the map and initialize it
if RasterImage <> nil then RasterImage.Free;
RasterImage := TFPMemoryImage.create(AWidth, AHeight);
// Now go through all points and attempt to fit them to our grid
for i := 0 to APage.GetEntitiesCount - 1 do
begin
lEntity := APage.GetEntity(i);
if lEntity is TvPoint then
begin
lPos.X := Round((lEntity.X - APage.MinX) * AWidth / (APage.MaxX - APage.MinX));
lPos.Y := Round((lEntity.Y - APage.MinY) * AHeight / (APage.MaxY - APage.MinY));
if lPos.X >= AWidth then lPos.X := AWidth-1;
if lPos.Y >= AHeight then lPos.Y := AHeight-1;
if lPos.X < 0 then lPos.X := 0;
if lPos.Y < 0 then lPos.Y := 0;
lValue.Red := Round((lEntity.Z - APage.MinZ) * 256 / (APage.MaxZ - APage.MinZ));
lValue.Green := lValue.Red;
lValue.Blue := lValue.Red;
//lValue.alpha:=;
RasterImage.Colors[lPos.X, lPos.Y] := lValue;
end;
end;
end;
constructor TvEntityWithPen.Create;
begin
inherited Create;