ezimpl.pas

很管用的GIS控件

Unit EZIMPL;

{***********************************************************}
{     EzGIS/CAD Components                                  }
{   (c) 2003 EzSoft Engineering                             }
{         All Rights Reserved                               }
{***********************************************************}

{$I EZ_FLAG.PAS}


{.$DEFINE GIFIMAGE_ON}{ uncomment to add support for Gif images
                        We use TGifImage with permission from Anders Melander,
                        latest version you can find on:
                        http://www.melander.dk/delphi/gifimage/ }
Interface

Uses
  SysUtils, Windows, Classes, Graphics, ezbase, EzBaseGIS ;


  Function CreateAndOpenTable( GIS: TEzBaseGIS; const FileName: string;
    ReadWrite, Shared: Boolean ): TEzBaseTable;
  Function CreateTable( GIS: TEzBaseGIS ): TEzBaseTable;
  Function GetDesktopBaseTableClass: TEzBaseTableClass;


// don't move this

{$IFDEF ISACTIVEX}
{.$DEFINE HALCYONDB}
{.$UNDEF NATIVEDB}
{.$UNDEF DBISAMDB}
{$ENDIF}

Implementation

Uses
  Forms, EzEntities, Db, EzSystem, EzConsts
{$IFDEF NATIVEDB}
{$IFNDEF NATIVEDLL}
  , dbf
{$ENDIF}
{$ENDIF}
{$IFDEF GIFIMAGE_ON}
  , GIFImage
{$ENDIF}
{$IFDEF BORLAND_BDE}
  , Bde, DBTables
{$ENDIF}
{$IFDEF DATASET_PROVIDER}
  , ezctrls
{$ENDIF}
{$IFDEF DBISAMDB}
  , DBISAMTb
{$ENDIF}
{$IFDEF HALCYONDB}
  , gs6_shel
{$ENDIF}
  ;


{$IFDEF DATASET_PROVIDER}

//************************ TEzDataSetProvider implementation **********************

Type

  TEzProviderTable = Class( TEzBaseTable )
  Private
    FDataSet: TDataSet;
    FAutoDispose: Boolean;
  Protected
    Function GetActive: boolean; Override;
    Procedure SetActive( Value: boolean ); Override;
    Function GetRecNo: Integer; Override;
    Procedure SetRecNo( Value: Integer ); Override;
  Public
    Constructor Create( Gis: TEzBaseGIS; Const FName: String;
      ReadWrite, Shared: boolean ); Override;
    Destructor Destroy; Override;
    Procedure Append( NewRecno: Integer ); Override;
    Function BOF: Boolean; Override;
    Function EOF: Boolean; Override;
    Function DateGet( Const FieldName: String ): TDateTime; Override;
    Function DateGetN( FieldNo: integer ): TDateTime; Override;
    Function Deleted: Boolean; Override;
    Function Field( FieldNo: integer ): String; Override;
    Function FieldCount: integer; Override;
    Function FieldDec( FieldNo: integer ): integer; Override;
    Function FieldGet( Const FieldName: String ): String; Override;
    Function FieldGetN( FieldNo: integer ): String; Override;
    Function FieldLen( FieldNo: integer ): integer; Override;
    Function FieldNo( Const FieldName: String ): integer; Override;
    Function FieldType( FieldNo: integer ): char; Override;
    Function Find( Const ss: String; IsExact, IsNear: boolean ): boolean; Override;
    Function FloatGet( Const Fieldname: String ): Double; Override;
    Function FloatGetN( FieldNo: Integer ): Double; Override;
    Function IndexCount: integer; Override;
    Function IndexAscending( Value: integer ): boolean; Override;
    Function Index( Const INames, Tag: String ): integer; Override;
    Function IndexCurrent: String; Override;
    Function IndexUnique( Value: integer ): boolean; Override;
    Function IndexExpression( Value: integer ): String; Override;
    Function IndexTagName( Value: integer ): String; Override;
    Function IndexFilter( Value: integer ): String; Override;
    Function IntegerGet( Const FieldName: String ): Integer; Override;
    Function IntegerGetN( FieldNo: integer ): Integer; Override;
    Function LogicGet( Const FieldName: String ): Boolean; Override;
    Function LogicGetN( FieldNo: integer ): Boolean; Override;
    Procedure MemoSave( Const FieldName: String; Stream: TStream ); Override;
    Procedure MemoSaveN( FieldNo: integer; Stream: TStream ); Override;
    Function MemoSize( Const FieldName: String ): Integer; Override;
    Function MemoSizeN( FieldNo: integer ): Integer; Override;
    Function RecordCount: Integer; Override;
    Function StringGet( Const FieldName: String ): String; Override;
    Function StringGetN( FieldNo: integer ): String; Override;
    Procedure DatePut( Const FieldName: String; value: TDateTime ); Override;
    Procedure DatePutN( FieldNo: integer; value: TDateTime ); Override;
    Procedure Delete; Override;
    Procedure Edit; Override;
    Procedure FieldPut( Const FieldName, Value: String ); Override;
    Procedure FieldPutN( FieldNo: integer; Const Value: String ); Override;
    Procedure First; Override;
    Procedure FloatPut( Const FieldName: String; Const Value: Double ); Override;
    Procedure FloatPutN( FieldNo: integer; Const Value: Double ); Override;
    Procedure FlushDB; Override;
    Procedure Go( n: Integer ); Override;
    Procedure IndexOn( Const IName, tag, keyexp, forexp: String;
      uniq: TEzIndexUnique; ascnd: TEzSortStatus ); Override;
    Procedure IntegerPut( Const Fieldname: String; Value: Integer ); Override;
    Procedure IntegerPutN( FieldNo: integer; Value: Integer ); Override;
    Procedure Last; Override;
    Procedure LogicPut( Const fieldname: String; value: boolean ); Override;
    Procedure LogicPutN( fieldno: integer; value: boolean ); Override;
    Procedure MemoLoad( Const fieldname: String; Stream: TStream ); Override;
    Procedure MemoLoadN( fieldno: integer; Stream: TStream ); Override;
    Procedure Next; Override;
    Procedure Pack; Override;
    Procedure Post; Override;
    Procedure Prior; Override;
    Procedure Recall; Override;
    Procedure Refresh; Override;
    Procedure Reindex; Override;
    Procedure SetTagTo( Const TName: String ); Override;
    Procedure SetUseDeleted( tf: boolean ); Override;
    Procedure StringPut( Const fieldname, value: String ); Override;
    Procedure StringPutN( fieldno: integer; Const value: String ); Override;
    Procedure Zap; Override;
    { procedures for manipulating databases }
    Function DBCreateTable( Const fname: String;
      AFieldList: TStringList ): boolean; Override;
    function DBTableExists( const TableName: string ): Boolean; Override;
    Function DBDropTable( const TableName: string): Boolean; Override;
    Function DBDropIndex( const TableName: string): Boolean; Override;
    Function DBRenameTable( const Source, Target: string): Boolean; Override;

    Property DataSet: TDataSet read FDataSet Write FDataSet ;
    Property AutoDispose: Boolean read FAutoDispose write FAutoDispose ;
  End;

//************************ TEzDataSetProvider implementation **********************
Constructor TEzProviderTable.Create( Gis: TEzBaseGIS; Const FName: String;
  ReadWrite, Shared: boolean );
Begin
  inherited Create( Gis, FName, ReadWrite, Shared );
  with TEzGis(Gis) do
    if Assigned( Provider) and Assigned( Provider.OnOpenTable) then
      Provider.OnOpenTable( Provider, FName, ReadWrite, Shared, FDataSet, FAutoDispose );
End;

Destructor TEzProviderTable.Destroy;
Begin
  if FAutoDispose and ( FDataSet <> Nil ) then
    FDataSet.Free;
  Inherited Destroy;
End;

Function TEzProviderTable.DBRenameTable( const Source, Target: string): Boolean;
begin
  Result:=false;
  if ( Gis is TEzGis ) And Assigned( TEzGis(Gis).Provider.OnRenameTable ) then
  begin
    TEzGis(Gis).Provider.OnRenameTable( TEzGis(Gis).Provider, Source, Target );
    Result:=true;
  end;
end;

Function TEzProviderTable.DBDropIndex( const TableName: string): Boolean;
begin
  Result:=false;
  if ( Gis is TEzGis ) And Assigned( TEzGis(Gis).Provider.OnDropIndexFile ) then
  begin
    TEzGis(Gis).Provider.OnDropIndexFile( TEzGis(Gis).Provider, TableName );
    Result:=true;
  end;
end;

Function TEzProviderTable.DBDropTable( const TableName: string): Boolean;
begin
  Result:= False;
  if ( Gis is TEzGis ) And Assigned( TEzGis(Gis).Provider.OnDropTable ) then
  begin
    TEzGis(Gis).Provider.OnDropTable( TEzGis(Gis).Provider, TableName );
    Result:= True;
  end;
end;

function TEzProviderTable.DBTableExists( const TableName: string ): Boolean;
begin
  Result:=False;
  if ( Gis is TEzGis ) And Assigned( TEzGis(Gis).Provider.OnQueryTableExists ) then
    TEzGis(Gis).Provider.OnQueryTableExists( TEzGis(Gis).Provider, TableName, Result );
end;

Function TEzProviderTable.DBCreateTable( Const fname: String;
  AFieldList: TStringList ): boolean;
Begin
  Result:=False;
  if ( Gis is TEzGis ) And Assigned( TEzGis(Gis).Provider.OnCreateTable ) then
  begin
    TEzGis(Gis).Provider.OnCreateTable( TEzGis(Gis).Provider, fname, AFieldList );
    Result:=true;
  end;
End;

Function TEzProviderTable.GetActive: boolean;
Begin
  result := FDataSet.Active;
End;

Procedure TEzProviderTable.SetActive( Value: boolean );
Begin
  FDataSet.Active := value;
End;

Function TEzProviderTable.GetRecNo: Integer;
Begin
  with TEzGis(Gis) do
    if Assigned( Provider) and Assigned( Provider.OnGetRecno) then
      Provider.OnGetRecno( Provider, FDataSet, Result );
End;

Procedure TEzProviderTable.SetRecNo( Value: Integer );
Begin
  with TEzGis(Gis) do
    if Assigned( Provider) and Assigned( Provider.OnSetToRecno) then
      Provider.OnSetToRecno( Provider, FDataSet, Value );
End;

Procedure TEzProviderTable.Append( NewRecno: Integer );
Begin
  with TEzGis(Gis) do
    if Assigned( Provider) and Assigned( Provider.OnAppendRecord) then
      Provider.OnAppendRecord( Provider, FDataSet, NewRecno );
End;

Function TEzProviderTable.BOF: Boolean;
Begin
  result := FDataSet.BOF;
End;

Function TEzProviderTable.EOF: Boolean;
Begin
  Result := FDataSet.EOF;
End;

Function TEzProviderTable.DateGet( Const FieldName: String ): TDateTime;
Begin
  Result := FDataSet.FieldByName( FieldName ).AsDateTime;
End;

Function TEzProviderTable.DateGetN( FieldNo: integer ): TDateTime;
Begin
  Result := FDataSet.Fields[FieldNo - 1].AsdateTime;
End;

Function TEzProviderTable.Deleted: Boolean;
Begin
  with TEzGis(Gis) do
    if Assigned( Provider) and Assigned( Provider.OnGetIsDeleted) then
      Provider.OnGetIsDeleted( Provider, FDataSet, Result );
End;

Function TEzProviderTable.Field( FieldNo: integer ): String;
Begin
  result := FDataSet.Fields[FieldNo - 1].FieldName;
End;

Function TEzProviderTable.FieldCount: integer;
Begin
  result := FDataSet.Fields.Count;
End;

Function TEzProviderTable.FieldDec( FieldNo: integer ): integer;
Var
  Datatype: TFieldType;
Begin
  Datatype := FDataSet.Fields[FieldNo - 1].Datatype;
  If Datatype In ftNonTexttypes Then
    Result := 0
  Else
    Case Datatype Of
      ftstring{$IFDEF LEVEL4}, ftFixedChar,
      ftWidestring{$ENDIF}
{$IFDEF LEVEL5}, ftGUID{$ENDIF}:
        Result := 0;
      ftBCD:
        Result := FDataSet.Fields[FieldNo - 1].Size;
      ftFloat, ftCurrency,
        ftAutoInc, ftSmallInt, ftInteger, ftWord
{$IFNDEF LEVEL3}, ftLargeInt{$ENDIF}:
        Result := 0;
      ftDate, ftTime, ftDateTime:
        Result := 0;
      ftBoolean:
        Result := 0;
    End;
End;

Function TEzProviderTable.FieldGet( Const FieldName: String ): String;
Begin
  result := FDataSet.FieldByName( FieldName ).AsString;
End;

Function TEzProviderTable.FieldGetN( FieldNo: integer ): String;
Begin
  result := FDataSet.Fields[FieldNo - 1].AsString;
End;

Function TEzProviderTable.FieldLen( FieldNo: integer ): integer;
Var
  Datatype: TFieldType;
Begin
  Datatype := FDataSet.Fields[FieldNo - 1].Datatype;
  If Datatype In ftNonTexttypes Then
    Result := 0
  Else
    Case Datatype Of
      ftstring{$IFDEF LEVEL4}, ftFixedChar,
      ftWidestring{$ENDIF}
{$IFDEF LEVEL5}, ftGUID{$ENDIF}:
        Result := FDataSet.Fields[FieldNo - 1].Size;
      ftFloat, ftCurrency, ftBCD,
        ftAutoInc, ftSmallInt, ftInteger, ftWord
{$IFNDEF LEVEL3}, ftLargeInt{$ENDIF}:
        Result := 20;
      ftDate, ftTime, ftDateTime:
        Result := 0;
      ftBoolean:
        Result := 0;
    End;
End;

Function TEzProviderTable.FieldNo( Const FieldName: String ): integer;
Var
  Field: TField;
Begin
  Field := FDataSet.FindField( FieldName );
  If Field = Nil Then
    Result := 0
  Else
    Result := Field.Index + 1;
End;

Function TEzProviderTable.FieldType( FieldNo: integer ): char;
Var
  Datatype: TFieldType;
Begin
  Datatype := FDataSet.Fields[FieldNo - 1].Datatype;
  If Datatype In ftNonTexttypes Then
  Begin
    Case DataType Of
      ftMemo, ftFmtMemo: Result := 'M';
      ftGraphic: Result := 'G';
      ftTypedBinary: Result := 'B';
    End;
  End
  Else
    Case Datatype Of
      ftstring{$IFDEF LEVEL4}, ftFixedChar,
      ftWidestring{$ENDIF}
{$IFDEF LEVEL5}, ftGUID{$ENDIF}:
        Result := 'C';
      ftFloat, ftCurrency, ftBCD,
        ftAutoInc, ftSmallInt, ftInteger, ftWord
{$IFNDEF LEVEL3}, ftLargeInt{$ENDIF}:
        Result := 'N';
      ftDate, ftTime, ftDateTime:
        Result := 'D';
      ftBoolean:
        Result := 'L';
    End;
End;

Function TEzProviderTable.Find( Const ss: String; IsExact, IsNear: boolean ): boolean;
Begin
  // this procedure must be done in database specific methods
End;

Function TEzProviderTable.FloatGet( Const Fieldname: String ): Double;
Begin
  result := FDataSet.FieldByName( FieldName ).Asfloat;
End;

Function TEzProviderTable.FloatGetN( FieldNo: Integer ): Double;
Begin
  result := FDataSet.Fields[FieldNo - 1].Asfloat;
End;

Function TEzProviderTable.IndexCount: integer;
Begin
  // this procedure must be done in database specific methods
End;

Function TEzProviderTable.IndexAscending( Value: integer ): boolean;
Begin
  // this procedure must be done in database specific methods
End;

Function TEzProviderTable.Index( Const INames, Tag: String ): integer;
Begin
  // this procedure must be done in database specific methods
End;

Function TEzProviderTable.IndexCurrent: String;
Begin
  // this procedure must be done in database specific methods
End;

Function TEzProviderTable.IndexUnique( Value: integer ): boolean;
Begin
  // this procedure must be done in database specific methods
End;

Function TEzProviderTable.IndexExpression( Value: integer ): String;
Begin
  // this procedure must be done in database specific methods
End;

Function TEzProviderTable.IndexTagName( Value: integer ): String;
Begin
  // this job must be done in database specific methods
End;

Function TEzProviderTable.IndexFilter( Value: integer ): String;
Begin
  // this job must be done in database specific methods
End;

Function TEzProviderTable.IntegerGet( Const FieldName: String ): Integer;