easygrid.~pas

一个非常好用的中国式表格控件（源码),对需在程序中插入格式复杂的表格非常有用

    if E2 <> nil then
    begin
      for I := 0 to PIntArray(E1)^[0] do
        if PIntArray(E1)^[I] <> PIntArray(E2)^[I] then Exit;
      Result := True;
    end
  end
  else Result := E2 = nil;
end;

{ Private. LongMulDiv multiplys the first two arguments and then
  divides by the third.  This is used so that real number
  (floating point) arithmetic is not necessary.  This routine saves
  the possible 64-bit value in a temp before doing the divide.  Does
  not do error checking like divide by zero.  Also assumes that the
  result is in the 32-bit range (Actually 31-bit, since this algorithm
  is for unsigned). }

function LongMulDiv(Mult1, Mult2, Div1: Longint): Longint; stdcall;
  external 'kernel32.dll' name 'MulDiv';

type
  TSelection = record
    StartPos, EndPos: Integer;
  end;

// 拷贝 Cell 内容(不包括合并信息)
procedure CellToCell(SrcCell,DestCell : PCellInfo);
begin
  with DestCell^ do
    begin
      DataStyle    := SrcCell.DataStyle;
      AlignMode    := SrcCell.AlignMode;

      ReadOnly     := SrcCell.ReadOnly;
      AutoWordBreak := SrcCell.AutoWordBreak;
      ShowForeText := SrcCell.ShowForeText;
      DrawTop      := SrcCell.DrawTop;
      DrawLeft     := SrcCell.DrawLeft;
      DrawBottom   := SrcCell.DrawBottom;
      DrawRight    := SrcCell.DrawRight;

      AllowNegative := SrcCell.AllowNegative;
      TrailingZero  := SrcCell.TrailingZero;
      ZeroNull     := SrcCell.ZeroNull;
      ThousandSep  := SrcCell.ThousandSep;
      MaxLength    := SrcCell.MaxLength;
      IntLength    := SrcCell.IntLength;
      DecLength    := SrcCell.DecLength;

      LineWidth    := SrcCell.LineWidth;
      PenStyle     := SrcCell.PenStyle;
      Number       := SrcCell.Number;
      Color        := SrcCell.Color;

      FontSize     := SrcCell.FontSize;
      FontColor    := SrcCell.FontColor;
      FontStyle    := SrcCell.FontStyle;

      FontName     := SrcCell.FontName;
      ForeText     := SrcCell.ForeText;
      BackText     := SrcCell.BackText;
    end;
end;

procedure Restrict(var Coord: TGridCoord; MinX, MinY, MaxX, MaxY: Longint);
begin
  with Coord do
  begin
    if X > MaxX then X := MaxX
    else if X < MinX then X := MinX;
    if Y > MaxY then Y := MaxY
    else if Y < MinY then Y := MinY;
  end;
end;

// 显示提示信息
procedure Say(SayString: string);
begin
  Application.MessageBox(PChar(SayString),'提示',
                         MB_OK + MB_ICONINFORMATION);
end;

// 显示错误信息
procedure SayStop(SayString: string);
begin
  Application.MessageBox(PChar(SayString),'提示',
                         MB_OK + MB_ICONSTOP);
end;

// 询问信息
function Ask(AskString:string;DefaultButton:Byte = 1) : Boolean;
var
   Flag : Integer;
begin
     Result := False;
     Flag := MB_DEFBUTTON1;
     if DefaultButton = 2 then
        Flag := MB_DEFBUTTON2;
     if (Application.MessageBox(PChar(AskString),'询问',MB_OKCANCEL + MB_ICONQUESTION + Flag) = IDOK) then
        Result := True;
end;

function MoneyToStr(S: string): string;
var
  Len, i: Integer;
begin
  i:=1;
  Len := Length(S);
  while i<=Len do
  begin
    if S[i] = ThousandSeparator then
    begin
      Delete(S, i ,1);
      Dec(Len);
    end;
    Inc(i);
  end;
  Result := Trim(S);
