frxcrosseditor.pas

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

  if FCross is TfrxCrossView then
  begin
    ColumnsLB.DragMode := dmManual;
    RowsLB.DragMode := dmManual;
    CellsLB.DragMode := dmManual;
    SwapB.Visible := False;
    DimensionsL.Visible := True;
    RowsE.Text := IntToStr(FCross.RowLevels);
    ColumnsE.Text := IntToStr(FCross.ColumnLevels);
    CellsE.Text := IntToStr(FCross.CellLevels);
  end
  else
    DatasetL.Visible := True;

  if FCross.DotMatrix then
  begin
    FontB.DropDownMenu := DMPPopup;
    FontB.OnClick := nil;
  end;

  ColumnHeaderCB.Checked := FCross.ShowColumnHeader;
  RowHeaderCB.Checked := FCross.ShowRowHeader;
  ColumnTotalCB.Checked := FCross.ShowColumnTotal;
  RowTotalCB.Checked := FCross.ShowRowTotal;

  FUpdating := False;
end;

procedure TfrxCrossEditorForm.FormHide(Sender: TObject);
begin
  if ModalResult = mrCancel then
    FCross.Assign(FTempCross);
end;

procedure TfrxCrossEditorForm.DrawCross;

  procedure FillMatrix;
  var
    i: Integer;
    RowValues, ColumnValues, CellValues: array of Variant;
  begin
    FCross.BeginMatrix;
    SetLength(RowValues, FCross.RowLevels);
    SetLength(ColumnValues, FCross.ColumnLevels);
    SetLength(CellValues, FCross.CellLevels);

    for i := 0 to FCross.RowLevels - 1 do
      RowValues[i] := FCross.RowFields[i];
    for i := 0 to FCross.ColumnLevels - 1 do
      ColumnValues[i] := FCross.ColumnFields[i];
    for i := 0 to FCross.CellLevels - 1 do
      CellValues[i] := 0;
    FCross.AddValue(RowValues, ColumnValues, CellValues);

    RowValues := nil;
    ColumnValues := nil;
    CellValues := nil;
    FCross.EndMatrix;
  end;

  procedure DrawSelection(Canvas: TCanvas; m: TfrxCustomMemoView);
  begin
    if m <> nil then
    with Canvas do
    begin
      Brush.Style := bsClear;
      Pen.Color := $00A9F9;
      Pen.Width := 2;
      Rectangle(Round(m.Left + 2), Round(m.Top + 2),
        Round(m.Left + m.Width - 0), Round(m.Top + m.Height - 0));
    end;
  end;

  procedure CorrectDMPBounds(Memo: TfrxCustomMemoView);
  begin
    if Memo is TfrxDMPMemoView then
    begin
      Memo.Left := Memo.Left + fr1CharX;
      Memo.Top := Memo.Top + fr1CharY;
      Memo.Width := Memo.Width - fr1CharX;
      Memo.Height := Memo.Height - fr1CharY;
    end;
  end;

  procedure DrawHeader(Canvas: TCanvas; Header: TfrxCrossHeader; p: TfrxPoint);
  var
    i: Integer;
    Items: TList;
    Item: TfrxCrossHeader;
    r: TfrxRect;
    m: TfrxCustomMemoView;
    s: String;
    fr: TfrxFrame;
  begin
    if not Header.Visible then Exit;
    Items := Header.AllItems;
    fr := TfrxFrame.Create;

    for i := 0 to Items.Count - 1 do
    begin
      Item := Items[i];
      m := Item.Memo;
      r := Item.Bounds;
      s := m.Text;
      m.Text := VarToStr(Item.Value);
      fr.Assign(m.Frame);
      if m.Frame.Typ = [] then
      begin
        m.Frame.Typ := [ftLeft, ftRight, ftTop, ftBottom];
        m.Frame.Color := $E8E8E8;
      end;

      m.SetBounds(r.Left + p.X, r.Top + p.Y, r.Right, r.Bottom);
      CorrectDMPBounds(m);
      if m.Visible then
      begin
        m.Draw(Canvas, 1, 1, 0, 0);
        if PtInRect(Rect(Round(r.Left + p.X), Round(r.Top + p.Y),
          Round(r.Left + p.X + r.Right), Round(r.Top + p.Y + r.Bottom)), FSelectedPoint) then
        begin
          FSelectedObject := m;
          FSelectedPoint := Point(0, 0);
          DrawSelection(Canvas, m);
        end;
      end;

      m.Text := s;
      m.Frame := fr;
    end;

    fr.Free;
    Items.Free;
  end;

  procedure DrawCell(Canvas: TCanvas; p: TfrxPoint);
  var
    i: Integer;
    h, CellOffs, CellWidth: Extended;
    Cell: Variant;
    ColumnItems, RowItems: TList;
    ColumnItem, RowItem: TfrxCrossHeader;
    m: TfrxCustomMemoView;
    CellRect: TRect;
  begin
    ColumnItems := FCross.Matrix.ColumnHeader.TerminalItems;
    RowItems := FCross.Matrix.RowHeader.TerminalItems;

    RowItem := RowItems[0];
    ColumnItem := ColumnItems[0];
    h := RowItem.Bounds.Bottom / FCross.CellLevels;
    CellOffs := 0;

    for i := 0 to FCross.CellLevels - 1 do
    begin
      Cell := FCross.Matrix.GetValue(0, 0, i);
      m := FCross.CellMemos[i];
      m.Text := m.FormatData(Cell);
      if FCross.PlainCells then
      begin
        CellWidth := ColumnItem.CellSizes[i];
        m.SetBounds(p.X + CellOffs, p.Y, CellWidth, RowItem.Bounds.Bottom);
        CellRect := Rect(Round(p.X + CellOffs), Round(p.Y),
          Round(p.X + CellOffs + CellWidth), Round(p.Y + RowItem.Bounds.Bottom));
        CellOffs := CellOffs + CellWidth;
      end
      else
      begin
        m.SetBounds(p.X, p.Y + i * h, ColumnItem.Bounds.Right, h);
        CellRect := Rect(Round(p.X), Round(p.Y + i * h),
          Round(p.X + ColumnItem.Bounds.Right), Round(p.Y + i * h + h));
      end;
      CorrectDMPBounds(m);
      m.Draw(Canvas, 1, 1, 0, 0);

      if PtInRect(CellRect, FSelectedPoint) then
      begin
        FSelectedObject := m;
        FSelectedPoint := Point(0, 0);
        DrawSelection(Canvas, m);
      end;
    end;

    ColumnItems.Free;
    RowItems.Free;
  end;

