featuresmain.pas

DevExpress公司出品的Borland Delphi和C++ Builder的控件(包含完整源代码)。 ExpressSpreadSheet:交叉数据表格控件。 一款Delphi

procedure TFeaturesMainForm.SaveSpreadSheet;
var
  AFileName: string;
begin
  if SaveDialog.Execute then
  begin
    AFileName := ChangeFileExt(SaveDialog.FileName, '.xls');
    cxSpreadBook.SaveToFile(AFileName );
    ActiveMDIChild.Caption := AFileName;
  end;
end;

procedure TFeaturesMainForm.SetCellsStyle(AValuesSet: TStyleValueSet; AAlign: TcxHorzTextAlign;
  AFontSize: Integer; const AFontName: string; AStyles: TFontStyles);

  procedure SetValue(AFlag: TStyleValue; ANeedStyle: TFontStyle;
    var ASetStyles: TFontStyles);
  begin
    if AFlag in AValuesSet then
    begin
      if ANeedStyle in AStyles then
        Include(ASetStyles, ANeedStyle)
      else
        Exclude(ASetStyles, ANeedStyle);
    end;
  end;

var
  I, J: Integer;
  AStyle: TFontStyles;

begin
  with cxSpreadBook do
  try
    BeginUpdate;
    with ActiveSheet do
    begin
      for I := SelectionRect.Left to SelectionRect.Right do
        for J := SelectionRect.Top to SelectionRect.Bottom do
        with GetCellObject(I, J) do
        try
          with Style do
          begin
            AStyle := Font.Style;
            if svFontName in AValuesSet then
              Font.Name := AFontName;
            if svSize in AValuesSet then
              Font.Size := AFontSize;
            if svAlign in AValuesSet then
              HorzTextAlign := AAlign;
            SetValue(svBold, fsBold, AStyle);
            SetValue(svItalic, fsItalic, AStyle);
            SetValue(svUnderline, fsUnderline, AStyle);
            SetValue(svStrikeOut, fsStrikeOut, AStyle);
            Font.Style := AStyle;
          end;
        finally
          Free;
        end;
    end;
  finally
    EndUpdate;
    UpdateControl;
  end;
end;

procedure TFeaturesMainForm.SetStates;
var
  AStyle: TFontStyles;
begin
  with cxSpreadBook do
  begin
    with ActiveSheet.GetCellObject(ActiveSheet.SelectionRect.Left,
      ActiveSheet.SelectionRect.Top) do
    try
      tbLeftAlign.Down := DisplayTextAlignment in [dtaLEFT, dtaFILL, dtaJUSTIFY];
      tbCenterAlign.Down := DisplayTextAlignment in [dtaCenter];
      tbRightAlign.Down := DisplayTextAlignment in [dtaRight];
      AStyle := Style.Font.Style;
      tbBold.Down := fsBold in AStyle;
      tbItalic.Down := fsItalic in AStyle;
      tbUnderline.Down := fsUnderline in AStyle;
      tbStrikeOut.Down := fsStrikeOut in AStyle;
      edtCellEdit.Text := Text;
      cbxFont.Text := Style.Font.Name;
      cbxSize.Text := IntToStr(Style.Font.Size);
    finally
      Free;
    end;
    actBeveledLookandFeel.Checked := PainterType = ptOfficeXPStyle;
    actBufferedpaint.Checked := BufferedPaint;
    actShowcaptions.Checked := ShowCaptionBar;
    actShowgrid.Checked := ShowGrid;
    actShowheaders.Checked := ShowHeaders;
    actShowformulas.Checked := ShowFormulas;
    actR1C1Referencestyle.Checked := R1C1ReferenceStyle;
    actAutomaticcalc.Checked := AutoRecalc;
  end;
end;

function TFeaturesMainForm.GetCellText(SelectionRect: TRect; R1C1: Boolean): String;
begin
  Result := cxSpreadBook.CellsNameByRef(cxSpreadBook.ActivePage, SelectionRect);
end;

procedure TFeaturesMainForm.cxSpreadBookSetSelection(Sender: TObject;
  ASheet: TcxSSBookSheet);
begin
  try
    FIsUpdate := True;
    SetStates;
    pnCellRect.Caption := GetCellText(ASheet.SelectionRect, cxSpreadBook.R1C1ReferenceStyle);
  finally
    FIsUpdate := False;
  end;
end;

procedure TFeaturesMainForm.edtCellEditChange(Sender: TObject);
begin
  if FIsUpdate then Exit;
  with cxSpreadBook do
  begin
    with ActiveSheet.GetCellObject(ActiveSheet.SelectionRect.Left, ActiveSheet.SelectionRect.Top) do
      SetCellText((Sender as TEdit).Text);
    UpdateControl;
  end;
