TMStringGrid for Delphi 5-XE2 + Source + Demo

Компонент TMStringGrid это полностью функциональный компонент TStringGrid со следующими замечательными дополнениями:

Объединение ячеек.
Выравнивание текста ячеек
Возможность исполнения ячейки в виде ComboBox или с кнопкой.
Возможность менять местами колонки и строки
Имеется функция для вывода выровненного текста на любой канве.

Данные отличия реализуются с помощь следующих дополнительных свойств и методов:

TMStringGrid = class(TMDrawGrid)
  ---
public
  ---
  function MergeCells(ALeft, ATop, ARight, ABottom : LongInt) : integer; overload; 
  function MergeCells(Selection : TGridRect) : integer; overload; 
  procedure SplitCells(ALeft, ATop, ARight, ABottom : LongInt); overload; 
  procedure SplitCells(ACol, ARow: LongInt); overload; 
  procedure SplitCells(Selection : TGridRect); overload; 
  procedure ClearMergedCells;
  procedure Move(const MovedCell : TMovedCell; FromIndex, ToIndex: Longint); 
  ---
  function GetMergedInfo(ACol, ARow: Integer; var MrgedCellInfo : TMrgedCellInfo) : boolean;
  property MergTextAlign[ACol, ARow: Integer]: TTextAlign write SetMergTextAlign;
  property CellTextWidth : integer read FCellTextWidth;
  property CellTextHeight : integer read FCellTextHeight;
  ---
published
  property PickList: TStrings read GetPickList write SetPickList;
  property CellButtonStyle : TCellButtonStyle read FCellButtonStyle write FCellButtonStyle default btsAuto;
  property OnTextAlignChange : TTextAlignChange read FOnTextAlignChange write FOnTextAlignChange;
  property OnCellButtonStyleChange : TButtonStyleChange read FOnCellButtonStyleChange write FOnCellButtonStyleChange;
  property OnCellButtonclick: TNotifyEvent read FCellButtonclick write FCellButtonclick;
  property OnGetPickListitems : TGetPickListItems read FGetPickListitems write FGetPickListitems;
end;

Метод

function GetMergedInfo(ACol, ARow: Integer; var MrgedCellInfo : TMrgedCellInfo) : Boolean

определяет, находится ли ячейка с координатами ACol, Arow в объединенной области. Если находится, функция возвращает True и заполняет структуру MrgedCellInfo, имеющую тип TmrgedCellInfo:

TMrgedCellInfo = record
  MergedRect : TGridRect;
  IsFixed : boolean;
  MergedTextAlign : TTextAlign;
end;

Здесь MergedRect — координаты объединенной области (Left, Top, Right, Bottom).

MergedTextAlign — определяет флаг выравнивания текста объединенной ячейки.

TTextAlign = (TO_TOPLEFT, TO_TOPCENTER, TO_TOPRIGHT, TO_CENTERLEFT,
  TO_CENTERCENTER, TO_CENTERRIGHT, TO_BOTTOMLEFT, TO_BOTTOMCENTER,
  TO_BOTTOMRIGHT, TO_EDITCONTROL);

Метод

function MergeCells(ALeft, ATop, ARight, ABottom : LongInt) : integer; overload;
function MergeCells(Selection : TGridRect) : integer; overload;

— перегружаемая функция, объединяющая область ячеек таблицы, ограниченную координатами ALeft, ATop, ARight, ABottom или Selection. Если функция завершается удачно, то возвращаемое значение ровно 0, если координаты введены неправильно, то возвращаемое значение ровно 1, если пытаться объединить фиксированные ячейки с обычными ячейками, то возвращаемое значение ровно 2.

procedure TForm1.FormCreate(Sender: TObject);
begin
   with MStringGrid1 do
     MergeCells(0,0, ColCount - 1, 0);
end;

или

procedure TForm1.Button1Click(Sender: TObject);
begin
   with MStringGrid1 do
     MergeCells(Selection);
end;

Метод

