frxcrosseditor.pas

这个是功能强大的报表软件

destructor TfrxCrossEditorForm.Destroy;
begin
  FImages.Free;
  FStyleSheet.Free;
  FTempCross.Free;
  inherited;
end;

procedure TfrxCrossEditorForm.FormCreate(Sender: TObject);
begin
  Caption := frxGet(4300);
  DatasetL.Caption := frxGet(4301);
  DimensionsL.Caption := frxGet(4302);
  RowsL.Caption := frxGet(4303);
  ColumnsL.Caption := frxGet(4304);
  CellsL.Caption := frxGet(4305);
  StructureL.Caption := frxGet(4306);
  RowHeaderCB.Caption := frxGet(4307);
  ColumnHeaderCB.Caption := frxGet(4308);
  RowTotalCB.Caption := frxGet(4309);
  ColumnTotalCB.Caption := frxGet(4310);
  SwapB.Hint := frxGet(4311);
  Func1MI.Caption := frxGet(4322);
  Func2MI.Caption := frxGet(4323);
  Func3MI.Caption := frxGet(4324);
  Func4MI.Caption := frxGet(4325);
  Func5MI.Caption := frxGet(4326);
  Func6MI.Caption := frxGet(4327);
  Sort1MI.Caption := frxGet(4328);
  Sort2MI.Caption := frxGet(4329);
  Sort3MI.Caption := frxGet(4330);
  TitleCB.Caption := frxGet(4314);
  CornerCB.Caption := frxGet(4315);
  AutoSizeCB.Caption := frxGet(4317);
  BorderCB.Caption := frxGet(4318);
  DownAcrossCB.Caption := frxGet(4319);
  RepeatCB.Caption := frxGet(4316);
  PlainCB.Caption := frxGet(4320);
  JoinCB.Caption := frxGet(4321);
  StyleB.Caption := frxGet(4312);
  SaveStyleMI.Caption := frxGet(4313);
  OkB.Caption := frxGet(1);
  CancelB.Caption := frxGet(2);

{$IFDEF UseTabset}
  Box.BevelKind := bkFlat;
{$ELSE}
  Box.BorderStyle := bsSingle;
{$IFDEF Delphi7}
  Box.ControlStyle := Box.ControlStyle + [csNeedsBorderPaint];
{$ENDIF}
{$ENDIF}
  CreateStyleMenu;
  StylePopup.Images := FImages;

  if UseRightToLeftAlignment then
    FlipChildren(True);
end;

procedure TfrxCrossEditorForm.FormShow(Sender: TObject);

  procedure SelectDataset;
  begin
    DatasetCB.ItemIndex := DatasetCB.Items.IndexOfObject(FCross.DataSet);
    if DatasetCB.ItemIndex = -1 then
      DatasetCB.ItemIndex := 0;
    DatasetCBClick(nil);
  end;

  procedure SelectFields;
  var
    i: Integer;
  begin
    for i := 0 to FCross.RowFields.Count - 1 do
      RowsLB.Items.Add(FCross.RowFields[i]);

    for i := 0 to FCross.ColumnFields.Count - 1 do
      ColumnsLB.Items.Add(FCross.ColumnFields[i]);

    CellsLB.Items := FCross.CellFields;
  end;

begin
  FTempCross.Assign(FCross);
  FCross.Report.GetDataSetList(DatasetCB.Items);
  SelectDataset;
  SelectFields;

  FUpdating := True;

  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;

  TitleCB.Checked := FCross.ShowTitle;
  CornerCB.Checked := FCross.ShowCorner;
  ColumnHeaderCB.Checked := FCross.ShowColumnHeader;
  RowHeaderCB.Checked := FCross.ShowRowHeader;
  ColumnTotalCB.Checked := FCross.ShowColumnTotal;
  RowTotalCB.Checked := FCross.ShowRowTotal;

  AutoSizeCB.Checked := FCross.AutoSize;
  BorderCB.Checked := FCross.Border;
  DownAcrossCB.Checked := FCross.DownThenAcross;
  RepeatCB.Checked := FCross.RepeatHeaders;
  PlainCB.Checked := FCross.PlainCells;
  JoinCB.Checked := FCross.JoinEqualCells;

  StyleB.Visible := not FCross.DotMatrix;

  FUpdating := False;
end;

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

procedure TfrxCrossEditorForm.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_F1 then
    frxResources.Help(Self);
end;

procedure TfrxCrossEditorForm.CreateStyleMenu;
var
  i: Integer;
  sl: TStringList;
  m: TMenuItem;
  b: TBitmap;
  Style: TfrxStyles;
