ezermapper.pas

很管用的GIS控件

unit EzERMapper;

{$I EZ_FLAG.PAS}
{$A+}
interface

Uses
  Controls, SysUtils, Classes, Windows, Graphics, Math,
  EzLib, EzBase, EzBaseGIS;

type

  TCoordSysType = (
    CST_NONE		{= 0},
    CST_RAW			{= 1},	(* Dataset cell x and y coords *)
    CST_UTM			{= 2},	(* Eastings and Northings *)
    CST_LATLONG		{= 3}		(* Longitude and Latitude *)
  );


  TCoordEN = Record
    eastings : double;
    northings : double;
    meters_z : double;
  End;

  TCoordLatLong = Record
    longitude : double;
    latitude : double;
    meters_z : double;
  End;

  TCoordRaw = Record
    meters_x : double;
    meters_y : double;
    meters_z:  double;
  End;

  TDSCoord = Record
    Case Integer Of
      0 : ( en : TCoordEN );
      1 : ( ll : TCoordLatLong );
      2 : ( raw : TCoordRaw );
  End;

  PEzERInfo = ^TEzERInfo;
  TEzERInfo = Record
    m_pAlgorithm : Pointer;
    origin : TDSCoord;
    topleft : TDSCoord;
    bottomright : TDSCoord;
    applytopleft : TDSCoord;
    applybottomright : TDSCoord;
    CoordSys : Integer;
    canvas_width : Integer;
    canvas_height : Integer;
    output_width : Integer;
    output_height : Integer;
    nr_columns : Integer;
    nr_rows : Integer;
    x_rel : double;
    y_rel : double;
    x_dpi : double;
    y_dpi : double;
    XPelsPerMeter : Integer;
    YPelsPerMeter : Integer;
    bitCount : Integer;
    Ok : Integer;
  End;

  TEzERMapper = Class( TEzClosedEntity )
  Private
    FFileName: String;
    FAlphaChannel: Byte;
    FVector: TEzVector;
  {$IFDEF BCB}
    function GetAlphaChannel: byte;
    function GetFileName: String;
    procedure SetAlphaChannel(const Value: byte);
    procedure SetFileName(const Value: String);
  {$ENDIF}
  Protected
    Function GetDrawPoints: TEzVector; Override;
    Function GetEntityID: TEzEntityID; Override;
    Function BasicInfoAsString: string; Override;
  Public
    Constructor CreateEntity( Const P1, P2: TEzPoint; Const FileName: String );
    Destructor Destroy; Override;
    Procedure Initialize; Override;
    Procedure LoadFromStream( Stream: TStream ); Override;
    Procedure SaveToStream( Stream: TStream ); Override;
    Procedure Draw( Grapher: TEzGrapher; Canvas: TCanvas; Const Clip: TEzRect;
      DrawMode: TEzDrawMode; Data: Pointer = Nil ); Override;
    Function StorageSize: Integer; Override;
    Procedure UpdateExtension; Override;
    Procedure UpdateControlPoint( Index: Integer; Const Value: TEzPoint; Grapher: TEzGrapher=Nil ); Override;
    Function GetControlPoints(TransfPts: Boolean; Grapher: TEzGrapher=Nil): TEzVector; Override;
    Function GetControlPointType( Index: Integer ): TEzControlPointType; Override;
    Function IsEqualTo( Entity: TEzEntity; IncludeAttribs: Boolean  = false): Boolean; Override;

    { This property determines the AlphaChannel of the image
      0= opaque, 255= transparent }
    Property AlphaChannel: byte {$IFDEF BCB} Read GetAlphaChannel Write SetAlphaChannel {$ELSE} Read FAlphaChannel Write FAlphaChannel {$ENDIF};
    Property FileName: String {$IFDEF BCB} Read GetFileName Write SetFileName {$ELSE} Read FFileName Write FFileName {$ENDIF};
  End;

  Procedure LoadERMapperDll;
  
Var
  HandleERMapperDll : THandle = 0;
  ERMapperDllLoaded : Boolean = False;

  GetImage : Function (Info : PEzERInfo;
			                 Var m_hBitMap : HBITMAP;
                       Var m_BmpInfo : BITMAPINFO;
			                 m_hDC : THandle;
                       Var bits : Pointer) : Integer cdecl stdcall;
  GetEzERInfo : Function (lpszPathName : PChar) : PEzERInfo cdecl stdcall;
  ERSFreeMem : Procedure(p : Pointer); cdecl stdcall ;
  FreeEzERInfo : Procedure(var p : PEzERInfo) cdecl stdcall ;
  setValues : Procedure(p : PEzERInfo) cdecl stdcall ;
  getERS_error_text: function(): PChar cdecl stdcall;

implementation

Uses
  EzConsts, EzSystem, EzGraphics;

