Code:OLAP Radar: Różnice pomiędzy wersjami

Z Motława
(Nowa strona: == Procedura do HierCube == function CalcTrendByCol(Args: TSubFunctionCalculatorArgs; out Res: Double; TrendVer: Integer): Boolean; var Node: TLabelNode; Nodes: TLabelNodes...)
 
 
(Nie pokazano 15 wersji utworzonych przez 3 użytkowników)
Linia 1: Linia 1:
−
== Procedura do [[HierCube]] ==
+
Procedury do [[HierCube]] i [[RadarCube]]
  
−
function CalcTrendByCol(Args: TSubFunctionCalculatorArgs; out Res: Double; TrendVer: Integer): Boolean;
+
== HierCube ==
−
var
+
Dla komponentu '''HierCube'''.
−
  Node: TLabelNode;
+
−
  Nodes: TLabelNodes;
+
−
  i: Integer;
+
−
  CurrCell, PrevCell: PDataCell;
+
−
  x0, x1: Double;
+
−
begin
+
−
  { by default return empty cell }
+
−
  Result := False;
+
−
  with Args do
+
−
  begin
+
−
//if not FunctionData[ColTreeIndex, RowTreeIndex].NotEmpty then Exit;
+
−
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;
+
−
{ find the parent node of RowLabelNode }
+
−
Node := RowLabelNode;
+
−
{ for the most total node return empty value }
+
−
if Node = nil then Exit;
+
−
{ the list of all nodes from the area of adequate comparisons including the given one }
+
−
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]; // RowTreeIndex
+
−
if PrevCell.NotEmpty then
+
−
begin
+
−
  Result := True;
+
−
  x0 := PrevCell.Data;
+
−
  case TrendVer of
+
−
1: Res := (1 - x0/x1) * 100;
+
−
2: Res := x0/x1 * 100;
+
−
  end;
+
−
end;
+
−
  end;
+
−
end;
+
−
  end;
+
−
end;
+
  
  
 +
1. Rozwiązanie statyczne.
 +
W celu dodania własnej procedury wyliczeniowej należy wykonać następujące czynności:<br>
 +
* 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:
 +
<source lang=pascal>
 +
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;
 +
</source>
 +
W komponencie '''Grid''' (THierCubeGrid) zdarzenie '''OnGetSubFunctionCalculator''' należy uzupełnić w następujący sposób:
 +
<source lang=pascal>
 +
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;
 +
</source>
 +
Dodajemy kod własnych funkcji:
 +
<source lang=pascal>
 +
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;
 +
</source>
 +
 +
 +
== 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|OLAP Radar]]

Aktualna wersja na dzień 11:53, 25 lis 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;
Źródło „https://wikii.int.com.pl/index.php?title=Code:OLAP_Radar&oldid=6336”