Валентин Озеров - Советы по Delphi. Версия 1.4.3 от 1.1.2001

end

Nomadicсоветует:

Кyсочек кода, чтобы повесить на clickable столбец RxGrid, показывающий RxQuery с определенным макросом %Order. Работать не бyдет (без модyлей), но в качестве идеи может быть полезен.

unitvgRXutil;

interface

usesSysUtils, Classes, DB, DBTables, rxLookup, RxQuery;

{ TrxDBLookup }

procedureRefreshRXLookup(Lookup: TrxLookupControl);

procedureRefreshRXLookupLookupSource(Lookup: TrxLookupControl);

functionRxLookupValueInteger(Lookup: TrxLookupControl): Integer;

{ TRxQuery }

{ Applicatable to SQL's without SELECT * syntax }

{ Inserts FieldName into first position in '%Order' macro and refreshes query }

procedureHandleOrderMacro(Query: TRxQuery; Field: TField);

{ Sets '%Order' macro, if defined, and refreshes query }

procedureInsertOrderBy(Query: TRxQuery; NewOrder: String);

{ Converts list of order fields if defined and refreshes query }

procedureUpdateOrderFields(Query: TQuery; OrderFields: TStrings);

implementation

usesvgUtils, vgDBUtl, vgBDEUtl;

{ TrxDBLookup refresh }

typeTRXLookupControlHack = class(TrxLookupControl)

propertyDataSource;

propertyLookupSource;

propertyValue;

propertyEmptyValue;

end;

procedureRefreshRXLookup(Lookup: TrxLookupControl);

varSaveField: String;

begin

withTRXLookupControlHack(Lookup) do begin

SaveField := DataField;

DataField := '';

DataField := SaveField;

end;

end;

procedureRefreshRXLookupLookupSource(Lookup: TrxLookupControl);

varSaveField: String;

begin

withTRXLookupControlHack(Lookup) do begin

SaveField := LookupDisplay;

LookupDisplay := '';

LookupDisplay := SaveField;

end;

end;

functionRxLookupValueInteger(Lookup: TrxLookupControl): Integer;

begin

withTRXLookupControlHack(Lookup) do try

ifValue <> EmptyValue thenResult := StrToInt(Value)

elseResult := 0;

except

Result := 0;

end;

end;

procedureInsertOrderBy(Query: TRxQuery; NewOrder: String);

var

Param: TParam;

OldActive: Boolean;

OldOrder: String;

Bmk: TPKBookMark;

begin

Param := FindParam(Query.Macros, 'Order');

if notAssigned(Param) thenExit;

OldOrder := Param.AsString;

ifOldOrder <> NewOrder then begin

OldActive := Query.Active;

ifOldActive thenBmk := GetPKBookmark(Query, '');

try

Query.Close;

Param.AsString := NewOrder;

try

Query.Prepare;

except

Param.AsString := OldOrder;

end;

Query.Active := OldActive;

ifOldActive thenSetToPKBookMark(Query, Bmk);

finally

ifOldActive thenFreePKBookmark(Bmk);

end;

end;

end;

procedureUpdateOrderFields(Query: TQuery; OrderFields: TStrings);

varNewOrderFields: TStrings;

procedureAddOrderField(S: String);

begin

ifNewOrderFields.IndexOf(S) < 0 thenNewOrderFields.Add(S);

end;

var

I, J: Integer;

Field: TField;

FieldDef: TFieldDef;

S: String;

begin

NewOrderFields := TStringList.Create;

withQuery do try

forI := 0 toOrderFields.Count - 1 do begin

S := OrderFields[I];

Field := FindField(S);

ifAssigned(Field) and(Field.FieldNo > 0) thenAddOrderField(IntToStr(Field.FieldNo))

else try

J := StrToInt(S);

ifJ < FieldDefs.Count thenAddOrderField(IntToStr(J));

except

end;

end;

OrderFields.Assign(NewOrderFields);

finally

NewOrderFields.Free;

end;

end;

procedureHandleOrderMacro(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 notAssigned(Param) orField.Calculated orField.Lookup thenExit;

OldOrder := Param.AsString;

I := 0;

Tmp := '';

OrderFields := TStringList.Create;

try

OrderFields.Ad(Field.FieldName);

whileI < Length(OldOrder) do begin