end;

procedure TFeaturesMainForm.edtCellEditExit(Sender: TObject);
begin
  with cxSpreadBook do
  begin
    with ActiveSheet.GetCellObject(ActiveSheet.SelectionRect.Left, ActiveSheet.SelectionRect.Top) do
    begin
      Text := Text;
      Free;
    end;
    UpdateControl;
    SetFocus;
  end;
  cxSpreadBookSetSelection(Self, cxSpreadBook.ActiveSheet);
end;

procedure TFeaturesMainForm.edtCellEditKeyPress(Sender: TObject; var Key: Char);
begin
  if Key = #13 then
  begin
    Windows.SetFocus(cxSpreadBook.Handle);
    edtCellEditExit(Sender);
  end;
end;

procedure TFeaturesMainForm.mnuBordersDrawItem(Sender: TObject; ACanvas: TCanvas;
  ARect: TRect; Selected: Boolean);
begin
  if Selected then
    ACanvas.Brush.Color := clHighLight
  else
    ACanvas.Brush.Color := clMenu;
  ACanvas.Brush.Style := bsSolid;
  ACanvas.FillRect(ARect);
  imgBordersImages.Draw(ACanvas, ARect.Left + 2, ARect.Top + 2, (Sender as TMenuItem).ImageIndex);
end;

procedure TFeaturesMainForm.mnuBordersMeasureItem(Sender: TObject; ACanvas: TCanvas;
  var Width, Height: Integer);
begin
  Width := 14;
  Height := 24;
end;

procedure TFeaturesMainForm.mnuBordersClick(Sender: TObject);
var
  ARect: TRect;
  AKey, I: Integer;
const
  AOutBorders: array[0..11, TcxSSEdgeBorder] of TcxSSEdgeLineStyle =
    ((lsDefault, lsDefault, lsDefault, lsDefault),
     (lsNone, lsNone, lsNone, lsDouble),
     (lsNone, lsThin, lsNone, lsThick),
     (lsNone, lsNone, lsNone, lsThin),
     (lsNone, lsNone, lsNone, lsThick),
     (lsThin, lsThin, lsThin, lsThin),
     (lsThin, lsNone, lsNone, lsNone),
     (lsNone, lsThin, lsNone, lsThin),
     (lsThin, lsThin, lsThin, lsThin),
     (lsNone, lsNone, lsThin, lsNone),
     (lsNone, lsThin, lsNone, lsDouble),
     (lsThick, lsThick, lsThick, lsThick));

  AInBorders: array[Boolean] of TcxSSEdgeLineStyle = (lsDefault, lsThin);

  procedure SetHorzStyle(ARow: Integer; AStyle: TcxSSEdgeLineStyle);
  var
    I: Integer;
  begin
    if AStyle <> lsNone then
    begin
      for I := ARect.Left to ARect.Right do
      begin
        with cxSpreadBook.ActiveSheet.GetCellObject(I, ARow) do
        try
          if (AKey = 0) or (AStyle <> lsDefault) then
            Style.Borders[eTop].Style := AStyle;
        finally
          Free;
        end;
      end;
    end;
  end;

  procedure SetVertStyle(ACol: Integer; AStyle: TcxSSEdgeLineStyle);
  var
    I: Integer;
  begin
    if AStyle <> lsNone then
    begin
      for I := ARect.Top to ARect.Bottom do
      begin
        with cxSpreadBook.ActiveSheet.GetCellObject(ACol, I) do
        try
          if (AKey = 0) or (AStyle <> lsDefault) then
            Style.Borders[eLeft].Style := AStyle;
        finally
          Free;
        end;
      end;
    end;
  end;

begin
  cxSpreadBook.BeginUpdate;
  try
    ARect := cxSpreadBook.ActiveSheet.SelectionRect;
    AKey := (Sender as TMenuItem).ImageIndex;
    SetVertStyle(ARect.Left, AOutBorders[AKey, eLeft]);
    SetHorzStyle(ARect.Top, AOutBorders[AKey, eTop]);
    SetVertStyle(ARect.Right + 1, AOutBorders[AKey, eRight]);
    SetHorzStyle(ARect.Bottom + 1, AOutBorders[AKey, eBottom]);
    for I := ARect.Top + 1 to ARect.Bottom do
      SetHorzStyle(I, AInBorders[AKey = 5]);
    for I := ARect.Left + 1 to ARect.Right do
      SetVertStyle(I, AInBorders[AKey = 5]);
  finally
    cxSpreadBook.EndUpdate;
    cxSpreadBook.UpdateControl;
  end;
end;

