ezimpl.pas

很管用的GIS控件

  FTable.FieldByname( Fieldname ).asboolean := value;
End;

Procedure TEzBDETable.LogicPutN( fieldno: integer; value: boolean );
Begin
  FTable.fields[fieldno - 1].asboolean := value;
End;

Procedure TEzBDETable.MemoLoad( Const fieldname: String; Stream: TStream );
Var
  field: TField;
Begin
  field := FTable.FindField( Fieldname );
  If field = Nil Then Exit;
  MemoLoadN( field.index + 1, Stream );
End;

Procedure TEzBDETable.MemoLoadN( fieldno: integer; Stream: TStream );
Begin
  Stream.Position:= 0;
  (FTable.Fields[FieldNo-1] as TBlobField).SaveToStream( Stream );
End;

Procedure TEzBDETable.Next;
Begin
  FTable.Next;
End;

Procedure TEzBDETable.Pack;
var
  OldVal: Boolean;
Begin
  // Ensure table is exclusive
   if not FTable.Active then FTable.Open;
   OldVal:= FTable.Exclusive;
   if not FTable.Exclusive then FTable.Exclusive:= True;

   Check( DbiPackTable( FTable.DBHandle, FTable.Handle, nil, szDBASE, True ) );

   FTable.Exclusive:= OldVal;
End;

Procedure TEzBDETable.Post;
Begin
  FTable.Post;
End;

Procedure TEzBDETable.Prior;
Begin
  FTable.Prior;
End;

Procedure TEzBDETable.Recall;
Begin
  FTable.UpdateCursorPos;
  DbiUndeleteRecord(FTable.Handle);
End;

Procedure TEzBDETable.Refresh;
Begin
  FTable.Refresh;
End;

Procedure TEzBDETable.Reindex;
Begin
  // nothing to do
End;

Procedure TEzBDETable.SetTagTo( Const TName: String );
Begin
  FTable.IndexName := TName;
End;

Procedure TEzBDETable.SetUseDeleted( tf: boolean );
var
  rslt: DBIResult;
  szErrMsg: DBIMSG;
Begin
  try
    FTable.DisableControls;
    try
      rslt := DbiSetProp(hDBIObj(FTable.Handle), curSOFTDELETEON, LongInt(tf));
      if rslt <> DBIERR_NONE then
      begin
        DbiGetErrorString(rslt, szErrMsg);
        raise Exception.Create(StrPas(szErrMsg));
      end;
    except
      on E: EDBEngineError do MessageToUser( E.Message, sMsgError, MB_ICONERROR );
      on E: Exception do MessageToUser( E.Message, sMsgError, MB_ICONERROR );
    end;
  finally
    FTable.Refresh;
    FTable.EnableControls;
  end;
End;

Procedure TEzBDETable.StringPut( Const fieldname, value: String );
Begin
  FTable.FieldByname( fieldname ).Asstring := value;
End;

Procedure TEzBDETable.StringPutN( fieldno: integer; Const value: String );
Begin
  FTable.Fields[Fieldno - 1].Asstring := value;
End;

Procedure TEzBDETable.Zap;
Begin
  FTable.EmptyTable;
End;

{$ENDIF}



{$IFDEF DBISAMDB}

//************************ DBISAM database implementation **********************

Type

  TEzDBISAMTable = Class( TEzBaseTable )
  Private
    FDBISAMTable: TDBISAMTable;
  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 CopyStructure( Const FileName, APassword: String ); Override;
    //Procedure CopyTo( Const FileName, APassword: 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;
    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;
  End;

//************************ DBISAM database implementation **********************

Function TEzDBISAMTable.DBRenameTable( const Source, Target: string): Boolean;
begin
  if FileExists( Source + '.dat' ) then
    SysUtils.RenameFile( Source + '.dat', Target + '.dat');
  if FileExists( Source + '.idx' ) then
    SysUtils.RenameFile( Source + '.idx', Target + '.idx');
  if FileExists( Source + '.blb' ) then
    SysUtils.RenameFile( Source + '.blb', Target + '.blb');
end;

Function TEzDBISAMTable.DBDropIndex( const TableName: string): Boolean;
begin
  // not used
end;

Function TEzDBISAMTable.DBDropTable( const TableName: string): Boolean;
begin
  SysUtils.DeleteFile( Tablename + '.dat' );
  SysUtils.DeleteFile( Tablename + '.idx' );
  SysUtils.DeleteFile( Tablename + '.blb' );
end;

function TEzDBISAMTable.DBTableExists( const TableName: string ): Boolean;
begin
  Result:= FileExists( ChangeFileExt( TableName, '.dat' ) );
end;

