eztable.pas

很管用的GIS控件

    End;
    If Accepted Then
      FRecords.Add( K );
  End;
  If DoFilter Then
    Filtered := False;
  FGraphicFilterList.Clear;
  FRecordCount := FRecords.Count;

End;

Procedure TEzTable.DoClose;
Begin
  FRecords.Clear;
  If Assigned( FFilterExpr ) Then
    FreeAndNil( FFilterExpr );
  If Assigned( FFindExpr ) Then
    FreeAndNil( FFindExpr );
  FGraphicFilterList.Clear;
  FGraphicFiltered := False;
End;

Procedure TEzTable.AllocateBookMark( RecordID, Bookmark: Pointer );
Begin
  PInteger( Bookmark )^ := Integer( RecordID );
End;

Function TEzTable.AllocateRecordID: Pointer;
Begin
  Result := Pointer( FCurRec );
End;

Procedure TEzTable.DisposeRecordID( Value: Pointer );
Begin
  // Do nothing, no need to dispose since pointer is just an integer
End;

Procedure TEzTable.GotoRecordID( Value: Pointer );
Var
  n: Integer;
Begin
  FCurRec := Integer( Value );
  n := FRecords[FCurRec];
  FLayer.Recno := n;
  FLayer.Synchronize;
End;

Procedure TEzTable.AddFieldDesc( FieldNo: Word );
Var
  iFldType: TFieldType;
  Size: Word;
  Name: String;
  typ: char;
Begin
  If FieldNo <= 0 Then Exit;
  Name := FLayer.DBTable.Field( FieldNo );
  Size := 0;
  Typ := FLayer.DBTable.FieldType( FieldNo );
  Case Typ Of
    'C':
      Begin
        iFldType := ftString; { Char string }
        Size := FLayer.DBTable.FieldLen( FieldNo );
      End;
    'F', 'N':
      Begin
        If ( FLayer.DBTable.FieldDec( FieldNo ) > 0 ) Then
        Begin
          iFldType := ftFloat; { Number }
        End
        Else If ( FLayer.DBTable.FieldLen( FieldNo ) > 4 ) Then
        Begin
          iFldType := ftInteger;
        End
        Else
        Begin
          iFldType := ftSmallInt;
        End;
      End;
    'M':
      Begin
        iFldType := ftMemo;
      End;
    'G',
      'B':
      Begin
        iFldType := ftBlob;
      End;
    'L':
      Begin
        iFldType := ftBoolean; { Logical }
      End;
    'D':
      Begin
        iFldType := ftDate; { Date }
      End;
    'I':
      Begin
        iFldType := ftInteger; {VFP integer}
      End;
    'T':
      Begin
        iFldType := ftDateTime; {VFP datetime}
      End;
  Else
    iFldType := ftUnknown;
  End;
  If iFldType <> ftUnknown Then
    FieldDefs.Add( Name, iFldType, Size, false );
End;

Procedure TEzTable.DoCreateFieldDefs;
Var
  I, P: Integer;
  DataType: TFieldType;
  ASize: Word;

  Function UniqueFieldName( Const Value: String ): String;
  Var
    found: Boolean;
    NumTry, J: Integer;
  Begin
    result := Value;
    Numtry := 0;
    Repeat
      Found := False;
      For J := 0 To FieldDefs.Count - 1 Do
        If AnsiCompareText( FieldDefs[J].Name, result ) = 0 Then
        Begin
          Found := True;
          Break;
        End;
      If Found Then
      Begin
        Inc( Numtry );
        result := Value + '_' + IntToStr( Numtry );
      End;
    Until Not Found;
  End;

