ezbase.pas

很管用的GIS控件

  TEzSortFloatField = Class( TEzSortField )
  Protected
    Function GetAsString: String; Override;
    Procedure SetAsString( Const Value: String ); Override;
    Function GetAsFloat: double; Override;
    Procedure SetAsFloat( Value: double ); Override;
    Function GetAsInteger: Longint; Override;
    Procedure SetAsInteger( Value: Longint ); Override;
    Function GetAsBoolean: Boolean; Override;
    Procedure SetAsBoolean( Value: Boolean ); Override;
  Public
    Constructor Create( Fields: TEzSortFields ); Override;
  End;

  {-------------------------------------------------------------------------------}
  {                  Define TEzSortIntegerField                                      }
  {-------------------------------------------------------------------------------}

  TEzSortIntegerField = Class( TEzSortField )
  Protected
    Function GetAsString: String; Override;
    Procedure SetAsString( Const Value: String ); Override;
    Function GetAsInteger: Longint; Override;
    Procedure SetAsInteger( Value: Longint ); Override;
    Function GetAsFloat: double; Override;
    Procedure SetAsFloat( Value: double ); Override;
    Function GetAsBoolean: Boolean; Override;
    Procedure SetAsBoolean( Value: Boolean ); Override;
  Public
    Constructor Create( Fields: TEzSortFields ); Override;
  End;

  {-------------------------------------------------------------------------------}
  {                  Define TEzSortBooleanField                                      }
  {-------------------------------------------------------------------------------}

  TEzSortBooleanField = Class( TEzSortField )
  Protected
    Function GetAsString: String; Override;
    Procedure SetAsString( Const Value: String ); Override;
    Function GetAsBoolean: Boolean; Override;
    Procedure SetAsBoolean( Value: Boolean ); Override;
    Function GetAsInteger: Longint; Override;
    Procedure SetAsInteger( Value: Longint ); Override;
    Function GetAsFloat: double; Override;
    Procedure SetAsFloat( Value: double ); Override;
  Public
    Constructor Create( Fields: TEzSortFields ); Override;
  End;

  {-------------------------------------------------------------------------------}
  {                  Define TEzSortFields                                            }
  {-------------------------------------------------------------------------------}

  TEzSortList = Class;

  TEzSortFields = Class
    fSortList: TEzSortList;
    fItems: TList;
    Function GetCount: Integer;
    Function GetItem( Index: Integer ): TEzSortField;
  Public
    Constructor Create( SortList: TEzSortList );
    Destructor Destroy; Override;
    Function Add( DataType: TExprType ): TEzSortField;
    Procedure Clear;

    Property Count: Integer Read GetCount;
    Property Items[Index: Integer]: TEzSortField Read GetItem; Default;
    Property SortList: TEzSortList Read fSortList;
  End;

  {-------------------------------------------------------------------------------}
  {                  Define TEzSortList                                           }
  {-------------------------------------------------------------------------------}
  TEzSortList = Class( TObject )
  Private
    fFields: TEzSortFields;
    fRecNo: Integer;
    fRecordBufferSize: Integer;

    Function ActiveBuffer: PChar; Virtual; Abstract;
  Protected
    Function GetFieldData( Field: TEzSortField; Buffer: Pointer ): Boolean; Virtual; Abstract;
    Procedure SetFieldData( Field: TEzSortField; Buffer: Pointer ); Virtual; Abstract;
    Procedure SetRecno( Value: Integer );
    Function GetRecno: Integer;
    Procedure SetSourceRecno( Value: Integer ); Virtual; Abstract;
    Function GetSourceRecno: Integer; Virtual; Abstract;
    Function GetRecordCount: Integer; Virtual; Abstract;
  Public
    Constructor Create;
    Destructor Destroy; Override;
    Procedure AddField( pDataType: TExprType; pDataSize: Integer; pDescending: Boolean );
    Procedure Insert; Virtual; Abstract;
    Procedure Sort;
    Procedure Exchange( Recno1, Recno2: Integer ); Virtual; Abstract;
    Procedure Clear; Virtual; Abstract;

    Property Count: Integer Read GetRecordCount;
    Property Recno: Integer Read GetRecno Write SetRecno;
    Property SourceRecno: Integer Read GetSourceRecno Write SetSourceRecno;
    Property Fields: TEzSortFields Read fFields;
  End;

  TEzMemSortList = Class( TEzSortList )
  Private
    fBufferList: TList;
    Function ActiveBuffer: PChar; Override;
  Protected
    Function GetFieldData( Field: TEzSortField; Buffer: Pointer ): Boolean; Override;
    Procedure SetFieldData( Field: TEzSortField; Buffer: Pointer ); Override;
    Function GetRecordCount: Integer; Override;
    Procedure SetSourceRecno( Value: Integer ); Override;
    Function GetSourceRecno: Integer; Override;
  Public
    Constructor Create;
    Destructor Destroy; Override;
    Procedure Insert; Override;
    Procedure Exchange( Recno1, Recno2: Integer ); Override;
    Procedure Clear; Override;
  End;


