RxFPC:add RxDBGrid sort engine for IBX

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6154 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
alexs75
2018-01-29 11:34:23 +00:00
parent 47d2a48f3d
commit c0f254ae83
4 changed files with 186 additions and 0 deletions

View File

@ -0,0 +1,42 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<Package Version="4">
<Name Value="rx_sort_ibx"/>
<Type Value="RunAndDesignTime"/>
<CompilerOptions>
<Version Value="11"/>
<SearchPaths>
<OtherUnitFiles Value="rx_sort_ibx"/>
<UnitOutputDirectory Value="lib/rx_sort_ibx/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
</CompilerOptions>
<Files Count="2">
<Item1>
<Filename Value="rx_sort_ibx/rxsortibx.pas"/>
<HasRegisterProc Value="True"/>
<UnitName Value="RxSortIBX"/>
</Item1>
<Item2>
<Filename Value="rx_sort_ibx/exsortibx.pas"/>
<UnitName Value="exsortibx"/>
</Item2>
</Files>
<RequiredPkgs Count="3">
<Item1>
<PackageName Value="ibexpress"/>
</Item1>
<Item2>
<PackageName Value="rxnew"/>
</Item2>
<Item3>
<PackageName Value="FCL"/>
</Item3>
</RequiredPkgs>
<UsageOptions>
<UnitPath Value="$(PkgOutDir)"/>
</UsageOptions>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
</Package>
</CONFIG>

View File

@ -0,0 +1,22 @@
{ This file was automatically created by Lazarus. Do not edit!
This source is only used to compile and install the package.
}
unit rx_sort_ibx;
{$warn 5023 off : no warning about unused units}
interface
uses
RxSortIBX, exsortibx, LazarusPackageIntf;
implementation
procedure Register;
begin
RegisterUnit('RxSortIBX', @RxSortIBX.Register);
end;
initialization
RegisterPackage('rx_sort_ibx', @Register);
end.

View File

@ -0,0 +1,90 @@
unit exsortibx;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, DB, RxDBGrid;
type
{ TZeosDataSetSortEngine }
{ TIBXDataSetSortEngine }
TIBXDataSetSortEngine = class(TRxDBGridSortEngine)
protected
public
procedure Sort(FieldName: string; ADataSet:TDataSet; Asc:boolean; SortOptions:TRxSortEngineOptions);override;
procedure SortList(ListField: string; ADataSet: TDataSet; Asc: array of boolean; SortOptions: TRxSortEngineOptions); override;
end;
implementation
uses IBCustomDataSet;
function FixFieldName(S:string):string;inline;
begin
if not IsValidIdent(S) then
Result:='"'+S+'"'
else
Result:=S;
end;
{ TIBXDataSetSortEngine }
procedure TIBXDataSetSortEngine.Sort(FieldName: string; ADataSet: TDataSet;
Asc: boolean; SortOptions: TRxSortEngineOptions);
begin
if not Assigned(ADataSet) then exit;
if ADataSet is TIBCustomDataSet then
begin
if Asc then
FieldName := FixFieldName(FieldName) + ' Asc'
else
FieldName := FixFieldName(FieldName) + ' Desc';
TIBCustomDataSet(ADataSet).OrderFields:=FieldName;
end;
end;
procedure TIBXDataSetSortEngine.SortList(ListField: string; ADataSet: TDataSet;
Asc: array of boolean; SortOptions: TRxSortEngineOptions);
var
S: String;
C: SizeInt;
i: Integer;
begin
if not Assigned(ADataSet) then exit;
S:='';
C:=Pos(';', ListField);
i:=0;
while C>0 do
begin
if S<>'' then S:=S+';';
S:=S + FixFieldName(Copy(ListField, 1, C-1));
Delete(ListField, 1, C);
if (i<=High(Asc)) and (not Asc[i]) then
S:=S + ' DESC';
C:=Pos(';', ListField);
inc(i);
end;
if ListField<>'' then
begin
if S<>'' then S:=S+';';
S:=S + FixFieldName(ListField);
if (i<=High(Asc)) and (not Asc[i]) then
S:=S + ' DESC';
end;
(ADataSet as TIBCustomDataSet).OrderFields:=S;
end;
initialization
RegisterRxDBGridSortEngine(TIBXDataSetSortEngine, 'TIBQuery');
RegisterRxDBGridSortEngine(TIBXDataSetSortEngine, 'TIBDataSet');
end.

View File

@ -0,0 +1,32 @@
unit RxSortIBX;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils;
type
TRxSortIBX = class(TComponent)
private
protected
public
published
end;
procedure Register;
implementation
uses exsortibx;
procedure Register;
begin
RegisterComponents('RX DBAware',[TRxSortIBX]);
end;
end.