rm_cross.pas

report machine 2.3 功能强大

      Assign(TRMMemoView(View), TRMMemoView(FReport.FindObject('GrandColumnTotalMemo' + Name)))
    else if row = FCross.Rows.Count - 1 then // grand total row
      Assign(TRMMemoView(View), TRMMemoView(FReport.FindObject('GrandRowTotalMemo' + Name)))
    else if FCross.IsTotalColumn[col] and (row > 0) then // "total" column
    begin
      if (View.Prop['FrameTyp'] and RMftLeft) <> 0 then
        Assign(TRMMemoView(View), TRMMemoView(FReport.FindObject('ColumnTotalMemo' + Name)));
    end
    else if FCross.IsTotalRow[row] then // "total" row
    begin
      if (col >= FCross.TopLeftSize.cx) or ((View.Prop['FrameTyp'] and RMftTop) <> 0) then
        Assign(TRMMemoView(View), TRMMemoView(FReport.FindObject('RowTotalMemo' + Name)));
    end;

    if not hd then
    begin
      TRMMemoView(View).Alignment := al;
      v1 := TRMMemoView(FReport.FindObject('CellMemo' + Name));
      TRMMemoView(View).Format := v1.Format;
      TRMMemoView(View).FormatStr := v1.FormatStr;
    end;

    if (row <= FCross.TopLeftSize.cy) and (col < FCross.TopLeftSize.cx) then
      View.FillColor := clNone;

    if (col >= FCross.TopLeftSize.cx) and (row > FCross.TopLeftSize.cy) then // cross body
    begin
      s := '';
      for i := 0 to FCross.CellItemsCount - 1 do
      begin
        v := FCross.CellByIndex[row, col, i];
        RMVariables['CrossVariable'] := v;
        CurView := View;
        FReport.InternalOnGetValue('CrossVariable', s1);
        s := s + s1 + #13#10;
      end;
    end
    else
    begin
      v := FCross.CellByIndex[row, col, 0];
      if v = Null then
        s := ''
      else
      begin
        RMVariables['CrossVariable'] := v;
        CurView := View;
        FReport.InternalOnGetValue('CrossVariable', s);
      end;
    end;

    b := (row = 0) and (col = FCross.TopLeftSize.cx);
    View.Prop['AutoWidth'] := b;
    View.Prop['WordWrap'] := not b;

    View.Memo.Text := s;
  end;

  if Assigned(FSavedOnBeforePrint) then
    FSavedOnBeforePrint(Memo, View);
end;

procedure TRMCrossView.ReportBeginDoc;
var
  v: TRMView;
begin
  Visible := False;
  FSkip := False;
  if (Memo.Count < 4) or (Trim(Memo[0]) = '') or (Trim(Memo[1]) = '') or
    (Trim(Memo[2]) = '') or (Trim(Memo[3]) = '') then
  begin
    FSkip := True;
    if Assigned(FSavedOnBeginDoc) then
      FSavedOnBeginDoc;
    Exit;
  end;

  if FReport.FindObject('ColumnHeaderMemo' + Name) = nil then
    CreateObjects;

  FCross := TRMCross.Create(TDataSet(
    RMFindComponent(FReport.Owner, FReport.Dictionary.RealDatasetName[Memo[0]])),
    Memo[1], Memo[2], Memo[3]);

  v := FReport.FindObject('ColumnTotalMemo' + Name);
  if (v <> nil) and (v.Memo.Count > 0) then
    FCross.ColumnTotalString := v.Memo[0];

  v := FReport.FindObject('GrandColumnTotalMemo' + Name);
  if (v <> nil) and (v.Memo.Count > 0) then
    FCross.ColumnGrandTotalString := v.Memo[0];

  v := FReport.FindObject('RowTotalMemo' + Name);
  if (v <> nil) and (v.Memo.Count > 0) then
    FCross.RowTotalString := v.Memo[0];

  v := FReport.FindObject('GrandRowTotalMemo' + Name);
  if (v <> nil) and (v.Memo.Count > 0) then
    FCross.RowGrandTotalString := v.Memo[0];

  FCross.Build;
  if FCross.Columns.Count = 0 then
  begin
    FCross.Free;
    FSkip := True;
    if Assigned(FSavedOnBeginDoc) then
      FSavedOnBeginDoc;
    Exit;
  end;

  FRowDS := TRMUserDataset.Create(FReport.Owner);
  FRowDS.Name := 'RowDS' + Name;
  FRowDS.RangeEnd := reCount;
  FRowDS.RangeEndCount := FCross.Rows.Count;
  if not PShowRowTotal then
    FRowDS.RangeEndCount := FRowDS.RangeEndCount - 1;

  FColumnDS := TRMUserDataset.Create(FReport.Owner);
  FColumnDS.Name := 'ColumnDS' + Name;
  FColumnDS.RangeEnd := reCount;
  FColumnDS.RangeEndCount := FCross.Columns.Count;
  if not PShowColTotal then
    FColumnDS.RangeEndCount := FColumnDS.RangeEndCount - 1;

  MakeBands;
  if Assigned(FAfterCreateObjects) then
  	FAfterCreateObjects(Self);
  if Assigned(FSavedOnBeginDoc) then
    FSavedOnBeginDoc;
