frxcross.pas

报表控件。FastReport 是非常强大的报表控件

      TopIndex := BottomIndex + 1;
      BottomIndex := Items.Count - 1;
    end;
  end;

  CreateBand;

  LargeBand.Free;
  Items.Free;
end;

{$IFDEF FR_COM}
function TfrxCustomCrossView.Get_CellFields(out Value: WideString): HResult; stdcall;
begin
  Value := WideString(String(CellFields.GetText));
  Result := S_OK;
end;

function TfrxCustomCrossView.Set_CellFields(const Value: WideString): HResult; stdcall;
begin
  CellFields.SetText( PAnsiChar(String(Value)) );
  CellLevels := CellFields.Count;
  Result := S_OK;
end;

function TfrxCustomCrossView.Get_CellFunctions(Index: Integer; out Value: frxCrossFunction): HResult; stdcall;
begin
  Value := frxCrossFunction(CellFunctions[Index]);
  Result := S_OK;
end;

function TfrxCustomCrossView.Set_CellFunctions(Index: Integer; Value: frxCrossFunction): HResult; stdcall;
begin
  CellFunctions[Index] := TfrxCrossFunction(Value);
  Result := S_OK;
end;

function TfrxCustomCrossView.Get_CellMemos(Index: Integer; out Value: IfrxCustomMemoView): HResult; stdcall;
begin
  Value := CellMemos[Index];
  Result := S_OK;
end;

function TfrxCustomCrossView.Get_ColumnFields(out Value: WideString): HResult; stdcall;
begin
  Value := WideString(String(ColumnFields.GetText));
  Result := S_OK;
end;

function TfrxCustomCrossView.Set_ColumnFields(const Value: WideString): HResult; stdcall;
begin
  ColumnFields.SetText( PAnsiChar(String(Value)) );
  ColumnLevels := ColumnFields.Count;
  Result := S_OK;
end;

function TfrxCustomCrossView.Get_ColumnMemos(Index: Integer; out Value: IfrxCustomMemoView): HResult; stdcall;
begin
  Value := ColumnMemos[Index];
  Result := S_OK;
end;

function TfrxCustomCrossView.Get_ColumnSort(Index: Integer; out Value: frxCrossSortOrder): HResult; stdcall;
begin
  Value := frxCrossSortOrder(ColumnSort[Index]);
  Result := S_OK;
end;

function TfrxCustomCrossView.Set_ColumnSort(Index: Integer; Value: frxCrossSortOrder): HResult; stdcall;
begin
  ColumnSort[Index] := TfrxCrossSortOrder(Value);
  Result := S_OK;
end;

function TfrxCustomCrossView.Get_ColumnTotalMemos(Index: Integer; out Value: IfrxCustomMemoView): HResult; stdcall;
begin
  Value := ColumnTotalMemos[Index];
  Result := S_OK;
end;

function TfrxCustomCrossView.Get_RowFields(out Value: WideString): HResult; stdcall;
begin
  Value := WideString(String(RowFields.GetText));
  Result := S_OK;
end;

function TfrxCustomCrossView.Set_RowFields(const Value: WideString): HResult; stdcall;
begin
  RowFields.SetText( PAnsiChar(String(Value)) );
  RowLevels := RowFields.Count;
  Result := S_OK;
end;

function TfrxCustomCrossView.Get_RowMemos(Index: Integer; out Value: IfrxCustomMemoView): HResult; stdcall;
begin
  Value := RowMemos[Index];
  Result := S_OK;
end;

function TfrxCustomCrossView.Get_RowSort(Index: Integer; out Value: frxCrossSortOrder): HResult; stdcall;
begin
  Value := frxCrossSortOrder( RowSort[Index] );
  Result := S_OK;
end;

function TfrxCustomCrossView.Set_RowSort(Index: Integer; Value: frxCrossSortOrder): HResult; stdcall;
begin
  RowSort[Index] := TfrxCrossSortOrder( Value );
  Result := S_OK;
end;

function TfrxCustomCrossView.Get_RowTotalMemos(Index: Integer; out Value: IfrxCustomMemoView): HResult; stdcall;
begin
  Value := RowTotalMemos[Index];
  Result := S_OK;
end;

function TfrxCustomCrossView.Get_MaxWidth(out Value: Integer): HResult; stdcall;
begin
  Value := MaxWidth;
  Result := S_OK;
end;

function TfrxCustomCrossView.Set_MaxWidth(Value: Integer): HResult; stdcall;
begin
  MaxWidth := Value;
  Result := S_OK;
end;

function TfrxCustomCrossView.Get_MinWidth(out Value: Integer): HResult; stdcall;
begin
  Value := MinWidth;
  Result := S_OK;
end;

function TfrxCustomCrossView.Set_MinWidth(Value: Integer): HResult; stdcall;
begin
  MinWidth := Value;
  Result := S_OK;
end;

function TfrxCustomCrossView.AddValues(Rows: PSafeArray; Columns: PSafeArray; Cells: PSafeArray): HResult; stdcall;
type
  VariantArray = array of Variant;