begin
  with PaintBox.Canvas do
  begin
    Brush.Color := clWindow;
    FillRect(Rect(0, 0, PaintBox.Width, PaintBox.Height));
  end;

  if FCross.IsCrossValid then
  begin
    FillMatrix;
    if not FCross.Matrix.NoColumns then
      DrawHeader(PaintBox.Canvas, FCross.Matrix.ColumnHeader,
        frxPoint(FCross.RowHeaderWidth + 10, 10));
    if not FCross.Matrix.NoRows then
      DrawHeader(PaintBox.Canvas, FCross.Matrix.RowHeader,
        frxPoint(10, FCross.ColumnHeaderHeight + 10));
    DrawCell(PaintBox.Canvas, frxPoint(FCross.RowHeaderWidth + 10,
      FCross.ColumnHeaderHeight + 10));
    DrawSelection(PaintBox.Canvas, FSelectedObject);
  end;
end;

procedure TfrxCrossEditorForm.PaintBoxPaint(Sender: TObject);
begin
  DrawCross;
end;

procedure TfrxCrossEditorForm.DatasetCBDrawItem(Control: TWinControl;
  Index: Integer; ARect: TRect; State: TOwnerDrawState);
begin
  DatasetCB.Canvas.FillRect(ARect);
  FImageList.Draw(DatasetCB.Canvas, ARect.Left, ARect.Top, 53);
  DatasetCB.Canvas.TextOut(ARect.Left + 20, ARect.Top + 1, DatasetCB.Items[Index]);