end;

function StrToMoney(S: string; IntLen, DecLen: Integer;
         HasTrailingZero: Boolean = True; IsZeroNull: Boolean = True;
         HasThousandSep: Boolean = True): string;
var
  TempResult, fmtStr: string;
  Len, DotPos, i: Integer;
begin
  Result := '';
  S := MoneyToStr(S);
  if (S = '') or (S = '-') or (S = '0.') or (S = '0') or ((StrToFloat(S) = 0) and IsZeroNull) then Exit;
  fmtStr := '%'+IntToStr(IntLen)+'.'+IntToStr(DecLen)+'f';
  TempResult := Format(fmtStr, [StrToFloat(S)]);
  if HasThousandSep then
  begin
    fmtStr := '%'+IntToStr(IntLen)+'.'+IntToStr(DecLen)+'n';
    TempResult := Format(fmtStr, [StrToFloat(S)]);
  end;
  DotPos := Pos('.', TempResult);
  if (not HasTrailingZero) and (DotPos > 0) then
  begin
    i := Length(TempResult);
    while (i > 0) and (TempResult[i] = '0') do
    begin
      Delete(TempResult, i, 1);
      Dec(i);
    end;
  end;
  Len := Length(TempResult);
  if TempResult[Len] = '.' then
    Delete(TempResult, Len, 1);
  Result := Trim(TempResult);
end;

// ******************************************************************
// SetClipRect : 用 OldRgn 保存当前剪裁区,然后把 ClipR 置为新的剪裁区
// RestoreClipRect : 恢复原来的剪裁区(上次保存在 OldRgn 中)
procedure TCustomEasyGrid.SetClipRect(ACanvas: TCanvas; ClipR: TRect);
begin
  OldRgn := 0;
  OldRgn := CreateRectRgn(0,0,0,0);
  HaveClip := GetClipRgn(ACanvas.Handle, OldRgn);

  NewRgn := CreateRectRgnIndirect(ClipR);
  SelectClipRgn(ACanvas.Handle, NewRgn);
  DeleteObject(NewRgn);
end;

procedure TCustomEasyGrid.RestoreClipRect(ACanvas: TCanvas);
begin
  if HaveClip > 0 then
    SelectClipRgn(ACanvas.Handle, OldRgn)
  else
    SelectClipRgn(ACanvas.Handle, 0);
  DeleteObject(OldRgn);
end;
// 注意: SetClipRect 与 RestoreClipRect 必须对同一个 Canvas 配对使用
// ******************************************************************

function TCustomEasyGrid.FindLastVisibleCell(Start: Integer; AAxisDrawInfo: TEasyGridAxisDrawInfo): Integer;
begin
  Result := Start;
  with AAxisDrawInfo do
  begin
    while (Result > FixedCellCount) and (GetExtent(Result) < 0) do
      Dec(Result);
    if Result <= FixedCellCount then
      Result := Start + 1;
  end;
end;

function TCustomEasyGrid.FindNextVisibleCell(Start: Integer; AAxisDrawInfo: TEasyGridAxisDrawInfo): Integer;
begin
  Result := Start;
  with AAxisDrawInfo do
  begin
    while (Result < GridCellCount) and (GetExtent(Result) < 0) do
      Inc(Result);
    if Result >= GridCellCount then
      Result := Start - 1;
  end;
end;

// 弹出式菜单项按键响应事件
procedure TCustomEasyGrid.MenuItemClick(Sender: TObject);
begin
  case TMenuItemTag(TMenuItem(Sender).Tag) of
    mtCut :
      CutCells(TRect(Selection));
    mtCopy :
      CopyCells(TRect(Selection));
    mtPaste :
      PasteCells(TPoint(FCurrent));
    mtInsertCellRight :
      InsertCellRight(TRect(Selection));
    mtInsertCellDown :
      InsertCellDown(TRect(Selection));
    mtInsertCol :
      InsertCol(TRect(Selection));
    mtInsertRow :
      InsertRow(TRect(Selection));
    mtDeleteCellRight :
      DeleteCellRight(TRect(Selection));
    mtDeleteCellDown :
      DeleteCellDown(TRect(Selection));
    mtDeleteCol :
      DeleteCol(TRect(Selection));
    mtDeleteRow :
      DeleteRow(TRect(Selection));
    mtClearCells :
      ClearCells(TRect(Selection));
    mtSetCellProp :
      SetCellProp;
  end;
