⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 cellprop.pas

📁 一个非常好用的中国式表格控件(源码),对需在程序中插入格式复杂的表格非常有用
💻 PAS
📖 第 1 页 / 共 2 页
字号:
// *****************************************************************************
//
// Note: This free package of source code can only be used for reference and
//       learning purpose, you can distribute it freely, but please do not use
//       it for profit sake.
//
//       Special thanks to: RICHBBS (www.delphibbs.com)
//
//                                                         Huang Qian, Feb 2002
//                                                         Wuhan University
//
// *****************************************************************************

unit CellProp;

interface             

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls, ExtCtrls;

type
  TFormCellProp = class(TForm)
    PageCtlCellProp: TPageControl;
    TabSheetCellType: TTabSheet;
    TabSheetAlign: TTabSheet;
    TabSheetFont: TTabSheet;
    TabSheetOthers: TTabSheet;
    BtnOk: TButton;
    BtnCancel: TButton;
    LbxCellType: TListBox;
    LabelExample1: TLabel;
    BevelExample1: TBevel;
    MemoExample1: TMemo;
    LabelAlign: TLabel;
    BevelAlign: TBevel;
    LabelFontName: TLabel;
    LabelFrame: TLabel;
    BevelFrameStyle: TBevel;
    LabelHAlign: TLabel;
    LabelVAlign: TLabel;
    CbxHAlign: TComboBox;
    CbxVAlign: TComboBox;
    LabelControl: TLabel;
    BevelControl: TBevel;
    ChkBoxAutoWordBreak: TCheckBox;
    ChkBoxMerge: TCheckBox;
    LabelCellType: TLabel;
    BevelCellType: TBevel;
    LabelFontStyle: TLabel;
    LabelFontSize: TLabel;
    LbxFontName: TListBox;
    LbxFontStyle: TListBox;
    LbxFontSize: TListBox;
    LabelFontColor: TLabel;
    GbxFontPreview: TGroupBox;
    PanelFontPreview2: TPanel;
    PanelFontPreview1: TPanel;
    ChkBoxUnderLine: TCheckBox;
    ChkBoxDrawLeft: TCheckBox;
    ChkBoxDrawRight: TCheckBox;
    ChkBoxDrawTop: TCheckBox;
    ChkBoxDrawBottom: TCheckBox;
    LabelFrameSize: TLabel;
    EditFrameSize: TEdit;
    LabelPointSize: TLabel;
    LabelBackColor: TLabel;
    BevelBackColor: TBevel;
    LabelIntro1: TLabel;
    PanelFontColor: TPanel;
    BtnSetFontColor: TButton;
    BtnSetBackColor: TButton;
    PanelBackColor: TPanel;
    EditFontSize: TEdit;
    LabelMaxLength: TLabel;
    EditMaxLength: TEdit;
    LabelIntLength: TLabel;
    EditIntLength: TEdit;
    LabelDecLength: TLabel;
    EditDecLength: TEdit;
    ChkBoxAllowNeg: TCheckBox;
    ChkBoxThousandSep: TCheckBox;
    ChkBoxTrailingZero: TCheckBox;
    ChkBoxZeroNull: TCheckBox;
    LabelPenStyle: TLabel;
    CbxPenStyle: TComboBox;
    ColorDialogCellProp: TColorDialog;
    BevelReadOnly: TBevel;
    LabelReadOnly: TLabel;
    ChkBoxReadOnly: TCheckBox;
    procedure LbxCellTypeClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure LbxFontStyleClick(Sender: TObject);
    procedure LbxFontSizeClick(Sender: TObject);
    procedure UpDownClick(Sender: TObject; Button: TUDBtnType);
    procedure LbxFontNameClick(Sender: TObject);
    procedure ChkBoxUnderLineClick(Sender: TObject);
    procedure EditFontSizeKeyPress(Sender: TObject; var Key: Char);
    procedure BtnSetFontColorClick(Sender: TObject);
    procedure BtnSetBackColorClick(Sender: TObject);
    procedure BtnOkClick(Sender: TObject);
    procedure CbxHAlignClick(Sender: TObject);
    procedure CbxVAlignClick(Sender: TObject);
    procedure EditFontSizeChange(Sender: TObject);
    procedure EditFrameSizeChange(Sender: TObject);
    procedure EditMaxLengthChange(Sender: TObject);
    procedure EditIntLengthChange(Sender: TObject);
    procedure EditDecLengthChange(Sender: TObject);
  private
    CellRange: TRect;
    procedure SetNumControls(Value: boolean);
    procedure GetFirstCellProp;
    procedure SetControlState;
  public
    ParentGrid: Pointer;
  end;