end;

procedure TfrxCrossEditorForm.DatasetCBClick(Sender: TObject);
var
  ds: TfrxCustomDBDataSet;
begin
  if DatasetCB.ItemIndex = -1 then Exit;
  ds := TfrxCustomDBDataSet(DatasetCB.Items.Objects[DatasetCB.ItemIndex]);
  ds.GetFieldList(FieldsLB.Items);
  RowsLB.Clear;
  ColumnsLB.Clear;
  CellsLB.Clear;
  if Sender <> nil then
    ReflectChanges;
end;

procedure TfrxCrossEditorForm.FieldsLBDrawItem(Control: TWinControl;
  Index: Integer; ARect: TRect; State: TOwnerDrawState);
begin
  FieldsLB.Canvas.FillRect(ARect);
  FImageList.Draw(FieldsLB.Canvas, ARect.Left, ARect.Top, 54);
  FieldsLB.Canvas.TextOut(ARect.Left + 20, ARect.Top + 1, FieldsLB.Items[Index]);
end;

procedure TfrxCrossEditorForm.ReflectChanges;
begin
  if DatasetCB.ItemIndex = -1 then
    FCross.DataSet := nil else
    FCross.DataSet := TfrxCustomDBDataSet(DatasetCB.Items.Objects[DatasetCB.ItemIndex]);
  if FCross is TfrxDBCrossView then
  begin
    FCross.RowFields := RowsLB.Items;
    FCross.ColumnFields := ColumnsLB.Items;
    FCross.CellFields := CellsLB.Items;
  end;
  FCross.RowLevels := FCross.RowFields.Count;
  FCross.ColumnLevels := FCross.ColumnFields.Count;
  FCross.CellLevels := FCross.CellFields.Count;
  FSelectedObject := nil;
  DrawCross;
  UpdateControls;
end;

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

procedure TfrxCrossEditorForm.LBDragDrop(Sender, Source: TObject; X,
  Y: Integer);
var
  s: String;
  i: Integer;
  CellExist: Boolean;
  SourceLB, SenderLB: TListBox;
begin
  SourceLB := TListBox(Source);
  SenderLB := TListBox(Sender);
  if (Source = Sender) and (Source <> FieldsLB) then
  begin
    i := SourceLB.ItemAtPos(Point(X, Y), True);
    if i = -1 then
      i := SourceLB.Items.Count - 1;
    SourceLB.Items.Exchange(SourceLB.ItemIndex, i);
  end
  else if Source <> Sender then
  begin
    if SourceLB.ItemIndex = -1 then Exit;
    s := SourceLB.Items[SourceLB.ItemIndex];

    CellExist := CellsLB.Items.IndexOf(s) >= 0;

    if not (((Source = CellsLB) and (Sender = FieldsLB)) or
      ((Source = FieldsLB) and (Sender <> CellsLB) and CellExist)) then
      SenderLB.Items.Add(s);
    i := FieldsLB.Items.IndexOf(s);
    if (Source = CellsLB) and (Sender <> FieldsLB) and (i <> -1) then
    begin
      FieldsLB.Items.Delete(i);
      repeat
        i := CellsLB.Items.IndexOf(s);
        if i <> -1 then
          CellsLB.Items.Delete(i);
      until i = -1;
    end;
    if (Source <> FieldsLB) and (Sender = CellsLB) then
      FieldsLB.Items.Add(s);

    if not (((Source = FieldsLB) and (Sender = CellsLB)) or
      ((Source = FieldsLB) and CellExist)) then
    begin
      i := SourceLB.ItemIndex;
      if (i <> -1) and (SourceLB.Items[i] = s) then
        SourceLB.Items.Delete(i);
    end;
  end;

  ReflectChanges;