end;

procedure TCustomEasyGrid.SetCellProp(DefaultPage: Integer = -1);
var
  Index: Integer;
begin
  FormCellProp := TFormCellProp.Create(Self);
  Index := DefaultPage;
  if (DefaultPage < 0) then Index := FCellPropPageIndex;
  if (Index >= FormCellProp.PageCtlCellProp.PageCount) then
    Index := FormCellProp.PageCtlCellProp.PageCount - 1;
  with FormCellProp do
  begin
    ParentGrid := TEasyGrid(Self);
    PageCtlCellProp.ActivePage := PageCtlCellProp.Pages[Index];
    ShowModal;
    FCellPropPageIndex := PageCtlCellProp.ActivePage.PageIndex;
    if ModalResult = mrOk then
      if Assigned(FAfterSetCellProp) then FAfterSetCellProp(Self, TRect(Selection));
  end;
  FormCellProp.Release;
end;

// 初始化弹出式菜单
procedure TCustomEasyGrid.InitPopupMenu;
var
  AMenuItem, BMenuItem: TMenuItem;
begin
  AMenuItem := TMenuItem.Create(EasyGridPopup);
  AMenuItem.Caption := '剪切(&T)';
  AMenuItem.Tag := Ord(mtCut);
  AMenuItem.OnClick := MenuItemClick;
  EasyGridPopup.Items.Add(AMenuItem);

  AMenuItem := TMenuItem.Create(EasyGridPopup);
  AMenuItem.Caption := '复制(&C)';
  AMenuItem.Tag := Ord(mtCopy);
  AMenuItem.OnClick := MenuItemClick;
  EasyGridPopup.Items.Add(AMenuItem);

  AMenuItem := TMenuItem.Create(EasyGridPopup);
  AMenuItem.Caption := '粘贴(&P)';
  AMenuItem.Tag := Ord(mtPaste);
  AMenuItem.OnClick := MenuItemClick;
  EasyGridPopup.Items.Add(AMenuItem);

  AMenuItem := TMenuItem.Create(EasyGridPopup);
  AMenuItem.Caption := '-';
  EasyGridPopup.Items.Add(AMenuItem);

  AMenuItem := TMenuItem.Create(EasyGridPopup);
  AMenuItem.Caption := '插入(&I)...';
  EasyGridPopup.Items.Add(AMenuItem);

    BMenuItem := TMenuItem.Create(AMenuItem);
    BMenuItem.Caption := '横向插入单元格';
    BMenuItem.Tag := Ord(mtInsertCellRight);
    BMenuItem.OnClick := MenuItemClick;
    AMenuItem.Add(BMenuItem);

    BMenuItem := TMenuItem.Create(AMenuItem);
    BMenuItem.Caption := '纵向插入单元格';
    BMenuItem.Tag := Ord(mtInsertCellDown);
    BMenuItem.OnClick := MenuItemClick;
    AMenuItem.Add(BMenuItem);

    BMenuItem := TMenuItem.Create(AMenuItem);
    BMenuItem.Caption := '插入整行';
    BMenuItem.Tag := Ord(mtInsertRow);
    BMenuItem.OnClick := MenuItemClick;
    AMenuItem.Add(BMenuItem);

    BMenuItem := TMenuItem.Create(AMenuItem);
    BMenuItem.Caption := '插入整列';
    BMenuItem.Tag := Ord(mtInsertCol);
    BMenuItem