dxdatasetbintree.pas

Well known and usefull component for delphi 7

   GetMem(Res,DXTabGetFieldSize(Field.FieldNo));
   FastMove((SrcBuffer+DXTabGetFieldOffset(Field.FieldNo))^,Res^,DXTabGetFieldSize(Field.FieldNo));
   Result:=Res;
end;

function TDXDataSetBinaryTree.GetFieldData(Field:TField;Buffer:Pointer):Boolean;
var
   SrcBuffer:PChar;
   Pc:PChar;

begin
   Result:=False;
   if not DXTabGetActiveBuffer(SrcBuffer) then Exit;
   if (not FIsOpen) or (SrcBuffer=nil) then Exit;
   if (((Field.FieldNo>0) and
      (Field.FieldKind<>fkCalculated) and
      (Field.FieldKind<>fkLookup)) or
      ((Field.FieldKind=fkCalculated) or
      (Field.FieldKind = fkLookup))) and
      (Assigned(SrcBuffer)) then begin
      if Field.FieldKind in [fkCalculated,fkLookup] then begin
         Inc(SrcBuffer,FStartCalculated+Field.Offset);
         if (SrcBuffer[0]=#0) or (Buffer=nil) then Exit
         else begin
            Pc:=@SrcBuffer[1];
            FastMove(Pc^,Buffer^,Field.DataSize);
         end;
         Result:=True;
      end
      else begin
         Result:=not IsFieldNull(Field.FieldNo);
         if Result and Assigned(Buffer) then begin
            if IsFieldNull(Field.FieldNo) then exit;
            if Field.DataType in [ftMemo,ftGraphic,ftBlob,ftVarBytes] then
               Result:=False
            else begin
               FastMove((SrcBuffer+DXTabGetFieldOffset(Field.FieldNo))^,Buffer^,DXTabGetFieldSize(Field.FieldNo));
               Result:=True;
            end;
         end;
      end;
   end;
end;

procedure TDXDataSetBinaryTree.SetFieldDataNoDataEvent(Field:TField;Buffer:Pointer);
var
   DestBuffer:PChar;

begin
   DXTabGetActiveBuffer(DestBuffer);
   if (Field.FieldNo>0) and
      (Assigned(Buffer)) and
      (Assigned(DestBuffer)) then
      FastMove(Buffer^,(DestBuffer+DXTabGetFieldOffset(Field.FieldNo))^,DXTabGetFieldSize(Field.FieldNo));
end;

procedure TDXDataSetBinaryTree.DataEvent(Event: TDataEvent; Info: Longint);
Begin
   inherited DataEvent(Event,Info)
End;

procedure TDXDataSetBinaryTree.SetFieldData(Field: TField; Buffer: Pointer);
var
   DestBuffer:PChar;
   Null:Boolean;
   Pc:PChar;

begin
   if not (State in dswritemodes) and
      not FIgnoreSetFieldChk then
{$IFDEF VER100}
      DatabaseError(SDataSetEditMode);
{$ELSE}
      DatabaseError(SDataSetEditMode,Self);
{$ENDIF}
   DXTabGetActiveBuffer(DestBuffer);
   if Field.FieldKind in [fkCalculated, fkLookup] then begin
      Inc(DestBuffer, FStartCalculated+Field.Offset);
      Boolean(DestBuffer[0]):=(Buffer<>nil);
      if Boolean(DestBuffer[0]) then begin
         Pc:=@DestBuffer[1];
         FastMove(Buffer^, Pc^, Field.DataSize);
      end;
   end
   else begin
      if (Field.FieldNo>0) and
         (Assigned(Buffer)) and
         (Assigned(DestBuffer)) then
         FastMove(Buffer^,(DestBuffer+DXTabGetFieldOffset(Field.FieldNo))^,DXTabGetFieldSize(Field.FieldNo));
      if not Assigned(buffer) then Null:=True
      else begin
         Null:=False;
      end;
      FastMove(Null,(DestBuffer+DXTabGetFieldOffset(Field.FieldNo)+DXTabGetFieldSize(Field.FieldNo))^,DXBoolSize);
   end;
   DataEvent(deFieldChange,Longint(Field)); // Causes InternalPost
end;

procedure TDXDataSetBinaryTree.GetBookmarkData(Buffer: PChar; Data: Pointer);
begin
  FIntBookmark:=0;
  if Data<>nil then begin
    PLongInt(Data)^:=PRecInfo(Buffer + FBookmarkInfoOffset)^.Bookmark;
    FIntBookmark:=PInteger(Data)^;
  end;
end;

function TDXDataSetBinaryTree.GetBookmarkFlag(Buffer: PChar): TBookmarkFlag;
begin 
  Result:=PRecInfo(Buffer + FBookmarkInfoOffset)^.BookmarkFlag;
end;

procedure TDXDataSetBinaryTree.InternalGotoBookmark(Bookmark: Pointer);
var
   Index:Integer;

begin
   if FDataList.Count=0 then exit;
   Index:=FDataList.GetIndexFromBookMark(PLongInt(Bookmark)^);
   if Index<>0 then FRecordPos:=Index
   else
{$IFDEF VER100}
      DatabaseError(SysUtils.Format(SBookmarkNotFound,[IntegerToString(Index)]));
{$ELSE}
      DatabaseError(SysUtils.Format(SBookmarkNotFound,[IntegerToString(Index)]),Self);
{$ENDIF}
end;

procedure TDXDataSetBinaryTree.InternalSetToRecord(Buffer: PChar);
var
   ReqBookmark:Integer;

begin
   ReqBookmark:=PRecInfo(Buffer+FBookmarkInfoOffset)^.Bookmark;
   InternalGotoBookmark(@ReqBookmark);
end;

procedure TDXDataSetBinaryTree.SetBookmarkData(Buffer: PChar; Data: Pointer);
begin
   if Data<>nil then PRecInfo(Buffer+FBookmarkInfoOffset)^.Bookmark:=PLongInt(Data)^
   else PRecInfo(Buffer+FBookmarkInfoOffset)^.Bookmark:=0;
end;

function TDXDataSetBinaryTree.BookmarkValid(Bookmark: Pointer): Boolean;
var
   ReqBookmark:Integer;

begin
   Result:=False;
   if Bookmark=nil then exit;
   ReqBookmark:=PLongInt(Bookmark)^;
   Result:=ReqBookmark>=0
end;

procedure TDXDataSetBinaryTree.SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag);
begin
   PRecInfo(Buffer+FBookmarkInfoOffset)^.BookmarkFlag:=Value;
