| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096 |
- unit ScintEdit;
- {
- Inno Setup
- Copyright (C) 1997-2024 Jordan Russell
- Portions by Martijn Laan
- For conditions of distribution and use, see LICENSE.TXT.
- TScintEdit component: a VCL wrapper for Scintilla
- }
- interface
- uses
- Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Generics.Collections, ScintInt;
- const
- StyleNumbers = 32; { The syntax highlighting can use up to 32 styles }
- StyleNumberBits = 5; { 5 bits are needed to store 32 values }
- StyleNumberMask = StyleNumbers-1; { To get the 5 bits from a byte it needs to be AND-ed with $1F = 31 }
- StyleNumberUnusedBits = 8-StyleNumberBits; { 3 bits of a byte are unused }
- type
- TScintChangeHistory = (schDisabled, schMarkers, schIndicators);
- TScintCommand = type NativeInt;
- TScintEditAutoCompleteSelectionEvent = TNotifyEvent;
- TScintEditCallTipArrowClick = procedure(Sender: TObject; const Up: Boolean) of object;
- TScintEditChangeInfo = record
- Inserting: Boolean;
- StartPos, Length, LinesDelta: Integer;
- end;
- TScintEditChangeEvent = procedure(Sender: TObject;
- const Info: TScintEditChangeInfo) of object;
- TScintEditCharAddedEvent = procedure(Sender: TObject; Ch: AnsiChar) of object;
- TScintEditDropFilesEvent = procedure(Sender: TObject; X, Y: Integer;
- AFiles: TStrings) of object;
- TScintHintInfo = Controls.THintInfo;
- TScintEditHintShowEvent = procedure(Sender: TObject;
- var Info: TScintHintInfo) of object;
- TScintEditMarginClickEvent = procedure(Sender: TObject; MarginNumber: Integer;
- Line: Integer) of object;
- TScintEditUpdate = (suContent, suSelection, suVScroll, suHScroll);
- TScintEditUpdates = set of TScintEditUpdate;
- TScintEditUpdateUIEvent = procedure(Sender: TObject; Updated: TScintEditUpdates) of object;
- TScintFindOption = (sfoMatchCase, sfoWholeWord, sfoRegEx);
- TScintFindOptions = set of TScintFindOption;
- TScintFoldFlag = (sffLineBeforeExpanded, sffLineBeforeContracted,
- sffLineAfterExpanded, sffLineAfterContracted, sffLevelNumbers, sffLineState);
- TScintFoldFlags = set of TScintFoldFlag;
- TScintIndentationGuides = (sigNone, sigReal, sigLookForward, sigLookBoth);
- TScintKeyCode = type Word;
- TScintKeyDefinition = type Cardinal;
- TScintReplaceMode = (srmNormal, srmMinimal, srmRegEx);
- TScintStyleByteIndicatorNumber = 0..1; { Could be increased to 0..StyleNumberUnusedBits-1 }
- TScintStyleByteIndicatorNumbers = set of TScintStyleByteIndicatorNumber;
- TScintIndicatorNumber = INDICATOR_CONTAINER..INDICATOR_MAX;
- TScintLineEndings = (sleCRLF, sleCR, sleLF);
- TScintLineState = type Integer;
- TScintMarkerNumber = 0..31;
- TScintMarkerNumbers = set of TScintMarkerNumber;
- TScintRange = record
- StartPos, EndPos: Integer;
- constructor Create(const AStartPos, AEndPos: Integer);
- function Empty: Boolean;
- function Overlaps(const ARange: TScintRange): Boolean;
- function Within(const ARange: TScintRange): Boolean;
- end;
- TScintRangeList = class(TList<TScintRange>)
- function Overlaps(const ARange: TScintRange;
- var AOverlappingRange: TScintRange): Boolean;
- end;
- TScintCaretAndAnchor = record
- CaretPos, AnchorPos: Integer;
- constructor Create(const ACaretPos, AAnchorPos: Integer);
- function Range: TScintRange;
- end;
- TScintCaretAndAnchorList = class(TList<TScintCaretAndAnchor>);
- TScintRawCharSet = set of AnsiChar;
- TScintRawString = type RawByteString;
- TScintRectangle = record
- Left, Top, Right, Bottom: Integer;
- end;
- TScintSelectionMode = (ssmStream, ssmRectangular, ssmLines, ssmThinRectangular);
- TScintStyleNumber = 0..StyleNumbers-1;
- TScintVirtualSpaceOption = (svsRectangularSelection, svsUserAccessible,
- svsNoWrapLineStart);
- TScintVirtualSpaceOptions = set of TScintVirtualSpaceOption;
- PScintRangeToFormat = ^TScintRangeToFormat;
- TScintRangeToFormat = record
- hdc, hdcTarget: UINT_PTR;
- rc, rcPage: TScintRectangle;
- chrg: TScintRange;
- end;
- TScintEditStrings = class;
- TScintCustomStyler = class;
- EScintEditError = class(Exception);
- TScintEdit = class(TWinControl)
- private
- FAcceptDroppedFiles: Boolean;
- FAutoCompleteFontName: String;
- FAutoCompleteFontSize: Integer;
- FAutoCompleteStyle: Integer;
- FChangeHistory: TScintChangeHistory;
- FCodePage: Integer;
- FDirectPtr: Pointer;
- FDirectStatusFunction: SciFnDirectStatus;
- FEffectiveCodePage: Integer;
- FEffectiveCodePageDBCS: Boolean;
- FFillSelectionToEdge: Boolean;
- FFoldLevelNumbersOrLineState: Boolean;
- FForceModified: Boolean;
- FIndentationGuides: TScintIndentationGuides;
- FLeadBytes: TScintRawCharSet;
- FLineNumbers: Boolean;
- FLines: TScintEditStrings;
- FOnAutoCompleteSelection: TScintEditAutoCompleteSelectionEvent;
- FOnCallTipArrowClick: TScintEditCallTipArrowClick;
- FOnChange: TScintEditChangeEvent;
- FOnCharAdded: TScintEditCharAddedEvent;
- FOnDropFiles: TScintEditDropFilesEvent;
- FOnHintShow: TScintEditHintShowEvent;
- FOnMarginClick: TScintEditMarginClickEvent;
- FOnMarginRightClick: TScintEditMarginClickEvent;
- FOnModifiedChange: TNotifyEvent;
- FOnUpdateUI: TScintEditUpdateUIEvent;
- FOnZoom: TNotifyEvent;
- FReportCaretPositionToStyler: Boolean;
- FStyler: TScintCustomStyler;
- FTabWidth: Integer;
- FUseStyleAttributes: Boolean;
- FUseTabCharacter: Boolean;
- FVirtualSpaceOptions: TScintVirtualSpaceOptions;
- FWordChars: AnsiString;
- FWordCharsAsSet: TSysCharSet;
- FWordWrap: Boolean;
- procedure ApplyOptions;
- procedure ForwardMessage(const Message: TMessage);
- function GetAnchorPosition: Integer;
- function GetAutoCompleteActive: Boolean;
- function GetCallTipActive: Boolean;
- function GetCaretColumn: Integer;
- function GetCaretColumnExpandedForTabs: Integer;
- function GetCaretLine: Integer;
- function GetCaretLineText: String;
- function GetCaretPosition: Integer;
- function GetCaretPositionInLine: Integer;
- function GetCaretVirtualSpace: Integer;
- function GetInsertMode: Boolean;
- function GetLineEndings: TScintLineEndings;
- function GetLineEndingString: TScintRawString;
- function GetLineHeight: Integer;
- function GetLinesInWindow: Integer;
- function GetMainSelText: String;
- function GetModified: Boolean;
- function GetRawCaretLineText: TScintRawString;
- function GetRawMainSelText: TScintRawString;
- function GetRawSelText: TScintRawString;
- function GetRawText: TScintRawString;
- function GetReadOnly: Boolean;
- class function GetReplaceTargetMessage(const ReplaceMode: TScintReplaceMode): Cardinal;
- class function GetSearchFlags(const Options: TScintFindOptions): Integer;
- function GetSelection: TScintRange;
- function GetSelectionAnchorPosition(Selection: Integer): Integer;
- function GetSelectionAnchorVirtualSpace(Selection: Integer): Integer;
- function GetSelectionCaretPosition(Selection: Integer): Integer;
- function GetSelectionCaretVirtualSpace(Selection: Integer): Integer;
- function GetSelectionEndPosition(Selection: Integer): Integer;
- function GetSelectionCount: Integer;
- function GetSelectionMode: TScintSelectionMode;
- function GetSelectionStartPosition(Selection: Integer): Integer;
- function GetSelText: String;
- function GetTopLine: Integer;
- function GetZoom: Integer;
- procedure SetAcceptDroppedFiles(const Value: Boolean);
- procedure SetAutoCompleteFontName(const Value: String);
- procedure SetAutoCompleteFontSize(const Value: Integer);
- procedure SetCodePage(const Value: Integer);
- procedure SetCaretColumn(const Value: Integer);
- procedure SetCaretLine(const Value: Integer);
- procedure SetCaretPosition(const Value: Integer);
- procedure SetCaretPositionWithSelectFromAnchor(const Value: Integer);
- procedure SetCaretVirtualSpace(const Value: Integer);
- procedure SetChangeHistory(const Value: TScintChangeHistory);
- procedure SetFillSelectionToEdge(const Value: Boolean);
- procedure SetFoldFlags(const Value: TScintFoldFlags);
- procedure SetIndentationGuides(const Value: TScintIndentationGuides);
- procedure SetLineNumbers(const Value: Boolean);
- procedure SetMainSelection(const Value: Integer);
- procedure SetMainSelText(const Value: String);
- procedure SetRawMainSelText(const Value: TScintRawString);
- procedure SetRawSelText(const Value: TScintRawString);
- procedure SetRawText(const Value: TScintRawString);
- procedure SetReadOnly(const Value: Boolean);
- procedure SetSelection(const Value: TScintRange);
- procedure SetSelectionAnchorPosition(Selection: Integer; const Value: Integer);
- procedure SetSelectionAnchorVirtualSpace(Selection: Integer;
- const Value: Integer);
- procedure SetSelectionCaretPosition(Selection: Integer; const Value: Integer);
- procedure SetSelectionCaretVirtualSpace(Selection: Integer;
- const Value: Integer);
- procedure SetSelectionMode(const Value: TScintSelectionMode);
- procedure SetSelText(const Value: String);
- procedure SetStyler(const Value: TScintCustomStyler);
- procedure SetTabWidth(const Value: Integer);
- procedure SetTopLine(const Value: Integer);
- procedure SetUseStyleAttributes(const Value: Boolean);
- procedure SetUseTabCharacter(const Value: Boolean);
- procedure SetVirtualSpaceOptions(const Value: TScintVirtualSpaceOptions);
- procedure SetWordWrap(const Value: Boolean);
- procedure SetZoom(const Value: Integer);
- procedure UpdateCodePage;
- procedure UpdateLineNumbersWidth;
- procedure CMColorChanged(var Message: TMessage); message CM_COLORCHANGED;
- procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
- procedure CMHintShow(var Message: TCMHintShow); message CM_HINTSHOW;
- procedure CMSysColorChange(var Message: TMessage); message CM_SYSCOLORCHANGE;
- procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
- procedure WMDestroy(var Message: TWMDestroy); message WM_DESTROY;
- procedure WMDropFiles(var Message: TWMDropFiles); message WM_DROPFILES;
- procedure WMEraseBkgnd(var Message: TMessage); message WM_ERASEBKGND;
- procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
- procedure WMMouseWheel(var Message: TMessage); message WM_MOUSEWHEEL;
- protected
- procedure Change(const AInserting: Boolean; const AStartPos, ALength,
- ALinesDelta: Integer); virtual;
- procedure CheckPosRange(const StartPos, EndPos: Integer);
- procedure CreateParams(var Params: TCreateParams); override;
- procedure CreateWnd; override;
- class function GetErrorException(const S: String): EScintEditError;
- class procedure Error(const S: String); overload;
- class procedure ErrorFmt(const S: String; const Args: array of const);
- function GetMainSelection: Integer;
- function GetTarget: TScintRange;
- procedure InitRawString(var S: TScintRawString; const Len: Integer);
- procedure Notification(AComponent: TComponent; Operation: TOperation); override;
- procedure Notify(const N: TSCNotification); virtual;
- procedure SetTarget(const StartPos, EndPos: Integer);
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- procedure AddMarker(const Line: Integer; const Marker: TScintMarkerNumber);
- procedure AddSelection(const CaretPos, AnchorPos: Integer);
- procedure AssignCmdKey(const Key: AnsiChar; const Shift: TShiftState;
- const Command: TScintCommand); overload;
- procedure AssignCmdKey(const KeyCode: TScintKeyCode; const Shift: TShiftState;
- const Command: TScintCommand); overload;
- procedure BeginUndoAction;
- procedure BraceMatch;
- function Call(Msg: Cardinal; WParam: Longint; LParam: Longint): Longint; overload;
- function Call(Msg: Cardinal; WParam: Longint; LParam: Longint; out WarnStatus: Integer): Longint; overload;
- function Call(Msg: Cardinal; WParam: Longint; const LParamStr: TScintRawString): Longint; overload;
- function Call(Msg: Cardinal; WParam: Longint; const LParamStr: TScintRawString; out WarnStatus: Integer): Longint; overload;
- procedure CancelAutoComplete;
- procedure CancelAutoCompleteAndCallTip;
- procedure CancelCallTip;
- function CanPaste: Boolean;
- function CanRedo: Boolean;
- function CanUndo: Boolean;
- procedure ChooseCaretX;
- procedure ClearAll;
- procedure ClearCmdKey(const Key: AnsiChar; const Shift: TShiftState); overload;
- procedure ClearCmdKey(const KeyCode: TScintKeyCode; const Shift: TShiftState); overload;
- procedure ClearIndicators(const IndicatorNumber: TScintIndicatorNumber);
- procedure ClearSelection;
- procedure ClearUndo(const ClearChangeHistory: Boolean = True);
- function ConvertRawStringToString(const S: TScintRawString): String;
- function ConvertPCharToRawString(const Text: PChar;
- const TextLen: Integer): TScintRawString;
- function ConvertStringToRawString(const S: String): TScintRawString;
- procedure CopyToClipboard;
- procedure CutToClipboard;
- procedure DeleteAllMarkersOnLine(const Line: Integer);
- procedure DeleteMarker(const Line: Integer; const Marker: TScintMarkerNumber);
- procedure DPIChanged(const Message: TMessage);
- procedure EndUndoAction;
- procedure EnsureLineVisible(const Line: Integer);
- function FindRawText(const StartPos, EndPos: Integer; const S: TScintRawString;
- const Options: TScintFindOptions; out MatchRange: TScintRange): Boolean;
- function FindText(const StartPos, EndPos: Integer; const S: String;
- const Options: TScintFindOptions; out MatchRange: TScintRange): Boolean;
- procedure FoldLine(const Line: Integer; const Fold: Boolean);
- function FormatRange(const Draw: Boolean;
- const RangeToFormat: PScintRangeToFormat): Integer;
- procedure ForceModifiedState;
- function GetByteAtPosition(const Pos: Integer): AnsiChar;
- function GetCharacterCount(const StartPos, EndPos: Integer): Integer;
- function GetColumnFromPosition(const Pos: Integer): Integer;
- function GetDefaultWordChars: AnsiString;
- function GetDocLineFromVisibleLine(const VisibleLine: Integer): Integer;
- function GetIndicatorAtPosition(const IndicatorNumber: TScintIndicatorNumber;
- const Pos: Integer): Boolean;
- function GetLineEndPosition(const Line: Integer): Integer;
- function GetLineFromPosition(const Pos: Integer): Integer;
- function GetLineIndentation(const Line: Integer): Integer;
- function GetLineIndentPosition(const Line: Integer): Integer;
- function GetMarkers(const Line: Integer): TScintMarkerNumbers;
- function GetPointFromPosition(const Pos: Integer): TPoint;
- function GetPositionAfter(const Pos: Integer): Integer;
- function GetPositionBefore(const Pos: Integer): Integer;
- function GetPositionFromLine(const Line: Integer): Integer;
- function GetPositionFromLineColumn(const Line, Column: Integer): Integer;
- function GetPositionFromLineExpandedColumn(const Line, ExpandedColumn: Integer): Integer;
- function GetPositionFromPoint(const P: TPoint;
- const CharPosition, CloseOnly: Boolean): Integer;
- function GetPositionOfMatchingBrace(const Pos: Integer): Integer;
- function GetPositionRelative(const Pos, CharacterCount: Integer): Integer;
- function GetRawTextLength: Integer;
- function GetRawTextRange(const StartPos, EndPos: Integer): TScintRawString;
- procedure GetSelections(const RangeList: TScintRangeList); overload;
- procedure GetSelections(const CaretAndAnchorList: TScintCaretAndAnchorList); overload;
- procedure GetSelections(const CaretAndAnchorList, VirtualSpacesList: TScintCaretAndAnchorList); overload;
- function GetStyleAtPosition(const Pos: Integer): TScintStyleNumber;
- function GetTextRange(const StartPos, EndPos: Integer): String;
- function GetVisibleLineFromDocLine(const DocLine: Integer): Integer;
- function GetWordEndPosition(const Pos: Integer; const OnlyWordChars: Boolean): Integer;
- function GetWordStartPosition(const Pos: Integer; const OnlyWordChars: Boolean): Integer;
- function IsPositionInViewVertically(const Pos: Integer): Boolean;
- class function KeyCodeAndShiftToKeyDefinition(const KeyCode: TScintKeyCode;
- Shift: TShiftState): TScintKeyDefinition;
- function MainSelTextEquals(const S: String;
- const Options: TScintFindOptions): Boolean;
- class function KeyToKeyCode(const Key: AnsiChar): TScintKeyCode;
- procedure PasteFromClipboard;
- function RawMainSelTextEquals(const S: TScintRawString;
- const Options: TScintFindOptions): Boolean;
- class function RawStringIsBlank(const S: TScintRawString): Boolean;
- procedure Redo;
- procedure RemoveAdditionalSelections;
- function ReplaceMainSelText(const S: String;
- const ReplaceMode: TScintReplaceMode = srmNormal): TScintRange;
- function ReplaceRawMainSelText(const S: TScintRawString;
- const ReplaceMode: TScintReplaceMode = srmNormal): TScintRange;
- function ReplaceRawTextRange(const StartPos, EndPos: Integer;
- const S: TScintRawString; const ReplaceMode: TScintReplaceMode = srmNormal): TScintRange;
- function ReplaceTextRange(const StartPos, EndPos: Integer; const S: String;
- const ReplaceMode: TScintReplaceMode = srmNormal): TScintRange;
- procedure RestyleLine(const Line: Integer);
- procedure ScrollCaretIntoView;
- procedure SelectAll;
- procedure SelectAllOccurrences(const Options: TScintFindOptions);
- procedure SelectAndEnsureVisible(const Range: TScintRange);
- procedure SelectNextOccurrence(const Options: TScintFindOptions);
- function SelEmpty: Boolean;
- function SelNotEmpty(out Sel: TScintRange): Boolean;
- procedure SetAutoCompleteFillupChars(const FillupChars: AnsiString);
- procedure SetAutoCompleteSeparators(const Separator, TypeSeparator: AnsiChar);
- procedure SetAutoCompleteSelectedItem(const S: TScintRawString);
- procedure SetAutoCompleteStopChars(const StopChars: AnsiString);
- procedure SetBraceBadHighlighting(const Pos: Integer);
- procedure SetBraceHighlighting(const Pos1, Pos2: Integer);
- procedure SetCursorID(const CursorID: Integer);
- procedure SetCallTipHighlight(HighlightStart, HighlightEnd: Integer);
- procedure SetDefaultWordChars;
- procedure SetEmptySelection;
- procedure SetEmptySelections;
- procedure SetIndicators(const StartPos, EndPos: Integer;
- const IndicatorNumber: TScintIndicatorNumber; const Value: Boolean);
- procedure SetLineIndentation(const Line, Indentation: Integer);
- procedure SetSavePoint;
- procedure SetSingleSelection(const CaretPos, AnchorPos: Integer);
- procedure SettingChange(const Message: TMessage);
- procedure SetWordChars(const S: AnsiString);
- procedure ShowAutoComplete(const CharsEntered: Integer; const WordList: AnsiString);
- procedure ShowCallTip(const Pos: Integer; const Definition: AnsiString);
- procedure StyleNeeded(const EndPos: Integer);
- procedure SysColorChange(const Message: TMessage);
- function TestRegularExpression(const S: String): Boolean;
- function TestRawRegularExpression(const S: TScintRawString): Boolean;
- procedure Undo;
- procedure UpdateStyleAttributes;
- function WordAtCaret: String;
- function WordAtCaretRange: TScintRange;
- procedure ZoomIn;
- procedure ZoomOut;
- property AnchorPosition: Integer read GetAnchorPosition;
- property AutoCompleteActive: Boolean read GetAutoCompleteActive;
- property CallTipActive: Boolean read GetCallTipActive;
- property CaretColumn: Integer read GetCaretColumn write SetCaretColumn;
- property CaretColumnExpandedForTabs: Integer read GetCaretColumnExpandedForTabs;
- property CaretLine: Integer read GetCaretLine write SetCaretLine;
- property CaretLineText: String read GetCaretLineText;
- property CaretPosition: Integer read GetCaretPosition write SetCaretPosition;
- property CaretPositionInLine: Integer read GetCaretPositionInLine;
- property CaretPositionWithSelectFromAnchor: Integer write SetCaretPositionWithSelectFromAnchor;
- property CaretVirtualSpace: Integer read GetCaretVirtualSpace write SetCaretVirtualSpace;
- property EffectiveCodePage: Integer read FEffectiveCodePage;
- property FoldFlags: TScintFoldFlags write SetFoldFlags;
- property InsertMode: Boolean read GetInsertMode;
- property LineEndings: TScintLineEndings read GetLineEndings;
- property LineEndingString: TScintRawString read GetLineEndingString;
- property LineHeight: Integer read GetLineHeight;
- property Lines: TScintEditStrings read FLines;
- property LinesInWindow: Integer read GetLinesInWindow;
- property MainSelection: Integer read GetMainSelection write SetMainSelection;
- property MainSelText: String read GetMainSelText write SetMainSelText;
- property Modified: Boolean read GetModified;
- property RawCaretLineText: TScintRawString read GetRawCaretLineText;
- property RawMainSelText: TScintRawString read GetRawMainSelText write SetRawMainSelText;
- property RawSelText: TScintRawString read GetRawSelText write SetRawSelText;
- property RawText: TScintRawString read GetRawText write SetRawText;
- property RawTextLength: Integer read GetRawTextLength;
- property ReadOnly: Boolean read GetReadOnly write SetReadOnly;
- property Selection: TScintRange read GetSelection write SetSelection;
- property SelectionAnchorPosition[Selection: Integer]: Integer read GetSelectionAnchorPosition write SetSelectionAnchorPosition;
- property SelectionAnchorVirtualSpace[Selection: Integer]: Integer read GetSelectionAnchorVirtualSpace write SetSelectionAnchorVirtualSpace;
- property SelectionCaretPosition[Selection: Integer]: Integer read GetSelectionCaretPosition write SetSelectionCaretPosition;
- property SelectionCaretVirtualSpace[Selection: Integer]: Integer read GetSelectionCaretVirtualSpace write SetSelectionCaretVirtualSpace;
- property SelectionCount: Integer read GetSelectionCount;
- property SelectionEndPosition[Selection: Integer]: Integer read GetSelectionEndPosition;
- property SelectionMode: TScintSelectionMode read GetSelectionMode write SetSelectionMode;
- property SelectionStartPosition[Selection: Integer]: Integer read GetSelectionStartPosition;
- property SelText: String read GetSelText write SetSelText;
- property Styler: TScintCustomStyler read FStyler write SetStyler;
- property Target: TScintRange read GetTarget;
- property TopLine: Integer read GetTopLine write SetTopLine;
- property WordChars: AnsiString read FWordChars;
- property WordCharsAsSet: TSysCharSet read FWordCharsAsSet;
- published
- property AcceptDroppedFiles: Boolean read FAcceptDroppedFiles write SetAcceptDroppedFiles
- default False;
- property AutoCompleteFontName: String read FAutoCompleteFontName
- write SetAutoCompleteFontName;
- property AutoCompleteFontSize: Integer read FAutoCompleteFontSize
- write SetAutoCompleteFontSize default 0;
- property ChangeHistory: TScintChangeHistory read FChangeHistory write SetChangeHistory default schDisabled;
- property CodePage: Integer read FCodePage write SetCodePage default CP_UTF8;
- property Color;
- property FillSelectionToEdge: Boolean read FFillSelectionToEdge write SetFillSelectionToEdge
- default False;
- property Font;
- property IndentationGuides: TScintIndentationGuides read FIndentationGuides
- write SetIndentationGuides default sigNone;
- property LineNumbers: Boolean read FLineNumbers write SetLineNumbers default False;
- property ParentFont;
- property PopupMenu;
- property ReportCaretPositionToStyler: Boolean read FReportCaretPositionToStyler
- write FReportCaretPositionToStyler;
- property TabStop default True;
- property TabWidth: Integer read FTabWidth write SetTabWidth default 8;
- property UseStyleAttributes: Boolean read FUseStyleAttributes write SetUseStyleAttributes
- default True;
- property UseTabCharacter: Boolean read FUseTabCharacter write SetUseTabCharacter
- default True;
- property VirtualSpaceOptions: TScintVirtualSpaceOptions read FVirtualSpaceOptions
- write SetVirtualSpaceOptions default [];
- property WordWrap: Boolean read FWordWrap write SetWordWrap default False;
- property Zoom: Integer read GetZoom write SetZoom default 0;
- property OnAutoCompleteSelection: TScintEditAutoCompleteSelectionEvent read FOnAutoCompleteSelection write FOnAutoCompleteSelection;
- property OnCallTipArrowClick: TScintEditCallTipArrowClick read FOnCallTipArrowClick write FOnCallTipArrowClick;
- property OnChange: TScintEditChangeEvent read FOnChange write FOnChange;
- property OnCharAdded: TScintEditCharAddedEvent read FOnCharAdded write FOnCharAdded;
- property OnDropFiles: TScintEditDropFilesEvent read FOnDropFiles write FOnDropFiles;
- property OnHintShow: TScintEditHintShowEvent read FOnHintShow write FOnHintShow;
- property OnKeyDown;
- property OnKeyPress;
- property OnKeyUp;
- property OnMarginClick: TScintEditMarginClickEvent read FOnMarginClick write FOnMarginClick;
- property OnMarginRightClick: TScintEditMarginClickEvent read FOnMarginRightClick write FOnMarginRightClick;
- property OnModifiedChange: TNotifyEvent read FOnModifiedChange write FOnModifiedChange;
- property OnMouseDown;
- property OnMouseMove;
- property OnMouseUp;
- property OnUpdateUI: TScintEditUpdateUIEvent read FOnUpdateUI write FOnUpdateUI;
- property OnZoom: TNotifyEvent read FOnZoom write FOnZoom;
- end;
- TScintEditStrings = class(TStrings)
- private
- FEdit: TScintEdit;
- function GetLineEndingLength(const Index: Integer): Integer;
- function GetRawLine(Index: Integer): TScintRawString;
- function GetRawLineWithEnding(Index: Integer): TScintRawString;
- function GetRawLineLength(Index: Integer): Integer;
- function GetRawLineLengthWithEnding(Index: Integer): Integer;
- function GetState(Index: Integer): TScintLineState;
- procedure PutRawLine(Index: Integer; const S: TScintRawString);
- protected
- procedure CheckIndexRange(const Index: Integer);
- procedure CheckIndexRangePlusOne(const Index: Integer);
- function Get(Index: Integer): String; override;
- function GetCount: Integer; override;
- function GetTextStr: String; override;
- procedure Put(Index: Integer; const S: String); override;
- procedure SetTextStr(const Value: String); override;
- public
- procedure Clear; override;
- procedure Delete(Index: Integer); override;
- procedure Insert(Index: Integer; const S: String); override;
- procedure InsertRawLine(Index: Integer; const S: TScintRawString);
- procedure SetText(Text: PChar); override;
- property RawLineLengths[Index: Integer]: Integer read GetRawLineLength;
- property RawLineLengthsWithEnding[Index: Integer]: Integer read GetRawLineLengthWithEnding;
- property RawLines[Index: Integer]: TScintRawString read GetRawLine write PutRawLine;
- property RawLinesWithEnding[Index: Integer]: TScintRawString read GetRawLineWithEnding;
- property State[Index: Integer]: TScintLineState read GetState;
- end;
- TScintStyleAttributes = record
- FontName: String;
- FontSize: Integer;
- FontStyle: TFontStyles;
- FontCharset: TFontCharset;
- ForeColor: TColor;
- BackColor: TColor;
- end;
- TScintCustomStyler = class(TComponent)
- private
- FCaretIndex: Integer;
- FCurIndex: Integer;
- FLineState: TScintLineState;
- FStyleStartIndex: Integer;
- FStyleStr: AnsiString;
- FText: TScintRawString;
- FTextLen: Integer;
- function GetCurChar: AnsiChar;
- function GetEndOfLine: Boolean;
- protected
- procedure ApplyStyleByteIndicators(const Indicators: TScintStyleByteIndicatorNumbers;
- StartIndex, EndIndex: Integer);
- procedure ApplyStyle(const Style: TScintStyleNumber;
- StartIndex, EndIndex: Integer);
- procedure CommitStyle(const Style: TScintStyleNumber);
- function ConsumeAllRemaining: Boolean;
- function ConsumeChar(const C: AnsiChar): Boolean;
- function ConsumeCharIn(const Chars: TScintRawCharSet): Boolean;
- function ConsumeChars(const Chars: TScintRawCharSet): Boolean;
- function ConsumeCharsNot(const Chars: TScintRawCharSet): Boolean;
- function ConsumeString(const Chars: TScintRawCharSet): TScintRawString;
- function CurCharIn(const Chars: TScintRawCharSet): Boolean;
- function CurCharIs(const C: AnsiChar): Boolean;
- procedure GetFoldLevel(const LineState, PreviousLineState: TScintLineState;
- var Level: Integer; var Header, EnableHeaderOnPrevious: Boolean); virtual; abstract;
- procedure GetStyleAttributes(const Style: Integer;
- var Attributes: TScintStyleAttributes); virtual; abstract;
- function LineTextSpans(const S: TScintRawString): Boolean; virtual;
- function NextCharIs(const C: AnsiChar): Boolean;
- function PreviousCharIn(const Chars: TScintRawCharSet): Boolean;
- procedure ResetCurIndexTo(Index: Integer);
- procedure ReplaceText(StartIndex, EndIndex: Integer; const C: AnsiChar);
- procedure StyleNeeded; virtual; abstract;
- property CaretIndex: Integer read FCaretIndex;
- property CurChar: AnsiChar read GetCurChar;
- property CurIndex: Integer read FCurIndex;
- property EndOfLine: Boolean read GetEndOfLine;
- property LineState: TScintLineState read FLineState write FLineState;
- property StyleStartIndex: Integer read FStyleStartIndex;
- property Text: TScintRawString read FText;
- property TextLength: Integer read FTextLen;
- end;
- TScintPixmap = class
- private
- type
- TPixmap = array of AnsiString;
- class var
- ColorCodes: String;
- var
- FPixmap: TPixmap;
- class constructor Create;
- function GetPixmap: Pointer;
- public
- procedure InitializeFromBitmap(const ABitmap: TBitmap; const TransparentColor: TColorRef);
- property Pixmap: Pointer read GetPixmap;
- end;
- implementation
- uses
- ShellAPI, RTLConsts, UITypes, GraphUtil;
- { TScintEdit }
- const
- AUTOCSETSEPARATOR = #9;
- constructor TScintEdit.Create(AOwner: TComponent);
- begin
- inherited;
- FCodePage := CP_UTF8;
- FLines := TScintEditStrings.Create;
- FLines.FEdit := Self;
- FTabWidth := 8;
- FUseStyleAttributes := True;
- FUseTabCharacter := True;
- SetBounds(0, 0, 257, 193);
- ParentColor := False;
- TabStop := True;
- end;
- destructor TScintEdit.Destroy;
- begin
- SetStyler(nil);
- FLines.Free;
- FLines := nil;
- inherited;
- end;
- procedure TScintEdit.AddMarker(const Line: Integer;
- const Marker: TScintMarkerNumber);
- begin
- FLines.CheckIndexRange(Line);
- Call(SCI_MARKERADD, Line, Marker);
- end;
- procedure TScintEdit.AddSelection(const CaretPos, AnchorPos: Integer);
- { Adds a new selection as the main selection retaining all other selections as
- additional selections without scrolling the caret into view. The first
- selection should be added with SetSingleSelection. }
- begin
- Call(SCI_ADDSELECTION, CaretPos, AnchorPos);
- end;
- procedure TScintEdit.ApplyOptions;
- const
- IndentationGuides: array [TScintIndentationGuides] of Integer = (SC_IV_NONE, SC_IV_REAL,
- SC_IV_LOOKFORWARD, SC_IV_LOOKBOTH);
- var
- Flags: Integer;
- begin
- if not HandleAllocated then
- Exit;
- Call(SCI_SETSELEOLFILLED, Ord(FFillSelectionToEdge), 0);
- Call(SCI_SETTABWIDTH, FTabWidth, 0);
- Call(SCI_SETUSETABS, Ord(FUseTabCharacter), 0);
- Flags := 0;
- if svsRectangularSelection in VirtualSpaceOptions then
- Flags := Flags or SCVS_RECTANGULARSELECTION;
- if svsUserAccessible in VirtualSpaceOptions then
- Flags := Flags or SCVS_USERACCESSIBLE;
- if svsNoWrapLineStart in VirtualSpaceOptions then
- Flags := Flags or SCVS_NOWRAPLINESTART;
- Call(SCI_SETVIRTUALSPACEOPTIONS, Flags, 0);
- Call(SCI_SETWRAPMODE, Ord(FWordWrap), 0);
- Call(SCI_SETINDENTATIONGUIDES, IndentationGuides[FIndentationGuides], 0);
- { If FChangeHistory is not schDisabled then next call to ClearUndo will enable
- change history and else we should disable it now }
- if FChangeHistory = schDisabled then
- Call(SCI_SETCHANGEHISTORY, SC_CHANGE_HISTORY_DISABLED, 0);
- end;
- procedure TScintEdit.AssignCmdKey(const Key: AnsiChar; const Shift: TShiftState;
- const Command: TScintCommand);
- begin
- AssignCmdKey(KeyToKeyCode(Key), Shift, Command);
- end;
- procedure TScintEdit.AssignCmdKey(const KeyCode: TScintKeyCode;
- const Shift: TShiftState; const Command: TScintCommand);
- begin
- Call(SCI_ASSIGNCMDKEY, KeyCodeAndShiftToKeyDefinition(KeyCode, Shift), Command);
- end;
- procedure TScintEdit.BeginUndoAction;
- begin
- Call(SCI_BEGINUNDOACTION, 0, 0);
- end;
- procedure TScintEdit.BraceMatch;
- begin
- var Selections: TScintCaretAndAnchorList := nil;
- var VirtualSpaces: TScintCaretAndAnchorList := nil;
- try
- Selections := TScintCaretAndAnchorList.Create;
- VirtualSpaces := TScintCaretAndAnchorList.Create;
- GetSelections(Selections, VirtualSpaces);
- for var I := 0 to Selections.Count-1 do begin
- if VirtualSpaces[I].CaretPos = 0 then begin
- var Pos := Selections[I].CaretPos;
- var MatchPos := GetPositionOfMatchingBrace(Pos);
- if MatchPos = -1 then begin
- Pos := GetPositionBefore(Pos);
- MatchPos := GetPositionOfMatchingBrace(Pos)
- end;
- if MatchPos <> -1 then begin
- SelectionCaretPosition[I] := MatchPos;
- SelectionAnchorPosition[I] := MatchPos;
- if I = 0 then
- ScrollCaretIntoView;
- end;
- end;
- end;
- finally
- VirtualSpaces.Free;
- Selections.Free;
- end;
- end;
- function TScintEdit.Call(Msg: Cardinal; WParam: Longint; LParam: Longint): Longint;
- begin
- var Dummy: Integer;
- Result := Call(Msg, WParam, LParam, Dummy);
- end;
- function TScintEdit.Call(Msg: Cardinal; WParam: Longint; LParam: Longint;
- out WarnStatus: Integer): Longint;
- begin
- HandleNeeded;
- if FDirectPtr = nil then
- Error('Call: FDirectPtr is nil');
- if not Assigned(FDirectStatusFunction) then
- Error('Call: FDirectStatusFunction is nil');
- var ErrorStatus: Integer;
- Result := FDirectStatusFunction(FDirectPtr, Msg, WParam, LParam, ErrorStatus);
- if ErrorStatus <> 0 then begin
- var Dummy: Integer;
- FDirectStatusFunction(FDirectPtr, SCI_SETSTATUS, 0, 0, Dummy);
- if ErrorStatus < SC_STATUS_WARN_START then
- ErrorFmt('Error status %d returned after Call(%u, %d, %d) = %d',
- [ErrorStatus, Msg, WParam, LParam, Result]);
- end;
- WarnStatus := ErrorStatus;
- end;
- function TScintEdit.Call(Msg: Cardinal; WParam: Longint;
- const LParamStr: TScintRawString): Longint;
- begin
- var Dummy: Integer;
- Result := Call(Msg, WParam, LParamStr, Dummy);
- end;
- function TScintEdit.Call(Msg: Cardinal; WParam: Longint;
- const LParamStr: TScintRawString; out WarnStatus: Integer): Longint;
- begin
- Result := Call(Msg, WParam, LPARAM(PAnsiChar(LParamStr)), WarnStatus);
- end;
- procedure TScintEdit.CancelAutoComplete;
- begin
- Call(SCI_AUTOCCANCEL, 0, 0);
- end;
- procedure TScintEdit.CancelAutoCompleteAndCallTip;
- begin
- CancelAutoComplete;
- CancelCallTip;
- end;
- procedure TScintEdit.CancelCallTip;
- begin
- Call(SCI_CALLTIPCANCEL, 0, 0);
- end;
- function TScintEdit.CanPaste: Boolean;
- begin
- Result := Call(SCI_CANPASTE, 0, 0) <> 0;
- end;
- function TScintEdit.CanRedo: Boolean;
- begin
- Result := Call(SCI_CANREDO, 0, 0) <> 0;
- end;
- function TScintEdit.CanUndo: Boolean;
- begin
- Result := Call(SCI_CANUNDO, 0, 0) <> 0;
- end;
- procedure TScintEdit.Change(const AInserting: Boolean;
- const AStartPos, ALength, ALinesDelta: Integer);
- var
- Info: TScintEditChangeInfo;
- begin
- inherited Changed;
- if Assigned(FOnChange) then begin
- Info.Inserting := AInserting;
- Info.StartPos := AStartPos;
- Info.Length := ALength;
- Info.LinesDelta := ALinesDelta;
- FOnChange(Self, Info);
- end;
- end;
- procedure TScintEdit.CheckPosRange(const StartPos, EndPos: Integer);
- begin
- if (StartPos < 0) or (StartPos > EndPos) or (EndPos > GetRawTextLength) then
- ErrorFmt('CheckPosRange: Invalid range (%d, %d)', [StartPos, EndPos]);
- end;
- procedure TScintEdit.ChooseCaretX;
- begin
- Call(SCI_CHOOSECARETX, 0, 0);
- end;
- procedure TScintEdit.ClearAll;
- begin
- Call(SCI_CLEARALL, 0, 0);
- ChooseCaretX;
- end;
- procedure TScintEdit.ClearCmdKey(const Key: AnsiChar; const Shift: TShiftState);
- begin
- ClearCmdKey(KeyToKeyCode(Key), Shift);
- end;
- procedure TScintEdit.ClearCmdKey(const KeyCode: TScintKeyCode; const Shift: TShiftState);
- begin
- Call(SCI_CLEARCMDKEY, KeyCodeAndShiftToKeyDefinition(KeyCode, Shift), 0);
- end;
- procedure TScintEdit.ClearIndicators(
- const IndicatorNumber: TScintIndicatorNumber);
- begin
- Call(SCI_SETINDICATORCURRENT, IndicatorNumber, 0);
- Call(SCI_INDICATORCLEARRANGE, 0, RawTextLength);
- end;
- procedure TScintEdit.ClearSelection;
- begin
- Call(SCI_CLEAR, 0, 0);
- end;
- procedure TScintEdit.ClearUndo(const ClearChangeHistory: Boolean);
- begin
- { SCI_EMPTYUNDOBUFFER resets the save point but doesn't send a
- SCN_SAVEPOINTREACHED notification. Call SetSavePoint manually to get
- that. SetSavePoint additionally resets FForceModified. }
- SetSavePoint;
- Call(SCI_EMPTYUNDOBUFFER, 0, 0);
- { Clearing change history requires one to disable and re-enable it. But
- also, from Scintilla docs: "Change history depends on the undo history
- and can only be enabled when undo history is enabled and empty." This
- is why the following code is here. }
- if ClearChangeHistory and (FChangeHistory <> schDisabled) then begin
- Call(SCI_SETCHANGEHISTORY, SC_CHANGE_HISTORY_DISABLED, 0);
- var Flags := SC_CHANGE_HISTORY_ENABLED;
- if FChangeHistory = schMarkers then
- Flags := Flags or SC_CHANGE_HISTORY_MARKERS
- else
- Flags := Flags or SC_CHANGE_HISTORY_INDICATORS;
- Call(SCI_SETCHANGEHISTORY, Flags, 0);
- end;
- end;
- function TScintEdit.ConvertRawStringToString(const S: TScintRawString): String;
- var
- SrcLen, DestLen: Integer;
- DestStr: UnicodeString;
- begin
- SrcLen := Length(S);
- if SrcLen > 0 then begin
- DestLen := MultiByteToWideChar(FCodePage, 0, PAnsiChar(S), SrcLen, nil, 0);
- if DestLen <= 0 then
- Error('MultiByteToWideChar failed');
- SetString(DestStr, nil, DestLen);
- if MultiByteToWideChar(FCodePage, 0, PAnsiChar(S), SrcLen, @DestStr[1],
- Length(DestStr)) <> DestLen then
- Error('Unexpected result from MultiByteToWideChar');
- end;
- Result := DestStr;
- end;
- function TScintEdit.ConvertPCharToRawString(const Text: PChar;
- const TextLen: Integer): TScintRawString;
- var
- DestLen: Integer;
- DestStr: TScintRawString;
- begin
- if TextLen > 0 then begin
- DestLen := WideCharToMultiByte(FCodePage, 0, Text, TextLen, nil, 0, nil, nil);
- if DestLen <= 0 then
- Error('WideCharToMultiByte failed');
- InitRawString(DestStr, DestLen);
- if WideCharToMultiByte(FCodePage, 0, Text, TextLen, @DestStr[1], Length(DestStr),
- nil, nil) <> DestLen then
- Error('Unexpected result from WideCharToMultiByte');
- end;
- Result := DestStr;
- end;
- function TScintEdit.ConvertStringToRawString(const S: String): TScintRawString;
- begin
- Result := ConvertPCharToRawString(PChar(S), Length(S));
- end;
- procedure TScintEdit.CopyToClipboard;
- begin
- Call(SCI_COPY, 0, 0);
- end;
- procedure TScintEdit.CreateParams(var Params: TCreateParams);
- begin
- inherited;
- CreateSubClass(Params, 'Scintilla');
- //Params.ExStyle := Params.ExStyle or WS_EX_CLIENTEDGE;
- Params.WindowClass.style := Params.WindowClass.style and
- not (CS_HREDRAW or CS_VREDRAW);
- end;
- procedure TScintEdit.CreateWnd;
- begin
- if IsscintLibrary = 0 then
- Error('CreateWnd: IsscintLibrary is 0');
- inherited;
- FDirectPtr := Pointer(SendMessage(Handle, SCI_GETDIRECTPOINTER, 0, 0));
- if FDirectPtr = nil then
- Error('CreateWnd: FDirectPtr is nil');
- FDirectStatusFunction := SciFnDirectStatus(SendMessage(Handle, SCI_GETDIRECTSTATUSFUNCTION, 0, 0));
- if not Assigned(FDirectStatusFunction) then
- Error('CreateWnd: FDirectStatusFunction is nil');
- UpdateCodePage;
- Call(SCI_SETCOMMANDEVENTS, 0, 0);
- Call(SCI_SETMODEVENTMASK, SC_MOD_INSERTTEXT or SC_MOD_DELETETEXT, 0);
- Call(SCI_SETCARETPERIOD, GetCaretBlinkTime, 0);
- Call(SCI_SETSCROLLWIDTHTRACKING, 1, 0);
- { The default popup menu conflicts with the VCL's PopupMenu }
- Call(SCI_USEPOPUP, 0, 0);
- SetDefaultWordChars;
- ApplyOptions;
- UpdateStyleAttributes;
- if FAcceptDroppedFiles then
- DragAcceptFiles(Handle, True);
- end;
- procedure TScintEdit.CutToClipboard;
- begin
- Call(SCI_CUT, 0, 0);
- end;
- procedure TScintEdit.DeleteAllMarkersOnLine(const Line: Integer);
- begin
- FLines.CheckIndexRange(Line);
- Call(SCI_MARKERDELETE, Line, -1);
- end;
- procedure TScintEdit.DeleteMarker(const Line: Integer;
- const Marker: TScintMarkerNumber);
- begin
- FLines.CheckIndexRange(Line);
- Call(SCI_MARKERDELETE, Line, Marker);
- end;
- procedure TScintEdit.EndUndoAction;
- begin
- Call(SCI_ENDUNDOACTION, 0, 0);
- end;
- procedure TScintEdit.EnsureLineVisible(const Line: Integer);
- begin
- FLines.CheckIndexRange(Line);
- Call(SCI_ENSUREVISIBLE, Line, 0);
- end;
- class function TScintEdit.GetErrorException(const S: String): EScintEditError;
- { Can be used when just calling Error would cause a compiler warning because it doesn't realize Error always raises }
- begin
- Result := EScintEditError.Create('TScintEdit error: ' + S);
- end;
- class procedure TScintEdit.Error(const S: String);
- begin
- raise GetErrorException(S);
- end;
- class procedure TScintEdit.ErrorFmt(const S: String; const Args: array of const);
- begin
- Error(Format(S, Args));
- end;
- function TScintEdit.FindRawText(const StartPos, EndPos: Integer;
- const S: TScintRawString; const Options: TScintFindOptions;
- out MatchRange: TScintRange): Boolean;
- begin
- SetTarget(StartPos, EndPos);
- Call(SCI_SETSEARCHFLAGS, GetSearchFlags(Options), 0);
- Result := Call(SCI_SEARCHINTARGET, Length(S), S) >= 0;
- if Result then
- MatchRange := GetTarget;
- end;
- function TScintEdit.FindText(const StartPos, EndPos: Integer; const S: String;
- const Options: TScintFindOptions; out MatchRange: TScintRange): Boolean;
- begin
- Result := FindRawText(StartPos, EndPos, ConvertStringToRawString(S),
- Options, MatchRange);
- end;
- procedure TScintEdit.FoldLine(const Line: Integer; const Fold: Boolean);
- begin
- FLines.CheckIndexRange(Line);
- { If the line is not part of a fold the following will return False }
- var Folded := Call(SCI_GETFOLDEXPANDED, Line, 0) = 0;
- if Fold <> Folded then begin
- { If the line is not part of a fold the following will do nothing
- and else if the line is not the header Scintilla will lookup the
- header for us }
- Call(SCI_TOGGLEFOLD, Line, 0);
- end;
- end;
- procedure TScintEdit.ForceModifiedState;
- begin
- if not FForceModified then begin
- FForceModified := True;
- if Assigned(FOnModifiedChange) then
- FOnModifiedChange(Self);
- end;
- end;
- function TScintEdit.FormatRange(const Draw: Boolean;
- const RangeToFormat: PScintRangeToFormat): Integer;
- begin
- Result := Call(SCI_FORMATRANGE, Ord(Draw), LPARAM(RangeToFormat));
- end;
- procedure TScintEdit.ForwardMessage(const Message: TMessage);
- begin
- if HandleAllocated then
- CallWindowProc(DefWndProc, Handle, Message.Msg, Message.WParam, Message.LParam);
- end;
- function TScintEdit.GetAnchorPosition: Integer;
- begin
- Result := Call(SCI_GETANCHOR, 0, 0);
- end;
- function TScintEdit.GetAutoCompleteActive: Boolean;
- begin
- Result := Call(SCI_AUTOCACTIVE, 0, 0) <> 0;
- end;
- function TScintEdit.GetByteAtPosition(const Pos: Integer): AnsiChar;
- begin
- Result := AnsiChar(Call(SCI_GETCHARAT, Pos, 0));
- end;
- function TScintEdit.GetCallTipActive: Boolean;
- begin
- Result := Call(SCI_CALLTIPACTIVE, 0, 0) <> 0;
- end;
- function TScintEdit.GetCaretColumn: Integer;
- begin
- Result := GetColumnFromPosition(GetCaretPosition);
- end;
- function TScintEdit.GetCaretColumnExpandedForTabs: Integer;
- begin
- Result := Call(SCI_GETCOLUMN, GetCaretPosition, 0);
- Inc(Result, GetCaretVirtualSpace);
- end;
- function TScintEdit.GetCaretLine: Integer;
- begin
- Result := GetLineFromPosition(GetCaretPosition);
- end;
- function TScintEdit.GetCaretLineText: String;
- begin
- Result := ConvertRawStringToString(GetRawCaretLineText);
- end;
- function TScintEdit.GetCaretPosition: Integer;
- begin
- Result := Call(SCI_GETCURRENTPOS, 0, 0);
- end;
- function TScintEdit.GetCaretPositionInLine: Integer;
- begin
- var Caret := CaretPosition;
- var LineStart := GetPositionFromLine(GetLineFromPosition(Caret));
- Result := Caret - LineStart;
- end;
- function TScintEdit.GetCaretVirtualSpace: Integer;
- begin
- Result := GetSelectionCaretVirtualSpace(GetMainSelection);
- end;
- function TScintEdit.GetCharacterCount(const StartPos, EndPos: Integer): Integer;
- begin
- CheckPosRange(StartPos, EndPos);
- Result := Call(SCI_COUNTCHARACTERS, StartPos, EndPos);
- end;
- function TScintEdit.GetColumnFromPosition(const Pos: Integer): Integer;
- var
- Line: Integer;
- begin
- Line := GetLineFromPosition(Pos);
- Result := Pos - GetPositionFromLine(Line);
- end;
- function TScintEdit.GetDefaultWordChars: AnsiString;
- begin
- Result := 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_';
- end;
- function TScintEdit.GetDocLineFromVisibleLine(const VisibleLine: Integer): Integer;
- begin
- Result := Call(SCI_DOCLINEFROMVISIBLE, VisibleLine, 0);
- end;
- function TScintEdit.GetIndicatorAtPosition(
- const IndicatorNumber: TScintIndicatorNumber; const Pos: Integer): Boolean;
- begin
- Result := Call(SCI_INDICATORVALUEAT, IndicatorNumber, Pos) <> 0;
- end;
- function TScintEdit.GetInsertMode: Boolean;
- begin
- Result := Call(SCI_GETOVERTYPE, 0, 0) = 0;
- end;
- function TScintEdit.GetLineEndings: TScintLineEndings;
- begin
- case Call(SCI_GETEOLMODE, 0, 0) of
- SC_EOL_CR: Result := sleCR;
- SC_EOL_LF: Result := sleLF;
- SC_EOL_CRLF: Result := sleCRLF;
- else
- raise GetErrorException('Unexpected SCI_GETEOLMODE result');
- end;
- end;
- function TScintEdit.GetLineEndingString: TScintRawString;
- const
- EndingStrs: array[TScintLineEndings] of TScintRawString =
- (#13#10, #13, #10);
- begin
- Result := EndingStrs[LineEndings];
- end;
- function TScintEdit.GetLineEndPosition(const Line: Integer): Integer;
- { Returns the position at the end of the line, before any line end characters. }
- begin
- FLines.CheckIndexRange(Line);
- Result := Call(SCI_GETLINEENDPOSITION, Line, 0);
- end;
- function TScintEdit.GetLineFromPosition(const Pos: Integer): Integer;
- begin
- Result := Call(SCI_LINEFROMPOSITION, Pos, 0);
- end;
- function TScintEdit.GetLineHeight: Integer;
- begin
- Result := Call(SCI_TEXTHEIGHT, 0, 0);
- end;
- function TScintEdit.GetLineIndentation(const Line: Integer): Integer;
- begin
- FLines.CheckIndexRange(Line);
- Result := Call(SCI_GETLINEINDENTATION, Line, 0);
- end;
- function TScintEdit.GetLineIndentPosition(const Line: Integer): Integer;
- begin
- FLines.CheckIndexRange(Line);
- Result := Call(SCI_GETLINEINDENTPOSITION, Line, 0);
- end;
- function TScintEdit.GetLinesInWindow: Integer;
- begin
- Result := Call(SCI_LINESONSCREEN, 0, 0);
- end;
- function TScintEdit.GetMainSelection: Integer;
- begin
- Result := Call(SCI_GETMAINSELECTION, 0, 0);
- end;
- function TScintEdit.GetMainSelText: String;
- begin
- Result := ConvertRawStringToString(GetRawMainSelText);
- end;
- function TScintEdit.GetMarkers(const Line: Integer): TScintMarkerNumbers;
- begin
- FLines.CheckIndexRange(Line);
- Integer(Result) := Call(SCI_MARKERGET, Line, 0);
- end;
- function TScintEdit.GetModified: Boolean;
- begin
- Result := FForceModified or (Call(SCI_GETMODIFY, 0, 0) <> 0);
- end;
- function TScintEdit.GetPointFromPosition(const Pos: Integer): TPoint;
- begin
- Result.X := Call(SCI_POINTXFROMPOSITION, 0, Pos);
- Result.Y := Call(SCI_POINTYFROMPOSITION, 0, Pos);
- end;
- function TScintEdit.GetPositionAfter(const Pos: Integer): Integer;
- begin
- Result := Call(SCI_POSITIONAFTER, Pos, 0);
- end;
- function TScintEdit.GetPositionBefore(const Pos: Integer): Integer;
- begin
- Result := Call(SCI_POSITIONBEFORE, Pos, 0);
- end;
- function TScintEdit.GetPositionFromLine(const Line: Integer): Integer;
- begin
- FLines.CheckIndexRangePlusOne(Line);
- Result := Call(SCI_POSITIONFROMLINE, Line, 0);
- end;
- function TScintEdit.GetPositionFromLineColumn(const Line, Column: Integer): Integer;
- var
- Col, Len: Integer;
- begin
- Col := Column;
- Result := GetPositionFromLine(Line);
- Len := GetLineEndPosition(Line) - Result;
- if Col > Len then
- Col := Len;
- if Col > 0 then
- Inc(Result, Col);
- end;
- function TScintEdit.GetPositionFromLineExpandedColumn(const Line,
- ExpandedColumn: Integer): Integer;
- begin
- FLines.CheckIndexRange(Line);
- Result := Call(SCI_FINDCOLUMN, Line, ExpandedColumn);
- end;
- function TScintEdit.GetPositionFromPoint(const P: TPoint;
- const CharPosition, CloseOnly: Boolean): Integer;
- begin
- if CharPosition then begin
- if CloseOnly then
- Result := Call(SCI_CHARPOSITIONFROMPOINTCLOSE, P.X, P.Y)
- else
- Result := Call(SCI_CHARPOSITIONFROMPOINT, P.X, P.Y);
- end
- else begin
- if CloseOnly then
- Result := Call(SCI_POSITIONFROMPOINTCLOSE, P.X, P.Y)
- else
- Result := Call(SCI_POSITIONFROMPOINT, P.X, P.Y);
- end;
- end;
- function TScintEdit.GetPositionOfMatchingBrace(const Pos: Integer): Integer;
- begin
- Result := Call(SCI_BRACEMATCH, Pos, 0);
- end;
- function TScintEdit.GetPositionRelative(const Pos,
- CharacterCount: Integer): Integer;
- begin
- Result := Call(SCI_POSITIONRELATIVE, Pos, CharacterCount);
- end;
- function TScintEdit.GetRawCaretLineText: TScintRawString;
- begin
- var Line := CaretLine;
- Result := GetRawTextRange(GetPositionFromLine(Line), GetPositionFromLine(Line+1));
- end;
- function TScintEdit.GetRawMainSelText: TScintRawString;
- begin
- var MainSel := MainSelection;
- var CaretPos := SelectionCaretPosition[MainSel];
- var AnchorPos := SelectionAnchorPosition[MainSel];
- if AnchorPos < CaretPos then
- Result := GetRawTextRange(AnchorPos, CaretPos)
- else
- Result := GetRawTextRange(CaretPos, AnchorPos);
- end;
- function TScintEdit.GetRawSelText: TScintRawString;
- { Gets the combined text of *all* selections }
- var
- Len: Integer;
- S: TScintRawString;
- begin
- Len := Call(SCI_GETSELTEXT, 0, 0);
- if Len > 0 then begin
- InitRawString(S, Len);
- Call(SCI_GETSELTEXT, 0, LPARAM(PAnsiChar(@S[1])));
- end;
- Result := S;
- end;
- function TScintEdit.GetRawText: TScintRawString;
- begin
- Result := GetRawTextRange(0, GetRawTextLength);
- end;
- function TScintEdit.GetRawTextLength: Integer;
- begin
- Result := Call(SCI_GETLENGTH, 0, 0);
- end;
- function TScintEdit.GetRawTextRange(const StartPos, EndPos: Integer): TScintRawString;
- var
- S: TScintRawString;
- Range: TSci_TextRange;
- begin
- CheckPosRange(StartPos, EndPos);
- if EndPos > StartPos then begin
- InitRawString(S, EndPos - StartPos);
- Range.chrg.cpMin := StartPos;
- Range.chrg.cpMax := EndPos;
- Range.lpstrText := @S[1];
- if Call(SCI_GETTEXTRANGE, 0, LPARAM(@Range)) <> EndPos - StartPos then
- Error('Unexpected result from SCI_GETTEXTRANGE');
- end;
- Result := S;
- end;
- function TScintEdit.GetReadOnly: Boolean;
- begin
- Result := Call(SCI_GETREADONLY, 0, 0) <> 0;
- end;
- class function TScintEdit.GetReplaceTargetMessage(
- const ReplaceMode: TScintReplaceMode): Cardinal;
- begin
- case ReplaceMode of
- srmNormal: Result := SCI_REPLACETARGET;
- srmMinimal: Result := SCI_REPLACETARGETMINIMAL;
- srmRegEx: Result := SCI_REPLACETARGETRE;
- else
- raise GetErrorException('Unknown ReplaceMode');
- end;
- end;
- class function TScintEdit.GetSearchFlags(const Options: TScintFindOptions): Integer;
- begin
- { Note: Scintilla ignores SCFIND_WHOLEWORD when SCFIND_REGEXP is set }
- Result := 0;
- if sfoMatchCase in Options then
- Result := Result or SCFIND_MATCHCASE;
- if sfoWholeWord in Options then
- Result := Result or SCFIND_WHOLEWORD;
- if sfoRegEx in Options then
- Result := Result or (SCFIND_REGEXP or SCFIND_CXX11REGEX);
- end;
- function TScintEdit.GetSelection: TScintRange;
- begin
- Result.StartPos := Call(SCI_GETSELECTIONSTART, 0, 0);
- Result.EndPos := Call(SCI_GETSELECTIONEND, 0, 0);
- end;
- procedure TScintEdit.GetSelections(const RangeList: TScintRangeList);
- begin
- RangeList.Clear;
- for var I := 0 to SelectionCount-1 do begin
- var StartPos := GetSelectionStartPosition(I);
- var EndPos := GetSelectionEndPosition(I);
- RangeList.Add(TScintRange.Create(StartPos, EndPos));
- end;
- end;
- procedure TScintEdit.GetSelections(const CaretAndAnchorList: TScintCaretAndAnchorList);
- begin
- CaretAndAnchorList.Clear;
- for var I := 0 to SelectionCount-1 do begin
- var CaretPos := GetSelectionCaretPosition(I);
- var AnchorPos := GetSelectionAnchorPosition(I);
- CaretAndAnchorList.Add(TScintCaretAndAnchor.Create(CaretPos, AnchorPos));
- end;
- end;
- procedure TScintEdit.GetSelections(const CaretAndAnchorList, VirtualSpacesList: TScintCaretAndAnchorList);
- begin
- GetSelections(CaretAndAnchorList);
- VirtualSpacesList.Clear;
- for var I := 0 to SelectionCount-1 do begin
- var CaretPos := GetSelectionCaretVirtualSpace(I);
- var AnchorPos := GetSelectionAnchorVirtualSpace(I);
- VirtualSpacesList.Add(TScintCaretAndAnchor.Create(CaretPos, AnchorPos));
- end;
- end;
- function TScintEdit.GetSelectionAnchorPosition(Selection: Integer): Integer;
- begin
- Result := Call(SCI_GETSELECTIONNANCHOR, Selection, 0);
- end;
- function TScintEdit.GetSelectionAnchorVirtualSpace(Selection: Integer): Integer;
- begin
- Result := Call(SCI_GETSELECTIONNANCHORVIRTUALSPACE, Selection, 0);
- end;
- function TScintEdit.GetSelectionCaretPosition(Selection: Integer): Integer;
- begin
- Result := Call(SCI_GETSELECTIONNCARET, Selection, 0);
- end;
- function TScintEdit.GetSelectionCaretVirtualSpace(Selection: Integer): Integer;
- begin
- Result := Call(SCI_GETSELECTIONNCARETVIRTUALSPACE, Selection, 0);
- end;
- function TScintEdit.GetSelectionCount: Integer;
- { Returns the number of selections currently active. Rectangular selections are
- handled (and returned) as multiple selections, one for each line. }
- begin
- Result := Call(SCI_GETSELECTIONS, 0, 0);
- end;
- function TScintEdit.GetSelectionEndPosition(Selection: Integer): Integer;
- begin
- Result := Call(SCI_GETSELECTIONNEND, Selection, 0)
- end;
- function TScintEdit.GetSelectionMode: TScintSelectionMode;
- begin
- case Call(SCI_GETSELECTIONMODE, 0, 0) of
- SC_SEL_STREAM: Result := ssmStream;
- SC_SEL_RECTANGLE: Result := ssmRectangular;
- SC_SEL_LINES: Result := ssmLines;
- SC_SEL_THIN: Result := ssmThinRectangular;
- else
- raise GetErrorException('Unexpected SCI_GETSELECTIONMODE result');
- end;
- end;
- function TScintEdit.GetSelectionStartPosition(Selection: Integer): Integer;
- begin
- Result := Call(SCI_GETSELECTIONNSTART, Selection, 0);
- end;
- function TScintEdit.GetSelText: String;
- begin
- Result := ConvertRawStringToString(GetRawSelText);
- end;
- function TScintEdit.GetStyleAtPosition(const Pos: Integer): TScintStyleNumber;
- begin
- Result := Call(SCI_GETSTYLEAT, Pos, 0);
- end;
- function TScintEdit.GetTarget: TScintRange;
- begin
- Result.StartPos := Call(SCI_GETTARGETSTART, 0, 0);
- Result.EndPos := Call(SCI_GETTARGETEND, 0, 0);
- end;
- function TScintEdit.GetTextRange(const StartPos, EndPos: Integer): String;
- begin
- Result := ConvertRawStringToString(GetRawTextRange(StartPos, EndPos));
- end;
- function TScintEdit.GetTopLine: Integer;
- begin
- Result := Call(SCI_GETFIRSTVISIBLELINE, 0, 0);
- end;
- function TScintEdit.GetVisibleLineFromDocLine(const DocLine: Integer): Integer;
- begin
- FLines.CheckIndexRange(DocLine);
- Result := Call(SCI_VISIBLEFROMDOCLINE, DocLine, 0);
- end;
- function TScintEdit.GetWordEndPosition(const Pos: Integer;
- const OnlyWordChars: Boolean): Integer;
- begin
- Result := Call(SCI_WORDENDPOSITION, Pos, Ord(OnlyWordChars));
- end;
- function TScintEdit.GetWordStartPosition(const Pos: Integer;
- const OnlyWordChars: Boolean): Integer;
- begin
- Result := Call(SCI_WORDSTARTPOSITION, Pos, Ord(OnlyWordChars));
- end;
- function TScintEdit.GetZoom: Integer;
- begin
- Result := Call(SCI_GETZOOM, 0, 0);
- end;
- procedure TScintEdit.InitRawString(var S: TScintRawString; const Len: Integer);
- begin
- SetString(S, nil, Len);
- //experimental, dont need this ATM:
- if FCodePage <> 0 then
- System.SetCodePage(RawByteString(S), FCodePage, False);
- end;
- function TScintEdit.IsPositionInViewVertically(const Pos: Integer): Boolean;
- var
- P: TPoint;
- begin
- P := GetPointFromPosition(Pos);
- Result := (P.Y >= 0) and (P.Y + GetLineHeight <= ClientHeight);
- end;
- class function TScintEdit.KeyCodeAndShiftToKeyDefinition(
- const KeyCode: TScintKeyCode; Shift: TShiftState): TScintKeyDefinition;
- begin
- Result := KeyCode;
- if ssShift in Shift then
- Result := Result or (SCMOD_SHIFT shl 16);
- if ssAlt in Shift then
- Result := Result or (SCMOD_ALT shl 16);
- if ssCtrl in Shift then
- Result := Result or (SCMOD_CTRL shl 16);
- end;
- class function TScintEdit.KeyToKeyCode(const Key: AnsiChar): TScintKeyCode;
- begin
- Result := Ord(UpCase(Key));
- end;
- function TScintEdit.MainSelTextEquals(const S: String;
- const Options: TScintFindOptions): Boolean;
- begin
- Result := RawMainSelTextEquals(ConvertStringToRawString(S), Options);
- end;
- procedure TScintEdit.Notification(AComponent: TComponent; Operation: TOperation);
- begin
- inherited;
- if Operation = opRemove then
- if AComponent = FStyler then
- SetStyler(nil);
- end;
- procedure TScintEdit.Notify(const N: TSCNotification);
- begin
- case N.nmhdr.code of
- SCN_AUTOCSELECTION:
- begin
- if Assigned(FOnAutoCompleteSelection) then
- FOnAutoCompleteSelection(Self);
- end;
- SCN_CALLTIPCLICK:
- begin
- if (N.position in [1, 2]) and Assigned(FOnCallTipArrowClick) then
- FOnCallTipArrowClick(Self, N.position = 1);
- end;
- SCN_CHARADDED:
- begin
- if Assigned(FOnCharAdded) then
- FOnCharAdded(Self, AnsiChar(N.ch));
- end;
- SCN_MARGINCLICK:
- begin
- if Assigned(FOnMarginClick) then
- FOnMarginClick(Self, N.margin, GetLineFromPosition(N.position));
- end;
- SCN_MARGINRIGHTCLICK:
- begin
- if Assigned(FOnMarginRightClick) then
- FOnMarginRightClick(Self, N.margin, GetLineFromPosition(N.position));
- end;
- SCN_MODIFIED:
- begin
- { CreateWnd limits SCN_MODIFIED to INSERTTEXT and DELETETEXT }
- if N.modificationType and SC_MOD_INSERTTEXT <> 0 then
- Change(True, N.position, N.length, N.linesAdded)
- else if N.modificationType and SC_MOD_DELETETEXT <> 0 then
- Change(False, N.position, N.length, N.linesAdded);
- if (N.linesAdded > 0) and FLineNumbers then
- UpdateLineNumbersWidth;
- end;
- SCN_SAVEPOINTLEFT,
- SCN_SAVEPOINTREACHED:
- begin
- if Assigned(FOnModifiedChange) then
- FOnModifiedChange(Self);
- end;
- SCN_STYLENEEDED: StyleNeeded(N.position);
- SCN_UPDATEUI:
- begin
- if Assigned(FOnUpdateUI) then
- FOnUpdateUI(Self, TScintEditUpdates(Byte(N.updated)));
- end;
- SCN_ZOOM:
- begin
- if Assigned(FOnZoom) then
- FOnZoom(Self);
- if FLineNumbers then
- UpdateLineNumbersWidth;
- end;
- end;
- end;
- procedure TScintEdit.PasteFromClipboard;
- begin
- Call(SCI_PASTE, 0, 0);
- end;
- function TScintEdit.RawMainSelTextEquals(const S: TScintRawString;
- const Options: TScintFindOptions): Boolean;
- begin
- Call(SCI_TARGETFROMSELECTION, 0, 0);
- Call(SCI_SETSEARCHFLAGS, GetSearchFlags(Options), 0);
- Result := False;
- if Call(SCI_SEARCHINTARGET, Length(S), S) >= 0 then begin
- var Target := GetTarget;
- var Sel := GetSelection;
- if (Target.StartPos = Sel.StartPos) and (Target.EndPos = Sel.EndPos) then
- Result := True;
- end;
- end;
- class function TScintEdit.RawStringIsBlank(const S: TScintRawString): Boolean;
- begin
- for var I := 1 to Length(S) do
- if not(S[I] in [#9, ' ']) then
- Exit(False);
- Result := True;
- end;
- procedure TScintEdit.Redo;
- begin
- Call(SCI_REDO, 0, 0);
- end;
- procedure TScintEdit.RemoveAdditionalSelections;
- { Removes additional selections without scrolling the caret into view }
- begin
- var MainSel := MainSelection;
- var CaretPos := SelectionCaretPosition[MainSel];
- var AnchorPos := SelectionAnchorPosition[MainSel];
- SetSingleSelection(CaretPos, AnchorPos);
- end;
- function TScintEdit.ReplaceMainSelText(const S: String;
- const ReplaceMode: TScintReplaceMode): TScintRange;
- begin
- ReplaceRawMainSelText(ConvertStringToRawString(S), ReplaceMode);
- end;
- function TScintEdit.ReplaceRawMainSelText(const S: TScintRawString;
- const ReplaceMode: TScintReplaceMode): TScintRange;
- { Replaces the main selection just like SetRawSelText/SCI_REPLACESEL but
- without removing additional selections }
- begin
- { First replace the selection }
- Call(SCI_TARGETFROMSELECTION, 0, 0);
- Call(GetReplaceTargetMessage(ReplaceMode), Length(S), S);
- { Then make the main selection an empty selection at the end of the inserted
- text, just like SCI_REPLACESEL }
- var Pos := GetTarget.EndPos; { SCI_REPLACETARGET* updates the target }
- var MainSel := MainSelection;
- SetSelectionCaretPosition(MainSel, Pos);
- SetSelectionAnchorPosition(MainSel, Pos);
- { Finally call Editor::SetLastXChosen and scroll caret into view, also just
- like SCI_REPLACESEL }
- ChooseCaretX;
- ScrollCaretIntoView;
- end;
- function TScintEdit.ReplaceRawTextRange(const StartPos, EndPos: Integer;
- const S: TScintRawString; const ReplaceMode: TScintReplaceMode): TScintRange;
- begin
- CheckPosRange(StartPos, EndPos);
- SetTarget(StartPos, EndPos);
- Call(GetReplaceTargetMessage(ReplaceMode), Length(S), S);
- Result := GetTarget;
- end;
- function TScintEdit.ReplaceTextRange(const StartPos, EndPos: Integer;
- const S: String; const ReplaceMode: TScintReplaceMode): TScintRange;
- begin
- Result := ReplaceRawTextRange(StartPos, EndPos, ConvertStringToRawString(S), ReplaceMode);
- end;
- procedure TScintEdit.RestyleLine(const Line: Integer);
- begin
- var StartPos := GetPositionFromLine(Line);
- var EndPos := GetPositionFromLine(Line + 1);
- { Back up the 'last styled position' if necessary using SCI_STARTSTYLINE
- (SCI_SETENDSTYLED would have been a clearer name because setting the
- 'last styled position' is all it does) }
- if StartPos < Call(SCI_GETENDSTYLED, 0, 0) then
- Call(SCI_STARTSTYLING, StartPos, 0);
- StyleNeeded(EndPos);
- end;
- procedure TScintEdit.ScrollCaretIntoView;
- begin
- Call(SCI_SCROLLCARET, 0, 0);
- end;
- procedure TScintEdit.SelectAllOccurrences(const Options: TScintFindOptions);
- { At the moment this does not automatically expand folds, unlike VSCode. Also
- see SelectNextOccurrence. }
- begin
- Call(SCI_TARGETWHOLEDOCUMENT, 0, 0);
- Call(SCI_SETSEARCHFLAGS, GetSearchFlags(Options), 0);
- Call(SCI_MULTIPLESELECTADDEACH, 0, 0);
- end;
- procedure TScintEdit.SelectAndEnsureVisible(const Range: TScintRange);
- begin
- CheckPosRange(Range.StartPos, Range.EndPos);
- { If the range is in a contracted section, expand it }
- var StartLine := GetLineFromPosition(Range.StartPos);
- var EndLine := GetLineFromPosition(Range.EndPos);
- for var Line := StartLine to EndLine do
- EnsureLineVisible(Line);
- { Select }
- Selection := Range;
- end;
- procedure TScintEdit.SelectNextOccurrence(const Options: TScintFindOptions);
- { At the moment this does not automatically expand folds, unlike VSCode. Also
- see SelectAllOccurrences. }
- begin
- Call(SCI_TARGETWHOLEDOCUMENT, 0, 0);
- Call(SCI_SETSEARCHFLAGS, GetSearchFlags(Options), 0);
- Call(SCI_MULTIPLESELECTADDNEXT, 0, 0);
- end;
- function TScintEdit.SelEmpty: Boolean;
- { Returns True if the main selection is empty even if there are additional
- selections. }
- begin
- var Sel: TScintRange;
- Result := not SelNotEmpty(Sel);
- end;
- function TScintEdit.SelNotEmpty(out Sel: TScintRange): Boolean;
- begin
- Sel := GetSelection;
- Result := Sel.EndPos > Sel.StartPos;
- end;
- procedure TScintEdit.SelectAll;
- begin
- Call(SCI_SELECTALL, 0, 0);
- end;
- procedure TScintEdit.SetAcceptDroppedFiles(const Value: Boolean);
- begin
- if FAcceptDroppedFiles <> Value then begin
- FAcceptDroppedFiles := Value;
- if HandleAllocated then
- DragAcceptFiles(Handle, Value);
- end;
- end;
- procedure TScintEdit.SetAutoCompleteFillupChars(const FillupChars: AnsiString);
- begin
- Call(SCI_AUTOCSETFILLUPS, 0, FillupChars);
- end;
- procedure TScintEdit.SetAutoCompleteFontName(const Value: String);
- begin
- if FAutoCompleteFontName <> Value then begin
- FAutoCompleteFontName := Value;
- UpdateStyleAttributes;
- end;
- end;
- procedure TScintEdit.SetAutoCompleteFontSize(const Value: Integer);
- begin
- if FAutoCompleteFontSize <> Value then begin
- FAutoCompleteFontSize := Value;
- UpdateStyleAttributes;
- end;
- end;
- procedure TScintEdit.SetAutoCompleteSelectedItem(const S: TScintRawString);
- begin
- Call(SCI_AUTOCSELECT, 0, S);
- end;
- procedure TScintEdit.SetAutoCompleteSeparators(const Separator, TypeSeparator: AnsiChar);
- begin
- Call(SCI_AUTOCSETSEPARATOR, WParam(Separator), 0);
- Call(SCI_AUTOCSETTYPESEPARATOR, WParam(TypeSeparator), 0);
- end;
- procedure TScintEdit.SetAutoCompleteStopChars(const StopChars: AnsiString);
- begin
- Call(SCI_AUTOCSTOPS, 0, StopChars);
- end;
- procedure TScintEdit.SetBraceBadHighlighting(const Pos: Integer);
- begin
- Call(SCI_BRACEBADLIGHT, Pos, 0);
- end;
- procedure TScintEdit.SetBraceHighlighting(const Pos1, Pos2: Integer);
- begin
- Call(SCI_BRACEHIGHLIGHT, Pos1, Pos2);
- end;
- procedure TScintEdit.SetCallTipHighlight(HighlightStart, HighlightEnd: Integer);
- begin
- Call(SCI_CALLTIPSETHLT, HighlightStart, HighlightEnd);
- end;
- procedure TScintEdit.SetCaretColumn(const Value: Integer);
- begin
- SetCaretPosition(GetPositionFromLineColumn(GetCaretLine, Value));
- end;
- procedure TScintEdit.SetCaretLine(const Value: Integer);
- begin
- Call(SCI_GOTOLINE, Value, 0);
- ChooseCaretX;
- end;
- procedure TScintEdit.SetCaretPosition(const Value: Integer);
- begin
- Call(SCI_GOTOPOS, Value, 0);
- ChooseCaretX;
- end;
- procedure TScintEdit.SetCaretPositionWithSelectFromAnchor(const Value: Integer);
- { Sets the caret position and creates a selection between the anchor and the
- caret position without scrolling the caret into view. }
- begin
- Call(SCI_SETCURRENTPOS, Value, 0);
- end;
- procedure TScintEdit.SetCaretVirtualSpace(const Value: Integer);
- { Also sets the anchor's virtual space! }
- var
- Pos, LineEndPos, MainSel: Integer;
- begin
- { Weird things happen if a non-zero virtual space is set when the caret
- isn't at the end of a line, so don't allow it }
- Pos := GetCaretPosition;
- LineEndPos := GetLineEndPosition(GetLineFromPosition(Pos));
- if (Pos = LineEndPos) or (Value = 0) then begin
- MainSel := GetMainSelection;
- SetSelectionAnchorVirtualSpace(MainSel, Value);
- SetSelectionCaretVirtualSpace(MainSel, Value);
- ChooseCaretX;
- end;
- end;
- procedure TScintEdit.SetChangeHistory(const Value: TScintChangeHistory);
- begin
- if FChangeHistory <> Value then begin
- FChangeHistory := Value;
- ApplyOptions;
- end;
- end;
- procedure TScintEdit.SetCodePage(const Value: Integer);
- begin
- if FCodePage <> Value then begin
- FCodePage := Value;
- UpdateCodePage;
- end;
- end;
- procedure TScintEdit.SetCursorID(const CursorID: Integer);
- begin
- Call(SCI_SETCURSOR, CursorID, 0);
- end;
- procedure TScintEdit.SetDefaultWordChars;
- begin
- SetWordChars(GetDefaultWordChars);
- end;
- procedure TScintEdit.SetEmptySelection;
- { Make the main selection empty and removes additional selections without
- scrolling the caret into view }
- begin
- Call(SCI_SETEMPTYSELECTION, GetCaretPosition, 0);
- end;
- procedure TScintEdit.SetEmptySelections;
- { Makes all selections empty without scrolling the caret into view }
- begin
- for var Selection := 0 to SelectionCount-1 do begin
- var Pos := SelectionCaretPosition[Selection];
- SelectionAnchorPosition[Selection] := Pos;
- end;
- end;
- procedure TScintEdit.SetFillSelectionToEdge(const Value: Boolean);
- begin
- if FFillSelectionToEdge <> Value then begin
- FFillSelectionToEdge := Value;
- ApplyOptions;
- end;
- end;
- procedure TScintEdit.SetFoldFlags(const Value: TScintFoldFlags);
- begin
- var Flags := 0;
- if sffLineBeforeExpanded in Value then
- Flags := Flags or SC_FOLDFLAG_LINEBEFORE_EXPANDED;
- if sffLineBeforeContracted in Value then
- Flags := Flags or SC_FOLDFLAG_LINEBEFORE_CONTRACTED;
- if sffLineAfterExpanded in Value then
- Flags := Flags or SC_FOLDFLAG_LINEAFTER_EXPANDED;
- if sffLineAfterContracted in Value then
- Flags := Flags or SC_FOLDFLAG_LINEAFTER_CONTRACTED;
- if sffLevelNumbers in Value then
- Flags := Flags or SC_FOLDFLAG_LEVELNUMBERS
- else if sffLineState in Value then
- Flags := Flags or SC_FOLDFLAG_LINESTATE;
- Call(SCI_SETFOLDFLAGS, Flags, 0);
- var FoldLevelNumbersOrLineState := Value * [sffLevelNumbers, sffLineState] <> [];
- if FoldLevelNumbersOrLineState <> FFoldLevelNumbersOrLineState then begin
- FFoldLevelNumbersOrLineState := FoldLevelNumbersOrLineState;
- UpdateLineNumbersWidth;
- end;
- end;
- procedure TScintEdit.SetIndicators(const StartPos, EndPos: Integer;
- const IndicatorNumber: TScintIndicatorNumber; const Value: Boolean);
- begin
- CheckPosRange(StartPos, EndPos);
- Call(SCI_SETINDICATORCURRENT, IndicatorNumber, 0);
- if Value then begin
- Call(SCI_SETINDICATORVALUE, IndicatorNumber, 1);
- Call(SCI_INDICATORFILLRANGE, StartPos, EndPos - StartPos);
- end else
- Call(SCI_INDICATORCLEARRANGE, StartPos, EndPos - StartPos);
- end;
- procedure TScintEdit.SetLineIndentation(const Line, Indentation: Integer);
- begin
- FLines.CheckIndexRange(Line);
- Call(SCI_SETLINEINDENTATION, Line, Indentation);
- end;
- procedure TScintEdit.SetIndentationGuides(const Value: TScintIndentationGuides);
- begin
- if FIndentationGuides <> Value then begin
- FIndentationGuides := Value;
- ApplyOptions;
- end;
- end;
- procedure TScintEdit.SetLineNumbers(const Value: Boolean);
- begin
- if FLineNumbers <> Value then begin
- FLineNumbers := Value;
- UpdateLineNumbersWidth;
- end;
- end;
- procedure TScintEdit.SetMainSelection(const Value: Integer);
- begin
- Call(SCI_SETMAINSELECTION, Value, 0);
- end;
- procedure TScintEdit.SetMainSelText(const Value: String);
- begin
- SetRawMainSelText(ConvertStringToRawString(Value));
- end;
- procedure TScintEdit.SetRawMainSelText(const Value: TScintRawString);
- begin
- ReplaceRawMainSelText(Value, srmMinimal);
- end;
- procedure TScintEdit.SetRawSelText(const Value: TScintRawString);
- { Replaces the main selection's text and *clears* additional selections }
- begin
- Call(SCI_REPLACESEL, 0, Value);
- end;
- procedure TScintEdit.SetRawText(const Value: TScintRawString);
- begin
- { Workaround: Without this call, if the caret is on line 0 and out in
- virtual space, it'll remain in virtual space after the replacement }
- Call(SCI_CLEARSELECTIONS, 0, 0);
- { Using ReplaceRawTextRange instead of SCI_SETTEXT for embedded null support }
- ReplaceRawTextRange(0, GetRawTextLength, Value);
- ChooseCaretX;
- end;
- procedure TScintEdit.SetReadOnly(const Value: Boolean);
- begin
- Call(SCI_SETREADONLY, Ord(Value), 0);
- end;
- procedure TScintEdit.SetSavePoint;
- begin
- if FForceModified then begin
- FForceModified := False;
- if Assigned(FOnModifiedChange) then
- FOnModifiedChange(Self);
- end;
- Call(SCI_SETSAVEPOINT, 0, 0);
- end;
- procedure TScintEdit.SetSelection(const Value: TScintRange);
- { Sets the main selection and removes additional selections. Very similar
- to SetSingleSelection, not sure why both messages exist and are slightly
- different }
- begin
- Call(SCI_SETSEL, Value.StartPos, Value.EndPos);
- end;
- procedure TScintEdit.SetSelectionAnchorPosition(Selection: Integer;
- const Value: Integer);
- { Also sets anchors's virtual space to 0 }
- begin
- Call(SCI_SETSELECTIONNANCHOR, Selection, Value);
- end;
- procedure TScintEdit.SetSelectionAnchorVirtualSpace(Selection: Integer;
- const Value: Integer);
- begin
- Call(SCI_SETSELECTIONNANCHORVIRTUALSPACE, Selection, Value);
- end;
- procedure TScintEdit.SetSelectionCaretPosition(Selection: Integer;
- const Value: Integer);
- { Also sets caret's virtual space to 0 }
- begin
- Call(SCI_SETSELECTIONNCARET, Selection, Value);
- end;
- procedure TScintEdit.SetSelectionCaretVirtualSpace(Selection: Integer;
- const Value: Integer);
- begin
- Call(SCI_SETSELECTIONNCARETVIRTUALSPACE, Selection, Value);
- end;
- procedure TScintEdit.SetSelectionMode(const Value: TScintSelectionMode);
- begin
- var Mode: Integer;
- if Value = ssmStream then
- Mode := SC_SEL_STREAM
- else if Value = ssmRectangular then
- Mode := SC_SEL_RECTANGLE
- else if Value = ssmLines then
- Mode := SC_SEL_LINES
- else
- Mode := SC_SEL_THIN;
- { Note this uses *CHANGE* and not *SET* }
- Call(SCI_CHANGESELECTIONMODE, Mode, 0);
- end;
- procedure TScintEdit.SetSelText(const Value: String);
- begin
- SetRawSelText(ConvertStringToRawString(Value));
- end;
- procedure TScintEdit.SetSingleSelection(const CaretPos, AnchorPos: Integer);
- { Sets the main selection and removes additional selections without scrolling
- the caret into view }
- begin
- Call(SCI_SETSELECTION, CaretPos, AnchorPos);
- end;
- procedure TScintEdit.SetStyler(const Value: TScintCustomStyler);
- begin
- if FStyler <> Value then begin
- if Assigned(Value) then
- Value.FreeNotification(Self);
- FStyler := Value;
- if HandleAllocated then begin
- Call(SCI_CLEARDOCUMENTSTYLE, 0, 0);
- Call(SCI_STARTSTYLING, 0, 0);
- UpdateStyleAttributes;
- end;
- end;
- end;
- procedure TScintEdit.SetTabWidth(const Value: Integer);
- begin
- if (FTabWidth <> Value) and (Value > 0) and (Value < 100) then begin
- FTabWidth := Value;
- ApplyOptions;
- end;
- end;
- procedure TScintEdit.SetTarget(const StartPos, EndPos: Integer);
- begin
- Call(SCI_SETTARGETSTART, StartPos, 0);
- Call(SCI_SETTARGETEND, EndPos, 0);
- end;
- procedure TScintEdit.SetTopLine(const Value: Integer);
- begin
- Call(SCI_SETFIRSTVISIBLELINE, Value, 0);
- end;
- procedure TScintEdit.SetUseStyleAttributes(const Value: Boolean);
- begin
- if FUseStyleAttributes <> Value then begin
- FUseStyleAttributes := Value;
- UpdateStyleAttributes;
- end;
- end;
- procedure TScintEdit.SetUseTabCharacter(const Value: Boolean);
- begin
- if FUseTabCharacter <> Value then begin
- FUseTabCharacter := Value;
- ApplyOptions;
- end;
- end;
- procedure TScintEdit.SetVirtualSpaceOptions(const Value: TScintVirtualSpaceOptions);
- begin
- if FVirtualSpaceOptions <> Value then begin
- FVirtualSpaceOptions := Value;
- ApplyOptions;
- end;
- end;
- procedure TScintEdit.SetWordChars(const S: AnsiString);
- begin
- FWordChars := S;
- FWordCharsAsSet := [];
- for var C in S do
- Include(FWordCharsAsSet, C);
- Call(SCI_SETWORDCHARS, 0, S);
- end;
- procedure TScintEdit.SetWordWrap(const Value: Boolean);
- begin
- if FWordWrap <> Value then begin
- FWordWrap := Value;
- ApplyOptions;
- end;
- end;
- procedure TScintEdit.SetZoom(const Value: Integer);
- begin
- Call(SCI_SETZOOM, Value, 0);
- end;
- procedure TScintEdit.ShowAutoComplete(const CharsEntered: Integer;
- const WordList: AnsiString);
- begin
- Call(SCI_AUTOCSHOW, CharsEntered, WordList);
- end;
- procedure TScintEdit.ShowCallTip(const Pos: Integer;
- const Definition: AnsiString);
- begin
- Call(SCI_CALLTIPSHOW, Pos, Definition);
- end;
- procedure TScintEdit.StyleNeeded(const EndPos: Integer);
- function CalcCaretIndex(const FirstLine, LastLine: Integer): Integer;
- var
- CaretPos, StartPos, EndPos: Integer;
- begin
- Result := 0;
- if FReportCaretPositionToStyler then begin
- CaretPos := GetCaretPosition;
- StartPos := GetPositionFromLine(FirstLine);
- EndPos := GetLineEndPosition(LastLine);
- if (CaretPos >= StartPos) and (CaretPos <= EndPos) then
- Result := CaretPos - StartPos + 1;
- end;
- end;
- procedure MaskDoubleByteCharacters(var S: TScintRawString);
- var
- Len, I: Integer;
- begin
- { This replaces all lead and trail bytes in S with #$80 and #$81 to
- ensure that stylers do not mistake trail bytes for single-byte ASCII
- characters (e.g. #131'A' is a valid combination on CP 932). }
- if not FEffectiveCodePageDBCS then
- Exit;
- Len := Length(S);
- I := 1;
- while I <= Len do begin
- if S[I] in FLeadBytes then begin
- S[I] := #$80;
- if I < Len then begin
- Inc(I);
- S[I] := #$81;
- end;
- end;
- Inc(I);
- end;
- end;
- function LineSpans(const Line: Integer): Boolean;
- var
- S: TScintRawString;
- begin
- S := FLines.RawLines[Line];
- MaskDoubleByteCharacters(S);
- Result := FStyler.LineTextSpans(S);
- end;
- function StyleLine(const FirstLine: Integer; const StartStylingPos: Integer): Integer;
- begin
- { Find final line in series of spanned lines }
- var LastLine := FirstLine;
- while (LastLine < Lines.Count - 1) and LineSpans(LastLine) do
- Inc(LastLine);
- { We don't pass line endings to the styler, because when the style of a
- line ending changes, Scintilla assumes it must be a 'hanging' style and
- immediately repaints all subsequent lines. (To see this in the IS IDE,
- insert and remove a ';' character before a [Setup] directive, i.e.
- toggle comment styling.) }
- FStyler.FCaretIndex := CalcCaretIndex(FirstLine, LastLine);
- FStyler.FCurIndex := 1;
- FStyler.FStyleStartIndex := 1;
- FStyler.FLineState := 0;
- if FirstLine > 0 then
- FStyler.FLineState := FLines.GetState(FirstLine-1);
- FStyler.FText := GetRawTextRange(GetPositionFromLine(FirstLine),
- GetLineEndPosition(LastLine));
- MaskDoubleByteCharacters(FStyler.FText);
- FStyler.FTextLen := Length(FStyler.FText);
- FStyler.FStyleStr := StringOfChar(AnsiChar(0), FStyler.FTextLen +
- FLines.GetLineEndingLength(LastLine));
- var PreviousLineState := FStyler.LineState;
- FStyler.StyleNeeded;
- var N := Length(FStyler.FStyleStr);
- if N > 0 then begin
- var HadStyleByteIndicators := False;
- { Apply style byte indicators. Add first as INDICATOR_CONTAINER and so on. }
- for var Indicator := 0 to High(TScintStyleByteIndicatorNumber) do begin
- var PrevI := 1;
- var PrevValue := Indicator in TScintStyleByteIndicatorNumbers(Byte(Ord(FStyler.FStyleStr[1]) shr StyleNumberBits));
- for var CurI := 2 to N do begin
- var CurValue := Indicator in TScintStyleByteIndicatorNumbers(Byte(Ord(FStyler.FStyleStr[CurI]) shr StyleNumberBits));
- if CurValue <> PrevValue then begin
- SetIndicators(StartStylingPos+PrevI-1, StartStylingPos+CurI-1, Ord(Indicator)+INDICATOR_CONTAINER, PrevValue);
- HadStyleByteIndicators := HadStyleByteIndicators or PrevValue;
- PrevI := CurI;
- PrevValue := CurValue;
- end;
- end;
- SetIndicators(StartStylingPos+PrevI-1, StartStylingPos+N, Ord(Indicator)+INDICATOR_CONTAINER, PrevValue);
- HadStyleByteIndicators := HadStyleByteIndicators or PrevValue;
- end;
- { Apply styles after removing any style byte indicators }
- if HadStyleByteIndicators then
- for var I := 1 to N do
- FStyler.FStyleStr[I] := AnsiChar(Ord(FStyler.FStyleStr[I]) and StyleNumberMask);
- Call(SCI_SETSTYLINGEX, Length(FStyler.FStyleStr), FStyler.FStyleStr);
- FStyler.FStyleStr := '';
- FStyler.FText := '';
- end;
- { Get fold level }
- var LineState := FStyler.LineState;
- var FoldLevel: Integer;
- var FoldHeader, EnableFoldHeaderOnPrevious: Boolean;
- FStyler.GetFoldLevel(LineState, PreviousLineState, FoldLevel, FoldHeader, EnableFoldHeaderOnPrevious);
- Inc(FoldLevel, SC_FOLDLEVELBASE);
- if FoldHeader then
- FoldLevel := FoldLevel or SC_FOLDLEVELHEADERFLAG;
- { Apply line state and fold level }
- for var I := FirstLine to LastLine do begin
- var OldState := FLines.GetState(I);
- if FStyler.FLineState <> OldState then
- Call(SCI_SETLINESTATE, I, FStyler.FLineState);
- var OldLevel := Call(SCI_GETFOLDLEVEL, I, 0);
- var NewLevel := FoldLevel;
- { Setting SC_FOLDLEVELWHITEFLAG on empty lines causes a problem: when
- Scintilla auto expands a contracted section (for example after removing ']'
- from a section header) all the empty lines stay invisible, even any which
- are in the middle of the section. See https://sourceforge.net/p/scintilla/bugs/2442/ }
- //if FLines.GetRawLineLength(I) = 0 then
- // NewLevel := NewLevel or SC_FOLDLEVELWHITEFLAG;
- if NewLevel <> OldLevel then
- Call(SCI_SETFOLDLEVEL, I, NewLevel);
- end;
- { Retroactively set header on previous line if requested to do so. Must be
- *after* the loop above. Not sure why. Problem reproduction: move code above
- the loop, run it, open Debug.iss, change [Setup] to [Set up] and notice
- styling of the [Languages] section below it is now broken. If you turn on
- sffLevelNumbers you will also see that the first entry in that section got
- a header flag. }
- if (FirstLine > 0) and EnableFoldHeaderOnPrevious then begin
- var PreviousLine := FirstLine-1;
- var OldLevel := Call(SCI_GETFOLDLEVEL, PreviousLine, 0);
- var NewLevel := OldLevel or SC_FOLDLEVELHEADERFLAG;
- if NewLevel <> OldLevel then
- Call(SCI_SETFOLDLEVEL, PreviousLine, NewLevel);
- end;
- Result := LastLine;
- end;
- procedure DefaultStyleLine(const Line: Integer);
- var
- StyleStr: AnsiString;
- begin
- { Note: Using SCI_SETSTYLINGEX because it only redraws the part of the
- range that changed, whereas SCI_SETSTYLING redraws the entire range. }
- StyleStr := StringOfChar(AnsiChar(0), FLines.GetRawLineLengthWithEnding(Line));
- Call(SCI_SETSTYLINGEX, Length(StyleStr), StyleStr);
- end;
- var
- StartPos, StartLine, EndLine, Line: Integer;
- begin
- StartPos := Call(SCI_GETENDSTYLED, 0, 0);
- StartLine := GetLineFromPosition(StartPos);
- { EndPos (always?) points to the position *after* the last character of the
- last line needing styling (usually an LF), so subtract 1 to avoid
- restyling one extra line unnecessarily.
- But don't do this if we're being asked to style all the way to the end.
- When the document's last line is empty, 'EndPos - 1' will point to the
- line preceding the last line, so StyleLine() will never be called on the
- last line, and it will never be assigned a LINESTATE. This causes IS's
- autocompletion to think the last line's section is scNone. }
- if EndPos < GetRawTextLength then
- EndLine := GetLineFromPosition(EndPos - 1)
- else
- EndLine := GetLineFromPosition(EndPos);
- //outputdebugstring('-----');
- //outputdebugstring(pchar(format('StyleNeeded poses: %d, %d', [StartPos, EndPos])));
- //outputdebugstring(pchar(format('StyleNeeded lines: %d, %d', [StartLine, EndLine])));
- { If StartLine is within a series of spanned lines, back up }
- if Assigned(FStyler) then
- while (StartLine > 0) and (LineSpans(StartLine - 1)) do
- Dec(StartLine);
- Line := StartLine;
- while Line <= EndLine do begin
- var StartStylingPos := GetPositionFromLine(Line);
- Call(SCI_STARTSTYLING, StartStylingPos, 0);
- if Assigned(FStyler) then
- Line := StyleLine(Line, StartStylingPos)
- else
- DefaultStyleLine(Line);
- Inc(Line);
- end;
- end;
- procedure TScintEdit.SysColorChange(const Message: TMessage);
- begin
- ForwardMessage(Message);
- end;
- function TScintEdit.TestRawRegularExpression(const S: TScintRawString): Boolean;
- { Example invalid regular expression: ( }
- begin
- Call(SCI_SETTARGETRANGE, 0, 0);
- Call(SCI_SETSEARCHFLAGS, GetSearchFlags([sfoRegEx]), 0);
- var WarnStatus: Integer;
- var Res := Call(SCI_SEARCHINTARGET, Length(S), S, WarnStatus);
- Result := not ((Res = -1) and (WarnStatus = SC_STATUS_WARN_REGEX));
- end;
- function TScintEdit.TestRegularExpression(const S: String): Boolean;
- begin
- Result := TestRawRegularExpression(ConvertStringToRawString(S));
- end;
- procedure TScintEdit.Undo;
- begin
- Call(SCI_UNDO, 0, 0);
- end;
- procedure TScintEdit.UpdateCodePage;
- procedure InitLeadBytes;
- var
- Info: TCPInfo;
- I: Integer;
- J: Byte;
- begin
- FLeadBytes := [];
- if FEffectiveCodePageDBCS and GetCPInfo(FEffectiveCodePage, Info) then begin
- I := 0;
- while (I < MAX_LEADBYTES) and ((Info.LeadByte[I] or Info.LeadByte[I+1]) <> 0) do begin
- for J := Info.LeadByte[I] to Info.LeadByte[I+1] do
- Include(FLeadBytes, AnsiChar(J));
- Inc(I, 2);
- end;
- end;
- end;
- var
- CP: Integer;
- begin
- if HandleAllocated then begin
- { To Scintilla, code page 0 does not mean the current ANSI code page, but
- an unspecified single byte code page. So that DBCS support is properly
- enabled when running on a DBCS ANSI code page, replace 0 with GetACP. }
- CP := FCodePage;
- if CP = 0 then
- CP := GetACP;
- Call(SCI_SETCODEPAGE, CP, 0);
- { Scintilla ignores attempts to set a code page it has no special support
- for. But the editor could currently be set for UTF-8 or DBCS, so get it
- out of that mode by setting the code page to 0 (a value it does
- recognize). }
- if Call(SCI_GETCODEPAGE, 0, 0) <> CP then
- Call(SCI_SETCODEPAGE, 0, 0);
- FEffectiveCodePage := Call(SCI_GETCODEPAGE, 0, 0);
- FEffectiveCodePageDBCS := (FEffectiveCodePage <> 0) and
- (FEffectiveCodePage <> SC_CP_UTF8);
- InitLeadBytes;
- end;
- end;
- procedure TScintEdit.UpdateLineNumbersWidth;
- var
- LineCount, PixelWidth: Integer;
- Nines: String;
- begin
- if FLineNumbers or FFoldLevelNumbersOrLineState then begin
- { Note: Based on SciTE's SciTEBase::SetLineNumberWidth. }
- if FFoldLevelNumbersOrLineState then
- Nines := StringOfChar('9', 12)
- else begin
- LineCount := Call(SCI_GETLINECOUNT, 0, 0);
- Nines := '9';
- while LineCount >= 10 do begin
- LineCount := LineCount div 10;
- Nines := Nines + '9';
- end;
- end;
- PixelWidth := 4 + Call(SCI_TEXTWIDTH, STYLE_LINENUMBER, AnsiString(Nines));
- end else
- PixelWidth := 0;
-
- Call(SCI_SETMARGINWIDTHN, 0, PixelWidth);
- end;
- procedure TScintEdit.UpdateStyleAttributes;
- var
- DefaultAttr: TScintStyleAttributes;
- procedure SetStyleAttr(const StyleNumber: Integer;
- const Attr: TScintStyleAttributes; const Force: Boolean);
- begin
- if Force or (Attr.FontName <> DefaultAttr.FontName) then
- Call(SCI_STYLESETFONT, StyleNumber, AnsiString(Attr.FontName));
- if Force or (Attr.FontSize <> DefaultAttr.FontSize) then
- { Note: Scintilla doesn't support negative point sizes like the VCL }
- Call(SCI_STYLESETSIZE, StyleNumber, Abs(Attr.FontSize));
- if Force or (Attr.FontCharset <> DefaultAttr.FontCharset) then
- Call(SCI_STYLESETCHARACTERSET, StyleNumber, Attr.FontCharset);
- if Force or (Attr.FontStyle <> DefaultAttr.FontStyle) then begin
- Call(SCI_STYLESETBOLD, StyleNumber, Ord(fsBold in Attr.FontStyle));
- Call(SCI_STYLESETITALIC, StyleNumber, Ord(fsItalic in Attr.FontStyle));
- Call(SCI_STYLESETUNDERLINE, StyleNumber, Ord(fsUnderline in Attr.FontStyle));
- end;
- if Force or (Attr.ForeColor <> DefaultAttr.ForeColor) then
- Call(SCI_STYLESETFORE, StyleNumber, ColorToRGB(Attr.ForeColor));
- if Force or (Attr.BackColor <> DefaultAttr.BackColor) then
- Call(SCI_STYLESETBACK, StyleNumber, ColorToRGB(Attr.BackColor));
- end;
- procedure SetStyleAttrFromStyler(const StyleNumber: Integer);
- var
- Attr: TScintStyleAttributes;
- begin
- Attr := DefaultAttr;
- FStyler.GetStyleAttributes(StyleNumber, Attr);
- SetStyleAttr(StyleNumber, Attr, False);
- end;
- var
- I: Integer;
- begin
- if not HandleAllocated then
- Exit;
- Call(SCI_SETCARETFORE, ColorToRGB(Font.Color), 0);
- DefaultAttr.FontName := Font.Name;
- DefaultAttr.FontSize := Font.Size;
- DefaultAttr.FontStyle := Font.Style;
- DefaultAttr.FontCharset := Font.Charset;
- DefaultAttr.ForeColor := Font.Color;
- DefaultAttr.BackColor := Color;
- Call(SCI_STYLERESETDEFAULT, 0, 0);
- SetStyleAttr(STYLE_DEFAULT, DefaultAttr, True);
- Call(SCI_STYLECLEARALL, 0, 0);
- if Assigned(FStyler) then begin
- if FUseStyleAttributes then begin
- for I := 0 to StyleNumbers-1 do
- SetStyleAttrFromStyler(I);
- SetStyleAttrFromStyler(STYLE_BRACEBAD);
- SetStyleAttrFromStyler(STYLE_BRACELIGHT);
- SetStyleAttrFromStyler(STYLE_INDENTGUIDE);
- end;
- SetStyleAttrFromStyler(STYLE_LINENUMBER);
- end;
- if (AutoCompleteFontName <> '') or (AutoCompleteFontSize > 0) then begin
- if AutoCompleteFontName <> '' then
- DefaultAttr.FontName := AutoCompleteFontName;
- if AutoCompleteFontSize > 0 then
- DefaultAttr.FontSize := AutoCompleteFontSize;
- DefaultAttr.FontStyle := [];
- { Note: Scintilla doesn't actually use the colors set here }
- DefaultAttr.ForeColor := clWindowText;
- DefaultAttr.BackColor := clWindow;
- if FAutoCompleteStyle = 0 then
- FAutoCompleteStyle := Call(SCI_ALLOCATEEXTENDEDSTYLES, 1, 0);
- SetStyleAttr(FAutoCompleteStyle, DefaultAttr, True);
- Call(SCI_AUTOCSETSTYLE, FAutoCompleteStyle, 0);
- end else
- Call(SCI_AUTOCSETSTYLE, 0, 0);
- end;
- function TScintEdit.WordAtCaret: String;
- begin
- var Range := WordAtCaretRange;
- Result := GetTextRange(Range.StartPos, Range.EndPos);
- end;
- function TScintEdit.WordAtCaretRange: TScintRange;
- begin
- var Pos := GetCaretPosition;
- Result.StartPos := GetWordStartPosition(Pos, True);
- Result.EndPos := GetWordEndPosition(Pos, True);
- end;
- procedure TScintEdit.ZoomIn;
- begin
- Call(SCI_ZOOMIN, 0, 0);
- end;
- procedure TScintEdit.ZoomOut;
- begin
- Call(SCI_ZOOMOUT, 0, 0);
- end;
- procedure TScintEdit.CMColorChanged(var Message: TMessage);
- begin
- inherited;
- UpdateStyleAttributes;
- end;
- procedure TScintEdit.CMFontChanged(var Message: TMessage);
- begin
- inherited;
- UpdateStyleAttributes;
- end;
- procedure TScintEdit.CMHintShow(var Message: TCMHintShow);
- begin
- inherited;
- if Assigned(FOnHintShow) then
- FOnHintShow(Self, Message.HintInfo^);
- end;
- procedure TScintEdit.CMSysColorChange(var Message: TMessage);
- begin
- inherited;
- UpdateStyleAttributes;
- end;
- procedure TScintEdit.CNNotify(var Message: TWMNotify);
- begin
- Notify(PSCNotification(Message.NMHdr)^);
- end;
- procedure TScintEdit.WMDestroy(var Message: TWMDestroy);
- begin
- FDirectPtr := nil;
- FDirectStatusFunction := nil;
- inherited;
- end;
- procedure TScintEdit.DpiChanged(const Message: TMessage);
- begin
- ForwardMessage(Message);
- end;
- procedure TScintEdit.WMDropFiles(var Message: TWMDropFiles);
- var
- FileList: TStringList;
- NumFiles, I: Integer;
- Filename: array[0..MAX_PATH-1] of Char;
- P: TPoint;
- begin
- FileList := nil;
- try
- if FAcceptDroppedFiles and Assigned(FOnDropFiles) then begin
- FileList := TStringList.Create;
- NumFiles := DragQueryFile(Message.Drop, UINT(-1), nil, 0);
- for I := 0 to NumFiles-1 do
- if DragQueryFile(Message.Drop, I, Filename,
- SizeOf(Filename) div SizeOf(Filename[0])) <> 0 then
- FileList.Add(Filename);
- if FileList.Count > 0 then begin
- if not DragQueryPoint(Message.Drop, P) then begin
- P.X := -1;
- P.Y := -1;
- end;
- FOnDropFiles(Self, P.X, P.Y, FileList);
- end;
- end;
- finally
- FileList.Free;
- DragFinish(Message.Drop);
- Message.Drop := 0;
- end;
- end;
- procedure TScintEdit.WMEraseBkgnd(var Message: TMessage);
- begin
- { Bypass the VCL's WM_ERASEBKGND handler; it causes flicker when selecting +
- scrolling downward using the mouse }
- Message.Result := CallWindowProc(DefWndProc, Handle, Message.Msg,
- Message.WParam, Message.LParam);
- end;
- procedure TScintEdit.WMGetDlgCode(var Message: TWMGetDlgCode);
- begin
- inherited;
- Message.Result := Message.Result or (DLGC_WANTARROWS or DLGC_WANTTAB);
- end;
- procedure TScintEdit.WMMouseWheel(var Message: TMessage);
- begin
- { Bypass TControl's broken WM_MOUSEWHEEL handler: it translates WParamLo
- from a combination of MK_* values to a TShiftState -- which is only
- meaningful to the VCL -- but it doesn't restore the original value before
- passing an unhandled WM_MOUSEWHEEL message up to DefWndProc. This causes
- Scintilla to see Ctrl+wheel as Shift+wheel, breaking zoom. (Observed on
- Delphi 2009 and still needed in Delphi 11.3.) }
- Message.Result := CallWindowProc(DefWndProc, Handle, Message.Msg,
- Message.WParam, Message.LParam);
- end;
- procedure TScintEdit.SettingChange(const Message: TMessage);
- begin
- ForwardMessage(Message);
- end;
- { TScintEditStrings }
- procedure TScintEditStrings.CheckIndexRange(const Index: Integer);
- begin
- if (Index < 0) or (Index >= GetCount) then
- Error(SListIndexError, Index);
- end;
- procedure TScintEditStrings.CheckIndexRangePlusOne(const Index: Integer);
- begin
- if (Index < 0) or (Index > GetCount) then
- Error(SListIndexError, Index);
- end;
- procedure TScintEditStrings.Clear;
- begin
- FEdit.SetRawText('');
- end;
- procedure TScintEditStrings.Delete(Index: Integer);
- var
- StartPos, EndPos: Integer;
- begin
- CheckIndexRange(Index);
- StartPos := FEdit.GetPositionFromLine(Index);
- EndPos := FEdit.GetPositionFromLine(Index + 1);
- FEdit.ReplaceRawTextRange(StartPos, EndPos, '');
- end;
- function TScintEditStrings.Get(Index: Integer): String;
- begin
- Result := FEdit.ConvertRawStringToString(GetRawLine(Index));
- end;
- function TScintEditStrings.GetCount: Integer;
- begin
- Result := FEdit.Call(SCI_GETLINECOUNT, 0, 0);
- end;
- function TScintEditStrings.GetLineEndingLength(const Index: Integer): Integer;
- var
- StartPos, EndPos: Integer;
- begin
- CheckIndexRange(Index);
- StartPos := FEdit.GetLineEndPosition(Index);
- EndPos := FEdit.GetPositionFromLine(Index + 1);
- Result := EndPos - StartPos;
- end;
- function TScintEditStrings.GetRawLine(Index: Integer): TScintRawString;
- var
- StartPos, EndPos: Integer;
- begin
- CheckIndexRange(Index);
- StartPos := FEdit.GetPositionFromLine(Index);
- EndPos := FEdit.GetLineEndPosition(Index);
- Result := FEdit.GetRawTextRange(StartPos, EndPos);
- end;
- function TScintEditStrings.GetRawLineLength(Index: Integer): Integer;
- var
- StartPos, EndPos: Integer;
- begin
- CheckIndexRange(Index);
- StartPos := FEdit.GetPositionFromLine(Index);
- EndPos := FEdit.GetLineEndPosition(Index);
- Result := EndPos - StartPos;
- end;
- function TScintEditStrings.GetRawLineLengthWithEnding(Index: Integer): Integer;
- var
- StartPos, EndPos: Integer;
- begin
- CheckIndexRange(Index);
- StartPos := FEdit.GetPositionFromLine(Index);
- EndPos := FEdit.GetPositionFromLine(Index + 1);
- Result := EndPos - StartPos;
- end;
- function TScintEditStrings.GetRawLineWithEnding(Index: Integer): TScintRawString;
- var
- StartPos, EndPos: Integer;
- begin
- CheckIndexRange(Index);
- StartPos := FEdit.GetPositionFromLine(Index);
- EndPos := FEdit.GetPositionFromLine(Index + 1);
- Result := FEdit.GetRawTextRange(StartPos, EndPos);
- end;
- function TScintEditStrings.GetState(Index: Integer): TScintLineState;
- begin
- CheckIndexRange(Index);
- Result := FEdit.Call(SCI_GETLINESTATE, Index, 0);
- end;
- function TScintEditStrings.GetTextStr: String;
- begin
- Result := FEdit.ConvertRawStringToString(FEdit.GetRawText);
- end;
- procedure TScintEditStrings.Insert(Index: Integer; const S: String);
- begin
- InsertRawLine(Index, FEdit.ConvertStringToRawString(S));
- end;
- procedure TScintEditStrings.InsertRawLine(Index: Integer; const S: TScintRawString);
- var
- Pos: Integer;
- EndingStr, InsertStr: TScintRawString;
- begin
- CheckIndexRangePlusOne(Index);
- EndingStr := FEdit.GetLineEndingString;
- Pos := FEdit.GetPositionFromLine(Index);
- if (Index = GetCount) and (Pos <> FEdit.GetPositionFromLine(Index - 1)) then
- InsertStr := EndingStr + S + EndingStr
- else
- InsertStr := S + EndingStr;
- { Using ReplaceRawTextRange instead of SCI_INSERTTEXT for embedded null support }
- FEdit.ReplaceRawTextRange(Pos, Pos, InsertStr);
- end;
- procedure TScintEditStrings.Put(Index: Integer; const S: String);
- begin
- PutRawLine(Index, FEdit.ConvertStringToRawString(S));
- end;
- procedure TScintEditStrings.PutRawLine(Index: Integer; const S: TScintRawString);
- var
- StartPos, EndPos: Integer;
- begin
- CheckIndexRange(Index);
- StartPos := FEdit.GetPositionFromLine(Index);
- EndPos := FEdit.GetLineEndPosition(Index);
- FEdit.ReplaceRawTextRange(StartPos, EndPos, S, srmMinimal);
- end;
- procedure TScintEditStrings.SetText(Text: PChar);
- begin
- FEdit.SetRawText(FEdit.ConvertPCharToRawString(Text, StrLen(Text)));
- end;
- procedure TScintEditStrings.SetTextStr(const Value: String);
- begin
- FEdit.SetRawText(FEdit.ConvertStringToRawString(Value));
- end;
- { TScintCustomStyler }
- procedure TScintCustomStyler.ApplyStyleByteIndicators(const Indicators: TScintStyleByteIndicatorNumbers;
- StartIndex, EndIndex: Integer);
- begin
- var IndByte := Byte(Indicators) shl StyleNumberBits;
- if IndByte <> 0 then begin
- if StartIndex < 1 then
- StartIndex := 1;
- if EndIndex > FTextLen then
- EndIndex := FTextLen;
- for var I := StartIndex to EndIndex do
- FStyleStr[I] := AnsiChar(Ord(FStyleStr[I]) or IndByte);
- end;
- end;
- procedure TScintCustomStyler.ApplyStyle(const Style: TScintStyleNumber;
- StartIndex, EndIndex: Integer);
- begin
- if StartIndex < 1 then
- StartIndex := 1;
- if EndIndex > FTextLen then
- EndIndex := FTextLen;
- for var I := StartIndex to EndIndex do
- if Ord(FStyleStr[I]) and StyleNumberMask = 0 then
- FStyleStr[I] := AnsiChar(Style or (Ord(FStyleStr[I]) and not StyleNumberMask));
- end;
- procedure TScintCustomStyler.CommitStyle(const Style: TScintStyleNumber);
- begin
- ApplyStyle(Style, FStyleStartIndex, FCurIndex - 1);
- FStyleStartIndex := FCurIndex;
- end;
- function TScintCustomStyler.ConsumeAllRemaining: Boolean;
- begin
- Result := FCurIndex <= FTextLen;
- if Result then
- FCurIndex := FTextLen + 1;
- end;
- function TScintCustomStyler.ConsumeChar(const C: AnsiChar): Boolean;
- begin
- Result := (FCurIndex <= FTextLen) and (FText[FCurIndex] = C);
- if Result then
- Inc(FCurIndex);
- end;
- function TScintCustomStyler.ConsumeCharIn(const Chars: TScintRawCharSet): Boolean;
- begin
- Result := (FCurIndex <= FTextLen) and (FText[FCurIndex] in Chars);
- if Result then
- Inc(FCurIndex);
- end;
- function TScintCustomStyler.ConsumeChars(const Chars: TScintRawCharSet): Boolean;
- begin
- Result := False;
- while FCurIndex <= FTextLen do begin
- if not(FText[FCurIndex] in Chars) then
- Break;
- Result := True;
- Inc(FCurIndex);
- end;
- end;
- function TScintCustomStyler.ConsumeCharsNot(const Chars: TScintRawCharSet): Boolean;
- begin
- Result := False;
- while FCurIndex <= FTextLen do begin
- if FText[FCurIndex] in Chars then
- Break;
- Result := True;
- Inc(FCurIndex);
- end;
- end;
- function TScintCustomStyler.ConsumeString(const Chars: TScintRawCharSet): TScintRawString;
- var
- StartIndex: Integer;
- begin
- StartIndex := FCurIndex;
- ConsumeChars(Chars);
- Result := Copy(FText, StartIndex, FCurIndex - StartIndex);
- end;
- function TScintCustomStyler.CurCharIn(const Chars: TScintRawCharSet): Boolean;
- begin
- Result := (FCurIndex <= FTextLen) and (FText[FCurIndex] in Chars);
- end;
- function TScintCustomStyler.CurCharIs(const C: AnsiChar): Boolean;
- begin
- Result := (FCurIndex <= FTextLen) and (FText[FCurIndex] = C);
- end;
- function TScintCustomStyler.GetCurChar: AnsiChar;
- begin
- Result := #0;
- if FCurIndex <= FTextLen then
- Result := FText[FCurIndex];
- end;
- function TScintCustomStyler.GetEndOfLine: Boolean;
- begin
- Result := FCurIndex > FTextLen;
- end;
- function TScintCustomStyler.LineTextSpans(const S: TScintRawString): Boolean;
- begin
- Result := False;
- end;
- function TScintCustomStyler.NextCharIs(const C: AnsiChar): Boolean;
- begin
- Result := (FCurIndex < FTextLen) and (FText[FCurIndex+1] = C);
- end;
- function TScintCustomStyler.PreviousCharIn(const Chars: TScintRawCharSet): Boolean;
- begin
- Result := (FCurIndex > 1) and (FCurIndex-1 <= FTextLen) and
- (FText[FCurIndex-1] in Chars);
- end;
- procedure TScintCustomStyler.ReplaceText(StartIndex, EndIndex: Integer;
- const C: AnsiChar);
- var
- P: PAnsiChar;
- I: Integer;
- begin
- if StartIndex < 1 then
- StartIndex := 1;
- if EndIndex > FTextLen then
- EndIndex := FTextLen;
- P := @FText[1];
- for I := StartIndex to EndIndex do
- P[I-1] := C;
- end;
- procedure TScintCustomStyler.ResetCurIndexTo(Index: Integer);
- begin
- FCurIndex := Index;
- FStyleStartIndex := Index;
- end;
- { TScintPixmap }
- const
- XPMTransparentChar = ' ';
- XPMTerminatorChar = '"';
- class constructor TScintPixmap.Create;
- begin
- { Chars 128-255 are supported below but don't work in Scintilla }
- for var C := #1 to #127 do
- if (C <> XPMTransparentChar) and (C <> XPMTerminatorChar) then
- ColorCodes := ColorCodes + C;
- end;
- function TScintPixmap.GetPixmap: Pointer;
- begin
- Result := FPixmap;
- end;
- type
- TRGBTripleArray = array[0..MaxInt div SizeOf(TRGBTriple) - 1] of TRGBTriple;
- PRGBTripleArray = ^TRGBTripleArray;
- procedure TScintPixmap.InitializeFromBitmap(const ABitmap: TBitmap;
- const TransparentColor: TColorRef);
- procedure SetNextPixmapLine(const Pixmap: TPixmap; var Index: Integer; const Line: String);
- begin
- if Index > High(Pixmap) then
- TScintEdit.Error('SetNextPixmapLine: Index out of range');
- { Convert Line to an AnsiString, but copy the exact ordinal values;
- i.e. don't do any translation of 128-255 }
- var AnsiLine: AnsiString;
- SetLength(AnsiLine, Length(Line));
- for var I := 1 to Length(AnsiLine) do
- AnsiLine[I] := AnsiChar(Ord(Line[I]));
- Pixmap[Index] := AnsiLine;
- Inc(Index);
- end;
- begin
- if ABitmap.PixelFormat <> pf24bit then
- TScintEdit.Error('Invalid PixelFormat');
- var Colors := TDictionary<Integer, TPair<Char, String>>.Create; { RGB -> Code & WebColor }
- try
- { Build colors list }
- for var Y := 0 to ABitmap.Height-1 do begin
- var Pixels: PRGBTripleArray := ABitmap.ScanLine[Y];
- for var X := 0 to ABitmap.Width-1 do begin
- var Color := RGB(Pixels[X].rgbtRed, Pixels[X].rgbtGreen, Pixels[X].rgbtBlue);
- if (Color <> TransparentColor) and not Colors.ContainsKey(Color) then begin
- var ColorCodeIndex := Colors.Count+1;
- if ColorCodeIndex > Length(ColorCodes) then
- TScintEdit.Error('Too many colors');
- Colors.Add(Color, TPair<Char, String>.Create(ColorCodes[ColorCodeIndex], RGBToWebColorStr(Color)))
- end;
- end;
- end;
- { Build pixmap }
- var Line: String;
- SetLength(FPixmap, 0); { Not really needed but makes things clearer while debugging }
- SetLength(FPixmap, 1 + Colors.Count + ABitmap.Height + 1);
- Line := Format('%d %d %d 1', [ABitmap.Width, ABitmap.Height, Colors.Count]);
- var Index := 0;
- SetNextPixmapLine(FPixmap, Index, Line);
- for var Color in Colors do begin
- Line := Format('%s c %s', [Color.Value.Key, Color.Value.Value]);
- SetNextPixmapLine(FPixmap, Index, Line);
- end;
- for var Y := 0 to ABitmap.Height-1 do begin
- Line := '';
- var Pixels: PRGBTripleArray := ABitmap.ScanLine[Y];
- for var X := 0 to ABitmap.Width-1 do begin
- var Color := RGB(Pixels[X].rgbtRed, Pixels[X].rgbtGreen, Pixels[X].rgbtBlue);
- if Color = TransparentColor then
- Line := Line + XPMTransparentChar
- else
- Line := Line + Colors[Color].Key;
- end;
- SetNextPixmapLine(FPixmap, Index, Line);
- end;
- { Add terminating nil pointer - Scintilla doesnt really need it but setting it anyway }
- SetNextPixmapLine(FPixmap, Index, '');
- finally
- Colors.Free;
- end;
- end;
- { TScintRange }
- constructor TScintRange.Create(const AStartPos, AEndPos: Integer);
- begin
- StartPos := AStartPos;
- EndPos := AEndPos;
- end;
- function TScintRange.Overlaps(const ARange: TScintRange): Boolean;
- begin
- Result := not ARange.Empty and (StartPos <= ARange.EndPos) and (EndPos >= ARange.StartPos);
- end;
- function TScintRange.Empty: Boolean;
- begin
- Result := StartPos = EndPos;
- end;
- function TScintRange.Within(const ARange: TScintRange): Boolean;
- begin
- Result := (StartPos >= ARange.StartPos) and (EndPos <= ARange.EndPos);
- end;
- { TScintRangeList }
- function TScintRangeList.Overlaps(const ARange: TScintRange;
- var AOverlappingRange: TScintRange): Boolean;
- begin
- for var Item in Self do begin
- if Item.Overlaps(ARange) then begin
- AOverlappingRange := Item;
- Exit(True);
- end;
- end;
- Result := False;
- end;
- { TScintCaretAndAnchor }
- constructor TScintCaretAndAnchor.Create(const ACaretPos, AAnchorPos: Integer);
- begin
- CaretPos := ACaretPos;
- AnchorPos := AAnchorPos;
- end;
- function TScintCaretAndAnchor.Range: TScintRange;
- begin
- if CaretPos <= AnchorPos then begin
- Result.StartPos := CaretPos;
- Result.EndPos := AnchorPos;
- end else begin
- Result.StartPos := AnchorPos;
- Result.EndPos := CaretPos;
- end;
- end;
- end.
|