Begin
  FieldDefs.Clear;
  For I := 0 To FMapFields.Count - 1 Do
    With FMapFields[I] Do
    Begin
      If IsExpression Then
      Begin
        FreeAndNil( FResolver );
        FResolver := TEzMainExpr.Create( FGIS, FLayer );
        FResolver.ParseExpression( Expression );
        ASize := 0;
        Case FResolver.Expression.ExprType Of
          ttString:
            Begin
              DataType := ftString;
              ASize := FResolver.Expression.MaxLen;
              If ASize = 0 Then
                ASize := 10;
            End;
          ttFloat:
            DataType := ftFloat;
          ttInteger:
            DataType := ftInteger;
          ttBoolean:
            DataType := ftBoolean;
        Else
          DataType := ftString;
        End;
        P:= AnsiPos('.', FieldName);
        if P > 0 then
          FieldName:= Copy(FieldName,P+1,Length(FieldName));
        FieldName := UniqueFieldName( FieldName );
        FieldDefs.Add( FieldName, DataType, ASize, false );
        {FldDef:= FieldDefs.AddFieldDef;
        FldDef.Name:= FieldName;
        FldDef.DataType:= DataType;
        FldDef.Size:= ASize;
        FldDef.Required:= False;}
      End
      Else If FLayer.DBTable <> Nil Then
      Begin
        AddFieldDesc( FLayer.DBTable.FieldNo( FieldName ) );
        {FieldName:= FieldName;
        SourceField:= FLayer.DBTable.FieldNo(FieldName);
        FldDef:= FieldDefs.AddFieldDef;
        FldDef.Name:= FLayer.DBTable.Field(SourceField);
        FldDef.DataType:= SourceField.DataType;
        FldDef.Size:= SourceField.Size;
        FldDef.Required:= SourceField.Required;
        if SourceField.DataType = ftBCD then
        begin
          FldDef.Size:= TBCDField(SourceField).Size;
          FldDef.Precision:= TBCDField(SourceField).Precision;
        end; }
      End;
    End;
End;

Procedure TEzTable.DoDeleteRecord;
Begin
  UpdateCursorPos;
  FLayer.DeleteEntity( SourceRecNo );
End;

Procedure TEzTable.DoFirst;
Begin
  FCurRec := -1;
End;

Procedure TEzTable.DoGotoBookmark( Bookmark: Pointer );
Begin
  GotoRecordID( Pointer( PInteger( Bookmark )^ ) );
End;

Procedure TEzTable.DoLast;
Begin
  FCurRec := FRecordCount;
End;

Function TEzTable.GetBookMarkSize: Integer;
Begin
  Result := sizeof( Integer );
End;

Function TEzTable.DoBookmarkValid( Bookmark: TBookmark ): boolean;
Begin
  result := ( PInteger( Bookmark )^ > 0 ) And ( PInteger( Bookmark )^ <= FRecordCount );
End;

Function TEzTable.DoCompareBookmarks( Bookmark1, Bookmark2: TBookmark ): Integer;
Var
  b1, b2: integer;
Begin
  b1 := PInteger( Bookmark1 )^;
  b2 := PInteger( Bookmark2 )^;
  If b1 = b2 Then
    Result := 0
  Else If b1 < b2 Then
    Result := -1
  Else
    Result := 1;
End;

Function TEzTable.Locate( Const KeyFields: String; Const KeyValues: Variant;
  Options: TLocateOptions ): Boolean;
Begin
  result := false;
End;

Function TEzTable.Lookup( Const KeyFields: String;
  Const KeyValues: Variant; Const ResultFields: String ): Variant;
Begin
  result := '';
End;

Function TEzTable.GetFieldValue( Field: TField ): Variant;
Var
  MapField: TEzGISField;
  s: String;
  Ft: Char;
  ADate: TDateTime;
Begin
  If FLayer.RecIsDeleted Then
  Begin
    Result := Null;
    Exit;
  End;
  if Field.FieldNo < 0 then
  begin
    Result:= Field.Value;
    exit;
  end;
  MapField := FMapFields[Field.FieldNo - 1];
  If MapField.IsExpression Then
  Begin
    With MapField.Resolver.Expression Do
      Case ExprType Of
        ttString: result := AsString;
        ttFloat: result := AsFloat;
        ttInteger: result := AsInteger;
        ttBoolean: result := AsBoolean;
      End;
  End
  Else If FLayer.DBTable <> Nil Then
  Begin
    // must be as variant
    Ft := FLayer.DBTable.FieldType( MapField.SourceField );
    Case Ft Of
      'C':
        Begin
          S := FLayer.DBTable.StringGetN( MapField.SourceField );
          If Length( Trim( s ) ) = 0 Then
            Result := Null
          Else
            Result := s;
        End;
      'D', 'T':
        Begin
        ADate:= FLayer.DBTable.DateGetN( MapField.SourceField );
        If ADate = 0 then
          ADate:= Now;
        Result := ADate;
        End;
      'L':
        Result := FLayer.DBTable.LogicGetN( MapField.SourceField );
      'N', 'F':
        Result := FLayer.DBTable.FloatGetN( MapField.SourceField );
      'I':
        Result := FLayer.DBTable.IntegerGetN( MapField.SourceField );
    End;
  End;
End;

Procedure TEzTable.SetFieldValue( Field: TField; Const Value: Variant );
Var
  MapField: TEzGISField;
Begin
  MapField := FMapFields[Field.FieldNo - 1];
  If MapField.IsExpression Then
    Exit;
  If Not ( FLayer.DBTable.FieldType( MapField.SourceField ) In ['M', 'B', 'G'] ) Then
  Begin
    FLayer.DBTable.Edit;
    FLayer.DBTable.FieldPutN( MapField.SourceField, Value );
    FLayer.DBTable.Post;
  End;
End;

Function TEzTable.Navigate( Buffer: PChar; GetMode: TGetMode; doCheck: Boolean ): TGetResult;
Var
  Acceptable: Boolean;
Begin
  If FRecordCount < 1 Then
    Result := grEOF
  Else
  Begin
    Result := grOK;
    Repeat
      Case GetMode Of
        gmNext:
          If FCurRec >= FRecordCount - 1 Then
            Result := grEOF
          Else
            Inc( FCurRec );
        gmPrior:
          If FCurRec <= 0 Then
          Begin
            Result := grBOF;
            FCurRec := -1;
          End
          Else
            Dec( FCurRec );
        gmCurrent:
          If ( FCurRec < 0 ) Or ( FCurRec >= FRecordCount ) Then
            Result := grError;
      End;
      Acceptable := FilterRecord( Buffer );
      If ( GetMode = gmCurrent ) And Not Acceptable Then
        Result := grError;
      If ( Result = grError ) And DoCheck Then
        DatabaseError( SGetRecordInvalid );
    Until ( Result <> grOk ) Or Acceptable;
  End;
End;

Function TEzTable.Find( Const Expression: String; Direction: TEzDirection;
  Origin: TEzOrigin ): Boolean;
Begin
  result := false;
  If ( FFindExpr <> Nil ) Then
    FreeAndNil( FFindExpr );
  If FRecordCount = 1 Then Exit;
  FFindExpr := TEzMainExpr.Create( FGIS, FLayer );
  Try
    FFindExpr.ParseExpression( Expression );
    If FFindExpr.Expression.ExprType <> ttBoolean Then
    Begin
      DatabaseErrorFmt( 'Expression [''%s''] is not of Boolean type', [Expression] );
      FreeAndNil( FFindExpr );
      Exit;
    End;
    If Origin = orEntire then
      result := DoFindFirst
    Else
    Begin

    End;
  Except
    FreeAndNil( FFindExpr );
  End;
End;

Function TEzTable.DoFindFirst: Boolean;
Var
  n: Integer;
Begin
  result := false;
  If FFindExpr = Nil Then Exit;
  UpdateCursorPos;
  FFindRow := 1;
  While FFindRow <= FRecordCount Do
  Begin
    n := FRecords[FFindRow - 1];
    FLayer.Recno := n;
    If Not Layer.RecIsDeleted Then
      With FGIS Do
      Begin
        FLayer.Synchronize;
        If FFindExpr.Expression.AsBoolean Then
        Begin
          Self.Recno := FFindRow;
          result := true;
          break;
        End;
      End;
    Inc( FFindRow );
  End;
  //if not result then
  //  DatabaseError(SRecordNotFound);
End;

Function TEzTable.FindNext: Boolean;
Var
  n: Longint;
Begin
  result := False;
  If FFindExpr = Nil Then Exit;
  UpdateCursorPos;
  Inc( FFindRow );
  While FFindRow <= FRecordCount Do
  Begin
    n := FRecords[FFindRow - 1];
    FLayer.Recno := n;
    If Not FLayer.RecIsDeleted Then
      With FGIS Do
      Begin
        FLayer.Synchronize;
        If FFindExpr.Expression.AsBoolean Then
        Begin
          Self.Recno := FFindRow;
          result := true;
          Break;
        End;
      End;
    Inc( FFindRow );
  End;
  //if not bfound then
  //  DatabaseError(SRecordNotFound);
End;

Function TEzTable.GetRecNo: Integer;
Begin
  UpdateCursorPos;
  If ( FCurRec = -1 ) And ( FRecordCount > 0 ) Then
    Result := 1
  Else
    Result := FCurRec + 1;
End;