Code:OLAP Radar

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;