How-to-convert-a-Grids-Surfer-to-a-Grids-Arcview


            Title: How to convert a Grid's Surfer to a Grid's Arcview
Question: This code is useful to load a raster Grd file from surfer to ArcView when you want to interpolate data by using Sufer and then loading the grid by using Raster Arcview.
Answer:
This component has several procedures which you can load a Grid of Surfer, visualize the Grid and Save the Grid in a ArcView Format. Then you can load the Grid in Arcview by using a Raster option!
This is the code of the component:
unit MapGrid;
interface
uses Messages, Windows, SysUtils, Classes, Controls, Forms, Menus, Graphics,
 StdCtrls, ExtCtrls, Dialogs, ScaleColor;
 
type
 TMapGrid = class(TGraphicControl)
 private
 { Private declarations }
 FPicture: TPicture;
 FStretch: Boolean;
 FTransparent: Boolean;
 FCenter: Boolean;
 FDrawing: Boolean;
 function CargarArchivo(Ruta: string; TipodeGrilla: byte): Boolean;
 function GetCanvas: TCanvas;
 procedure FWRuta(GridPath: string);
 procedure LimpiarCeldas;
 procedure AutoColor;
 procedure Pintar(Dato: string; i,j: longword);
 procedure PictureChanged(Sender: TObject);
 procedure SetCenter(Value: Boolean);
 procedure SetStretch(Value: Boolean);
 procedure SetTransparent(Value: Boolean);
 property Canvas: TCanvas read GetCanvas;
 
 protected
 { Protected declarations }
 FAutoAjuste: Boolean;
 FRuta: string;
 FColorMin,FColorMax,FColorNoData: TColor;
 FIntervalos,FColores: TStrings;
 FNIntervalos: byte;
 FNoData: string;
 FDib: boolean;
 FEncabezado: string;
 Fnx,Fny: longword;
 FXmin,FYmin,FZmin: string;
 FXmax,FYmax,FZmax: string;
 FZoom: SmallInt;
 FCellSize: string;
 FCellSizeX: string;
 FCellSizeY: string;
 FGridType: byte;
 FActiveEscala: TScaleColor;
 function CargarGrilladeSurfer(Ruta: string): Boolean;
 function CargarGrilladeArcView(Ruta: string): Boolean;
 function CanAutoSize(var NewWidth, NewHeight: Integer): Boolean; override;
 function DestRect: TRect;
 function DoPaletteChange: Boolean;
 procedure Paint; override;
 procedure BusqueEscala(Control: TScaleColor);
 public
 Datos,Escala: array of array of string;
 constructor Create(AOwner: TComponent); override;
 destructor Destroy; override;
 function GuardarGrilladeSurfer(Ruta: string): boolean;
 function GuardarGrilladeArcView(Ruta: string): boolean;
 function GuardarGrillaXYZ(Ruta: string): boolean;
 function Coordenadas(Col,Row: longword): string;
 function GetToken(LeeCadena: Ansistring; Sep: char; Num: longword): string;
 function Info(Const X,Y: longword): string;
 procedure Inicializar;
 procedure Repintar(Const W,H: integer);
 property Colores: TStrings Read FColores Write FColores default nil;
 published
 property ActiveEscala: TScaleColor Read FActiveEscala Write BusqueEscala default nil;
 property Dibujar: boolean Read FDib Write FDib;
 property Encabezado: string Read FEncabezado Write FEncabezado;
 property Nx: longword read Fnx write Fnx;
 property Ny: longword read Fny write Fny;
 property Xmin: string Read FXmin Write FXmin;
 property Ymin: string Read FYmin Write FYmin;
 property Xmax: string Read FXmax Write FXmax;
 property Ymax: string Read FYmax Write FYmax;
 property Zmin: string Read FZmin Write FZmin;
 property Zmax: string Read FZmax Write FZmax;
 property Zoom: SmallInt Read FZoom Write FZoom;
 property ColorMinimo: TColor read FColorMin write FColorMin;
 property ColorMaximo: TColor read FColorMax write FColorMax;
 property ColorNoDato: TColor read FColorNoData write FColorNoData;
 property CellSize: string Read FCellSize Write FCellSize;
 property CellSizeX: string Read FCellSizeX Write FCellSizeX;
 property CellSizeY: string Read FCellSizeY Write FCellSizeY;
 property NoDataValue: string Read FNoData Write FNoData;
 property Ruta: string Read FRuta Write FWRuta;
 property Intervalos: TStrings Read FIntervalos Write FIntervalos default nil;
 property GridType: byte Read FGridType Write FGridType;
 property Nintervalos: byte read FNIntervalos write FNIntervalos default 10;
 property Align;
 property Anchors;
 property AutoSize;
 property Center: Boolean read FCenter write SetCenter default False;
 property Constraints;
 property Enabled;
 property ParentShowHint;
 property PopupMenu;
 property ShowHint;
 property Stretch: Boolean read FStretch write SetStretch default True;
 property Transparent: Boolean read FTransparent write SetTransparent default False;
 property Visible;
 property OnClick;
 property OnContextPopup;
 property OnDblClick;
 property OnMouseDown;
 property OnMouseMove;
 property OnMouseUp;
 end;
 procedure Register;