procedure TFeaturesMainForm.cbxSizeKeyPress(Sender: TObject; var Key: Char);
begin
  if Key = #13 then
    Windows.SetFocus(cxSpreadBook.Handle)
  else
    if not (Key in ['0'..'9']) then
      Key := #0;
end;

procedure TFeaturesMainForm.cbxSizeChange(Sender: TObject);
var
  ASize: Integer;
begin
  if cxTryStrToInt(cbxSize.Text, ASize) then
    SetCellsStyle([svSize], haGeneral, ASize, cbxFont.Text, []);
end;

procedure TFeaturesMainForm.tbCenterAlignClick(Sender: TObject);
begin
  SetCellsStyle([svAlign], haCenter, 0, cbxFont.Text, []);
end;

procedure TFeaturesMainForm.tbRightAlignClick(Sender: TObject);
begin
  SetCellsStyle([svAlign], haRight, 0, cbxFont.Text, []);
end;

procedure TFeaturesMainForm.SetTokenStyle(AToolButton: TToolButton; AStyleValue: TStyleValue; AFontStyle: TFontStyle);
begin
  if AToolButton.Down then
    SetCellsStyle([AStyleValue], haGeneral, 0, '', [AFontStyle])
  else
    SetCellsStyle([AStyleValue], haGeneral, 0, '', []);
end;

procedure TFeaturesMainForm.actBoldClick(Sender: TObject);
begin
  SetTokenStyle(tbBold, svBold, fsBold);
end;

procedure TFeaturesMainForm.actItalicClick(Sender: TObject);
begin
  SetTokenStyle(tbItalic, svItalic, fsItalic);
end;

procedure TFeaturesMainForm.actUnderlineClick(Sender: TObject);
begin
  SetTokenStyle(tbUnderline, svUnderline, fsUnderline);
end;

procedure TFeaturesMainForm.actStrikeOutClick(Sender: TObject);
begin
  SetTokenStyle(tbStrikeOut, svStrikeOut, fsStrikeOut);
end;

procedure TFeaturesMainForm.tbMergeSplitClick(Sender: TObject);
begin
  with cxSpreadBook.ActiveSheet do
    SetMergedState(SelectionRect, (Sender as TToolButton).Tag = 7);
end;

procedure TFeaturesMainForm.tbsSummaryClick(Sender: TObject);
begin
  CalculateSummary(0);
end;

procedure TFeaturesMainForm.tbBorderStyleClick(Sender: TObject);
var
  ARect: TRect;
begin
  ARect := tbBorderStyle.BoundsRect;
  ARect.TopLeft := tbsFormatting.ClientToScreen(ARect.TopLeft);
  ARect.BottomRight := tbsFormatting.ClientToScreen(ARect.BottomRight);
  tbBorderStyle.Down := True;
  pmBorders.Popup(ARect.Left, ARect.Bottom);
  tbBorderStyle.Down := False;
end;

procedure TFeaturesMainForm.SummaryItemClick(Sender: TObject);
begin
  CalculateSummary((Sender as TMenuItem).Tag)
end;

procedure TFeaturesMainForm.cbxFontKeyPress(Sender: TObject; var Key: Char);
begin
  if Key = #13 then
    Windows.SetFocus(cxSpreadBook.Handle);
end;

procedure TFeaturesMainForm.actSheetExecute(Sender: TObject);
begin
  with cxSpreadBook do
    PageCount := PageCount + 1;
end;

procedure TFeaturesMainForm.actColumnExecute(Sender: TObject);
begin
  with cxSpreadBook do
    ActiveSheet.InsertCells(ActiveSheet.SelectionRect, msAllCol);
end;

procedure TFeaturesMainForm.actRowExecute(Sender: TObject);
begin
  with cxSpreadBook do
    ActiveSheet.InsertCells(ActiveSheet.SelectionRect, msAllRow);
end;

procedure TFeaturesMainForm.actNewExecute(Sender: TObject);
begin
  NewSheet;
end;

procedure TFeaturesMainForm.actOpenSpreadSheetExecute(Sender: TObject);
begin
  OpenSpreadSheet;
end;

procedure TFeaturesMainForm.actSaveSpeadSheetExecute(Sender: TObject);
begin
  SaveSpreadSheet;
end;

procedure TFeaturesMainForm.actExitExecute(Sender: TObject);
begin
  Close;
end;

procedure TFeaturesMainForm.AlwaysEnabled(Sender: TObject);
begin
  TCustomAction(Sender).Enabled := True;
end;

procedure TFeaturesMainForm.actPasteExecute(Sender: TObject);
begin
  with cxSpreadBook.ActiveSheet do
    Paste(SelectionRect.TopLeft);
end;

procedure TFeaturesMainForm.actCopyExecute(Sender: TObject);
begin
  with cxSpreadBook.ActiveSheet do