implementation
uses EasyGrid;
{$R *.DFM}

procedure TFormCellProp.LbxCellTypeClick(Sender: TObject);
begin
  with (Sender as TListBox) do
  begin
    case ItemIndex of
      0 :
        begin
          MemoExample1.Clear;
          MemoExample1.Lines.Add('中文字符');
          MemoExample1.Lines.Add('12345678');
          MemoExample1.Lines.Add('ABCDEFG HIJKLMN');
          MemoExample1.Lines.Add(',.<>!@#$%^&*()');
          LabelIntro1.Caption := '常规类型的单元格可以输入任意字符,而不作特殊的处理。';
          SetNumControls(False);
        end;
      1 :
        begin
          MemoExample1.Clear;
          MemoExample1.Lines.Add('123');
          MemoExample1.Lines.Add('12345.6789');
          MemoExample1.Lines.Add('-98765.4321');
          MemoExample1.Lines.Add('0.0005');
          LabelIntro1.Caption := '数值类型的单元格用于一般数字的显示和输入。';
          SetNumControls(True);
        end;
      2 :
        begin
          MemoExample1.Clear;
          MemoExample1.Lines.Add('1999-01-01');
          LabelIntro1.Caption := '日期类型的单元格允许按日期格式显示和输入内容。';
          SetNumControls(False);
        end;
      3 :
        begin
          MemoExample1.Clear;
          MemoExample1.Lines.Add('8:30');
          MemoExample1.Lines.Add('00:00:01');
          MemoExample1.Lines.Add('12:00:00');
          MemoExample1.Lines.Add('23:59:59');
          LabelIntro1.Caption := '时间类型的单元格允许按时间格式显示和输入内容。';
          SetNumControls(False);
        end;
    end;
  end;
end;

procedure TFormCellProp.SetNumControls(Value: boolean);
begin
  LabelMaxLength.Visible := Value;
  EditMaxLength.Visible := Value;

  LabelIntLength.Visible := Value;
  EditIntLength.Visible := Value;

  LabelDecLength.Visible := Value;
  EditDecLength.Visible := Value;

  ChkBoxAllowNeg.Visible := Value;
  ChkBoxThousandSep.Visible := Value;
  ChkBoxTrailingZero.Visible := Value;
  ChkBoxZeroNull.Visible := Value;
end;

procedure TFormCellProp.GetFirstCellProp;
var
  ACellInfo: PCellInfo;