{ picking constants }
Const
  PICKED_NONE = -3; { no point or interior picked }
  PICKED_INTERIOR = -2; { picked inside entity (only closed entities) }
  PICKED_POINT = -1; { picked on a line segment }

  { units array constant }
  pj_units: Array[TEzCoordsUnits] Of TEzPJ_UNITS = (
    ( id:'m'      ; to_meter: 1.0; name: 'Meter' ),
    ( id:'km'     ; to_meter: 1000; name: 'Kilometer' ),
    ( id:'dm'     ; to_meter: 0.10; name: 'Decimeter' ),
    ( id:'cm'     ; to_meter: 0.01; name: 'Centimeter' ),
    ( id:'mm'     ; to_meter: 0.001; name: 'Millimeter' ),
    ( id:'kmi'    ; to_meter: 1852.0; name: 'International Nautical Mile' ),
    ( id:'in'     ; to_meter: 0.0254; name: 'International Inch' ),
    ( id:'ft'     ; to_meter: 0.3048; name: 'International Foot' ),
    ( id:'yd'     ; to_meter: 0.9144; name: 'International Yard' ),
    ( id:'mi'     ; to_meter: 1609.344; name: 'International Statute Mile' ),
    ( id:'fath'   ; to_meter: 1.8288; name: 'International Fathom' ),
    ( id:'ch'     ; to_meter: 20.1168; name: 'International Chain' ),
    ( id:'link'   ; to_meter: 0.201168; name: 'International Link' ),
    ( id:'us-in'  ; to_meter: 0.0254000508001; name: 'U.S. Surveyor''s Inch' ),
    ( id:'us-ft'  ; to_meter: 0.304800609601219; name: 'U.S. Surveyor''s Foot' ),
    ( id:'us-yd'  ; to_meter: 0.914401828803658; name: 'U.S. Surveyor''s Yard' ),
    ( id:'us-ch'  ; to_meter: 20.11684023368047; name: 'U.S. Surveyor''s Chain' ),
    ( id:'us-mi'  ; to_meter: 1609.347218694437; name: 'U.S. Surveyor''s Statute Mile' ),
    ( id:'ind-yd' ; to_meter: 0.91439523; name: 'Indian Yard' ),
    ( id:'ind-ft' ; to_meter: 0.30479841; name: 'Indian Foot' ),
    ( id:'ind-ch' ; to_meter: 20.11669506; name: 'Indian Chain' ),
    ( id:'deg'    ; to_meter: 1.0; name: 'Degrees' )
    );

Function UnitCodeFromID( Const id: String ): TEzCoordsUnits;

Procedure BitmapToWMF( Bitmap: TBitmap; MetaFile: TMetaFile );
Procedure WMFToBitmap( Bitmap: TBitmap; MetaFile: TMetaFile );

Implementation

Uses
  TypInfo, Inifiles, EzSystem, EzConsts, EzEntities, ezbasegis
{$IFDEF USE_GRAPHICEX}
  , GraphicEx
{$ENDIF}
{$IFDEF JPEG_SUPPORT}
  //, Jpeg
{$ENDIF}
{$IFDEF GIF_SUPPORT}
  , GifImage
{$ENDIF}
  ;

Function UnitCodeFromID( Const ID: String ): TEzCoordsUnits;
Var
  i: TEzCoordsUnits;
  //en: String;
Begin
  result := cuM; // meter the default
  For i := Low( pj_units ) To High( pj_units ) Do
  Begin
    //en := GetEnumName( System.TypeInfo( TEzCoordsUnits ), Ord( i ) );
    If AnsiCompareText( {copy( en, 3, length( en ) )} pj_units[i].ID, ID ) = 0 Then
    Begin
      result := i;
      exit;
    End;
  End;
End;

{function UnitCodeFromName(const Name:String) : TEzCoordsUnits;
var
  i : TEzCoordsUnits;
begin
  result :=  cuM;    // meter the default
  for i :=  Low(pj_units) to High(pj_units) do
     if AnsiCompareText(pj_units[i].name,Name)=0 then
     begin
        result :=  i;
        exit;
     end;
end; }

{-------------------------------------------------------------------------------}
{                  Utilities                                                    }
{-------------------------------------------------------------------------------}

Procedure BitmapToWMF( Bitmap: TBitmap; MetaFile: TMetaFile );
Var
  MetafileCanvas: TMetafileCanvas;
