paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

fpvviewer: Now the contour line drawer is working

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@2366 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
sekelsenmat 2012-03-29 08:50:37 +00:00
parent 3d8de9876b
commit ac4762265b
3 changed files with 97 additions and 56 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
applications/fpvviewer/coreconrec.pas
View File

@ -65,13 +65,13 @@ uses
//------------------------------------------------------------------------------
type
TMatrix = Array Of Array of Double;
TVector = Array Of Double;
TVectorL4D = Array [0..4] of Double;
TVectorL4I = Array [0..4] of Integer;
TCastArray = Array [0..2,0..2,0..2] of Integer;
TMatrix = array of array of Double;
TVector = array of Double;
TVectorL4D = array [0..4] of Double;
TVectorL4I = array [0..4] of Integer;
TCastArray = array [0..2,0..2,0..2] of Integer;
Procedure Conrec(D: TMatrix ; // 2D - Data field
procedure Conrec(D: TMatrix ; // 2D - Data field
ilb,iub, // west - east ilb lower bound
// iub upper bound
jlb,jub : Integer; // north - south jlb lower bound
@ -81,9 +81,15 @@ Procedure Conrec(D: TMatrix ; // 2D - Data field
nc: Integer; // nc number of cut levels
z : TVector); // values of cut levels
type
TContourLineDrawingProc = procedure(z,x1,y1,x2,y2: Double) of object;
var
ContourLineDrawingProc: TContourLineDrawingProc;
implementation
Procedure Conrec(D: TMatrix ; // 2D - Data field
procedure Conrec(D: TMatrix ; // 2D - Data field
ilb,iub, // west - east ilb lower bound
// iub upper bound
jlb,jub : Integer; // north - south jlb lower bound
@ -93,8 +99,8 @@ Procedure Conrec(D: TMatrix ; // 2D - Data field
nc: Integer; // nc number of cut levels
z : TVector); // values of cut levels
const
im : Array [0..3] of Integer = (0,1,1,0); // coord. cast array west - east
jm : Array [0..3] of Integer = (0,0,1,1); // coord. cast array north - south
im : array [0..3] of Integer = (0,1,1,0); // coord. cast array west - east
jm : array [0..3] of Integer = (0,0,1,1); // coord. cast array north - south
var
m1,m2,m3,deside:Integer;
dmin,dmax,x1,x2,y1,y2:Double;
@ -106,16 +112,16 @@ var
temp1,temp2:Double ;
r:Byte;
// ------- service xsec west east lin. interpol -------------------------------
Function xsec(p1,p2:Integer):Double;
// ------- service xsec west east lin. interpol -------------------------------
function xsec(p1,p2:Integer):Double;
Begin
result:=(h[p2]*xh[p1]-h[p1]*xh[p2])/(h[p2]-h[p1]);
result:=(h[p2]*xh[p1]-h[p1]*xh[p2])/(h[p2]-h[p1]);
End;
//------- service ysec north south lin interpol -------------------------------
Function ysec(p1,p2:Integer):Double;
//------- service ysec north south lin interpol -------------------------------
Function ysec(p1,p2:Integer):Double;
Begin
result := (h[p2]*yh[p1]-h[p1]*yh[p2])/(h[p2]-h[p1]);
result := (h[p2]*yh[p1]-h[p1]*yh[p2])/(h[p2]-h[p1]);
End;
begin
@ -135,8 +141,10 @@ begin
// set line counter
lcnt:=0;
//-----------------------------------------------------------------------------
For j:=jub-1 DownTo jlb Do Begin // over all north - south and +For j
For i:=ilb To iub-1 Do Begin // east - west coordinates of datafield +For i
For j:=jub-1 DownTo jlb Do // over all north - south and +For j
begin
For i:=ilb To iub-1 Do // east - west coordinates of datafield +For i
begin
// set casting bounds from array
temp1 := min(D[i , j],D[i ,j+1]);
temp2 := min(D[i+1, j],D[i+1,j+1]);
@ -199,7 +207,8 @@ begin
m1 := m; m2 := 0;
If NOT(m=4) Then m3 := m+1 Else m3 :=1;
deside := casttab[sh[m1]+1 ,sh[m2]+1, sh[m3]+1];
If NOT(deside=0) Then Begin // ask is there a desition available -------- +If If NOT(deside=0)
if not(deside=0) then // ask is there a desition available -------- +If If NOT(deside=0)
begin
Case deside Of // ------- determin the by desided cast cuts ------------ +Case deside;
1: Begin x1:=xh[m1]; y1:=yh[m1]; x2:=xh[m2]; y2:=yh[m2]; End;
2: Begin x1:=xh[m2]; y1:=yh[m2]; x2:=xh[m3]; y2:=yh[m3]; End;
@ -225,7 +234,7 @@ begin
// Writeln(Format('%2.2f %2.2f %2.2f %2.2f %2.2f',
// [z[k],x1,y1,x2,y2]));
//DrawingProc(z[k],x1,y1,x2,y2);
ContourLineDrawingProc(z[k],x1,y1,x2,y2);
// -------------------------------------------------------------------
end; // ----------------------------------------------------------------- -If Not(deside=0)

8
applications/fpvviewer/fpvv_mainform.lfm
View File

@ -11,7 +11,7 @@ object frmFPVViewer: TfrmFPVViewer
LCLVersion = '0.9.31'
object editFileName: TFileNameEdit
Left = 8
Height = 22
Height = 21
Top = 8
Width = 304
DialogOptions = []
@ -33,7 +33,7 @@ object frmFPVViewer: TfrmFPVViewer
end
object spinScale: TFloatSpinEdit
Left = 72
Height = 16
Height = 21
Top = 72
Width = 168
DecimalPlaces = 6
@ -46,9 +46,9 @@ object frmFPVViewer: TfrmFPVViewer
end
object Label1: TLabel
Left = 8
Height = 17
Height = 14
Top = 79
Width = 56
Width = 45
Caption = 'Scale by:'
ParentColor = False
end

98
applications/fpvviewer/fpvv_mainform.pas
View File

@ -35,7 +35,7 @@ type
procedure FormDestroy(Sender: TObject);
procedure spinScaleChange(Sender: TObject);
private
{ private declarations }
procedure MyContourLineDrawingProc(z,x1,y1,x2,y2: Double);
public
{ public declarations }
Drawer: TFPVVDrawer;
@ -109,8 +109,8 @@ end;
procedure TfrmFPVViewer.btnContourLinesClick(Sender: TObject);
const
dimx = 100; // dimension west - east
dimy = 100; // dimenstion north west
dimx = 1024; // dimension west - east
dimy = 1024; // dimenstion north west
dimh = 10; // dimension for contour levels
var
Mat:TMatrix; // 2D - Datafield
@ -120,45 +120,70 @@ var
i,j:Integer; // adress indexes
x,y:Double; // coord. values
mi,ma:Double; // for minimum & maximum
Vec: TvVectorialDocument;
lPage: TvVectorialPage;
lRasterImage: TvRasterImage;
begin
setlength(scx,dimx); // create dynamicly the vectors and datafield
// Drawing size setting and initialization
Drawer.Drawing.Width := Drawer.Width;
Drawer.Drawing.Height := Drawer.Height;
Drawer.Drawing.Canvas.Brush.Color := clWhite;
Drawer.Drawing.Canvas.Brush.Style := bsSolid;
Drawer.Drawing.Canvas.FillRect(0, 0, Drawer.Drawing.Width, Drawer.Drawing.Height);
Vec := TvVectorialDocument.Create;
Vec.ReadFromFile(editFileName.FileName);
lPage := Vec.GetPage(0);
lRasterImage := TvRasterImage(lPage.GetEntity(0));
// create dynamicaly the vectors and datafield
setlength(scx,dimx);
setlength(scy,dimy);
setlength(hgt,dimh);
setlength(mat,dimx);
For i:=0 to dimx-1 Do Setlength(mat[i],dimy);
for i:=0 to dimx-1 do Setlength(mat[i],dimy);
try
for i:=0 to dimx-1 do scx[i]:= i * 10; // set scaling vector west - east
for i:=0 to dimy-1 do scy[i]:= i * 10; // set scaling vector north - south
For i:=0 to dimx-1 Do scx[i]:= i * 10; // set scaling vector west - east
For i:=0 to dimy-1 Do scy[i]:= i * 10; // set scaling vector north - south
for i:=0 to dimx-1 do // ----------------------------------- set 2d data field
for j:=0 to dimy-1 do
begin
x:=i-dimx/2;
y:=j-dimy/2;
mat[i,j]:= Round(lRasterImage.RasterImage.Colors[i, j].red * 10 / $FFFF);
{ (sin(x/dimx*4*pi) * cos(y/dimy*4*pi)) +
(sin(x/dimx*2*pi) * cos(y/dimy*2*pi)) +
(sin(x/dimx*1*pi) * cos(y/dimy*1*pi)) +
(sin(x/dimx*0.5*pi) * cos(y/dimy*0.5*pi))+
(sin(x/dimx*0.25*pi) * cos(y/dimy*0.25*pi));}
end; // -----------------------------------------------------------------------
For i:=0 to dimx-1 Do // ----------------------------------- set 2d data field
For j:=0 to dimy-1 Do Begin
x:=i-dimx/2;
y:=j-dimy/2;
mat[i,j]:= (sin(x/dimx*4*pi) * cos(y/dimy*4*pi)) +
(sin(x/dimx*2*pi) * cos(y/dimy*2*pi)) +
(sin(x/dimx*1*pi) * cos(y/dimy*1*pi)) +
(sin(x/dimx*0.5*pi) * cos(y/dimy*0.5*pi))+
(sin(x/dimx*0.25*pi) * cos(y/dimy*0.25*pi));
end; // -----------------------------------------------------------------------
mi:=1e16; // ------------ Set the minimunm and maximum fof the data field
ma:=-1e16;
for i:=0 to dimx-1 Do
for j:=0 to dimy-1 do
begin
if mat[i,j]<mi then mi:=mat[i,j];
if mat[i,j]>ma then ma:=mat[i,j];
end; //----------------------------------------------------------------
mi:=1e16; // ------------ Set the minimunm and maximum fof the data field
ma:=-1e16;
For i:=0 to dimx-1 Do
For j:=0 to dimy-1 do
begin
if mat[i,j]<mi then mi:=mat[i,j];
if mat[i,j]>ma then ma:=mat[i,j];
End; //----------------------------------------------------------------
For i:=0 to dimh-1 Do hgt[i]:=mi+i*(ma-mi)/(dimh-1); // ----- create cut levels
For i:=0 to dimh-1 Do hgt[i]:=mi+i*(ma-mi)/(dimh-1); // ----- create cut levels
conrec(mat,0,dimx-1,0,dimy-1,scx,scy,dimh,hgt); // call the contour algorithm*)
ContourLineDrawingProc := @MyContourLineDrawingProc;
// call the contour algorithm
conrec(mat,0,dimx-1,0,dimy-1,scx,scy,dimh,hgt);
finally
// Finalization of allocated memory
setlength(scx, 0);
setlength(scy, 0);
setlength(hgt, 0);
For i:=0 to dimx-1 Do Setlength(mat[i], 0);
setlength(mat, 0);
Vec.Free;
end;
// Finalization of allocated memory
setlength(scx, 0);
setlength(scy, 0);
setlength(hgt, 0);
For i:=0 to dimx-1 Do Setlength(mat[i], 0);
setlength(mat, 0);
Drawer.Invalidate;
end;
procedure TfrmFPVViewer.btnViewDXFTokensClick(Sender: TObject);
@ -256,5 +281,12 @@ begin
else spinScale.Increment := 1;
end;
procedure TfrmFPVViewer.MyContourLineDrawingProc(z, x1, y1, x2, y2: Double);
begin
Drawer.Drawing.Canvas.Pen.Style := psSolid;
Drawer.Drawing.Canvas.Pen.Color := clBlack;
Drawer.Drawing.Canvas.Line(Round(x1 / 20), Round(y1 / 20), Round(x2 / 20), Round(y2 / 20));
end;
end.