Версия для печати
Компонент TMStringGrid
http://www.delphikingdom.com/asp/viewitem.asp?catalogID=1443Дамир
дата публикации 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;
К матеиралу прилагается демонстрационная программа, в которой показываются основные особенности использования данного компонента
Специально для Королевства Delphi
К материалу прилагаются файлы:
- Исходники компонента (2892 K) обновление от 7/22/2012 1:28:00 PM
- Демо-программа (3.4 K) обновление от 7/22/2012 1:30:00 PM