begin
  sl := TStringList.Create;
  FStyleSheet.GetList(sl);

  FImages.Clear;
  b := TBitmap.Create;
  b.Width := 16;
  b.Height := 16;
  frxResources.MainButtonImages.Draw(b.Canvas, 0, 0, 2);
  FImages.Add(b, nil);

  { create thumbnail images for each style }
  for i := 0 to sl.Count - 1 do
  begin
    Style := FStyleSheet[i];
    with b.Canvas do
    begin
      Brush.Color := Style.Find('column').Color;
      if Brush.Color = clNone then
        Brush.Color := clWhite;
      FillRect(Rect(0, 0, 16, 8));
      Brush.Color := Style.Find('cell').Color;
      if Brush.Color = clNone then
        Brush.Color := clWhite;
      FillRect(Rect(0, 8, 16, 16));
      Pen.Color := clSilver;
      Brush.Style := bsClear;
      Rectangle(0, 0, 16, 16);
    end;
    FImages.Add(b, nil);
  end;

  while StylePopup.Items[0] <> Sep1 do
    StylePopup.Items[0].Free;

  for i := sl.Count - 1 downto 0 do
  begin
    m := TMenuItem.Create(StylePopup);
    m.Caption := sl[i];
    m.ImageIndex := i + 1;
    m.OnClick := StyleClick;
    StylePopup.Items.Insert(0, m);
  end;
  
  b.Free;
  sl.Free;
end;

procedure TfrxCrossEditorForm.ReflectChanges(ChangesFrom: TObject; UpdateText: Boolean);
var
  i, j: Integer;
  s: String;
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;

  if ChangesFrom = nil then // change all
  begin
    if FCross.CellLevels = 1 then
      if UpdateText then
        FCross.CornerMemos[0].Text := FCross.CellFields[0]
    else
    begin
      FCross.CornerMemos[0].Text := '';
      FCross.CornerMemos[2].Text := 'Data';
    end;

    if UpdateText then
      for i := 0 to FCross.RowLevels do
        for j := 0 to FCross.CellLevels - 1 do
          FCross.CellHeaderMemos[i * FCross.CellLevels + j].Text := FCross.CellFields[j];

    s := '';
    for i := 0 to FCross.ColumnLevels - 1 do
      s := s + FCross.ColumnFields[i] + ', ';
    if s <> '' then
      SetLength(s, Length(s) - 2);
    if UpdateText then
      FCross.CornerMemos[1].Text := s;

    if UpdateText then
      for i := 0 to FCross.RowLevels - 1 do
        FCross.CornerMemos[i + 3].Text := FCross.RowFields[i];
  end
  else if (ChangesFrom = RowsLB) or (ChangesFrom = RowsE) then
  begin
    if UpdateText then
      for i := 0 to FCross.RowLevels do
        for j := 0 to FCross.CellLevels - 1 do
          FCross.CellHeaderMemos[i * FCross.CellLevels + j].Text := FCross.CellFields[j];

    if UpdateText then
      for i := 0 to FCross.RowLevels - 1 do
        FCross.CornerMemos[i + 3].Text := FCross.RowFields[i];
  end
  else if (ChangesFrom = ColumnsLB) or (ChangesFrom = ColumnsE) then
  begin
    s := '';
    for i := 0 to FCross.ColumnLevels - 1 do
      s := s + FCross.ColumnFields[i] + ', ';
    if s <> '' then
      SetLength(s, Length(s) - 2);
    if UpdateText then
      FCross.CornerMemos[1].Text := s;
  end
  else if (ChangesFrom = CellsLB) or (ChangesFrom = CellsE) then
  begin
    if FCross.CellLevels = 1 then
      if UpdateText then
        FCross.CornerMemos[0].Text := FCross.CellFields[0]
    else
    begin
      FCross.CornerMemos[0].Text := '';
      FCross.CornerMemos[2].Text := 'Data';
    end;

    if UpdateText then
      for i := 0 to FCross.RowLevels do
        for j := 0 to FCross.CellLevels - 1 do
          FCross.CellHeaderMemos[i * FCross.CellLevels + j].Text := FCross.CellFields[j];
  end;

  PaintBoxPaint(nil);
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(nil);
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;
  SourceLB, SenderLB: TListBox;
begin
  SourceLB := TListBox(Source);
  SenderLB := TListBox(Sender);
  if SourceLB.ItemIndex = -1 then Exit;
  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