mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-07-20 09:27:09 +02:00
1046 lines
32 KiB
ObjectPascal
1046 lines
32 KiB
ObjectPascal
{
|
|
*****************************************************************************
|
|
This file is part of the LazEdit package from the Lazarus IDE.
|
|
|
|
This content of this file is licensensed: Modified LGPL-2
|
|
Or at the users choice: Modified LGPL-3
|
|
See the file COPYING.modifiedLGPL.txt, included in the Lazarus distribution,
|
|
for details about the license.
|
|
|
|
Alternatively, the contents of this file may be used under the terms of the
|
|
Mozilla Public License Version 1.1 http://www.mozilla.org/MPL/
|
|
|
|
A copy used under either License can have the other Licenses removed from this
|
|
header. A note should be added that the original file is available with the
|
|
above choice of License.
|
|
*****************************************************************************
|
|
}
|
|
unit LazEditTextAttributes;
|
|
|
|
{$mode objfpc}{$H+}
|
|
{$ModeSwitch advancedrecords}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, Graphics;
|
|
|
|
type
|
|
// TODO: TLazEditDisplayTokenBound is not yet supporting wrapped text - The Physical value may change
|
|
|
|
{ TLazEditDisplayTokenBound }
|
|
|
|
TLazEditDisplayTokenBound = record
|
|
Physical: Integer; // 1 based - May be in middle of char
|
|
Logical: Integer; // 1 based
|
|
Offset: Integer; // default 0. MultiWidth (e.g. Tab), if token starts in the middle of char
|
|
|
|
function HasValue: boolean; inline;
|
|
function Init(APhys, ALog: Integer; AnOffs: Integer = 0): boolean; inline;
|
|
end;
|
|
|
|
|
|
|
|
TLazTextAttributeFeature = (
|
|
lafPastEOL // color extends past eol
|
|
);
|
|
TLazTextAttributeFeatures = set of TLazTextAttributeFeature;
|
|
|
|
TLazTextAttrLineStyle = (
|
|
slsSolid, // PS_SOLID pen
|
|
slsDashed, // PS_DASH pen
|
|
slsDotted, // PS_DOT
|
|
slsWaved // solid wave
|
|
);
|
|
|
|
TLazTextAttrFrameEdges = (
|
|
sfeNone,
|
|
sfeAround, // frame around
|
|
sfeBottom, // bottom part of the frame
|
|
sfeLeft // left part of the frame
|
|
);
|
|
|
|
TLazTextAttrBorderSide = (
|
|
bsLeft,
|
|
bsTop,
|
|
bsRight,
|
|
bsBottom
|
|
);
|
|
TLazTextAttrBorderSides = set of TLazTextAttrBorderSide;
|
|
|
|
const
|
|
LazTextFrameEdgeToSides: array [TLazTextAttrFrameEdges] of TLazTextAttrBorderSides =
|
|
( [], // sfeNone
|
|
[bsLeft, bsTop, bsRight, bsBottom], // sfeAround
|
|
[bsBottom], // sfeBottom
|
|
[bsLeft] // sfeLeft
|
|
);
|
|
|
|
LazTextFrameEdgePriorities: array [TLazTextAttrFrameEdges] of integer =
|
|
( 0, // sfeNone
|
|
1, // sfeAround
|
|
2, // sfeBottom
|
|
2 // sfeLeft
|
|
);
|
|
|
|
type
|
|
|
|
{ TLazCustomEditTextAttribute }
|
|
|
|
TLazCustomEditTextAttribute = class(TPersistent)
|
|
protected type
|
|
TLazTextAttributeColor = (lacForeColor, lacBackColor, lacFrameColor);
|
|
strict private
|
|
FSupportedFeatures: TLazTextAttributeFeatures;
|
|
private
|
|
// 0 or -1 start/end before/after line // 1 first char
|
|
FStartX, FEndX: TLazEditDisplayTokenBound;
|
|
|
|
FColors: array[TLazTextAttributeColor] of TColor;
|
|
FFrameEdges: TLazTextAttrFrameEdges;
|
|
FFrameStyle: TLazTextAttrLineStyle;
|
|
FStyle: TFontStyles;
|
|
FFeatures: TLazTextAttributeFeatures;
|
|
|
|
FUpdateCount: integer;
|
|
FHasUpdates: Boolean;
|
|
protected
|
|
function GetColor(AnIndex: TLazTextAttributeColor): TColor; inline;
|
|
function GetAlpha({%H-}AnIndex: TLazTextAttributeColor): byte; virtual;
|
|
function GetPriority({%H-}AnIndex: TLazTextAttributeColor): integer; virtual;
|
|
function GetFrameStyle: TLazTextAttrLineStyle; inline;
|
|
function GetFrameEdges: TLazTextAttrFrameEdges; inline;
|
|
function GetFrameSideColors({%H-}Side: TLazTextAttrBorderSide): TColor; virtual;
|
|
function GetFrameSidePriority({%H-}Side: TLazTextAttrBorderSide): integer; virtual;
|
|
function GetFrameSideStyles({%H-}Side: TLazTextAttrBorderSide): TLazTextAttrLineStyle; virtual;
|
|
function GetStyle: TFontStyles; inline;
|
|
function GetStyleMask: TFontStyles; virtual;
|
|
function GetStylePriority({%H-}AnIndex: TFontStyle): integer; virtual;
|
|
procedure SetColor(AnIndex: TLazTextAttributeColor; AValue: TColor);
|
|
procedure SetAlpha({%H-}AnIndex: TLazTextAttributeColor; {%H-}AValue: byte); virtual;
|
|
procedure SetPriority({%H-}AnIndex: TLazTextAttributeColor; {%H-}AValue: integer); virtual;
|
|
procedure SetFrameStyle(AValue: TLazTextAttrLineStyle);
|
|
procedure SetFrameEdges(AValue: TLazTextAttrFrameEdges);
|
|
procedure SetStyle(AValue: TFontStyles);
|
|
procedure SetStyleMask({%H-}AValue: TFontStyles); virtual;
|
|
procedure SetStylePriority({%H-}AnIndex: TFontStyle; {%H-}AValue: integer); virtual;
|
|
procedure SetFeatures(AValue: TLazTextAttributeFeatures);
|
|
protected
|
|
procedure Changed;
|
|
procedure DoChanged; virtual;
|
|
procedure Init; virtual;
|
|
procedure DoClear; virtual;
|
|
procedure AssignSupportedFeaturesFrom(ASource: TLazCustomEditTextAttribute); // Not called by assign, must be called explicitly
|
|
procedure AssignColorsFrom(ASource: TLazCustomEditTextAttribute); virtual;
|
|
procedure AssignFrom(ASource: TLazCustomEditTextAttribute); virtual;
|
|
function DefaultSupportedFeatures: TLazTextAttributeFeatures; virtual;
|
|
public
|
|
constructor Create; overload;
|
|
constructor Create(ASupportedFeatures: TLazTextAttributeFeatures); overload;
|
|
// Assign does not change SupportedFeatures
|
|
procedure Assign(ASource: TPersistent); override;
|
|
procedure AssignColors(ASource: TLazCustomEditTextAttribute);
|
|
procedure Clear;
|
|
procedure BeginUpdate;
|
|
procedure EndUpdate;
|
|
function IsEnabled: boolean; virtual;
|
|
procedure UpdateSupportedFeatures(AnAddSupportedFeatures, ARemoveSupportedFeatures: TLazTextAttributeFeatures);
|
|
procedure SetAllPriorities(APriority: integer); virtual;
|
|
// boundaries of the frame
|
|
procedure SetFrameBoundsPhys(AStart, AEnd: Integer);
|
|
procedure SetFrameBoundsLog(AStart, AEnd: Integer; AStartOffs: Integer = 0; AEndOffs: Integer = 0);
|
|
property StartX: TLazEditDisplayTokenBound read FStartX write FStartX;
|
|
property EndX: TLazEditDisplayTokenBound read FEndX write FEndX;
|
|
|
|
property SupportedFeatures: TLazTextAttributeFeatures read FSupportedFeatures;
|
|
public
|
|
property Foreground: TColor index lacForeColor read GetColor write SetColor;
|
|
property Background: TColor index lacBackColor read GetColor write SetColor;
|
|
property FrameColor: TColor index lacFrameColor read GetColor write SetColor;
|
|
|
|
property BackAlpha: byte index lacBackColor read GetAlpha write SetAlpha;
|
|
property ForeAlpha: byte index lacForeColor read GetAlpha write SetAlpha;
|
|
property FrameAlpha: byte index lacFrameColor read GetAlpha write SetAlpha;
|
|
|
|
property ForePriority: integer index lacForeColor read GetPriority write SetPriority;
|
|
property BackPriority: integer index lacBackColor read GetPriority write SetPriority;
|
|
property FramePriority: integer index lacFrameColor read GetPriority write SetPriority;
|
|
|
|
property FrameStyle: TLazTextAttrLineStyle read GetFrameStyle write SetFrameStyle;
|
|
property FrameEdges: TLazTextAttrFrameEdges read GetFrameEdges write SetFrameEdges;
|
|
|
|
property FrameSidePriority[Side: TLazTextAttrBorderSide]: integer read GetFrameSidePriority;
|
|
property FrameSideColors[Side: TLazTextAttrBorderSide]: TColor read GetFrameSideColors;
|
|
property FrameSideStyles[Side: TLazTextAttrBorderSide]: TLazTextAttrLineStyle read GetFrameSideStyles;
|
|
|
|
property Style: TFontStyles read GetStyle write SetStyle;
|
|
property StyleMask: TFontStyles read GetStyleMask write SetStyleMask;
|
|
// FStyle = [], FStyleMask = [] ==> no modification
|
|
// FStyle = [fsBold], FStyleMask = [] ==> invert fsBold
|
|
// FStyle = [], FStyleMask = [fsBold] ==> clear fsBold
|
|
// FStyle = [fsBold], FStyleMask = [fsBold] ==> set fsBold
|
|
|
|
property StylePriority[AnIndex: TFontStyle]: integer read GetStylePriority write SetStylePriority;
|
|
property BoldPriority: integer index fsBold read GetStylePriority write SetStylePriority;
|
|
property ItalicPriority: integer index fsItalic read GetStylePriority write SetStylePriority;
|
|
property UnderlinePriority: integer index fsUnderline read GetStylePriority write SetStylePriority;
|
|
property StrikeOutPriority: integer index fsStrikeOut read GetStylePriority write SetStylePriority;
|
|
|
|
property Features: TLazTextAttributeFeatures read FFeatures write SetFeatures;
|
|
end;
|
|
|
|
{ TLazEditTextAttribute }
|
|
|
|
TLazEditTextAttribute = class(TLazCustomEditTextAttribute)
|
|
private
|
|
FOnChange: TNotifyEvent;
|
|
FStoredName, FFixedCaption: string;
|
|
FCaption: PString;
|
|
|
|
FPriority: array[TLazTextAttributeColor] of Integer;
|
|
FStylePriority: array[TFontStyle] of Integer;
|
|
|
|
FDefaultColors: array[TLazTextAttributeColor] of TColor;
|
|
FDefaultPriority: array[TLazTextAttributeColor] of Integer;
|
|
FDefaultFrameEdges: TLazTextAttrFrameEdges;
|
|
FDefaultFrameStyle: TLazTextAttrLineStyle;
|
|
FDefaultStyle: TFontStyles;
|
|
FDefaultStylePriority: array[TFontStyle] of Integer;
|
|
FDefaultFeatures: TLazTextAttributeFeatures;
|
|
|
|
protected
|
|
function GetPriority(AnIndex: TLazTextAttributeColor): integer; override;
|
|
function GetFrameSidePriority(Side: TLazTextAttrBorderSide): integer; override;
|
|
function GetStylePriority(AnIndex: TFontStyle): integer; override;
|
|
procedure SetPriority(AnIndex: TLazTextAttributeColor; AValue: integer); override;
|
|
procedure SetStylePriority(AnIndex: TFontStyle; AValue: integer); override;
|
|
|
|
function GetFeaturesStored: Boolean;
|
|
function GetColorStored(AnIndex: TLazTextAttributeColor): Boolean;
|
|
function GetPriorityStored(AnIndex: TLazTextAttributeColor): Boolean;
|
|
function GetFrameStyleStored: Boolean;
|
|
function GetFrameEdgesStored: Boolean;
|
|
function GetStyleStored: Boolean;
|
|
function GetStylePriorityStored(AnIndex: TFontStyle): Boolean;
|
|
|
|
procedure DoChanged; override;
|
|
procedure Init; override;
|
|
procedure DoClearThis; inline;
|
|
procedure DoClear; override;
|
|
procedure AssignColorsFrom(ASource: TLazCustomEditTextAttribute); override;
|
|
procedure AssignFrom(ASource: TLazCustomEditTextAttribute); override;
|
|
public
|
|
constructor Create;
|
|
constructor Create(ASupportedFeatures: TLazTextAttributeFeatures);
|
|
constructor Create(ACaption: string; AStoredName: String = '');
|
|
constructor Create(ACaption: string; AStoredName: String; ASupportedFeatures: TLazTextAttributeFeatures);
|
|
constructor Create(ACaption: PString; AStoredName: String = ''); // e.g. pointer to resourcestring. (Must be global var/const)
|
|
constructor Create(ACaption: PString; AStoredName: String; ASupportedFeatures: TLazTextAttributeFeatures); // e.g. pointer to resourcestring. (Must be global var/const)
|
|
procedure SetCaption(ACaption: String);
|
|
|
|
procedure InternalSaveDefaultValues; virtual;
|
|
procedure SetAllPriorities(APriority: integer); override;
|
|
|
|
property Caption: PString read FCaption; // will never be nil
|
|
property StoredName: string read FStoredName write FStoredName; // name for storage (e.g. xml)
|
|
|
|
published
|
|
property Foreground stored GetColorStored;
|
|
property Background stored GetColorStored;
|
|
property FrameColor stored GetColorStored;
|
|
|
|
property ForePriority stored GetPriorityStored;
|
|
property BackPriority stored GetPriorityStored;
|
|
property FramePriority stored GetPriorityStored;
|
|
|
|
property FrameStyle stored GetFrameStyleStored;
|
|
property FrameEdges stored GetFrameEdgesStored;
|
|
|
|
property Style stored GetStyleStored;
|
|
property BoldPriority stored GetStylePriorityStored;
|
|
property ItalicPriority stored GetStylePriorityStored;
|
|
property UnderlinePriority stored GetStylePriorityStored;
|
|
property StrikeOutPriority stored GetStylePriorityStored;
|
|
|
|
property Features stored GetFeaturesStored;
|
|
|
|
property OnChange: TNotifyEvent read FOnChange write FOnChange;
|
|
end;
|
|
|
|
{ TLazEditTextAttributeModifier }
|
|
|
|
TLazEditTextAttributeModifier = class(TLazEditTextAttribute)
|
|
private
|
|
FAlpha: array[TLazTextAttributeColor] of Byte;
|
|
FStyleMask: TFontStyles;
|
|
|
|
FDefaultAlpha: array[TLazTextAttributeColor] of Byte;
|
|
FDefaultStyleMask: TFontStyles;
|
|
protected
|
|
function GetAlpha(AnIndex: TLazTextAttributeColor): byte; override;
|
|
function GetStyleMask: TFontStyles; override;
|
|
procedure SetAlpha(AnIndex: TLazTextAttributeColor; AValue: byte); override;
|
|
procedure SetStyleMask(AValue: TFontStyles); override;
|
|
|
|
function GetAlphaStored(AnIndex: TLazTextAttributeColor): Boolean;
|
|
function GetStyleMaskStored: Boolean;
|
|
|
|
procedure DoClearThis; reintroduce; inline;
|
|
procedure DoClear; override;
|
|
procedure AssignColorsFrom(ASource: TLazCustomEditTextAttribute); override;
|
|
public
|
|
function IsEnabled: boolean; override;
|
|
procedure InternalSaveDefaultValues; override;
|
|
|
|
published
|
|
property BackAlpha stored GetAlphaStored;
|
|
property ForeAlpha stored GetAlphaStored;
|
|
property FrameAlpha stored GetAlphaStored;
|
|
|
|
property StyleMask stored GetStyleMaskStored;
|
|
end;
|
|
|
|
TLazEditCustomHighlighter = class(TComponent)
|
|
protected
|
|
procedure AddAttribute(AAttrib: TLazEditTextAttribute); virtual; abstract;
|
|
procedure RemoveAttribute(AAttrib: TLazEditTextAttribute); virtual; abstract;
|
|
end;
|
|
|
|
{ TLazEditTextAttributeModifierCollectionItem }
|
|
|
|
TLazEditTextAttributeModifierCollectionItem = class(TCollectionItem)
|
|
private
|
|
FAttribute: TLazEditTextAttributeModifier;
|
|
procedure SetAttribute(AValue: TLazEditTextAttributeModifier);
|
|
public
|
|
constructor Create(ACollection: TCollection); override;
|
|
destructor Destroy; override;
|
|
published
|
|
property Attribute: TLazEditTextAttributeModifier read FAttribute write SetAttribute;
|
|
end;
|
|
|
|
{ TLazEditTextAttributeModifierCollection }
|
|
|
|
TLazEditTextAttributeModifierCollection = class(TCollection)
|
|
private
|
|
FBaseName: string;
|
|
FBaseStoredName: string;
|
|
FOnAttributeChange: TNotifyEvent;
|
|
FOwner: TLazEditCustomHighlighter;
|
|
procedure DoAttribChaged(Sender: TObject);
|
|
function GetAttrib(Index: Integer): TLazEditTextAttributeModifier;
|
|
function GetItem(Index: Integer): TLazEditTextAttributeModifierCollectionItem;
|
|
procedure SetAttribs(Index: Integer; AValue: TLazEditTextAttributeModifier);
|
|
procedure SetBaseName(AValue: string);
|
|
procedure SetBaseStoredName(AValue: string);
|
|
procedure SetItem(Index: Integer; Value: TLazEditTextAttributeModifierCollectionItem);
|
|
procedure ResetNames;
|
|
protected
|
|
procedure Notify(Item: TCollectionItem; Action: TCollectionNotification); override;
|
|
public
|
|
constructor Create(AnOwner: TLazEditCustomHighlighter);
|
|
function Add: TLazEditTextAttributeModifierCollectionItem;
|
|
public
|
|
property BaseName: string read FBaseName write SetBaseName;
|
|
property BaseStoredName: string read FBaseStoredName write SetBaseStoredName;
|
|
|
|
property Items[Index: Integer]: TLazEditTextAttributeModifierCollectionItem read GetItem
|
|
write SetItem; default;
|
|
property Attribs[Index: Integer]: TLazEditTextAttributeModifier read GetAttrib
|
|
write SetAttribs;
|
|
property OnAttributeChange: TNotifyEvent read FOnAttributeChange write FOnAttributeChange;
|
|
end;
|
|
|
|
implementation
|
|
|
|
{ TLazEditDisplayTokenBound }
|
|
|
|
function TLazEditDisplayTokenBound.HasValue: boolean;
|
|
begin
|
|
Result := (Physical > 0) or (Logical > 0);
|
|
end;
|
|
|
|
function TLazEditDisplayTokenBound.Init(APhys, ALog: Integer; AnOffs: Integer): boolean;
|
|
begin
|
|
Physical := APhys;
|
|
Logical := ALog;
|
|
Offset := AnOffs;
|
|
end;
|
|
|
|
{ TLazCustomEditTextAttribute }
|
|
|
|
function TLazCustomEditTextAttribute.GetColor(AnIndex: TLazTextAttributeColor): TColor;
|
|
begin
|
|
Result := FColors[AnIndex];
|
|
end;
|
|
|
|
function TLazCustomEditTextAttribute.GetAlpha(AnIndex: TLazTextAttributeColor): byte;
|
|
begin
|
|
Result := 0;
|
|
end;
|
|
|
|
function TLazCustomEditTextAttribute.GetPriority(AnIndex: TLazTextAttributeColor): integer;
|
|
begin
|
|
Result := 0;
|
|
end;
|
|
|
|
function TLazCustomEditTextAttribute.GetFrameStyle: TLazTextAttrLineStyle;
|
|
begin
|
|
Result := FFrameStyle;
|
|
end;
|
|
|
|
function TLazCustomEditTextAttribute.GetFrameEdges: TLazTextAttrFrameEdges;
|
|
begin
|
|
Result := FFrameEdges;
|
|
end;
|
|
|
|
function TLazCustomEditTextAttribute.GetFrameSideColors(Side: TLazTextAttrBorderSide): TColor;
|
|
begin
|
|
Result := FColors[lacFrameColor];
|
|
end;
|
|
|
|
function TLazCustomEditTextAttribute.GetFrameSidePriority(Side: TLazTextAttrBorderSide): integer;
|
|
begin
|
|
Result := 0;
|
|
end;
|
|
|
|
function TLazCustomEditTextAttribute.GetFrameSideStyles(Side: TLazTextAttrBorderSide
|
|
): TLazTextAttrLineStyle;
|
|
begin
|
|
Result := FFrameStyle;
|
|
end;
|
|
|
|
function TLazCustomEditTextAttribute.GetStyle: TFontStyles;
|
|
begin
|
|
Result := FStyle;
|
|
end;
|
|
|
|
function TLazCustomEditTextAttribute.GetStyleMask: TFontStyles;
|
|
begin
|
|
Result := [low(TFontStyle)..High(TFontStyle)];
|
|
end;
|
|
|
|
function TLazCustomEditTextAttribute.GetStylePriority(AnIndex: TFontStyle): integer;
|
|
begin
|
|
Result := 0;
|
|
end;
|
|
|
|
procedure TLazCustomEditTextAttribute.SetColor(AnIndex: TLazTextAttributeColor; AValue: TColor);
|
|
begin
|
|
if FColors[AnIndex] = AValue then
|
|
exit;
|
|
FColors[AnIndex] := AValue;
|
|
Changed;
|
|
end;
|
|
|
|
procedure TLazCustomEditTextAttribute.SetAlpha(AnIndex: TLazTextAttributeColor; AValue: byte);
|
|
begin
|
|
raise exception.Create('abstract');
|
|
end;
|
|
|
|
procedure TLazCustomEditTextAttribute.SetPriority(AnIndex: TLazTextAttributeColor; AValue: integer
|
|
);
|
|
begin
|
|
assert(false, 'TLazCustomEditTextAttribute.SetPriority: abstract');
|
|
//raise exception.Create('abstract');
|
|
end;
|
|
|
|
procedure TLazCustomEditTextAttribute.SetFrameStyle(AValue: TLazTextAttrLineStyle);
|
|
begin
|
|
if FFrameStyle = AValue then
|
|
exit;
|
|
FFrameStyle := AValue;
|
|
Changed;
|
|
end;
|
|
|
|
procedure TLazCustomEditTextAttribute.SetFrameEdges(AValue: TLazTextAttrFrameEdges);
|
|
begin
|
|
if FFrameEdges = AValue then
|
|
exit;
|
|
FFrameEdges := AValue;
|
|
Changed;
|
|
end;
|
|
|
|
procedure TLazCustomEditTextAttribute.SetStyle(AValue: TFontStyles);
|
|
begin
|
|
if FStyle = AValue then
|
|
exit;
|
|
FStyle := AValue;
|
|
Changed;
|
|
end;
|
|
|
|
procedure TLazCustomEditTextAttribute.SetStyleMask(AValue: TFontStyles);
|
|
begin
|
|
assert(false, 'TLazCustomEditTextAttribute.SetStyleMask: abstract');
|
|
//raise exception.Create('abstract');
|
|
end;
|
|
|
|
procedure TLazCustomEditTextAttribute.SetStylePriority(AnIndex: TFontStyle; AValue: integer);
|
|
begin
|
|
assert(false, 'TLazCustomEditTextAttribute.SetStylePriority: abstract');
|
|
//raise exception.Create('abstract');
|
|
end;
|
|
|
|
procedure TLazCustomEditTextAttribute.SetFeatures(AValue: TLazTextAttributeFeatures);
|
|
begin
|
|
AValue := AValue * FSupportedFeatures;
|
|
if FFeatures = AValue then
|
|
exit;
|
|
FFeatures := AValue;
|
|
Changed;
|
|
end;
|
|
|
|
procedure TLazCustomEditTextAttribute.Changed;
|
|
begin
|
|
FHasUpdates := FUpdateCount > 0;
|
|
if FHasUpdates then
|
|
exit;
|
|
DoChanged;
|
|
end;
|
|
|
|
procedure TLazCustomEditTextAttribute.DoChanged;
|
|
begin
|
|
//
|
|
end;
|
|
|
|
procedure TLazCustomEditTextAttribute.Init;
|
|
begin
|
|
Clear;
|
|
end;
|
|
|
|
procedure TLazCustomEditTextAttribute.DoClear;
|
|
var
|
|
c: TLazTextAttributeColor;
|
|
begin
|
|
for c := low(TLazTextAttributeColor) to high(TLazTextAttributeColor) do
|
|
FColors[c] := clNone;
|
|
FFrameEdges := sfeAround;
|
|
FFrameStyle := slsSolid;
|
|
FStyle := [];
|
|
|
|
FStartX.Physical := -1;
|
|
FEndX.Physical := -1;
|
|
FStartX.Logical := -1;
|
|
FEndX.Logical := -1;
|
|
FStartX.Offset := 0;
|
|
FEndX.Offset := 0;
|
|
end;
|
|
|
|
procedure TLazCustomEditTextAttribute.AssignSupportedFeaturesFrom(
|
|
ASource: TLazCustomEditTextAttribute);
|
|
begin
|
|
FSupportedFeatures := ASource.SupportedFeatures;
|
|
FFeatures := FFeatures * SupportedFeatures;
|
|
Changed;
|
|
end;
|
|
|
|
procedure TLazCustomEditTextAttribute.AssignColorsFrom(ASource: TLazCustomEditTextAttribute);
|
|
begin
|
|
FColors := ASource.FColors;
|
|
FFrameEdges := ASource.FFrameEdges;
|
|
FFrameStyle := ASource.FFrameStyle;
|
|
FStyle := ASource.FStyle;
|
|
FFeatures := ASource.FFeatures * SupportedFeatures;
|
|
end;
|
|
|
|
procedure TLazCustomEditTextAttribute.AssignFrom(ASource: TLazCustomEditTextAttribute);
|
|
begin
|
|
FStartX := ASource.FStartX;
|
|
FEndX := ASource.FEndX;
|
|
end;
|
|
|
|
function TLazCustomEditTextAttribute.DefaultSupportedFeatures: TLazTextAttributeFeatures;
|
|
begin
|
|
Result := [];
|
|
end;
|
|
|
|
constructor TLazCustomEditTextAttribute.Create;
|
|
begin
|
|
Create(DefaultSupportedFeatures);
|
|
end;
|
|
|
|
constructor TLazCustomEditTextAttribute.Create(ASupportedFeatures: TLazTextAttributeFeatures);
|
|
begin
|
|
FSupportedFeatures := ASupportedFeatures;
|
|
Init;
|
|
end;
|
|
|
|
procedure TLazCustomEditTextAttribute.Assign(ASource: TPersistent);
|
|
var
|
|
Src: TLazCustomEditTextAttribute absolute ASource;
|
|
begin
|
|
if ASource is TLazCustomEditTextAttribute then begin
|
|
BeginUpdate;
|
|
AssignColorsFrom(Src);
|
|
AssignFrom(Src);
|
|
Changed;
|
|
EndUpdate;
|
|
end
|
|
else
|
|
inherited Assign(ASource);
|
|
end;
|
|
|
|
procedure TLazCustomEditTextAttribute.AssignColors(ASource: TLazCustomEditTextAttribute);
|
|
begin
|
|
BeginUpdate;
|
|
AssignColorsFrom(ASource);
|
|
Changed;
|
|
EndUpdate;
|
|
end;
|
|
|
|
procedure TLazCustomEditTextAttribute.Clear;
|
|
begin
|
|
BeginUpdate;
|
|
DoClear;
|
|
Changed;
|
|
EndUpdate;
|
|
end;
|
|
|
|
procedure TLazCustomEditTextAttribute.BeginUpdate;
|
|
begin
|
|
inc(FUpdateCount);
|
|
end;
|
|
|
|
procedure TLazCustomEditTextAttribute.EndUpdate;
|
|
begin
|
|
if FUpdateCount > 0 then begin
|
|
dec(FUpdateCount);
|
|
if FHasUpdates and (FUpdateCount = 0) then
|
|
Changed;
|
|
end;
|
|
end;
|
|
|
|
function TLazCustomEditTextAttribute.IsEnabled: boolean;
|
|
var
|
|
c: TLazTextAttributeColor;
|
|
begin
|
|
Result := True;
|
|
if FStyle <> [] then
|
|
exit;
|
|
for c := low(TLazTextAttributeColor) to high(TLazTextAttributeColor) do
|
|
if FColors[c] <> clNone then
|
|
exit;
|
|
Result := False;
|
|
end;
|
|
|
|
procedure TLazCustomEditTextAttribute.UpdateSupportedFeatures(AnAddSupportedFeatures,
|
|
ARemoveSupportedFeatures: TLazTextAttributeFeatures);
|
|
begin
|
|
FSupportedFeatures := FSupportedFeatures - ARemoveSupportedFeatures + AnAddSupportedFeatures;
|
|
end;
|
|
|
|
procedure TLazCustomEditTextAttribute.SetAllPriorities(APriority: integer);
|
|
begin
|
|
assert(false, 'TLazCustomEditTextAttribute.SetAllPriorities: abstract');
|
|
//raise exception.Create('abstract');
|
|
end;
|
|
|
|
procedure TLazCustomEditTextAttribute.SetFrameBoundsPhys(AStart, AEnd: Integer);
|
|
begin
|
|
FStartX.Physical := AStart;
|
|
FEndX.Physical := AEnd;
|
|
FStartX.Logical := -1;
|
|
FEndX.Logical := -1;
|
|
FStartX.Offset := 0;
|
|
FEndX.Offset := 0;
|
|
end;
|
|
|
|
procedure TLazCustomEditTextAttribute.SetFrameBoundsLog(AStart, AEnd: Integer;
|
|
AStartOffs: Integer; AEndOffs: Integer);
|
|
begin
|
|
FStartX.Physical := -1;
|
|
FEndX.Physical := -1;
|
|
FStartX.Logical := AStart;
|
|
FEndX.Logical := AEnd;
|
|
FStartX.Offset := AStartOffs;
|
|
FEndX.Offset := AEndOffs;
|
|
end;
|
|
|
|
{ TLazEditTextAttribute }
|
|
|
|
function TLazEditTextAttribute.GetPriority(AnIndex: TLazTextAttributeColor): integer;
|
|
begin
|
|
Result := FPriority[AnIndex];
|
|
end;
|
|
|
|
function TLazEditTextAttribute.GetFrameSidePriority(Side: TLazTextAttrBorderSide): integer;
|
|
begin
|
|
Result := FPriority[lacFrameColor];
|
|
end;
|
|
|
|
function TLazEditTextAttribute.GetStylePriority(AnIndex: TFontStyle): integer;
|
|
begin
|
|
Result := inherited GetStylePriority(AnIndex);
|
|
end;
|
|
|
|
procedure TLazEditTextAttribute.SetPriority(AnIndex: TLazTextAttributeColor; AValue: integer);
|
|
begin
|
|
if FPriority[AnIndex] = AValue then
|
|
exit;
|
|
FPriority[AnIndex] := AValue;
|
|
Changed;
|
|
end;
|
|
|
|
procedure TLazEditTextAttribute.SetStylePriority(AnIndex: TFontStyle; AValue: integer);
|
|
begin
|
|
if FStylePriority[AnIndex] = AValue then
|
|
exit;
|
|
FStylePriority[AnIndex] := AValue;
|
|
Changed;
|
|
end;
|
|
|
|
function TLazEditTextAttribute.GetFeaturesStored: Boolean;
|
|
begin
|
|
Result := FFeatures <> FDefaultFeatures;
|
|
end;
|
|
|
|
function TLazEditTextAttribute.GetColorStored(AnIndex: TLazTextAttributeColor): Boolean;
|
|
begin
|
|
Result := FColors[AnIndex] <> FDefaultColors[AnIndex];
|
|
end;
|
|
|
|
function TLazEditTextAttribute.GetPriorityStored(AnIndex: TLazTextAttributeColor): Boolean;
|
|
begin
|
|
Result := FPriority[AnIndex] <> FDefaultPriority[AnIndex];
|
|
end;
|
|
|
|
function TLazEditTextAttribute.GetFrameStyleStored: Boolean;
|
|
begin
|
|
Result := FFrameStyle <> FDefaultFrameStyle;
|
|
end;
|
|
|
|
function TLazEditTextAttribute.GetFrameEdgesStored: Boolean;
|
|
begin
|
|
Result := FFrameEdges <> FDefaultFrameEdges;
|
|
end;
|
|
|
|
function TLazEditTextAttribute.GetStyleStored: Boolean;
|
|
begin
|
|
Result := FStyle <> FDefaultStyle;
|
|
end;
|
|
|
|
function TLazEditTextAttribute.GetStylePriorityStored(AnIndex: TFontStyle): Boolean;
|
|
begin
|
|
Result := FStylePriority[AnIndex] <> FDefaultStylePriority[AnIndex];
|
|
end;
|
|
|
|
procedure TLazEditTextAttribute.SetCaption(ACaption: String);
|
|
begin
|
|
FFixedCaption := ACaption;
|
|
FCaption := @FFixedCaption;
|
|
end;
|
|
|
|
procedure TLazEditTextAttribute.DoChanged;
|
|
begin
|
|
inherited DoChanged;
|
|
if FOnChange <> nil then
|
|
FOnChange(Self);
|
|
end;
|
|
|
|
procedure TLazEditTextAttribute.Init;
|
|
begin
|
|
inherited Init;
|
|
InternalSaveDefaultValues;
|
|
end;
|
|
|
|
procedure TLazEditTextAttribute.DoClearThis;
|
|
var
|
|
c: TLazTextAttributeColor;
|
|
f: TFontStyle;
|
|
begin
|
|
for c := low(TLazTextAttributeColor) to high(TLazTextAttributeColor) do
|
|
FPriority[c] := 0;
|
|
for f := low(TFontStyle) to high(TFontStyle) do
|
|
FStylePriority[f] := 0;
|
|
end;
|
|
|
|
procedure TLazEditTextAttribute.DoClear;
|
|
begin
|
|
inherited DoClear;
|
|
DoClearThis;
|
|
end;
|
|
|
|
procedure TLazEditTextAttribute.AssignColorsFrom(ASource: TLazCustomEditTextAttribute);
|
|
var
|
|
Source: TLazEditTextAttribute absolute ASource;
|
|
begin
|
|
inherited AssignColorsFrom(ASource);
|
|
if ASource is TLazEditTextAttribute then begin
|
|
FPriority := Source.FPriority;
|
|
FStylePriority := Source.FStylePriority;
|
|
end
|
|
else
|
|
DoClearThis;
|
|
end;
|
|
|
|
procedure TLazEditTextAttribute.AssignFrom(ASource: TLazCustomEditTextAttribute);
|
|
var
|
|
Source: TLazEditTextAttribute absolute ASource;
|
|
begin
|
|
inherited AssignFrom(ASource);
|
|
if ASource is TLazEditTextAttribute then begin
|
|
FStoredName := Source.FStoredName;
|
|
FFixedCaption := Source.FFixedCaption;
|
|
FCaption := Source.FCaption;
|
|
end;
|
|
end;
|
|
|
|
constructor TLazEditTextAttribute.Create;
|
|
begin
|
|
FCaption := @FFixedCaption;
|
|
inherited Create;
|
|
end;
|
|
|
|
constructor TLazEditTextAttribute.Create(ASupportedFeatures: TLazTextAttributeFeatures);
|
|
begin
|
|
FCaption := @FFixedCaption;
|
|
inherited Create(ASupportedFeatures);
|
|
end;
|
|
|
|
constructor TLazEditTextAttribute.Create(ACaption: string; AStoredName: String);
|
|
begin
|
|
Create(ACaption, AStoredName, DefaultSupportedFeatures);
|
|
end;
|
|
|
|
constructor TLazEditTextAttribute.Create(ACaption: string; AStoredName: String;
|
|
ASupportedFeatures: TLazTextAttributeFeatures);
|
|
begin
|
|
FFixedCaption := ACaption;
|
|
Create(@FFixedCaption, AStoredName, ASupportedFeatures);
|
|
end;
|
|
|
|
constructor TLazEditTextAttribute.Create(ACaption: PString; AStoredName: String);
|
|
begin
|
|
Create(ACaption, AStoredName, DefaultSupportedFeatures);
|
|
end;
|
|
|
|
constructor TLazEditTextAttribute.Create(ACaption: PString; AStoredName: String;
|
|
ASupportedFeatures: TLazTextAttributeFeatures);
|
|
begin
|
|
Create(ASupportedFeatures);
|
|
if ACaption <> nil then
|
|
FCaption := ACaption;
|
|
|
|
FStoredName := AStoredName;
|
|
if FStoredName = '' then
|
|
FStoredName := FCaption^;
|
|
end;
|
|
|
|
procedure TLazEditTextAttribute.InternalSaveDefaultValues;
|
|
begin
|
|
FDefaultColors := FColors;
|
|
FDefaultPriority := FPriority;
|
|
FDefaultFrameEdges := FFrameEdges;
|
|
FDefaultFrameStyle := FFrameStyle;
|
|
FDefaultStyle := FStyle;
|
|
FDefaultStylePriority := FStylePriority;
|
|
FDefaultFeatures := FFeatures;
|
|
end;
|
|
|
|
procedure TLazEditTextAttribute.SetAllPriorities(APriority: integer);
|
|
var
|
|
c: TLazTextAttributeColor;
|
|
f: TFontStyle;
|
|
begin
|
|
for c := low(TLazTextAttributeColor) to high(TLazTextAttributeColor) do
|
|
FPriority[c] := APriority;
|
|
for f := low(TFontStyle) to high(TFontStyle) do
|
|
FStylePriority[f] := APriority;
|
|
end;
|
|
|
|
{ TLazEditTextAttributeModifier }
|
|
|
|
function TLazEditTextAttributeModifier.GetAlpha(AnIndex: TLazTextAttributeColor): byte;
|
|
begin
|
|
Result := FAlpha[AnIndex];
|
|
end;
|
|
|
|
function TLazEditTextAttributeModifier.GetStyleMask: TFontStyles;
|
|
begin
|
|
Result := FStyleMask;
|
|
end;
|
|
|
|
procedure TLazEditTextAttributeModifier.SetAlpha(AnIndex: TLazTextAttributeColor; AValue: byte);
|
|
begin
|
|
if FAlpha[AnIndex] = AValue then
|
|
exit;
|
|
FAlpha[AnIndex] := AValue;
|
|
Changed;
|
|
end;
|
|
|
|
procedure TLazEditTextAttributeModifier.SetStyleMask(AValue: TFontStyles);
|
|
begin
|
|
if FStyleMask = AValue then
|
|
exit;
|
|
FStyleMask := AValue;
|
|
Changed;
|
|
end;
|
|
|
|
function TLazEditTextAttributeModifier.GetAlphaStored(AnIndex: TLazTextAttributeColor): Boolean;
|
|
begin
|
|
Result := FAlpha[AnIndex] <> FDefaultAlpha[AnIndex];
|
|
end;
|
|
|
|
function TLazEditTextAttributeModifier.GetStyleMaskStored: Boolean;
|
|
begin
|
|
Result := FStyleMask <> FDefaultStyleMask;
|
|
end;
|
|
|
|
procedure TLazEditTextAttributeModifier.DoClearThis;
|
|
var
|
|
c: TLazTextAttributeColor;
|
|
begin
|
|
for c := low(TLazTextAttributeColor) to high(TLazTextAttributeColor) do
|
|
FAlpha[c] := 0;
|
|
FStyleMask := [];
|
|
end;
|
|
|
|
procedure TLazEditTextAttributeModifier.DoClear;
|
|
begin
|
|
inherited DoClear;
|
|
DoClearThis;
|
|
end;
|
|
|
|
procedure TLazEditTextAttributeModifier.AssignColorsFrom(ASource: TLazCustomEditTextAttribute);
|
|
var
|
|
Source: TLazEditTextAttributeModifier absolute ASource;
|
|
begin
|
|
inherited AssignColorsFrom(ASource);
|
|
if ASource is TLazEditTextAttributeModifier then begin
|
|
FAlpha := Source.FAlpha;
|
|
FStyleMask := Source.FStyleMask;
|
|
end
|
|
else
|
|
DoClearThis;
|
|
end;
|
|
|
|
function TLazEditTextAttributeModifier.IsEnabled: boolean;
|
|
begin
|
|
Result := inherited IsEnabled;
|
|
if Result then
|
|
exit;
|
|
Result := FStyleMask <> [];
|
|
end;
|
|
|
|
procedure TLazEditTextAttributeModifier.InternalSaveDefaultValues;
|
|
begin
|
|
inherited InternalSaveDefaultValues;
|
|
FDefaultAlpha := FAlpha;
|
|
FDefaultStyleMask := FStyleMask;
|
|
end;
|
|
|
|
{ TLazEditTextAttributeModifierCollectionItem }
|
|
|
|
procedure TLazEditTextAttributeModifierCollectionItem.SetAttribute(
|
|
AValue: TLazEditTextAttributeModifier);
|
|
begin
|
|
FAttribute.Assign(AValue);
|
|
end;
|
|
|
|
constructor TLazEditTextAttributeModifierCollectionItem.Create(ACollection: TCollection);
|
|
begin
|
|
FAttribute := TLazEditTextAttributeModifier.Create('', '');
|
|
inherited Create(ACollection);
|
|
end;
|
|
|
|
destructor TLazEditTextAttributeModifierCollectionItem.Destroy;
|
|
begin
|
|
inherited Destroy;
|
|
FAttribute.Destroy;
|
|
end;
|
|
|
|
{ TLazEditTextAttributeModifierCollection }
|
|
|
|
function TLazEditTextAttributeModifierCollection.GetItem(Index: Integer
|
|
): TLazEditTextAttributeModifierCollectionItem;
|
|
begin
|
|
Result := TLazEditTextAttributeModifierCollectionItem(inherited GetItem(Index));
|
|
end;
|
|
|
|
function TLazEditTextAttributeModifierCollection.GetAttrib(Index: Integer
|
|
): TLazEditTextAttributeModifier;
|
|
begin
|
|
Result := Items[Index].Attribute;
|
|
end;
|
|
|
|
procedure TLazEditTextAttributeModifierCollection.DoAttribChaged(Sender: TObject);
|
|
begin
|
|
if FOnAttributeChange <> nil then
|
|
FOnAttributeChange(Sender);
|
|
end;
|
|
|
|
procedure TLazEditTextAttributeModifierCollection.SetAttribs(Index: Integer;
|
|
AValue: TLazEditTextAttributeModifier);
|
|
begin
|
|
Items[Index].Attribute := AValue;
|
|
end;
|
|
|
|
procedure TLazEditTextAttributeModifierCollection.SetBaseName(AValue: string);
|
|
begin
|
|
if FBaseName = AValue then Exit;
|
|
FBaseName := AValue;
|
|
if Format(FBaseName, [9]) = FBaseName then
|
|
FBaseName := FBaseName + ' %d';
|
|
|
|
ResetNames;
|
|
end;
|
|
|
|
procedure TLazEditTextAttributeModifierCollection.SetBaseStoredName(AValue: string);
|
|
begin
|
|
if FBaseStoredName = AValue then Exit;
|
|
FBaseStoredName := AValue;
|
|
if Format(FBaseStoredName, [9]) = FBaseStoredName then
|
|
FBaseStoredName := FBaseStoredName + '_%d';
|
|
|
|
ResetNames;
|
|
end;
|
|
|
|
procedure TLazEditTextAttributeModifierCollection.SetItem(Index: Integer;
|
|
Value: TLazEditTextAttributeModifierCollectionItem);
|
|
begin
|
|
inherited SetItem(Index, Value);
|
|
end;
|
|
|
|
procedure TLazEditTextAttributeModifierCollection.ResetNames;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i := 0 to Count - 1 do begin
|
|
Attribs[i].SetCaption(Format(FBaseName, [i]));
|
|
Attribs[i].StoredName := Format(FBaseStoredName, [i]);
|
|
end;
|
|
end;
|
|
|
|
procedure TLazEditTextAttributeModifierCollection.Notify(Item: TCollectionItem;
|
|
Action: TCollectionNotification);
|
|
var
|
|
TheItem: TLazEditTextAttributeModifierCollectionItem absolute Item;
|
|
i: Integer;
|
|
begin
|
|
inherited Notify(Item, Action);
|
|
case Action of
|
|
cnAdded: begin
|
|
FOwner.AddAttribute(TheItem.Attribute);
|
|
TheItem.Attribute.OnChange := @DoAttribChaged;
|
|
end;
|
|
cnExtracting, cnDeleting: begin
|
|
FOwner.RemoveAttribute(TheItem.Attribute);
|
|
end;
|
|
end;
|
|
ResetNames;
|
|
end;
|
|
|
|
constructor TLazEditTextAttributeModifierCollection.Create(AnOwner: TLazEditCustomHighlighter);
|
|
begin
|
|
FOwner := AnOwner;
|
|
inherited Create(TLazEditTextAttributeModifierCollectionItem);
|
|
end;
|
|
|
|
function TLazEditTextAttributeModifierCollection.Add: TLazEditTextAttributeModifierCollectionItem;
|
|
begin
|
|
Result := TLazEditTextAttributeModifierCollectionItem(inherited Add);
|
|
end;
|
|
|
|
end.
|
|
|