MemoComponentUnit.pas 94 KB

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