unit vgRXutil;

interface

uses
 SysUtils, Classes, DB, DBTables, rxLookup, RxQuery;

{ TrxDBLookup }
procedure RefreshRXLookup(Lookup: TrxLookupControl);
procedure RefreshRXLookupLookupSource(Lookup: TrxLookupControl);

function RxLookupValueInteger(Lookup: TrxLookupControl): Integer;

{ TRxQuery }

{ Applicatable to SQL's without SELECT * syntax }

{ Inserts FieldName into first position in '%Order' macro and refreshes query }
procedure HandleOrderMacro(Query: TRxQuery; Field: TField);

{ Sets '%Order' macro, if defined, and refreshes query }
procedure InsertOrderBy(Query: TRxQuery; NewOrder: string);

{ Converts list of order fields if defined and refreshes query }
procedure UpdateOrderFields(Query: TQuery; OrderFields: TStrings);

implementation
uses
 vgUtils, vgDBUtl, vgBDEUtl;

{ TrxDBLookup refresh }

type
 TRXLookupControlHack = class(TrxLookupControl)
 property DataSource;
 property LookupSource;
 property Value;
 property EmptyValue;
 end;

procedure RefreshRXLookup(Lookup: TrxLookupControl);
var
 SaveField: string;
begin
 with TRXLookupControlHack(Lookup) do
 begin
 SaveField := DataField;
 DataField := '';
 DataField := SaveField;
 end;
end;

procedure RefreshRXLookupLookupSource(Lookup: TrxLookupControl);
var
 SaveField: string;
begin
 with TRXLookupControlHack(Lookup) do
 begin
 SaveField := LookupDisplay;
 LookupDisplay := '';
 LookupDisplay := SaveField;
 end;
end;

function RxLookupValueInteger(Lookup: TrxLookupControl): Integer;
begin
 with TRXLookupControlHack(Lookup) do
 try
 if Value <> EmptyValue then
 Result := StrToInt(Value)
 else
 Result := 0;
 except
 Result := 0;
 end;
end;

procedure InsertOrderBy(Query: TRxQuery; NewOrder: string);
var
 Param: TParam;
 OldActive: Boolean;
 OldOrder: string;
 Bmk: TPKBookMark;
begin
 Param := FindParam(Query.Macros, 'Order');
 if not Assigned(Param) then
 Exit;

 OldOrder := Param.AsString;

 if OldOrder <> NewOrder then
 begin
 OldActive := Query.Active;
 if OldActive then
 Bmk := GetPKBookmark(Query, '');
 try
 Query.Close;
 Param.AsString := NewOrder;
 try
 Query.Prepare;
 except
 Param.AsString := OldOrder;
 end;
 Query.Active := OldActive;
 if OldActive then
 SetToPKBookMark(Query, Bmk);
 finally
 if OldActive then
 FreePKBookmark(Bmk);
 end;
 end;
end;

procedure UpdateOrderFields(Query: TQuery; OrderFields: TStrings);
var
 NewOrderFields: TStrings;

 procedure AddOrderField(S: string);
 begin
 if NewOrderFields.IndexOf(S) < 0 then
 NewOrderFields.Add(S);
 end;

var
 I, J: Integer;
 Field: TField;
 FieldDef: TFieldDef;
 S: string;
begin
 NewOrderFields := TStringList.Create;
 with Query do
 try
 for I := 0 to OrderFields.Count - 1 do
 begin
 S := OrderFields[I];
 Field := FindField(S);
 if Assigned(Field) and (Field.FieldNo > 0) then
 AddOrderField(IntToStr(Field.FieldNo))
 else
 try
 J := StrToInt(S);
 if J < FieldDefs.Count then
 AddOrderField(IntToStr(J));
 except
 end;
 end;
 OrderFields.Assign(NewOrderFields);
 finally
 NewOrderFields.Free;
 end;
end;

procedure HandleOrderMacro(Query: TRxQuery; Field: TField);
var
 Param: TParam;
 Tmp, OldOrder, NewOrder: string;
 I: Integer;
 C: Char;
 TmpField: TField;
 OrderFields: TStrings;
begin
 Param := FindParam(Query.Macros, 'Order');
 if not Assigned(Param) or Field.Calculated or Field.Lookup then
 Exit;
 OldOrder := Param.AsString;
 I := 0;
 Tmp := '';
 OrderFields := TStringList.Create;
 try
 OrderFields.Ad(Field.FieldName);
 while I < Length(OldOrder) do
 begin
 Inc(I);
 C := OldOrder[I];
 if C in FieldNameChars then
 Tmp := Tmp + C;

 if (not (C in FieldNameChars) or (I = Length(OldOrder))) and (Tmp <> '')
 then
 begin
 TmpField := Field.DataSet.FindField(Tmp);
 if OrderFields.IndexOf(Tmp) < 0 then
 OrderFields.Add(Tmp);
 Tmp := '';
 end;
 end;

 UpdateOrderFields(Query, OrderFields);
 NewOrder := OrderFields[0];
 for I := 1 to OrderFields.Count - 1 do
 NewOrder := NewOrder + ', ' + OrderFields[1];
 finally
 OrderFields.Free;
 end;
 InsertOrderBy(Query, NewOrder);
end;

end.