//  FReport.SaveToFile('e:\ls');
end;

procedure TRMCrossView.ReportEndDoc;
begin
  if not FSkip then
  begin
    FCross.Free;
    FRowDS.Free;
    FColumnDS.Free;
    VarClear(FColumnWidths);
    VarClear(FColumnHeights);
  end;
  if Assigned(FSavedOnEndDoc) then
    FSavedOnEndDoc;
end;

function TRMCrossView.GetShowRowTotal: Boolean;
begin
  Result := (Flags and flCrossShowRowTotal) <> 0;
end;

procedure TRMCrossView.SetShowRowTotal(Value: Boolean);
begin
  if (Restrictions and RMrfDontModify) = 0 then
    Flags := (Flags and not flCrossShowRowTotal) + Word(value) * flCrossShowRowTotal;
end;

function TRMCrossView.GetShowColTotal: Boolean;
begin
  Result := (Flags and flCrossShowColTotal) <> 0;
end;

procedure TRMCrossView.SetShowColTotal(Value: Boolean);
begin
  if (Restrictions and RMrfDontModify) = 0 then
    Flags := (Flags and not flCrossShowColTotal) + Word(value) * flCrossShowColTotal;
end;

function TRMCrossView.GetShowIndicator: Boolean;
begin
  Result := (Flags and flCrossShowIndicator) <> 0;
end;

procedure TRMCrossView.SetShowIndicator(Value: Boolean);
begin
  if (Restrictions and RMrfDontModify) = 0 then
    Flags := (Flags and not flCrossShowIndicator) + Word(value) * flCrossShowIndicator;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMCrossForm}

procedure TRMCrossForm.FillDatasetsLB;
var
  sl: TStringList;
begin
  sl := TStringList.Create;
  DatasetsLB.Items.BeginUpdate;
  CurReport.Dictionary.GetDatasetList(DatasetsLB.Items);
  DatasetsLB.Items.EndUpdate;
  sl.Free;
end;

procedure TRMCrossForm.DatasetsLBClick(Sender: TObject);
var
  i: Integer;
  sl: TStringList;
begin
  if Integer(DatasetsLB.Items.Objects[DatasetsLB.ItemIndex]) = 1 then
  begin
    sl := TStringList.Create;
    CurReport.Dictionary.GetVariablesList(DatasetsLB.Items[DatasetsLB.ItemIndex], sl);
    FieldsLB.Items.Clear;
    for i := 0 to sl.Count - 1 do
      FieldsLB.Items.AddObject(sl[i], TObject(1));
    sl.Free;
  end
  else
    CurReport.Dictionary.GetFieldList(DatasetsLB.Items[DatasetsLB.ItemIndex],
      FieldsLB.Items)
end;

procedure TRMCrossForm.ListBox3Enter(Sender: TObject);
begin
  FListBox := TListBox(Sender);
end;

procedure TRMCrossForm.ClearSelection(Sender: TObject);
var
  i: Integer;