Begin
  MetaFile.Width := Bitmap.Width;
  MetaFile.Height := Bitmap.Height;
  MetafileCanvas := TMetafileCanvas.CreateWithComment( MetaFile, 0, 'EzGis', 'EzGis Components' );
  Try
    BitBlt( MetafileCanvas.Handle, 0, 0, Bitmap.Width, Bitmap.Height,
      Bitmap.Canvas.Handle, 0, 0, SRCCOPY );
  Finally
    MetafileCanvas.Free;
  End;
End;

Procedure WMFToBitmap( Bitmap: TBitmap; MetaFile: TMetaFile );
Var
  B: TBitmap;
Begin
  B := TBitmap.Create;
  B.Monochrome := False;
  B.Width := MetaFile.Width;
  B.Height := MetaFile.Height;
  B.Canvas.Draw( 0, 0, MetaFile );
  Bitmap.Assign( B );
  B.Free;
End;

Function GetDeviceRes( DC: THandle ): Integer;
Var
  Noc: Integer;
Begin
  Result := 8;
  Noc := GetDeviceCaps( DC, BITSPIXEL );
  If Noc <= 4 Then
    Result := 4
  Else If Noc = 8 Then
    Result := 8
  Else If Noc >= 16 Then
    Result := 24;
End;

{-------------------------------------------------------------------------------}
{                  Implements TEzGraphicLink                                      }
{-------------------------------------------------------------------------------}

Constructor TEzGraphicLink.Create;
Begin
  Inherited Create;
  FBitmap := TBitmap.Create;
End;

Destructor TEzGraphicLink.Destroy;
Begin
  FBitmap.Free;
  Inherited Destroy;
End;

Procedure TEzGraphicLink.readWMF( Const FileName: String );
Var
  Metafile: TMetafile;
Begin
  Metafile := TMetafile.Create;
  Try
    Metafile.LoadFromFile( FileName );
    WMFToBitmap( Bitmap, Metafile );
  Finally
    Metafile.free;
  End;
End;

Procedure TEzGraphicLink.readEMF( Const FileName: String );
Begin
  readWMF( FileName );
End;

Procedure TEzGraphicLink.readICO( Const FileName: String );
Var
  TmpBitmap: TBitmap;
  Icon: TIcon;
Begin
  Icon := TIcon.Create;
  Try
    Icon.LoadFromFile( FileName );
    TmpBitmap := CreateBitmapFromIcon( Icon, clOlive );
    Bitmap.Assign( TmpBitmap );
    TmpBitmap.Free;
  Finally
    Icon.Free;
  End;
End;

Procedure TEzGraphicLink.readBMP( Const FileName: String );
Begin
  FBitmap.LoadFromFile( FileName );
End;

{$IFDEF JPEG_SUPPORT}

Procedure TEzGraphicLink.readJPG( Const FileName: String );
Var
  Jpg: TJpegImage;
  JpegStream: TStream;
Begin
  Jpg := TJpegImage.Create;
  Try
    JpegStream := TFileStream.Create( FileName, fmOpenRead Or fmShareDenyWrite );
    If Jpg.PixelFormat = jf24bit Then
      Bitmap.PixelFormat := pf24bit
    Else
      Bitmap.PixelFormat := pf8bit;
    Jpg.LoadFromStream( JpegStream );
    Jpg.PixelFormat := jf8bit;

    Bitmap.Width := Jpg.Width;
    Bitmap.Height := Jpg.Height;
    Bitmap.Canvas.Draw( 0, 0, Jpg );
  Finally
    Jpg.Free;
  End;
End;

Procedure TEzGraphicLink.putJPG( Bitmap: TBitmap; Const FileName: String );
Var
  Jpg: TJpegImage;
Begin
  Jpg := TJpegImage.Create;
  Try
    Jpg.Assign( Bitmap );
    Jpg.PixelFormat := jf24Bit;
    //Jpg.Scale:= jsQuarter;
    Jpg.Smoothing := true;
    Jpg.CompressionQuality := 50;
    Jpg.Compress;
    Jpg.SaveToFile( FileName );
  Finally
    Jpg.Free;
  End;
End;
{$ENDIF}

{$IFDEF GIF_SUPPORT}

Procedure TEzGraphicLink.readGIF( Const FileName: String );
Begin
  With TGifImage.Create Do
  Try
    LoadFromFile( FileName );
    Self.Bitmap.Assign( Bitmap );
  Finally
    Free;
  End;
End;

Procedure TEzGraphicLink.putGIF( Bitmap: TBitmap; Const FileName: String );
Var
  bmp: TBitmap;
Begin
  bmp := Bitmap;
  With TGifImage.Create Do
  Try
    Assign( bmp );
    SaveToFile( FileName );
  Finally
    Free;
  End;
End;
{$ENDIF}

Procedure TEzGraphicLink.putBMP( Bitmap: TBitmap; Const FileName: String );
Begin