mirror of
https://github.com/HeidiSQL/HeidiSQL.git
synced 2025-08-06 18:24:26 +08:00
1610 lines
43 KiB
ObjectPascal
1610 lines
43 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.
|
||
Unicode translation by Ma<4D>l H<>rz.
|
||
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.35.2.9 2008/09/17 13:59:12 maelh 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
|
||
Consts,
|
||
Windows,
|
||
Messages,
|
||
Graphics,
|
||
Controls,
|
||
Forms,
|
||
StdCtrls,
|
||
Menus,
|
||
Registry,
|
||
SynEditTypes,
|
||
SynEditKeyConst,
|
||
SynUnicode,
|
||
{$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;
|
||
FShowModification: Boolean;
|
||
FDigitCount: Integer;
|
||
FLeadingZeros: Boolean;
|
||
FZeroStart: Boolean;
|
||
FLeftOffset: Integer;
|
||
FRightOffset: Integer;
|
||
FRightMargin: 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;
|
||
FModificationBarWidth: Integer;
|
||
FModificationColorModified: TColor;
|
||
FModificationColorSaved: TColor;
|
||
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 SetRightMargin(Value: integer);
|
||
procedure SetShowLineNumbers(const Value: Boolean);
|
||
procedure SetShowModification(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);
|
||
function GetWidth: Integer;
|
||
procedure SetModificationColorModified(const Value: TColor);
|
||
procedure SetModificationColorSaved(const Value: TColor);
|
||
procedure SetModificationBarWidth(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;
|
||
//++ DPI-Aware
|
||
procedure ChangeScale(M, D: Integer); virtual;
|
||
//-- DPI-Aware
|
||
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 ModificationBarWidth: Integer read FModificationBarWidth
|
||
write SetModificationBarWidth default 4;
|
||
property ModificationColorModified: TColor read FModificationColorModified
|
||
write SetModificationColorModified default clYellow;
|
||
property ModificationColorSaved: TColor read FModificationColorSaved
|
||
write SetModificationColorSaved default clLime;
|
||
property RightOffset: Integer read FRightOffset write SetRightOffset
|
||
default 2;
|
||
property RightMargin: integer read FRightMargin write SetRightMargin
|
||
default 2;
|
||
property ShowLineNumbers: Boolean read FShowLineNumbers
|
||
write SetShowLineNumbers default FALSE;
|
||
property ShowModification: Boolean read FShowModification
|
||
write SetShowModification default FALSE;
|
||
property UseFontStyle: Boolean read FUseFontStyle write SetUseFontStyle
|
||
default True;
|
||
property Visible: Boolean read FVisible write SetVisible default TRUE;
|
||
property Width: Integer read GetWidth 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;
|
||
//++ DPI-Aware
|
||
procedure ChangeScale(M, D: Integer); virtual;
|
||
//-- DPI-Aware
|
||
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;
|
||
//++ DPI-Aware
|
||
procedure ChangeScale(M, D: Integer); virtual;
|
||
//-- DPI-Aware
|
||
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); overload;
|
||
procedure DrawTransparent(ACanvas: TCanvas; Number, X, Y,
|
||
LineHeight: Integer; TransparentColor: TColor); overload;
|
||
//++ DPI-Aware
|
||
procedure ChangeScale(M, D: Integer); virtual;
|
||
//-- DPI-Aware
|
||
end;
|
||
|
||
{ TSynHotKey }
|
||
|
||
const
|
||
BorderWidth = 0;
|
||
|
||
type
|
||
TSynBorderStyle = TBorderStyle;
|
||
|
||
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);
|
||
procedure WMGetDlgCode(var Message: TMessage); message WM_GETDLGCODE;
|
||
procedure WMKillFocus(var Msg: TWMKillFocus); message WM_KILLFOCUS;
|
||
procedure WMSetFocus(var Msg: TWMSetFocus); message WM_SETFOCUS;
|
||
protected
|
||
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;
|
||
procedure CreateParams(var Params: TCreateParams); override;
|
||
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: UnicodeString; virtual; abstract;
|
||
procedure SetPattern(const Value: UnicodeString); virtual; abstract;
|
||
function GetLength(Index: Integer): Integer; virtual; abstract;
|
||
function GetResult(Index: Integer): Integer; virtual; abstract;
|
||
function GetResultCount: Integer; virtual; abstract;
|
||
procedure SetOptions(const Value: TSynSearchOptions); virtual; abstract;
|
||
public
|
||
function FindAll(const NewText: UnicodeString): Integer; virtual; abstract;
|
||
function Replace(const aOccurrence, aReplacement: UnicodeString): UnicodeString; virtual; abstract;
|
||
property Pattern: UnicodeString read GetPattern write SetPattern;
|
||
property ResultCount: Integer read GetResultCount;
|
||
property Results[Index: Integer]: Integer read GetResult;
|
||
property Lengths[Index: Integer]: Integer read GetLength;
|
||
property Options: TSynSearchOptions write SetOptions;
|
||
end;
|
||
|
||
{$IFNDEF SYN_COMPILER_4_UP}
|
||
TBetterRegistry = class(TRegistry)
|
||
function OpenKeyReadOnly(const Key: string): Boolean;
|
||
end;
|
||
{$ELSE}
|
||
TBetterRegistry = TRegistry;
|
||
{$ENDIF}
|
||
|
||
//++ DPI-Aware
|
||
procedure ResizeBitmap(Bitmap: TBitmap; const NewWidth,
|
||
NewHeight: integer);
|
||
//-- DPI-Aware
|
||
|
||
|
||
implementation
|
||
|
||
uses
|
||
SynEditMiscProcs;
|
||
|
||
//++ DPI-Aware
|
||
procedure ResizeBitmap(Bitmap: TBitmap; const NewWidth,
|
||
NewHeight: integer);
|
||
var
|
||
buffer: TBitmap;
|
||
begin
|
||
buffer := TBitmap.Create;
|
||
try
|
||
{$IFDEF SYN_COMPILER_12_UP}
|
||
buffer.SetSize(NewWidth, NewHeight);
|
||
{$ELSE}
|
||
buffer.Width := NewWidth;
|
||
buffer.Height := NewHeight;
|
||
{$ENDIF}
|
||
buffer.Canvas.StretchDraw(Rect(0, 0, NewWidth, NewHeight), Bitmap);
|
||
{$IFDEF SYN_COMPILER_12_UP}
|
||
buffer.SetSize(NewWidth, NewHeight);
|
||
{$ELSE}
|
||
buffer.Width := NewWidth;
|
||
buffer.Height := NewHeight;
|
||
{$ENDIF}
|
||
Bitmap.Canvas.Draw(0, 0, buffer);
|
||
finally
|
||
buffer.Free;
|
||
end;
|
||
end;
|
||
//-- DPI-Aware
|
||
|
||
{ 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 }
|
||
//++ DPI-Aware
|
||
procedure TSynGutter.ChangeScale(M, D: Integer);
|
||
begin
|
||
fWidth := MulDiv(fWidth, M, D);
|
||
fLeftOffset := MulDiv(fLeftOffset, M, D);
|
||
fRightOffset := MulDiv(fRightOffset, M, D);
|
||
fFont.Height := MulDiv(fFont.Height, M, D);
|
||
if Assigned(fOnChange) then fOnChange(Self);
|
||
end;
|
||
//-- DPI-Aware
|
||
|
||
|
||
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;
|
||
FRightMargin := 2;
|
||
FBorderColor := clWindow;
|
||
FBorderStyle := gbsMiddle;
|
||
FLineNumberStart := 1;
|
||
FZeroStart := False;
|
||
FGradient := False;
|
||
FGradientStartColor := clWindow;
|
||
FGradientEndColor := clBtnFace;
|
||
FGradientSteps := 48;
|
||
|
||
FShowModification := FALSE;
|
||
FModificationBarWidth := 4;
|
||
FModificationColorModified := clYellow;
|
||
FModificationColorSaved := clLime;
|
||
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;
|
||
FRightMargin := Src.FRightMargin;
|
||
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);
|
||
Result := Format('%*d', [FAutoSizeDigitCount, Line]);
|
||
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
|
||
begin
|
||
if FShowLineNumbers then
|
||
Result := FLeftOffset + FRightOffset + FAutoSizeDigitCount * CharWidth + FRightMargin
|
||
else if FAutoSize then
|
||
Result := FLeftOffset + FRightOffset + FRightMargin
|
||
else
|
||
Result := FWidth;
|
||
|
||
// take modification indicator into account
|
||
if FShowModification then
|
||
Result := Result + FModificationBarWidth;
|
||
end;
|
||
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.SetRightMargin(Value: integer);
|
||
begin
|
||
Value := Max(0, Value);
|
||
if fRightMargin <> Value then begin
|
||
fRightMargin := 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.SetShowModification(const Value: Boolean);
|
||
begin
|
||
if FShowModification <> Value then begin
|
||
FShowModification := 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.SetModificationBarWidth(const Value: Integer);
|
||
begin
|
||
if FModificationBarWidth <> Value then
|
||
begin
|
||
FModificationBarWidth := Value;
|
||
if Assigned(FOnChange) then FOnChange(Self);
|
||
end;
|
||
end;
|
||
|
||
procedure TSynGutter.SetModificationColorModified(const Value: TColor);
|
||
begin
|
||
if FModificationColorModified <> Value then
|
||
begin
|
||
FModificationColorModified := Value;
|
||
if Assigned(FOnChange) then FOnChange(Self);
|
||
end;
|
||
end;
|
||
|
||
procedure TSynGutter.SetModificationColorSaved(const Value: TColor);
|
||
begin
|
||
if FModificationColorSaved <> Value then
|
||
begin
|
||
FModificationColorSaved := Value;
|
||
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;
|
||
|
||
function TSynGutter.GetWidth: Integer;
|
||
begin
|
||
if not Visible then
|
||
Result := 0
|
||
else
|
||
Result := FWidth;
|
||
end;
|
||
|
||
{ TSynBookMarkOpt }
|
||
|
||
//++ DPI-Aware
|
||
procedure TSynBookMarkOpt.ChangeScale(M, D: Integer);
|
||
Var
|
||
L : Integer;
|
||
begin
|
||
L := (M div D) * D; // Factor multiple of 100%
|
||
fLeftMargin := MulDiv(fLeftMargin, L, D);
|
||
fXoffset := MulDiv(fXoffset, L, D);
|
||
end;
|
||
//-- DPI-Aware
|
||
|
||
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 }
|
||
|
||
//++ DPI-Aware
|
||
procedure TSynGlyph.ChangeScale(M, D: Integer);
|
||
Var
|
||
L : Integer;
|
||
begin
|
||
L := (M div D) * D; // Factor multiple of 100%
|
||
ResizeBitmap(fInternalGlyph, MulDiv(fInternalGlyph.Width, L, D), MulDiv(fInternalGlyph.Height, L, D));
|
||
ResizeBitmap(fGlyph, MulDiv(fGlyph.Width, L, D), MulDiv(fGlyph.Height, L, D));
|
||
end;
|
||
//-- DPI-Aware
|
||
|
||
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;
|
||
|
||
aCanvas.BrushCopy(rcDest, vGlyph, rcSrc, vMaskColor);
|
||
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;
|
||
|
||
//++ DPI-Aware
|
||
procedure TSynInternalImage.ChangeScale(M, D: Integer);
|
||
Var
|
||
L: Integer;
|
||
begin
|
||
L := (M div D) * D; // Factor multiple of 100%
|
||
fWidth := MulDiv(fWidth, L, D);
|
||
ResizeBitmap(fImages, fWidth * fCount, MulDiv(fImages.Height, L, D));
|
||
fHeight := fImages.Height;
|
||
end;
|
||
//-- DPI-Aware
|
||
|
||
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;
|
||
ACanvas.BrushCopy(rcDest, FImages, rcSrc, TransparentColor);
|
||
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): UnicodeString;
|
||
begin
|
||
if ssCtrl in Shift then Result := SmkcCtrl;
|
||
if ssShift in Shift then Result := Result + SmkcShift;
|
||
if ssAlt in Shift then Result := Result + SmkcAlt;
|
||
|
||
Result := Result + ShortCutToText(TShortCut(Key));
|
||
if Result = '' then
|
||
Result := srNone;
|
||
end;
|
||
|
||
constructor TSynHotKey.Create(AOwner: TComponent);
|
||
begin
|
||
inherited;
|
||
|
||
BorderStyle := bsSingle;
|
||
{$IFDEF SYN_COMPILER_7_UP}
|
||
ControlStyle := ControlStyle + [csNeedsBorderPaint];
|
||
{$ENDIF}
|
||
|
||
FInvalidKeys := [hcNone, hcShift];
|
||
FModifiers := [hkAlt];
|
||
SetHotKey($0041); { Alt+A }
|
||
|
||
ParentColor := False;
|
||
Color := clWindow;
|
||
TabStop := True;
|
||
end;
|
||
|
||
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;
|
||
|
||
procedure TSynHotKey.DoExit;
|
||
begin
|
||
inherited;
|
||
if FPressedOnlyModifiers then
|
||
begin
|
||
Text := srNone;
|
||
Invalidate;
|
||
end;
|
||
end;
|
||
|
||
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 AnsiChar(Key) in ['a'..'z'] then Key := Ord(UpCase(AnsiChar(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
|
||
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 + TextWidth(Canvas, 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 AnsiChar(Key) in ['a'..'z'] then Key := Ord(UpCase(AnsiChar(Key)));
|
||
end;
|
||
{$ENDIF}
|
||
|
||
if FPressedOnlyModifiers then
|
||
begin
|
||
Text := srNone;
|
||
Invalidate;
|
||
SetCaretPos(BorderWidth + 1 + TextWidth(Canvas, 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;
|
||
|
||
Canvas.Brush.Style := bsSolid;
|
||
Canvas.Brush.Color := Color;
|
||
InflateRect(r, -BorderWidth, -BorderWidth);
|
||
Canvas.FillRect(r);
|
||
TextRect(Canvas, r, BorderWidth + 1, BorderWidth + 1, Text);
|
||
end;
|
||
|
||
procedure TSynHotKey.SetBorderStyle(const Value: TSynBorderStyle);
|
||
begin
|
||
if FBorderStyle <> Value then
|
||
begin
|
||
FBorderStyle := Value;
|
||
RecreateWnd;
|
||
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 + TextWidth(Canvas, 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;
|
||
|
||
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 + TextWidth(Canvas, Text), BorderWidth + 1);
|
||
ShowCaret(Handle);
|
||
end;
|
||
|
||
|
||
{$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}
|
||
|
||
begin
|
||
InternalResources := nil;
|
||
end.
|