implementation
uses consts;
procedure Register;
begin
 RegisterComponents('MapGrid', [TMapGrid]);
end;
constructor TMapGrid.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);
 Intervalos:=TStringList.Create;
 Colores:=TStringList.Create;
 Nintervalos:=10;
 NoDataValue:='1.70141E+038';
 ColorMinimo:=clBlue;
 ColorMaximo:=clRed;
 ColorNoDato:=clWhite;
 ControlStyle:=ControlStyle + [csReplicatable];
 Dibujar:= True;
 FPicture:=TPicture.Create;
 FPicture.OnChange:=PictureChanged;
 Height:=105;
 Width:=105;
 Zoom:=0;
 Stretch:=True;
end;
destructor TMapGrid.Destroy;
begin
 FPicture.Free;
 FIntervalos:=nil;
 FColores:=nil;
 inherited Destroy;
end;
procedure TMapGrid.BusqueEscala(Control: TScaleColor);
begin
 if FActiveEscala Control then
 if not (Control = nil) then// and (GetParentForm(Control) = TScaleColorGph) and ((csLoading in ComponentState) then
 begin
 FActiveEscala:=Control;
 FActiveEscala.Importar(Self);
 end
 else
 FActiveEscala:=nil;
end;
function TMapGrid.DestRect: TRect;
begin
 if Stretch then
 Result := ClientRect
 else if Center then
 Result := Bounds((Width - FPicture.Width) div 2, (Height - FPicture.Height) div 2,
 FPicture.Width, FPicture.Height)
 else
 Result := Rect(0, 0, FPicture.Width, FPicture.Height);
end;
procedure TMapGrid.Paint;
var
 Save: Boolean;
begin
 if csDesigning in ComponentState then
 with inherited Canvas do
 begin
 Pen.Style := psDash;
 Brush.Style := bsClear;
 Rectangle(0, 0, Width, Height);
 end;
 Save := FDrawing;
 FDrawing := True;
 try
 with inherited Canvas do
 StretchDraw(DestRect, FPicture.Graphic);
 finally
 FDrawing := Save;
 end;
end;
function TMapGrid.DoPaletteChange: Boolean;
var
 ParentForm: TCustomForm;
 Tmp: TGraphic;
begin
 Result:= False;
 Tmp:= FPicture.Graphic;
 if Visible and (not (csLoading in ComponentState)) and (Tmp nil) and
 (Tmp.PaletteModified) then
 begin
 if (Tmp.Palette = 0) then
 Tmp.PaletteModified := False
 else
 begin
 ParentForm := GetParentForm(Self);
 if Assigned(ParentForm) and ParentForm.Active and Parentform.HandleAllocated then
 begin
 if FDrawing then
 ParentForm.Perform(wm_QueryNewPalette, 0, 0)
 else
 PostMessage(ParentForm.Handle, wm_QueryNewPalette, 0, 0);
 Result := True;
 Tmp.PaletteModified := False;
 end;
 end;
 end;
end;
function TMapGrid.GetCanvas: TCanvas;
var
 Bitmap: TBitmap;
begin
 if FPicture.Graphic = nil then
 begin
 Bitmap := TBitmap.Create;
 try
 Bitmap.Width := Width;
 Bitmap.Height := Height;
 FPicture.Graphic := Bitmap;
 finally
 Bitmap.Free;
 end;
 end;
 if FPicture.Graphic is TBitmap then
 Result := TBitmap(FPicture.Graphic).Canvas
 else
 raise EInvalidOperation.Create(SImageCanvasNeedsBitmap);
end;
procedure TMapGrid.SetCenter(Value: Boolean);
begin
 if FCenter Value then
 begin
 FCenter := Value;
 PictureChanged(Self);
 end;
