⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 eztable.pas

📁 很管用的GIS控件
💻 PAS
📖 第 1 页 / 共 5 页
字号:
    FreeMem( PRecordInfo( Buffer + FDataSize )^.BookMark );
    PRecordInfo( Buffer + FDataSize )^.BookMark := Nil;
  End;
End;

Procedure TEzBaseDataset.AllocateBLOBPointers( Buffer: PChar );
Var
  Index: Integer;
  Offset: Integer;
  //Stream: TMemoryStream;
  P: Pointer;
Begin
  For Index := 0 To FieldCount - 1 Do
    If Fields[Index].DataType In [ftMemo, ftGraphic] Then
    Begin
      Offset := Integer( FBufferMap.Objects[Index] );
      //Stream:=TMemoryStream.Create;
      //Move(Pointer(Stream),(Buffer+Offset)^,sizeof(Pointer));
      // get the pointer to the blob field
      AllocateBlobPointer( Fields[Index], P );
      Move( P, ( Buffer + Offset )^, sizeof( Pointer ) );
    End;
End;

Procedure TEzBaseDataset.FreeBlobPointers( Buffer: PChar );
Var
  Index: Integer;
  Offset: Integer;
  P: Pointer;
Begin
  For Index := 0 To FieldCount - 1 Do
    If Fields[Index].DataType In [ftMemo, ftGraphic] Then
    Begin
      Offset := Integer( FBufferMap.Objects[Index] );
      Move( ( Buffer + Offset )^, Pointer( P ), sizeof( Pointer ) );
      FreeBlobPointer( Fields[Index], P );
      //if FreeAndNil<>nil then FreeAndNil.Free;
      P := Nil;
      Move( P, ( Buffer + Offset )^, sizeof( Pointer ) );
    End;
End;

Procedure TEzBaseDataset.AllocateBLOBPointer( Field: TField; Var P: Pointer );
Begin
  P := Nil;
End;

Procedure TEzBaseDataset.FreeBLOBPointer( Field: TField; Var P: Pointer );
Begin
  P := Nil;
End;

Procedure TEzBaseDataset.InternalInitFieldDefs;
Begin
  DoCreateFieldDefs;
End;

Procedure TEzBaseDataset.ClearCalcFields( Buffer: PChar );
Begin
  FillChar( Buffer[FStartCalculated], CalcFieldsSize, 0 );
End;

Function TEzBaseDataset.GetActiveRecordBuffer: PChar;
Begin
  Case State Of
    dsBrowse: If isEmpty Then
        Result := Nil
      Else
        Result := ActiveBuffer;
    dsCalcFields: Result := CalcBuffer;
    dsFilter: Result := Nil;
    dsEdit, dsInsert: Result := ActiveBuffer;
    dsNewValue, dsOldValue, dsCurValue: Result := ActiveBuffer;
{$IFDEF level5}
    dsBlockRead: Result := ActiveBuffer;
{$ENDIF}
  Else
    Result := Nil;
  End;
End;

Function TEzBaseDataset.GetCanModify: Boolean;
Begin
  Result := False;
End;

Function TEzBaseDataset.GetRecord( Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean ): TGetResult;
Begin
  Result := Navigate( Buffer, GetMode, DoCheck );
  If ( Result = grOk ) Then
  Begin
    RecordToBuffer( Buffer );
    ClearCalcFields( Buffer );
    GetCalcFields( Buffer );
  End
  Else If ( Result = grError ) And DoCheck Then
    DatabaseError( 'No Records' );
End;

Function TEzBaseDataset.GetRecordSize: Word;
Begin
  FDataSize := GetDataSize;
  Result := FDataSize + sizeof( TRecordInfo ) + CalcFieldsSize;
  FStartCalculated := FDataSize + sizeof( TRecordInfo );
End;

Function TEzBaseDataset.GetDataSize: Integer;
Var
  Index: Integer;
