xqbase.pas

TxQuery is an SQL engine implemented in a TDataSet descendant component, that can parse SQL syntax,

  If ( Value < 1 ) Or ( Value > GetRecordCount ) Then
    Raise EXQueryError.Create( SRecnoInvalid );
  fRecNo := Value;
End;

Function TxqSortList.GetRecno: Integer;
Begin
  Result := fRecNo;
End;

Procedure TxqSortList.AddField( pDataType: TExprType;
  pDataSize: Integer; pDescending: Boolean );
Begin
  With fFields.Add( pDataType ) Do
  Begin
    BufferOffset := fRecordBufferSize;
    DataType := pDataType;
    Case DataType Of
      ttString: DataSize := pDataSize + 1;
      ttFloat: DataSize := SizeOf( Double );
      ttInteger: DataSize := SizeOf( Integer );
      ttBoolean: DataSize := SizeOf( WordBool );
    End;
    Desc := pDescending;
    Inc( fRecordBufferSize, DataSize );
  End;
End;

Function TxqSortList.IsEqual( Recno1, Recno2: Integer ): Boolean;
Var
  Buffer: PChar;
  Buffer1: PChar;
  Buffer2: PChar;
Begin
  SetRecno( Recno1 );
  Buffer := ActiveBuffer;
  GetMem( Buffer1, fRecordBufferSize );
  Move( Buffer^, Buffer1^, fRecordBufferSize );

  SetRecno( Recno2 );
  Buffer := ActiveBuffer;
  GetMem( Buffer2, fRecordBufferSize );
  Move( Buffer^, Buffer2^, fRecordBufferSize );

  { the first SizeOf(Integer) bytes is the source recno and always is different }
  Result := Comparemem( ( Buffer1 + SizeOf( Integer ) ),
    ( Buffer2 + SizeOf( Integer ) ), fRecordBufferSize - SizeOf( Integer ) );

  FreeMem( Buffer1, fRecordBufferSize );
  FreeMem( Buffer2, fRecordBufferSize );

End;

Function TxqSortList.DoCompare( N: Integer; Const KeyValue: Variant ): Integer;
{ returns -1, 0 or 1 for a<b, a=b, a>b}
Var
  DataType: TExprType;
  s: String;
  f: Double;
  i: Integer;
  b, cb: Boolean;
  CompareValue: Variant;
Begin
  Result := 0;
  SetRecno( N );
  DataType := fFields[0].DataType;
  If VarIsNull( KeyValue ) Then
  Begin
    { solo por si se ofrece, se prueba tambien al recibir un valor NULL }
    Case DataType Of
      ttString: CompareValue := '';
      ttFloat, ttInteger: CompareValue := 0;
      ttBoolean: CompareValue := False ;
    End;
  End Else
    CompareValue := KeyValue;
  Case DataType Of
    ttString:
      Begin
        s := fFields[0].AsString;
        If s = CompareValue Then
        Begin
          Result := 0;
          Exit;
        End;
        If fFields[0].Desc Then
        Begin
          If s < CompareValue Then
            Result := 1
          Else
            Result := -1;
        End
        Else
        Begin
          If s < CompareValue Then
            Result := -1
          Else
            Result := 1;
        End;
      End;
    ttFloat:
      Begin
        f := fFields[0].AsFloat;
        If f = CompareValue Then
        Begin
          Result := 0;
          Exit;
        End;
        If fFields[0].Desc Then
        Begin
          If f < CompareValue Then
            Result := 1
          Else
            Result := -1;
        End
        Else
        Begin
          If f < CompareValue Then
            Result := -1
          Else
            Result := 1;
        End;
      End;
    ttInteger:
      Begin
        i := fFields[0].AsInteger;
        If i = CompareValue Then
        Begin
          Result := 0;
          Exit;
        End;
        If fFields[0].Desc Then
        Begin
          If i < CompareValue Then
            Result := 1
          Else
            Result := -1;
        End
        Else
        Begin
          If i < CompareValue Then
            Result := -1
          Else
            Result := 1;
        End;
      End;
    ttBoolean:
      Begin
        b := fFields[0].AsBoolean;
        cb := CompareValue;
        If ord( b ) = ord( cb ) Then
        Begin
          Result := 0;
          Exit;
        End;
        If fFields[0].Desc Then
        Begin
          If Ord( b ) < Ord( cb ) Then
            Result := 1
          Else
            Result := -1;
        End
        Else
        Begin
          If Ord( b ) < Ord( cb ) Then
            Result := -1
          Else
            Result := 1;
        End;
      End;
  End;
End;

Function TxqSortList.Find( Const KeyValue: Variant; Var Index: Integer ): Boolean;
Var
  L, H, I, C: Integer;
Begin
  Result := False;
  L := 1;
  H := GetRecordCount;
  While L <= H Do
  Begin
    I := ( L + H ) Shr 1;
    C := DoCompare( I, KeyValue );
    If C < 0 Then
      L := I + 1
    Else
    Begin
      H := I - 1;
      If C = 0 Then
      Begin
        Result := True;
        //if Duplicates <> dupAccept then L := I;
      End;
    End;
  End;
  Index := L;
End;

{ this methods filter only by the first data column of the sort }

Procedure TxqSortList.Filter( Const KeyValue: Variant );
Var
  I, Index: Integer;