begin
  for i := 0 to GroupBox1.ControlCount - 1 do
  begin
    if (GroupBox1.Controls[i] <> Sender) and (GroupBox1.Controls[i] is TListBox) then
      (GroupBox1.Controls[i] as TListBox).ItemIndex := -1;
  end;
  CheckBox1.Enabled := Sender <> ListBox4;
  ComboBox2.Enabled := Sender = ListBox4;
end;

procedure TRMCrossForm.ListBox3Click(Sender: TObject);
var
  s: string;
begin
  if (FListBox <> nil) and (FListBox.ItemIndex <> -1) then
  begin
    s := FListBox.Items[FListBox.ItemIndex];
    FBusy := True;
    CheckBox1.Checked := Pos('+', s) <> 0;
    FBusy := False;
  end;
  ClearSelection(Sender);
end;

procedure TRMCrossForm.CheckBox1Click(Sender: TObject);
var
  i: Integer;
  s: string;
begin
  if FBusy then Exit;
  if (FListBox <> nil) and (FListBox.ItemIndex <> -1) then
  begin
    i := FListBox.ItemIndex;
    s := FListBox.Items[i];
    if Pos('+', s) <> 0 then
      s := Copy(s, 1, Length(s) - 1)
    else
      s := s + '+';
    FListBox.Items[i] := s;
    FListBox.ItemIndex := i;
  end;
  TDrawPanel(DrawPanel).Paint;
end;

procedure TRMCrossForm.ListBox4Click(Sender: TObject);
var
  s: string;
begin
  FBusy := True;
  if ListBox4.ItemIndex <> -1 then
  begin
    ComboBox2.Enabled := True;
    s := ListBox4.Items[ListBox4.ItemIndex];
    if Pos('+', s) = 0 then
      ComboBox2.ItemIndex := 0
    else
    begin
      s := AnsiLowerCase(Copy(s, Pos('+', s) + 1, 255));
      if (s = '') or (s = 'sum') then
        ComboBox2.ItemIndex := 1
      else if s = 'min' then
        ComboBox2.ItemIndex := 2
      else if s = 'max' then
        ComboBox2.ItemIndex := 3
      else if s = 'avg' then
        ComboBox2.ItemIndex := 4
      else if s = 'count' then
        ComboBox2.ItemIndex := 5
    end;
  end;
  FBusy := False;
  ClearSelection(Sender);
end;

procedure TRMCrossForm.ComboBox2Click(Sender: TObject);
var
  i: Integer;
  s: string;
begin
  if FBusy then Exit;
  if ListBox4.ItemIndex <> -1 then
  begin
    i := ListBox4.ItemIndex;
    s := PureName1(ListBox4.Items[i]);
    case ComboBox2.ItemIndex of
      0: ;
      1: s := s + '+';
      2: s := s + '+min';
      3: s := s + '+max';
      4: s := s + '+avg';
      5: s := s + '+count';
    end;
    ListBox4.Items[i] := s;
    ListBox4.ItemIndex := i;
  end;
end;

procedure TRMCrossForm.ListBox3DblClick(Sender: TObject);
begin
  CheckBox1.Checked := not CheckBox1.Checked;
end;

procedure TRMCrossForm.ListBox4DrawItem(Control: TWinControl;
  Index: Integer; ARect: TRect; State: TOwnerDrawState);
var
  s: string;
begin
  with TListBox(Control).Canvas do
  begin
    s := TListBox(Control).Items[Index];
    FillRect(ARect);
    if Pos('+', s) <> 0 then
    begin
      TextOut(ARect.Left + 1, ARect.Top, Copy(s, 1, Pos('+', s) - 1));
      s := Copy(s, Pos('+', s) + 1, 255);
      if s = '' then
      begin
        if Control = ListBox4 then
          s := 'sum'
        else
          s := 'total';
      end;
      TextOut(ARect.Right - TextWidth(s) - 2, ARect.Top, s);
    end
    else
      TextOut(ARect.Left + 1, ARect.Top, s);
  end;
end;

procedure TRMCrossForm.FieldsLBDragOver(Sender, Source: TObject; X,
  Y: Integer; State: TDragState; var Accept: Boolean);
begin
  Accept := TListBox(Source).Items.Count > 0;
end;