end;

procedure TDXDataSetBinaryTree.InternalFirst;
begin
   FRecordPos:=0;
end;

procedure TDXDataSetBinaryTree.InternalInitFieldDefs;
begin
  // pull from the server a list of "field" and call AddField!
  If FieldDefs.Count<1 then Begin
     If Assigned(fNeedFields) then fNeedFields(Self);
     if csDesigning in ComponentState then exit;
     If FieldDefs.Count<1 then
{$IFDEF VER100}
        DatabaseError(SNoFields);
{$ELSE}
        DatabaseError(SNoFields,Self);
{$ENDIF}
  End;
end;

procedure TDXDataSetBinaryTree.InternalLast;
begin
   FRecordPos:=FDataList.Count+1;
end;

procedure TDXDataSetBinaryTree.InternalHandleException;
begin
   SysUtils.ShowException(ExceptObject, ExceptAddr);
//  Application.HandleException(Self);
end;

procedure TDXDataSetBinaryTree.InternalDelete;
var
   PBlobSpot:PChar;
   BlobSpot,I:Integer;

begin
   for i:=FieldCount-1 downto 0 do
      if IsBlobField(Fields[i]) then begin
         PBlobSpot:=GetInternalFieldData(Fields[i]);
         if PBlobSpot<>nil then begin
            FastMove(PBlobSpot^,BlobSpot,DXIntSize);
            FreeMem(PBlobSpot);
            FBlobList.BlobDelete(BlobSpot,Fields[i].FieldNo);
         end;
      end;
   FDataList.Delete(FRecordPos);
   if FDataList.Count=0 then FRecordPos:=0
   else if FRecordPos>FDataList.Count then FRecordPos:=FDataList.Count;
end;

procedure TDXDataSetBinaryTree.InternalAddRecord(Buffer: Pointer; Append: Boolean);
begin
   DXTabInsertRecord(0,Buffer);
{
   if Append then begin
      InternalLast;
      FDataList.AppendRow(FLastBookMark);
   end
   else begin
      FDataList.InsertRow(FRecordPos,FLastBookmark);
   end;
   FDataList.PutToBuffer(Buffer,FRecordPos);
   Inc(FLastBookmark);
}
end;

procedure TDXDataSetBinaryTree.InternalClose;
begin
   EmptyDataSet;
   FIsOpen:=False;
   FRecordPos:=0;
   FRecordSize:=0;
   BindFields(False);
   if DefaultFields then DestroyFields;
   If Assigned(FDataList) then Begin
      If Not FUseShareDataList then FDataList.Free;
      FDataList:=Nil;
   End;
end;

procedure TDXDataSetBinaryTree.InternalOpen;
begin
   If Not Assigned(FDataList) then Begin
      If FUseShareDataList then Begin
         If Assigned(FNeedDataList) then 
            FNeedDataList(FDataList);
         // fire event to associate FDataList with the shared one!
      End
      Else FDataList:=TDXDataList.Create;
   End;
   FRecordPos:=0;                  // initial record pos before BOF
   BookmarkSize:=DXIntSize;
   InternalInitFieldDefs;
   if DefaultFields then CreateFields;
   BindFields(True);                  // bind FieldDefs to actual data
   CreateTable;
   FIsOpen:=True;
   FRealRecNo:=0;
   FLastBookmark:=0;
   FBlobList.ResetNextId;