procedure SplitCells(ALeft, ATop, ARight, ABottom : LongInt); overload; 
procedure SplitCells(ACol, ARow: LongInt); overload; 
procedure SplitCells(Selection : TGridRect); overload;

— перегружаемая процедура, разбивающая объединенную область ячеек таблицы, ограниченную координатами ALeft, ATop, ARight, ABottom или Selection или имеющую в составе объединенной области ячейку с координатами ACol, ARow.

procedure TForm1.Button2Click(Sender: TObject);
begin
   with MStringGrid1 do
     SplitCells(0,0, ColCount - 1, 0);
end;

или

procedure TForm1.Button2Click(Sender: TObject);
begin
   with MStringGrid1 do
     SplitCells(0,0);
end;

или

procedure TForm1.Button3Click(Sender: TObject);
begin
   with MStringGrid1 do
     SplitCells(Selection);
end;

Метод

procedure ClearMergedCells;

процедура, разбивающая все объединенные ячейки.

Метод

procedure Move(const MovedCell : TMovedCell; FromIndex, ToIndex: Longint);
— процедура, позволяющая менять местами колонки или строки с номерами FromIndex, ToIndex. MovedCell — константа, имеющая тип TMovedCell, определяющая что нужно перемещать, колонки или строки.

type
  TMovedCell = (MCol, MRow);

procedure TForm1.Button4Click(Sender: TObject);
begin
   MStringGrid1.Move(MCol,1,3);
end;

выполнение данной процедуры приведет к перемещению колонки с номером 1 в колонку с номером 3. При этом колонки с номерами 2, 3 сместятся влево.

Свойство

property MergTextAlign[ACol, ARow: Integer]: TTextAlign write SetMergTextAlign;

определяет выравнивание текста объединенной ячейки, содержащей координаты ACol, ARow.

procedure TForm1.Button1Click(Sender: TObject);
begin
 with MStringGrid1 do
 begin
   MergeCells(Selection);
   with Selection do
    MergTextAlign[Left, Top] := TO_CENTERCENTER;
 end;
end;

Свойства

property CellTextWidth : integer read FCellTextWidth;
property CellTextHeight : integer read FCellTextHeight;

определяют ширину и высоту многострочного текста при прорисовке ячейки

var Bool : boolean;
procedure TForm1.MStringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
begin
    with MStringGrid1 do
    begin
     if Bool and (CellTextHeight > RowHeights[ARow]) then
     begin
      RowHeights[ARow] := CellTextHeight;
      Bool := false;
     end;
    end;
end;   

procedure TForm1.MStringGrid1GetEditText(Sender: TObject; ACol,
  ARow: Integer; var Value: String);
begin
   Bool := true;
end;

данная процедура автоматически подгоняет высоту ячейки так, чтобы многострочный текст полностью помещался в ячейке (Только если определено OnTextAlignChange и для данной ячейки TextAlign <> TO_EDITCONTROL)

var Bool : boolean;
procedure TForm1.MStringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
begin
   with MStringGrid1 do
     if Bool and (CellTextWidth > ColWidths[ACol]) then
     begin
       ColWidths[ACol] := CellTextWidth + 4;
       Bool := false;
     end;
end;

procedure TForm1.MStringGrid1GetEditText(Sender: TObject; ACol,
  ARow: Integer; var Value: String);
begin
   Bool := true;
end;

данная процедура автоматически подгоняет ширину ячейки так, чтобы однострочный текст полностью помещался в ячейке.

Свойство


заполняет раскрывающийся список значениями по умолчанию при CellButtonStyle=btsPickList.

Свойство

property CellButtonStyle : TCellButtonStyle read FCellButtonStyle write FCellButtonStyle default btsAuto;

— имеет тип TCellButtonStyle и определяет стиль кнопок в ячейках по умолчанию.

TCellButtonStyle = (btsAuto, btsEllipsis, btsPickList);

Свойство

property OnTextAlignChange : TTextAlignChange read FOnTextAlignChange write FOnTextAlignChange;

-имеет процедурный тип TTextAlignChange и определяет способ задания стиля кнопок в ячейках.

