mirror of
https://github.com/HeidiSQL/HeidiSQL.git
synced 2025-08-06 18:24:26 +08:00
1736 lines
47 KiB
ObjectPascal
1736 lines
47 KiB
ObjectPascal
{-------------------------------------------------------------------------------
|
|
The contents of this file are subject to the Mozilla Public License
|
|
Version 1.1 (the "License"); you may not use this file except in compliance
|
|
with the License. You may obtain a copy of the License at
|
|
http://www.mozilla.org/MPL/
|
|
|
|
Software distributed under the License is distributed on an "AS IS" basis,
|
|
WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
|
|
the specific language governing rights and limitations under the License.
|
|
|
|
The Original Code is: SynEditMiscClasses.pas, released 2000-04-07.
|
|
The Original Code is based on the mwSupportClasses.pas file from the
|
|
mwEdit component suite by Martin Waldenburg and other developers, the Initial
|
|
Author of this file is Michael Hieke.
|
|
All Rights Reserved.
|
|
|
|
Contributors to the SynEdit and mwEdit projects are listed in the
|
|
Contributors.txt file.
|
|
|
|
Alternatively, the contents of this file may be used under the terms of the
|
|
GNU General Public License Version 2 or later (the "GPL"), in which case
|
|
the provisions of the GPL are applicable instead of those above.
|
|
If you wish to allow use of your version of this file only under the terms
|
|
of the GPL and not to allow others to use your version of this file
|
|
under the MPL, indicate your decision by deleting the provisions above and
|
|
replace them with the notice and other provisions required by the GPL.
|
|
If you do not delete the provisions above, a recipient may use your version
|
|
of this file under either the MPL or the GPL.
|
|
|
|
$Id: SynEditMiscClasses.pas,v 1.40 2007/01/25 08:32:24 etrusco Exp $
|
|
|
|
You may retrieve the latest version of this file at the SynEdit home page,
|
|
located at http://SynEdit.SourceForge.net
|
|
|
|
Known Issues:
|
|
-------------------------------------------------------------------------------}
|
|
|
|
{$IFNDEF QSYNEDITMISCCLASSES}
|
|
unit SynEditMiscClasses;
|
|
{$ENDIF}
|
|
|
|
{$I SynEdit.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
{$IFDEF SYN_CLX}
|
|
{$IFDEF SYN_LINUX}
|
|
Xlib,
|
|
{$ENDIF}
|
|
Types,
|
|
Qt,
|
|
QConsts,
|
|
QGraphics,
|
|
QControls,
|
|
QImgList,
|
|
QStdCtrls,
|
|
QMenus,
|
|
kTextDrawer,
|
|
QSynEditTypes,
|
|
QSynEditKeyConst,
|
|
{$ELSE}
|
|
Consts,
|
|
Windows,
|
|
Messages,
|
|
Graphics,
|
|
Controls,
|
|
Forms,
|
|
StdCtrls,
|
|
Menus,
|
|
Registry,
|
|
SynEditTypes,
|
|
SynEditKeyConst,
|
|
{$ENDIF}
|
|
{$IFDEF SYN_COMPILER_4_UP}
|
|
Math,
|
|
{$ENDIF}
|
|
Classes,
|
|
SysUtils;
|
|
|
|
type
|
|
TSynSelectedColor = class(TPersistent)
|
|
private
|
|
fBG: TColor;
|
|
fFG: TColor;
|
|
fOnChange: TNotifyEvent;
|
|
procedure SetBG(Value: TColor);
|
|
procedure SetFG(Value: TColor);
|
|
public
|
|
constructor Create;
|
|
procedure Assign(Source: TPersistent); override;
|
|
published
|
|
property Background: TColor read fBG write SetBG default clHighLight;
|
|
property Foreground: TColor read fFG write SetFG default clHighLightText;
|
|
property OnChange: TNotifyEvent read fOnChange write fOnChange;
|
|
end;
|
|
|
|
TSynGutterBorderStyle = (gbsNone, gbsMiddle, gbsRight);
|
|
|
|
TSynGutter = class(TPersistent)
|
|
private
|
|
fFont: TFont;
|
|
fColor: TColor;
|
|
fBorderColor: TColor;
|
|
fWidth: integer;
|
|
fShowLineNumbers: boolean;
|
|
fDigitCount: integer;
|
|
fLeadingZeros: boolean;
|
|
fZeroStart: boolean;
|
|
fLeftOffset: integer;
|
|
fRightOffset: integer;
|
|
fOnChange: TNotifyEvent;
|
|
fCursor: TCursor;
|
|
fVisible: boolean;
|
|
fUseFontStyle: boolean;
|
|
fAutoSize: boolean;
|
|
fAutoSizeDigitCount: integer;
|
|
fBorderStyle: TSynGutterBorderStyle;
|
|
fLineNumberStart: Integer;
|
|
fGradient: Boolean;
|
|
fGradientStartColor: TColor;
|
|
fGradientEndColor: TColor;
|
|
fGradientSteps: Integer;
|
|
procedure SetAutoSize(const Value: boolean);
|
|
procedure SetBorderColor(const Value: TColor);
|
|
procedure SetColor(const Value: TColor);
|
|
procedure SetDigitCount(Value: integer);
|
|
procedure SetLeadingZeros(const Value: boolean);
|
|
procedure SetLeftOffset(Value: integer);
|
|
procedure SetRightOffset(Value: integer);
|
|
procedure SetShowLineNumbers(const Value: boolean);
|
|
procedure SetUseFontStyle(Value: boolean);
|
|
procedure SetVisible(Value: boolean);
|
|
procedure SetWidth(Value: integer);
|
|
procedure SetZeroStart(const Value: boolean);
|
|
procedure SetFont(Value: TFont);
|
|
procedure OnFontChange(Sender: TObject);
|
|
procedure SetBorderStyle(const Value: TSynGutterBorderStyle);
|
|
procedure SetLineNumberStart(const Value: Integer);
|
|
procedure SetGradient(const Value: Boolean);
|
|
procedure SetGradientStartColor(const Value: TColor);
|
|
procedure SetGradientEndColor(const Value: TColor);
|
|
procedure SetGradientSteps(const Value: Integer);
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
procedure Assign(Source: TPersistent); override;
|
|
procedure AutoSizeDigitCount(LinesCount: integer);
|
|
function FormatLineNumber(Line: integer): string;
|
|
function RealGutterWidth(CharWidth: integer): integer;
|
|
published
|
|
property AutoSize: boolean read fAutoSize write SetAutoSize default FALSE;
|
|
property BorderStyle: TSynGutterBorderStyle read fBorderStyle
|
|
write SetBorderStyle default gbsMiddle;
|
|
property Color: TColor read fColor write SetColor default clBtnFace;
|
|
property BorderColor: TColor read fBorderColor write SetBorderColor default clWindow;
|
|
property Cursor: TCursor read fCursor write fCursor default crDefault;
|
|
property DigitCount: integer read fDigitCount write SetDigitCount
|
|
default 4;
|
|
property Font: TFont read fFont write SetFont;
|
|
property LeadingZeros: boolean read fLeadingZeros write SetLeadingZeros
|
|
default FALSE;
|
|
property LeftOffset: integer read fLeftOffset write SetLeftOffset
|
|
default 16;
|
|
property RightOffset: integer read fRightOffset write SetRightOffset
|
|
default 2;
|
|
property ShowLineNumbers: boolean read fShowLineNumbers
|
|
write SetShowLineNumbers default FALSE;
|
|
property UseFontStyle: boolean read fUseFontStyle write SetUseFontStyle
|
|
default True;
|
|
property Visible: boolean read fVisible write SetVisible default TRUE;
|
|
property Width: integer read fWidth write SetWidth default 30;
|
|
property ZeroStart: boolean read fZeroStart write SetZeroStart
|
|
default False;
|
|
property LineNumberStart: Integer read fLineNumberStart write SetLineNumberStart default 1;
|
|
property Gradient: Boolean read fGradient write SetGradient default False;
|
|
property GradientStartColor: TColor read fGradientStartColor write SetGradientStartColor default clWindow;
|
|
property GradientEndColor: TColor read fGradientEndColor write SetGradientEndColor default clBtnFace;
|
|
property GradientSteps: Integer read fGradientSteps write SetGradientSteps default 48;
|
|
property OnChange: TNotifyEvent read fOnChange write fOnChange;
|
|
end;
|
|
|
|
TSynBookMarkOpt = class(TPersistent)
|
|
private
|
|
fBookmarkImages: TImageList;
|
|
fDrawBookmarksFirst: boolean;
|
|
fEnableKeys: Boolean;
|
|
fGlyphsVisible: Boolean;
|
|
fLeftMargin: Integer;
|
|
fOwner: TComponent;
|
|
fXoffset: integer;
|
|
fOnChange: TNotifyEvent;
|
|
procedure SetBookmarkImages(const Value: TImageList);
|
|
procedure SetDrawBookmarksFirst(Value: boolean);
|
|
procedure SetGlyphsVisible(Value: Boolean);
|
|
procedure SetLeftMargin(Value: Integer);
|
|
procedure SetXOffset(Value: integer);
|
|
public
|
|
constructor Create(AOwner: TComponent);
|
|
procedure Assign(Source: TPersistent); override;
|
|
published
|
|
property BookmarkImages: TImageList
|
|
read fBookmarkImages write SetBookmarkImages;
|
|
property DrawBookmarksFirst: boolean read fDrawBookmarksFirst
|
|
write SetDrawBookmarksFirst default True;
|
|
property EnableKeys: Boolean
|
|
read fEnableKeys write fEnableKeys default True;
|
|
property GlyphsVisible: Boolean
|
|
read fGlyphsVisible write SetGlyphsVisible default True;
|
|
property LeftMargin: Integer read fLeftMargin write SetLeftMargin default 2;
|
|
property Xoffset: integer read fXoffset write SetXOffset default 12;
|
|
property OnChange: TNotifyEvent read fOnChange write fOnChange;
|
|
end;
|
|
|
|
TSynGlyph = class(TPersistent)
|
|
private
|
|
fVisible: boolean;
|
|
fInternalGlyph, fGlyph: TBitmap;
|
|
fInternalMaskColor, fMaskColor: TColor;
|
|
fOnChange: TNotifyEvent;
|
|
procedure SetGlyph(Value: TBitmap);
|
|
procedure GlyphChange(Sender: TObject);
|
|
procedure SetMaskColor(Value: TColor);
|
|
procedure SetVisible(Value: boolean);
|
|
function GetWidth : integer;
|
|
function GetHeight : integer;
|
|
public
|
|
constructor Create(aModule: THandle; const aName: string; aMaskColor: TColor);
|
|
destructor Destroy; override;
|
|
procedure Assign(aSource: TPersistent); override;
|
|
procedure Draw(aCanvas: TCanvas; aX, aY, aLineHeight: integer);
|
|
property Width : integer read GetWidth;
|
|
property Height : integer read GetHeight;
|
|
published
|
|
property Glyph: TBitmap read fGlyph write SetGlyph;
|
|
property MaskColor: TColor read fMaskColor write SetMaskColor default clNone;
|
|
property Visible: boolean read fVisible write SetVisible default True;
|
|
property OnChange: TNotifyEvent read fOnChange write fOnChange;
|
|
end;
|
|
|
|
{ TSynMethodChain }
|
|
|
|
ESynMethodChain = class(Exception);
|
|
TSynExceptionEvent = procedure (Sender: TObject; E: Exception;
|
|
var DoContinue: Boolean) of object;
|
|
|
|
TSynMethodChain = class(TObject)
|
|
private
|
|
FNotifyProcs: TList;
|
|
FExceptionHandler: TSynExceptionEvent;
|
|
protected
|
|
procedure DoFire(const AEvent: TMethod); virtual; abstract;
|
|
function DoHandleException(E: Exception): Boolean; virtual;
|
|
property ExceptionHandler: TSynExceptionEvent read FExceptionHandler
|
|
write FExceptionHandler;
|
|
public
|
|
constructor Create; virtual;
|
|
destructor Destroy; override;
|
|
procedure Add(AEvent: TMethod);
|
|
procedure Remove(AEvent: TMethod);
|
|
procedure Fire;
|
|
end;
|
|
|
|
{ TSynNotifyEventChain }
|
|
|
|
TSynNotifyEventChain = class(TSynMethodChain)
|
|
private
|
|
FSender: TObject;
|
|
protected
|
|
procedure DoFire(const AEvent: TMethod); override;
|
|
public
|
|
constructor CreateEx(ASender: TObject);
|
|
procedure Add(AEvent: TNotifyEvent);
|
|
procedure Remove(AEvent: TNotifyEvent);
|
|
property ExceptionHandler;
|
|
property Sender: TObject read FSender write FSender;
|
|
end;
|
|
|
|
{ TSynInternalImage }
|
|
|
|
TSynInternalImage = class(TObject)
|
|
private
|
|
fImages : TBitmap;
|
|
fWidth : Integer;
|
|
fHeight : Integer;
|
|
fCount : Integer;
|
|
|
|
function CreateBitmapFromInternalList(aModule: THandle; const Name: string): TBitmap;
|
|
procedure FreeBitmapFromInternalList;
|
|
public
|
|
constructor Create(aModule: THandle; const Name: string; Count: integer);
|
|
destructor Destroy; override;
|
|
procedure Draw(ACanvas: TCanvas; Number, X, Y, LineHeight: integer);
|
|
procedure DrawTransparent(ACanvas: TCanvas; Number, X, Y,
|
|
LineHeight: integer; TransparentColor: TColor);
|
|
end;
|
|
|
|
{ TSynHotKey }
|
|
|
|
const
|
|
{$IFDEF SYN_CLX}
|
|
BorderWidth = 2;
|
|
{$ELSE}
|
|
BorderWidth = 0;
|
|
{$ENDIF}
|
|
|
|
type
|
|
{$IFDEF SYN_CLX}
|
|
TSynBorderStyle = bsNone..bsSingle;
|
|
{$ELSE}
|
|
TSynBorderStyle = TBorderStyle;
|
|
{$ENDIF}
|
|
|
|
THKModifier = (hkShift, hkCtrl, hkAlt);
|
|
THKModifiers = set of THKModifier;
|
|
THKInvalidKey = (hcNone, hcShift, hcCtrl, hcAlt, hcShiftCtrl,
|
|
hcShiftAlt, hcCtrlAlt, hcShiftCtrlAlt);
|
|
THKInvalidKeys = set of THKInvalidKey;
|
|
|
|
TSynHotKey = class(TCustomControl)
|
|
private
|
|
FBorderStyle: TSynBorderStyle;
|
|
FHotKey: TShortCut;
|
|
FInvalidKeys: THKInvalidKeys;
|
|
FModifiers: THKModifiers;
|
|
FPressedOnlyModifiers: Boolean;
|
|
procedure SetBorderStyle(const Value: TSynBorderStyle);
|
|
procedure SetHotKey(const Value: TShortCut);
|
|
procedure SetInvalidKeys(const Value: THKInvalidKeys);
|
|
procedure SetModifiers(const Value: THKModifiers);
|
|
{$IFNDEF SYN_CLX}
|
|
procedure WMGetDlgCode(var Message: TMessage); message WM_GETDLGCODE;
|
|
procedure WMKillFocus(var Msg: TWMKillFocus); message WM_KILLFOCUS;
|
|
procedure WMSetFocus(var Msg: TWMSetFocus); message WM_SETFOCUS;
|
|
{$ENDIF}
|
|
protected
|
|
{$IFNDEF SYN_CLX}
|
|
procedure CreateParams(var Params: TCreateParams); override;
|
|
{$ENDIF}
|
|
{$IFDEF SYN_CLX}
|
|
function EventFilter(Sender: QObjectH; Event: QEventH): Boolean; override;
|
|
{$ENDIF}
|
|
procedure DoExit; override;
|
|
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
|
|
procedure KeyUp(var Key: Word; Shift: TShiftState); override;
|
|
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
|
|
procedure Paint; override;
|
|
{$IFDEF SYN_CLX}
|
|
function WidgetFlags: Integer; override;
|
|
{$ENDIF}
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
published
|
|
property BorderStyle: TSynBorderStyle read FBorderStyle write SetBorderStyle
|
|
default bsSingle;
|
|
property HotKey: TShortCut read FHotKey write SetHotKey default $0041; { Alt+A }
|
|
property InvalidKeys: THKInvalidKeys read FInvalidKeys write SetInvalidKeys default [hcNone, hcShift];
|
|
property Modifiers: THKModifiers read FModifiers write SetModifiers default [hkAlt];
|
|
end;
|
|
|
|
TSynEditSearchCustom = class(TComponent)
|
|
protected
|
|
function GetPattern: string; virtual; abstract;
|
|
procedure SetPattern(const Value: string); virtual; abstract;
|
|
function GetLength(aIndex: integer): integer; virtual; abstract;
|
|
function GetResult(aIndex: integer): integer; virtual; abstract;
|
|
function GetResultCount: integer; virtual; abstract;
|
|
procedure SetOptions(const Value: TSynSearchOptions); virtual; abstract;
|
|
public
|
|
function FindAll(const NewText: string): integer; virtual; abstract;
|
|
function Replace(const aOccurrence, aReplacement: string): string; virtual; abstract;
|
|
property Pattern: string read GetPattern write SetPattern;
|
|
property ResultCount: integer read GetResultCount;
|
|
property Results[aIndex: integer]: integer read GetResult;
|
|
property Lengths[aIndex: integer]: integer read GetLength;
|
|
property Options: TSynSearchOptions write SetOptions;
|
|
end;
|
|
|
|
{$IFNDEF SYN_CLX}
|
|
{$IFNDEF SYN_COMPILER_4_UP}
|
|
TBetterRegistry = class(TRegistry)
|
|
function OpenKeyReadOnly(const Key: string): Boolean;
|
|
end;
|
|
{$ELSE}
|
|
TBetterRegistry = TRegistry;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
TSynEditMark = class
|
|
protected
|
|
fOnChange: TNotifyEvent;
|
|
fLine, fChar, fImage: Integer;
|
|
fVisible: boolean;
|
|
fInternalImage: boolean;
|
|
fBookmarkNum: integer;
|
|
procedure SetChar(const Value: Integer); virtual;
|
|
procedure SetImage(const Value: Integer); virtual;
|
|
procedure SetLine(const Value: Integer); virtual;
|
|
procedure SetVisible(const Value: boolean);
|
|
procedure SetInternalImage(const Value: boolean);
|
|
function GetIsBookmark: boolean;
|
|
public
|
|
constructor Create();
|
|
property Line: integer read fLine write SetLine;
|
|
property Char: integer read fChar write SetChar;
|
|
property ImageIndex: integer read fImage write SetImage;
|
|
property BookmarkNumber: integer read fBookmarkNum write fBookmarkNum;
|
|
property Visible: boolean read fVisible write SetVisible;
|
|
property InternalImage: boolean read fInternalImage write SetInternalImage;
|
|
property IsBookmark: boolean read GetIsBookmark;
|
|
property OnChange: TNotifyEvent read fOnChange write fOnChange;
|
|
end;
|
|
|
|
TSynEditLineMarks = array[0..16] of TSynEditMark;
|
|
|
|
{ A list of mark objects. Each object cause a litle picture to be drawn in the
|
|
gutter. }
|
|
|
|
{ TSynEditMarkList }
|
|
|
|
TSynEditMarkList = class(TObject)
|
|
private
|
|
fItems: TList;
|
|
fOnChange: TNotifyEvent;
|
|
procedure DoChange;
|
|
function GetItem(Index: Integer): TSynEditMark;
|
|
function GetCount: Integer;
|
|
procedure InternalDelete(Index: Integer);
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
function Add(Item: TSynEditMark): Integer;
|
|
function Remove(Item: TSynEditMark): Integer;
|
|
procedure ClearLine(line: integer);
|
|
procedure Clear;
|
|
procedure GetMarksForLine(line: integer; out Marks: TSynEditLineMarks);
|
|
public
|
|
property Items[Index: Integer]: TSynEditMark read GetItem; default;
|
|
property Count: Integer read GetCount;
|
|
property OnChange: TNotifyEvent read fOnChange write fOnChange;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses
|
|
{$IFDEF SYN_CLX}
|
|
QSynEditMiscProcs;
|
|
{$ELSE}
|
|
SynEditMiscProcs;
|
|
{$ENDIF}
|
|
|
|
{ TSynSelectedColor }
|
|
|
|
constructor TSynSelectedColor.Create;
|
|
begin
|
|
inherited Create;
|
|
fBG := clHighLight;
|
|
fFG := clHighLightText;
|
|
end;
|
|
|
|
procedure TSynSelectedColor.Assign(Source: TPersistent);
|
|
var
|
|
Src: TSynSelectedColor;
|
|
begin
|
|
if (Source <> nil) and (Source is TSynSelectedColor) then begin
|
|
Src := TSynSelectedColor(Source);
|
|
fBG := Src.fBG;
|
|
fFG := Src.fFG;
|
|
if Assigned(fOnChange) then fOnChange(Self);
|
|
end else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
procedure TSynSelectedColor.SetBG(Value: TColor);
|
|
begin
|
|
if (fBG <> Value) then begin
|
|
fBG := Value;
|
|
if Assigned(fOnChange) then fOnChange(Self);
|
|
end;
|
|
end;
|
|
|
|
procedure TSynSelectedColor.SetFG(Value: TColor);
|
|
begin
|
|
if (fFG <> Value) then begin
|
|
fFG := Value;
|
|
if Assigned(fOnChange) then fOnChange(Self);
|
|
end;
|
|
end;
|
|
|
|
{ TSynGutter }
|
|
|
|
constructor TSynGutter.Create;
|
|
begin
|
|
inherited Create;
|
|
fFont := TFont.Create;
|
|
fFont.Name := 'Courier New';
|
|
fFont.Size := 8;
|
|
fFont.Style := [];
|
|
fUseFontStyle := True;
|
|
fFont.OnChange := OnFontChange;
|
|
|
|
fColor := clBtnFace;
|
|
fVisible := TRUE;
|
|
fWidth := 30;
|
|
fLeftOffset := 16;
|
|
fDigitCount := 4;
|
|
fAutoSizeDigitCount := fDigitCount;
|
|
fRightOffset := 2;
|
|
fBorderColor := clWindow;
|
|
fBorderStyle := gbsMiddle;
|
|
fLineNumberStart := 1;
|
|
fZeroStart := False;
|
|
fGradient := False;
|
|
fGradientStartColor := clWindow;
|
|
fGradientEndColor := clBtnFace;
|
|
fGradientSteps := 48;
|
|
end;
|
|
|
|
destructor TSynGutter.Destroy;
|
|
begin
|
|
fFont.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TSynGutter.Assign(Source: TPersistent);
|
|
var
|
|
Src: TSynGutter;
|
|
begin
|
|
if Assigned(Source) and (Source is TSynGutter) then begin
|
|
Src := TSynGutter(Source);
|
|
fFont.Assign(src.Font);
|
|
fUseFontStyle := src.fUseFontStyle;
|
|
fColor := Src.fColor;
|
|
fVisible := Src.fVisible;
|
|
fWidth := Src.fWidth;
|
|
fShowLineNumbers := Src.fShowLineNumbers;
|
|
fLeadingZeros := Src.fLeadingZeros;
|
|
fZeroStart := Src.fZeroStart;
|
|
fLeftOffset := Src.fLeftOffset;
|
|
fDigitCount := Src.fDigitCount;
|
|
fRightOffset := Src.fRightOffset;
|
|
fAutoSize := Src.fAutoSize;
|
|
fAutoSizeDigitCount := Src.fAutoSizeDigitCount;
|
|
fLineNumberStart := Src.fLineNumberStart;
|
|
fBorderColor := Src.fBorderColor;
|
|
fBorderStyle := Src.fBorderStyle;
|
|
fGradient := Src.fGradient;
|
|
fGradientStartColor := Src.fGradientStartColor;
|
|
fGradientEndColor := Src.fGradientEndColor;
|
|
fGradientSteps := Src.fGradientSteps;
|
|
if Assigned(fOnChange) then fOnChange(Self);
|
|
end else
|
|
inherited;
|
|
end;
|
|
|
|
procedure TSynGutter.AutoSizeDigitCount(LinesCount: integer);
|
|
var
|
|
nDigits: integer;
|
|
begin
|
|
if fVisible and fAutoSize and fShowLineNumbers then
|
|
begin
|
|
if fZeroStart then
|
|
Dec(LinesCount)
|
|
else if fLineNumberStart > 1 then
|
|
Inc(LinesCount, fLineNumberStart - 1);
|
|
|
|
nDigits := Max(Length(IntToStr(LinesCount)), fDigitCount);
|
|
if fAutoSizeDigitCount <> nDigits then begin
|
|
fAutoSizeDigitCount := nDigits;
|
|
if Assigned(fOnChange) then fOnChange(Self);
|
|
end;
|
|
end else
|
|
fAutoSizeDigitCount := fDigitCount;
|
|
end;
|
|
|
|
function TSynGutter.FormatLineNumber(Line: integer): string;
|
|
var
|
|
i: integer;
|
|
begin
|
|
if fZeroStart then
|
|
Dec(Line)
|
|
else if fLineNumberStart > 1 then
|
|
Inc(Line, fLineNumberStart - 1);
|
|
Str(Line : fAutoSizeDigitCount, Result);
|
|
if fLeadingZeros then
|
|
for i := 1 to fAutoSizeDigitCount - 1 do begin
|
|
if (Result[i] <> ' ') then break;
|
|
Result[i] := '0';
|
|
end;
|
|
end;
|
|
|
|
function TSynGutter.RealGutterWidth(CharWidth: integer): integer;
|
|
begin
|
|
if not fVisible then
|
|
Result := 0
|
|
else if fShowLineNumbers then
|
|
Result := fLeftOffset + fRightOffset + fAutoSizeDigitCount * CharWidth + 2
|
|
else
|
|
Result := fWidth;
|
|
end;
|
|
|
|
procedure TSynGutter.SetAutoSize(const Value: boolean);
|
|
begin
|
|
if fAutoSize <> Value then begin
|
|
fAutoSize := Value;
|
|
if Assigned(fOnChange) then fOnChange(Self);
|
|
end;
|
|
end;
|
|
|
|
procedure TSynGutter.SetColor(const Value: TColor);
|
|
begin
|
|
if fColor <> Value then begin
|
|
fColor := Value;
|
|
if Assigned(fOnChange) then fOnChange(Self);
|
|
end;
|
|
end;
|
|
|
|
procedure TSynGutter.SetFont(Value: TFont);
|
|
begin
|
|
fFont.Assign(Value);
|
|
end;
|
|
|
|
procedure TSynGutter.OnFontChange(Sender: TObject);
|
|
begin
|
|
if Assigned(fOnChange) then fOnChange(Self);
|
|
end;
|
|
|
|
procedure TSynGutter.SetDigitCount(Value: integer);
|
|
begin
|
|
Value := MinMax(Value, 2, 12);
|
|
if fDigitCount <> Value then begin
|
|
fDigitCount := Value;
|
|
fAutoSizeDigitCount := fDigitCount;
|
|
if Assigned(fOnChange) then fOnChange(Self);
|
|
end;
|
|
end;
|
|
|
|
procedure TSynGutter.SetLeadingZeros(const Value: boolean);
|
|
begin
|
|
if fLeadingZeros <> Value then begin
|
|
fLeadingZeros := Value;
|
|
if Assigned(fOnChange) then fOnChange(Self);
|
|
end;
|
|
end;
|
|
|
|
procedure TSynGutter.SetLeftOffset(Value: integer);
|
|
begin
|
|
Value := Max(0, Value);
|
|
if fLeftOffset <> Value then begin
|
|
fLeftOffset := Value;
|
|
if Assigned(fOnChange) then fOnChange(Self);
|
|
end;
|
|
end;
|
|
|
|
procedure TSynGutter.SetRightOffset(Value: integer);
|
|
begin
|
|
Value := Max(0, Value);
|
|
if fRightOffset <> Value then begin
|
|
fRightOffset := Value;
|
|
if Assigned(fOnChange) then fOnChange(Self);
|
|
end;
|
|
end;
|
|
|
|
procedure TSynGutter.SetShowLineNumbers(const Value: boolean);
|
|
begin
|
|
if fShowLineNumbers <> Value then begin
|
|
fShowLineNumbers := Value;
|
|
if Assigned(fOnChange) then fOnChange(Self);
|
|
end;
|
|
end;
|
|
|
|
procedure TSynGutter.SetUseFontStyle(Value: boolean);
|
|
begin
|
|
if fUseFontStyle <> Value then begin
|
|
fUseFontStyle := Value;
|
|
if Assigned(fOnChange) then fOnChange(Self);
|
|
end;
|
|
end;
|
|
|
|
procedure TSynGutter.SetVisible(Value: boolean);
|
|
begin
|
|
if fVisible <> Value then begin
|
|
fVisible := Value;
|
|
if Assigned(fOnChange) then fOnChange(Self);
|
|
end;
|
|
end;
|
|
|
|
procedure TSynGutter.SetWidth(Value: integer);
|
|
begin
|
|
Value := Max(0, Value);
|
|
if fWidth <> Value then begin
|
|
fWidth := Value;
|
|
if Assigned(fOnChange) then fOnChange(Self);
|
|
end;
|
|
end;
|
|
|
|
procedure TSynGutter.SetZeroStart(const Value: boolean);
|
|
begin
|
|
if fZeroStart <> Value then begin
|
|
fZeroStart := Value;
|
|
if Assigned(fOnChange) then fOnChange(Self);
|
|
end;
|
|
end;
|
|
|
|
procedure TSynGutter.SetBorderStyle(const Value: TSynGutterBorderStyle);
|
|
begin
|
|
fBorderStyle := Value;
|
|
if Assigned(fOnChange) then fOnChange(Self);
|
|
end;
|
|
|
|
procedure TSynGutter.SetLineNumberStart(const Value: Integer);
|
|
begin
|
|
if Value <> fLineNumberStart then
|
|
begin
|
|
fLineNumberStart := Value;
|
|
if fLineNumberStart < 0 then
|
|
fLineNumberStart := 0;
|
|
if fLineNumberStart = 0 then
|
|
fZeroStart := True
|
|
else
|
|
fZeroStart := False;
|
|
if Assigned(fOnChange) then fOnChange(Self);
|
|
end;
|
|
end;
|
|
|
|
procedure TSynGutter.SetBorderColor(const Value: TColor);
|
|
begin
|
|
if fBorderColor <> Value then
|
|
begin
|
|
fBorderColor := Value;
|
|
if Assigned(fOnChange) then fOnChange(Self);
|
|
end;
|
|
end;
|
|
|
|
procedure TSynGutter.SetGradient(const Value: Boolean);
|
|
begin
|
|
if Value <> fGradient then
|
|
begin
|
|
fGradient := Value;
|
|
if Assigned(fOnChange) then fOnChange(Self);
|
|
end;
|
|
end;
|
|
|
|
procedure TSynGutter.SetGradientEndColor(const Value: TColor);
|
|
begin
|
|
if Value <> fGradientEndColor then
|
|
begin
|
|
fGradientEndColor := Value;
|
|
if Assigned(fOnChange) then fOnChange(Self);
|
|
end;
|
|
end;
|
|
|
|
procedure TSynGutter.SetGradientStartColor(const Value: TColor);
|
|
begin
|
|
if Value <> fGradientStartColor then
|
|
begin
|
|
fGradientStartColor := Value;
|
|
if Assigned(fOnChange) then fOnChange(Self);
|
|
end;
|
|
end;
|
|
|
|
procedure TSynGutter.SetGradientSteps(const Value: Integer);
|
|
begin
|
|
if Value <> fGradientSteps then
|
|
begin
|
|
fGradientSteps := Value;
|
|
if fGradientSteps < 2 then
|
|
fGradientSteps := 2;
|
|
if Assigned(fOnChange) then fOnChange(Self);
|
|
end;
|
|
end;
|
|
|
|
{ TSynBookMarkOpt }
|
|
|
|
constructor TSynBookMarkOpt.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create;
|
|
fDrawBookmarksFirst := TRUE;
|
|
fEnableKeys := True;
|
|
fGlyphsVisible := True;
|
|
fLeftMargin := 2;
|
|
fOwner := AOwner;
|
|
fXOffset := 12;
|
|
end;
|
|
|
|
procedure TSynBookMarkOpt.Assign(Source: TPersistent);
|
|
var
|
|
Src: TSynBookMarkOpt;
|
|
begin
|
|
if (Source <> nil) and (Source is TSynBookMarkOpt) then begin
|
|
Src := TSynBookMarkOpt(Source);
|
|
fBookmarkImages := Src.fBookmarkImages;
|
|
fDrawBookmarksFirst := Src.fDrawBookmarksFirst;
|
|
fEnableKeys := Src.fEnableKeys;
|
|
fGlyphsVisible := Src.fGlyphsVisible;
|
|
fLeftMargin := Src.fLeftMargin;
|
|
fXoffset := Src.fXoffset;
|
|
if Assigned(fOnChange) then fOnChange(Self);
|
|
end else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
procedure TSynBookMarkOpt.SetBookmarkImages(const Value: TImageList);
|
|
begin
|
|
if fBookmarkImages <> Value then begin
|
|
fBookmarkImages := Value;
|
|
if Assigned(fBookmarkImages) then fBookmarkImages.FreeNotification(fOwner);
|
|
if Assigned(fOnChange) then fOnChange(Self);
|
|
end;
|
|
end;
|
|
|
|
procedure TSynBookMarkOpt.SetDrawBookmarksFirst(Value: boolean);
|
|
begin
|
|
if Value <> fDrawBookmarksFirst then begin
|
|
fDrawBookmarksFirst := Value;
|
|
if Assigned(fOnChange) then fOnChange(Self);
|
|
end;
|
|
end;
|
|
|
|
procedure TSynBookMarkOpt.SetGlyphsVisible(Value: Boolean);
|
|
begin
|
|
if fGlyphsVisible <> Value then begin
|
|
fGlyphsVisible := Value;
|
|
if Assigned(fOnChange) then fOnChange(Self);
|
|
end;
|
|
end;
|
|
|
|
procedure TSynBookMarkOpt.SetLeftMargin(Value: Integer);
|
|
begin
|
|
if fLeftMargin <> Value then begin
|
|
fLeftMargin := Value;
|
|
if Assigned(fOnChange) then fOnChange(Self);
|
|
end;
|
|
end;
|
|
|
|
procedure TSynBookMarkOpt.SetXOffset(Value: integer);
|
|
begin
|
|
if fXOffset <> Value then begin
|
|
fXOffset := Value;
|
|
if Assigned(fOnChange) then fOnChange(Self);
|
|
end;
|
|
end;
|
|
|
|
{ TSynGlyph }
|
|
|
|
constructor TSynGlyph.Create(aModule: THandle; const aName: string; aMaskColor: TColor);
|
|
begin
|
|
inherited Create;
|
|
|
|
if aName <> '' then
|
|
begin
|
|
fInternalGlyph := TBitmap.Create;
|
|
fInternalGlyph.LoadFromResourceName(aModule, aName);
|
|
fInternalMaskColor := aMaskColor;
|
|
end
|
|
else
|
|
fInternalMaskColor := clNone;
|
|
|
|
fVisible := True;
|
|
fGlyph := TBitmap.Create;
|
|
fGlyph.OnChange := GlyphChange;
|
|
fMaskColor := clNone;
|
|
end;
|
|
|
|
destructor TSynGlyph.Destroy;
|
|
begin
|
|
if Assigned(fInternalGlyph) then
|
|
FreeAndNil(fInternalGlyph);
|
|
|
|
fGlyph.Free;
|
|
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TSynGlyph.Assign(aSource: TPersistent);
|
|
var
|
|
vSrc : TSynGlyph;
|
|
begin
|
|
if Assigned(aSource) and (aSource is TSynGlyph) then
|
|
begin
|
|
vSrc := TSynGlyph(aSource);
|
|
fInternalGlyph := vSrc.fInternalGlyph;
|
|
fInternalMaskColor := vSrc.fInternalMaskColor;
|
|
fVisible := vSrc.fVisible;
|
|
fGlyph := vSrc.fGlyph;
|
|
fMaskColor := vSrc.fMaskColor;
|
|
if Assigned(fOnChange) then fOnChange(Self);
|
|
end
|
|
else
|
|
inherited;
|
|
end;
|
|
|
|
procedure TSynGlyph.Draw(aCanvas: TCanvas; aX, aY, aLineHeight: integer);
|
|
var
|
|
rcSrc, rcDest : TRect;
|
|
vGlyph : TBitmap;
|
|
vMaskColor : TColor;
|
|
begin
|
|
if not fGlyph.Empty then
|
|
begin
|
|
vGlyph := fGlyph;
|
|
vMaskColor := fMaskColor;
|
|
end
|
|
else if Assigned(fInternalGlyph) then
|
|
begin
|
|
vGlyph := fInternalGlyph;
|
|
vMaskColor := fInternalMaskColor;
|
|
end
|
|
else
|
|
Exit;
|
|
|
|
if aLineHeight >= vGlyph.Height then
|
|
begin
|
|
rcSrc := Rect(0, 0, vGlyph.Width, vGlyph.Height);
|
|
Inc(aY, (aLineHeight - vGlyph.Height) div 2);
|
|
rcDest := Rect(aX, aY, aX + vGlyph.Width, aY + vGlyph.Height);
|
|
end
|
|
else
|
|
begin
|
|
rcDest := Rect(aX, aY, aX + vGlyph.Width, aY + aLineHeight);
|
|
aY := (vGlyph.Height - aLineHeight) div 2;
|
|
rcSrc := Rect(0, aY, vGlyph.Width, aY + aLineHeight);
|
|
end;
|
|
|
|
{$IFDEF SYN_CLX}
|
|
if vMaskColor = clNone then
|
|
vGlyph.Transparent := False
|
|
else begin
|
|
vGlyph.TransparentColor := vMaskColor;
|
|
vGlyph.Transparent := True;
|
|
end;
|
|
aCanvas.CopyRect(rcDest, vGlyph.Canvas, rcSrc);
|
|
{$ELSE}
|
|
aCanvas.BrushCopy(rcDest, vGlyph, rcSrc, vMaskColor);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TSynGlyph.SetGlyph(Value: TBitmap);
|
|
begin
|
|
fGlyph.Assign(Value);
|
|
end;
|
|
|
|
procedure TSynGlyph.GlyphChange(Sender: TObject);
|
|
begin
|
|
if Assigned(fOnChange) then fOnChange(Self);
|
|
end;
|
|
|
|
procedure TSynGlyph.SetMaskColor(Value: TColor);
|
|
begin
|
|
if fMaskColor <> Value then
|
|
begin
|
|
fMaskColor := Value;
|
|
if Assigned(fOnChange) then fOnChange(Self);
|
|
end;
|
|
end;
|
|
|
|
procedure TSynGlyph.SetVisible(Value: boolean);
|
|
begin
|
|
if fVisible <> Value then
|
|
begin
|
|
fVisible := Value;
|
|
if Assigned(fOnChange) then fOnChange(Self);
|
|
end;
|
|
end;
|
|
|
|
function TSynGlyph.GetWidth : integer;
|
|
begin
|
|
if not fGlyph.Empty then
|
|
Result := fGlyph.Width
|
|
else
|
|
if Assigned(fInternalGlyph) then
|
|
Result := fInternalGlyph.Width
|
|
else
|
|
Result := 0;
|
|
end;
|
|
|
|
function TSynGlyph.GetHeight : integer;
|
|
begin
|
|
if not fGlyph.Empty then
|
|
Result := fGlyph.Height
|
|
else
|
|
if Assigned(fInternalGlyph) then
|
|
Result := fInternalGlyph.Height
|
|
else
|
|
Result := 0;
|
|
end;
|
|
|
|
{ TSynMethodChain }
|
|
|
|
procedure TSynMethodChain.Add(AEvent: TMethod);
|
|
begin
|
|
if not Assigned(@AEvent) then
|
|
raise ESynMethodChain.CreateFmt(
|
|
'%s.Entry : the parameter `AEvent'' must be specified.', [ClassName]);
|
|
|
|
with FNotifyProcs, AEvent do
|
|
begin
|
|
Add(Code);
|
|
Add(Data);
|
|
end
|
|
end;
|
|
|
|
constructor TSynMethodChain.Create;
|
|
begin
|
|
inherited;
|
|
FNotifyProcs := TList.Create;
|
|
end;
|
|
|
|
destructor TSynMethodChain.Destroy;
|
|
begin
|
|
FNotifyProcs.Free;
|
|
inherited;
|
|
end;
|
|
|
|
function TSynMethodChain.DoHandleException(E: Exception): Boolean;
|
|
begin
|
|
if not Assigned(FExceptionHandler) then
|
|
raise E
|
|
else
|
|
try
|
|
Result := True;
|
|
FExceptionHandler(Self, E, Result);
|
|
except
|
|
raise ESynMethodChain.CreateFmt(
|
|
'%s.DoHandleException : MUST NOT occur any kind of exception in '+
|
|
'ExceptionHandler', [ClassName]);
|
|
end;
|
|
end;
|
|
|
|
procedure TSynMethodChain.Fire;
|
|
var
|
|
AMethod: TMethod;
|
|
i: Integer;
|
|
begin
|
|
i := 0;
|
|
with FNotifyProcs, AMethod do
|
|
while i < Count do
|
|
try
|
|
repeat
|
|
Code := Items[i];
|
|
Inc(i);
|
|
Data := Items[i];
|
|
Inc(i);
|
|
|
|
DoFire(AMethod)
|
|
until i >= Count;
|
|
except
|
|
on E: Exception do
|
|
if not DoHandleException(E) then
|
|
i := MaxInt;
|
|
end;
|
|
end;
|
|
|
|
procedure TSynMethodChain.Remove(AEvent: TMethod);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
if not Assigned(@AEvent) then
|
|
raise ESynMethodChain.CreateFmt(
|
|
'%s.Remove: the parameter `AEvent'' must be specified.', [ClassName]);
|
|
|
|
with FNotifyProcs, AEvent do
|
|
begin
|
|
i := Count - 1;
|
|
while i > 0 do
|
|
if Items[i] <> Data then
|
|
Dec(i, 2)
|
|
else
|
|
begin
|
|
Dec(i);
|
|
if Items[i] = Code then
|
|
begin
|
|
Delete(i);
|
|
Delete(i);
|
|
end;
|
|
Dec(i);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{ TSynNotifyEventChain }
|
|
|
|
procedure TSynNotifyEventChain.Add(AEvent: TNotifyEvent);
|
|
begin
|
|
inherited Add(TMethod(AEvent));
|
|
end;
|
|
|
|
constructor TSynNotifyEventChain.CreateEx(ASender: TObject);
|
|
begin
|
|
inherited Create;
|
|
FSender := ASender;
|
|
end;
|
|
|
|
procedure TSynNotifyEventChain.DoFire(const AEvent: TMethod);
|
|
begin
|
|
TNotifyEvent(AEvent)(FSender);
|
|
end;
|
|
|
|
procedure TSynNotifyEventChain.Remove(AEvent: TNotifyEvent);
|
|
begin
|
|
inherited Remove(TMethod(AEvent));
|
|
end;
|
|
|
|
{ TSynInternalImage }
|
|
|
|
type
|
|
TInternalResource = class (TObject)
|
|
public
|
|
UsageCount : Integer;
|
|
Name : string;
|
|
Bitmap : TBitmap;
|
|
end;
|
|
|
|
var
|
|
InternalResources: TList;
|
|
|
|
constructor TSynInternalImage.Create(aModule: THandle; const Name: string; Count: integer);
|
|
begin
|
|
inherited Create;
|
|
fImages := CreateBitmapFromInternalList( aModule, Name );
|
|
fWidth := (fImages.Width + Count shr 1) div Count;
|
|
fHeight := fImages.Height;
|
|
fCount := Count;
|
|
end;
|
|
|
|
destructor TSynInternalImage.Destroy;
|
|
begin
|
|
FreeBitmapFromInternalList;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TSynInternalImage.CreateBitmapFromInternalList(aModule: THandle;
|
|
const Name: string): TBitmap;
|
|
var
|
|
idx: Integer;
|
|
newIntRes: TInternalResource;
|
|
begin
|
|
{ There is no list until now }
|
|
if (InternalResources = nil) then
|
|
InternalResources := TList.Create;
|
|
|
|
{ Search the list for the needed resource }
|
|
for idx := 0 to InternalResources.Count - 1 do
|
|
if (TInternalResource (InternalResources[idx]).Name = UpperCase (Name)) then
|
|
with TInternalResource (InternalResources[idx]) do begin
|
|
UsageCount := UsageCount + 1;
|
|
Result := Bitmap;
|
|
exit;
|
|
end;
|
|
|
|
{ There is no loaded resource in the list so let's create a new one }
|
|
Result := TBitmap.Create;
|
|
Result.LoadFromResourceName( aModule, Name );
|
|
|
|
{ Add the new resource to our list }
|
|
newIntRes:= TInternalResource.Create;
|
|
newIntRes.UsageCount := 1;
|
|
newIntRes.Name := UpperCase (Name);
|
|
newIntRes.Bitmap := Result;
|
|
InternalResources.Add (newIntRes);
|
|
end;
|
|
|
|
procedure TSynInternalImage.FreeBitmapFromInternalList;
|
|
var
|
|
idx: Integer;
|
|
intRes: TInternalResource;
|
|
function FindImageInList: Integer;
|
|
begin
|
|
for Result := 0 to InternalResources.Count - 1 do
|
|
if (TInternalResource (InternalResources[Result]).Bitmap = fImages) then
|
|
exit;
|
|
Result := -1;
|
|
end;
|
|
begin
|
|
{ Search the index of our resource in the list }
|
|
idx := FindImageInList;
|
|
|
|
{ Ey, what's this ???? }
|
|
if (idx = -1) then
|
|
exit;
|
|
|
|
{ Decrement the usagecount in the object. If there are no more users
|
|
remove the object from the list and free it }
|
|
intRes := TInternalResource (InternalResources[idx]);
|
|
with intRes do begin
|
|
UsageCount := UsageCount - 1;
|
|
if (UsageCount = 0) then begin
|
|
Bitmap.Free;
|
|
InternalResources.Delete (idx);
|
|
intRes.Free;
|
|
end;
|
|
end;
|
|
|
|
{ If there are no more entries in the list free it }
|
|
if (InternalResources.Count = 0) then begin
|
|
InternalResources.Free;
|
|
InternalResources := nil;
|
|
end;
|
|
end;
|
|
|
|
procedure TSynInternalImage.Draw(ACanvas: TCanvas;
|
|
Number, X, Y, LineHeight: integer);
|
|
var
|
|
rcSrc, rcDest: TRect;
|
|
begin
|
|
if (Number >= 0) and (Number < fCount) then
|
|
begin
|
|
if LineHeight >= fHeight then begin
|
|
rcSrc := Rect(Number * fWidth, 0, (Number + 1) * fWidth, fHeight);
|
|
Inc(Y, (LineHeight - fHeight) div 2);
|
|
rcDest := Rect(X, Y, X + fWidth, Y + fHeight);
|
|
end else begin
|
|
rcDest := Rect(X, Y, X + fWidth, Y + LineHeight);
|
|
Y := (fHeight - LineHeight) div 2;
|
|
rcSrc := Rect(Number * fWidth, Y, (Number + 1) * fWidth,
|
|
Y + LineHeight);
|
|
end;
|
|
ACanvas.CopyRect(rcDest, fImages.Canvas, rcSrc);
|
|
end;
|
|
end;
|
|
|
|
procedure TSynInternalImage.DrawTransparent(ACanvas: TCanvas; Number, X, Y,
|
|
LineHeight: integer; TransparentColor: TColor);
|
|
var
|
|
rcSrc, rcDest: TRect;
|
|
begin
|
|
if (Number >= 0) and (Number < fCount) then
|
|
begin
|
|
if LineHeight >= fHeight then begin
|
|
rcSrc := Rect(Number * fWidth, 0, (Number + 1) * fWidth, fHeight);
|
|
Inc(Y, (LineHeight - fHeight) div 2);
|
|
rcDest := Rect(X, Y, X + fWidth, Y + fHeight);
|
|
end else begin
|
|
rcDest := Rect(X, Y, X + fWidth, Y + LineHeight);
|
|
Y := (fHeight - LineHeight) div 2;
|
|
rcSrc := Rect(Number * fWidth, Y, (Number + 1) * fWidth,
|
|
Y + LineHeight);
|
|
end;
|
|
{$IFDEF SYN_CLX}
|
|
ACanvas.CopyMode := cmMergeCopy;
|
|
ACanvas.CopyRect(rcDest, fImages.Canvas, rcSrc);
|
|
{$ELSE}
|
|
ACanvas.BrushCopy(rcDest, fImages, rcSrc, TransparentColor);
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
|
|
{ TSynHotKey }
|
|
|
|
function KeySameAsShiftState(Key: Word; Shift: TShiftState): Boolean;
|
|
begin
|
|
Result := (Key = SYNEDIT_SHIFT) and (ssShift in Shift) or
|
|
(Key = SYNEDIT_CONTROL) and (ssCtrl in Shift) or
|
|
(Key = SYNEDIT_MENU) and (ssAlt in Shift);
|
|
end;
|
|
|
|
function ModifiersToShiftState(Modifiers: THKModifiers): TShiftState;
|
|
begin
|
|
Result := [];
|
|
if hkShift in Modifiers then Include(Result, ssShift);
|
|
if hkCtrl in Modifiers then Include(Result, ssCtrl);
|
|
if hkAlt in Modifiers then Include(Result, ssAlt);
|
|
end;
|
|
|
|
function ShiftStateToTHKInvalidKey(Shift: TShiftState): THKInvalidKey;
|
|
begin
|
|
Shift := Shift * [ssShift, ssAlt, ssCtrl];
|
|
if Shift = [ssShift] then
|
|
Result := hcShift
|
|
else if Shift = [ssCtrl] then
|
|
Result := hcCtrl
|
|
else if Shift = [ssAlt] then
|
|
Result := hcAlt
|
|
else if Shift = [ssShift, ssCtrl] then
|
|
Result := hcShiftCtrl
|
|
else if Shift = [ssShift, ssAlt] then
|
|
Result := hcShiftAlt
|
|
else if Shift = [ssCtrl, ssAlt] then
|
|
Result := hcCtrlAlt
|
|
else if Shift = [ssShift, ssCtrl, ssAlt] then
|
|
Result := hcShiftCtrlAlt
|
|
else
|
|
Result := hcNone;
|
|
end;
|
|
|
|
function ShortCutToTextEx(Key: Word; Shift: TShiftState): WideString;
|
|
begin
|
|
if ssCtrl in Shift then Result := SmkcCtrl;
|
|
if ssShift in Shift then Result := Result + SmkcShift;
|
|
if ssAlt in Shift then Result := Result + SmkcAlt;
|
|
|
|
{$IFDEF SYN_CLX}
|
|
if Lo(Key) > Ord('Z') then
|
|
Result := Result + Chr(Key)
|
|
else
|
|
{$ENDIF}
|
|
Result := Result + ShortCutToText(TShortCut(Key));
|
|
if Result = '' then
|
|
Result := srNone;
|
|
end;
|
|
|
|
constructor TSynHotKey.Create(AOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
{$IFDEF SYN_CLX}
|
|
InputKeys := [ikAll];
|
|
{$ENDIF}
|
|
|
|
BorderStyle := bsSingle;
|
|
{$IFNDEF SYN_CLX}
|
|
{$IFDEF SYN_COMPILER_7_UP}
|
|
ControlStyle := ControlStyle + [csNeedsBorderPaint];
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
FInvalidKeys := [hcNone, hcShift];
|
|
FModifiers := [hkAlt];
|
|
SetHotKey($0041); { Alt+A }
|
|
|
|
ParentColor := False;
|
|
Color := clWindow;
|
|
TabStop := True;
|
|
end;
|
|
|
|
{$IFNDEF SYN_CLX}
|
|
procedure TSynHotKey.CreateParams(var Params: TCreateParams);
|
|
const
|
|
BorderStyles: array[TSynBorderStyle] of DWORD = (0, WS_BORDER);
|
|
ClassStylesOff = CS_VREDRAW or CS_HREDRAW;
|
|
begin
|
|
inherited CreateParams(Params);
|
|
with Params do
|
|
begin
|
|
WindowClass.Style := WindowClass.Style and not ClassStylesOff;
|
|
Style := Style or BorderStyles[fBorderStyle] or WS_CLIPCHILDREN;
|
|
|
|
if NewStyleControls and Ctl3D and (fBorderStyle = bsSingle) then
|
|
begin
|
|
Style := Style and not WS_BORDER;
|
|
ExStyle := ExStyle or WS_EX_CLIENTEDGE;
|
|
end;
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
procedure TSynHotKey.DoExit;
|
|
begin
|
|
inherited;
|
|
if FPressedOnlyModifiers then
|
|
begin
|
|
Text := srNone;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
{$IFDEF SYN_CLX}
|
|
function TSynHotKey.EventFilter(Sender: QObjectH; Event: QEventH): Boolean;
|
|
begin
|
|
Result := inherited EventFilter(Sender, Event);
|
|
case QEvent_type(Event) of
|
|
QEventType_FocusIn:
|
|
begin
|
|
Canvas.Font := Font;
|
|
CreateCaret(Self, 0, 1, Canvas.TextHeight('x') + 2);
|
|
SetCaretPos(BorderWidth + 1 + Canvas.TextWidth(Text), BorderWidth + 1);
|
|
ShowCaret(Self);
|
|
end;
|
|
QEventType_FocusOut:
|
|
begin
|
|
DestroyCaret;
|
|
end;
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
procedure TSynHotKey.KeyDown(var Key: Word; Shift: TShiftState);
|
|
var
|
|
MaybeInvalidKey: THKInvalidKey;
|
|
SavedKey: Word;
|
|
{$IFDEF SYN_LINUX}
|
|
Code: Byte;
|
|
{$ENDIF}
|
|
begin
|
|
{$IFDEF SYN_LINUX}
|
|
// uniform Keycode: key has the same value wether Shift is pressed or not
|
|
if Key <= 255 then
|
|
begin
|
|
Code := XKeysymToKeycode(Xlib.PDisplay(QtDisplay), Key);
|
|
Key := XKeycodeToKeysym(Xlib.PDisplay(QtDisplay), Code, 0);
|
|
if Char(Key) in ['a'..'z'] then Key := Ord(UpCase(Char(Key)));
|
|
end;
|
|
{$ENDIF}
|
|
|
|
SavedKey := Key;
|
|
FPressedOnlyModifiers := KeySameAsShiftState(Key, Shift);
|
|
|
|
MaybeInvalidKey := ShiftStateToTHKInvalidKey(Shift);
|
|
if MaybeInvalidKey in FInvalidKeys then
|
|
Shift := ModifiersToShiftState(FModifiers);
|
|
|
|
if not FPressedOnlyModifiers then
|
|
begin
|
|
{$IFDEF SYN_CLX}
|
|
if Lo(Key) > Ord('Z') then
|
|
Key := Lo(Key);
|
|
{$ENDIF}
|
|
FHotKey := ShortCut(Key, Shift)
|
|
end
|
|
else
|
|
begin
|
|
FHotKey := 0;
|
|
Key := 0;
|
|
end;
|
|
|
|
if Text <> ShortCutToTextEx(Key, Shift) then
|
|
begin
|
|
Text := ShortCutToTextEx(Key, Shift);
|
|
Invalidate;
|
|
SetCaretPos(BorderWidth + 1 + Canvas.TextWidth(Text), BorderWidth + 1);
|
|
end;
|
|
|
|
Key := SavedKey;
|
|
end;
|
|
|
|
procedure TSynHotKey.KeyUp(var Key: Word; Shift: TShiftState);
|
|
{$IFDEF SYN_LINUX}
|
|
var
|
|
Code: Byte;
|
|
{$ENDIF}
|
|
begin
|
|
{$IFDEF SYN_LINUX}
|
|
// uniform Keycode: key has the same value wether Shift is pressed or not
|
|
if Key <= 255 then
|
|
begin
|
|
Code := XKeysymToKeycode(Xlib.PDisplay(QtDisplay), Key);
|
|
Key := XKeycodeToKeysym(Xlib.PDisplay(QtDisplay), Code, 0);
|
|
if Char(Key) in ['a'..'z'] then Key := Ord(UpCase(Char(Key)));
|
|
end;
|
|
{$ENDIF}
|
|
|
|
if FPressedOnlyModifiers then
|
|
begin
|
|
Text := srNone;
|
|
Invalidate;
|
|
SetCaretPos(BorderWidth + 1 + Canvas.TextWidth(Text), BorderWidth + 1);
|
|
end;
|
|
end;
|
|
|
|
procedure TSynHotKey.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
|
|
Y: Integer);
|
|
begin
|
|
inherited;
|
|
SetFocus;
|
|
end;
|
|
|
|
procedure TSynHotKey.Paint;
|
|
var
|
|
r: TRect;
|
|
begin
|
|
r := ClientRect;
|
|
|
|
{$IFDEF SYN_CLX}
|
|
QClxDrawUtil_DrawWinPanel(Canvas.Handle, @r, Palette.ColorGroup(cgActive), True,
|
|
QBrushH(0));
|
|
{$ENDIF}
|
|
|
|
Canvas.Brush.Style := bsSolid;
|
|
Canvas.Brush.Color := Color;
|
|
InflateRect(r, -BorderWidth, -BorderWidth);
|
|
Canvas.FillRect(r);
|
|
Canvas.TextRect(r, BorderWidth + 1, BorderWidth + 1, Text);
|
|
end;
|
|
|
|
procedure TSynHotKey.SetBorderStyle(const Value: TSynBorderStyle);
|
|
begin
|
|
if FBorderStyle <> Value then
|
|
begin
|
|
FBorderStyle := Value;
|
|
{$IFDEF SYN_CLX}
|
|
Resize;
|
|
Invalidate;
|
|
{$ELSE}
|
|
RecreateWnd;
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
|
|
procedure TSynHotKey.SetHotKey(const Value: TShortCut);
|
|
var
|
|
Key: Word;
|
|
Shift: TShiftState;
|
|
MaybeInvalidKey: THKInvalidKey;
|
|
begin
|
|
ShortCutToKey(Value, Key, Shift);
|
|
|
|
MaybeInvalidKey := ShiftStateToTHKInvalidKey(Shift);
|
|
if MaybeInvalidKey in FInvalidKeys then
|
|
Shift := ModifiersToShiftState(FModifiers);
|
|
|
|
FHotKey := ShortCut(Key, Shift);
|
|
Text := ShortCutToTextEx(Key, Shift);
|
|
Invalidate;
|
|
if not Visible then
|
|
SetCaretPos(BorderWidth + 1 + Canvas.TextWidth(Text), BorderWidth + 1);
|
|
end;
|
|
|
|
procedure TSynHotKey.SetInvalidKeys(const Value: THKInvalidKeys);
|
|
begin
|
|
FInvalidKeys := Value;
|
|
SetHotKey(FHotKey);
|
|
end;
|
|
|
|
procedure TSynHotKey.SetModifiers(const Value: THKModifiers);
|
|
begin
|
|
FModifiers := Value;
|
|
SetHotKey(FHotKey);
|
|
end;
|
|
|
|
{$IFDEF SYN_CLX}
|
|
function TSynHotKey.WidgetFlags: Integer;
|
|
begin
|
|
Result := inherited WidgetFlags or Integer(WidgetFlags_WRepaintNoErase);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{$IFNDEF SYN_CLX}
|
|
procedure TSynHotKey.WMGetDlgCode(var Message: TMessage);
|
|
begin
|
|
Message.Result := DLGC_WANTTAB or DLGC_WANTARROWS;
|
|
end;
|
|
|
|
procedure TSynHotKey.WMKillFocus(var Msg: TWMKillFocus);
|
|
begin
|
|
DestroyCaret;
|
|
end;
|
|
|
|
procedure TSynHotKey.WMSetFocus(var Msg: TWMSetFocus);
|
|
begin
|
|
Canvas.Font := Font;
|
|
CreateCaret(Handle, 0, 1, -Canvas.Font.Height + 2);
|
|
SetCaretPos(BorderWidth + 1 + Canvas.TextWidth(Text), BorderWidth + 1);
|
|
ShowCaret(Handle);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{$IFNDEF SYN_CLX}
|
|
{$IFNDEF SYN_COMPILER_4_UP}
|
|
|
|
{ TBetterRegistry }
|
|
|
|
function TBetterRegistry.OpenKeyReadOnly(const Key: string): Boolean;
|
|
|
|
function IsRelative(const Value: string): Boolean;
|
|
begin
|
|
Result := not ((Value <> '') and (Value[1] = '\'));
|
|
end;
|
|
|
|
var
|
|
TempKey: HKey;
|
|
S: string;
|
|
Relative: Boolean;
|
|
begin
|
|
S := Key;
|
|
Relative := IsRelative(S);
|
|
|
|
if not Relative then Delete(S, 1, 1);
|
|
TempKey := 0;
|
|
Result := RegOpenKeyEx(GetBaseKey(Relative), PChar(S), 0,
|
|
KEY_READ, TempKey) = ERROR_SUCCESS;
|
|
if Result then
|
|
begin
|
|
if (CurrentKey <> 0) and Relative then S := CurrentPath + '\' + S;
|
|
ChangeKey(TempKey, S);
|
|
end;
|
|
end; { TBetterRegistry.OpenKeyReadOnly }
|
|
|
|
{$ENDIF SYN_COMPILER_4_UP}
|
|
{$ENDIF SYN_CLX}
|
|
|
|
{ TSynEditMark }
|
|
|
|
function TSynEditMark.GetIsBookmark: boolean;
|
|
begin
|
|
Result := (fBookmarkNum >= 0);
|
|
end;
|
|
|
|
procedure TSynEditMark.SetChar(const Value: Integer);
|
|
begin
|
|
FChar := Value;
|
|
end;
|
|
|
|
procedure TSynEditMark.SetImage(const Value: Integer);
|
|
begin
|
|
FImage := Value;
|
|
if fVisible and Assigned(fOnChange) then
|
|
fOnChange(Self);
|
|
// fEdit.InvalidateGutterLines(fLine, fLine);
|
|
end;
|
|
|
|
procedure TSynEditMark.SetInternalImage(const Value: boolean);
|
|
begin
|
|
fInternalImage := Value;
|
|
if fVisible and Assigned(fOnChange) then
|
|
fOnChange(Self);
|
|
end;
|
|
|
|
procedure TSynEditMark.SetLine(const Value: Integer);
|
|
begin
|
|
if (fLine <> Value) and fVisible and Assigned(fOnChange) then
|
|
begin
|
|
if fLine > 0 then
|
|
fOnChange(Self);
|
|
fLine := Value;
|
|
if fLine > 0 then
|
|
fOnChange(Self);
|
|
end
|
|
else
|
|
fLine := Value;
|
|
end;
|
|
|
|
procedure TSynEditMark.SetVisible(const Value: boolean);
|
|
begin
|
|
if fVisible <> Value then
|
|
begin
|
|
fVisible := Value;
|
|
if Assigned(fOnChange) then
|
|
fOnChange(Self);
|
|
end;
|
|
end;
|
|
|
|
constructor TSynEditMark.Create;
|
|
begin
|
|
inherited Create;
|
|
fBookmarkNum := -1;
|
|
end;
|
|
|
|
{ TSynEditMarkList }
|
|
|
|
function TSynEditMarkList.Add(Item: TSynEditMark): Integer;
|
|
begin
|
|
Result := fItems.Add(Item);
|
|
DoChange;
|
|
end;
|
|
|
|
procedure TSynEditMarkList.ClearLine(Line: integer);
|
|
var
|
|
i: integer;
|
|
v_Changed: Boolean;
|
|
begin
|
|
v_Changed := False;
|
|
for i := fItems.Count -1 downto 0 do
|
|
if not Items[i].IsBookmark and (Items[i].Line = Line) then
|
|
begin
|
|
InternalDelete(i);
|
|
v_Changed := True;
|
|
end;
|
|
if v_Changed then
|
|
DoChange;
|
|
end;
|
|
|
|
constructor TSynEditMarkList.Create;
|
|
begin
|
|
inherited Create;
|
|
fItems := TList.Create;
|
|
end;
|
|
|
|
destructor TSynEditMarkList.Destroy;
|
|
begin
|
|
Clear;
|
|
fItems.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TSynEditMarkList.InternalDelete(Index: Integer);
|
|
begin
|
|
TObject(fItems[Index]).Free;
|
|
fItems.Delete(Index);
|
|
end;
|
|
|
|
procedure TSynEditMarkList.DoChange;
|
|
begin
|
|
if Assigned(FOnChange) then
|
|
FOnChange(Self);
|
|
end;
|
|
|
|
function TSynEditMarkList.GetItem(Index: Integer): TSynEditMark;
|
|
begin
|
|
result := TSynEditMark(fItems[Index]);
|
|
end;
|
|
|
|
procedure TSynEditMarkList.GetMarksForLine(line: integer;
|
|
out marks: TSynEditLineMarks);
|
|
//Returns up to maxMarks book/gutter marks for a chosen line.
|
|
var
|
|
v_MarkCount: integer;
|
|
i: integer;
|
|
begin
|
|
FillChar(marks, SizeOf(marks), 0);
|
|
v_MarkCount := 0;
|
|
for i := 0 to fItems.Count - 1 do
|
|
begin
|
|
if Items[i].Line = line then
|
|
begin
|
|
marks[v_MarkCount] := Items[i];
|
|
Inc(v_MarkCount);
|
|
if v_MarkCount = Length(marks) then
|
|
break;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TSynEditMarkList.GetCount: Integer;
|
|
begin
|
|
Result := fItems.Count;
|
|
end;
|
|
|
|
procedure TSynEditMarkList.Clear;
|
|
begin
|
|
while fItems.Count <> 0 do
|
|
begin
|
|
InternalDelete(0);
|
|
end;
|
|
DoChange;
|
|
end;
|
|
|
|
function TSynEditMarkList.Remove(Item: TSynEditMark): Integer;
|
|
begin
|
|
Result := fItems.IndexOf(Item);
|
|
InternalDelete(Result);
|
|
DoChange;
|
|
end;
|
|
|
|
begin
|
|
InternalResources.Free;
|
|
end.
|