end;
procedure TMapGrid.SetStretch(Value: Boolean);
begin
 if Value FStretch then
 begin
 FStretch := Value;
 PictureChanged(Self);
 end;
end;
procedure TMapGrid.SetTransparent(Value: Boolean);
begin
 if Value FTransparent then
 begin
 FTransparent := Value;
 PictureChanged(Self);
 end;
end;
procedure TMapGrid.PictureChanged(Sender: TObject);
var
 G: TGraphic;
begin
 if AutoSize and (FPicture.Width 0) and (FPicture.Height 0) then
 SetBounds(Left, Top, FPicture.Width, FPicture.Height);
 G:= FPicture.Graphic;
 if G nil then
 begin
 if not ((G is TMetaFile) or (G is TIcon)) then
 G.Transparent := FTransparent;
 if (not G.Transparent) and (Stretch or (G.Width = Width)
 and (G.Height = Height)) then
 ControlStyle := ControlStyle + [csOpaque]
 else
 ControlStyle := ControlStyle - [csOpaque];
 if DoPaletteChange and FDrawing then Update;
 end
 else ControlStyle := ControlStyle - [csOpaque];
 if not FDrawing then Invalidate;
end;
function TMapGrid.CanAutoSize(var NewWidth, NewHeight: Integer): Boolean;
begin
 Result := True;
 if not (csDesigning in ComponentState) or (FPicture.Width 0) and
 (FPicture.Height 0) then
 begin
 if Align in [alNone, alLeft, alRight] then
 NewWidth := FPicture.Width;
 if Align in [alNone, alTop, alBottom] then
 NewHeight := FPicture.Height;
 end;
end;
function TMapGrid.CargarArchivo(Ruta: string; TipodeGrilla: byte) : Boolean;
var
 Resultado: Boolean;
 Forma: real;
begin
 FRuta:=Ruta;
 LimpiarCeldas;
 case (TipodeGrilla) of
 0: Resultado:=CargarGrilladeSurfer(Ruta);
 1: Resultado:=CargarGrilladeArcView(Ruta);
 else
 Resultado:=False;
 end;
 CargarArchivo:=Resultado;
 if (ActiveEscala nil) then
 ActiveEscala.Importar(Self);
 Forma:=Width/Height;
 Height:=200;
 Width:=Trunc(Forma*Height)
end;
function TMapGrid.CargarGrilladeSurfer(Ruta: string): boolean;
var
 i,j: longword;
 F: TextFile;
 S: string;
 Dato: Extended;
begin
 Result:=False;
 if not FileExists(Ruta) then
 Exit;
 AssignFile(F, Ruta);
 Reset(F);
 Readln(F,S);
 Encabezado:=S;
 Readln(F,S);
 Nx:=StrToInt(GetToken(S,' ',1));
 Ny:=StrToInt(GetToken(S,' ',2));
 Datos:=nil;
 SetLength(datos,Ny,Nx);
 Readln(F,S);
 Xmin:=GetToken(S,' ',1);
 Xmax:=GetToken(S,' ',2);
 Readln(F,S);
 Ymin:=GetToken(S,' ',1);
 Ymax:=GetToken(S,' ',2);
 Readln(F,S);
 Zmin:=GetToken(S,' ',1);
 Zmax:=GetToken(S,' ',2);
 CellSizeX:=FloatToStr((StrToFloat(Xmax)-StrToFloat(Xmin))/Nx);
 CellSizeY:=FloatToStr((StrToFloat(Ymax)-StrToFloat(Ymin))/Ny);
 CellSize:=FloatToStr((StrToFloat(CellSizeX)+StrToFloat(CellSizeY))/2);
 NoDataValue:='1.70141E+38';
 if (Dibujar) then
 AutoColor;
 for i:=Ny-1 Downto 0 do
 for j:=0 to Nx-1 do
 begin
 Read(F, Dato);
 Datos[i,j]:=FloatToStr(Dato);
 if (Dibujar) then
 Pintar(Datos[i,j],i,j);
 end;
 Result:=True;
end;
procedure TMapGrid.Pintar(Dato: string; i,j: longword);
var
 MyRect: TRect;
 l: longword;
 ColorActual: string;