Procedure LoadERMapperDll;
Begin
  HandleERMapperDll := LoadLibrary('ERDll.dll');
  If HandleERMapperDll > 32 Then
  Begin
    ERMapperDllLoaded := True;
    @GetImage := GetProcAddress(HandleERMapperDll, 'getImage');
    Assert( @GetImage <> Nil) ;
    @GetEzERInfo := GetProcAddress(HandleERMapperDll, 'getEzERInfo');
    Assert( @GetEzERInfo <> Nil) ;
    @ERSFreeMem := GetProcAddress(HandleERMapperDll, 'ERSFreeMem');
    Assert( @getEzERInfo <> Nil) ;
    @FreeEzERInfo := GetProcAddress(HandleERMapperDll, 'freeEzERInfo');
    Assert(@FreeEzERInfo <> Nil);
    @setValues := GetProcAddress(HandleERMapperDll, 'setValues');
    Assert(@setValues <> Nil);
    @getERS_error_text := GetProcAddress(HandleERMapperDll, 'getERS_error_text');
    Assert(@getERS_error_text <> Nil);
  End Else
    ERMapperDllLoaded := False;
End;

Constructor TEzERMapper.CreateEntity( Const P1, P2: TEzPoint;
  Const FileName: String );
Begin
  Inherited CreateEntity( [P1, P2], False );
  FFileName := FileName;
End;

Destructor TEzERMapper.Destroy;
Begin
  FVector.Free;
  Inherited Destroy;
End;

Procedure TEzERMapper.Initialize;
begin
  inherited;
  FVector := TEzVector.Create( 5 );
end;

Function TEzERMapper.BasicInfoAsString: string;
Begin
  Result:= Format(sERMapperInfo, [FPoints.AsString,FFileName,FAlphaChannel]);
End;

Function TEzERMapper.GetEntityID: TEzEntityID;
Begin
  result := idERMapper;
End;

{$IFDEF BCB}
function TEzERMapper.GetAlphaChannel: byte;
begin
  Result := FAlphaChannel;
end;

function TEzERMapper.GetFileName: String;
begin
  Result := FFileName;
end;

procedure TEzERMapper.SetAlphaChannel(const Value: byte);
begin
  FAlphaChannel := Value;
end;

procedure TEzERMapper.SetFileName(const Value: String);
begin
  FFileName := Value;
end;
{$ENDIF}

Function TEzERMapper.GetControlPoints(TransfPts: Boolean; Grapher: TEzGrapher=Nil): TEzVector;
Var
  TmpR: TEzRect;
  Movept: TEzPoint;
Begin
  Result := TEzVector.Create( 8 );
  TmpR.Emin := FPoints[0];
  TmpR.Emax := FPoints[1];
  TmpR := ReorderRect2D( TmpR );
  With Result Do
  Begin
    Add( TmpR.Emin ); // LOWER LEFT
    AddPoint( ( TmpR.Emin.X + TmpR.Emax.X ) / 2, TmpR.Emin.Y ); // MIDDLE BOTTOM
    AddPoint( TmpR.Emax.X, TmpR.Emin.Y ); // LOWER RIGHT
    AddPoint( TmpR.Emax.X, ( TmpR.Emin.Y + TmpR.Emax.Y ) / 2 ); // MIDDLE RIGHT
    Add( TmpR.Emax ); // UPPER RIGHT
    AddPoint( ( TmpR.Emin.X + TmpR.Emax.X ) / 2, TmpR.Emax.Y ); // MIDDLE TOP
    AddPoint( TmpR.Emin.X, TmpR.Emax.Y ); // UPPER LEFT
    AddPoint( TmpR.Emin.X, ( TmpR.Emin.Y + TmpR.Emax.Y ) / 2 ); // MIDDLE LEFT
    if TransfPts then
    begin
      // the move control point
      MovePt.X := ( TmpR.Emin.X + TmpR.Emax.X ) / 2;
      MovePt.Y := ( TmpR.Emin.Y + TmpR.Emax.Y ) / 2;
      AddPoint( MovePt.X, MovePt.Y );
    end;
  End;
End;

Function TEzERMapper.GetControlPointType( Index: Integer ): TEzControlPointType;
Begin
  If Index = 8 Then
    Result := cptMove
  Else
    Result := cptNode;
End;

Procedure TEzERMapper.UpdateControlPoint( Index: Integer; Const Value: TEzPoint; Grapher: TEzGrapher=Nil );
Var
  TmpR: TEzRect;
  Movept: TEzPoint;
  M: TEzMatrix;
Begin
  FPoints.DisableEvents := True;
  Try
    TmpR.Emin := FPoints[0];
    TmpR.Emax := FPoints[1];
    TmpR := ReorderRect2D( TmpR );
    Case Index Of
      0: // LOWER LEFT
        Begin
          TmpR.Emin := Value;
        End;
      1: // MIDDLE BOTTOM
        Begin
          TmpR.Emin.Y := Value.Y;
        End;
      2: // LOWER RIGHT
        Begin
          TmpR.Emax.X := Value.X;
          TmpR.Emin.Y := Value.Y;
        End;
      3: // MIDDLE RIGHT
        Begin
          TmpR.Emax.X := Value.X;
        End;
      4: // UPPER RIGHT
        Begin
          TmpR.Emax := Value;
        End;
      5: // MIDDLE TOP
        Begin
          TmpR.Emax.Y := Value.Y;
        End;
      6: // UPPER LEFT
        Begin
          TmpR.Emin.X := Value.X;
          TmpR.Emax.Y := Value.Y;
        End;
      7: // MIDDLE LEFT
        Begin
          TmpR.Emin.X := Value.X;
        End;