var
  ArrayData: Pointer;
  R: VariantArray;
  C: VariantArray;
  V: VariantArray;
begin
  SafeArrayAccessData( Rows, ArrayData );
  R := VariantArray(ArrayData);
  SafeArrayUnAccessData( Rows );

  SafeArrayAccessData( Columns, ArrayData );
  C := VariantArray(ArrayData);
  SafeArrayUnAccessData( Columns );

  SafeArrayAccessData( Cells, ArrayData );
  V := VariantArray(ArrayData);
  SafeArrayUnAccessData( Cells );

  AddValue( R, C, V );
  Result := S_OK;
end;

function TfrxCustomCrossView.AddValuesVB6(Rows: OleVariant; Columns: OleVariant; Cells: OleVariant): HResult; stdcall;
var
  r: PSafeArray;
  c: PSafeArray;
  v: PSafeArray;
begin
  Result := E_HANDLE;
  repeat
    if not VarIsArray(Rows) then break;
    if not VarIsArray(Columns) then break;
    if not VarIsArray(Cells) then break;
    r := VarArrayLock(Rows);
    c := VarArrayLock(Columns);
    v := VarArrayLock(Cells);
    Result := AddValues(r, c, v);
    VarArrayUnlock(Cells);
    VarArrayUnlock(Columns);
    VarArrayUnlock(Rows);
  until True;
end;

function TfrxCustomCrossView.Get_GapX(out Value: Integer): HResult; stdcall;
begin
  Value := GapX;
  Result := S_OK;
end;

function TfrxCustomCrossView.Set_GapX(Value: Integer): HResult; stdcall;
begin
  GapX := Value;
  Result := S_OK;
end;

function TfrxCustomCrossView.Get_GapY(out Value: Integer): HResult; stdcall;
begin
  Value := GapY;
  Result := S_OK;
end;

function TfrxCustomCrossView.Set_GapY(Value: Integer): HResult; stdcall;
begin
  GapY := Value;
  Result := S_OK;
end;

function TfrxCustomCrossView.Get_PlainCells(out Value: WordBool): HResult; stdcall;
begin
  Value := PlainCells;
  Result := S_OK;
end;

function TfrxCustomCrossView.Set_PlainCells(Value: WordBool): HResult; stdcall;
begin
  PlainCells := Value;
  Result := S_OK;
end;

function TfrxCustomCrossView.Get_DownThenAcross(out Value: WordBool): HResult; stdcall;
begin
  Value := DownThenAcross;
  Result := S_OK;
end;

function TfrxCustomCrossView.Set_DownThenAcross(Value: WordBool): HResult; stdcall;
begin
  DownThenAcross := Value;
  Result := S_OK;
end;

function TfrxCustomCrossView.Get_RepeatHeaders(out Value: WordBool): HResult; stdcall;
begin
  Value := RepeatHeaders;
  Result := S_OK;
end;

function TfrxCustomCrossView.Set_RepeatHeaders(Value: WordBool): HResult; stdcall;
begin
  RepeatHeaders := Value;
  Result := S_OK;
end;

function TfrxCustomCrossView.Get_ShowColumnHeader(out Value: WordBool): HResult; stdcall;
begin
  Value := ShowColumnHeader;
  Result := S_OK;
end;

function TfrxCustomCrossView.Set_ShowColumnHeader(Value: WordBool): HResult; stdcall;
begin
  ShowColumnHeader := Value;
  Result := S_OK;
end;

function TfrxCustomCrossView.Get_ShowColumnTotal(out Value: WordBool): HResult; stdcall;
begin
  Value := ShowColumnTotal;
  Result := S_OK;
end;

function TfrxCustomCrossView.Set_ShowColumnTotal(Value: WordBool): HResult; stdcall;
begin
  ShowColumnTotal := Value;
  Result := S_OK;
end;

function TfrxCustomCrossView.Get_ShowRowHeader(out Value: WordBool): HResult; stdcall;
begin
  Value := ShowRowHeader;
  Result := S_OK;
end;

function TfrxCustomCrossView.Set_ShowRowHeader(Value: WordBool): HResult; stdcall;
begin
  ShowRowHeader := Value;
  Result := S_OK;
end;

function TfrxCustomCrossView.Get_ShowRowTotal(out Value: WordBool): HResult; stdcall;
begin
  Value := ShowRowTotal;
  Result := S_OK;
end;

function TfrxCustomCrossView.Set_ShowRowTotal(Value: WordBool): HResult; stdcall;
begin
  ShowRowTotal := Value;
  Result := S_OK;
end;
{$ENDIF}

{ TfrxCrossView }

class function TfrxCrossView.GetDescription: String;
begin
  Result := frxResources.Get('obCross');
end;

function TfrxCrossView.IsCrossValid: Boolean;
begin
  Result := (FCellLevels > 0) and (FRowLevels >= 0) and (FColumnLevels >= 0);
end;

