MemoComponentUnit.pas 95 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573357435753576357735783579358035813582358335843585358635873588358935903591359235933594359535963597359835993600360136023603360436053606360736083609361036113612361336143615361636173618361936203621362236233624362536263627362836293630363136323633363436353636363736383639364036413642364336443645364636473648364936503651365236533654365536563657365836593660366136623663366436653666366736683669367036713672367336743675367636773678367936803681368236833684368536863687368836893690
  1. {
  2. This Delphi component is part of TIGCC IDE.
  3. Copyright (C) 2000-2004 Sebastian Reichelt
  4. This program is free software; you can redistribute it and/or modify
  5. it under the terms of the GNU General Public License as published by
  6. the Free Software Foundation; either version 2, or (at your option)
  7. any later version.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. GNU General Public License for more details.
  12. You should have received a copy of the GNU General Public License
  13. along with this program; if not, write to the Free Software Foundation,
  14. Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  15. }
  16. {*******************************************************}
  17. { }
  18. { TMemo-Compatible Component v1.19 }
  19. { }
  20. { Copyright (c) 2000-2004 Sebastian Reichelt }
  21. { }
  22. {*******************************************************}
  23. unit MemoComponentUnit;
  24. interface
  25. uses
  26. Windows, Messages, SysUtils, Classes, Forms, Graphics, Controls, StdCtrls, ObjList;
  27. type
  28. TMCRanges = class;
  29. TCustomRange = class;
  30. TMCRange = class;
  31. TWholeTextRange = class;
  32. TVisibleRange = class;
  33. TSelectionRange = class;
  34. TCustomFormattedRange = class;
  35. TFormattedRange = class;
  36. TNormalFormattedRange = class;
  37. TFormattedRangeArray = array of TCustomFormattedRange;
  38. TIntegerList = class;
  39. TTextCell = record
  40. Row,
  41. Col: Integer;
  42. end;
  43. PUndoOperation = ^TUndoOperation;
  44. TUndoOperation = record
  45. RStart,
  46. REnd: Integer;
  47. NewText: string;
  48. NextItem: PUndoOperation;
  49. end;
  50. TReplaceEvent = procedure(Sender: TObject; Pos, Change: Integer) of object;
  51. TCurCursor = (ccNone, ccIBeam, ccArrow, ccDrag);
  52. { Note:
  53. The key element of the TMemoComponent class is the ReplaceText
  54. method. Its intent is to replace a piece of text (range) with as
  55. little destruction as possible. All values, for example the line
  56. index table and tracked ranges, are kept intact. Do not attempt to
  57. call this procedure directly or to modify the memo's text directly
  58. using FText. Instead, create a range and use its Text property.
  59. The range can be tracked or not, but be sure to set the Editor
  60. property if it is not tracked.
  61. To change the behavior when drawing text, override the virtual
  62. CreateSplitRanges method. The result must be an array of
  63. TCustomFormattedRange. }
  64. TMemoComponent = class(TCustomControl)
  65. private
  66. FHasFocus: Boolean;
  67. FCaretCreated: Boolean;
  68. FSelecting: Boolean;
  69. FDragging: Boolean;
  70. FStartDrag: Boolean;
  71. FDblClicked: Boolean;
  72. FLineStarts: TIntegerList;
  73. FScrollBars: TScrollStyle;
  74. FBorderStyle: TBorderStyle;
  75. FReadOnly: Boolean;
  76. FOnChange: TNotifyEvent;
  77. FText: TCaption;
  78. FTrackedRanges: TMCRanges;
  79. FWholeText: TCustomRange;
  80. FLines: TStrings;
  81. FVisibleRange: TVisibleRange;
  82. FSelection: TSelectionRange;
  83. FLongestLineLength: Integer;
  84. FAlwaysShowCaret: Boolean;
  85. FLeftMargin: Integer;
  86. FTopMargin: Integer;
  87. FTabSize: Integer;
  88. FOnSelectionChange: TNotifyEvent;
  89. FTextLength: Integer;
  90. FBitmapped: Boolean;
  91. FOnChangePrivate: TNotifyEvent;
  92. FAllowUndo: Boolean;
  93. FOnReplaceText: TReplaceEvent;
  94. FForbiddenFontStyles: TFontStyles;
  95. FDrawingSuspended: Boolean;
  96. FDragDropEditing: Boolean;
  97. FRemoveTrailingSpaces: Boolean;
  98. FAutoIndent: Boolean;
  99. procedure CMFontChanged(var Message: TMessage); message cm_FontChanged;
  100. procedure WMSize(var Message: TWMSize); message wm_Size;
  101. procedure WMHScroll(var Message: TWMHScroll); message wm_HScroll;
  102. procedure WMVScroll(var Message: TWMVScroll); message wm_VScroll;
  103. procedure WMSetFocus(var Message: TWMSetFocus); message wm_SetFocus;
  104. procedure WMKillFocus(var Message: TWMKillFocus); message wm_KillFocus;
  105. procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message wm_EraseBkgnd;
  106. procedure CMWantSpecialKey(var Message: TCMWantSpecialKey); message cm_WantSpecialKey;
  107. procedure WMKeyDown(var Message: TWMKeyDown); message wm_KeyDown;
  108. procedure WMKeyUp(var Message: TWMKeyUp); message wm_KeyUp;
  109. procedure WMClear(var Message: TWMClear); message wm_Clear;
  110. procedure WMCut(var Message: TWMCut); message wm_Cut;
  111. procedure WMCopy(var Message: TWMCopy); message wm_Copy;
  112. procedure WMPaste(var Message: TWMPaste); message wm_Paste;
  113. procedure WMSetText(var Message: TWMSetText); message wm_SetText;
  114. procedure WMGetText(var Message: TWMGetText); message wm_GetText;
  115. procedure WMGetTextLength(var Message: TWMGetTextLength); message wm_GetTextLength;
  116. procedure WMTimer(var Message: TWMTimer); message wm_Timer;
  117. procedure EMUndo(var Message: TMessage); message em_Undo;
  118. procedure EMCanUndo(var Message: TMessage); message em_CanUndo;
  119. procedure CMMouseWheel(var Message: TCMMouseWheel); message cm_MouseWheel;
  120. procedure WMGetDlgCode(var Message: TWMGetDlgCode); message wm_GetDlgCode;
  121. procedure SetText(const Value: TCaption);
  122. procedure SetScrollBars(const Value: TScrollStyle);
  123. procedure SetBorderStyle(const Value: TBorderStyle);
  124. procedure SetReadOnly(const Value: Boolean);
  125. procedure SetLines(const Value: TStrings);
  126. function GetLineCount: Integer;
  127. function GetLineLength(LineIndex: Integer): Integer;
  128. function GetVisualLineLength(LineIndex: Integer): Integer;
  129. function GetSelLength: Integer;
  130. function GetSelStart: Integer;
  131. procedure SetSelLength(const Value: Integer);
  132. procedure SetSelStart(const Value: Integer);
  133. procedure SetAlwaysShowCaret(const Value: Boolean);
  134. procedure SetLeftMargin(const Value: Integer);
  135. procedure SetTopMargin(const Value: Integer);
  136. procedure SetTabSize(const Value: Integer);
  137. function GetCanRedo: Boolean;
  138. function GetCanUndo: Boolean;
  139. procedure SetBitmapped(const Value: Boolean);
  140. procedure SetAllowUndo(const Value: Boolean);
  141. procedure SetRemoveTrailingSpaces(const Value: Boolean);
  142. procedure SetHasFocus(const Value: Boolean);
  143. protected
  144. FontHeight,
  145. FontWidth,
  146. PageHeight,
  147. PageWidth: Integer;
  148. DrawBmp: TBitmap;
  149. FUndoStack,
  150. FRedoStack: PUndoOperation;
  151. FInUndo,
  152. DontNotify: Boolean;
  153. DragOrigRange: TMCRange;
  154. FCurCursor: TCurCursor;
  155. FTempCursor: Boolean;
  156. FCursorIBeam: HCursor;
  157. FCursorArrow: HCursor;
  158. FCursorDrag: HCursor;
  159. procedure CreateParams(var Params: TCreateParams); override;
  160. procedure CreateWnd; override;
  161. procedure ReplaceText(Range: TCustomRange; const NewText: string); virtual;
  162. procedure DrawTextLine(Range: TCustomRange; Left, Top: Integer; NextTabStop: Integer); virtual;
  163. function CreateSplitRanges(Range: TCustomRange): TFormattedRangeArray; virtual;
  164. procedure DrawBorder(LeftRect, TopRect: TRect; Canvas: TCanvas); virtual;
  165. procedure TextChangeNotification(StartPos, OldLength, NewLength: Integer); dynamic;
  166. procedure TextChangeNotificationAfter; dynamic;
  167. procedure Change; dynamic;
  168. procedure SelectionChange; dynamic;
  169. procedure UpdateFontSize; virtual;
  170. procedure UpdatePageSize; virtual;
  171. procedure UpdateDrawBmp; virtual;
  172. procedure ReCreateCaret; virtual;
  173. procedure FreeCaret; virtual;
  174. procedure Paint; override;
  175. procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  176. procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
  177. procedure MouseMoveInternal(X, Y: Integer); virtual;
  178. procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  179. procedure KeyPress(var Key: Char); override;
  180. procedure DblClick; override;
  181. function GetLastUndo: TUndoOperation; virtual;
  182. function GetLastRedo: TUndoOperation; virtual;
  183. function CreateUndoBeginEndBlock: PUndoOperation; virtual;
  184. function IsUndoBeginEndBlock(Op: PUndoOperation): Boolean; virtual;
  185. procedure MakeUndoOperation(Op: PUndoOperation); virtual;
  186. procedure MakeRedoOperation(Op: PUndoOperation); virtual;
  187. procedure CancelDragging;
  188. procedure SetCurCursor(NewCursor: TCurCursor = ccNone; Temporary: Boolean = False);
  189. property HasFocus: Boolean read FHasFocus write SetHasFocus;
  190. public
  191. constructor Create(AOwner: TComponent); override;
  192. destructor Destroy; override;
  193. procedure Clear; virtual;
  194. procedure HandleKeyPress(var Key: Char);
  195. procedure HandleKeyDown(var Key: Word; Shift: TShiftState);
  196. procedure HandleKeyUp(var Key: Word; Shift: TShiftState);
  197. function CharIdxToCell(CharIdx: Integer): TTextCell; virtual;
  198. function CellToCharIdx(Cell: TTextCell): Integer; virtual;
  199. function ScrPointToScrCell(P: TPoint): TTextCell; virtual;
  200. function ScrCellToScrPoint(Cell: TTextCell): TPoint; virtual;
  201. function TabSpacesAtPos(P: Integer): Integer; virtual;
  202. function CellToScrCol(Cell: TTextCell): Integer; virtual;
  203. procedure CellFromScrCol(var Cell: TTextCell); virtual;
  204. function CellFromScrColToScrCol(var Cell: TTextCell): Integer; virtual;
  205. procedure SelectAll;
  206. procedure ClearSelection;
  207. procedure CutToClipboard;
  208. procedure CopyToClipboard;
  209. procedure PasteFromClipboard;
  210. procedure Undo;
  211. procedure Redo;
  212. procedure ClearUndo;
  213. procedure ClearRedo;
  214. procedure ScrollCaret; virtual;
  215. procedure ChangeIndent(Change: Integer); virtual;
  216. procedure RemoveTrSp; virtual;
  217. procedure RemoveTrSpFromLine(LineIdx: Integer); virtual;
  218. procedure RemoveTrSpFromString(var Str: string; IncludeLastLine: Boolean = False); virtual;
  219. property Text: TCaption read FText write SetText;
  220. property TextLength: Integer read FTextLength;
  221. property TrackedRanges: TMCRanges read FTrackedRanges;
  222. property WholeText: TCustomRange read FWholeText;
  223. property LineCount: Integer read GetLineCount;
  224. property LongestLineLength: Integer read FLongestLineLength;
  225. property LineLength[LineIndex: Integer]: Integer read GetLineLength;
  226. property VisualLineLength[LineIndex: Integer]: Integer read GetVisualLineLength;
  227. property VisibleRange: TVisibleRange read FVisibleRange;
  228. property Selection: TSelectionRange read FSelection;
  229. property SelStart: Integer read GetSelStart write SetSelStart;
  230. property SelLength: Integer read GetSelLength write SetSelLength;
  231. property ForbiddenFontStyles: TFontStyles read FForbiddenFontStyles;
  232. property CanUndo: Boolean read GetCanUndo;
  233. property CanRedo: Boolean read GetCanRedo;
  234. property DrawingSuspended: Boolean read FDrawingSuspended write FDrawingSuspended;
  235. property OnReplaceText: TReplaceEvent read FOnReplaceText write FOnReplaceText;
  236. property OnChangePrivate: TNotifyEvent read FOnChangePrivate write FOnChangePrivate;
  237. published
  238. property ScrollBars: TScrollStyle read FScrollBars write SetScrollBars default ssNone;
  239. property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle;
  240. property Bitmapped: Boolean read FBitmapped write SetBitmapped;
  241. property ReadOnly: Boolean read FReadOnly write SetReadOnly default False;
  242. property AllowUndo: Boolean read FAllowUndo write SetAllowUndo default True;
  243. property OnChange: TNotifyEvent read FOnChange write FOnChange;
  244. property OnSelectionChange: TNotifyEvent read FOnSelectionChange write FOnSelectionChange;
  245. property Lines: TStrings read FLines write SetLines;
  246. property AlwaysShowCaret: Boolean read FAlwaysShowCaret write SetAlwaysShowCaret;
  247. property LeftMargin: Integer read FLeftMargin write SetLeftMargin;
  248. property TopMargin: Integer read FTopMargin write SetTopMargin;
  249. property TabSize: Integer read FTabSize write SetTabSize;
  250. property AutoIndent: Boolean read FAutoIndent write FAutoIndent;
  251. property DragDropEditing: Boolean read FDragDropEditing write FDragDropEditing;
  252. property RemoveTrailingSpaces: Boolean read FRemoveTrailingSpaces write SetRemoveTrailingSpaces;
  253. property TabStop default True;
  254. property Align;
  255. property Anchors;
  256. property Color nodefault;
  257. property Constraints;
  258. property Ctl3D;
  259. property Enabled;
  260. property Font;
  261. property ParentColor;
  262. property ParentCtl3D;
  263. property ParentFont;
  264. property ParentShowHint;
  265. property PopupMenu;
  266. property ShowHint;
  267. property TabOrder;
  268. property Visible;
  269. property OnClick;
  270. property OnDblClick;
  271. property OnEnter;
  272. property OnExit;
  273. property OnKeyDown;
  274. property OnKeyPress;
  275. property OnKeyUp;
  276. property OnMouseDown;
  277. property OnMouseMove;
  278. property OnMouseUp;
  279. end;
  280. TCustomRange = class(TFastContainerItem)
  281. private
  282. FEditor: TMemoComponent;
  283. FChanging: Integer;
  284. FOnOverwrite: TNotifyEvent;
  285. FOnChange: TNotifyEvent;
  286. function GetEndPoint: TPoint;
  287. function GetStartPoint: TPoint;
  288. protected
  289. procedure SetRStart(const Value: Integer); virtual;
  290. procedure SetREnd(const Value: Integer); virtual;
  291. procedure SetRLength(const Value: Integer); virtual;
  292. function GetRStart: Integer; virtual; abstract;
  293. function GetREnd: Integer; virtual; abstract;
  294. function GetRLength: Integer; virtual;
  295. function GetEndRowCol: TTextCell; virtual;
  296. function GetStartRowCol: TTextCell; virtual;
  297. procedure SetEndRowCol(const Value: TTextCell); virtual;
  298. procedure SetStartRowCol(const Value: TTextCell); virtual;
  299. procedure SetText(const Value: string); virtual;
  300. function GetText: string; virtual;
  301. procedure Changing; dynamic;
  302. procedure Change; dynamic;
  303. procedure DiscardChanges; dynamic;
  304. procedure InternalDoMove(RangeStart, RangeEnd, LC: Integer); virtual;
  305. public
  306. constructor Create(Collection: TFastObjectContainer); override;
  307. procedure AssignTo(Dest: TPersistent); override;
  308. procedure NotifyOverwrite; dynamic;
  309. procedure DoChanging;
  310. procedure DoChange;
  311. procedure DoDiscardChanges;
  312. procedure Clear; virtual;
  313. function CharInRange(CharIdx: Integer): Boolean;
  314. procedure DrawRange; virtual;
  315. procedure ScrollInView(FromBorder: Integer); virtual;
  316. property Editor: TMemoComponent read FEditor write FEditor;
  317. property StartRowCol: TTextCell read GetStartRowCol write SetStartRowCol;
  318. property EndRowCol: TTextCell read GetEndRowCol write SetEndRowCol;
  319. property StartPoint: TPoint read GetStartPoint;
  320. property EndPoint: TPoint read GetEndPoint;
  321. property Text: string read GetText write SetText;
  322. published
  323. property RStart: Integer read GetRStart write SetRStart;
  324. property REnd: Integer read GetREnd write SetREnd;
  325. property RLength: Integer read GetRLength write SetRLength;
  326. property OnChange: TNotifyEvent read FOnChange write FOnChange;
  327. property OnOverwrite: TNotifyEvent read FOnOverwrite write FOnOverwrite;
  328. end;
  329. TMCRange = class(TCustomRange)
  330. private
  331. FRStart: Integer;
  332. FREnd: Integer;
  333. protected
  334. procedure SetREnd(const Value: Integer); override;
  335. procedure SetRStart(const Value: Integer); override;
  336. function GetREnd: Integer; override;
  337. function GetRStart: Integer; override;
  338. procedure InternalDoMove(RangeStart, RangeEnd, LC: Integer); override;
  339. public
  340. constructor Create(Collection: TFastObjectContainer); override;
  341. end;
  342. TWholeTextRange = class(TCustomRange)
  343. protected
  344. function GetREnd: Integer; override;
  345. function GetRStart: Integer; override;
  346. end;
  347. TVisibleRange = class(TCustomRange)
  348. private
  349. FLeftCol: Integer;
  350. FTopRow: Integer;
  351. procedure SetLeftCol(const Value: Integer);
  352. procedure SetRightCol(const Value: Integer);
  353. function GetRightCol: Integer;
  354. procedure SetTopRow(const Value: Integer);
  355. procedure SetBottomRow(const Value: Integer);
  356. function GetBottomRow: Integer;
  357. protected
  358. VisibleTextRect: TRect;
  359. procedure SetRStart(const Value: Integer); override;
  360. procedure SetREnd(const Value: Integer); override;
  361. procedure SetRLength(const Value: Integer); override;
  362. function GetRStart: Integer; override;
  363. function GetREnd: Integer; override;
  364. function GetStartRowCol: TTextCell; override;
  365. function GetEndRowCol: TTextCell; override;
  366. procedure SetStartRowCol(const Value: TTextCell); override;
  367. procedure SetEndRowCol(const Value: TTextCell); override;
  368. procedure Changing; override;
  369. procedure Change; override;
  370. procedure Update;
  371. public
  372. constructor Create(Collection: TFastObjectContainer); override;
  373. published
  374. property LeftCol: Integer read FLeftCol write SetLeftCol;
  375. property RightCol: Integer read GetRightCol write SetRightCol;
  376. property TopRow: Integer read FTopRow write SetTopRow;
  377. property BottomRow: Integer read GetBottomRow write SetBottomRow;
  378. end;
  379. TSelectWordDirection = (swLeft, swRight);
  380. TSelectWordDirections = set of TSelectWordDirection;
  381. TSelectionRange = class(TMCRange)
  382. private
  383. FOldSel: TCustomRange;
  384. FBackwards: Boolean;
  385. FCaretShowing: Boolean;
  386. FScrCol: Integer;
  387. function GetCursorPos: Integer;
  388. procedure SetCursorPos(const Value: Integer);
  389. function GetScrCol: Integer;
  390. protected
  391. procedure Changing; override;
  392. procedure Change; override;
  393. procedure DiscardChanges; override;
  394. procedure SetText(const Value: string); override;
  395. public
  396. procedure AssignTo(Dest: TPersistent); override;
  397. procedure NoSelAtPos(Pos: Integer);
  398. procedure UpdateCaretPos;
  399. procedure ShowCaret;
  400. procedure HideCaret;
  401. procedure SelectWord(Directions: TSelectWordDirections = [swLeft, swRight]);
  402. function ScrColToCol(Row: Integer): Integer;
  403. property CursorPos: Integer read GetCursorPos write SetCursorPos;
  404. property ScrCol: Integer read GetScrCol write FScrCol;
  405. published
  406. property Backwards: Boolean read FBackwards write FBackwards;
  407. end;
  408. TCustomFormattedRange = class(TMCRange)
  409. protected
  410. function GetColor: TColor; virtual; abstract;
  411. function GetFont: TFont; virtual; abstract;
  412. procedure SetColor(const Value: TColor); virtual;
  413. procedure SetFont(const Value: TFont); virtual;
  414. public
  415. FreeWhenDone: Boolean;
  416. procedure AssignTo(Dest: TPersistent); override;
  417. procedure CleanUpFont; virtual;
  418. published
  419. property Color: TColor read GetColor write SetColor;
  420. property Font: TFont read GetFont write SetFont;
  421. end;
  422. TFormattedRange = class(TCustomFormattedRange)
  423. private
  424. FFont: TFont;
  425. FColor: TColor;
  426. protected
  427. function GetColor: TColor; override;
  428. function GetFont: TFont; override;
  429. procedure SetColor(const Value: TColor); override;
  430. procedure SetFont(const Value: TFont); override;
  431. public
  432. constructor Create(Collection: TFastObjectContainer); override;
  433. destructor Destroy; override;
  434. end;
  435. TNormalFormattedRange = class(TCustomFormattedRange)
  436. protected
  437. function GetColor: TColor; override;
  438. function GetFont: TFont; override;
  439. end;
  440. TRangeClass = class of TCustomRange;
  441. TMCRanges = class(TFastObjectContainer)
  442. private
  443. FItemClass: TRangeClass;
  444. function NewGetOwner: TMemoComponent;
  445. protected
  446. function NewGetItem(ItemIndex: Integer): TCustomRange;
  447. public
  448. FDestroying: Boolean;
  449. constructor Create(AOwner: TMemoComponent);
  450. destructor Destroy; override;
  451. function Add: TCustomRange; overload;
  452. function Add(Start, Count: Integer): TCustomRange; overload;
  453. property ItemClass: TRangeClass read FItemClass write FItemClass;
  454. property Items[ItemIndex: Integer]: TCustomRange read NewGetItem;
  455. property Owner: TMemoComponent read NewGetOwner;
  456. end;
  457. TIntegerList = class(TObject)
  458. private
  459. FList: TList;
  460. function GetCount: Integer;
  461. function GetItem(ItemIndex: Integer): Integer;
  462. procedure SetItem(ItemIndex: Integer; const Value: Integer);
  463. procedure SetCount(const Value: Integer);
  464. public
  465. constructor Create;
  466. destructor Destroy; override;
  467. function Add(Item: Integer): Integer;
  468. procedure Insert(Index: Integer; Item: Integer);
  469. procedure Delete(Index: Integer);
  470. procedure Clear; dynamic;
  471. property Items[ItemIndex: Integer]: Integer read GetItem write SetItem;
  472. property Count: Integer read GetCount write SetCount;
  473. end;
  474. function TextCell(CellRow, CellCol: Integer): TTextCell;
  475. procedure Register;
  476. implementation
  477. uses
  478. UtilsDos, ClipBrd;
  479. const
  480. MaxScrollTolerance = 2;
  481. ScrollOffset = 10;
  482. procedure Register;
  483. begin
  484. RegisterComponents('Edit Controls', [TMemoComponent]);
  485. end;
  486. { TMemoComponentStrings Definition }
  487. type
  488. TMemoComponentStrings = class(TStrings)
  489. private
  490. Memo: TMemoComponent;
  491. protected
  492. function Get(LineIndex: Integer): string; override;
  493. function GetCount: Integer; override;
  494. function GetTextStr: string; override;
  495. procedure Put(LineIndex: Integer; const S: string); override;
  496. procedure SetTextStr(const Value: string); override;
  497. public
  498. procedure Clear; override;
  499. procedure Delete(LineIndex: Integer); override;
  500. procedure Insert(LineIndex: Integer; const S: string); override;
  501. end;
  502. { Helper Functions }
  503. function TextCell(CellRow, CellCol: Integer): TTextCell;
  504. begin
  505. with Result do begin
  506. Row := CellRow;
  507. Col := CellCol;
  508. end;
  509. end;
  510. { TMemoComponent }
  511. procedure TMemoComponent.CancelDragging;
  512. var
  513. P: TPoint;
  514. begin
  515. if FSelecting or FDragging then begin
  516. if HandleAllocated then
  517. KillTimer (Handle, 1);
  518. FSelecting := False;
  519. FDragging := False;
  520. P := ScreenToClient (Mouse.CursorPos);
  521. MouseMoveInternal (P.X, P.Y);
  522. end;
  523. end;
  524. procedure TMemoComponent.CellFromScrCol(var Cell: TTextCell);
  525. var
  526. I,
  527. Col,
  528. Count: Integer;
  529. begin
  530. if Cell.Row < 1 then
  531. Cell.Row := 1;
  532. if Cell.Row > LineCount then
  533. Cell.Row := LineCount;
  534. if TabSize <> 1 then begin
  535. Count := 0;
  536. I := CellToCharIdx (TextCell (Cell.Row, 1));
  537. Col := Cell.Col;
  538. Cell.Col := 1;
  539. while Count < Col do begin
  540. if (I <= TextLength) and (Text [I] = #9) then
  541. Count := (Count div TabSize + 1) * TabSize
  542. else
  543. Inc (Count);
  544. if Count < Col then begin
  545. Inc (I);
  546. Inc (Cell.Col);
  547. end;
  548. end;
  549. end;
  550. if Cell.Col < 1 then
  551. Cell.Col := 1;
  552. if Cell.Col > LineLength [Cell.Row] + 1 then
  553. Cell.Col := LineLength [Cell.Row] + 1;
  554. end;
  555. function TMemoComponent.CellFromScrColToScrCol(var Cell: TTextCell):
  556. Integer;
  557. var
  558. I,
  559. Col,
  560. Count: Integer;
  561. begin
  562. if Cell.Row < 1 then
  563. Cell.Row := 1;
  564. if Cell.Row > LineCount then
  565. Cell.Row := LineCount;
  566. if TabSize = 1 then
  567. Result := Cell.Col
  568. else begin
  569. Result := 1;
  570. Count := 0;
  571. I := CellToCharIdx (TextCell (Cell.Row, 1));
  572. Col := Cell.Col;
  573. Cell.Col := 1;
  574. while Count < Col do begin
  575. Result := Count + 1;
  576. if (I <= TextLength) and (Text [I] = #9) then
  577. Count := (Count div TabSize + 1) * TabSize
  578. else
  579. Inc (Count);
  580. if Count < Col then begin
  581. Inc (I);
  582. Inc (Cell.Col);
  583. end;
  584. end;
  585. end;
  586. if Cell.Col < 1 then
  587. Cell.Col := 1;
  588. if Cell.Col > LineLength [Cell.Row] + 1 then
  589. Cell.Col := LineLength [Cell.Row] + 1;
  590. end;
  591. function TMemoComponent.CellToCharIdx(Cell: TTextCell): Integer;
  592. begin
  593. with Cell do
  594. if Row <= 0 then
  595. Result := Col
  596. else if Row > LineCount then
  597. Result := TextLength + 2 + Col
  598. else
  599. Result := FLineStarts.Items [Row - 1] + Col - 1;
  600. end;
  601. function TMemoComponent.CellToScrCol(Cell: TTextCell): Integer;
  602. var
  603. I,
  604. Idx: Integer;
  605. begin
  606. if TabSize = 1 then
  607. Result := Cell.Col
  608. else begin
  609. Result := 0;
  610. Idx := CellToCharIdx (TextCell (Cell.Row, 1));
  611. for I := Idx to Idx + Cell.Col - 2 do begin
  612. if (I > 0) and (I <= TextLength) and (Text [I] = #9) then
  613. Result := (Result div TabSize + 1) * TabSize
  614. else
  615. Inc (Result);
  616. end;
  617. Inc (Result);
  618. end;
  619. end;
  620. procedure TMemoComponent.Change;
  621. begin
  622. if not DontNotify then begin
  623. inherited Changed;
  624. if Assigned (FOnChange) then
  625. FOnChange (Self);
  626. if Assigned (FOnChangePrivate) then
  627. FOnChangePrivate (Self);
  628. end;
  629. end;
  630. procedure TMemoComponent.ChangeIndent(Change: Integer);
  631. var
  632. I,
  633. RS,
  634. RE,
  635. L,
  636. CurPos: Integer;
  637. begin
  638. if Change <> 0 then begin
  639. DontNotify := True;
  640. try
  641. VisibleRange.DoChanging;
  642. try
  643. MakeUndoOperation (CreateUndoBeginEndBlock);
  644. RS := Selection.StartRowCol.Row;
  645. RE := Selection.EndRowCol.Row;
  646. if RE < RS then
  647. RE := RS;
  648. for I := RS to RE do begin
  649. CurPos := CellToCharIdx (TextCell (I, 1));
  650. if Change > 0 then begin
  651. while (CurPos <= TextLength) and (Text [CurPos] in [#9, #21]) do
  652. Inc (CurPos);
  653. L := Change;
  654. with TMCRange.Create (nil) do begin
  655. Editor := Self;
  656. RStart := CurPos;
  657. RLength := 0;
  658. Text := StringOfChar (#9, L);
  659. if (Selection.RLength > 0) and (Selection.RStart = REnd + 1) then
  660. Selection.RStart := RStart;
  661. Free;
  662. end;
  663. end else begin
  664. L := 0;
  665. while (CurPos <= TextLength) and (Text [CurPos] in [#9, #21]) do begin
  666. Inc (CurPos);
  667. Inc (L);
  668. end;
  669. if L > -Change then
  670. L := -Change;
  671. with TMCRange.Create (nil) do begin
  672. Editor := Self;
  673. RStart := CurPos - L;
  674. REnd := CurPos - 1;
  675. Text := '';
  676. Free;
  677. end;
  678. end;
  679. end;
  680. MakeUndoOperation (CreateUndoBeginEndBlock);
  681. finally
  682. VisibleRange.DoDiscardChanges;
  683. end;
  684. Selection.HideCaret;
  685. try
  686. VisibleRange.DrawRange;
  687. Selection.UpdateCaretPos;
  688. finally
  689. Selection.ShowCaret;
  690. end;
  691. finally
  692. DontNotify := False;
  693. end;
  694. Self.Change;
  695. SelectionChange;
  696. end;
  697. end;
  698. function TMemoComponent.CharIdxToCell(CharIdx: Integer): TTextCell;
  699. var
  700. LineIdx: Integer;
  701. begin
  702. with FLineStarts do begin
  703. if TextLength > 0 then
  704. LineIdx := Count * CharIdx div TextLength - 1
  705. else
  706. LineIdx := 0;
  707. if LineIdx < 0 then
  708. LineIdx := 0;
  709. if LineIdx >= Count then
  710. LineIdx := Count - 1;
  711. while (LineIdx < Count - 1) and (Items [LineIdx] < CharIdx) do
  712. Inc (LineIdx);
  713. while (LineIdx > 0) and (Items [LineIdx] > CharIdx) do
  714. Dec (LineIdx);
  715. with Result do begin
  716. Row := LineIdx + 1;
  717. Col := CharIdx - Items [LineIdx] + 1;
  718. end;
  719. end;
  720. end;
  721. procedure TMemoComponent.Clear;
  722. begin
  723. Text := '';
  724. end;
  725. procedure TMemoComponent.ClearRedo;
  726. begin
  727. while CanRedo do
  728. GetLastRedo;
  729. end;
  730. procedure TMemoComponent.ClearSelection;
  731. begin
  732. Perform (wm_Clear, 0, 0);
  733. end;
  734. procedure TMemoComponent.ClearUndo;
  735. begin
  736. while CanRedo do
  737. GetLastRedo;
  738. while CanUndo do
  739. GetLastUndo;
  740. Change;
  741. end;
  742. procedure TMemoComponent.CMFontChanged(var Message: TMessage);
  743. begin
  744. inherited;
  745. UpdateFontSize;
  746. VisibleRange.Update;
  747. VisibleRange.DrawRange;
  748. end;
  749. procedure TMemoComponent.CMMouseWheel(var Message: TCMMouseWheel);
  750. var
  751. Msg: TWMScroll;
  752. I: Integer;
  753. begin
  754. with Msg do begin
  755. Msg := wm_VScroll;
  756. if Message.WheelDelta >= 0 then
  757. ScrollCode := sb_LineUp
  758. else
  759. ScrollCode := sb_LineDown;
  760. end;
  761. for I := 1 to 3 do
  762. WMVScroll (Msg);
  763. Message.Result := 1;
  764. end;
  765. procedure TMemoComponent.CMWantSpecialKey(var Message: TCMWantSpecialKey);
  766. begin
  767. inherited;
  768. if not (csDesigning in ComponentState) then
  769. if Message.CharCode in [vk_Left, vk_Right, vk_Up, vk_Down, vk_Prior, vk_Next, vk_Home, vk_End, vk_Tab, vk_Clear, vk_Delete, vk_Insert, vk_Return] then
  770. Message.Result := 1;
  771. end;
  772. procedure TMemoComponent.CopyToClipboard;
  773. begin
  774. Perform (wm_Copy, 0, 0);
  775. end;
  776. constructor TMemoComponent.Create(AOwner: TComponent);
  777. begin
  778. inherited;
  779. FBitmapped := False;
  780. FText := '';
  781. FLineStarts := TIntegerList.Create;
  782. FLineStarts.Add (1);
  783. FLines := TMemoComponentStrings.Create;
  784. TMemoComponentStrings(FLines).Memo := Self;
  785. FTrackedRanges := TMCRanges.Create (Self);
  786. FWholeText := TWholeTextRange.Create (nil);
  787. FWholeText.Editor := Self;
  788. FVisibleRange := TVisibleRange.Create (TrackedRanges);
  789. FSelection := TSelectionRange.Create (TrackedRanges);
  790. with FSelection do begin
  791. FRStart := 1;
  792. FREnd := 0;
  793. end;
  794. FTabSize := 2;
  795. FScrollBars := ssBoth;
  796. FBorderStyle := bsSingle;
  797. FLeftMargin := 2;
  798. FTopMargin := 0;
  799. FAllowUndo := True;
  800. ControlStyle := ControlStyle + [csOpaque] - [csNoStdEvents];
  801. DoubleBuffered := False;
  802. Constraints.MinWidth := 64;
  803. Constraints.MinHeight := 64;
  804. TabStop := True;
  805. ParentColor := False;
  806. Color := clWindow;
  807. Font.Name := 'Courier New';
  808. Font.Size := 10;
  809. Width := 129;
  810. Height := 129;
  811. end;
  812. procedure TMemoComponent.CreateParams(var Params: TCreateParams);
  813. const
  814. ScrollBar: array [TScrollStyle] of DWORD = (0, WS_HSCROLL, WS_VSCROLL,
  815. WS_HSCROLL or WS_VSCROLL);
  816. begin
  817. inherited;
  818. with Params do begin
  819. Style := Style or ScrollBar [FScrollBars];
  820. if NewStyleControls and Ctl3D and (FBorderStyle = bsSingle) then begin
  821. Style := Style and not WS_BORDER;
  822. ExStyle := ExStyle or WS_EX_CLIENTEDGE;
  823. end;
  824. end;
  825. end;
  826. function TMemoComponent.CreateSplitRanges(Range: TCustomRange): TFormattedRangeArray;
  827. var
  828. RS,
  829. RE: Integer;
  830. begin
  831. RS := Range.RStart;
  832. if Selection.RLength > 0 then begin
  833. RE := Selection.RStart - 1;
  834. if RE > Range.REnd then
  835. RE := Range.REnd;
  836. if RE >= RS then begin
  837. SetLength (Result, Length (Result) + 1);
  838. Result [High (Result)] := TNormalFormattedRange.Create (nil);
  839. with Result [High (Result)] do begin
  840. FreeWhenDone := True;
  841. Editor := Self;
  842. RStart := RS;
  843. REnd := RE;
  844. end;
  845. end;
  846. RS := Selection.RStart;
  847. if RS < Range.RStart then
  848. RS := Range.RStart;
  849. RE := Selection.REnd;
  850. if RE > Range.REnd then
  851. RE := Range.REnd;
  852. if RE >= RS then begin
  853. SetLength (Result, Length (Result) + 1);
  854. Result [High (Result)] := TFormattedRange.Create (nil);
  855. with Result [High (Result)] do begin
  856. FreeWhenDone := True;
  857. Editor := Self;
  858. RStart := RS;
  859. REnd := RE;
  860. Font.Assign (Self.Font);
  861. if HasFocus then begin
  862. Font.Color := clHighlightText;
  863. Color := clHighlight;
  864. end else
  865. Color := clSilver;
  866. end;
  867. end;
  868. RS := Selection.REnd + 1;
  869. if RS < Range.RStart then
  870. RS := Range.RStart;
  871. end;
  872. RE := Range.REnd;
  873. if RE >= RS then begin
  874. SetLength (Result, Length (Result) + 1);
  875. Result [High (Result)] := TNormalFormattedRange.Create (nil);
  876. with Result [High (Result)] do begin
  877. FreeWhenDone := True;
  878. Editor := Self;
  879. RStart := RS;
  880. REnd := RE;
  881. end;
  882. end;
  883. end;
  884. function TMemoComponent.CreateUndoBeginEndBlock: PUndoOperation;
  885. begin
  886. New (Result);
  887. with Result^ do begin
  888. RStart := -1;
  889. REnd := -1;
  890. NewText := '';
  891. end;
  892. end;
  893. procedure TMemoComponent.CreateWnd;
  894. begin
  895. inherited;
  896. UpdateFontSize;
  897. SetCurCursor (ccIBeam);
  898. end;
  899. procedure TMemoComponent.CutToClipboard;
  900. begin
  901. Perform (wm_Cut, 0, 0);
  902. end;
  903. procedure TMemoComponent.DblClick;
  904. begin
  905. inherited;
  906. FDblClicked := True;
  907. Selection.SelectWord;
  908. end;
  909. destructor TMemoComponent.Destroy;
  910. begin
  911. DontNotify := True;
  912. FHasFocus := False;
  913. ClearUndo;
  914. FSelection.Free;
  915. FVisibleRange.Free;
  916. FLines.Free;
  917. FTrackedRanges.Free;
  918. FWholeText.Free;
  919. FLineStarts.Free;
  920. if Assigned (DrawBmp) then begin
  921. DrawBmp.Free;
  922. DrawBmp := nil;
  923. end;
  924. FreeCaret;
  925. inherited;
  926. end;
  927. procedure TMemoComponent.DrawBorder(LeftRect, TopRect: TRect;
  928. Canvas: TCanvas);
  929. begin
  930. Canvas.Brush.Color := Color;
  931. Canvas.FillRect (LeftRect);
  932. Canvas.FillRect (TopRect);
  933. end;
  934. procedure TMemoComponent.DrawTextLine(Range: TCustomRange; Left, Top: Integer; NextTabStop: Integer);
  935. var
  936. I,
  937. SP,
  938. X,
  939. Y,
  940. TextFlags: Integer;
  941. R: TRect;
  942. Ranges: TFormattedRangeArray;
  943. S: string;
  944. Cnv: TCanvas;
  945. begin
  946. if HandleAllocated and ((Range.RLength > 0) or (Range.REnd >= TextLength)) then begin
  947. if Bitmapped then begin
  948. Cnv := DrawBmp.Canvas;
  949. TextFlags := eto_Opaque or eto_Clipped;
  950. end else begin
  951. Cnv := Canvas;
  952. TextFlags := eto_Opaque or eto_Clipped;
  953. end;
  954. SetLength (Ranges, 0);
  955. Ranges := CreateSplitRanges (Range);
  956. R := Rect (Left, Top, Left, Top + FontHeight);
  957. for I := Low (Ranges) to High (Ranges) do
  958. with Ranges [I] do begin
  959. CleanUpFont;
  960. if RLength > 0 then begin
  961. Cnv.Brush.Color := Color;
  962. Cnv.Font.Assign (Font);
  963. if Self.Text [REnd] = #10 then
  964. S := Copy (Self.Text, RStart, RLength - 2)
  965. else if Self.Text [REnd] = #13 then
  966. S := Copy (Self.Text, RStart, RLength - 1)
  967. else
  968. S := Copy (Self.Text, RStart, RLength);
  969. SP := 1;
  970. while SP <= Length (S) do begin
  971. if S [SP] = #9 then begin
  972. System.Delete (S, SP, 1);
  973. System.Insert (StringOfChar (' ', NextTabStop), S, SP);
  974. Inc (SP, NextTabStop);
  975. NextTabStop := TabSize;
  976. end else begin
  977. Inc (SP);
  978. Dec (NextTabStop);
  979. if NextTabStop <= 0 then
  980. Inc (NextTabStop, TabSize);
  981. end;
  982. end;
  983. if (REnd <= TextLength) and (Self.Text [REnd] in [#10, #13]) then begin
  984. R.Right := ClientWidth;
  985. end else
  986. R.Right := R.Left + FontWidth * Length (S);
  987. X := R.Left;
  988. Y := R.Top;
  989. if (fsItalic in Font.Style) and (Pos ('Courier', Font.Name) > 0) then
  990. Dec (Y);
  991. if R.Left < LeftMargin then
  992. R.Left := LeftMargin;
  993. if R.Right > R.Left then begin
  994. {$IFDEF DrawDebug}
  995. Cnv.FillRect (R);
  996. Cnv.DrawFocusRect (R);
  997. Sleep (100);
  998. {$ENDIF}
  999. ExtTextOut (Cnv.Handle, X, Y, TextFlags, @R, PChar (S), Length (S), nil);
  1000. end;
  1001. R.Left := R.Right;
  1002. end;
  1003. if FreeWhenDone then
  1004. Free;
  1005. end;
  1006. if Range.REnd >= TextLength then begin
  1007. if R.Left < LeftMargin then
  1008. R.Left := LeftMargin;
  1009. R.Right := ClientWidth;
  1010. Cnv.Brush.Color := Color;
  1011. Cnv.FillRect (R);
  1012. end;
  1013. end;
  1014. end;
  1015. procedure TMemoComponent.EMCanUndo(var Message: TMessage);
  1016. begin
  1017. if Message.WParam = 1 then
  1018. Message.Result := Integer (Assigned (FRedoStack))
  1019. else
  1020. Message.Result := Integer (Assigned (FUndoStack));
  1021. end;
  1022. procedure TMemoComponent.EMUndo(var Message: TMessage);
  1023. var
  1024. Op: TUndoOperation;
  1025. NewOp: PUndoOperation;
  1026. Repeating: Boolean;
  1027. CurSel: TMCRange;
  1028. begin
  1029. if Perform (em_CanUndo, Message.WParam, 0) <> 0 then
  1030. with Message do begin
  1031. FInUndo := True;
  1032. Repeating := False;
  1033. CurSel := nil;
  1034. repeat
  1035. if WParam = 1 then
  1036. Op := GetLastRedo
  1037. else
  1038. Op := GetLastUndo;
  1039. if IsUndoBeginEndBlock (@Op) then begin
  1040. Repeating := not Repeating;
  1041. if Repeating then begin
  1042. DontNotify := True;
  1043. VisibleRange.DoChanging;
  1044. end else begin
  1045. VisibleRange.DoDiscardChanges;
  1046. Selection.HideCaret;
  1047. VisibleRange.DrawRange;
  1048. if Assigned (CurSel) then
  1049. Selection.Assign (CurSel);
  1050. Selection.UpdateCaretPos;
  1051. Selection.ShowCaret;
  1052. DontNotify := False;
  1053. Self.Change;
  1054. SelectionChange;
  1055. Selection.ScrollInView (4);
  1056. end;
  1057. if WParam = 1 then
  1058. MakeUndoOperation (CreateUndoBeginEndBlock)
  1059. else
  1060. MakeRedoOperation (CreateUndoBeginEndBlock);
  1061. end else begin
  1062. with TMCRange.Create (nil) do begin
  1063. Editor := Self;
  1064. New (NewOp);
  1065. RStart := Op.RStart;
  1066. REnd := Op.REnd;
  1067. NewOp.NewText := Text;
  1068. Text := Op.NewText;
  1069. NewOp.RStart := RStart;
  1070. NewOp.REnd := REnd;
  1071. if WParam = 1 then
  1072. MakeUndoOperation (NewOp)
  1073. else
  1074. MakeRedoOperation (NewOp);
  1075. if Repeating then begin
  1076. if Assigned (CurSel) then begin
  1077. if REnd + 1 > CurSel.RStart then
  1078. CurSel.RStart := REnd + 1;
  1079. end else begin
  1080. CurSel := TMCRange.Create (TrackedRanges);
  1081. CurSel.RStart := REnd + 1;
  1082. end;
  1083. end else begin
  1084. AssignTo (Selection);
  1085. Selection.ScrollInView (4);
  1086. end;
  1087. Free;
  1088. end;
  1089. end;
  1090. until not Repeating;
  1091. if Assigned (CurSel) then
  1092. CurSel.Free;
  1093. FInUndo := False;
  1094. Change;
  1095. end;
  1096. end;
  1097. procedure TMemoComponent.FreeCaret;
  1098. begin
  1099. if FCaretCreated then begin
  1100. Selection.HideCaret;
  1101. DestroyCaret;
  1102. FCaretCreated := False;
  1103. end;
  1104. end;
  1105. function TMemoComponent.GetCanRedo: Boolean;
  1106. begin
  1107. Result := Perform (em_CanUndo, 1, 0) <> 0;
  1108. end;
  1109. function TMemoComponent.GetCanUndo: Boolean;
  1110. begin
  1111. Result := Perform (em_CanUndo, 0, 0) <> 0;
  1112. end;
  1113. function TMemoComponent.GetLastRedo: TUndoOperation;
  1114. begin
  1115. if Assigned (FRedoStack) then begin
  1116. Result := FRedoStack^;
  1117. Dispose (FRedoStack);
  1118. FRedoStack := Result.NextItem;
  1119. end;
  1120. end;
  1121. function TMemoComponent.GetLastUndo: TUndoOperation;
  1122. begin
  1123. if Assigned (FUndoStack) then begin
  1124. Result := FUndoStack^;
  1125. Dispose (FUndoStack);
  1126. FUndoStack := Result.NextItem;
  1127. end;
  1128. end;
  1129. function TMemoComponent.GetLineCount: Integer;
  1130. begin
  1131. Result := FLineStarts.Count;
  1132. end;
  1133. function TMemoComponent.GetLineLength(LineIndex: Integer): Integer;
  1134. begin
  1135. Result := CellToCharIdx (TextCell (LineIndex + 1, 0)) - CellToCharIdx (TextCell (LineIndex, 0)) - 2;
  1136. end;
  1137. function TMemoComponent.GetSelLength: Integer;
  1138. begin
  1139. Result := Selection.RLength;
  1140. end;
  1141. function TMemoComponent.GetSelStart: Integer;
  1142. begin
  1143. Result := Selection.RStart - 1;
  1144. end;
  1145. function TMemoComponent.GetVisualLineLength(LineIndex: Integer): Integer;
  1146. begin
  1147. Result := CellToScrCol (TextCell (LineIndex, GetLineLength (LineIndex) + 1)) - 1;
  1148. end;
  1149. procedure TMemoComponent.HandleKeyDown(var Key: Word; Shift: TShiftState);
  1150. var
  1151. NewPos: Integer;
  1152. Cell: TTextCell;
  1153. SavScrCol: Integer;
  1154. InWord: Boolean;
  1155. P: TPoint;
  1156. begin
  1157. inherited;
  1158. SavScrCol := -1;
  1159. NewPos := Low (Integer);
  1160. if ReadOnly then begin
  1161. case Key of
  1162. vk_Left: Perform (wm_HScroll, sb_LineLeft, 0);
  1163. vk_Right: Perform (wm_HScroll, sb_LineRight, 0);
  1164. vk_Up: Perform (wm_VScroll, sb_LineUp, 0);
  1165. vk_Down: Perform (wm_VScroll, sb_LineDown, 0);
  1166. vk_Prior: Perform (wm_VScroll, sb_PageUp, 0);
  1167. vk_Next: Perform (wm_VScroll, sb_PageDown, 0);
  1168. vk_Home: begin
  1169. if ssCtrl in Shift then
  1170. Perform (wm_VScroll, sb_Top, 0);
  1171. Perform (wm_HScroll, sb_Top, 0);
  1172. end;
  1173. vk_End:
  1174. if ssCtrl in Shift then
  1175. Perform (wm_VScroll, sb_Bottom, 0)
  1176. else
  1177. Perform (wm_HScroll, sb_Bottom, 0);
  1178. vk_Insert:
  1179. if Shift = [ssCtrl] then
  1180. CopyToClipboard;
  1181. end;
  1182. end else begin
  1183. with Selection do begin
  1184. case Key of
  1185. vk_Clear: begin
  1186. Clear;
  1187. ScrollInView (4);
  1188. end;
  1189. vk_Delete:
  1190. if (Shift = []) or (Shift = [ssCtrl]) then begin
  1191. if (RLength = 0) or (Shift = [ssCtrl]) then begin
  1192. DoChanging;
  1193. if Shift = [ssCtrl] then
  1194. SelectWord ([swRight]);
  1195. if RLength = 0 then begin
  1196. RLength := 1;
  1197. if (RLength = 1) and (Text [1] in [#10, #13]) then
  1198. RLength := 2;
  1199. end;
  1200. DoDiscardChanges;
  1201. end;
  1202. Clear;
  1203. ScrollInView (4);
  1204. end else if Shift = [ssShift] then
  1205. CutToClipboard;
  1206. vk_Insert:
  1207. if Shift = [ssShift] then
  1208. PasteFromClipboard
  1209. else if Shift = [ssCtrl] then
  1210. CopyToClipboard;
  1211. vk_Back:
  1212. if (Shift = []) or (Shift = [ssShift]) or (Shift = [ssCtrl]) then begin
  1213. if (RLength = 0) or (Shift = [ssCtrl]) then begin
  1214. DoChanging;
  1215. if Shift = [ssCtrl] then
  1216. SelectWord ([swLeft]);
  1217. if RLength = 0 then begin
  1218. RStart := RStart - 1;
  1219. if (RLength = 1) and (Text [1] in [#10, #13]) then
  1220. RStart := RStart - 1;
  1221. end;
  1222. DoDiscardChanges;
  1223. end;
  1224. Clear;
  1225. ScrollInView (4);
  1226. end else if Shift = [ssAlt] then
  1227. Undo
  1228. else if Shift = [ssAlt, ssShift] then
  1229. Redo;
  1230. vk_Tab:
  1231. if Shift = [] then begin
  1232. Text := #9;
  1233. ScrollInView (4);
  1234. end;
  1235. vk_Left: begin
  1236. if (not (ssShift in Shift)) and (RLength > 0) and (not AlwaysShowCaret) then
  1237. REnd := RStart - 1
  1238. else
  1239. if (ssCtrl in Shift) then begin
  1240. NewPos := CursorPos;
  1241. InWord := (NewPos > 1) and (NewPos <= TextLength + 1) and (Self.Text [NewPos - 1] in ['A'..'Z', 'a'..'z', '0'..'9', '_']);
  1242. while (NewPos > 1) and ((Self.Text [NewPos - 1] in ['A'..'Z', 'a'..'z', '0'..'9', '_']) = InWord) do begin
  1243. if Self.Text [NewPos - 1] in [#10, #13] then
  1244. Dec (NewPos, 2)
  1245. else
  1246. Dec (NewPos);
  1247. end;
  1248. end else begin
  1249. if (CursorPos > 1) and (Self.Text [CursorPos - 1] in [#10, #13]) then
  1250. NewPos := CursorPos - 2
  1251. else
  1252. NewPos := CursorPos - 1;
  1253. end;
  1254. end;
  1255. vk_Right: begin
  1256. if (not (ssShift in Shift)) and (RLength > 0) and (not AlwaysShowCaret) then
  1257. RStart := REnd + 1
  1258. else
  1259. if (ssCtrl in Shift) then begin
  1260. NewPos := CursorPos;
  1261. InWord := (NewPos >= 1) and (NewPos <= TextLength) and (Self.Text [NewPos] in ['A'..'Z', 'a'..'z', '0'..'9', '_']);
  1262. while (NewPos <= TextLength) and ((Self.Text [NewPos] in ['A'..'Z', 'a'..'z', '0'..'9', '_']) = InWord) do begin
  1263. if Self.Text [NewPos] in [#10, #13] then
  1264. Inc (NewPos, 2)
  1265. else
  1266. Inc (NewPos);
  1267. end;
  1268. end else begin
  1269. if (CursorPos <= TextLength) and (Self.Text [CursorPos] in [#10, #13]) then
  1270. NewPos := CursorPos + 2
  1271. else
  1272. NewPos := CursorPos + 1;
  1273. end;
  1274. end;
  1275. vk_Up: begin
  1276. if (not (ssShift in Shift)) and (RLength > 0) and (not AlwaysShowCaret) then
  1277. REnd := RStart - 1
  1278. else begin
  1279. SavScrCol := ScrCol;
  1280. Cell := CharIdxToCell (CursorPos);
  1281. Dec (Cell.Row);
  1282. Cell.Col := ScrColToCol (Cell.Row);
  1283. NewPos := CellToCharIdx (Cell);
  1284. end;
  1285. end;
  1286. vk_Down: begin
  1287. if (not (ssShift in Shift)) and (RLength > 0) and (not AlwaysShowCaret) then
  1288. RStart := REnd + 1
  1289. else begin
  1290. SavScrCol := ScrCol;
  1291. Cell := CharIdxToCell (CursorPos);
  1292. Inc (Cell.Row);
  1293. Cell.Col := ScrColToCol (Cell.Row);
  1294. NewPos := CellToCharIdx (Cell);
  1295. end;
  1296. end;
  1297. vk_Prior: begin
  1298. SavScrCol := ScrCol;
  1299. Cell := CharIdxToCell (CursorPos);
  1300. Dec (Cell.Row, PageHeight - 1);
  1301. Cell.Col := ScrColToCol (Cell.Row);
  1302. NewPos := CellToCharIdx (Cell);
  1303. end;
  1304. vk_Next: begin
  1305. SavScrCol := ScrCol;
  1306. Cell := CharIdxToCell (CursorPos);
  1307. Inc (Cell.Row, PageHeight - 1);
  1308. Cell.Col := ScrColToCol (Cell.Row);
  1309. NewPos := CellToCharIdx (Cell);
  1310. end;
  1311. vk_Home: begin
  1312. Cell := CharIdxToCell (CursorPos);
  1313. if ssCtrl in Shift then
  1314. Cell.Row := 1;
  1315. Cell.Col := 1;
  1316. NewPos := CellToCharIdx (Cell);
  1317. end;
  1318. vk_End: begin
  1319. Cell := CharIdxToCell (CursorPos);
  1320. if ssCtrl in Shift then
  1321. Cell.Row := LineCount;
  1322. Cell.Col := LineLength [Cell.Row] + 1;
  1323. NewPos := CellToCharIdx (Cell);
  1324. end;
  1325. vk_Escape:
  1326. if FDragging and Assigned (DragOrigRange) then begin
  1327. DragOrigRange.Text := Selection.Text;
  1328. Selection.Text := '';
  1329. Selection.Assign (DragOrigRange);
  1330. CancelDragging;
  1331. DontNotify := False;
  1332. end;
  1333. end;
  1334. if NewPos <> Low (Integer) then begin
  1335. if ssShift in Shift then
  1336. CursorPos := NewPos
  1337. else
  1338. NoSelAtPos (NewPos);
  1339. ScrCol := SavScrCol;
  1340. ScrollInView (0);
  1341. end;
  1342. end;
  1343. if (UpCase (Char (Key)) = 'Z') and (ssCtrl in Shift) then begin
  1344. if ssShift in Shift then
  1345. Redo
  1346. else
  1347. Undo;
  1348. end;
  1349. if FDragging and (Key = vk_Control) then begin
  1350. P := ScreenToClient (Mouse.CursorPos);
  1351. MouseMove (Shift, P.X, P.Y);
  1352. end;
  1353. end;
  1354. if Shift = [ssCtrl] then
  1355. case UpCase (Char (Key)) of
  1356. 'X': if not ReadOnly then CutToClipboard;
  1357. 'C': CopyToClipboard;
  1358. 'V': if not ReadOnly then PasteFromClipboard;
  1359. end;
  1360. end;
  1361. procedure TMemoComponent.HandleKeyPress(var Key: Char);
  1362. var
  1363. BeginLn,
  1364. FirstChr: Integer;
  1365. begin
  1366. if ((Key >= #32) and (Key <> #127)) or (Key = #13) then
  1367. if not ReadOnly then
  1368. with Selection do begin
  1369. if Key = #13 then begin
  1370. if AutoIndent then begin
  1371. BeginLn := CellToCharIdx (TextCell (StartRowCol.Row, 1));
  1372. FirstChr := FirstNonWhiteSpace (Copy (Self.Text, BeginLn, RStart - BeginLn));
  1373. Text := #13#10 + Copy (Self.Text, BeginLn, FirstChr - 1);
  1374. end else
  1375. Text := #13#10;
  1376. end else
  1377. Text := Key;
  1378. ScrollInView (4);
  1379. end;
  1380. end;
  1381. procedure TMemoComponent.HandleKeyUp(var Key: Word; Shift: TShiftState);
  1382. var
  1383. P: TPoint;
  1384. begin
  1385. if (not ReadOnly) and FDragging and (Key = vk_Control) then begin
  1386. P := ScreenToClient (Mouse.CursorPos);
  1387. MouseMove (Shift, P.X, P.Y);
  1388. end;
  1389. end;
  1390. function TMemoComponent.IsUndoBeginEndBlock(Op: PUndoOperation): Boolean;
  1391. begin
  1392. Result := Op.RStart = -1;
  1393. end;
  1394. procedure TMemoComponent.KeyPress(var Key: Char);
  1395. begin
  1396. inherited;
  1397. HandleKeyPress (Key);
  1398. end;
  1399. procedure TMemoComponent.MakeRedoOperation(Op: PUndoOperation);
  1400. begin
  1401. if Assigned (Op) then begin
  1402. Op.NextItem := FRedoStack;
  1403. FRedoStack := Op;
  1404. end;
  1405. end;
  1406. procedure TMemoComponent.MakeUndoOperation(Op: PUndoOperation);
  1407. begin
  1408. if Assigned (Op) then begin
  1409. Op.NextItem := FUndoStack;
  1410. FUndoStack := Op;
  1411. end;
  1412. end;
  1413. procedure TMemoComponent.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  1414. var
  1415. Cell: TTextCell;
  1416. NewPos: Integer;
  1417. begin
  1418. inherited;
  1419. if not FDblClicked then begin
  1420. try
  1421. SetFocus;
  1422. except end;
  1423. if (Button = mbLeft) or ((Button = mbRight) and (Selection.RLength <= 0)) then begin
  1424. Cell := ScrPointToScrCell (Point (X, Y));
  1425. Inc (Cell.Row, VisibleRange.TopRow - 1);
  1426. Inc (Cell.Col, VisibleRange.LeftCol - 1);
  1427. CellFromScrCol (Cell);
  1428. NewPos := CellToCharIdx (Cell);
  1429. with Selection do
  1430. if ssShift in Shift then
  1431. CursorPos := NewPos
  1432. else begin
  1433. if DragDropEditing and (RLength > 0) and (RStart <= NewPos) and (REnd >= NewPos - 1) and (not ReadOnly) then
  1434. FStartDrag := True
  1435. else
  1436. NoSelAtPos (NewPos)
  1437. end;
  1438. if not (FSelecting or FStartDrag) then begin
  1439. FSelecting := True;
  1440. if HandleAllocated then
  1441. SetTimer (Handle, 1, 50, nil);
  1442. end;
  1443. end;
  1444. end;
  1445. end;
  1446. procedure TMemoComponent.MouseMove(Shift: TShiftState; X, Y: Integer);
  1447. begin
  1448. inherited;
  1449. if FStartDrag and (not FDragging) then begin
  1450. if not Assigned (DragOrigRange) then
  1451. DragOrigRange := TMCRange.Create (TrackedRanges);
  1452. with DragOrigRange do begin
  1453. RStart := Selection.RStart;
  1454. RLength := 0;
  1455. end;
  1456. FDragging := True;
  1457. SetCurCursor (ccDrag, True);
  1458. if HandleAllocated and (not FSelecting) then
  1459. SetTimer (Handle, 1, 50, nil);
  1460. FSelecting := False;
  1461. DontNotify := True;
  1462. end;
  1463. FStartDrag := False;
  1464. if FDragging and Assigned (DragOrigRange) then begin
  1465. if ssCtrl in Shift then
  1466. DragOrigRange.Text := Selection.Text
  1467. else
  1468. DragOrigRange.Text := '';
  1469. end;
  1470. MouseMoveInternal (X, Y);
  1471. end;
  1472. procedure TMemoComponent.MouseMoveInternal(X, Y: Integer);
  1473. var
  1474. Cell: TTextCell;
  1475. NewPos: Integer;
  1476. SelText,
  1477. MoveText: string;
  1478. DRStart,
  1479. DREnd: Integer;
  1480. begin
  1481. if (FSelecting or FDragging) and (not FDblClicked) then begin
  1482. Cell := ScrPointToScrCell (Point (X, Y));
  1483. Inc (Cell.Row, VisibleRange.TopRow - 1);
  1484. Inc (Cell.Col, VisibleRange.LeftCol - 1);
  1485. CellFromScrCol (Cell);
  1486. NewPos := CellToCharIdx (Cell);
  1487. if FSelecting then
  1488. Selection.CursorPos := NewPos
  1489. else if FDragging then begin
  1490. if Assigned (DragOrigRange) then begin
  1491. DRStart := DragOrigRange.RStart;
  1492. DREnd := DragOrigRange.REnd;
  1493. end else begin
  1494. DRStart := 0;
  1495. DREnd := 0;
  1496. end;
  1497. if (NewPos <= DRStart) or (NewPos > DREnd) then begin
  1498. with Selection do begin
  1499. SelText := Text;
  1500. if NewPos < RStart then begin
  1501. if (RStart - NewPos >= Length (SelText)) or ((DRStart >= NewPos) and (DRStart <= RStart)) then begin
  1502. Text := '';
  1503. NoSelAtPos (NewPos);
  1504. Text := SelText;
  1505. RStart := NewPos;
  1506. RLength := Length (SelText);
  1507. end else
  1508. with TMCRange.Create (nil) do try
  1509. Editor := Self;
  1510. RStart := NewPos;
  1511. RLength := Selection.RStart - NewPos;
  1512. MoveText := Text;
  1513. Text := '';
  1514. RStart := Selection.REnd + 1;
  1515. RLength := 0;
  1516. Text := MoveText;
  1517. if Assigned (DragOrigRange) then
  1518. with DragOrigRange do
  1519. if (REnd < RStart) and (RStart = Selection.REnd + 1) then
  1520. RStart := RStart + Length (MoveText);
  1521. finally
  1522. Free;
  1523. end;
  1524. end else if NewPos > REnd + 1 then begin
  1525. if (NewPos - (REnd + 1) >= Length (SelText)) or ((DRStart >= REnd + 1) and (DRStart <= NewPos)) then begin
  1526. Text := '';
  1527. NoSelAtPos (NewPos - Length (SelText));
  1528. Text := SelText;
  1529. RStart := NewPos - Length (SelText);
  1530. RLength := Length (SelText);
  1531. end else
  1532. with TMCRange.Create (nil) do try
  1533. Editor := Self;
  1534. RStart := Selection.REnd + 1;
  1535. RLength := NewPos - (Selection.REnd + 1);
  1536. MoveText := Text;
  1537. Text := '';
  1538. RStart := Selection.RStart;
  1539. RLength := 0;
  1540. Text := MoveText;
  1541. finally
  1542. Free;
  1543. end;
  1544. end;
  1545. end;
  1546. end;
  1547. end;
  1548. end;
  1549. if DragDropEditing and (not FStartDrag) and (not FDragging) and (not ReadOnly) then begin
  1550. Cell := ScrPointToScrCell (Point (X, Y));
  1551. Inc (Cell.Row, VisibleRange.TopRow - 1);
  1552. Inc (Cell.Col, VisibleRange.LeftCol - 1);
  1553. CellFromScrCol (Cell);
  1554. NewPos := CellToCharIdx (Cell);
  1555. with Selection do begin
  1556. if (RLength > 0) and (RStart <= NewPos) and (REnd >= NewPos - 1) then
  1557. SetCurCursor (ccArrow)
  1558. else
  1559. SetCurCursor (ccIBeam);
  1560. end;
  1561. end;
  1562. end;
  1563. procedure TMemoComponent.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  1564. var
  1565. Cell: TTextCell;
  1566. NewPos: Integer;
  1567. Op: PUndoOperation;
  1568. begin
  1569. inherited;
  1570. if FStartDrag then begin
  1571. FStartDrag := False;
  1572. Cell := ScrPointToScrCell (Point (X, Y));
  1573. Inc (Cell.Row, VisibleRange.TopRow - 1);
  1574. Inc (Cell.Col, VisibleRange.LeftCol - 1);
  1575. CellFromScrCol (Cell);
  1576. NewPos := CellToCharIdx (Cell);
  1577. Selection.NoSelAtPos (NewPos);
  1578. end;
  1579. if (Button in [mbLeft, mbRight]) and (FSelecting or FDragging) and (not FDblClicked) then begin
  1580. if FDragging then begin
  1581. if Assigned (DragOrigRange) then begin
  1582. if ssCtrl in Shift then
  1583. DragOrigRange.Text := Selection.Text
  1584. else
  1585. DragOrigRange.Text := '';
  1586. end;
  1587. if AllowUndo and ((Selection.RStart <> DragOrigRange.RStart) or (DragOrigRange.RLength > 0)) then begin
  1588. ClearRedo;
  1589. MakeUndoOperation (CreateUndoBeginEndBlock);
  1590. if Assigned (DragOrigRange) and (DragOrigRange.RLength <= 0) then begin
  1591. New (Op);
  1592. Op.RStart := DragOrigRange.RStart;
  1593. if Op.RStart > Selection.RStart then
  1594. Dec (Op.RStart, Selection.RLength);
  1595. Op.REnd := Op.RStart - 1;
  1596. Op.NewText := Selection.Text;
  1597. MakeUndoOperation (Op);
  1598. end;
  1599. New (Op);
  1600. Op.RStart := Selection.RStart;
  1601. Op.REnd := Selection.REnd;
  1602. Op.NewText := '';
  1603. MakeUndoOperation (Op);
  1604. MakeUndoOperation (CreateUndoBeginEndBlock);
  1605. DontNotify := False;
  1606. Change;
  1607. SelectionChange;
  1608. end;
  1609. DontNotify := False;
  1610. end;
  1611. CancelDragging;
  1612. end;
  1613. FDblClicked := False;
  1614. if Assigned (DragOrigRange) then begin
  1615. DragOrigRange.Free;
  1616. DragOrigRange := nil;
  1617. end;
  1618. end;
  1619. procedure TMemoComponent.Paint;
  1620. begin
  1621. inherited;
  1622. if not DrawingSuspended then begin
  1623. Selection.HideCaret;
  1624. if Bitmapped then begin
  1625. UpdateDrawBmp;
  1626. Canvas.Draw (0, 0, DrawBmp)
  1627. end else begin
  1628. DrawBorder (Rect (0, 0, LeftMargin, ClientHeight), Rect (0, 0, ClientWidth, TopMargin), Canvas);
  1629. VisibleRange.DrawRange;
  1630. end;
  1631. Selection.ShowCaret;
  1632. end;
  1633. end;
  1634. procedure TMemoComponent.PasteFromClipboard;
  1635. begin
  1636. Perform (wm_Paste, 0, 0);
  1637. end;
  1638. procedure TMemoComponent.ReCreateCaret;
  1639. begin
  1640. if HasFocus and HandleAllocated then begin
  1641. FreeCaret;
  1642. CreateCaret (Handle, 0, 2, FontHeight - 2);
  1643. FCaretCreated := True;
  1644. with Selection do begin
  1645. UpdateCaretPos;
  1646. ShowCaret;
  1647. end;
  1648. end;
  1649. end;
  1650. procedure TMemoComponent.Redo;
  1651. begin
  1652. Perform (em_Undo, 1, 0);
  1653. end;
  1654. procedure TMemoComponent.RemoveTrSp;
  1655. var
  1656. I: Integer;
  1657. begin
  1658. DontNotify := True;
  1659. try
  1660. Selection.DoChanging;
  1661. try
  1662. for I := 1 to LineCount do
  1663. RemoveTrSpFromLine (I);
  1664. finally
  1665. Selection.DoChange;
  1666. end;
  1667. finally
  1668. DontNotify := False;
  1669. end;
  1670. Self.Change;
  1671. end;
  1672. procedure TMemoComponent.RemoveTrSpFromLine(LineIdx: Integer);
  1673. var
  1674. I,
  1675. LastChar: Integer;
  1676. S: string;
  1677. begin
  1678. with TMCRange.Create (nil) do try
  1679. Editor := Self;
  1680. StartRowCol := TextCell (LineIdx, 1);
  1681. EndRowCol := TextCell (LineIdx + 1, -2);
  1682. S := Text;
  1683. LastChar := 0;
  1684. for I := Length (S) downto 1 do
  1685. if not (S [I] in [' ', #9]) then begin
  1686. LastChar := I;
  1687. Break;
  1688. end;
  1689. if LastChar < Length (S) then begin
  1690. RStart := RStart + LastChar;
  1691. Clear;
  1692. end;
  1693. finally
  1694. Free;
  1695. end;
  1696. end;
  1697. procedure TMemoComponent.RemoveTrSpFromString(var Str: string; IncludeLastLine: Boolean);
  1698. var
  1699. I,
  1700. P,
  1701. NextChar,
  1702. CurLineStart: Integer;
  1703. begin
  1704. CurLineStart := 1;
  1705. repeat
  1706. NextChar := Length (Str) + 1;
  1707. for I := CurLineStart to Length (Str) + 1 do begin
  1708. if ((I <= Length (Str)) and (Str [I] = #13)) or (IncludeLastLine and (I > Length (Str))) then begin
  1709. NextChar := I + 1;
  1710. for P := I - 1 downto CurLineStart do begin
  1711. if Str [P] in [' ', #9] then
  1712. Delete (Str, P, 1)
  1713. else
  1714. Break;
  1715. end;
  1716. Break;
  1717. end;
  1718. end;
  1719. while (NextChar <= Length (Str)) and (Str [NextChar] in [#13, #10]) do
  1720. Inc (NextChar);
  1721. CurLineStart := NextChar;
  1722. until NextChar > Length (Str);
  1723. end;
  1724. procedure TMemoComponent.ReplaceText(Range: TCustomRange; const NewText: string);
  1725. var
  1726. RS,
  1727. I,
  1728. L,
  1729. LI,
  1730. EI,
  1731. LC,
  1732. P,
  1733. BC,
  1734. LnCh,
  1735. RangeStart,
  1736. RangeEnd,
  1737. IStart,
  1738. IEnd: Integer;
  1739. S: string;
  1740. BlUndo,
  1741. PUN,
  1742. ChangedTopRow: Boolean;
  1743. Op: PUndoOperation;
  1744. begin
  1745. PUN := False;
  1746. LnCh := 0;
  1747. RangeStart := Range.RStart;
  1748. RangeEnd := Range.REnd;
  1749. with Selection do begin
  1750. DoChanging;
  1751. FOldSel.Free;
  1752. FOldSel := nil;
  1753. end;
  1754. RS := RangeStart;
  1755. S := AdjustLineBreaks (NewText);
  1756. if RemoveTrailingSpaces then
  1757. RemoveTrSpFromString (S);
  1758. L := Length (S);
  1759. if AllowUndo and not (FInUndo or FDragging) then begin
  1760. ClearRedo;
  1761. BlUndo := False;
  1762. Op := FUndoStack;
  1763. if Assigned (Op) then begin
  1764. if Range.RLength <= 0 then begin
  1765. if (L > 0) and (Length (Op.NewText) <= 0) and (Op.REnd >= Op.RStart) then begin
  1766. if Op.REnd + 1 = RS then begin
  1767. Inc (Op.REnd, L);
  1768. BlUndo := True;
  1769. end;
  1770. end;
  1771. end else begin
  1772. if (L <= 0) and (Length (Op.NewText) > 0) and (Op.REnd < Op.RStart) then begin
  1773. if Op.RStart = RS then begin
  1774. Op.NewText := Op.NewText + Range.Text;
  1775. BlUndo := True;
  1776. end else if Op.RStart = Range.REnd + 1 then begin
  1777. Dec (Op.RStart, Range.RLength);
  1778. Dec (Op.REnd, Range.RLength);
  1779. Op.NewText := Range.Text + Op.NewText;
  1780. BlUndo := True;
  1781. end;
  1782. end;
  1783. end;
  1784. end;
  1785. if not BlUndo then begin
  1786. New (Op);
  1787. Op.RStart := RS;
  1788. Op.REnd := RS + L - 1;
  1789. Op.NewText := Range.Text;
  1790. MakeUndoOperation (Op);
  1791. end;
  1792. end;
  1793. LI := CharIdxToCell(Range.RStart).Row;
  1794. EI := CharIdxToCell(Range.REnd+1).Row;
  1795. LC := L - Range.RLength;
  1796. if VisualLineLength [EI] >= FLongestLineLength then begin
  1797. FLongestLineLength := 0;
  1798. PUN := True;
  1799. end;
  1800. with FLineStarts do
  1801. if (Range.RStart = 1) and (Range.REnd = TextLength) then begin
  1802. LnCh := Count - 1;
  1803. Clear;
  1804. Add (1);
  1805. FLongestLineLength := 0;
  1806. PUN := True;
  1807. end else
  1808. for I := EI - 1 downto LI do begin
  1809. if (not PUN) and (VisualLineLength [I + 1] >= FLongestLineLength) then begin
  1810. FLongestLineLength := 0;
  1811. PUN := True;
  1812. end;
  1813. Delete (I);
  1814. Dec (LnCh);
  1815. end;
  1816. Delete (FText, RS, Range.RLength);
  1817. Insert (S, FText, RS);
  1818. FTextLength := Length (FText);
  1819. BC := 0;
  1820. for P := 1 to Length (S) - 1 do
  1821. if S [P] = #13 then begin
  1822. FLineStarts.Insert (LI + BC, Range.RStart + P + 1);
  1823. Inc (LnCh);
  1824. Inc (BC);
  1825. end;
  1826. with FLineStarts do begin
  1827. for I := LI + BC to Count - 1 do
  1828. Items [I] := Items [I] + LC;
  1829. if FLongestLineLength <= 0 then begin
  1830. IStart := 0;
  1831. IEnd := Count - 1;
  1832. end else begin
  1833. IStart := LI - 1;
  1834. IEnd := LI + BC;
  1835. end;
  1836. for I := IStart to IEnd do
  1837. if (I >= 0) and (I < Count) then begin
  1838. P := VisualLineLength [I + 1];
  1839. if P > FLongestLineLength then begin
  1840. FLongestLineLength := P;
  1841. PUN := True;
  1842. end;
  1843. end;
  1844. end;
  1845. with TrackedRanges do
  1846. for I := Count - 1 downto 0 do
  1847. if (Items [I] <> Range) and (Items [I] <> VisibleRange) then
  1848. Items[I].InternalDoMove (RangeStart, RangeEnd, LC);
  1849. if Assigned (FOnReplaceText) then
  1850. FOnReplaceText (Self, RS, LC);
  1851. ChangedTopRow := False;
  1852. if LnCh <> 0 then
  1853. with VisibleRange do
  1854. if LI < FTopRow then begin
  1855. Inc (FTopRow, LnCh);
  1856. ChangedTopRow := True;
  1857. end;
  1858. if Range is TSelectionRange then begin
  1859. TSelectionRange(Range).NoSelAtPos (RS + L);
  1860. end else
  1861. Range.RLength := L;
  1862. TextChangeNotification (RS, L - LC, L);
  1863. if PUN or (LnCh <> 0) then
  1864. UpdatePageSize;
  1865. with TMCRange.Create (nil) do begin
  1866. Editor := Self;
  1867. if ChangedTopRow then
  1868. RStart := VisibleRange.RStart
  1869. else
  1870. RStart := RS;
  1871. if LnCh <> 0 then
  1872. EndRowCol := VisibleRange.EndRowCol
  1873. else
  1874. EndRowCol := TextCell (EI + 1, 0);
  1875. DrawRange;
  1876. Free;
  1877. end;
  1878. TextChangeNotificationAfter;
  1879. Selection.DoChange;
  1880. Change;
  1881. end;
  1882. function TMemoComponent.ScrCellToScrPoint(Cell: TTextCell): TPoint;
  1883. begin
  1884. with Cell do
  1885. Result := Point ((Col - 1) * FontWidth + LeftMargin, (Row - 1) * FontHeight + TopMargin);
  1886. end;
  1887. procedure TMemoComponent.ScrollCaret;
  1888. begin
  1889. Selection.ScrollInView (4);
  1890. end;
  1891. function TMemoComponent.ScrPointToScrCell(P: TPoint): TTextCell;
  1892. begin
  1893. with P do
  1894. Result := TextCell ((Y - TopMargin) div FontHeight + 1, (X - LeftMargin + FontWidth div 2) div FontWidth + 1);
  1895. end;
  1896. procedure TMemoComponent.SelectAll;
  1897. begin
  1898. Selection.Assign (WholeText);
  1899. end;
  1900. procedure TMemoComponent.SelectionChange;
  1901. begin
  1902. if not DontNotify then begin
  1903. if Assigned (FOnSelectionChange) then
  1904. FOnSelectionChange(Self);
  1905. end;
  1906. end;
  1907. procedure TMemoComponent.SetAllowUndo(const Value: Boolean);
  1908. begin
  1909. FAllowUndo := Value;
  1910. if not FAllowUndo then
  1911. ClearUndo;
  1912. end;
  1913. procedure TMemoComponent.SetAlwaysShowCaret(const Value: Boolean);
  1914. begin
  1915. if FAlwaysShowCaret <> Value then begin
  1916. FAlwaysShowCaret := Value;
  1917. Selection.ShowCaret;
  1918. end;
  1919. end;
  1920. procedure TMemoComponent.SetBitmapped(const Value: Boolean);
  1921. begin
  1922. FBitmapped := Value;
  1923. if (not Value) and Assigned (DrawBmp) then begin
  1924. DrawBmp.Free;
  1925. DrawBmp := nil;
  1926. end;
  1927. end;
  1928. procedure TMemoComponent.SetBorderStyle(const Value: TBorderStyle);
  1929. begin
  1930. if FBorderStyle <> Value then begin
  1931. FBorderStyle := Value;
  1932. RecreateWnd;
  1933. end;
  1934. end;
  1935. procedure TMemoComponent.SetCurCursor(NewCursor: TCurCursor; Temporary: Boolean);
  1936. var
  1937. CursorHandle: ^HCursor;
  1938. begin
  1939. if FCurCursor <> NewCursor then begin
  1940. if FTempCursor and (NewCursor = ccNone) then
  1941. NewCursor := FCurCursor;
  1942. case NewCursor of
  1943. ccIBeam: begin
  1944. CursorHandle := @FCursorIBeam;
  1945. if CursorHandle^ = 0 then
  1946. CursorHandle^ := LoadCursor (0, idc_IBeam);
  1947. end;
  1948. ccArrow: begin
  1949. CursorHandle := @FCursorArrow;
  1950. if CursorHandle^ = 0 then
  1951. CursorHandle^ := LoadCursor (0, idc_Arrow);
  1952. end;
  1953. ccDrag: begin
  1954. CursorHandle := @FCursorDrag;
  1955. if CursorHandle^ = 0 then
  1956. CursorHandle^ := Screen.Cursors [crDrag];
  1957. end;
  1958. else
  1959. CursorHandle := nil;
  1960. end;
  1961. if Assigned (CursorHandle) and (CursorHandle^ <> 0) and not (csDesigning in ComponentState) then begin
  1962. if Temporary then begin
  1963. SetCursor (CursorHandle^);
  1964. FTempCursor := True;
  1965. end else begin
  1966. if FTempCursor then begin
  1967. SetCursor (CursorHandle^);
  1968. FTempCursor := False;
  1969. end;
  1970. SetClassLong (Handle, gcl_HCursor, CursorHandle^);
  1971. FCurCursor := NewCursor;
  1972. end;
  1973. end;
  1974. end;
  1975. end;
  1976. procedure TMemoComponent.SetHasFocus(const Value: Boolean);
  1977. begin
  1978. if FHasFocus <> Value then begin
  1979. FHasFocus := Value;
  1980. if not HasFocus then
  1981. FreeCaret;
  1982. Selection.DrawRange;
  1983. if HasFocus then
  1984. ReCreateCaret;
  1985. end;
  1986. end;
  1987. procedure TMemoComponent.SetLeftMargin(const Value: Integer);
  1988. begin
  1989. if FLeftMargin <> Value then begin
  1990. FLeftMargin := Value;
  1991. UpdatePageSize;
  1992. VisibleRange.Update;
  1993. VisibleRange.DrawRange;
  1994. Selection.UpdateCaretPos;
  1995. end;
  1996. end;
  1997. procedure TMemoComponent.SetLines(const Value: TStrings);
  1998. begin
  1999. FLines.Assign (Value);
  2000. end;
  2001. procedure TMemoComponent.SetReadOnly(const Value: Boolean);
  2002. begin
  2003. if FReadOnly <> Value then begin
  2004. FReadOnly := Value;
  2005. Selection.ShowCaret;
  2006. end;
  2007. end;
  2008. procedure TMemoComponent.SetRemoveTrailingSpaces(const Value: Boolean);
  2009. begin
  2010. if FRemoveTrailingSpaces <> Value then begin
  2011. FRemoveTrailingSpaces := Value;
  2012. if Value then
  2013. RemoveTrSp;
  2014. end;
  2015. end;
  2016. procedure TMemoComponent.SetScrollBars(const Value: TScrollStyle);
  2017. begin
  2018. if FScrollBars <> Value then begin
  2019. FScrollBars := Value;
  2020. RecreateWnd;
  2021. end;
  2022. end;
  2023. procedure TMemoComponent.SetSelLength(const Value: Integer);
  2024. begin
  2025. Selection.RLength := Value;
  2026. end;
  2027. procedure TMemoComponent.SetSelStart(const Value: Integer);
  2028. begin
  2029. Selection.NoSelAtPos (Value + 1);
  2030. end;
  2031. procedure TMemoComponent.SetTabSize(const Value: Integer);
  2032. var
  2033. I: Integer;
  2034. begin
  2035. if FTabSize <> Value then begin
  2036. FTabSize := Value;
  2037. if FTabSize < 1 then
  2038. FTabSize := 1;
  2039. Selection.DoChanging;
  2040. FLongestLineLength := 0;
  2041. for I := 0 to LineCount do
  2042. if FLongestLineLength < VisualLineLength [I] then
  2043. FLongestLineLength := VisualLineLength [I];
  2044. UpdatePageSize;
  2045. VisibleRange.Update;
  2046. VisibleRange.DrawRange;
  2047. Selection.UpdateCaretPos;
  2048. Selection.DoChange;
  2049. end;
  2050. end;
  2051. procedure TMemoComponent.SetText(const Value: TCaption);
  2052. begin
  2053. WholeText.Text := Value;
  2054. end;
  2055. procedure TMemoComponent.SetTopMargin(const Value: Integer);
  2056. begin
  2057. if FTopMargin <> Value then begin
  2058. FTopMargin := Value;
  2059. UpdatePageSize;
  2060. VisibleRange.Update;
  2061. VisibleRange.DrawRange;
  2062. Selection.UpdateCaretPos;
  2063. end;
  2064. end;
  2065. function TMemoComponent.TabSpacesAtPos(P: Integer): Integer;
  2066. var
  2067. I: Integer;
  2068. RS: TTextCell;
  2069. Ps: Integer;
  2070. begin
  2071. if TabSize <= 1 then
  2072. Result := TabSize
  2073. else begin
  2074. RS := CharIdxToCell (P);
  2075. RS.Col := 1;
  2076. Ps := 0;
  2077. for I := CellToCharIdx (RS) to P - 1 do begin
  2078. if Text [I] = #9 then
  2079. Ps := (Ps div TabSize + 1) * TabSize
  2080. else
  2081. Inc (Ps);
  2082. end;
  2083. Result := TabSize - Ps mod TabSize;
  2084. end;
  2085. end;
  2086. procedure TMemoComponent.TextChangeNotification(StartPos, OldLength,
  2087. NewLength: Integer);
  2088. begin
  2089. end;
  2090. procedure TMemoComponent.TextChangeNotificationAfter;
  2091. begin
  2092. end;
  2093. procedure TMemoComponent.Undo;
  2094. begin
  2095. Perform (em_Undo, 0, 0);
  2096. end;
  2097. procedure TMemoComponent.UpdateDrawBmp;
  2098. begin
  2099. if Bitmapped then begin
  2100. if not Assigned (DrawBmp) then
  2101. DrawBmp := TBitmap.Create;
  2102. if (DrawBmp.Width <> ClientWidth) or (DrawBmp.Height <> ClientHeight) then begin
  2103. DrawBmp.Width := ClientWidth;
  2104. DrawBmp.Height := ClientHeight;
  2105. DrawBorder (Rect (0, 0, LeftMargin, ClientHeight), Rect (0, 0, ClientWidth, TopMargin), DrawBmp.Canvas);
  2106. end;
  2107. end else
  2108. if Assigned (DrawBmp) then begin
  2109. DrawBmp.Free;
  2110. DrawBmp := nil;
  2111. end;
  2112. end;
  2113. procedure TMemoComponent.UpdateFontSize;
  2114. const
  2115. WidthMeasureChar = 'M';
  2116. HeightMeasureChar = 'Q';
  2117. procedure TryStyle(Style: TFontStyle);
  2118. begin
  2119. Canvas.Font.Style := Canvas.Font.Style + [Style];
  2120. if FontWidth <> Canvas.TextWidth (WidthMeasureChar) then
  2121. Include (FForbiddenFontStyles, Style);
  2122. Canvas.Font.Assign (Font);
  2123. end;
  2124. begin
  2125. FForbiddenFontStyles := [];
  2126. if HandleAllocated and Assigned (Parent) then begin
  2127. Canvas.Font.Assign (Font);
  2128. FontWidth := Canvas.TextWidth (WidthMeasureChar);
  2129. FontHeight := Canvas.TextHeight (HeightMeasureChar);
  2130. TryStyle (fsBold);
  2131. TryStyle (fsItalic);
  2132. ReCreateCaret;
  2133. UpdatePageSize;
  2134. end;
  2135. end;
  2136. procedure TMemoComponent.UpdatePageSize;
  2137. var
  2138. ScrollInfo: TScrollInfo;
  2139. DrawAll: Boolean;
  2140. begin
  2141. if HandleAllocated and Assigned (Parent) then begin
  2142. VisibleRange.DoChanging;
  2143. DrawAll := Bitmapped and ((not Assigned (DrawBmp)) or (DrawBmp.Width < ClientWidth) or (DrawBmp.Height < ClientHeight));
  2144. UpdateDrawBmp;
  2145. if FontHeight <= 0 then
  2146. FontHeight := 13;
  2147. if FontWidth <= 0 then
  2148. FontWidth := 8;
  2149. if HandleAllocated and Assigned (Parent) then begin
  2150. PageHeight := (ClientHeight - TopMargin) div FontHeight;
  2151. PageWidth := (ClientWidth - LeftMargin) div FontWidth;
  2152. end else begin
  2153. PageHeight := 1;
  2154. PageWidth := 1;
  2155. end;
  2156. if PageHeight < 1 then
  2157. PageHeight := 1;
  2158. if PageWidth < 1 then
  2159. PageWidth := 1;
  2160. VisibleRange.Update;
  2161. if HandleAllocated then begin
  2162. with ScrollInfo do begin
  2163. cbSize := SizeOf (ScrollInfo);
  2164. fMask := sif_All or sif_DisableNoScroll;
  2165. nMin := 1;
  2166. nMax := LineCount;
  2167. nPos := VisibleRange.TopRow;
  2168. nPage := PageHeight;
  2169. end;
  2170. SetScrollInfo (Handle, sb_Vert, ScrollInfo, True);
  2171. with ScrollInfo do begin
  2172. nMin := 1;
  2173. nMax := LongestLineLength;
  2174. nPos := VisibleRange.LeftCol;
  2175. nPage := PageWidth;
  2176. end;
  2177. SetScrollInfo (Handle, sb_Horz, ScrollInfo, True);
  2178. end;
  2179. VisibleRange.DoChange;
  2180. if DrawAll then
  2181. VisibleRange.DrawRange;
  2182. end;
  2183. end;
  2184. procedure TMemoComponent.WMClear(var Message: TWMClear);
  2185. begin
  2186. inherited;
  2187. Selection.Clear;
  2188. end;
  2189. procedure TMemoComponent.WMCopy(var Message: TWMCopy);
  2190. begin
  2191. inherited;
  2192. if Selection.RLength > 0 then
  2193. Clipboard.AsText := Selection.Text;
  2194. end;
  2195. procedure TMemoComponent.WMCut(var Message: TWMCut);
  2196. begin
  2197. inherited;
  2198. if Selection.RLength > 0 then begin
  2199. Clipboard.AsText := Selection.Text;
  2200. Selection.Clear;
  2201. end;
  2202. end;
  2203. procedure TMemoComponent.WMEraseBkgnd(var Message: TWMEraseBkgnd);
  2204. begin
  2205. Message.Result := 1;
  2206. end;
  2207. procedure TMemoComponent.WMGetDlgCode(var Message: TWMGetDlgCode);
  2208. begin
  2209. inherited;
  2210. if ReadOnly then
  2211. Message.Result := Message.Result or dlgc_WantArrows
  2212. else
  2213. Message.Result := Message.Result or dlgc_WantAllKeys;
  2214. end;
  2215. procedure TMemoComponent.WMGetText(var Message: TWMGetText);
  2216. begin
  2217. StrPLCopy (Message.Text, Text, Message.TextMax);
  2218. Message.Result := StrLen (Message.Text);
  2219. end;
  2220. procedure TMemoComponent.WMGetTextLength(var Message: TWMGetTextLength);
  2221. begin
  2222. Message.Result := TextLength;
  2223. end;
  2224. procedure TMemoComponent.WMHScroll(var Message: TWMHScroll);
  2225. var
  2226. ScrollPos: Integer;
  2227. OldPos: Integer;
  2228. begin
  2229. VisibleRange.DoChanging;
  2230. inherited;
  2231. OldPos := VisibleRange.LeftCol;
  2232. ScrollPos := OldPos;
  2233. with Message do begin
  2234. if ScrollCode in [sb_ThumbTrack, sb_ThumbPosition] then
  2235. ScrollPos := Pos
  2236. else begin
  2237. case ScrollCode of
  2238. sb_Top: ScrollPos := 1;
  2239. sb_Bottom: ScrollPos := LongestLineLength - PageWidth + 1;
  2240. sb_LineLeft: ScrollPos := OldPos - 1;
  2241. sb_LineRight: ScrollPos := OldPos + 1;
  2242. sb_PageLeft: ScrollPos := OldPos - PageWidth;
  2243. sb_PageRight: ScrollPos := OldPos + PageWidth;
  2244. end;
  2245. end;
  2246. Result := 0;
  2247. end;
  2248. if ScrollPos > LongestLineLength - PageWidth + 1 then
  2249. ScrollPos := LongestLineLength - PageWidth + 1;
  2250. if ScrollPos < 1 then
  2251. ScrollPos := 1;
  2252. if ScrollPos <> OldPos then begin
  2253. SetScrollPos (Handle, sb_Horz, ScrollPos, True);
  2254. VisibleRange.FLeftCol := ScrollPos;
  2255. VisibleRange.DoChange;
  2256. Update;
  2257. end else
  2258. VisibleRange.DoDiscardChanges;
  2259. end;
  2260. procedure TMemoComponent.WMKeyDown(var Message: TWMKeyDown);
  2261. begin
  2262. inherited;
  2263. HandleKeyDown (Message.CharCode, KeyDataToShiftState (Message.KeyData));
  2264. end;
  2265. procedure TMemoComponent.WMKeyUp(var Message: TWMKeyUp);
  2266. begin
  2267. HandleKeyUp (Message.CharCode, KeyDataToShiftState (Message.KeyData));
  2268. inherited;
  2269. end;
  2270. procedure TMemoComponent.WMKillFocus(var Message: TWMKillFocus);
  2271. begin
  2272. inherited;
  2273. HasFocus := False;
  2274. end;
  2275. procedure TMemoComponent.WMPaste(var Message: TWMPaste);
  2276. begin
  2277. inherited;
  2278. Selection.Text := Clipboard.AsText;
  2279. Selection.ScrollInView (1);
  2280. end;
  2281. procedure TMemoComponent.WMSetFocus(var Message: TWMSetFocus);
  2282. begin
  2283. inherited;
  2284. HasFocus := True;
  2285. end;
  2286. procedure TMemoComponent.WMSetText(var Message: TWMSetText);
  2287. begin
  2288. Text := StrPas (Message.Text);
  2289. Message.Result := 1;
  2290. end;
  2291. procedure TMemoComponent.WMSize(var Message: TWMSize);
  2292. begin
  2293. inherited;
  2294. UpdatePageSize;
  2295. end;
  2296. procedure TMemoComponent.WMTimer(var Message: TWMTimer);
  2297. var
  2298. P: TPoint;
  2299. DLeft,
  2300. DTop: Integer;
  2301. begin
  2302. inherited;
  2303. if (Message.TimerID = 1) and (FSelecting or FDragging) then begin
  2304. P := ScreenToClient (Mouse.CursorPos);
  2305. DLeft := 0;
  2306. DTop := 0;
  2307. if P.X < 0 then
  2308. DLeft := -((-1 - P.X) div ScrollOffset + 1)
  2309. else if P.X >= ClientWidth then
  2310. DLeft := ((P.X - ClientWidth) div ScrollOffset + 1);
  2311. if P.Y < 0 then
  2312. DTop := -((-1 - P.Y) div ScrollOffset + 1)
  2313. else if P.Y >= ClientHeight then
  2314. DTop := ((P.Y - ClientHeight) div ScrollOffset + 1);
  2315. if (DLeft <> 0) or (DTop <> 0) then begin
  2316. with VisibleRange do begin
  2317. if DLeft <> 0 then
  2318. LeftCol := LeftCol + DLeft;
  2319. if DTop <> 0 then
  2320. TopRow := TopRow + DTop;
  2321. end;
  2322. MouseMoveInternal (P.X, P.Y);
  2323. end;
  2324. end;
  2325. end;
  2326. procedure TMemoComponent.WMVScroll(var Message: TWMVScroll);
  2327. var
  2328. ScrollPos: Integer;
  2329. OldPos: Integer;
  2330. begin
  2331. VisibleRange.DoChanging;
  2332. inherited;
  2333. OldPos := GetScrollPos (Handle, sb_Vert);
  2334. ScrollPos := OldPos;
  2335. with Message do begin
  2336. if ScrollCode in [sb_ThumbTrack, sb_ThumbPosition] then
  2337. ScrollPos := Pos
  2338. else begin
  2339. case ScrollCode of
  2340. sb_Top: ScrollPos := 1;
  2341. sb_Bottom: ScrollPos := LineCount - PageHeight + 1;
  2342. sb_LineUp: ScrollPos := OldPos - 1;
  2343. sb_LineDown: ScrollPos := OldPos + 1;
  2344. sb_PageUp: ScrollPos := OldPos - PageHeight;
  2345. sb_PageDown: ScrollPos := OldPos + PageHeight;
  2346. end;
  2347. end;
  2348. Result := 0;
  2349. end;
  2350. if ScrollPos > LineCount - PageHeight + 1 then
  2351. ScrollPos := LineCount - PageHeight + 1;
  2352. if ScrollPos < 1 then
  2353. ScrollPos := 1;
  2354. if ScrollPos <> OldPos then begin
  2355. SetScrollPos (Handle, sb_Vert, ScrollPos, True);
  2356. VisibleRange.FTopRow := ScrollPos;
  2357. VisibleRange.DoChange;
  2358. Update;
  2359. end else
  2360. VisibleRange.DoDiscardChanges;
  2361. end;
  2362. { TIntegerList }
  2363. function TIntegerList.Add(Item: Integer): Integer;
  2364. begin
  2365. Result := FList.Add (Pointer (Item));
  2366. end;
  2367. procedure TIntegerList.Clear;
  2368. begin
  2369. FList.Clear;
  2370. end;
  2371. constructor TIntegerList.Create;
  2372. begin
  2373. inherited;
  2374. FList := TList.Create;
  2375. end;
  2376. procedure TIntegerList.Delete(Index: Integer);
  2377. begin
  2378. FList.Delete (Index);
  2379. end;
  2380. destructor TIntegerList.Destroy;
  2381. begin
  2382. FList.Free;
  2383. inherited;
  2384. end;
  2385. function TIntegerList.GetCount: Integer;
  2386. begin
  2387. Result := FList.Count;
  2388. end;
  2389. function TIntegerList.GetItem(ItemIndex: Integer): Integer;
  2390. begin
  2391. Result := Integer (FList.Items [ItemIndex]);
  2392. end;
  2393. procedure TIntegerList.Insert(Index, Item: Integer);
  2394. begin
  2395. FList.Insert (Index, Pointer (Item));
  2396. end;
  2397. procedure TIntegerList.SetCount(const Value: Integer);
  2398. begin
  2399. FList.Count := Value;
  2400. end;
  2401. procedure TIntegerList.SetItem(ItemIndex: Integer; const Value: Integer);
  2402. begin
  2403. FList.Items [ItemIndex] := Pointer (Value);
  2404. end;
  2405. { TMemoComponentStrings }
  2406. procedure TMemoComponentStrings.Clear;
  2407. begin
  2408. Memo.Clear;
  2409. end;
  2410. procedure TMemoComponentStrings.Delete(LineIndex: Integer);
  2411. var
  2412. Range: TCustomRange;
  2413. begin
  2414. Range := TMCRange.Create (nil);
  2415. with Range do begin
  2416. Editor := Memo;
  2417. if LineIndex < Memo.LineCount - 1 then begin
  2418. StartRowCol := TextCell (LineIndex + 1, 1);
  2419. EndRowCol := TextCell (LineIndex + 2, 0);
  2420. end else begin
  2421. StartRowCol := TextCell (LineIndex + 1, -1);
  2422. EndRowCol := TextCell (LineIndex + 2, -2);
  2423. end;
  2424. Clear;
  2425. Free;
  2426. end;
  2427. end;
  2428. function TMemoComponentStrings.Get(LineIndex: Integer): string;
  2429. var
  2430. Range: TCustomRange;
  2431. begin
  2432. Range := TMCRange.Create (nil);
  2433. with Range do begin
  2434. Editor := Memo;
  2435. StartRowCol := TextCell (LineIndex + 1, 1);
  2436. EndRowCol := TextCell (LineIndex + 2, -2);
  2437. Result := Text;
  2438. Free;
  2439. end;
  2440. end;
  2441. function TMemoComponentStrings.GetCount: Integer;
  2442. begin
  2443. if Memo.TextLength > 0 then
  2444. Result := Memo.LineCount
  2445. else
  2446. Result := 0;
  2447. end;
  2448. function TMemoComponentStrings.GetTextStr: string;
  2449. begin
  2450. Result := Memo.Text;
  2451. end;
  2452. procedure TMemoComponentStrings.Insert(LineIndex: Integer; const S: string);
  2453. var
  2454. Range: TCustomRange;
  2455. begin
  2456. if Memo.TextLength > 0 then begin
  2457. Range := TMCRange.Create (nil);
  2458. with Range do begin
  2459. Editor := Memo;
  2460. if LineIndex < Memo.LineCount then begin
  2461. StartRowCol := TextCell (LineIndex + 1, 1);
  2462. RLength := 0;
  2463. Text := S + #13#10;
  2464. end else begin
  2465. RStart := Memo.TextLength + 1;
  2466. RLength := 0;
  2467. Text := #13#10 + S;
  2468. end;
  2469. Free;
  2470. end;
  2471. end else
  2472. Memo.Text := S;
  2473. end;
  2474. procedure TMemoComponentStrings.Put(LineIndex: Integer; const S: string);
  2475. var
  2476. Range: TCustomRange;
  2477. begin
  2478. Range := TMCRange.Create (nil);
  2479. with Range do begin
  2480. Editor := Memo;
  2481. StartRowCol := TextCell (LineIndex + 1, 1);
  2482. EndRowCol := TextCell (LineIndex + 2, -2);
  2483. Text := S;
  2484. Free;
  2485. end;
  2486. end;
  2487. procedure TMemoComponentStrings.SetTextStr(const Value: string);
  2488. begin
  2489. Memo.Text := Value;
  2490. end;
  2491. { TMCRanges }
  2492. function TMCRanges.Add(Start, Count: Integer): TCustomRange;
  2493. begin
  2494. Result := Add;
  2495. with Result do begin
  2496. RStart := Start;
  2497. RLength := Count;
  2498. end;
  2499. end;
  2500. function TMCRanges.Add: TCustomRange;
  2501. begin
  2502. Result := FItemClass.Create(Self);
  2503. end;
  2504. constructor TMCRanges.Create(AOwner: TMemoComponent);
  2505. begin
  2506. inherited Create (AOwner, TCustomRange);
  2507. FItemClass := TMCRange;
  2508. end;
  2509. destructor TMCRanges.Destroy;
  2510. begin
  2511. FDestroying := True;
  2512. inherited;
  2513. end;
  2514. function TMCRanges.NewGetItem(ItemIndex: Integer): TCustomRange;
  2515. begin
  2516. Result := TCustomRange (GetItem (ItemIndex));
  2517. end;
  2518. function TMCRanges.NewGetOwner: TMemoComponent;
  2519. begin
  2520. Result := TMemoComponent (inherited Owner);
  2521. end;
  2522. { TCustomRange }
  2523. procedure TCustomRange.SetText(const Value: string);
  2524. begin
  2525. if Assigned (Editor) then
  2526. Editor.ReplaceText (Self, Value);
  2527. end;
  2528. function TCustomRange.GetText: string;
  2529. begin
  2530. if Assigned (Editor) then
  2531. Result := Copy (Editor.Text, RStart, RLength)
  2532. else
  2533. Result := '';
  2534. end;
  2535. function TCustomRange.GetEndRowCol: TTextCell;
  2536. begin
  2537. if Assigned (Editor) then
  2538. Result := Editor.CharIdxToCell (REnd)
  2539. else
  2540. Result := TextCell (1, 0);
  2541. end;
  2542. function TCustomRange.GetStartRowCol: TTextCell;
  2543. begin
  2544. if Assigned (Editor) then
  2545. Result := Editor.CharIdxToCell (RStart)
  2546. else
  2547. Result := TextCell (1, 1);
  2548. end;
  2549. procedure TCustomRange.SetEndRowCol(const Value: TTextCell);
  2550. begin
  2551. if Assigned (Editor) then
  2552. REnd := Editor.CellToCharIdx (Value);
  2553. end;
  2554. procedure TCustomRange.SetStartRowCol(const Value: TTextCell);
  2555. begin
  2556. if Assigned (Editor) then
  2557. RStart := Editor.CellToCharIdx (Value);
  2558. end;
  2559. function TCustomRange.GetRLength: Integer;
  2560. begin
  2561. Result := REnd - RStart + 1;
  2562. end;
  2563. procedure TCustomRange.SetRLength(const Value: Integer);
  2564. begin
  2565. REnd := RStart + Value - 1;
  2566. end;
  2567. procedure TCustomRange.SetREnd(const Value: Integer);
  2568. begin
  2569. end;
  2570. procedure TCustomRange.SetRStart(const Value: Integer);
  2571. begin
  2572. end;
  2573. procedure TCustomRange.NotifyOverwrite;
  2574. begin
  2575. if Assigned (FOnOverwrite) then
  2576. FOnOverwrite (Self);
  2577. end;
  2578. procedure TCustomRange.Clear;
  2579. begin
  2580. if RLength > 0 then
  2581. Text := '';
  2582. end;
  2583. function TCustomRange.CharInRange(CharIdx: Integer): Boolean;
  2584. begin
  2585. Result := (CharIdx >= RStart) and (CharIdx <= REnd);
  2586. end;
  2587. procedure TCustomRange.DrawRange;
  2588. var
  2589. Part: TMCRange;
  2590. I,
  2591. LC,
  2592. TR,
  2593. RowS,
  2594. RowE,
  2595. ColS,
  2596. ColE,
  2597. ScrCol: Integer;
  2598. AfterText: Boolean;
  2599. SC,
  2600. EC,
  2601. Cell: TTextCell;
  2602. Cnv: TCanvas;
  2603. begin
  2604. if Assigned (Editor) and Editor.HandleAllocated and Assigned (Editor.Parent) and (Editor.VisibleRange.FChanging = 0) and (not (Editor.DrawingSuspended and not Editor.Bitmapped)) and ((RLength > 0) or (Self is TVisibleRange) or (Self is TWholeTextRange) or (RStart >= Editor.TextLength)) then begin
  2605. if Editor.Bitmapped then begin
  2606. Editor.UpdateDrawBmp;
  2607. Cnv := Editor.DrawBmp.Canvas;
  2608. end else begin
  2609. Cnv := Editor.Canvas;
  2610. if (RStart >= Editor.Selection.CursorPos - 1) and (REnd <= Editor.Selection.CursorPos) then
  2611. Editor.Selection.HideCaret;
  2612. end;
  2613. if Editor.TextLength <= 0 then begin
  2614. Cnv.Brush.Color := Editor.Color;
  2615. Cnv.FillRect (Editor.ClientRect)
  2616. end else begin
  2617. LC := Editor.VisibleRange.LeftCol;
  2618. TR := Editor.VisibleRange.TopRow;
  2619. SC := StartRowCol;
  2620. EC := EndRowCol;
  2621. Part := TMCRange.Create (nil);
  2622. Part.Editor := Editor;
  2623. RowS := SC.Row;
  2624. if RowS < TR then
  2625. RowS := TR;
  2626. RowE := EC.Row;
  2627. if REnd >= Editor.TextLength then
  2628. Inc (RowE);
  2629. I := TR + Editor.PageHeight + 1;
  2630. if Editor.VisibleRange.REnd >= Editor.TextLength then
  2631. Inc (I);
  2632. if RowE > I then
  2633. RowE := I;
  2634. for I := RowS to RowE do begin
  2635. if I = SC.Row then begin
  2636. ColS := SC.Col;
  2637. Cell := TextCell (I, Editor.CellToScrCol (SC))
  2638. end else begin
  2639. ColS := 1;
  2640. Cell := TextCell (I, 1);
  2641. end;
  2642. if Cell.Col < Editor.VisibleRange.LeftCol then
  2643. Cell.Col := Editor.VisibleRange.LeftCol;
  2644. ScrCol := Editor.CellFromScrColToScrCol (Cell);
  2645. if I = EC.Row then
  2646. ColE := EC.Col
  2647. else
  2648. ColE := Editor.LineLength [I] + 2;
  2649. if ColE > Editor.VisibleRange.RightCol then
  2650. ColE := Editor.VisibleRange.RightCol;
  2651. AfterText := (I >= Editor.LineCount) and (Editor.CellToCharIdx (TextCell (I, ColS - 1)) > Editor.TextLength);
  2652. if AfterText then begin
  2653. Part.StartRowCol := TextCell (I + 1, -1);
  2654. with Editor.Selection do
  2655. if CharInRange (Part.RStart) then begin
  2656. if Editor.HasFocus then
  2657. Cnv.Brush.Color := clHighlight
  2658. else
  2659. Cnv.Brush.Color := clSilver;
  2660. end else begin
  2661. Cnv.Brush.Color := Editor.Color;
  2662. if (RStart >= Part.RStart) and (RStart <= Part.RStart + 2) then
  2663. HideCaret;
  2664. end;
  2665. Cnv.FillRect (Rect (Editor.LeftMargin, Editor.TopMargin + (I - TR) * Editor.FontHeight, Editor.ClientWidth, Editor.TopMargin + (I - TR + 1) * Editor.FontHeight));
  2666. end else begin
  2667. if (ColE >= ColS) or ((I >= Editor.LineCount) and (Editor.CellToCharIdx (TextCell (I, ColE)) >= Editor.TextLength)) then begin
  2668. Part.StartRowCol := Cell;
  2669. Part.EndRowCol := TextCell (I, ColE);
  2670. Editor.DrawTextLine (Part, Editor.LeftMargin + (ScrCol - LC) * Editor.FontWidth, Editor.TopMargin + (I - TR) * Editor.FontHeight, Editor.TabSize - (ScrCol - 1) mod Editor.TabSize);
  2671. end;
  2672. end;
  2673. if (I >= Editor.LineCount) or AfterText then begin
  2674. if Editor.Selection.RStart >= Editor.TextLength then
  2675. Editor.Selection.HideCaret;
  2676. Cnv.Brush.Color := Editor.Color;
  2677. Cnv.FillRect (Rect (Editor.LeftMargin, Editor.TopMargin + (Editor.LineCount - TR + 1) * Editor.FontHeight, Editor.ClientWidth, Editor.ClientHeight));
  2678. end;
  2679. end;
  2680. Part.Free;
  2681. end;
  2682. if Editor.Bitmapped then
  2683. Editor.Invalidate
  2684. else
  2685. Editor.Selection.ShowCaret;
  2686. end;
  2687. end;
  2688. constructor TCustomRange.Create(Collection: TFastObjectContainer);
  2689. begin
  2690. inherited;
  2691. if Collection is TMCRanges then
  2692. Editor := TMCRanges(Collection).Owner;
  2693. end;
  2694. procedure TCustomRange.Change;
  2695. begin
  2696. if Assigned (FOnChange) then
  2697. FOnChange (Self);
  2698. end;
  2699. function TCustomRange.GetEndPoint: TPoint;
  2700. var
  2701. Cell: TTextCell;
  2702. I: Integer;
  2703. Ps: Integer;
  2704. begin
  2705. if Assigned (Editor) then begin
  2706. Cell := EndRowCol;
  2707. with Cell do begin
  2708. if (REnd > 0) and (REnd <= Editor.TextLength) and (Editor.Text [REnd] in [#10, #13]) then begin
  2709. Inc (Row);
  2710. Col := 0;
  2711. end;
  2712. if Editor.TabSize = 1 then
  2713. Ps := Col
  2714. else begin
  2715. Ps := 0;
  2716. for I := Editor.CellToCharIdx (TextCell (Row, 1)) to REnd do begin
  2717. if (I > 0) and (I <= Editor.TextLength) and (Editor.Text [I] = #9) then
  2718. Ps := (Ps div Editor.TabSize + 1) * Editor.TabSize
  2719. else
  2720. Inc (Ps);
  2721. end;
  2722. end;
  2723. with Editor.VisibleRange do
  2724. Result := Editor.ScrCellToScrPoint (TextCell (Row - TopRow + 1, Ps - LeftCol + 2))
  2725. end;
  2726. end else
  2727. Result := Point (0, 0);
  2728. end;
  2729. function TCustomRange.GetStartPoint: TPoint;
  2730. var
  2731. Cell: TTextCell;
  2732. I: Integer;
  2733. Ps: Integer;
  2734. begin
  2735. if Assigned (Editor) then begin
  2736. Cell := StartRowCol;
  2737. with Cell do begin
  2738. if Editor.TabSize = 1 then
  2739. Ps := Col - 1
  2740. else begin
  2741. Ps := 0;
  2742. for I := Editor.CellToCharIdx (TextCell (Row, 1)) to RStart - 1 do begin
  2743. if (I > 0) and (I <= Editor.TextLength) and (Editor.Text [I] = #9) then
  2744. Ps := (Ps div Editor.TabSize + 1) * Editor.TabSize
  2745. else
  2746. Inc (Ps);
  2747. end;
  2748. end;
  2749. with Editor.VisibleRange do
  2750. Result := Editor.ScrCellToScrPoint (TextCell (Row - TopRow + 1, Ps - LeftCol + 2))
  2751. end;
  2752. end else
  2753. Result := Point (0, 0);
  2754. end;
  2755. procedure TCustomRange.Changing;
  2756. begin
  2757. end;
  2758. procedure TCustomRange.DoChange;
  2759. begin
  2760. Dec (FChanging);
  2761. if FChanging = 0 then
  2762. Change;
  2763. end;
  2764. procedure TCustomRange.DoChanging;
  2765. begin
  2766. if FChanging = 0 then
  2767. Changing;
  2768. Inc (FChanging);
  2769. end;
  2770. procedure TCustomRange.DiscardChanges;
  2771. begin
  2772. end;
  2773. procedure TCustomRange.DoDiscardChanges;
  2774. begin
  2775. Dec (FChanging);
  2776. if FChanging = 0 then
  2777. DiscardChanges;
  2778. end;
  2779. procedure TCustomRange.ScrollInView(FromBorder: Integer);
  2780. var
  2781. Cell: TTextCell;
  2782. LC,
  2783. Tolerance: Integer;
  2784. U: Boolean;
  2785. begin
  2786. if Assigned (Editor) then begin
  2787. if FromBorder < MaxScrollTolerance then
  2788. Tolerance := FromBorder
  2789. else
  2790. Tolerance := MaxScrollTolerance;
  2791. if (Self is TSelectionRange) and TSelectionRange(Self).Backwards then
  2792. Cell := StartRowCol
  2793. else
  2794. Cell := Editor.CharIdxToCell (REnd + 1);
  2795. Cell.Col := Editor.CellToScrCol (Cell);
  2796. with Editor.VisibleRange do begin
  2797. DoChanging;
  2798. U := True;
  2799. if TopRow > Cell.Row - Tolerance then
  2800. TopRow := Cell.Row - FromBorder
  2801. else if (TopRow < Cell.Row - Editor.PageHeight + 1) and (Editor.PageHeight > 1) then
  2802. TopRow := Cell.Row - Editor.PageHeight + 1 + FromBorder
  2803. else
  2804. U := False;
  2805. if LeftCol > Cell.Col - Tolerance then begin
  2806. LC := Cell.Col - FromBorder;
  2807. if LC < 1 then
  2808. LC := 1;
  2809. if LeftCol <> LC then begin
  2810. LeftCol := LC;
  2811. U := True;
  2812. end;
  2813. end else if LeftCol < Cell.Col - Editor.PageWidth then begin
  2814. LC := Cell.Col - Editor.PageWidth + FromBorder;
  2815. if LC < 1 then
  2816. LC := 1;
  2817. if LeftCol <> LC then begin
  2818. LeftCol := LC;
  2819. U := True;
  2820. end;
  2821. end;
  2822. if U then
  2823. DoChange
  2824. else
  2825. DoDiscardChanges;
  2826. end;
  2827. end;
  2828. end;
  2829. procedure TCustomRange.AssignTo(Dest: TPersistent);
  2830. begin
  2831. if Dest is TCustomRange then begin
  2832. with Dest as TCustomRange do begin
  2833. DoChanging;
  2834. RStart := Self.RStart;
  2835. REnd := Self.REnd;
  2836. DoChange;
  2837. end;
  2838. Exit;
  2839. end;
  2840. inherited;
  2841. end;
  2842. procedure TCustomRange.InternalDoMove(RangeStart, RangeEnd, LC: Integer);
  2843. var
  2844. RMod: Boolean;
  2845. RE: Integer;
  2846. AdjustRE: Boolean;
  2847. begin
  2848. // Warning: The same function exists for TMCRange.
  2849. // See the comments for that procedure.
  2850. DoChanging;
  2851. RMod := False;
  2852. if LC > 0 then begin
  2853. if (REnd >= RangeStart) and (REnd <= RangeEnd) then begin
  2854. if RStart > RangeStart then
  2855. RStart := RangeStart;
  2856. REnd := RangeStart - 1;
  2857. RMod := True;
  2858. end else if REnd > RangeEnd then
  2859. REnd := REnd + LC;
  2860. if (RStart >= RangeStart) and (RStart <= RangeEnd) then begin
  2861. RStart := RangeStart;
  2862. RMod := True;
  2863. end else if RStart > RangeEnd then begin
  2864. if RStart <= REnd then
  2865. RStart := RStart + LC;
  2866. end;
  2867. end else begin
  2868. RE := REnd;
  2869. AdjustRE := False;
  2870. if (RStart >= RangeStart) and (RStart <= RangeEnd) then begin
  2871. RStart := RangeStart;
  2872. RMod := True;
  2873. end else if RStart > RangeEnd then begin
  2874. if (RStart > RE) and (RE = RangeEnd) then
  2875. AdjustRE := True;
  2876. RStart := RStart + LC;
  2877. end;
  2878. if (not AdjustRE) and (RE >= RangeStart) and (RE <= RangeEnd) then begin
  2879. if RStart > RangeStart then
  2880. RStart := RangeStart;
  2881. REnd := RangeStart - 1;
  2882. RMod := True;
  2883. end else if AdjustRE or (RE > RangeEnd) then
  2884. REnd := RE + LC;
  2885. end;
  2886. DoChange;
  2887. if RMod and (RLength <= 0) then
  2888. NotifyOverwrite;
  2889. end;
  2890. { TMCRange }
  2891. constructor TMCRange.Create(Collection: TFastObjectContainer);
  2892. begin
  2893. inherited;
  2894. FRStart := 1;
  2895. end;
  2896. function TMCRange.GetREnd: Integer;
  2897. begin
  2898. Result := FREnd;
  2899. end;
  2900. function TMCRange.GetRStart: Integer;
  2901. begin
  2902. Result := FRStart;
  2903. end;
  2904. procedure TMCRange.InternalDoMove(RangeStart, RangeEnd, LC: Integer);
  2905. var
  2906. RMod: Boolean;
  2907. RE: Integer;
  2908. AdjustRE: Boolean;
  2909. begin
  2910. // Warning: The same function exists for TCustomRange.
  2911. DoChanging;
  2912. RMod := False;
  2913. if LC > 0 then begin
  2914. // Characters have been added to the range given by RangeStart and RangeEnd.
  2915. // First, adjust REnd.
  2916. if (FREnd >= RangeStart) and (FREnd <= RangeEnd) then begin
  2917. // The current range (Self) ends in the area that has been changed.
  2918. if FRStart > RangeStart then
  2919. // It also starts in the area, so let it start at the beginning.
  2920. FRStart := RangeStart;
  2921. // Let the range end at the last character that has stayed the same.
  2922. FREnd := RangeStart - 1;
  2923. // The current range has been 'overwritten'.
  2924. RMod := True;
  2925. end else if FREnd > RangeEnd then
  2926. // The current range ends behind the area that has been changed.
  2927. // No matter where it starts, it is moved by LC characters (LC > 0).
  2928. FREnd := FREnd + LC;
  2929. // Next, adjust RStart.
  2930. if (FRStart >= RangeStart) and (FRStart <= RangeEnd) then begin
  2931. // The current range (Self) starts in the area that has been changed.
  2932. // Let the range start at the beginning of the updated area.
  2933. FRStart := RangeStart;
  2934. // The current range has been 'overwritten'.
  2935. RMod := True;
  2936. end else if FRStart > RangeEnd then begin
  2937. // The current range starts behind the area that has been changed.
  2938. if FRStart <= FREnd then
  2939. // Special case: If the current range is empty, and REnd hasn't
  2940. // been moved to the right, then don't move RStart either.
  2941. // Otherwise, it is moved by LC characters (LC > 0).
  2942. FRStart := FRStart + LC;
  2943. end;
  2944. end else begin
  2945. // Characters have been removed from the range
  2946. // For TCustomRange, changing RStart may also change REnd; save REnd
  2947. // to avoid problems.
  2948. RE := FREnd;
  2949. AdjustRE := False;
  2950. // First, adjust RStart.
  2951. if (FRStart >= RangeStart) and (FRStart <= RangeEnd) then begin
  2952. // The current range (Self) starts in the area that has been changed.
  2953. // Let the range start at the beginning of the updated area.
  2954. FRStart := RangeStart;
  2955. // The current range has been 'overwritten'.
  2956. RMod := True;
  2957. end else if FRStart > RangeEnd then begin
  2958. // The current range starts behind the area that has been changed.
  2959. // No matter where it ends, it is moved by LC characters (LC <= 0).
  2960. if (FRStart > RE) and (RE = RangeEnd) then
  2961. // If the range is empty and starts directly after the changed area,
  2962. // REnd would normally not be adjusted correctly. So do this manually.
  2963. AdjustRE := True;
  2964. FRStart := FRStart + LC;
  2965. end;
  2966. if (not AdjustRE) and (RE >= RangeStart) and (RE <= RangeEnd) then begin
  2967. // The current range (Self) ends in the area that has been changed.
  2968. if FRStart > RangeStart then
  2969. FRStart := RangeStart;
  2970. // Let the range end at the last character that has stayed the same.
  2971. FREnd := RangeStart - 1;
  2972. // The current range has been 'overwritten'.
  2973. RMod := True;
  2974. end else if AdjustRE or (RE > RangeEnd) then
  2975. // The current range ends behind the area that has been changed.
  2976. // No matter where it starts, it is moved by LC characters (LC <= 0).
  2977. FREnd := RE + LC;
  2978. end;
  2979. DoChange;
  2980. if RMod and (FREnd < FRStart) then
  2981. // The range has been completely overwritten.
  2982. NotifyOverwrite;
  2983. end;
  2984. procedure TMCRange.SetREnd(const Value: Integer);
  2985. begin
  2986. DoChanging;
  2987. FREnd := Value;
  2988. if FREnd < RStart - 1 then
  2989. FREnd := RStart - 1;
  2990. if Assigned (Editor) and (FREnd > Editor.TextLength) then
  2991. FREnd := Editor.TextLength;
  2992. DoChange;
  2993. end;
  2994. procedure TMCRange.SetRStart(const Value: Integer);
  2995. begin
  2996. DoChanging;
  2997. FRStart := Value;
  2998. if FRStart < 1 then
  2999. FRStart := 1;
  3000. if Assigned (Editor) and (FRStart > Editor.TextLength + 1) then
  3001. FRStart := Editor.TextLength + 1;
  3002. REnd := REnd;
  3003. DoChange;
  3004. end;
  3005. { TWholeTextRange }
  3006. function TWholeTextRange.GetREnd: Integer;
  3007. begin
  3008. if Assigned (Editor) then
  3009. Result := Editor.TextLength
  3010. else
  3011. Result := 0;
  3012. end;
  3013. function TWholeTextRange.GetRStart: Integer;
  3014. begin
  3015. Result := 1;
  3016. end;
  3017. { TVisibleRange }
  3018. procedure TVisibleRange.Change;
  3019. function DivDown(Div1, Div2: Integer): Integer;
  3020. begin
  3021. Result := Div1 div Div2;
  3022. end;
  3023. function DivUp(Div1, Div2: Integer): Integer;
  3024. begin
  3025. Result := (Div1 - 1) div Div2 + 1;
  3026. end;
  3027. var
  3028. NewTextRect,
  3029. EditorRect,
  3030. UpdateRect: TRect;
  3031. begin
  3032. inherited;
  3033. if Assigned (Editor) and Editor.HandleAllocated then begin
  3034. NewTextRect := Rect (FLeftCol, FTopRow, FLeftCol + Editor.PageWidth + 1, FTopRow + Editor.PageHeight + 1);
  3035. if not EqualRect (VisibleTextRect, NewTextRect) then
  3036. with Editor.Selection do begin
  3037. HideCaret;
  3038. if (NewTextRect.Left <> VisibleTextRect.Left) or (NewTextRect.Top >= VisibleTextRect.Bottom - 1) or (VisibleTextRect.Top >= NewTextRect.Bottom - 1) then
  3039. Self.DrawRange
  3040. else with Editor do begin
  3041. EditorRect := ClientRect;
  3042. Inc (EditorRect.Left, Editor.LeftMargin);
  3043. Inc (EditorRect.Top, Editor.TopMargin);
  3044. if VisibleTextRect.Top <> NewTextRect.Top then begin
  3045. if Bitmapped and Assigned (DrawBmp) then begin
  3046. if VisibleTextRect.Top > NewTextRect.Top then begin
  3047. BitBlt (DrawBmp.Canvas.Handle, LeftMargin, TopMargin, DrawBmp.Width - LeftMargin, DrawBmp.Height - TopMargin - (NewTextRect.Top - VisibleTextRect.Top) * FontHeight, DrawBmp.Canvas.Handle, LeftMargin, TopMargin + (NewTextRect.Top - VisibleTextRect.Top) * FontHeight, SrcCopy);
  3048. UpdateRect := Rect (LeftMargin, TopMargin, ClientWidth, TopMargin + (VisibleTextRect.Top - NewTextRect.Top) * FontHeight);
  3049. end else begin
  3050. BitBlt (DrawBmp.Canvas.Handle, LeftMargin, TopMargin + (VisibleTextRect.Top - NewTextRect.Top) * FontHeight, DrawBmp.Width - LeftMargin, DrawBmp.Height - TopMargin - (VisibleTextRect.Top - NewTextRect.Top) * FontHeight, DrawBmp.Canvas.Handle, LeftMargin, TopMargin, SrcCopy);
  3051. UpdateRect := Rect (LeftMargin, ClientHeight - (NewTextRect.Top - VisibleTextRect.Top) * FontHeight, ClientWidth, ClientHeight);
  3052. end;
  3053. end else
  3054. ScrollWindowEx (Handle, 0, (VisibleTextRect.Top - NewTextRect.Top) * FontHeight, @EditorRect, @EditorRect, 0, @UpdateRect, 0);
  3055. end else
  3056. UpdateRect := Rect (0, 0, -1, -1);
  3057. if not IsRectEmpty (UpdateRect) then
  3058. with TMCRange.Create (nil) do begin
  3059. Editor := Self.Editor;
  3060. StartRowCol := TextCell (DivDown (UpdateRect.Top, FontHeight) + FTopRow, 1);
  3061. EndRowCol := TextCell (DivUp (UpdateRect.Bottom, FontHeight) + FTopRow, 1);
  3062. DrawRange;
  3063. Free;
  3064. end;
  3065. if Bitmapped and Assigned (DrawBmp) then
  3066. Invalidate;
  3067. end;
  3068. UpdateCaretPos;
  3069. ShowCaret;
  3070. end;
  3071. end;
  3072. end;
  3073. procedure TVisibleRange.Changing;
  3074. begin
  3075. if Assigned (Editor) then
  3076. VisibleTextRect := Rect (FLeftCol, FTopRow, FLeftCol + Editor.PageWidth + 1, FTopRow + Editor.PageHeight + 1)
  3077. else
  3078. VisibleTextRect := Rect (0, 0, 0, 0);
  3079. end;
  3080. constructor TVisibleRange.Create(Collection: TFastObjectContainer);
  3081. begin
  3082. inherited;
  3083. FTopRow := 1;
  3084. FLeftCol := 1;
  3085. end;
  3086. function TVisibleRange.GetBottomRow: Integer;
  3087. begin
  3088. if Assigned (Editor) then
  3089. Result := TopRow + Editor.PageHeight + 1
  3090. else
  3091. Result := TopRow;
  3092. end;
  3093. function TVisibleRange.GetEndRowCol: TTextCell;
  3094. begin
  3095. if Assigned (Editor) then begin
  3096. Result := TextCell (FTopRow + Editor.PageHeight + 1, 0);
  3097. if Editor.CellToCharIdx (Result) > Editor.TextLength then
  3098. Result := Editor.CharIdxToCell (Editor.TextLength);
  3099. end else
  3100. Result := TextCell (FTopRow, 0);
  3101. end;
  3102. function TVisibleRange.GetREnd: Integer;
  3103. begin
  3104. if Assigned (Editor) then
  3105. Result := Editor.CellToCharIdx (EndRowCol)
  3106. else
  3107. Result := 0;
  3108. end;
  3109. function TVisibleRange.GetRightCol: Integer;
  3110. begin
  3111. if Assigned (Editor) then
  3112. Result := LeftCol + Editor.PageWidth + 1
  3113. else
  3114. Result := LeftCol;
  3115. end;
  3116. function TVisibleRange.GetRStart: Integer;
  3117. begin
  3118. if Assigned (Editor) then
  3119. Result := Editor.CellToCharIdx (StartRowCol)
  3120. else
  3121. Result := 1;
  3122. end;
  3123. function TVisibleRange.GetStartRowCol: TTextCell;
  3124. begin
  3125. Result := TextCell (FTopRow, 1);
  3126. end;
  3127. procedure TVisibleRange.SetBottomRow(const Value: Integer);
  3128. begin
  3129. if Assigned (Editor) then
  3130. TopRow := Value - Editor.PageHeight
  3131. else
  3132. TopRow := Value;
  3133. end;
  3134. procedure TVisibleRange.SetEndRowCol(const Value: TTextCell);
  3135. begin
  3136. end;
  3137. procedure TVisibleRange.SetLeftCol(const Value: Integer);
  3138. begin
  3139. if FLeftCol <> Value then begin
  3140. DoChanging;
  3141. FLeftCol := Value;
  3142. Update;
  3143. DoChange;
  3144. end;
  3145. end;
  3146. procedure TVisibleRange.SetREnd(const Value: Integer);
  3147. begin
  3148. end;
  3149. procedure TVisibleRange.SetRightCol(const Value: Integer);
  3150. begin
  3151. if Assigned (Editor) then
  3152. LeftCol := Value - Editor.PageWidth
  3153. else
  3154. LeftCol := Value;
  3155. end;
  3156. procedure TVisibleRange.SetRLength(const Value: Integer);
  3157. begin
  3158. end;
  3159. procedure TVisibleRange.SetRStart(const Value: Integer);
  3160. begin
  3161. if Assigned (Editor) then
  3162. StartRowCol := Editor.CharIdxToCell (Value);
  3163. end;
  3164. procedure TVisibleRange.SetStartRowCol(const Value: TTextCell);
  3165. begin
  3166. TopRow := Value.Row;
  3167. end;
  3168. procedure TVisibleRange.SetTopRow(const Value: Integer);
  3169. begin
  3170. if FTopRow <> Value then begin
  3171. DoChanging;
  3172. FTopRow := Value;
  3173. Update;
  3174. DoChange;
  3175. end;
  3176. end;
  3177. procedure TVisibleRange.Update;
  3178. begin
  3179. if Assigned (Editor) and (FTopRow > Editor.LineCount - Editor.PageHeight + 1) then
  3180. FTopRow := Editor.LineCount - Editor.PageHeight + 1;
  3181. if FTopRow < 1 then
  3182. FTopRow := 1;
  3183. if Assigned (Editor) and (FLeftCol > Editor.LongestLineLength - Editor.PageWidth + 1) then
  3184. FLeftCol := Editor.LongestLineLength - Editor.PageWidth + 1;
  3185. if FLeftCol < 1 then
  3186. FLeftCol := 1;
  3187. if Assigned (Editor) and Editor.HandleAllocated then begin
  3188. SetScrollPos (Editor.Handle, sb_Vert, FTopRow, True);
  3189. SetScrollPos (Editor.Handle, sb_Horz, FLeftCol, True);
  3190. end;
  3191. end;
  3192. { TSelectionRange }
  3193. procedure TSelectionRange.AssignTo(Dest: TPersistent);
  3194. begin
  3195. inherited;
  3196. if Dest is TSelectionRange then
  3197. with Dest as TSelectionRange do
  3198. Backwards := Self.Backwards;
  3199. end;
  3200. procedure TSelectionRange.Change;
  3201. var
  3202. RS: Integer;
  3203. begin
  3204. inherited;
  3205. if Assigned (FOldSel) then
  3206. with FOldSel do begin
  3207. if Assigned (Editor) and Editor.RemoveTrailingSpaces and (Self.StartRowCol.Row <> StartRowCol.Row) and (not Editor.FInUndo) then
  3208. Editor.RemoveTrSpFromLine (StartRowCol.Row);
  3209. if Self.RStart = RStart then begin
  3210. if Self.REnd > REnd then begin
  3211. RStart := REnd + 1;
  3212. REnd := Self.REnd;
  3213. end else
  3214. RStart := Self.REnd + 1;
  3215. end else if Self.REnd = REnd then begin
  3216. if Self.RStart < RStart then begin
  3217. RS := RStart;
  3218. RStart := Self.RStart;
  3219. REnd := RS - 1;
  3220. end else
  3221. REnd := Self.RStart - 1;
  3222. end else
  3223. if Self.RLength > 0 then
  3224. Self.DrawRange;
  3225. if RLength > 0 then
  3226. DrawRange;
  3227. Free;
  3228. end;
  3229. FOldSel := nil;
  3230. UpdateCaretPos;
  3231. ShowCaret;
  3232. if Assigned (Editor) then
  3233. Editor.SelectionChange;
  3234. end;
  3235. procedure TSelectionRange.Changing;
  3236. begin
  3237. inherited;
  3238. HideCaret;
  3239. FScrCol := -1;
  3240. FOldSel := TMCRange.Create (nil);
  3241. FOldSel.Editor := Editor;
  3242. FOldSel.Assign (Self);
  3243. end;
  3244. procedure TSelectionRange.DiscardChanges;
  3245. begin
  3246. inherited;
  3247. if Assigned (FOldSel) then
  3248. FOldSel.Free;
  3249. FOldSel := nil;
  3250. UpdateCaretPos;
  3251. ShowCaret;
  3252. end;
  3253. function TSelectionRange.GetCursorPos: Integer;
  3254. begin
  3255. if Backwards then
  3256. Result := RStart
  3257. else
  3258. Result := REnd + 1;
  3259. end;
  3260. function TSelectionRange.GetScrCol: Integer;
  3261. begin
  3262. if FScrCol <= 0 then begin
  3263. if Assigned (Editor) then
  3264. FScrCol := Editor.CellToScrCol (Editor.CharIdxToCell (CursorPos))
  3265. else
  3266. FScrCol := 1;
  3267. end;
  3268. Result := FScrCol;
  3269. end;
  3270. procedure TSelectionRange.HideCaret;
  3271. begin
  3272. if Assigned (Editor) and Editor.FCaretCreated and FCaretShowing and Editor.HandleAllocated then begin
  3273. Windows.HideCaret (Editor.Handle);
  3274. FCaretShowing := False;
  3275. end;
  3276. end;
  3277. procedure TSelectionRange.NoSelAtPos(Pos: Integer);
  3278. begin
  3279. DoChanging;
  3280. Backwards := False;
  3281. RStart := Pos;
  3282. REnd := Pos - 1;
  3283. DoChange;
  3284. end;
  3285. function TSelectionRange.ScrColToCol(Row: Integer): Integer;
  3286. var
  3287. Cell: TTextCell;
  3288. begin
  3289. Cell.Row := Row;
  3290. Cell.Col := ScrCol;
  3291. if Assigned (Editor) then begin
  3292. Editor.CellFromScrCol (Cell);
  3293. if Cell.Col > Editor.LineLength [Row] + 1 then
  3294. Cell.Col := Editor.LineLength [Row] + 1;
  3295. end;
  3296. Result := Cell.Col;
  3297. end;
  3298. procedure TSelectionRange.SelectWord(Directions: TSelectWordDirections);
  3299. var
  3300. WS,
  3301. WE: Integer;
  3302. S: string;
  3303. begin
  3304. if Assigned (Editor) then begin
  3305. S := Editor.Text;
  3306. WS := RStart;
  3307. if swLeft in Directions then
  3308. while (WS > 1) and (IsCharAlphaNumeric (S [WS - 1]) or (S [WS - 1] in ['A'..'Z', 'a'..'z', '0'..'9', '_', '$', '#'])) do
  3309. Dec (WS);
  3310. WE := REnd;
  3311. if swRight in Directions then
  3312. while (WE < Length (S)) and (IsCharAlphaNumeric (S [WE + 1]) or (S [WE + 1] in ['A'..'Z', 'a'..'z', '0'..'9', '_', '$', '#'])) do
  3313. Inc (WE);
  3314. RStart := WS;
  3315. REnd := WE;
  3316. end;
  3317. end;
  3318. procedure TSelectionRange.SetCursorPos(const Value: Integer);
  3319. begin
  3320. if Backwards then begin
  3321. if Value <= REnd then
  3322. RStart := Value
  3323. else begin
  3324. Backwards := False;
  3325. RStart := REnd + 1;
  3326. REnd := Value - 1;
  3327. end;
  3328. end else begin
  3329. if Value - 1 >= RStart - 1 then
  3330. REnd := Value - 1
  3331. else begin
  3332. Backwards := True;
  3333. REnd := RStart - 1;
  3334. RStart := Value;
  3335. end;
  3336. end;
  3337. end;
  3338. procedure TSelectionRange.SetText(const Value: string);
  3339. begin
  3340. if Assigned (Editor) then
  3341. with Editor do
  3342. if FSelecting then
  3343. MouseUp (mbLeft, [], 0, 0);
  3344. inherited;
  3345. end;
  3346. procedure TSelectionRange.ShowCaret;
  3347. begin
  3348. if FChanging <= 0 then begin
  3349. if Assigned (Editor) and Editor.FCaretCreated and ((RLength = 0) or (Editor.AlwaysShowCaret)) and Editor.HasFocus and (not Editor.ReadOnly) and Editor.HandleAllocated then begin
  3350. if not FCaretShowing then begin
  3351. Windows.ShowCaret (Editor.Handle);
  3352. FCaretShowing := True;
  3353. end;
  3354. end else
  3355. HideCaret;
  3356. end;
  3357. end;
  3358. procedure TSelectionRange.UpdateCaretPos;
  3359. var
  3360. P: TPoint;
  3361. begin
  3362. if Assigned (Editor) and Editor.FCaretCreated and (FChanging <= 0) then begin
  3363. if Backwards then
  3364. P := StartPoint
  3365. else
  3366. P := EndPoint;
  3367. SetCaretPos (P.X - 1, P.Y + 1);
  3368. end;
  3369. end;
  3370. { TCustomFormattedRange }
  3371. procedure TCustomFormattedRange.AssignTo(Dest: TPersistent);
  3372. begin
  3373. inherited;
  3374. if Dest is TCustomFormattedRange then
  3375. with Dest as TCustomFormattedRange do begin
  3376. Color := Self.Color;
  3377. Font := Self.Font;
  3378. end;
  3379. end;
  3380. procedure TCustomFormattedRange.CleanUpFont;
  3381. begin
  3382. if Assigned (Editor) then
  3383. Font.Style := Font.Style - Editor.ForbiddenFontStyles;
  3384. end;
  3385. procedure TCustomFormattedRange.SetColor(const Value: TColor);
  3386. begin
  3387. end;
  3388. procedure TCustomFormattedRange.SetFont(const Value: TFont);
  3389. begin
  3390. end;
  3391. { TFormattedRange }
  3392. constructor TFormattedRange.Create(Collection: TFastObjectContainer);
  3393. begin
  3394. inherited;
  3395. FFont := TFont.Create;
  3396. end;
  3397. destructor TFormattedRange.Destroy;
  3398. begin
  3399. FFont.Free;
  3400. inherited;
  3401. end;
  3402. function TFormattedRange.GetColor: TColor;
  3403. begin
  3404. Result := FColor;
  3405. end;
  3406. function TFormattedRange.GetFont: TFont;
  3407. begin
  3408. Result := FFont;
  3409. end;
  3410. procedure TFormattedRange.SetColor(const Value: TColor);
  3411. begin
  3412. FColor := Value;
  3413. end;
  3414. procedure TFormattedRange.SetFont(const Value: TFont);
  3415. begin
  3416. if Assigned (Value) then
  3417. FFont.Assign (Value);
  3418. end;
  3419. { TNormalFormattedRange }
  3420. function TNormalFormattedRange.GetColor: TColor;
  3421. begin
  3422. if Assigned (Editor) then
  3423. Result := Editor.Color
  3424. else
  3425. Result := clWindow;
  3426. end;
  3427. function TNormalFormattedRange.GetFont: TFont;
  3428. begin
  3429. if Assigned (Editor) then
  3430. Result := Editor.Font
  3431. else
  3432. Result := nil;
  3433. end;
  3434. end.