paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-11 20:19:14 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL, implemented multiline TGridColumnTitle property, from wp, issue #25902

Browse Source 
git-svn-id: trunk@44781 -
This commit is contained in:
jesus 2014-04-22 00:32:27 +00:00
parent b10107b0de
commit fcb975e5e9
2 changed files with 17 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
components/ideintf/propedits.pp
View File

@ -30,7 +30,7 @@ uses
Classes, TypInfo, SysUtils, types, Forms, Controls, LCLProc, GraphType,
FPCAdds, // for StrToQWord in older fpc versions
StringHashList, ButtonPanel, Graphics, StdCtrls, Buttons, Menus, LCLType,
ExtCtrls, ComCtrls, LCLIntf, Dialogs, EditBtn, PropertyStorage, ValEdit,
ExtCtrls, ComCtrls, LCLIntf, Dialogs, EditBtn, PropertyStorage, Grids, ValEdit,
FileUtil, FileCtrl, ObjInspStrConsts, PropEditUtils,
// Forms with .lfm files
FrmSelectProps, StringsPropEditDlg, KeyValPropEditDlg, CollectionPropEditForm,
@ -6849,6 +6849,7 @@ begin
RegisterPropertyEditor(TypeInfo(TTranslateString), TCustomStaticText, 'Caption', TStringMultilinePropertyEditor);
RegisterPropertyEditor(TypeInfo(TTranslateString), TCustomCheckBox, 'Caption', TStringMultilinePropertyEditor);
RegisterPropertyEditor(TypeInfo(TTranslateString), TComponent, 'Hint', TStringMultilinePropertyEditor);
RegisterPropertyEditor(TypeInfo(TCaption), TGridColumnTitle, 'Caption', TStringMultilinePropertyEditor);
RegisterPropertyEditor(TypeInfo(TTabOrder), TControl, 'TabOrder', TTabOrderPropertyEditor);
RegisterPropertyEditor(TypeInfo(ShortString), nil, '', TCaptionPropertyEditor);
RegisterPropertyEditor(TypeInfo(TStrings), nil, '', TStringsPropertyEditor);

17
lcl/grids.pas
View File

@ -405,9 +405,10 @@ type
FIsDefaultTitleFont: boolean;
FLayout: ^TTextLayout;
FPrefixOption: TPrefixOption;
FMultiline: Boolean;
procedure FontChanged(Sender: TObject);
function GetAlignment: TAlignment;
function GetCaption: string;
function GetCaption: TCaption;
function GetColor: TColor;
function GetFont: TFont;
function GetLayout: TTextLayout;
@ -422,6 +423,7 @@ type
procedure SetImageIndex(const AValue: Integer);
procedure SetImageLayout(const AValue: TButtonLayout);
procedure SetLayout(const AValue: TTextLayout);
procedure SetMultiLine(const AValue: Boolean);
procedure SetPrefixOption(const AValue: TPrefixOption);
property IsDefaultFont: boolean read FIsDefaultTitleFont;
protected
@ -446,6 +448,7 @@ type
property ImageIndex: Integer read FImageIndex write SetImageIndex default -1;
property ImageLayout: TButtonLayout read FImageLayout write SetImageLayout default blGlyphRight;
property Layout: TTextLayout read GetLayout write SetLayout stored IsLayoutStored;
property MultiLine: Boolean read FMultiLine write SetMultiLine;
property PrefixOption: TPrefixOption read FPrefixOption write SetPrefixOption default poNone;
end;
@ -3494,6 +3497,7 @@ var
AColor: TColor;
CurrentTextStyle: TTextStyle;
IsSelected: boolean;
gc: TGridColumn;
begin
if DefaultDrawing then begin
Canvas.Pen.Mode := pmCopy;
@ -3529,6 +3533,8 @@ begin
CurrentTextStyle.ShowPrefix := ((gdFixed in aState) and (aRow < FFixedRows)) and GetTitleShowPrefix(aCol);
CurrentTextStyle.RightToLeft := UseRightToLeftReading;
CurrentTextStyle.EndEllipsis := (goCellEllipsis in Options);
gc := ColumnFromGridColumn(aCol);
CurrentTextStyle.SingleLine := (gc = nil) or (not gc.Title.MultiLine);
Canvas.TextStyle := CurrentTextStyle;
end else begin
Canvas.TextStyle := DefaultTextStyle;
@ -10744,7 +10750,7 @@ begin
result := FAlignment^;
end;
function TGridColumnTitle.GetCaption: string;
function TGridColumnTitle.GetCaption: TCaption;
begin
if FCaption = nil then
result := GetDefaultCaption
@ -10876,6 +10882,13 @@ begin
FColumn.ColumnChanged;
end;
procedure TGridColumnTitle.SetMultiLine(const AValue: Boolean);
begin
if FMultiLine = AValue then exit;
FMultiLine := AValue;
FColumn.ColumnChanged;
end;
procedure TGridColumnTitle.SetPrefixOption(const AValue: TPrefixOption);
begin
if FPrefixOption=AValue then exit;