Mega Code Archive
How to convert a Grids Surfer to a Grids Arcview
<![CDATA[
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.
]]>