function GetLBIndex(LB: TListBox; s: string): Integer;
var i: Integer;
begin
  Result := -1;
  for i := 0 to LB.Items.Count - 1 do
  begin
    if PureName1(Lb.Items[i]) = s then
    begin
      Result := i;
      Exit;
    end;
  end;
end;

procedure TRMCrossForm.FieldsLBDragDrop(Sender, Source: TObject; X,
  Y: Integer);
var
  s: string;
  i: Integer;
  L4Exist: Boolean;
begin
  if (Source = Sender) and (Source <> FieldsLB) then
  begin
    i := TListBox(Source).ItemAtPos(Point(x, y), True);
    if i = -1 then
      i := TListBox(Source).Items.Count - 1;
    TListBox(Source).Items.Exchange(TListBox(Source).ItemIndex, i);
  end
  else if Source <> Sender then
  begin
    if TListBox(Source).ItemIndex = -1 then Exit;
    s := PureName1(TListBox(Source).Items[TListBox(Source).ItemIndex]);
    L4Exist := GetLBIndex(ListBox4, s) >= 0;
    if Source = FieldsLB then
      s := s + '+';
    if (not ((Source = ListBox4) and (Sender = FieldsLB))) and
      (not ((Source = FieldsLB) and (Sender <> ListBox4) and L4Exist)) then
      TListBox(Sender).Items.Add(s);
    i := GetLBIndex(FieldsLB, PureName1(s));
    if (Source = ListBox4) and (Sender <> FieldsLB) and (i <> -1) then
    begin
      FieldsLB.Items.Delete(i);
      repeat
        i := GetLBIndex(ListBox4, PureName1(s));
        if i <> -1 then ListBox4.Items.Delete(i);
      until i = -1;
    end;
    if (Source <> FieldsLB) and (Sender = ListBox4) then
      FieldsLB.Items.Add(s);
    if (not ((Source = FieldsLB) and (Sender = ListBox4))) and (not ((Source = FieldsLB) and L4Exist)) then
    begin
      i := TListBox(Source).ItemIndex;
      if (i <> -1) and (Pos(PureName1(s), TListBox(Source).Items[i]) = 1) then
        TListBox(Source).Items.Delete(i);
    end;
  end;
  TDrawPanel(DrawPanel).Paint;
end;

procedure TRMCrossForm.FormShow(Sender: TObject);
var
  i: Integer;
  sl: TStringList;
  s: string;
begin
  sl := TStringList.Create;
  FillDatasetsLB;

  if Cross.Memo.Count >= 4 then
  begin
    i := DatasetsLB.Items.IndexOf(Cross.Memo[0]);
    if i <> -1 then
    begin
      DatasetsLB.ItemIndex := i;
      DatasetsLBClick(nil);

      RMSetCommaText(Cross.Memo[1], sl);
      for i := 0 to sl.Count - 1 do
      begin
        s := PureName1(sl[i]);
        if FieldsLB.Items.IndexOf(s) <> -1 then
          FieldsLB.Items.Delete(FieldsLB.Items.IndexOf(s));
      end;
      ListBox2.Items.Assign(sl);

      RMSetCommaText(Cross.Memo[2], sl);
      for i := 0 to sl.Count - 1 do
      begin
        s := PureName1(sl[i]);
        if FieldsLB.Items.IndexOf(s) <> -1 then
          FieldsLB.Items.Delete(FieldsLB.Items.IndexOf(s));
      end;
      ListBox3.Items.Assign(sl);

      RMSetCommaText(Cross.Memo[3], sl);
      ListBox4.Items.Assign(sl);
    end;
  end
  else
  begin
    if DatasetsLB.Items.Count > 0 then
      DatasetsLB.ItemIndex := 0;
    DatasetsLBClick(nil);
    ListBox2.Clear;
    ListBox3.Clear;
    ListBox4.Clear;
  end;

  sl.Free;
end;

procedure TRMCrossForm.FormHide(Sender: TObject);
var
  i: Integer;
  s: string;
begin
  if ModalResult = mrOk then
  begin
    RMDesigner.BeforeChange;
    Cross.Memo.Clear;
    Cross.Memo.Add(DatasetsLB.Items[DatasetsLB.ItemIndex]);

    s := '';
    f