Begin
  Result := 0;
  For Index := 0 To FieldCount - 1 Do
    Case Fields[Index].DataType Of
      ftString: Result := Result + Fields[Index].Size + 1; //Leave space for terminating null
      ftInteger, ftSmallInt, ftDate, ftTime: Result := Result + sizeof( Integer );
      ftFloat, ftCurrency, ftBCD, ftDateTime: Result := Result + sizeof( Double );
      ftBoolean: Result := Result + sizeof( WordBool );
      ftMemo, ftGraphic: Result := Result + sizeof( Pointer );
    End;
End;

Procedure TEzBaseDataset.InternalClose;
Begin
  BindFields( False );
  If DefaultFields Then
    DestroyFields;
  DoClose;
  FisOpen := False;
End;

Procedure TEzBaseDataset.InternalDelete;
Begin
  DoDeleteRecord;
End;

Procedure TEzBaseDataset.InternalEdit;
Begin
  If GetActiveRecordBuffer <> Nil Then
    InternalSetToRecord( GetActiveRecordBuffer );
End;

Procedure TEzBaseDataset.InternalFirst;
Begin
  DoFirst;
End;

Procedure TEzBaseDataset.InternalHandleException;
Begin
  Application.HandleException( Self );
End;

{This is called by the TDataset to initialize an already existing buffer.
We cannot just fill the buffer with 0s since that would overwrite our BLOB pointers.
Therefore we free the blob pointers first, then fill the buffer with zeros, then
reallocate the blob pointers}

Procedure TEzBaseDataset.InternalInitRecord( Buffer: PChar );
Begin
  FreeRecordPointers( Buffer );
  FillChar( Buffer^, FRecordSize, 0 );
  AllocateBlobPointers( Buffer );
End;

Procedure TEzBaseDataset.InternalInsert;
Begin

End;

Procedure TEzBaseDataset.InternalLast;
Begin
  DoLast;
End;

Procedure TEzBaseDataset.InternalPost;
Begin
  If FisOpen Then
  Begin
    DoBeforeSetFieldValue( State = dsInsert );
    BufferToRecord( GetActiveRecordBuffer );
    DoAfterSetFieldValue( State = dsInsert );
  End;
End;

Procedure TEzBaseDataset.InternalAddRecord( Buffer: Pointer; Append: Boolean );
Begin
  If Append Then
    InternalLast;
  DoBeforeSetFieldValue( True );
  BufferToRecord( Buffer );
  DoAfterSetFieldValue( True );
End;

Procedure TEzBaseDataset.InternalSetToRecord( Buffer: PChar );
Begin
  GotoRecordID( PRecordInfo( Buffer + FDataSize ).RecordID );
End;

Function TEzBaseDataset.IsCursorOpen: Boolean;
Begin
  Result := FisOpen;
End;

Procedure TEzBaseDataset.BufferToRecord( Buffer: PChar );
Var
  TempStr: String;
  TempInt: Integer;
  TempDouble: Double;
  TempBool: WordBool;
  Offset: Integer;
  Index: Integer;
  //Stream: TStream;
Begin
  For Index := 0 To FieldCount - 1 Do
  Begin
    Offset := Integer( FBufferMap.Objects[Fields[Index].FieldNo - 1] );
    Case Fields[Index].DataType Of
      ftString:
        Begin
          TempStr := PChar( Buffer + Offset );
          SetFieldValue( Fields[Index], TempStr );
        End;
      ftInteger, ftSmallInt, ftDate, ftTime:
        Begin
          Move( ( Buffer + Offset )^, TempInt, sizeof( Integer ) );
          SetFieldValue( Fields[Index], TempInt );
        End;
      ftFloat, ftBCD, ftCurrency, ftDateTime:
        Begin
          Move( ( Buffer + Offset )^, TempDouble, sizeof( Double ) );
          SetFieldValue( Fields[Index], TempDouble );
        End;
      ftBoolean:
        Begin
          Move( ( Buffer + Offset )^, TempBool, sizeof( Boolean ) );
          SetFieldValue( Fields[Index], TempBool );
        End;
      ftGraphic, ftMemo:
        Begin
          {Move( ( Buffer + Offset )^, Pointer( Stream ), sizeof( Pointer ) );
          Stream.Position := 0;
          SetBlobField( Fields[Index], Stream );}
        End;
    End;
  End;
End;