Function TEzDBISAMTable.DBCreateTable( Const fname: String; AFieldList: TStringList ): boolean;
Var
  s: String;
  v: boolean;
  i: integer;
  p: integer;
  fs: String;
  ft: String[1];
  fl: integer;
  fd: integer;

  Procedure LoadField;
  Begin
    v := true;
    p := Ansipos( ';', s );
    fs := '';
    If p > 0 Then
    Begin
      fs := System.Copy( s, 1, pred( p ) );
      System.Delete( s, 1, p );
    End
    Else
      v := false;

    p := Ansipos( ';', s );
    ft := ' ';
    If p = 2 Then
    Begin
      ft := System.Copy( s, 1, 1 );
      System.Delete( s, 1, p );
    End
    Else
      v := false;

    p := Ansipos( ';', s );
    fl := 0;
    If p > 0 Then
    Begin
      Try
        fl := StrToInt( System.Copy( s, 1, pred( p ) ) );
        System.Delete( s, 1, p );
      Except
        On Exception Do
          v := false;
      End;
    End
    Else
      v := false;

    fd := 0;
    Try
      fd := StrToInt( System.Copy( s, 1, 3 ) );
    Except
      On Exception Do
        v := false;
    End;
  End;

Begin
  { create a DBISAM table (.DAT and .IDX files }
  With TDBISAMTable.Create( Nil ) Do
  Try
    Databasename := ExtractFilePath( fname );
    TableName := ChangeFileExt( ExtractFileName( fname ), '' );
    With FieldDefs Do
    Begin
      Clear;
      Add( 'UID', ftInteger, 0, False );
      Add( 'DELETED', ftBoolean, 0, False );
      For I := 0 To AFieldList.count - 1 Do
      Begin
        s:= AFieldList[I];
        LoadField;
        If Not v Then
          EzGisError( SErrWrongField );
        Case ft[1] Of
          'C':
            Add( fs, ftString, fl, False );
          'F', 'N':
            If fd = 0 Then
              Add( fs, ftInteger, 0, False )
            Else
              Add( fs, ftFloat, 0, False );
          'M':
            Add( fs, ftMemo, 0, False );
          'G':
            Add( fs, ftGraphic, 0, False );
          'B':
            Add( fs, ftTypedBinary, 0, False );
          'L':
            Add( fs, ftBoolean, 0, False );
          'D':
            Add( fs, ftDate, 0, False );
          'T':
            Add( fs, ftTime, 0, False );
          'I':
            Add( fs, ftInteger, 0, False );
        End;
      End;
    End;
    With IndexDefs Do
    Begin
      Clear;
      Add( '', 'UID', [ixPrimary] );
    End;
    If Not Exists Then
      CreateTable;
  Finally
    Free;
  End;
End;

Constructor TEzDBISAMTable.Create( Gis: TEzBaseGIS; Const FName: String;
  ReadWrite, Shared: boolean );
Begin
  inherited Create( Gis, FName, ReadWrite, Shared );
  if Length(FName) > 0 then
  begin
    FDBISAMTable := TDBISAMTable.Create( Nil );
    With FDBISAMTable Do
    Begin
      DatabaseName := ExtractFilePath( FName );
      TableName := ChangeFileExt( ExtractFileName( FName ), '' );
      ReadOnly := Not ReadWrite;
      Exclusive := Not Shared;
      Open;
    End;
  end;
End;

Destructor TEzDBISAMTable.Destroy;
Begin
  FDBISAMTable.Free;
  Inherited Destroy;
End;

Function TEzDBISAMTable.GetActive: boolean;
Begin
  result := FDBISAMTable.Active;
End;

Procedure TEzDBISAMTable.SetActive( Value: boolean );
Begin
  FDBISAMTable.Active := value;
End;

Function TEzDBISAMTable.GetRecNo: Integer;
Begin
  result := FDBISAMTable.FieldByName( 'UID' ).AsInteger;
End;

Procedure TEzDBISAMTable.SetRecNo( Value: Integer );
Begin
  if FDBISAMTable.IndexName <> '' then
  begin
    FDBISAMTable.IndexName := ''; // primary index
    If Not FDBISAMTable.FindKey( [Value] ) Then
      EzGisError( 'Record not found !' );
  end else
  begin
    if FDBISAMTable.FieldByName( 'UID' ).AsInteger <> Value then
    begin
      If Not FDBISAMTable.FindKey( [Value] ) Then
        EzGisError( 'Record not found !' );
    end;
  end;
End;

Procedure TEzDBISAMTable.Append( NewRecno: Integer );
Begin
  FDBISAMTable.Insert;
  FDBISAMTable.FieldByName( 'UID' ).AsInteger := NewRecno;
  FDBISAMTable.Post;
End;

Function TEzDBISAMTable.BOF: Boolean;
Begin
  result := FDBISAMTable.BOF;
End;

Function TEzDBISAMTable.EOF: Boolean;
Begin
  result := FDBISAMTable.EOF;
End;

Function TEzDBISAMTable.DateGet( Const FieldName: String ): TDateTime;
Begin
  result := FDBISAMTable.FieldByName( FieldName ).AsDateTime;
End;

Function TEzDBISAMTable.DateGetN( FieldNo: integer ): TDateTime;
Begin
  result := FDBISAMTable.Fields[FieldNo - 1].AsdateTime;
End;

Function TEzDBISAMTable.Deleted: Boolean;
Begin
  result := False;
End;

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

Function TEzDBISAMTable.FieldCount: integer;
Begin
  result := FDBISAMTable.Fields.Count;
End;