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.

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) < StrToFloat(Escala[l,1])) then
    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) < Dato then
             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 ((TNum<=Num) and (TEnd<>0)) do
  begin
    TEnd:=Pos(Sep,LeeCadena);
    if TEnd<>0 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.