Procedure TEzBaseDataset.RecordToBuffer( Buffer: PChar );
Var
  Value: Variant;
  TempStr: String;
  TempInt: Integer;
  TempDouble: Double;
  TempBool: WordBool;
  Offset: Integer;
  Index: Integer;
  //Stream: TStream;
Begin
  With PRecordInfo( Buffer + FDataSize )^ Do
  Begin
    BookmarkFlag := bfCurrent;
    RecordID := AllocateRecordID;
    If BookmarkSize > 0 Then
    Begin
      If BookMark = Nil Then
        GetMem( BookMark, BookmarkSize );
      AllocateBookMark( RecordID, BookMark );
    End
    Else
      BookMark := Nil;
  End;
  DoBeforeGetFieldValue;
  For Index := 0 To FieldCount - 1 Do
  Begin
    If Not ( Fields[Index].DataType In [ftMemo, ftGraphic] ) Then
      Value := GetFieldValue( Fields[Index] );
    if Fields[Index].FieldNo < 0 then Continue;
    Offset := Integer( FBufferMap.Objects[Fields[Index].FieldNo - 1] );
    Case Fields[Index].DataType Of
      ftString:
        Begin
          If VarIsNull( Value ) Then
            TempStr := ''
          Else
            TempStr := Value;
          If length( TempStr ) > Fields[Index].Size Then
            System.Delete( TempStr, Fields[Index].Size, length( TempStr ) - Fields[Index].Size );
          StrLCopy( PChar( Buffer + Offset ), PChar( TempStr ), length( TempStr ) );
        End;
      ftInteger, ftSmallInt, ftDate, ftTime:
        Begin
          If VarIsNull( Value ) Then
            TempInt := 0
          Else
            TempInt := Value;
          Move( TempInt, ( Buffer + Offset )^, sizeof( TempInt ) );
        End;
      ftFloat, ftBCD, ftCurrency, ftDateTime:
        Begin
          If VarIsNull( Value ) Then
            TempDouble := 0
          Else
            TempDouble := Value;
          Move( TempDouble, ( Buffer + Offset )^, sizeof( TempDouble ) );
        End;
      ftBoolean:
        Begin
          If VarIsNull( Value ) Then
            TempBool := false
          Else
            TempBool := Value;
          Move( TempBool, ( Buffer + Offset )^, sizeof( TempBool ) );
        End;
      ftMemo, ftGraphic:
        Begin
          {
          Move( ( Buffer + Offset )^, Pointer( Stream ), sizeof( Pointer ) );
          if Stream <> Nil then
          begin
            Stream.Size := 0;
            Stream.Position := 0;
            GetBlobField( Fields[Index], Stream );
          end; }
        End;
    End;
  End;
  DoAfterGetFieldValue;
End;

Procedure TEzBaseDataset.DoDeleteRecord;
Begin
  //Nothing in base class
End;

Function TEzBaseDataset.GetFieldData( Field: TField; Buffer: Pointer ): Boolean;
Var
  RecBuffer: PChar;
  Offset: Integer;
  TempDouble: Double;
  Data: TDateTimeRec;
  TimeStamp: TTimeStamp;
  TempBool: WordBool;
  TempInt: Integer;