type
  TTextAlignChange = procedure(Sender: TObject; ACol, ARow: Longint; var TextAlign: TTextAlign) of object;
procedure TForm1.MStringGrid1TextAlignChange(Sender: TObject; ACol,
  ARow: Integer; var TextAlign: TTextAlign);
var CellInfo  : TMrgedCellInfo;
begin
     with MStringGrid1 do
      if GetMergedInfo(ACol, ARow, CellInfo) then
       if CellInfo.IsFixed then
           TextAlign := TO_TOPCENTER 
       else
          TextAlign := TO_CENTERCENTER;
end;

данная процедура определяет выравнивание текста в объединенных фиксированных и нефиксированных ячейках.

Свойство

property OnCellButtonStyleChange : TButtonStyleChange read FOnCellButtonStyleChange write FOnCellButtonStyleChange;

-имеет процедурный тип TButtonStyleChange и определяет способ задания стиля кнопок в ячейках.

type
  TButtonStyleChange = procedure(Sender: TObject; esCol, esRow: Longint; var CellButtonStyle: TCellButtonStyle) of object;

procedure TForm1.MStringGrid1CellButtonStyleChange(Sender: TObject; esCol,
  esRow: Integer; var CellButtonStyle: TCellButtonStyle);
begin
  CellButtonStyle := btsAuto;
  if esCol = 1 then
    CellButtonStyle := btsPickList;
  if esCol = 2 then
    CellButtonStyle := btsEllipsis;
end;

данная процедура определяет стиль кнопок в ячейках колонок.

Свойство

property OnCellButtonclick: TNotifyEvent read FCellButtonclick write FCellButtonclick;

имеет процедурный тип TNotifyEvent и определяет реакцию на нажатие кнопки ячейки при CellButtonStyle = btsEllipsis.

procedure TForm1.MStringGrid1CellButtonclick(Sender: TObject);
begin
  with MStringGrid1 do
   ShowMessage(IntToStr(Col) + '  ' + IntToStr(Row));
end;

Свойство

property OnGetPickListitems : TGetPickListItems read FGetPickListitems write FGetPickListitems;

имеет процедурный тип TGetPickListItems и определяет реакцию на раскрытие списка ячейки при CellButtonStyle = btsPickList.

type
  TGetPickListItems = procedure(Sender : TObject; ACol, ARow: Integer; Items: TStrings) of Object;

procedure TForm1.MStringGrid1GetPickListitems(Sender: TObject; ACol,
  ARow: Integer; Items: TStrings);
begin
   Items.Clear;
   if ARow = 1 then
   begin
     Items.Add('Text 1');
     Items.Add('Text 2');
     Items.Add('Text 3');
   end else
   begin
     Items.Add('String 1');
     Items.Add('String 2');
     Items.Add('String 3');
   end;
end;

Процедуа

procedure DrawAlignedText(Canvas : TCanvas; StrVal : string; TextAlign : TTextAlign; var ARect: TRect; var NeedWidth, NeedHeight : integer);

позволяет рисовать выровненный текст в прямоугольнике ARect и возвращает длину и высоту текста, если текст не умещается в прямоугольнике ARect. (Применяется для автоматического выравнивания ширины колонки или высоты строки)

procedure TForm1.MStringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var NeedWidth, NeedHeight : integer;
begin
   DrawAlignedText(MStringGrid1.Canvas, IntToStr(ACol) + '  ' + IntToStr(ARow), TO_CENTERCENTER, Rect, NeedWidth, NeedHeight);
end;

procedure TForm1.Button5Click(Sender: TObject);
var NeedWidth, NeedHeight : integer;
    Rect: TRect;
begin
   Canvas.Font.Size := 26;
   Canvas.Font.Color := clRed;
   Rect := ClientRect;
   DrawAlignedText(Canvas, 'Text', TO_BOTTOMRIGHT, Rect, NeedWidth, NeedHeight);
end;

К матеиралу прилагается демонстрационная программа, в которой показываются основные особенности использования данного компонента



Источник Королевство Delphi