rm_cross.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 2,297 行 · 第 1/5 页

  MakeTotals(Columns, True);
  Cell[Rows[0], Columns[Columns.Count - 1] + '+', 0] := 0;
  MakeTotals(Rows, False);
  Cell[Rows[Rows.Count - 1] + '+', Columns[0], 0] := 0;

  CalcTotals(FColFields, Rows, Columns);
  CalcTotals(FRowFields, Columns, Rows);
  CheckAvg;

  for i := 0 to FAddColumnsHeader.Count - 1 do
  begin
    Cell[Rows[0], Columns[Columns.Count - 1] + '+', 0] := 0;
  end;

  MakeColumnHeader;
  MakeRowHeader;
end;

function TRMCross.GetIsTotalRow(Index: Integer): Boolean;
begin
  Result := Pos('+;+', Rows[Index]) <> 0;
end;

function TRMCross.GetIsTotalColumn(Index: Integer): Boolean;
begin
  Result := Pos('+;+', Columns[Index]) <> 0;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TRMQuickArray }

constructor TRMQuickIntArray.Create(Length: Integer);
begin
  inherited Create;

  Len := Length;
  GetMem(arr, Len * SizeOf(TIntArrayCell));
  for Length := 0 to Len - 1 do
    arr[Length] := 0;
end;

destructor TRMQuickIntArray.Destroy;
begin
  FreeMem(arr, Len * SizeOf(TIntArrayCell));

  inherited;
end;

function TRMQuickIntArray.GetCell(Index: Integer): Integer;
begin
  Result := arr[Index];
end;

procedure TRMQuickIntArray.SetCell(Index: Integer; const Value: Integer);
begin
  arr[Index] := Value;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TRMCrossList }

function PureName1(s: string): string;
begin
  if Pos('+', s) <> 0 then
    Result := Copy(s, 1, Pos('+', s) - 1)
  else
    Result := s;
end;

constructor TRMCrossList.Create;
begin
  inherited Create;
  FList := TList.Create;
end;

destructor TRMCrossList.Destroy;
begin
  FreeAndNil(FList);
  inherited Destroy;
end;

procedure TRMCrossList.Add(v: TRMCrossView);
begin
  FList.Add(v);
  v.FSavedOnBeforePrint := v.ParentReport.OnBeforePrint;
  v.ParentReport.OnBeforePrint := v.ReportBeforePrint;
  v.FSavedOnPrintColumn := v.ParentReport.OnPrintColumn;
  v.ParentReport.OnPrintColumn := v.ReportPrintColumn;
end;

procedure TRMCrossList.Delete(v: TRMCrossView);
var
  i: Integer;
  v1: TRMCrossView;
begin
  v.ParentReport.OnBeforePrint := v.FSavedOnBeforePrint;
  v.ParentReport.OnPrintColumn := v.FSavedOnPrintColumn;

  i := FList.IndexOf(v);
  FList.Delete(i);

  if (i = 0) and (FList.Count > 0) then
  begin
    v := TRMCrossView(FList[0]);
    v.FSavedOnBeforePrint := v.ParentReport.OnBeforePrint;
    v.FSavedOnPrintColumn := v.ParentReport.OnPrintColumn;
  end;

  for i := 1 to FList.Count - 1 do
  begin
    v := TRMCrossView(FList[i]);
    v1 := TRMCrossView(FList[i - 1]);
    v.FSavedOnBeforePrint := v1.ReportBeforePrint;
    v.FSavedOnPrintColumn := v1.ReportPrintColumn;
  end;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMCrossView}

class function TRMCrossView.CanPlaceOnGridView: Boolean;
begin
  Result := False;
end;

function TRMCrossView.IsCrossView: Boolean;
begin
  Result := True;
end;

constructor TRMCrossView.Create;
begin
  inherited Create;
  FCross := nil;
  BaseName := 'Cross';

  DontUndo := True;
  OnePerPage := True;
  Restrictions := [rmrtDontSize, rmrtDontEditMemo];
  spWidth := 348;
  spHeight := 94;
  Visible := False;
  LeftFrame.Visible := True;
  TopFrame.Visible := True;
  RightFrame.Visible := True;
  BottomFrame.Visible := True;

  ParentReport := RMCurReport;
  RMCrossList.Add(Self);

  ShowRowTotal := False;
  ShowColumnTotal := False;
  ShowIndicator := True;
  SortColHeader := True;
  SortRowHeader := True;
  FInternalFrame := True;
  FDataWidth := 0; FDataHeight := 0;
  FHeaderWidth := '0';
  FHeaderHeight := '0';
  FDefDY := 18;

  FDictionary := TStringList.Create;
  FAddColumnsHeader := TStringList.Create;
end;

destructor TRMCrossView.Destroy;
var
  i: Integer;
  lPage: TRMReportPage;

  procedure _Del(s: string);
  var
    t: TRMView;
  begin
    if lPage <> nil then
    begin
      t := lPage.FindObject(s);
      if t <> nil then
        lPage.Delete(lPage.Objects.IndexOf(t));
    end;
  end;