Begin
  Result := false;
  If Not FisOpen Then Exit;
  RecBuffer := GetActiveRecordBuffer;
  If RecBuffer = Nil Then Exit;
  If Buffer = Nil Then
  Begin
    //Dataset checks if field is null by passing a nil buffer
    //Tell it is not null by passing back a result of True
    Result := True;
    exit;
  End;
  If ( Field.FieldKind = fkCalculated ) Or ( Field.FieldKind = fkLookup ) Then
  Begin
    inc( RecBuffer, FStartCalculated + Field.Offset );
    If ( RecBuffer[0] = #0 ) Or ( Buffer = Nil ) Then
      exit
    Else
      CopyMemory( Buffer, @RecBuffer[1], Field.DataSize );
  End
  Else
  Begin
    Offset := Integer( FBufferMap.Objects[Field.FieldNo - 1] );
    Case Field.DataType Of
      ftInteger:
        Move( ( RecBuffer + Offset )^, Integer( Buffer^ ), sizeof( Integer ) );
      ftTime, ftDate:
        begin
        Move( ( RecBuffer + Offset )^, TempInt, sizeof( Integer ) );
        If TempInt = 0 then
          TempInt:= 693594;
        Move( TempInt, Integer( Buffer^ ), sizeof( Integer ) );
        end;
      ftBoolean:
        Begin
          Move( ( RecBuffer + Offset )^, TempBool, sizeof( WordBool ) );
          Move( TempBool, WordBool( Buffer^ ), sizeof( WordBool ) );
        End;
      ftString:
        Begin
          StrLCopy( Buffer, PChar( RecBuffer + Offset ), StrLen( PChar( RecBuffer + Offset ) ) );
          StrPCopy( Buffer, TrimRight( StrPas( Buffer ) ) );
        End;
      ftCurrency, ftFloat: Move( ( RecBuffer + Offset )^, Double( Buffer^ ), sizeof( Double ) );
      ftDateTime:
        Begin
          Move( ( RecBuffer + Offset )^, TempDouble, sizeof( Double ) );
          TimeStamp := DateTimeToTimeStamp( TempDouble );
          Data.DateTime := TimeStampToMSecs( TimeStamp );
          Move( Data, Buffer^, sizeof( TDateTimeRec ) );
        End;
    End;
  End;
  Result := True;
End;

Procedure TEzBaseDataset.SetFieldData( Field: TField; Buffer: Pointer );
Var
  Offset: Integer;
  RecBuffer: Pchar;
  TempDouble: Double;
  Data: TDateTimeRec;
  TimeStamp: TTimeStamp;
  TempBool: WordBool;
Begin
  If Not Active Then exit;
  RecBuffer := GetActiveRecordBuffer;
  If RecBuffer = Nil Then exit;
  If Buffer = Nil Then exit;
  If ( Field.FieldKind = fkCalculated ) Or ( Field.FieldKind = fkLookup ) Then
  Begin
    Inc( RecBuffer, FStartCalculated + Field.Offset );
    Boolean( RecBuffer[0] ) := ( Buffer <> Nil );
    If Boolean( RecBuffer[0] ) Then
      CopyMemory( @RecBuffer[1], Buffer, Field.DataSize );
  End
  Else
  Begin
    Offset := Integer( FBufferMap.Objects[Field.FieldNo - 1] );
    Case Field.DataType Of
      ftInteger, ftDate, ftTime: Move( Integer( Buffer^ ), ( RecBuffer + Offset )^, sizeof( Integer ) );
      ftBoolean:
        Begin
          Move( WordBool( Buffer^ ), TempBool, sizeof( WordBool ) );
          Move( TempBool, ( RecBuffer + Offset )^, sizeof( WordBool ) );
        End;
      ftString: StrLCopy( PChar( RecBuffer + Offset ), Buffer, StrLen( PChar( Buffer ) ) );
      ftDateTime:
        Begin
          Data := TDateTimeRec( Buffer^ );
          TimeStamp := MSecsToTimeStamp( Data.DateTime );
          TempDouble := TimeStampToDateTime( TimeStamp );
          Move( TempDouble, ( RecBuffer + Offset )^, sizeof( TempDouble ) );
        End;
      ftFloat, ftCurrency: Move( Double( Buffer^ ), ( RecBuffer + Offset )^, sizeof( Double ) );
    End;
  End;
  If Not ( State In [dsCalcFields, dsFilter, dsNewValue] ) Then
    DataEvent( deFieldChange, Longint( Field ) );
End;

Function TEzBaseDataset.GetBookMarkSize: Integer;
Begin
  Result := 0;
End;

Procedure TEzBaseDataset.GetBookmarkData( Buffer: PChar; Data: Pointer );
Begin
  If BookMarkSize > 0 Then
    AllocateBookMark( PRecordInfo( Buffer + FDataSize ).RecordID, Data );
End;

Function TEzBaseDataset.GetBookmarkFlag( Buffer: PChar ): TBookmarkFlag;
Begin
  Result := PRecordInfo( Buffer + FDataSize ).BookMarkFlag;
End;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -