Code:OLAP Radar: Różnice pomiędzy wersjami
Z Motława
| Linia 2: | Linia 2: | ||
== HierCube == | == HierCube == | ||
| − | Dla komponentu '''HierCube'''. | + | Dla komponentu '''HierCube'''. |
| + | |||
| + | |||
1. Rozwiązanie statyczne. | 1. Rozwiązanie statyczne. | ||
W celu dodania własnej procedury wyliczeniowej należy wykonać następujące czynności:<br> | W celu dodania własnej procedury wyliczeniowej należy wykonać następujące czynności:<br> | ||
| Linia 17: | Linia 19: | ||
{...} | {...} | ||
MySubFunc1, MySubFunc2: TSubFunction; | MySubFunc1, MySubFunc2: TSubFunction; | ||
| + | function MyColPercentCalculator1(Args: TSubFunctionCalculatorArgs; out Res: Double): Boolean; | ||
| + | function MyColPercentCalculator2(Args: TSubFunctionCalculatorArgs; out Res: Double): Boolean; | ||
| + | function MyColTrendCalc(Args: TSubFunctionCalculatorArgs; out Res: Double; TrendNo: Integer): Boolean; | ||
public | public | ||
{...} | {...} | ||
end; | end; | ||
| + | |||
| + | implementation | ||
| + | |||
| + | {...} | ||
procedure TMainFRM.FormCreate(Sender: TObject); | procedure TMainFRM.FormCreate(Sender: TObject); | ||
begin | begin | ||
| − | ... | + | {...} |
{ dodanie funkcji w menu i pobranie identyfikatora } | { dodanie funkcji w menu i pobranie identyfikatora } | ||
MySubFunc1 := Grid.AddSubFunction('Przyrost w %').SubFunction; | MySubFunc1 := Grid.AddSubFunction('Przyrost w %').SubFunction; | ||
| Linia 48: | Linia 57: | ||
end; | end; | ||
| − | function TMainFRM.MyColPercentCalculator2(Args: TSubFunctionCalculatorArgs; out Res: Double): | + | function TMainFRM.MyColPercentCalculator2(Args: TSubFunctionCalculatorArgs; out Res: Double): Boolean; |
begin | begin | ||
Result := MyColTrendCalc(Args, Res, 2); | Result := MyColTrendCalc(Args, Res, 2); | ||
| Linia 74: | Linia 83: | ||
Exit; | Exit; | ||
if RowLabelNode = nil then Exit; | if RowLabelNode = nil then Exit; | ||
| − | |||
Node := RowLabelNode; | Node := RowLabelNode; | ||
| − | |||
| − | |||
| − | |||
if Node.IsSubTotal then Exit; | if Node.IsSubTotal then Exit; | ||
if (Node.Parent <> nil) and Node.Parent.IsSubTotal then Exit; | if (Node.Parent <> nil) and Node.Parent.IsSubTotal then Exit; | ||
| Linia 104: | Linia 109: | ||
end; | end; | ||
</source> | </source> | ||
| + | |||
== RadarCube == | == RadarCube == | ||
| − | Dla komponentu '''RadarCube'''. | + | Dla komponentu '''RadarCube'''. |
| + | |||
| + | Deklaracja własnej procedury: | ||
| + | |||
| + | <source lang=pascal> | ||
| + | TfmMain = class(TForm) | ||
| + | private | ||
| + | {...} | ||
| + | procedure MyColTrendCalc(EventArgs: TShowMeasureArgs; TrendNo: Integer); | ||
| + | public | ||
| + | {...} | ||
| + | end; | ||
| + | </source> | ||
| + | |||
| + | W implementacji dodajemy: | ||
| + | <source lang=pascal> | ||
| + | implementation | ||
| + | |||
| + | {...} | ||
| + | |||
| + | const | ||
| + | _ColTrend = 'Przyrost w %'; | ||
| + | _ColRate = 'Stosunek wartości %'; | ||
| + | </source> | ||
| + | |||
| + | |||
| + | Modyfikujemy zdarzenia '''OnInitMeasures''' i '''OnShowMeasure''': | ||
| + | <source lang=pascal> | ||
| + | procedure TfmMain.OnInitMeasuresHandler(Sender: TObject); | ||
| + | var | ||
| + | M: TMeasure; | ||
| + | begin | ||
| + | //+ Add a new show mode named "Rank by Row" in the "Sales" measure | ||
| + | M := (Sender as TCustomOLAPGrid).Measures.FindByDisplayName('Sales'); | ||
| + | if M <> nil then | ||
| + | begin | ||
| + | M.ShowModes.Add('Rank by Row'); | ||
| + | M.ShowModes.Add(_ColTrend); | ||
| + | M.ShowModes.Add(_ColRate); | ||
| + | end; | ||
| + | end; | ||
| + | |||
| + | procedure TfmMain.OnShowMeasure(Sender: TObject; EventArgs: TShowMeasureArgs); | ||
| + | begin | ||
| + | {...} | ||
| + | if EventArgs.ShowMode.Caption = _ColTrend then | ||
| + | MyColTrendCalc(EventArgs, 1); | ||
| + | if EventArgs.ShowMode.Caption = _ColRate then | ||
| + | MyColTrendCalc(EventArgs, 2); | ||
| + | end; | ||
| + | </source> | ||
| + | |||
| + | Dodajemy własną procedurę: | ||
| + | <source lang=pascal> | ||
| + | procedure TfmMain.MyColTrendCalc(EventArgs: TShowMeasureArgs; TrendNo: Integer); | ||
| + | var | ||
| + | i, j: integer; | ||
| + | MC: IMemberCell; | ||
| + | V: Variant; | ||
| + | x0, x1, y: Double; | ||
| + | S: string; | ||
| + | begin | ||
| + | EventArgs.ReturnValue := ''; | ||
| + | if VarIsNull(EventArgs.OriginalData) then Exit; | ||
| + | x1 := EventArgs.OriginalData; | ||
| + | if x1 = 0.0 then Exit; | ||
| + | S := '*'; | ||
| + | Grid.GetCellByAddress(EventArgs.CurrentAddress, i, j); | ||
| + | MC := IMemberCell(Grid.CellSet.Cells[j, i]); | ||
| + | if MC <> nil then | ||
| + | begin | ||
| + | MC := MC.PrevMember; | ||
| + | if MC <> nil then | ||
| + | begin | ||
| + | V := EventArgs.Evaluator.SiblingValue(MC.Member); | ||
| + | if not VarIsNull(V) then | ||
| + | begin | ||
| + | x0 := V; | ||
| + | y := 0; | ||
| + | case TrendNo of | ||
| + | 1: y := (1 - x0/x1) * 100; | ||
| + | 2: y := x0/x1 * 100; | ||
| + | end; | ||
| + | S := FormatFloat('#0.00"%"', y); | ||
| + | end; | ||
| + | end | ||
| + | else | ||
| + | S := 'N/A'; | ||
| + | end; | ||
| + | EventArgs.ReturnValue := S; | ||
| + | end; | ||
| + | </source> | ||
[[Kategoria: System]] | [[Kategoria: System]] | ||
[[Kategoria: Programowanie]] | [[Kategoria: Programowanie]] | ||
Wersja z 14:30, 23 mar 2009
Procedury do HierCube i RadarCube
HierCube
Dla komponentu HierCube.
1. Rozwiązanie statyczne.
W celu dodania własnej procedury wyliczeniowej należy wykonać następujące czynności:
- kliknąć w komponent Grid (THierCubeGrid);
- we własności FunctionDefs wybrać zakładkę Sub-function settings;
- kliknąć w ikonkę Create custom sub-function i w pole Display name wpisać nazwę wyświetlaną, która pojawi się w menu;
- przechodzimy do zakładki Summary settings, w drzewie wybieramy Distinct Count;
- wybieramy nowo założoną procedurę i w polu Format mask wybieramy właściwą maskę dla wyświetlanych wartości;
2. Rozwiązanie dynamiczne. W głównej formatce dodajemy deklaracje, a w zdarzeniu OnCreate dodajemy własne funkcje jak poniżej:
TMainFRM = class(TForm) private {...} MySubFunc1, MySubFunc2: TSubFunction; function MyColPercentCalculator1(Args: TSubFunctionCalculatorArgs; out Res: Double): Boolean; function MyColPercentCalculator2(Args: TSubFunctionCalculatorArgs; out Res: Double): Boolean; function MyColTrendCalc(Args: TSubFunctionCalculatorArgs; out Res: Double; TrendNo: Integer): Boolean; public {...} end; implementation {...} procedure TMainFRM.FormCreate(Sender: TObject); begin {...} { dodanie funkcji w menu i pobranie identyfikatora } MySubFunc1 := Grid.AddSubFunction('Przyrost w %').SubFunction; MySubFunc2 := Grid.AddSubFunction('Stosunek wartości %').SubFunction; { dodanie formatowania } Grid.SummarySettings.FindFieldName('Quantity').FunctionCustom1.SubFunctions[Ord(MySubFunc1)].FormatString := '0.00"%"'; Grid.SummarySettings.FindFieldName('Quantity').FunctionCustom1.SubFunctions[Ord(MySubFunc2)].FormatString := '0.00"%"'; end;
W komponencie Grid (THierCubeGrid) zdarzenie OnGetSubFunctionCalculator należy uzupełnić w następujący sposób:
procedure TMainFRM.GridGetSubFunctionCalculator(Sender: TObject; SubFun: TSubFunction; var Calculator: TSubFunctionCalculator); begin if SubFun = sstCustom1 then Calculator := MyColPercentCalculator else if SubFun = MySubFunc1 then Calculator := MyColPercentCalculator1 else if SubFun = MySubFunc2 then Calculator := MyColPercentCalculator2; end;
Dodajemy kod własnych funkcji:
function TMainFRM.MyColPercentCalculator1(Args: TSubFunctionCalculatorArgs; out Res: Double): Boolean; begin Result := MyColTrendCalc(Args, Res, 1); end; function TMainFRM.MyColPercentCalculator2(Args: TSubFunctionCalculatorArgs; out Res: Double): Boolean; begin Result := MyColTrendCalc(Args, Res, 2); end; function TMainFRM.MyColTrendCalc(Args: TSubFunctionCalculatorArgs; out Res: Double; TrendNo: Integer): Boolean; var Node: TLabelNode; Nodes: TLabelNodes; i: Integer; CurrCell, PrevCell: PDataCell; x0, x1: Double; begin { by default return empty cell } Result := False; with Args do begin CurrCell := FunctionData[ColTreeIndex, RowTreeIndex]; if CurrCell.NotEmpty then begin x1 := CurrCell.Data; if x1 = 0.0 then Exit; end else Exit; if RowLabelNode = nil then Exit; Node := RowLabelNode; if Node.IsSubTotal then Exit; if (Node.Parent <> nil) and Node.Parent.IsSubTotal then Exit; Nodes := Node.LabelNodes; { find previous cells from the area of adequate comparisons } i := Node.Index - 1; if i >= 0 then begin Node := Nodes[i]; if not Node.IsSubTotal then begin PrevCell := FunctionData[ColTreeIndex, Node.TreeIndex]; if PrevCell.NotEmpty then begin Result := True; x0 := PrevCell.Data; case TrendNo of 1: Res := (1 - x0/x1) * 100; 2: Res := x0/x1 * 100; end; end; end; end; end; end;
RadarCube
Dla komponentu RadarCube.
Deklaracja własnej procedury:
TfmMain = class(TForm) private {...} procedure MyColTrendCalc(EventArgs: TShowMeasureArgs; TrendNo: Integer); public {...} end;
W implementacji dodajemy:
implementation {...} const _ColTrend = 'Przyrost w %'; _ColRate = 'Stosunek wartości %';
Modyfikujemy zdarzenia OnInitMeasures i OnShowMeasure:
procedure TfmMain.OnInitMeasuresHandler(Sender: TObject); var M: TMeasure; begin //+ Add a new show mode named "Rank by Row" in the "Sales" measure M := (Sender as TCustomOLAPGrid).Measures.FindByDisplayName('Sales'); if M <> nil then begin M.ShowModes.Add('Rank by Row'); M.ShowModes.Add(_ColTrend); M.ShowModes.Add(_ColRate); end; end; procedure TfmMain.OnShowMeasure(Sender: TObject; EventArgs: TShowMeasureArgs); begin {...} if EventArgs.ShowMode.Caption = _ColTrend then MyColTrendCalc(EventArgs, 1); if EventArgs.ShowMode.Caption = _ColRate then MyColTrendCalc(EventArgs, 2); end;
Dodajemy własną procedurę:
procedure TfmMain.MyColTrendCalc(EventArgs: TShowMeasureArgs; TrendNo: Integer); var i, j: integer; MC: IMemberCell; V: Variant; x0, x1, y: Double; S: string; begin EventArgs.ReturnValue := ''; if VarIsNull(EventArgs.OriginalData) then Exit; x1 := EventArgs.OriginalData; if x1 = 0.0 then Exit; S := '*'; Grid.GetCellByAddress(EventArgs.CurrentAddress, i, j); MC := IMemberCell(Grid.CellSet.Cells[j, i]); if MC <> nil then begin MC := MC.PrevMember; if MC <> nil then begin V := EventArgs.Evaluator.SiblingValue(MC.Member); if not VarIsNull(V) then begin x0 := V; y := 0; case TrendNo of 1: y := (1 - x0/x1) * 100; 2: y := x0/x1 * 100; end; S := FormatFloat('#0.00"%"', y); end; end else S := 'N/A'; end; EventArgs.ReturnValue := S; end;