begin
  lPage := nil;
  for i := 0 to ParentReport.Pages.Count - 1 do
  begin
    if ParentReport.Pages[i].FindObject(Self.Name) <> nil then
    begin
      lPage := TRMReportPage(ParentReport.Pages[i]);
      Break;
    end;
  end;

  _Del('ColumnHeaderMemo' + Name);
  _Del('ColumnTotalMemo' + Name);
  _Del('GrandColumnTotalMemo' + Name);
  _Del('RowHeaderMemo' + Name);
  _Del('CellMemo' + Name);
  _Del('RowTotalMemo' + Name);
  _Del('GrandRowTotalMemo' + Name);
  _Del('ColHeaderMemo' + Name);
  _Del('CrossHeaderMemo' + Name);

  RMCrossList.Delete(Self);

  FreeAndNil(FDictionary);
  FreeAndNil(FAddColumnsHeader);

  inherited Destroy;
end;

type
  THackReport = class(TRMReport)
  end;

  THackReportPage = class(TRMReportPage)
  end;

  THackMemoView = class(TRMMemoView)
  end;

  THackUserDataset = class(TRMUserDataset)
  end;

function TRMCrossView.OneObject(aPage: TRMReportPage; Name1, Name2: string): TRMMemoView;
begin
  Result := TRMMemoView(RMCreateObject(rmgtMemo, ''));
  Result.ParentPage := aPage;
  Result.Name := Name1 + Name;
  Result.Memo.Add(Name2);
  Result.Font.Style := [fsBold];
  Result.spWidth := 80;
  Result.spHeight := FDefDY;
  Result.HAlign := rmHCenter;
  Result.VAlign := rmVCenter;
  Result.LeftFrame.Visible := True;
  Result.RightFrame.Visible := True;
  Result.TopFrame.Visible := True;
  Result.BottomFrame.Visible := True;
  Result.Restrictions := [rmrtDontSize, rmrtDontMove, rmrtDontDelete];
  THackMemoView(Result).IsChildView := True;
  Result.Visible := False;
end;

function TRMCrossView.ParentPage: TRMReportPage;
var
  i: Integer;
begin
  Result := nil;
  for i := 0 to ParentReport.Pages.Count - 1 do
  begin
    if ParentReport.Pages[i].FindObject(Self.Name) <> nil then
    begin
      Result := TRMReportPage(ParentReport.Pages[i]);
      Break;
    end;
  end;
end;

procedure TRMCrossView.CreateObjects;
var
  v: TRMMemoView;
  p: TRMReportPage;
begin
  p := ParentPage;

  OneObject(p, 'ColumnHeaderMemo', RMLoadStr(rmRes + 755)); //'Header'

  v := OneObject(p, 'ColumnTotalMemo', RMLoadStr(rmRes + 756)); //'Total'
  v.FillColor := $F5F5F5;

  v := OneObject(p, 'GrandColumnTotalMemo', RMLoadStr(rmRes + 757)); //'Grand total'
  v.FillColor := clSilver;

  OneObject(p, 'RowHeaderMemo', RMLoadStr(rmRes + 755)); //'Header'

  v := OneObject(p, 'CellMemo', RMLoadStr(rmRes + 758)); //'Cell'
  v.Font.Style := [];

  v := OneObject(p, 'RowTotalMemo', RMLoadStr(rmRes + 756)); //'Total'
  v.FillColor := $F5F5F5;

  v := OneObject(p, 'GrandRowTotalMemo', RMLoadStr(rmRes + 757)); //'Grand total'
  v.FillColor := clSilver;

  OneObject(p, 'CrossHeaderMemo', '');
end;

procedure TRMCrossView.ShowEditor;
var
  tmp: TRMCrossForm;
begin
  tmp := TRMCrossForm.Create(Application);
  try
    tmp.Cross := Self;
    tmp.ShowModal;
  finally
    tmp.Free;
  end;
end;

procedure TRMCrossView.Draw(aCanvas: TCanvas);
var
  v: TRMView;
  bmp: TBitmap;
  p: TRMReportPage;