Begin
  If FSelected = Nil Then
    FSelected := TList.Create
  Else
    FSelected.Clear;
  { the first value must be on the database }
  If Self.Find( KeyValue, Index ) Then
  Begin
    For I := Index To GetRecordCount Do
      If DoCompare( I, KeyValue ) = 0 Then
        FSelected.Add( Pointer( I ) )
      Else
        Break;
  End;
  FFilterRecno := -1;
End;

Procedure TxqSortList.First;
Begin
  If FSelected = Nil Then Exit;
  If FSelected.Count > 0 Then
  Begin
    FFilterRecno := 0;
    fBofCrack := false;
    fEofCrack := false;
    SetRecno( Longint( FSelected[FFilterRecno] ) );
  End
  Else
  Begin
    fBofCrack := true;
    fEofCrack := true;
  End
End;

Procedure TxqSortList.Next;
Begin
  If FSelected = Nil Then Exit;
  If FSelected.Count > 0 Then
  Begin
    If FFilterRecno < FSelected.Count - 1 Then
    Begin
      Inc( FFilterRecno );
      fBofCrack := false;
      fEofCrack := false;
    End
    Else
    Begin
      FFilterRecno := FSelected.Count - 1;
      fBofCrack := false;
      fEofCrack := true;
    End;
    SetRecno( Longint( FSelected[FFilterRecno] ) );
  End
  Else
  Begin
    fBofCrack := true;
    fEofCrack := true;
  End
End;

Function TxqSortList.Eof: Boolean;
Begin
  result := fEofCrack;
End;

Function TxqSortList.Bof: Boolean;
Begin
  result := fBofCrack;
End;

Procedure TxqSortList.Sort;
Var
  I, Idx: Integer;
  Index: Integer;
  Pivot: Integer;
  DataType: TExprType;
  IsDesc: Boolean;
  TempL, TempR: String;

  Function SortCompare_S( Recno: Integer; Const Value: String ): Integer;
  Var
    s: String;
  Begin
    SetRecno( Recno );
    s := fFields[Idx].AsString;
    If s = Value Then
    Begin
      Result := 0;
      Exit;
    End;
    If IsDesc Then
    Begin
      If s < Value Then
        Result := 1
      Else
        Result := -1;
    End
    Else
    Begin
      If s < Value Then
        Result := -1
      Else
        Result := 1;
    End;
  End;

  Function SortCompare_F( Recno: Integer; Const Value: Double ): Integer;
  Var
    f: Double;
  Begin
    SetRecno( Recno );
    f := fFields[Idx].AsFloat;
    If f = Value Then
    Begin
      Result := 0;
      Exit;
    End;
    If IsDesc Then
    Begin
      If f < Value Then
        Result := 1
      Else
        Result := -1;
    End
    Else
    Begin
      If f < Value Then
        Result := -1
      Else
        Result := 1;
    End;
  End;

  Function SortCompare_I( Recno: Integer; Value: Integer ): Integer;
  Var
    i: Integer;
  Begin
    SetRecno( Recno );
    i := fFields[Idx].AsInteger;
    If i = Value Then
    Begin
      Result := 0;
      Exit;
    End;
    If IsDesc Then
    Begin
      If i < Value Then
        Result := 1
      Else
        Result := -1;
    End
    Else
    Begin
      If i < Value Then
        Result := -1
      Else
        Result := 1;
    End;
  End;

  Function SortCompare_B( Recno: Integer; Value: Boolean ): Integer;
  Var
    b: Boolean;
  Begin
    SetRecno( Recno );
    b := fFields[Idx].AsBoolean;
    If Ord( b ) = Ord( Value ) Then
    Begin
      Result := 0;
      Exit;
    End;
    If IsDesc Then
    Begin
      If Ord( b ) < Ord( Value ) Then
        Result := 1
      Else
        Result := -1;
    End
    Else
    Begin
      If Ord( b ) < Ord( Value ) Then
        Result := -1
      Else
        Result := 1;
    End;
  End;

  Procedure QuickSort( L, R: Integer );
  Var
    I, J, P: Integer;
    s1: String;
    f1: Double;
    i1: Integer;
    b1: Boolean;
  Begin
    Repeat
      I := L;
      J := R;
      P := ( L + R ) Shr 1;
      SetRecno( P );
      f1 := 0;
      i1 := 0;
      b1 := False;
      Case DataType Of
        ttString: s1 := fFields[Idx].AsString;
        ttFloat: f1 := fFields[Idx].AsFloat;
        ttInteger: i1 := fFields[Idx].AsInteger;
        ttBoolean: b1 := fFields[Idx].AsBoolean;
      End;
      Repeat
        Case DataType Of
          ttString:
            Begin
              While SortCompare_S( I, s1 ) < 0 Do
                Inc( I );
            End;
          ttFloat:
            Begin
              While SortCompare_F( I, f1 ) < 0 Do
                Inc( I );
            End;
          ttInteger:
            Begin
              While SortCompare_I( I, i1 ) < 0 Do
                Inc( I );
            End;
          ttBoolean:
            Begin
              While SortCompare_B( I, b1 ) < 0 Do
                Inc( I );
            End;
        End;

        Case DataType Of
          ttString:
            Begin
              While SortCompare_S( J, s1 ) > 0 Do
                Dec( J );
            End;
          ttFloat:
            Begin