Дамир
дата публикации 22-07-2012 13:11 Компонент 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;
|
|
данная процедура автоматически подгоняет ширину ячейки так, чтобы однострочный текст полностью помещался в ячейке.
Свойство
property PickList: TStrings read GetPickList write SetPickList;
заполняет раскрывающийся список значениями по умолчанию при 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;
|
|
К матеиралу прилагается демонстрационная программа, в которой показываются основные особенности использования данного компонента
К материалу прилагаются файлы:
[Создание собственных компонент] [Отображение списков, сеток]
 Обсуждение материала [ 17-09-2019 13:03 ] 2 сообщения |