begin
  if ParentReport.FindObject('ColumnHeaderMemo' + Name) = nil then
    CreateObjects;
  BeginDraw(aCanvas);
  CalcGaps;
  ShowBackground;
  ShowFrame;

  v := ParentReport.FindObject('ColumnHeaderMemo' + Name);
  v.SetspBounds(spLeft + 92, spTop + 8, v.spWidth, v.spHeight);
  v.Draw(aCanvas);

  v := ParentReport.FindObject('ColumnTotalMemo' + Name);
  v.SetspBounds(spLeft + 176, spTop + 8, v.spWidth, v.spHeight);
  v.Draw(aCanvas);

  v := ParentReport.FindObject('GrandColumnTotalMemo' + Name);
  v.SetspBounds(spLeft + 260, spTOp + 8, v.spWidth, v.spHeight);
  v.Draw(aCanvas);

  v := ParentReport.FindObject('RowHeaderMemo' + Name);
  v.SetspBounds(spLeft + 8, spTop + 28, v.spWidth, v.spHeight);
  v.Draw(aCanvas);

  v := ParentReport.FindObject('CellMemo' + Name);
  v.SetspBounds(spLeft + 92, spTop + 28, v.spWidth, v.spHeight);
  v.Draw(aCanvas);

  v := ParentReport.FindObject('RowTotalMemo' + Name);
  v.SetspBounds(spLeft + 8, spTop + 48, v.spWidth, v.spHeight);
  v.Draw(aCanvas);

  v := ParentReport.FindObject('GrandRowTotalMemo' + Name);
  v.SetspBounds(spLeft + 8, spTop + 68, v.spWidth, v.spHeight);
  v.Draw(aCanvas);

  v := ParentReport.FindObject('CrossHeaderMemo' + Name);
  if v = nil then
  begin
    p := ParentPage;
    v := OneObject(p, 'CrossHeaderMemo', '');
  end;
  v.SetspBounds(spLeft + 8, spTop + 8, v.spWidth, v.spHeight);
  v.Draw(aCanvas);

  bmp := TBitmap.Create;
  try
    bmp.Handle := LoadBitmap(hInstance, 'RM_CrossObject');
    aCanvas.Draw(spLeft + spWidth - 20, spTop + spHeight - 20, bmp);
  finally
    bmp.Free;
  end;
  RestoreCoord;
end;

procedure TRMCrossView.LoadFromStream(aStream: TStream);
begin
  inherited LoadFromStream(aStream);
  RMReadWord(aStream);
  FInternalFrame := RMReadBoolean(aStream);
  FRepeatCaptions := RMReadBoolean(aStream);
  FShowHeader := RMReadBoolean(aStream);
  FDataWidth := RMReadInt32(aStream);
  FDataHeight := RMReadInt32(aStream);
  FHeaderWidth := RMReadString(aStream);
  FHeaderHeight := RMReadString(aStream);
  FDictionary.Text := RMReadString(aStream);
  FRowNoHeader := RMReadString(aStream);
  RMReadMemo(aStream, FAddColumnsHeader);
  OnePerPage := True;
end;

procedure TRMCrossView.SaveToStream(aStream: TStream);
begin
  inherited SaveToStream(aStream);
  RMWriteWord(aStream, 0);
  RMWriteBoolean(aStream, FInternalFrame);
  RMWriteBoolean(aStream, FRepeatCaptions);
  RMWriteBoolean(aStream, FShowHeader);
  RMWriteInt32(aStream, FDataWidth);
  RMWriteInt32(aStream, FDataHeight);
  RMWriteString(aStream, FHeaderWidth);
  RMWriteString(aStream, FHeaderHeight);
  RMWriteString(aStream, FDictionary.Text);
  RMWriteString(aStream, FRowNoHeader);
  RMWriteMemo(aStream, FAddColumnsHeader);
end;

procedure TRMCrossView.CalcWidths;
var
  i, w, maxw, h, maxh, k: Integer;
  v: TRMView;
  b: TBitmap;
  m: TStringList;
begin
  ParentReport.CurrentPage := ParentPage;

  FFlag := True;
  if FDataWidth <= 0 then
    FColumnWidths := TRMQuickIntArray.Create(FCross.Columns.Count + 1)
  else if (FHeaderWidth = '') or (FHeaderWidth = '0') then
    FColumnWidths := TRMQuickIntArray.Create(FCross.TopLeftSize.cx + 1);

  FColumnHeights := TRMQuickIntArray.Create(FCross.TopLeftSize.cy + 2);
  FLastTotalCol := TRMQuickIntArray.Create(FCross.TopLeftSize.cy + 1);

  if FDataHeight > 0 then
    FMaxCellHeight := FDataHeight
  else
    FMaxCellHeight := 0;
  FMaxGTHeight := 0;

  if not ShowRowTotal then
    FRowDS.RangeEndCount := FRowDS.RangeEndCount - 1;
  if not ShowColumnTotal then
    FColumnDS.RangeEndCount := FColumnDS.RangeEndCount - 1;

  for k := 0 to FCRoss.CellItemsCount - 1 do
  begin
    v := ParentReport.FindObject('CrossMemo@' + IntToStr(k) + Name);
    m := TStringList.Create;
    b := TBitmap.Create;
    THackMemoView(v).Canvas := b.Canvas;

    if (FHeaderWidth = '') or (FHeaderWidth = '0') then
    begin
      FColumnDS.First;
      while FColumnDS.RecordNo < FCross.TopLeftSize.cx do
      begin
        maxw := 0;

        FRowDS.First;
        FRowDS.Next;
        while not FRowDS.EOF do
        begin
          ReportBeforePrint(nil, TRMReportView(v));
          m.Assign(v.Memo);
          if m.Count = 0 then
            m.Add(' ');
          w := THackMemoView(v).CalcWidth(m) + 5;
          if w > maxw then
            maxw := w;
          FRowDS.Next;
        end;
        if FColumnWidths.Cell[FColumnDS.RecordNo] < maxw then
          FColumnWidths.Cell[FColumnDS.RecordNo] := maxw;
        FColumnDS.Next;
      end;
    end;

    if FDataWidth <= 0 then