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

📄 designgrid.pas

📁 delphi制作表格的控件
💻 PAS
📖 第 1 页 / 共 2 页
字号:
unit DesignGrid;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Menus, ActnCtrls, ToolWin, ActnMan, ActnMenus,
  ComCtrls, StdCtrls, ImgList, ActnList, EasyGrid, ExtDlgs;

type
  TDesignGridForm = class(TForm)
    MainMenu1: TMainMenu;
    mFile: TMenuItem;
    mEdit: TMenuItem;
    mInsert: TMenuItem;
    mLayout: TMenuItem;
    mSetTable: TMenuItem;
    H1: TMenuItem;
    StatusBar1: TStatusBar;
    CoolBar1: TCoolBar;
    ToolBar1: TToolBar;
    ToolBar2: TToolBar;
    ToolBar3: TToolBar;
    NNew: TMenuItem;
    NOpen: TMenuItem;
    N4: TMenuItem;
    NSave: TMenuItem;
    NSaveAs: TMenuItem;
    N7: TMenuItem;
    NPageSetup: TMenuItem;
    NPreView: TMenuItem;
    NPrint: TMenuItem;
    N11: TMenuItem;
    NClose: TMenuItem;
    NCopy: TMenuItem;
    NCut: TMenuItem;
    NPaste: TMenuItem;
    NCellNull: TMenuItem;
    N17: TMenuItem;
    NInData: TMenuItem;
    NInVar: TMenuItem;
    NInFu: TMenuItem;
    NInExpre: TMenuItem;
    NMarge: TMenuItem;
    NInRow: TMenuItem;
    NInCol: TMenuItem;
    N30: TMenuItem;
    NDelRow: TMenuItem;
    NDelCol: TMenuItem;
    NHelp: TMenuItem;
    N34: TMenuItem;
    NAbout: TMenuItem;
    NMargeDel: TMenuItem;
    N37: TMenuItem;
    NCellPro: TMenuItem;
    TBNew: TToolButton;
    TBOpen: TToolButton;
    ToolButton3: TToolButton;
    TBSave: TToolButton;
    TBPrint: TToolButton;
    ToolButton6: TToolButton;
    TBPreview: TToolButton;
    TBCopy: TToolButton;
    TBCut: TToolButton;
    TBPaste: TToolButton;
    ToolButton11: TToolButton;
    TBTablePro: TToolButton;
    TBCellLineCasing: TToolButton;
    TBCellLineIn: TToolButton;
    TBCellLineNull: TToolButton;
    TBCellLineLeft: TToolButton;
    TBCellLineVCa: TToolButton;
    TBCellLineRight: TToolButton;
    TBCellLineTop: TToolButton;
    ToolButton21: TToolButton;
    ToolButton22: TToolButton;
    TBCellLineHCa: TToolButton;
    ToolButton24: TToolButton;
    TBCellNull: TToolButton;
    TBNewTable: TToolButton;
    TBCellPro: TToolButton;
    ToolButton28: TToolButton;
    CBCellLineWidth: TComboBox;
    ToolButton29: TToolButton;
    TBCellLineBo: TToolButton;
    ToolButton31: TToolButton;
    TBHelp: TToolButton;
    CBFontName: TComboBox;
    CBFontSize: TComboBox;
    TBFontB: TToolButton;
    ToolButton34: TToolButton;
    TBFontI: TToolButton;
    TBFontU: TToolButton;
    ToolButton37: TToolButton;
    TBFontLeft: TToolButton;
    TBFontHCa: TToolButton;
    TBFontRight: TToolButton;
    ToolButton41: TToolButton;
    TBFontTop: TToolButton;
    TBFontVCa: TToolButton;
    TBFontBo: TToolButton;
    ToolButton45: TToolButton;
    TBMarge: TToolButton;
    TBInCol: TToolButton;
    TBInRow: TToolButton;
    ToolButton49: TToolButton;
    TBDelRow: TToolButton;
    TBDelCol: TToolButton;
    CBBandsName: TComboBox;
    ToolButton52: TToolButton;
    TBInData: TToolButton;
    TBInVar: TToolButton;
    TBInFu: TToolButton;
    ToolButton56: TToolButton;
    ToolButton57: TToolButton;
    EdCellVal: TEdit;
    ImageList1: TImageList;
    TBClose: TToolButton;
    ToolButton59: TToolButton;
    ToolButton60: TToolButton;
    Panel1: TPanel;
    PaCell: TPanel;
    ActionList1: TActionList;
    FANew: TAction;
    FAOpen: TAction;
    FASave: TAction;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    FASaveAs: TAction;
    ToolButton4: TToolButton;
    FAPageSetup: TAction;
    FAPreView: TAction;
    FAPrint: TAction;
    FAClose: TAction;
    FACopy: TAction;
    FACut: TAction;
    FAPaste: TAction;
    FACellNull: TAction;
    FAmarge: TAction;
    FAMargeDel: TAction;
    FACellPro: TAction;
    FAInRow: TAction;
    FAInCol: TAction;
    FADelRow: TAction;
    FADelCol: TAction;
    FAInData: TAction;
    NInBmp: TMenuItem;
    ToolButton1: TToolButton;
    TBInsertBmp: TToolButton;
    TBDeleteBmp: TToolButton;
    ToolImages: TImageList;
    FAInsertBmp: TAction;
    OpenPictureDialog1: TOpenPictureDialog;
    NInRtfText: TMenuItem;
    N2: TMenuItem;
    FAInsertRftText: TAction;
    N1: TMenuItem;
    N3: TMenuItem;
    TBLUpDown1: TToolButton;
    TBRUpDown1: TToolButton;
    ToolButton7: TToolButton;
    NGridStyle: TMenuItem;
    NRowStyle: TMenuItem;
    FGrid: TEasyGrid;
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormCreate(Sender: TObject);
    procedure FANewExecute(Sender: TObject);
    procedure FAOpenExecute(Sender: TObject);
    procedure FASaveExecute(Sender: TObject);
    procedure FASaveAsExecute(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure TBFontLeftClick(Sender: TObject);
    procedure CBFontNameChange(Sender: TObject);
    procedure CBFontSizeChange(Sender: TObject);
    procedure TBFontBClick(Sender: TObject);
    procedure TBFontIClick(Sender: TObject);
    procedure TBFontUClick(Sender: TObject);
    procedure FAPageSetupExecute(Sender: TObject);
    procedure FAPreViewExecute(Sender: TObject);
    procedure FAPrintExecute(Sender: TObject);
    procedure FACloseExecute(Sender: TObject);
    procedure FACopyExecute(Sender: TObject);
    procedure FACutExecute(Sender: TObject);
    procedure FAPasteExecute(Sender: TObject);
    procedure FACellNullExecute(Sender: TObject);
    procedure FAmargeExecute(Sender: TObject);
    procedure FAMargeDelExecute(Sender: TObject);
    procedure FACellProExecute(Sender: TObject);
    procedure TBCellLineLeftClick(Sender: TObject);
    procedure CBCellLineWidthChange(Sender: TObject);
    procedure FAInColExecute(Sender: TObject);
    procedure FADelRowExecute(Sender: TObject);
    procedure FADelColExecute(Sender: TObject);
    procedure FAInRowExecute(Sender: TObject);
    procedure TBFontColorChange(Sender: TObject);
    procedure FAInDataExecute(Sender: TObject);
    procedure FAInsertBmpExecute(Sender: TObject);
    procedure TBDeleteBmpClick(Sender: TObject);
    procedure FAInsertRftTextExecute(Sender: TObject);
    procedure TBCellColorClick(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure TBLUpDown1Click(Sender: TObject);
    procedure TBRUpDown1Click(Sender: TObject);
    procedure TBCellLineCasingClick(Sender: TObject);
    procedure TBCellLineNullClick(Sender: TObject);
    procedure NGridStyleClick(Sender: TObject);
  private
    { Private declarations }
    Save1,Save2: TEasyGridOptions;
    FLeft, FTop, FWidth, FHeight: Integer;
    CurAlign: TAlign;
    CellRange: TRect;
    FRunMode: TRunMode;
    procedure SetGrid(const Value: TEasyGrid);
    procedure AssignGrid(AGrid: TEasyGrid);
    procedure NewGrid;
    function MMToPixes(const MM: Integer) : Integer; //毫米转为点素
    procedure GridMouseMove(Sender: TObject;Shift: TShiftState; X, Y: Integer);
    procedure SetControlState(ACol, ARow: Integer);
    procedure SetAlignMode(AAlign : Integer);
    procedure SetBandN(AType: Byte; ABoolean: Boolean);
  public
    { Public declarations }
    CurGrid: TEasyGrid;
    property Grid: TEasyGrid read FGrid write SetGrid;
  end;

procedure OpenGridDesigner(AGrid: TEasyGrid);

implementation
uses CellField, CellProp, PageSetup;
{$R *.dfm}

const srFormCaption = 'EasyGrid编辑器';
      srLeft   = 1;
      srHCenter = 2;
      srRight  = 3;
      srTop    = 4;
      srVCenter = 8;
      srBottom  = 12;

procedure OpenGridDesigner(AGrid: TEasyGrid);
var
  DG: TDesignGridForm;
begin
  DG := TDesignGridForm.Create(Nil);
  try
    DG.Grid := AGrid;
    DG.ShowModal;
  finally
    DG.Free;
  end;
end;

procedure TDesignGridForm.SetGrid(const Value: TEasyGrid);
var Stream:TMemoryStream;
begin
  if Value = nil then Exit;
  try
     CurGrid := Value;
     Stream:=TMemoryStream.Create;
     FLeft := Value.Left;
     FTop := Value.Top;
     FWidth :=Value.Width;
     FHeight := Value.Height;
     CurAlign:=Value.Align;
     FRunMode := Value.RunMode;
     Save1:=Value.Options;
     Save2:=FGrid.Options;

     Stream.WriteComponent(Value);
     Stream.Position:=0;
     FGrid:=TEasyGrid(Stream.ReadComponent(FGrid));
     FGrid.Options:=Save2;
     FGrid.Align:=alClient;
     FGrid.RunMode:=rmDesignMode;
     //FGrid.ControlCollection.Assign(Value.ControlCollection);
  finally
     Stream.Free;
  end;
end;

procedure TDesignGridForm.AssignGrid(AGrid: TEasyGrid);
var Stream:TMemoryStream;
begin
   try
     Stream := TMemoryStream.Create;
     Stream.WriteComponent(FGrid);
     Stream.Position := 0;
     if AGrid = nil then
     begin
        AGrid.Free;
        AGrid := nil;
     end;
     AGrid := TEasyGrid(Stream.ReadComponent(AGrid));

     AGrid.Options := Save1;
     AGrid.Align := CurAlign;
     AGrid.Left := FLeft;
     AGrid.Top := FTop;
     AGrid.Width := FWidth;
     AGrid.Height := FHeight;

     AGrid.RunMode := FRunMode;
   finally
     Stream.Free;
   end;
end;
procedure TDesignGridForm.NewGrid;
begin
end;

procedure TDesignGridForm.GridMouseMove(Sender: TObject;Shift: TShiftState; X, Y: Integer);
begin
end;


function TDesignGridForm.MMToPixes(const MM: Integer): Integer;
begin
end;

procedure TDesignGridForm.SetControlState(ACol, ARow: Integer);
var
  ACellInfo: PCellInfo;
begin
  TBFontLeft.Down := False;
  TBFontHCa.Down := False;
  TBFontRight.Down := False;
  TBFontTop.Down := False;
  TBFontVCa.Down := False;
  TBFontBo.Down := False;

  ACellInfo := FGrid.Cells[ACol, ARow];
  with ACellInfo^, FGrid do
  begin
    case AlignMode of
      taLeft, taTopLeft, taBottomLeft: TBFontLeft.Down := True;
      taTop, taCenter, taBottom: TBFontHCa.Down := True;
      taRight, taTopRight, taBottomRight: TBFontRight.Down := True;
    end;
    case AlignMode of
      taTopLeft, taTop, taTopRight : TBFontTop.Down := True;
      taLeft, taCenter, taRight : TBFontVCa.Down := True;
      taBottomLeft, taBottom, taBottomRight : TBFontBo.Down := True;
    end;
    TBMarge.Down := ((Merges[Col, Row].Left <> Merges[Col, Row].Right) or
       (Merges[Col, Row].Top  <> Merges[Col, Row].Bottom));
    CBFontName.ItemIndex := CBFontName.Items.IndexOf(FontName);
    CBFontSize.Text := IntToStr(FontSize);
    TBFontB.Down := fsBold in FontStyle;
    TBFontI.Down := fsItalic in FontStyle;
    TBFontU.Down := fsUnderline	in FontStyle;
    //边框
    TBCellLineLeft.Down := DrawLeft;
    TBCellLineRight.Down := DrawRight;
    TBCellLineTop.Down := DrawTop;
    TBCellLineBo.Down := DrawBottom;
    CBCellLineWidth.Text := IntToStr(LineWidth);
    //斜线
    //TBLUpDown1.Down := BiasLine = blLUpdown1;
    //TBRUpDown1.Down := BiasLine = blRUpdown1;

    //颜色
    //TBCellColor.AutoColor := Color;
    //TBCellColor.Colors.Color := Color;
    //TBFontColor.AutoColor := FontColor;
  end;
end;

procedure TDesignGridForm.SetAlignMode(AAlign: Integer);
var
  NewAlignMode : TAlignMode;
  a: Integer;
begin
  if AAlign > srTop then
  begin
    if TBFontLeft.Down then a := AAlign + srLeft
    else if TBFontHCa.Down then a := AAlign + srHCenter
    else if TBFontRight.Down then a := AAlign + srRight;
  end else
  begin

⌨️ 快捷键说明

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