procedure TfrxCrossView.SetCellLevels(const Value: Integer);
var
  i: Integer;
begin
  inherited;
  FCellFields.Clear;
  for i := 0 to Value - 1 do
    FCellFields.Add('Cell');
end;

procedure TfrxCrossView.SetColumnLevels(const Value: Integer);
var
  i: Integer;
begin
  inherited;
  FColumnFields.Clear;
  for i := 0 to Value - 1 do
    FColumnFields.Add('Column');
end;

procedure TfrxCrossView.SetRowLevels(const Value: Integer);
var
  i: Integer;
begin
  inherited;
  FRowFields.Clear;
  for i := 0 to Value - 1 do
    FRowFields.Add('Row');
end;


{ TfrxDBCrossView }

class function TfrxDBCrossView.GetDescription: String;
begin
  Result := frxResources.Get('obDBCross');
end;

function TfrxDBCrossView.IsCrossValid: Boolean;
begin
  Result := (DataSet <> nil) and (FCellLevels > 0) and
    (FRowFields.Count = FRowLevels) and (FColumnFields.Count = FColumnLevels) and
    (FCellFields.Count = FCellLevels);
end;

procedure TfrxDBCrossView.FillMatrix;
var
  i: Integer;
  RowValues, ColumnValues, CellValues: array of Variant;
  sl: TStringList;
begin
  SetLength(RowValues, FRowLevels);
  SetLength(ColumnValues, FColumnLevels);
  SetLength(CellValues, FCellLevels);
  sl := TStringList.Create;
  DataSet.GetFieldList(sl);
  sl.Sorted := True;

  DataSet.First;
  while not DataSet.Eof do
  begin
    for i := 0 to FRowLevels - 1 do
    begin
      if sl.IndexOf(FRowFields[i]) <> -1 then
        RowValues[i] := DataSet.Value[FRowFields[i]]
      else
        RowValues[i] := Report.Calc(FRowFields[i])
    end;
    for i := 0 to FColumnLevels - 1 do
    begin
      if sl.IndexOf(FColumnFields[i]) <> -1 then
        ColumnValues[i] := DataSet.Value[FColumnFields[i]]
      else
        ColumnValues[i] := Report.Calc(FColumnFields[i])
    end;
    for i := 0 to FCellLevels - 1 do
    begin
      if sl.IndexOf(FCellFields[i]) <> -1 then
        CellValues[i] := DataSet.Value[FCellFields[i]]
      else
        CellValues[i] := Report.Calc(FCellFields[i])
    end;
    AddValue(RowValues, ColumnValues, CellValues);
    DataSet.Next;
  end;

  sl.Free;
  RowValues := nil;
  ColumnValues := nil;
  CellValues := nil;
end;


initialization
  frxObjects.RegisterObject1(TfrxCrossView, nil, '', 'Other', 0, 42);
  frxObjects.RegisterObject1(TfrxDBCrossView, nil, '', 'Other', 0, 49);
  frxResources.Add('TfrxPrintCellEvent',
    'PascalScript=(Memo: TfrxMemoView; RowIndex, ColumnIndex, CellIndex: Integer; RowValues, ColumnValues, Value: Variant);' + #13#10 +
    'C++Script=(TfrxMemoView Memo, int RowIndex, int ColumnIndex, int CellIndex, variant RowValues, variant ColumnValues, variant Value)' + #13#10 +
    'BasicScript=(Memo, RowIndex, ColumnIndex, CellIndex, RowValues, ColumnValues, Value)' + #13#10 +
    'JScript=(Memo, RowIndex, ColumnIndex, CellIndex, RowValues, ColumnValues, Value)');
  frxResources.Add('TfrxPrintHeaderEvent',
    'PascalScript=(Memo: TfrxMemoView; HeaderIndexes, HeaderValues, Value: Variant);' + #13#10 +
    'C++Script=(TfrxMemoView Memo, variant HeaderIndexes, variant HeaderValues, variant Value)' + #13#10 +
    'BasicScript=(Memo, HeaderIndexes, HeaderValues, Value)' + #13#10 +
    'JScript=(Memo, HeaderIndexes, HeaderValues, Value)');
  frxResources.Add('TfrxCalcWidthEvent',
    'PascalScript=(ColumnIndex: Integer; ColumnValues: Variant; var Width: Extended);' + #13#10 +
    'C++Script=(int ColumnIndex, variant ColumnValues, float &Width)' + #13#10 +
    'BasicScript=(ColumnIndex, ColumnValues, byref Width)' + #13#10 +
    'JScript=(ColumnIndex, ColumnValues, &Width)');
  frxResources.Add('TfrxCalcHeightEvent',
    'PascalScript=(RowIndex: Integer; RowValues: Variant; var Height: Extended);' + #13#10 +
    'C++Script=(int RowIndex, variant RowValues, float &Height)' + #13#10 +
    'BasicScript=(RowIndex, RowValues, byref Height)' + #13#10 +
    'JScript=(RowIndex, RowValues, &Height)');


end.


//<censored>