end;

procedure TDXDataSetBinaryTree.InternalPost;
begin
  CheckActive;
  if ((State<>dsEdit) and (State<>dsInsert)) then Exit;
  if State=dsEdit then FDataList.PutToBuffer(ActiveBuffer,FRecordPos)
  else Begin
     // calculate autoinc here!?
     DXTabInsertRecord(FRecordPos,ActiveBuffer);
  End;
end;

procedure TDXDataSetBinaryTree.DoAfterScroll;
begin
   if not FDoEvents then exit;
   if Active then inherited DoAfterScroll;
end;

procedure TDXDataSetBinaryTree.DoBeforeScroll;
begin
   if not FDoEvents then exit;
   if Active then inherited DoBeforeScroll;
end;

function TDXDataSetBinaryTree.IsCursorOpen: Boolean;
begin
   Result:=FIsOpen;
end;

function TDXDataSetBinaryTree.GetRecordCount: Integer;
begin
   Result:=FDataList.Count;
end;

function TDXDataSetBinaryTree.GetRecNo: Integer;
var
   SaveState:TDataSetState;
   SavePosition:Integer;
   TempBuffer:PChar;
   More:Boolean;

begin
{
  UpdateCursorPos;
  Result:=FRecordPos;
  Exit;
}
   UpdateCursorPos;
   CheckActive;
   if not Filtered then Result:=FRecordPos{+1}
   else begin
      Result:=0;
      SaveState:=SetTempState(dsBrowse);
      SavePosition:=FRecordPos;
try
      TempBuffer:=AllocRecordBuffer;
      InternalFirst;
      repeat
         More:=True;
         if GetRecord(TempBuffer,gmNext,True)=grOk then Inc(Result)
         else More:=False
      until (PRecInfo(TempBuffer+FBookmarkInfoOffset)^.Bookmark = SavePosition) or (not More);
finally
      RestoreState(SaveState);
      FRecordPos:=SavePosition;
      FreeRecordBuffer(TempBuffer);
end;
   end;
end;

procedure TDXDataSetBinaryTree.SetRecNo(Value: Integer);
var
   SaveState:TDataSetState;
   SavePosition:Integer;
   TempBuffer:PChar;

begin
   if not Filtered then FRecordPos:=FDataList.Count
   else begin
      SaveState:=SetTempState(dsBrowse);
      SavePosition:=FRecordPos;
try
      TempBuffer:=AllocRecordBuffer;
      InternalFirst;
      repeat
         if GetRecord(TempBuffer,gmNext,True)=grOk then Dec(Value)
         else begin
            FRecordPos:=SavePosition;
            break;
         end;
      until Value=0;
finally
      RestoreState(SaveState);
      FreeRecordBuffer(TempBuffer);
end;
   end;
end;

procedure TDXDataSetBinaryTree.EmptyDataSet;
begin
   if Active then begin
      Cancel;
      First;
   end;
   DisableControls;
try
   FRealRecNo:=0;
//   FMaxRecNo:=0;
   FBlobId:=0;
   FBlobList.ResetNextId;
   FRecordPos:=0;
   FBlobList.Clear;
   If Assigned(FDataList) then Begin
      if Not FUseShareDataList then Begin
         FDataList.Clear;
      End;
   End;
   FLastBookmark:=0;
   if Active then Refresh;
finally
    EnableControls;
end;
end;

function TDXDataSetBinaryTree.DXGetFieldData(RecNo:Cardinal;Field:TField):PChar;
begin
   Result:=nil;
   if (FDataList.Count<=0) or
      (RecNo>FDataList.Count) then exit;
//  Result:=FDataList.GetData(FRecordPos,DXTabGetFieldOffset(Field.FieldNo),DXTabGetFieldSize(Field.FieldNo));
end;

function TDXDataSetBinaryTree.DXTabFilterRecord(Buffer: PChar): Boolean;
var
   SaveState:TDataSetState;

begin
   Result:=True;
   if not Assigned(OnFilterRecord) then Exit;
   SaveState:=SetTempState(dsFilter);
   FFilterBuffer:=Buffer;
   OnFilterRecord(Self,Result);
   RestoreState(SaveState);
end;

function TDXDataSetBinaryTree.DXTabGetActiveBuffer(var Buffer: PChar): Boolean;
begin
   case State of
      dsBrowse:if IsEmpty then Buffer:=nil
      else Buffer:=ActiveBuffer;
      dsEdit,dsInsert:Buffer:=ActiveBuffer;
//    dsSetKey:Buffer:=PChar(FKeyBuffer) + SizeOf(TKeyBuffer);
      dsFilter:Buffer:=FFilterBuffer;
      dsCalcFields:Buffer:=CalcBuffer;
      else Buffer:=nil;
   end;
   Result:=Buffer<>nil;
end;

function TDXDataSetBinaryTree.DXTabGetFieldOffset(FieldNo: integer): Integer;
var
   x,offs:Integer;

begin
   offs:=0;