Begin
 MyRect.Top:=i;
 MyRect.Bottom:=(i+1);
 MyRect.Left:=j;
 MyRect.Right:=(j+1);
 ColorActual:=Colores[Nintervalos+1];
 if StrToFloat(Dato) StrToFloat(NoDataValue) then
 begin
 for l:=0 to nintervalos do
 if (StrToFloat(Dato) = StrToFloat(Escala[l,0])) and
 (StrToFloat(Dato) begin
 ColorActual:=Colores[l];
 break;
 end;
 end;
 FPicture.Bitmap.Canvas.Brush.Color:=StringToColor(ColorActual);
 FPicture.Bitmap.Canvas.FillRect(MyRect);
end;
function TMapGrid.CargarGrilladeArcView(Ruta: string): boolean;
var
 i,j: longword;
 F: TextFile;
 S: string;
 Dato: Extended;
begin
 Result:=False;
 if not FileExists(Ruta) then
 Exit;
 AssignFile(F, Ruta);
 Reset(F);
 Readln(F,S);
 Nx:=StrToInt(GetToken(S,' ',2));
 Readln(F,S);
 Ny:=StrToInt(GetToken(S,' ',2));
 Datos:=nil;
 SetLength(Datos,Ny,Nx);
 Readln(F,S);
 Xmin:=GetToken(S,' ',2);
 Readln(F,S);
 Ymin:=GetToken(S,' ',2);
 Readln(F,S);
 CellSize:=GetToken(S,' ',2);
 Readln(F,S);
 NoDataValue:=GetToken(S,' ',2);
 Zmin:= NoDataValue;
 Zmax:= '0';
 for i:=0 to Ny-1 do
 begin
 for j:= 0 to Nx-1 do
 begin
 Read(F, Dato);
 Datos[i,j]:=FloatToStr(Dato);
 if Dato StrToFloat(NoDataValue) then
 begin
 if StrToFloat(zmin) Dato then
 Zmin:=FloatToStr(Dato);
 if StrToFloat(zmax) Zmax:=FloatToStr(Dato);
 end;
 end;
 end;
 if (Dibujar) then
 begin
 AutoColor;
 for i:=0 to Ny-1 do
 for j:= 0 to Nx-1 do
 Pintar(Datos[i,j],i,j);
 end;
 Result:=True;
end;
function TMapGrid.Coordenadas(Col,Row: longword): string;
var
 X,Y: string;
begin
 X:=FloatToStr(Col*StrToFloat(CellSizeX)+StrToFloat(Xmin));
 Y:=FloatToStr(StrToFloat(Ymax)-Row*StrToFloat(CellSizeY));
 Coordenadas:=X+' '+Y;
end;
procedure TMapGrid.FWRuta(GridPath: string);
var
 F: TextFile;
 S: string;
begin
 FRuta:='';
 if not FileExists(GridPath) then
 begin
 FRuta:='';
 Exit;
 end;
 FRuta:=GridPath;
 AssignFile(F, FRuta);
 Reset(F);
 Readln(F,S);
 GridType:=2;
 if (GetToken( S,' ',1) = 'DSAA') Then
 GridType:=0
 else
 GridType:=1;
 if (GridType 1) then
 begin
 ShowMessage('InvalidFormat');
 exit;
 end;
 CloseFile(F);
 CargarArchivo(Ruta, GridType);
end;
procedure TMapGrid.Inicializar;
var
 myRect: TRect;
begin
 myRect.Left:=0;
 myRect.Right:=Width;
 myRect.Top:=0;
 myRect.Bottom:=Height;
 FPicture.Bitmap.Canvas.Brush.Color:=ClWhite;
 FPicture.Bitmap.Canvas.FillRect(MyRect);
end;
function TMapGrid.Info(Const X,Y: longword): string;
begin
 Info:='';
 if (Datos nil) then
 Info:=Datos[X,Y];
end;
procedure TMapGrid.Repintar(Const W,H: integer);
var
 i,j: longword;
begin
 AutoColor;
 ActiveEscala.Importar(Self);
 case GridType of
 0: for i:=Ny-1 Downto 0 do
 for j:=0 to Nx-1 do
 Pintar(Datos[i,j],i,j);
 1: for i:=0 to Ny-1 do
 for j:=0 to Nx-1 do
 Pintar(Datos[i,j],i,j);
 end;
 Height:=H;
 Width:=W;
end;
procedure TMapGrid.LimpiarCeldas;
begin
 FPicture:=nil;
 FPicture:=TPicture.Create;
 Datos:=nil;
 Intervalos.Clear;
 Colores.Clear;
 Escala:=nil;
end;
function TMapGrid.GuardarGrilladeSurfer(Ruta: string): boolean;
var
 i,j: longword;
 F: TextFile;
 Cadena: string;
begin
 AssignFile(F, Ruta);
 Rewrite(F);
 begin
 if (Encabezado = '') then Encabezado:='DSAA';
 writeln(F,Encabezado);
 Cadena:=IntToStr(Nx)+' '+IntToStr(Ny);
 writeln(F,Cadena);
 Cadena:=Xmin+' '+Xmax;
 writeln(F,Cadena);
 Cadena:=Ymin+' '+Ymax;
 writeln(F,Cadena);
 Cadena:=Zmin+' '+Zmax;
 writeln(F,Cadena);
 for i:=0 to Ny-1 do
 begin
 for j:=0 to Nx-1 do
 begin
 write(F,Datos[j,i],' ');
 end;
 writeln(F);
 end
 end;
Close(F);
Result:=True;
end;
function TMapGrid.GuardarGrilladeArcView(Ruta: string): boolean;
var
 i,j: longword;
 F: TextFile;
begin
 AssignFile(F, Ruta);
 Rewrite(F);
 begin
 write(F,'ncols ');
 writeln(F,Nx);
 write(F,'nrows ');
 writeln(F,Ny);
 write(F,'xllcorner ');
 writeln(F,Xmin);
 write(F,'yllcorner ');
 writeln(F,Ymin);
 write(F,'cellsize ');
 writeln(F,CellSize);
 writeln(F,'NODATA_value ' + NoDataValue);
 for i:= 0 to Ny-1 do
 for j:= 0 to Nx-1 do
 write(F, Datos[i,j],' ');
 end;
Close(F);
Result:=True;
end;
function TMapGrid.GuardarGrillaXYZ(Ruta: string): boolean;
var
 i,j: longword;
 F: TextFile;
begin
 AssignFile(F, Ruta);
 Rewrite(F);
 for j:=0 to Nx-1 do
 for i:=Ny-1 downto 0 do
 if Not(StrToFloat(Datos[j,i]) = StrToFloat(NoDataValue)) then
 writeln(F,Coordenadas(j,i)+' '+Datos[j,i]);
 Close(F);
 Result:=True;
end;
procedure TMapGrid.AutoColor;
var
i: integer;
R1,G1,B1: integer;
R2,G2,B2: integer;
R,G,B: integer;
min,max,delta: real;
begin
 if Ruta '' then
 begin
 Width:=Nx;
 Height:=Ny;
 Canvas.Brush.Style:=bsSolid;
 Colores.Clear ;
 Escala:=nil;
 R1:=GetRValue(ColorToRGB(ColorMinimo));
 G1:=GetGValue(ColorToRGB(ColorMinimo));
 B1:=GetBValue(ColorToRGB(ColorMinimo));
 R2:=GetRValue(ColorToRGB(ColorMaximo))-R1;
 G2:=GetGValue(ColorToRGB(ColorMaximo))-G1;
 B2:=GetBValue(ColorToRGB(ColorMaximo))-B1;
 Colores.Clear;
 for i:=0 to Nintervalos do
 begin
 R:=(R1+(i*R2) div Nintervalos);
 G:=(G1+(i*G2) div Nintervalos);
 B:=(B1+(i*B2) div Nintervalos);
 Colores.Add(IntToStr(RGB(R,G,B)));
 end;
 Colores.Add(IntToStr(ColorNoDato));
 end;
 SetLength(Escala,Nintervalos+1,2);
 delta:=(StrToFloat(zmax)-StrToFloat(zmin))/Nintervalos;
 min:=StrToFloat(zmin);
 max:=StrToFloat(zmin)+delta;
 for i:= 0 to Nintervalos-1 do
 begin
 Escala[i,0]:=FloatToStr(min);
 Escala[i,1]:=FloatToStr(max);
 min:=max;
 max:=max+delta;
 end;
 Escala[Nintervalos,0]:=zmax;
 Escala[Nintervalos,1]:=NoDataValue;
end;
function TMapGrid.GetToken(LeeCadena: AnsiString; Sep: char; Num: longword): string;
var
 Token: string;
 StrLen: longword;
 TNum: longword;
 TEnd: longword;
begin
 StrLen:=Length(LeeCadena);
 TNum:=1;
 TEnd:=StrLen;
 while ((TNum0)) do
 begin
 TEnd:=Pos(Sep,LeeCadena);
 if TEnd0 then
 begin
 Token:=Copy(LeeCadena,1,Tend-1);
 Delete(LeeCadena,1,Tend);
 INC(TNum);
 end
 else Token:=LeeCadena;
 end;
 if TNum=Num then Result:= Token
 else Result:='';
end;
end.
Algorithm Math Delphi