begin
  with TEasyGrid(ParentGrid) do
    ACellInfo := Cells[Col, Row];
  with ACellInfo^, TEasyGrid(ParentGrid) do
  begin
    // 第一页上的控件
    LbxCellType.ItemIndex := Ord(DataStyle);
    LbxCellTypeClick(LbxCellType);
    EditMaxLength.Text := IntToStr(MaxLength);
    EditIntLength.Text := IntToStr(IntLength);
    EditDecLength.Text := IntToStr(DecLength);
    ChkBoxAllowNeg.Checked := AllowNegative;
    ChkBoxThousandSep.Checked := ThousandSep;
    ChkBoxTrailingZero.Checked := TrailingZero;
    ChkBoxZeroNull.Checked := ZeroNull;
    // 第二页上的控件
    ChkBoxAutoWordBreak.Checked := AutoWordBreak;
    ChkBoxMerge.Checked :=
      ((Merges[Col, Row].Left <> Merges[Col, Row].Right) or
       (Merges[Col, Row].Top  <> Merges[Col, Row].Bottom));
    case AlignMode of
      taTopLeft, taLeft, taBottomLeft :
        CbxHAlign.ItemIndex := 0;
      taTop, taCenter, taBottom :
        CbxHAlign.ItemIndex := 1;
      taTopRight, taRight, taBottomRight :
        CbxHAlign.ItemIndex := 2;
    end;
    case AlignMode of
      taTopLeft, taTop, taTopRight :
        CbxVAlign.ItemIndex := 0;
      taLeft, taCenter, taRight :
        CbxVAlign.ItemIndex := 1;
      taBottomLeft, taBottom, taBottomRight :
        CbxVAlign.ItemIndex := 2;
    end;
    // 第三页上的控件
    with LbxFontName do
    begin
      ItemIndex := Items.IndexOf(FontName);
      if (ItemIndex >= 0) then
        LbxFontNameClick(LbxFontName);
    end;
    with LbxFontStyle do
    begin
      ItemIndex := -1;
      if FontStyle = [] then
        ItemIndex := 0
      else if FontStyle = [fsItalic] then
        ItemIndex := 1
      else if FontStyle = [fsBold] then
        ItemIndex := 2
      else if FontStyle = [fsBold,fsItalic] then
        ItemIndex := 3;
      if ItemIndex >= 0 then
        LbxFontStyleClick(LbxFontStyle);
    end;
    with LbxFontSize do
    begin
      ItemIndex := Items.IndexOf(IntToStr(FontSize));
      if ItemIndex >= 0 then
        LbxFontSizeClick(LbxFontSize);
    end;
    ChkBoxUnderLine.Checked := (fsUnderLine in FontStyle);
    PanelFontColor.Color := FontColor;
    PanelFontColor.Visible := True;
    with PanelFontPreview1.Font do
    begin
      Name :=  FontName;
      Size :=  FontSize;
      Style := FontStyle;
      Color := FontColor;
    end;
    // 第四页上的控件
    ChkBoxDrawLeft.Checked := DrawLeft;
    ChkBoxDrawTop.Checked := DrawTop;
    ChkBoxDrawRight.Checked := DrawRight;
    ChkBoxDrawBottom.Checked := DrawBottom;
    EditFrameSize.Text := IntToStr(LineWidth);
    CbxPenStyle.ItemIndex := Ord(PenStyle);
    PanelBackColor.Color := ACellInfo.Color;
    PanelBackColor.Visible := True;
    ChkBoxReadOnly.Checked := ReadOnly;
  end;
end;

procedure TFormCellProp.SetControlState;
var
  ACellInfo: PCellInfo;
  ACol, ARow: integer;
  NewCellTypeIndex, NewHAlignIndex, NewVAlignIndex: integer;
  NewFontNameIndex, NewFontStyleIndex, NewPenStyleIndex: integer;
  CellTypeVary, MaxLengthVary, IntLengthVary, DecLengthVary: boolean;
  AllowNegVary, ThousandSepVary, TrailingZeroVary, ZeroNullVary: boolean;
  HAlignVary, VAlignVary: boolean;
  AutoWordBreakVary, MergeVary, UnderLineVary: boolean;
  FontNameVary, FontStyleVary, FontSizeVary, FontColorVary: boolean;
  DrawLeftVary, DrawTopVary, DrawRightVary, DrawBottomVary: boolean;
  FrameSizeVary, PenStyleVary, BackColorVary, ReadOnlyVary: boolean;
