diff --git a/applications/fpvviewer/coreconrec.pas b/applications/fpvviewer/coreconrec.pas index 7d1b5acad..2f8221350 100644 --- a/applications/fpvviewer/coreconrec.pas +++ b/applications/fpvviewer/coreconrec.pas @@ -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) diff --git a/applications/fpvviewer/fpvv_mainform.lfm b/applications/fpvviewer/fpvv_mainform.lfm index 489e2752d..5e6b6230f 100644 --- a/applications/fpvviewer/fpvv_mainform.lfm +++ b/applications/fpvviewer/fpvv_mainform.lfm @@ -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 diff --git a/applications/fpvviewer/fpvv_mainform.pas b/applications/fpvviewer/fpvv_mainform.pas index 022782aec..2701bea56 100644 --- a/applications/fpvviewer/fpvv_mainform.pas +++ b/applications/fpvviewer/fpvv_mainform.pas @@ -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]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]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.