end;

procedure TfrxCrossEditorForm.LBDrawItem(Control: TWinControl;
  Index: Integer; ARect: TRect; State: TOwnerDrawState);
var
  HasSubtotal: Boolean;
  sort: String;
begin
  with TListBox(Control), TListBox(Control).Canvas do
  begin
    FillRect(ARect);
    TextOut(ARect.Left + 2, ARect.Top + 1, Items[Index]);

    if Control = RowsLB then
      sort := FSortNames[FCross.RowSort[Index]] else
      sort := FSortNames[FCross.ColumnSort[Index]];
    TextOut(ARect.Left + 200, ARect.Top + 1, sort);

    if Index <> Items.Count - 1 then
    begin
      TextOut(ARect.Left + 135, ARect.Top + 1, frxResources.Get('crSubtotal'));
      Pen.Color := clGray;
      Brush.Color := clWindow;
      Rectangle(ARect.Left + 120, ARect.Top + 3, ARect.Left + 131, ARect.Top + 14);

      if Control = RowsLB then
        HasSubtotal := FCross.RowTotalMemos[Index + 1].Visible else
        HasSubtotal := FCross.ColumnTotalMemos[Index + 1].Visible;

      if HasSubtotal then
      begin
        Pen.Color := clBlack;
        with ARect do
        begin
          PolyLine([Point(Left + 122, Top + 7), Point(Left + 124, Top + 9), Point(Left + 129, Top + 4)]);
          PolyLine([Point(Left + 122, Top + 8), Point(Left + 124, Top + 10), Point(Left + 129, Top + 5)]);
          PolyLine([Point(Left + 122, Top + 9), Point(Left + 124, Top + 11), Point(Left + 129, Top + 6)]);
        end;
      end;
    end;

    Pen.Color := clGray;
    Brush.Color := clWindow;
    Rectangle(ARect.Left + 185, ARect.Top + 3, ARect.Left + 196, ARect.Top + 14);

    Pen.Color := clBlack;
    with ARect do
    begin
      MoveTo(Left + 187, Top + 7); LineTo(Left + 194, Top + 7);
      MoveTo(Left + 188, Top + 8); LineTo(Left + 193, Top + 8);
      MoveTo(Left + 189, Top + 9); LineTo(Left + 192, Top + 9);
      MoveTo(Left + 190, Top + 10); LineTo(Left + 191, Top + 10);
    end;
  end;
end;

procedure TfrxCrossEditorForm.LBClick(Sender: TObject);
begin
  if Sender <> FieldsLB then
    FieldsLB.ItemIndex := -1;
  if Sender <> RowsLB then
    RowsLB.ItemIndex := -1;
  if Sender <> ColumnsLB then
    ColumnsLB.ItemIndex := -1;
  if Sender <> CellsLB then
    CellsLB.ItemIndex := -1;
end;

procedure TfrxCrossEditorForm.LBDblClick(Sender: TObject);
var
  lb: TListBox;
  s: String;
begin
  lb := TListBox(Sender);

  s := Cross.Report.Designer.InsertExpression(lb.Items[lb.ItemIndex]);
  if s <> '' then
  begin
    lb.Items[lb.ItemIndex] := s;
    ReflectChanges;
  end;
end;

procedure TfrxCrossEditorForm.CancelBClick(Sender: TObject);
begin
  ModalResult := mrCancel;
end;

procedure TfrxCrossEditorForm.OkBClick(Sender: TObject);
begin
  ModalResult := mrOk;
end;

procedure TfrxCrossEditorForm.LBMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  Memo: TfrxCustomMemoView;
  sort: TfrxCrossSortOrder;
  i: Integer;
  pt: TPoint;
begin
  FCurList := TListBox(Sender);