begin
  CellTypeVary := False;
  MaxLengthVary := False;
  IntLengthVary := False;
  DecLengthVary := False;
  AllowNegVary := False;
  ThousandSepVary := False;
  TrailingZeroVary := False;
  ZeroNullVary := False;
  HAlignVary := False;
  VAlignVary := False;
  AutoWordBreakVary := False;
  MergeVary := False;
  UnderLineVary := False;
  FontNameVary := False;
  FontStyleVary := False;
  FontSizeVary := False;
  FontColorVary := False;
  DrawLeftVary := False;
  DrawTopVary := False;
  DrawRightVary := False;
  DrawBottomVary := False;
  FrameSizeVary := False;
  PenStyleVary := False;
  BackColorVary := False;
  ReadOnlyVary := False;
  for ACol:=CellRange.Left to CellRange.Right do
    for ARow:=CellRange.Top to CellRange.Bottom do
    begin
      ACellInfo := TEasyGrid(ParentGrid).Cells[ACol, ARow];
      with ACellInfo^ do
      begin
        // 第一页上的控件
        NewCellTypeIndex := Ord(DataStyle);
        if (not CellTypeVary) and (NewCellTypeIndex <> LbxCellType.ItemIndex) then
          CellTypeVary := True;
        if (not MaxLengthVary) and (MaxLength <> StrToInt(EditMaxLength.Text)) then
          MaxLengthVary := True;
        if (not IntLengthVary) and (IntLength <> StrToInt(EditIntLength.Text)) then
          IntLengthVary := True;
        if (not DecLengthVary) and (DecLength <> StrToInt(EditDecLength.Text)) then
          DecLengthVary := True;
        if (not AllowNegVary) and (AllowNegative <> ChkBoxAllowNeg.Checked) then
          AllowNegVary := True;
        if (not ThousandSepVary) and (ThousandSep <> ChkBoxThousandSep.Checked) then
          ThousandSepVary := True;
        if (not TrailingZeroVary) and (TrailingZero <> ChkBoxTrailingZero.Checked) then
           TrailingZeroVary := True;
        if (not ZeroNullVary) and (ZeroNull <> ChkBoxZeroNull.Checked) then
          ZeroNullVary := True;
        // 第二页上的控件
        if not HAlignVary then
        begin
          NewHAlignIndex := -1;
          case AlignMode of
            taTopLeft, taLeft, taBottomLeft :
              NewHAlignIndex := 0;
            taTop, taCenter, taBottom :
              NewHAlignIndex := 1;
            taTopRight, taRight, taBottomRight :
              NewHAlignIndex := 2;
          end;
          if NewHAlignIndex <> CbxHAlign.ItemIndex then
            HAlignVary := True;
        end;
        if not VAlignVary then
        begin
          NewVAlignIndex := -1;
          case AlignMode of
            taTopLeft, taTop, taTopRight :
              NewVAlignIndex := 0;
            taLeft, taCenter, taRight :
              NewVAlignIndex := 1;
            taBottomLeft, taBottom, taBottomRight :
              NewVAlignIndex := 2;
          end;
          if NewVAlignIndex <> CbxVAlign.ItemIndex then
            VAlignVary := True;
        end;
        if (not AutoWordBreakVary) and (AutoWordBreak <> ChkBoxAutoWordBreak.Checked) then
          AutoWordBreakVary := True;
        if (not MergeVary) then
        begin
          with TEasyGrid(ParentGrid) do
            if ((Merges[ACol, ARow].Left <> Merges[Col, Row].Left) or
                (Merges[ACol, ARow].Top <> Merges[Col, Row].Top) or
                (Merges[ACol, ARow].Right <> Merges[Col, Row].Right) or
                (Merges[ACol, ARow].Bottom <> Merges[Col, Row].Bottom)) then
               MergeVary := True;
        end;
        // 第三页上的控件
        if (not FontNameVary) then
        begin
          NewFontNameIndex := LbxFontName.Items.IndexOf(FontName);
          if NewFontNameIndex <> LbxFontName.ItemIndex then
            FontNameVary := True;
        end;
        if (not FontStyleVary) then
          with LbxFontStyle do
          begin
            NewFontStyleIndex := -1;
            if FontStyle = [] then
              NewFontStyleIndex := 0
            else if FontStyle = [fsItalic] then
              NewFontStyleIndex := 1
            else if FontStyle = [fsBold] then
              NewFontStyleIndex := 2
            else if FontStyle = [fsBold,fsItalic] then
              NewFontStyleIndex := 3;
            if NewFontStyleIndex <> ItemIndex then

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -