viewercontrol.pas 106 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573357435753576357735783579358035813582358335843585358635873588358935903591359235933594359535963597359835993600360136023603360436053606360736083609361036113612361336143615361636173618361936203621362236233624362536263627362836293630363136323633363436353636363736383639364036413642364336443645364636473648364936503651365236533654365536563657365836593660366136623663366436653666366736683669367036713672367336743675367636773678367936803681368236833684368536863687368836893690369136923693369436953696369736983699370037013702370337043705370637073708370937103711371237133714371537163717371837193720372137223723372437253726372737283729373037313732373337343735373637373738373937403741374237433744374537463747374837493750375137523753375437553756375737583759376037613762376337643765376637673768376937703771377237733774377537763777377837793780378137823783378437853786378737883789379037913792379337943795379637973798379938003801380238033804380538063807380838093810381138123813381438153816381738183819382038213822382338243825382638273828382938303831383238333834383538363837383838393840384138423843384438453846384738483849385038513852385338543855385638573858385938603861386238633864386538663867386838693870387138723873387438753876387738783879388038813882388338843885388638873888388938903891389238933894389538963897389838993900390139023903390439053906390739083909391039113912391339143915391639173918391939203921392239233924392539263927392839293930393139323933393439353936393739383939394039413942394339443945394639473948394939503951395239533954395539563957
  1. {
  2. Double Commander
  3. -------------------------------------------------------------------------
  4. Show file in the text, bin, hex or dec mode
  5. Copyright (C) 2004 Radek Cervinka ([email protected])
  6. Copyright (C) 2006-2025 Alexander Koblov ([email protected])
  7. This program is free software; you can redistribute it and/or modify
  8. it under the terms of the GNU General Public License as published by
  9. the Free Software Foundation; either version 2 of the License, or
  10. (at your option) any later version.
  11. This program is distributed in the hope that it will be useful,
  12. but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  14. GNU General Public License for more details.
  15. You should have received a copy of the GNU General Public License
  16. along with this program. If not, see <http://www.gnu.org/licenses/>.
  17. }
  18. (*
  19. TODO:
  20. a) File mapping blocks writing into file by other processes.
  21. Either:
  22. + Open small text files by reading them all into memory (done).
  23. - Add optional custom loading/caching portions of file in memory
  24. and only reading from file when neccessary.
  25. b) Selecting text does not work well with composed Unicode characters
  26. (characters that are composed of multiple Unicode characters).
  27. c) Drawing/selecting text does not work correctly with RTL (right to left) text.
  28. d) FTextHeight is unreliable with complex unicode characters. It should be
  29. calculated based on currently displayed text (get max from each line's height).
  30. *)
  31. unit ViewerControl;
  32. {$mode objfpc}{$H+}
  33. interface
  34. uses
  35. SysUtils, Classes, Controls, StdCtrls, LCLVersion, LMessages, fgl;
  36. const
  37. MaxMemSize = $400000; // 4 Mb
  38. type
  39. TViewerControlMode = (vcmBin, vcmHex, vcmText, vcmWrap, vcmBook, vcmDec);
  40. TDataAccess = (dtMmap, dtNothing);
  41. TCharSide = (csBefore, csLeft, csRight, csAfter);
  42. TPtrIntList = specialize TFPGList<PtrInt>;
  43. TGuessEncodingEvent = function(const s: string): string;
  44. TFileOpenEvent = function(const FileName: String; Mode: LongWord): System.THandle;
  45. TCustomCharsPresentation = class;
  46. TCharToCustomValueTransformProc = function(AChar:AnsiChar;AMaxDigitsCount:integer):AnsiString of object;
  47. { TCustomCharsPresentation }
  48. {
  49. Presentation one char is called Value
  50. Function for convert char to Value is ChrToValueProc
  51. }
  52. TCustomCharsPresentation = class
  53. public
  54. ValuesPerLine :integer; // = 16 for Hex by default
  55. MaxValueDigits :integer; // the max width of present char (255) - 3 symbols
  56. MaxAddrDigits :integer; // = 8;
  57. StartOfs :integer; // = OffsetWidth + 2; // ': '
  58. EndOfs :integer; // = StartOfs + (ValuesPerLine * (ValueMaxDigits+SpaceCount));
  59. StartAscii :integer; // = StartOfs + (ValuesPerLine * (ValueMaxDigits+SpaceCount)) + 2; // ' '
  60. SpaceCount :integer; // = 1 - one spacebar between Values
  61. SeparatorSpace :AnsiString; // spacebar * SpaceCount
  62. SeparatorChar :AnsiChar; // '|'
  63. CountSeperate :integer; // insert SeparatorChar after every CountSeperate values
  64. ChrToValueProc :TCharToCustomValueTransformProc; // procedure which return presentation of one char
  65. constructor Create(APresentValuesPerLine,ACharMaxPresentWidth,AOffsetWidth,ACountSeparate:integer;AChrToValueProc:TCharToCustomValueTransformProc);
  66. destructor Destroy();override;
  67. end;
  68. type
  69. // If additional encodings are added they should be also supported by:
  70. // - GetNextCharAsAscii
  71. // - GetPrevCharAsAscii
  72. // - GetNextCharAsUtf8
  73. // - ConvertToUTF8
  74. // - UpdateSelection
  75. TViewerEncoding = (veAutoDetect,
  76. veUtf8,
  77. veUtf8bom,
  78. veAnsi,
  79. veOem,
  80. veCp1250,
  81. veCp1251,
  82. veCp1252,
  83. veCp1253,
  84. veCp1254,
  85. veCp1255,
  86. veCp1256,
  87. veCp1257,
  88. veCp1258,
  89. veCp437,
  90. veCp850,
  91. veCp852,
  92. veCp866,
  93. veCp874,
  94. veCp932,
  95. veCp936,
  96. veCp949,
  97. veCp950,
  98. veIso88591,
  99. veIso88592,
  100. veKoi8r,
  101. veKoi8u,
  102. veKoi8ru,
  103. veUcs2le,
  104. veUcs2be,
  105. veUtf16le,
  106. veUtf16be,
  107. veUtf32le, // = ucs4le
  108. veUtf32be); // = ucs4be
  109. TViewerEncodings = set of TViewerEncoding;
  110. const
  111. ViewerEncodingsNames: array [TViewerEncoding] of string =
  112. ('Auto-detect',
  113. 'UTF-8',
  114. 'UTF-8BOM',
  115. 'ANSI',
  116. 'OEM',
  117. 'CP1250',
  118. 'CP1251',
  119. 'CP1252',
  120. 'CP1253',
  121. 'CP1254',
  122. 'CP1255',
  123. 'CP1256',
  124. 'CP1257',
  125. 'CP1258',
  126. 'CP437',
  127. 'CP850',
  128. 'CP852',
  129. 'CP866',
  130. 'CP874',
  131. 'CP932',
  132. 'CP936',
  133. 'CP949',
  134. 'CP950',
  135. 'ISO-8859-1',
  136. 'ISO-8859-2',
  137. 'KOI8-R',
  138. 'KOI8-U',
  139. 'KOI8-RU',
  140. 'UCS-2LE',
  141. 'UCS-2BE',
  142. 'UTF-16LE',
  143. 'UTF-16BE',
  144. 'UTF-32LE',
  145. 'UTF-32BE');
  146. const
  147. ViewerEncodingOem: TViewerEncodings = [
  148. veCp437, veCp850, veCp852, veCp866];
  149. ViewerEncodingMultiByte: TViewerEncodings = [
  150. veCp932, veCp936, veCp949, veCp950,
  151. veUtf8, veUtf8bom, veUcs2le, veUcs2be,
  152. veUtf16le, veUtf16be, veUtf32le, veUtf32be];
  153. ViewerEncodingDoubleByte: TViewerEncodings = [
  154. veUcs2le, veUcs2be, veUtf16le, veUtf16be ];
  155. type
  156. { TViewerControl }
  157. TViewerControl = class(TCustomControl)
  158. protected
  159. FEncoding: TViewerEncoding;
  160. FViewerControlMode: TViewerControlMode;
  161. FFileName: String;
  162. FFileHandle: THandle;
  163. FFileSize: Int64;
  164. FMappingHandle: THandle;
  165. FMappedFile: Pointer;
  166. FPosition: PtrInt;
  167. FHPosition: Integer; // Tab for text during horizontal scroll
  168. FHLowEnd: Integer; // End for HPosition (string with max char)
  169. FVisibleOffset: PtrInt; // Offset in symbols for current line (see IsVisible and MakeVisible)
  170. FLowLimit: PtrInt; // Lowest possible value for Position
  171. FHighLimit: PtrInt; // Position cannot reach this value
  172. FBOMLength: Integer;
  173. FLineList: TPtrIntList;
  174. FBlockBeg: PtrInt;
  175. FBlockEnd: PtrInt;
  176. FCaretPos: PtrInt;
  177. FCaretPoint: TPoint;
  178. FMouseBlockBeg: PtrInt;
  179. FMouseBlockSide: TCharSide;
  180. FSelecting: Boolean;
  181. FTextWidth: Integer; // max char count or width in window
  182. FTextHeight: Integer; // measured values of font, rec calc at font changed
  183. FScrollBarVert: TScrollBar;
  184. FScrollBarHorz: TScrollBar;
  185. FOnPositionChanged: TNotifyEvent;
  186. FUpdateScrollBarPos: Boolean; // used to block updating of scrollbar
  187. FScrollBarPosition: Integer; // for updating vertical scrollbar based on Position
  188. FHScrollBarPosition: Integer; // for updating horizontal scrollbar based on HPosition
  189. FColCount: Integer;
  190. FTabSpaces: Integer; // tab width in spaces
  191. FMaxTextWidth: Integer; // maximum of chars on one line unwrapped text (max 16384)
  192. FExtraLineSpacing: Integer;
  193. FLeftMargin: Integer;
  194. FOnGuessEncoding: TGuessEncodingEvent;
  195. FOnFileOpen: TFileOpenEvent;
  196. FCaretVisible: Boolean;
  197. FShowCaret: Boolean;
  198. FAutoCopy: Boolean;
  199. FLastError: String;
  200. FText: String;
  201. FHex:TCustomCharsPresentation;
  202. FDec:TCustomCharsPresentation;
  203. FCustom:TCustomCharsPresentation;
  204. function GetPercent: Integer;
  205. procedure SetPercent(const AValue: Integer);
  206. procedure SetBlockBegin(const AValue: PtrInt);
  207. procedure SetBlockEnd(const AValue: PtrInt);
  208. procedure SetPosition(Value: PtrInt); virtual;
  209. procedure SetHPosition(Value: Integer);
  210. procedure SetPosition(Value: PtrInt; Force: Boolean); overload;
  211. procedure SetHPosition(Value: Integer; Force: Boolean); overload;
  212. procedure SetEncoding(AEncoding: TViewerEncoding);
  213. function GetEncodingName: string;
  214. procedure SetEncodingName(AEncodingName: string);
  215. procedure SetViewerMode(Value: TViewerControlMode);
  216. procedure SetColCount(const AValue: Integer);
  217. procedure SetMaxTextWidth(const AValue: Integer);
  218. procedure SetTabSpaces(const AValue: Integer);
  219. procedure SetShowCaret(AValue: Boolean);
  220. procedure SetCaretPos(AValue: PtrInt);
  221. {en
  222. Returns how many lines (given current FTextHeight) will fit into the window.
  223. }
  224. function GetClientHeightInLines(Whole: Boolean = True): Integer; inline;
  225. {en
  226. Calculates how many lines can be displayed from given position.
  227. param(FromPosition
  228. Position from which to check. It should point to a start of a line.)
  229. @param(LastLineReached
  230. If it is set to @true when the function returns, then the last
  231. line of text was reached when scanning.
  232. This means that there are no more lines to be displayed other than
  233. the ones scanned from FromPosition. In other words:
  234. SetPosition(GetStartOfNextLine(FromPosition)) will be one line
  235. too many and will be scrolled back.)
  236. }
  237. function GetLinesTillEnd(FromPosition: PtrInt; out LastLineReached: Boolean): Integer;
  238. function GetBomLength: Integer;
  239. procedure UpdateLimits;
  240. {en
  241. @param(iStartPos
  242. Should point to start of a line.
  243. It is increased by the amount of parsed data (with line endings).)
  244. @param(aLimit
  245. Position which cannot be reached while reading from file.)
  246. @param(DataLength
  247. It is length in bytes of parsed data without any line endings.
  248. iStartPos is moved beyond the line endings though.)
  249. }
  250. function CalcTextLineLength(var iStartPos: PtrInt; const aLimit: Int64; out DataLength: PtrInt): Integer;
  251. function GetStartOfLine(aPosition: PtrInt): PtrInt;
  252. function GetEndOfLine(aPosition: PtrInt): PtrInt;
  253. function GetStartOfPrevLine(aPosition: PtrInt): PtrInt;
  254. function GetStartOfNextLine(aPosition: PtrInt): PtrInt;
  255. {en
  256. Changes the value of aPosition to X lines back or forward.
  257. @param(aPosition
  258. File position to change.)
  259. @param(iLines
  260. Nr of lines to scroll.
  261. If positive the position is increased by iLines lines,
  262. if negative the position is decreased by -iLines lines.)
  263. }
  264. function ScrollPosition(var aPosition: PtrInt; iLines: Integer): Boolean;
  265. {en
  266. Calculates (x,y) cursor position to a position within file.
  267. @param(x
  268. Client X coordinate of mouse cursor.)
  269. @param(y
  270. Client Y coordinate of mouse cursor.)
  271. @param(CharSide
  272. To which side of a character at returned position the (x,y) points to.
  273. Only valid if returned position is not -1.)
  274. @returns(Position in file to which (x,y) points to, based on what is
  275. currently displayed.
  276. Returns -1 if (x,y) doesn't point to any position (outside of
  277. the text for example).)
  278. }
  279. function XYPos2Adr(x, y: Integer; out CharSide: TCharSide): PtrInt;
  280. procedure OutText(x, y: Integer; const sText: String; StartPos: PtrInt; DataLength: Integer);
  281. procedure OutBin(x, y: Integer; const sText: String; StartPos: PtrInt; DataLength: Integer);
  282. procedure OutCustom(x, y: Integer; const sText: String;StartPos: PtrInt; DataLength: Integer); // render one line
  283. function TransformCustom(var APosition: PtrInt; ALimit: PtrInt; AWithAdditionalData: Boolean = True): String;
  284. function TransformCustomBlock(var APosition: PtrInt; DataLength: Integer; ASeparatorsOn, AAlignData: Boolean; out AChars: String): String;
  285. function HexToValueProc(AChar:AnsiChar;AMaxDigitsCount:integer):AnsiString;
  286. function DecToValueProc(AChar:AnsiChar;AMaxDigitsCount:integer):AnsiString;
  287. procedure WriteBin;
  288. procedure WriteText;
  289. procedure WriteCustom; virtual;
  290. function TransformText(const sText: String; const Xoffset: Integer): String;
  291. function TransformBin(var aPosition: PtrInt; aLimit: PtrInt): String;
  292. function TransformHex(var aPosition: PtrInt; aLimit: PtrInt): AnsiString;virtual;
  293. procedure AddLineOffset(const iOffset: PtrInt); inline;
  294. procedure DrawLastError;
  295. function MapFile(const sFileName: String): Boolean;
  296. procedure UnMapFile;
  297. procedure SetFileName(const sFileName: String);
  298. procedure UpdateScrollbars;
  299. procedure ViewerResize(Sender: TObject);
  300. {en
  301. Returns next unicode character from the file, depending on Encoding.
  302. It is a faster version, which does as little conversion as possible,
  303. but only Ascii values are guaranteed to be valid (0-127).
  304. Other unicode values may/may not be valid, so shouldn't be tested.
  305. This function is used for reading pure ascii characters such as
  306. line endings, tabs, white spaces, etc.
  307. }
  308. function GetNextCharAsAscii(const iPosition: PtrInt; out CharLenInBytes: Integer): Cardinal;
  309. function GetPrevCharAsAscii(const iPosition: PtrInt; out CharLenInBytes: Integer): Cardinal;
  310. {en
  311. Retrieve next character from the file depending on encoding and
  312. automatically convert it to UTF-8.
  313. If CharLenInBytes is greater than 0 but the result is an empty string
  314. then it's possible there was no appropriate UTF-8 character for the
  315. next character of the current encoding.
  316. }
  317. function GetNextCharAsUtf8(const iPosition: PtrInt; out CharLenInBytes: Integer): String;
  318. procedure ReReadFile;
  319. {en
  320. Searches for an ASCII character.
  321. @param(aPosition
  322. Position from where the search starts.)
  323. @param(aMaxBytes
  324. How many bytes are available for reading.)
  325. @param(AsciiChars
  326. The function searches for any character that this string contains.)
  327. @param(bFindNotIn
  328. If @true searches for first character not included in AsciiChars.
  329. If @false searches for first character included in AsciiChars.)
  330. }
  331. function FindAsciiSetForward(aPosition, aMaxBytes: PtrInt;
  332. const AsciiChars: String;
  333. bFindNotIn: Boolean): PtrInt;
  334. {en
  335. Same as FindForward but it searches backwards from pAdr.
  336. aMaxBytes must be number of available bytes for reading backwards from pAdr.
  337. }
  338. function FindAsciiSetBackward(aPosition, aMaxBytes: PtrInt;
  339. const AsciiChars: String;
  340. bFindNotIn: Boolean): PtrInt;
  341. {en
  342. Checks if current selection is still valid given current viewer mode and encoding.
  343. For example checks if selection is not in the middle of a unicode character.
  344. }
  345. procedure UpdateSelection;
  346. function GetViewerRect: TRect;
  347. procedure ScrollBarVertScroll(Sender: TObject; ScrollCode: TScrollCode;
  348. var ScrollPos: Integer);
  349. procedure ScrollBarHorzScroll(Sender: TObject; ScrollCode: TScrollCode;
  350. var ScrollPos: Integer);
  351. function GetText(const StartPos, Len: PtrInt; const Xoffset: Integer): string;
  352. procedure SetText(const AValue: String);
  353. protected
  354. procedure WMSetFocus(var Message: TLMSetFocus); message LM_SETFOCUS;
  355. procedure WMKillFocus(var Message: TLMKillFocus); message LM_KILLFOCUS;
  356. procedure FontChanged(Sender: TObject); override;
  357. procedure KeyDown(var Key: word; Shift: TShiftState); override;
  358. procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  359. procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
  360. procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  361. function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override;
  362. function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override;
  363. function DoMouseWheelLeft(Shift: TShiftState; MousePos: TPoint): Boolean; override;
  364. function DoMouseWheelRight(Shift: TShiftState; MousePos: TPoint): Boolean; override;
  365. procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy; const AXProportion, AYProportion: Double); override;
  366. public
  367. constructor Create(AOwner: TComponent); override;
  368. destructor Destroy; override;
  369. procedure Paint; override;
  370. {en
  371. Scrolls the displayed text in the window.
  372. @param(iLines
  373. Nr of lines to scroll.
  374. If positive the text is scrolled downwards,
  375. if negative the text is scrolled upwards.)
  376. @returns(@true if the text was scrolled.)
  377. }
  378. function Scroll(iLines: Integer): Boolean;
  379. function HScroll(iSymbols: Integer): Boolean;
  380. procedure PageUp;
  381. procedure PageDown;
  382. procedure GoHome;
  383. procedure GoEnd;
  384. procedure HPageUp;
  385. procedure HPageDown;
  386. procedure HGoHome;
  387. procedure HGoEnd;
  388. procedure CaretGoHome;
  389. procedure CaretGoEnd;
  390. function GetDataAdr: Pointer;
  391. procedure SelectAll;
  392. procedure SelectText(AStart, AEnd: PtrInt);
  393. procedure CopyToClipboard;
  394. procedure CopyToClipboardF;
  395. function Selection: String;
  396. function IsVisible(const aPosition: PtrInt): Boolean; overload;
  397. procedure MakeVisible(const aPosition: PtrInt);
  398. function ConvertToUTF8(const sText: AnsiString): String;
  399. function ConvertFromUTF8(const sText: String): AnsiString;
  400. function FindUtf8Text(iStartPos: PtrInt; const sSearchText: String;
  401. bCaseSensitive: Boolean; bSearchBackwards: Boolean): PtrInt;
  402. procedure ResetEncoding;
  403. function IsFileOpen: Boolean; inline;
  404. function DetectEncoding: TViewerEncoding;
  405. procedure GetSupportedEncodings(List: TStrings);
  406. property Text: String read FText write SetText;
  407. property Percent: Integer Read GetPercent Write SetPercent;
  408. property Position: PtrInt Read FPosition Write SetPosition;
  409. property FileSize: Int64 Read FFileSize;
  410. property FileHandle: THandle read FFileHandle;
  411. property CaretPos: PtrInt Read FCaretPos Write SetCaretPos;
  412. property SelectionStart: PtrInt Read FBlockBeg Write SetBlockBegin;
  413. property SelectionEnd: PtrInt Read FBlockEnd Write SetBlockEnd;
  414. property EncodingName: string Read GetEncodingName Write SetEncodingName;
  415. property ColCount: Integer Read FColCount Write SetColCount;
  416. property MaxTextWidth: Integer read FMaxTextWidth write SetMaxTextWidth;
  417. property TabSpaces: Integer read FTabSpaces write SetTabSpaces;
  418. property LeftMargin: Integer read FLeftMargin write FLeftMargin;
  419. property ExtraLineSpacing: Integer read FExtraLineSpacing write FExtraLineSpacing;
  420. property AutoCopy: Boolean read FAutoCopy write FAutoCopy;
  421. property OnGuessEncoding: TGuessEncodingEvent Read FOnGuessEncoding Write FOnGuessEncoding;
  422. property OnFileOpen: TFileOpenEvent read FOnFileOpen write FOnFileOpen;
  423. published
  424. property Mode: TViewerControlMode Read FViewerControlMode Write SetViewerMode default vcmWrap;
  425. property FileName: String Read FFileName Write SetFileName;
  426. property Encoding: TViewerEncoding Read FEncoding Write SetEncoding default veAutoDetect;
  427. property OnPositionChanged: TNotifyEvent Read FOnPositionChanged Write FOnPositionChanged;
  428. property ShowCaret: Boolean read FShowCaret write SetShowCaret;
  429. property OnClick;
  430. property OnMouseDown;
  431. property OnMouseMove;
  432. property OnMouseUp;
  433. property OnMouseWheelUp;
  434. property OnMouseWheelDown;
  435. property Align;
  436. property Color;
  437. property Cursor default crIBeam;
  438. property Font;
  439. property ParentColor default False;
  440. property TabStop default True;
  441. end;
  442. procedure Register;
  443. implementation
  444. uses
  445. Math, LCLType, Graphics, Forms, LCLProc, Clipbrd, LConvEncoding,
  446. DCUnicodeUtils, LCLIntf, LazUTF8, DCOSUtils , DCConvertEncoding
  447. {$IF LCL_FULLVERSION >= 4990000}
  448. , LazUTF16
  449. {$ENDIF}
  450. {$IF DEFINED(UNIX)}
  451. , BaseUnix, Unix, DCUnix
  452. {$ELSEIF DEFINED(WINDOWS)}
  453. , Windows, DCWindows
  454. {$ENDIF};
  455. const
  456. cBinWidth = 80;
  457. // These strings must be Ascii only.
  458. sNonCharacter: string = ' !"#$%&''()*+,-./:;<=>?@[\]^`{|}~'#13#10#9;
  459. sWhiteSpace : string = ' '#13#10#9#8;
  460. const
  461. ASCII_TABLE: array[0..31] of String =
  462. (
  463. '.', '☺', '☻', '♥', '♦', '♣', '♠', '•', '◘', '○', '◙', '♂', '♀', '♪', '♫', '☼',
  464. '►', '◄', '↕', '‼', '¶', '§', '▬', '↨', '↑', '↓', '→', '←', '∟', '↔', '▲', '▼'
  465. );
  466. { TCustomCharsPresentation }
  467. constructor TCustomCharsPresentation.Create(APresentValuesPerLine,
  468. ACharMaxPresentWidth, AOffsetWidth, ACountSeparate: integer;AChrToValueProc:TCharToCustomValueTransformProc);
  469. begin
  470. SpaceCount:=1; // count of spacebars between values, =1
  471. ValuesPerLine := APresentValuesPerLine; // default for hex: 16 values
  472. MaxAddrDigits := AOffsetWidth; // = 8 , count of symbols for display caret offset
  473. StartOfs := AOffsetWidth + 2; // ': '
  474. MaxValueDigits := ACharMaxPresentWidth; // hex char (FF) - 2 symbols, dec char (255) - 3 symbols
  475. EndOfs := StartOfs + (ValuesPerLine * (MaxValueDigits+SpaceCount)); // +1 - take in spacebar
  476. StartAscii := StartOfs + (ValuesPerLine * (MaxValueDigits+SpaceCount)) + 2; // ' '
  477. SeparatorChar:='|';
  478. CountSeperate:=ACountSeparate;
  479. SeparatorSpace:=' ';
  480. ChrToValueProc:=AChrToValueProc; // method for convert char to Value
  481. end;
  482. destructor TCustomCharsPresentation.Destroy;
  483. begin
  484. inherited;
  485. end;
  486. // ----------------------------------------------------------------------------
  487. constructor TViewerControl.Create(AOwner: TComponent);
  488. begin
  489. inherited Create(AOwner);
  490. Cursor := crIBeam;
  491. ParentColor := False;
  492. DoubleBuffered := True;
  493. ControlStyle := ControlStyle + [csTripleClicks, csOpaque];
  494. TabStop := True; // so that it can get keyboard focus
  495. FEncoding := veAutoDetect;
  496. FViewerControlMode := vcmText;
  497. FCustom := nil;
  498. FFileName := '';
  499. FMappedFile := nil;
  500. FFileHandle := 0;
  501. FMappingHandle := 0;
  502. FPosition := 0;
  503. FHPosition := 0;
  504. FHLowEnd := 0;
  505. FLowLimit := 0;
  506. FHighLimit := 0;
  507. FBOMLength := 0;
  508. FTextHeight:= 14; // dummy value
  509. FColCount := 1;
  510. FTabSpaces := 8;
  511. FLeftMargin := 4;
  512. FMaxTextWidth := 1024;
  513. FAutoCopy := True;
  514. FLineList := TPtrIntList.Create;
  515. FScrollBarVert := TScrollBar.Create(Self);
  516. FScrollBarVert.Parent := Self;
  517. FScrollBarVert.Kind := sbVertical;
  518. FScrollBarVert.Align := alRight;
  519. FScrollBarVert.OnScroll := @ScrollBarVertScroll;
  520. FScrollBarVert.TabStop := False;
  521. FScrollBarVert.PageSize := 0;
  522. FScrollBarHorz := TScrollBar.Create(Self);
  523. FScrollBarHorz.Parent := Self;
  524. FScrollBarHorz.Kind := sbHorizontal;
  525. FScrollBarHorz.Align := alBottom;
  526. FScrollBarHorz.OnScroll := @ScrollBarHorzScroll;
  527. FScrollBarHorz.TabStop := False;
  528. FScrollBarHorz.PageSize := 0;
  529. FUpdateScrollBarPos := True;
  530. FScrollBarPosition := 0;
  531. FHScrollBarPosition := 0;
  532. FOnPositionChanged := nil;
  533. FOnGuessEncoding := nil;
  534. OnResize := @ViewerResize;
  535. FHex:=TCustomCharsPresentation.Create(16,2,8,8,@HexToValueProc);
  536. FDec:=TCustomCharsPresentation.Create(15,3,8,5,@DecToValueProc); // for set bigger ValuePerLine need to improve method GetEndOfLine
  537. end;
  538. destructor TViewerControl.Destroy;
  539. begin
  540. FHex.Free;
  541. FDec.Free;
  542. FHex:=nil;
  543. FDec:=nil;
  544. FCustom:=nil;
  545. UnMapFile;
  546. if Assigned(FLineList) then
  547. FreeAndNil(FLineList);
  548. inherited Destroy;
  549. end;
  550. procedure TViewerControl.DrawLastError;
  551. var
  552. AStyle: TTextStyle;
  553. begin
  554. AStyle:= Canvas.TextStyle;
  555. AStyle.Alignment:= taCenter;
  556. AStyle.Layout:= tlCenter;
  557. Canvas.Pen.Color := Canvas.Font.Color;
  558. Canvas.Line(0, 0, ClientWidth - 1, ClientHeight - 1);
  559. Canvas.Line(0, ClientHeight - 1, ClientWidth - 1, 0);
  560. Canvas.TextRect(GetViewerRect, 0, 0, FLastError, AStyle);
  561. end;
  562. procedure TViewerControl.Paint;
  563. var
  564. AText: String;
  565. begin
  566. if not IsFileOpen then
  567. begin
  568. DrawLastError;
  569. Exit;
  570. end;
  571. if FShowCaret and FCaretVisible then
  572. begin
  573. FCaretPoint.X := -1;
  574. FCaretVisible := not LCLIntf.HideCaret(Handle);
  575. end;
  576. Canvas.Font := Self.Font;
  577. Canvas.Brush.Color := Self.Color;
  578. {$IF DEFINED(LCLQT) and (LCL_FULLVERSION < 093100)}
  579. Canvas.Brush.Style := bsSolid;
  580. Canvas.FillRect(ClientRect);
  581. {$ENDIF}
  582. Canvas.Brush.Style := bsClear;
  583. FTextHeight := Canvas.TextHeight('Wg') + FExtraLineSpacing;
  584. if FViewerControlMode = vcmBook then
  585. FTextWidth := ((ClientWidth - (Canvas.TextWidth('W') * FColCount)) div FColCount)
  586. else begin
  587. AText := StringOfChar('W', FMaxTextWidth);
  588. FTextWidth := Canvas.TextFitInfo(AText, GetViewerRect.Width - FLeftMargin);
  589. end;
  590. FLineList.Clear;
  591. case FViewerControlMode of
  592. vcmBin : WriteBin;
  593. vcmText: WriteText;
  594. vcmWrap: WriteText;
  595. vcmBook: WriteText;
  596. vcmDec,vcmHex : WriteCustom;
  597. end;
  598. if FShowCaret and (FCaretPoint.X > -1) then
  599. begin
  600. LCLIntf.SetCaretPos(FCaretPoint.X, FCaretPoint.Y);
  601. if not FCaretVisible then FCaretVisible:= LCLIntf.ShowCaret(Handle);
  602. end;
  603. end;
  604. procedure TViewerControl.SetViewerMode(Value: TViewerControlMode);
  605. begin
  606. if not (csDesigning in ComponentState) then
  607. begin
  608. FLineList.Clear; // do not use cache from previous mode
  609. FViewerControlMode := Value;
  610. case FViewerControlMode of
  611. vcmHex: FCustom := FHex;
  612. vcmDec: FCustom := FDec;
  613. else
  614. FCustom := nil;
  615. end;
  616. if not IsFileOpen then
  617. Exit;
  618. // Take limits into account for selection.
  619. FBlockBeg := FBlockBeg + (GetDataAdr - FMappedFile);
  620. FBlockEnd := FBlockEnd + (GetDataAdr - FMappedFile);
  621. FHPosition := 0;
  622. FBOMLength := GetBomLength;
  623. UpdateLimits;
  624. // Take limits into account for selection.
  625. FBlockBeg := FBlockBeg - (GetDataAdr - FMappedFile);
  626. FBlockEnd := FBlockEnd - (GetDataAdr - FMappedFile);
  627. UpdateSelection;
  628. // Force recalculating position.
  629. SetPosition(FPosition, True);
  630. SetHPosition(FHPosition, True);
  631. UpdateScrollbars;
  632. Invalidate;
  633. end
  634. else
  635. FViewerControlMode := Value;
  636. end;
  637. procedure TViewerControl.SetColCount(const AValue: Integer);
  638. begin
  639. if AValue > 0 then FColCount := AValue
  640. else FColCount := 1;
  641. end;
  642. procedure TViewerControl.SetMaxTextWidth(const AValue: Integer);
  643. begin
  644. if AValue < 80 then
  645. FMaxTextWidth := 80
  646. else if AValue > 16384 then
  647. FMaxTextWidth := 16384
  648. else
  649. FMaxTextWidth:= AValue;
  650. end;
  651. procedure TViewerControl.SetTabSpaces(const AValue: Integer);
  652. begin
  653. if AValue < 1 then
  654. FTabSpaces := 1
  655. else if AValue > 32 then
  656. FTabSpaces := 32
  657. else
  658. FTabSpaces := AValue;
  659. end;
  660. function TViewerControl.ScrollPosition(var aPosition: PtrInt; iLines: Integer): Boolean;
  661. var
  662. i: Integer;
  663. NewPos: PtrInt;
  664. begin
  665. Result := False;
  666. NewPos := aPosition;
  667. if iLines < 0 then
  668. for i := 1 to -iLines do
  669. NewPos := GetStartOfPrevLine(NewPos)
  670. else
  671. for i := 1 to iLines do
  672. NewPos := GetStartOfNextLine(NewPos);
  673. Result := aPosition <> NewPos;
  674. aPosition := NewPos;
  675. end;
  676. function TViewerControl.Scroll(iLines: Integer): Boolean;
  677. var
  678. aPosition: PtrInt;
  679. begin
  680. if not IsFileOpen then
  681. Exit(False);
  682. aPosition := FPosition;
  683. Result := ScrollPosition(aPosition, iLines);
  684. if aPosition <> FPosition then
  685. SetPosition(aPosition);
  686. end;
  687. function TViewerControl.HScroll(iSymbols: Integer): Boolean;
  688. var
  689. newPos: Integer;
  690. begin
  691. if not IsFileOpen then
  692. Exit(False);
  693. newPos := FHPosition + iSymbols;
  694. if newPos < 0 then
  695. newPos := 0
  696. else if (newPos > FHLowEnd - FTextWidth) and (FHLowEnd - FTextWidth > 0) then
  697. newPos := FHLowEnd - FTextWidth;
  698. if newPos <> FHPosition then
  699. SetHPosition(newPos);
  700. Result:= True;
  701. end;
  702. function TViewerControl.GetText(const StartPos, Len: PtrInt; const Xoffset: Integer): string;
  703. begin
  704. SetString(Result, GetDataAdr + StartPos, Len);
  705. Result := TransformText(ConvertToUTF8(Result), Xoffset);
  706. end;
  707. procedure TViewerControl.SetText(const AValue: String);
  708. begin
  709. UnMapFile;
  710. FText:= AValue;
  711. FileName:= EmptyStr;
  712. FFileSize:= Length(FText);
  713. FMappedFile:= Pointer(FText);
  714. end;
  715. function TViewerControl.GetViewerRect: TRect;
  716. begin
  717. Result:= GetClientRect;
  718. if Assigned(FScrollBarHorz) and FScrollBarHorz.Visible then
  719. Dec(Result.Bottom, FScrollBarHorz.Height);
  720. if Assigned(FScrollBarVert) and FScrollBarVert.Visible then
  721. Dec(Result.Right, FScrollBarVert.Width);
  722. end;
  723. procedure TViewerControl.WMSetFocus(var Message: TLMSetFocus);
  724. begin
  725. if FShowCaret then
  726. begin
  727. LCLIntf.CreateCaret(Handle, 0, 2, FTextHeight);
  728. LCLIntf.ShowCaret(Handle);
  729. FCaretVisible:= True;
  730. end;
  731. end;
  732. procedure TViewerControl.WMKillFocus(var Message: TLMKillFocus);
  733. begin
  734. if FShowCaret then
  735. begin
  736. FCaretVisible:= False;
  737. LCLIntf.DestroyCaret(Handle);
  738. end;
  739. end;
  740. procedure TViewerControl.FontChanged(Sender: TObject);
  741. begin
  742. inherited FontChanged(Sender);
  743. if HandleAllocated then
  744. begin
  745. FTextHeight := Canvas.TextHeight('Wg') + FExtraLineSpacing;
  746. if FShowCaret then LCLIntf.CreateCaret(Handle, 0, 2, FTextHeight);
  747. end;
  748. end;
  749. function TViewerControl.CalcTextLineLength(var iStartPos: PtrInt; const aLimit: Int64; out DataLength: PtrInt): Integer;
  750. var
  751. MaxLineLength: Boolean;
  752. CharLenInBytes: Integer;
  753. OldPos, LastSpacePos: PtrInt;
  754. LastSpaceResult: Integer;
  755. begin
  756. Result := 0;
  757. DataLength := 0;
  758. LastSpacePos := -1;
  759. MaxLineLength := True;
  760. OldPos := iStartPos;
  761. while MaxLineLength and (iStartPos < aLimit) do
  762. begin
  763. case GetNextCharAsAscii(iStartPos, CharLenInBytes) of
  764. 9: // tab
  765. Inc(Result, FTabSpaces - Result mod FTabSpaces);
  766. 10: // stroka
  767. begin
  768. DataLength := iStartPos - OldPos;
  769. iStartPos := iStartPos + CharLenInBytes;
  770. Exit;
  771. end;
  772. 13: // karetka
  773. begin
  774. DataLength := iStartPos - OldPos;
  775. iStartPos := iStartPos + CharLenInBytes;
  776. // Move after possible #10.
  777. if (iStartPos < aLimit) and (GetNextCharAsAscii(iStartPos, CharLenInBytes) = 10) then
  778. Inc(iStartPos, CharLenInBytes);
  779. Exit;
  780. end;
  781. 32, 33, 40, 41, 44, 45, 46, 47, 92, 58, 59, 63, 91, 93: //probel
  782. begin
  783. Inc(Result, 1);
  784. LastSpacePos := iStartPos + CharLenInBytes;
  785. LastSpaceResult := Result;
  786. end;
  787. else
  788. Inc(Result, 1);
  789. end;
  790. if CharLenInBytes = 0 then // End of data or invalid character.
  791. break;
  792. iStartPos := iStartPos + CharLenInBytes;
  793. DataLength := iStartPos - OldPos;
  794. case FViewerControlMode of
  795. vcmText: MaxLineLength := Result < FMaxTextWidth;
  796. vcmWrap: MaxLineLength := Result < FTextWidth;
  797. vcmBook: MaxLineLength := Canvas.TextWidth(GetText(OldPos, DataLength, 0)) < FTextWidth;
  798. else
  799. Exit;
  800. end;
  801. end;
  802. if (not MaxLineLength) and (LastSpacePos <> -1) then
  803. begin
  804. iStartPos := LastSpacePos;
  805. Result := LastSpaceResult;
  806. DataLength := iStartPos - OldPos;
  807. end;
  808. end;
  809. function TViewerControl.TransformText(const sText: String; const Xoffset: Integer): String;
  810. var
  811. c: AnsiChar;
  812. i: Integer;
  813. Dos: Boolean;
  814. begin
  815. Result := '';
  816. Dos:= FEncoding in ViewerEncodingOem;
  817. for i := 1 to Length(sText) do
  818. begin
  819. c := sText[i];
  820. // Parse only ASCII chars.
  821. case c of
  822. #9:
  823. Result := Result + StringOfChar(' ',
  824. FTabSpaces - (UTF8Length(Result) + Xoffset) mod FTabSpaces);
  825. else
  826. begin
  827. if c < ' ' then
  828. begin
  829. if Dos then
  830. Result := Result + ASCII_TABLE[Ord(c)]
  831. else
  832. Result := Result + ' ';
  833. end
  834. else
  835. Result := Result + c;
  836. end;
  837. end;
  838. end;
  839. end;
  840. function TViewerControl.TransformBin(var aPosition: PtrInt; aLimit: PtrInt): String;
  841. var
  842. S: String;
  843. C: AnsiChar;
  844. P: PAnsiChar;
  845. Len: Integer;
  846. I, L: Integer;
  847. SingleByte: Boolean;
  848. begin
  849. Result := EmptyStr;
  850. if (APosition + cBinWidth) > aLimit then
  851. Len:= aLimit - APosition
  852. else begin
  853. Len:= cBinWidth;
  854. end;
  855. SetString(S, PAnsiChar(GetDataAdr) + aPosition, Len);
  856. SingleByte:= not (FEncoding in ViewerEncodingMultiByte);
  857. if SingleByte then
  858. begin
  859. S:= ConvertToUTF8(S);
  860. end;
  861. L:= Length(S);
  862. P:= PAnsiChar(S);
  863. for I := 1 to L do
  864. begin
  865. C := P^;
  866. if C < ' ' then
  867. Result := Result + '.'
  868. else if SingleByte then
  869. Result := Result + C
  870. else if C > #127 then
  871. Result := Result + '.'
  872. else begin
  873. Result := Result + C;
  874. end;
  875. Inc(P);
  876. end;
  877. Inc(aPosition, Len);
  878. end;
  879. function TViewerControl.TransformHex(var aPosition: PtrInt; aLimit: PtrInt): AnsiString;
  880. begin
  881. Result:=TransformCustom(aPosition,aLimit);
  882. end;
  883. function TViewerControl.TransformCustom(var APosition: PtrInt; ALimit: PtrInt;
  884. AWithAdditionalData: boolean): String;
  885. var
  886. sAscii: string = '';
  887. sRez : string = '';
  888. tPos : integer;
  889. begin
  890. tPos:=APosition;
  891. sRez:=TransformCustomBlock(APosition,FCustom.ValuesPerLine,True,True,sAscii);
  892. // Result := LineFormat(sRez, sStr, aStartOffset) else
  893. if AWithAdditionalData then
  894. begin
  895. sRez := Format('%s: %s', [IntToHex(tPos, FCustom.MaxAddrDigits), sRez]);
  896. if Length(sRez) < FCustom.ValuesPerLine * (FCustom.SpaceCount+FCustom.MaxValueDigits) then
  897. sRez := sRez + StringOfChar(' ', FCustom.ValuesPerLine * (FCustom.SpaceCount+FCustom.MaxValueDigits) - Length(sRez));
  898. sRez := sRez + ' ';
  899. sRez := sRez + sAscii;
  900. end;
  901. Result:=sRez;
  902. end;
  903. function TViewerControl.TransformCustomBlock(var APosition: PtrInt;
  904. DataLength: Integer; ASeparatorsOn, AAlignData: Boolean; out AChars: String): String;
  905. var
  906. S: String;
  907. C: AnsiChar;
  908. P: PAnsiChar;
  909. Len: Integer;
  910. I, L: Integer;
  911. sEmpty: String;
  912. iSep: Integer = 1;
  913. SingleByte: Boolean;
  914. begin
  915. Result:= EmptyStr;
  916. if (APosition + DataLength) > FHighLimit then
  917. Len:= FHighLimit - APosition
  918. else begin
  919. Len:= DataLength;
  920. end;
  921. SetString(S, PAnsiChar(GetDataAdr) + aPosition, Len);
  922. SingleByte:= not (FEncoding in ViewerEncodingMultiByte);
  923. if SingleByte then
  924. begin
  925. S:= ConvertToUTF8(S);
  926. end;
  927. L:= Length(S);
  928. P:= PAnsiChar(S);
  929. AChars:= EmptyStr;
  930. for I := 1 to L do
  931. begin
  932. C := P^;
  933. if C < ' ' then
  934. AChars := AChars + '.'
  935. else if SingleByte then
  936. AChars := AChars + C
  937. else if C > #127 then
  938. AChars := AChars + '.'
  939. else begin
  940. AChars := AChars + C;
  941. end;
  942. Inc(P);
  943. end;
  944. P:= PAnsiChar(GetDataAdr);
  945. for I := 0 to Len - 1 do
  946. begin
  947. C := P[aPosition];
  948. Result += FCustom.ChrToValueProc(C, FCustom.MaxValueDigits);
  949. if (iSep = FCustom.CountSeperate) and ASeparatorsOn and
  950. (I < (FCustom.ValuesPerLine - 1))then
  951. begin
  952. iSep := 0;
  953. Result += FCustom.SeparatorChar;
  954. end else
  955. begin
  956. Result += FCustom.SeparatorSpace;
  957. end;
  958. Inc(aPosition);
  959. Inc(iSep);
  960. end;
  961. if AAlignData then
  962. begin
  963. sEmpty := StringOfChar(#32, FCustom.MaxValueDigits);
  964. while (I < FCustom.ValuesPerLine - 1) do
  965. begin
  966. Result += sEmpty + FCustom.SeparatorSpace;
  967. Inc(I);
  968. end;
  969. end;
  970. end;
  971. function TViewerControl.DecToValueProc(AChar:AnsiChar;AMaxDigitsCount:integer):AnsiString;
  972. begin
  973. Result:= IntToStr(Ord(AChar));
  974. while Length(Result) < AMaxDigitsCount do
  975. Result:= '0' + Result;
  976. end;
  977. function TViewerControl.HexToValueProc(AChar:AnsiChar;AMaxDigitsCount:integer):AnsiString;
  978. begin
  979. Result:=IntToHex(Ord(AChar), AMaxDigitsCount);
  980. while length(Result)<AMaxDigitsCount do
  981. Result:=' '+Result;
  982. end;
  983. function TViewerControl.GetStartOfLine(aPosition: PtrInt): PtrInt;
  984. function GetStartOfLineText: PtrInt;
  985. var
  986. tmpPos, LineStartPos: PtrInt;
  987. DataLength: PtrInt;
  988. prevChar: Cardinal;
  989. MaxLineLength: Boolean;
  990. CharLenInBytes: Integer;
  991. begin
  992. prevChar := GetPrevCharAsAscii(aPosition, CharLenInBytes);
  993. if CharLenInBytes = 0 then
  994. Exit(aPosition);
  995. // Check if this already is not a start of line (if previous char is #10).
  996. if prevChar = 10 then
  997. Exit(aPosition);
  998. tmpPos := aPosition - CharLenInBytes;
  999. if tmpPos <= FLowLimit then
  1000. Exit(FLowLimit);
  1001. // Check if we're not in the middle of line ending
  1002. // (previous char is #13, current char is #10).
  1003. if (prevChar = 13) and
  1004. (GetNextCharAsAscii(aPosition, CharLenInBytes) = 10) then
  1005. begin
  1006. prevChar := GetPrevCharAsAscii(tmpPos, CharLenInBytes);
  1007. if CharLenInBytes = 0 then
  1008. Exit(aPosition);
  1009. Dec(tmpPos, CharLenInBytes);
  1010. end;
  1011. if tmpPos <= FLowLimit then
  1012. Exit(FLowLimit);
  1013. DataLength:= 0;
  1014. // Search for real start of line.
  1015. while (not (prevChar in [10, 13])) and (tmpPos > FLowLimit) do
  1016. begin
  1017. prevChar := GetPrevCharAsAscii(tmpPos, CharLenInBytes);
  1018. if CharLenInBytes = 0 then
  1019. Break;
  1020. Dec(tmpPos, CharLenInBytes);
  1021. case prevChar of
  1022. 9:
  1023. Inc(DataLength, FTabSpaces - DataLength mod FTabSpaces);
  1024. else
  1025. Inc(DataLength, 1);
  1026. end;
  1027. case FViewerControlMode of
  1028. vcmText: MaxLineLength := DataLength < FMaxTextWidth;
  1029. vcmWrap: MaxLineLength := DataLength < FTextWidth;
  1030. end;
  1031. if not MaxLineLength then Exit(tmpPos);
  1032. end;
  1033. // Previous end of line not found and there are no more data to check.
  1034. if (not (prevChar in [10, 13])) and (tmpPos <= FLowLimit) then
  1035. Exit(FLowLimit);
  1036. // Move forward to first non-line ending character.
  1037. Inc(tmpPos, CharLenInBytes);
  1038. // Search for start of real line or wrapped line.
  1039. while True do
  1040. begin
  1041. LineStartPos := tmpPos;
  1042. CalcTextLineLength(tmpPos, FHighLimit, DataLength);
  1043. if tmpPos = aPosition then
  1044. begin
  1045. if aPosition < FHighLimit then
  1046. Exit(aPosition) // aPosition is already at start of a line
  1047. else
  1048. Exit(LineStartPos); // aPosition points to end of file so return start of this line
  1049. end
  1050. else if tmpPos > aPosition then
  1051. Exit(LineStartPos); // Found start of line
  1052. end;
  1053. end;
  1054. function GetStartOfLineFixed(aFixedWidth: Integer): PtrInt;
  1055. begin
  1056. Result := aPosition - (aPosition mod aFixedWidth);
  1057. end;
  1058. var
  1059. i: Integer;
  1060. begin
  1061. if aPosition <= FLowLimit then
  1062. Exit(FLowLimit)
  1063. else if aPosition >= FHighLimit then
  1064. aPosition := FHighLimit; // search from the end of the file
  1065. // Speedup for currently displayed positions.
  1066. if (FLineList.Count > 0) and
  1067. (aPosition >= FLineList.Items[0]) and
  1068. (aPosition <= FLineList.Items[FLineList.Count - 1]) then
  1069. begin
  1070. for i := FLineList.Count - 1 downto 0 do
  1071. if FLineList.Items[i] <= aPosition then
  1072. Exit(FLineList.Items[i]);
  1073. end;
  1074. case FViewerControlMode of
  1075. vcmBin:
  1076. Result := GetStartOfLineFixed(cBinWidth);
  1077. vcmHex, vcmDec:
  1078. Result := GetStartOfLineFixed(FCustom.ValuesPerLine);
  1079. vcmText, vcmWrap, vcmBook:
  1080. Result := GetStartOfLineText;
  1081. else
  1082. Result := aPosition;
  1083. end;
  1084. end;
  1085. function TViewerControl.GetEndOfLine(aPosition: PtrInt): PtrInt;
  1086. function GetEndOfLineText: PtrInt;
  1087. var
  1088. tmpPos: PtrInt;
  1089. DataLength: PtrInt;
  1090. begin
  1091. Result := GetStartOfLine(aPosition);
  1092. tmpPos := Result;
  1093. CalcTextLineLength(tmpPos, FHighLimit, DataLength);
  1094. Result := Result + DataLength;
  1095. if Result < aPosition then
  1096. Result := aPosition;
  1097. end;
  1098. function GetEndOfLineFixed(aFixedWidth: Integer): PtrInt;
  1099. begin
  1100. Result := aPosition - (aPosition mod aFixedWidth) + aFixedWidth;
  1101. end;
  1102. begin
  1103. case FViewerControlMode of
  1104. vcmBin:
  1105. Result := GetEndOfLineFixed(cBinWidth);
  1106. vcmHex,vcmDec:
  1107. Result := GetEndOfLineFixed(FCustom.ValuesPerLine);
  1108. vcmText, vcmWrap, vcmBook:
  1109. Result := GetEndOfLineText;
  1110. else
  1111. Result := aPosition;
  1112. end;
  1113. end;
  1114. function TViewerControl.GetStartOfPrevLine(aPosition: PtrInt): PtrInt;
  1115. function GetPrevLineText: PtrInt;
  1116. var
  1117. tmpPos, LineStartPos: PtrInt;
  1118. DataLength: PtrInt;
  1119. prevChar: Cardinal;
  1120. MaxLineLength: Boolean;
  1121. CharLenInBytes: Integer;
  1122. begin
  1123. prevChar := GetPrevCharAsAscii(aPosition, CharLenInBytes);
  1124. if CharLenInBytes = 0 then
  1125. Exit(aPosition);
  1126. tmpPos := aPosition - CharLenInBytes; // start search from previous character
  1127. if tmpPos <= FLowLimit then
  1128. Exit(FLowLimit);
  1129. // Check if we're not in the middle of line ending
  1130. // (previous char is #13, current char is #10).
  1131. if (prevChar = 13) and
  1132. (GetNextCharAsAscii(aPosition, CharLenInBytes) = 10) then
  1133. begin
  1134. prevChar := GetPrevCharAsAscii(tmpPos, CharLenInBytes);
  1135. if CharLenInBytes = 0 then
  1136. Exit(aPosition);
  1137. Dec(tmpPos, CharLenInBytes);
  1138. end
  1139. else
  1140. begin
  1141. // Bypass possible end of previous line.
  1142. if prevChar = 10 then
  1143. begin
  1144. prevChar := GetPrevCharAsAscii(tmpPos, CharLenInBytes);
  1145. if CharLenInBytes = 0 then
  1146. Exit(aPosition);
  1147. Dec(tmpPos, CharLenInBytes);
  1148. end;
  1149. if prevChar = 13 then
  1150. begin
  1151. prevChar := GetPrevCharAsAscii(tmpPos, CharLenInBytes);
  1152. if CharLenInBytes = 0 then
  1153. Exit(aPosition);
  1154. Dec(tmpPos, CharLenInBytes);
  1155. end;
  1156. end;
  1157. if tmpPos <= FLowLimit then
  1158. Exit(FLowLimit);
  1159. DataLength:= 0;
  1160. // Search for real start of line.
  1161. while (not (prevChar in [10, 13])) and (tmpPos > FLowLimit) do
  1162. begin
  1163. prevChar := GetPrevCharAsAscii(tmpPos, CharLenInBytes);
  1164. if CharLenInBytes = 0 then
  1165. Break;
  1166. Dec(tmpPos, CharLenInBytes);
  1167. case prevChar of
  1168. 9:
  1169. Inc(DataLength, FTabSpaces - DataLength mod FTabSpaces);
  1170. else
  1171. Inc(DataLength, 1);
  1172. end;
  1173. case FViewerControlMode of
  1174. vcmText: MaxLineLength := DataLength < FMaxTextWidth;
  1175. vcmWrap: MaxLineLength := DataLength < FTextWidth;
  1176. end;
  1177. if not MaxLineLength then Exit(tmpPos);
  1178. end;
  1179. // Move forward to first non-line ending character.
  1180. Inc(tmpPos, CharLenInBytes);
  1181. // Search for start of real line or wrapped line.
  1182. while True do
  1183. begin
  1184. LineStartPos := tmpPos;
  1185. CalcTextLineLength(tmpPos, aPosition, DataLength);
  1186. if tmpPos >= aPosition then
  1187. Exit(LineStartPos); // Found start of line
  1188. end;
  1189. end;
  1190. function GetPrevLineFixed(aFixedWidth: Integer): PtrInt;
  1191. begin
  1192. Result := aPosition - (aPosition mod aFixedWidth);
  1193. if Result >= aFixedWidth then
  1194. Result := Result - aFixedWidth;
  1195. end;
  1196. var
  1197. i: Integer;
  1198. begin
  1199. if aPosition <= FLowLimit then
  1200. Exit(FLowLimit)
  1201. else if aPosition >= FHighLimit then
  1202. aPosition := FHighLimit; // search from the end of the file
  1203. // Speedup for currently displayed positions.
  1204. if (FLineList.Count > 0) and
  1205. (aPosition >= FLineList.Items[0]) and
  1206. (aPosition <= FLineList.Items[FLineList.Count - 1]) then
  1207. begin
  1208. for i := FLineList.Count - 1 downto 0 do
  1209. if FLineList.Items[i] < aPosition then
  1210. Exit(FLineList.Items[i]);
  1211. end;
  1212. case FViewerControlMode of
  1213. vcmBin:
  1214. Result := GetPrevLineFixed(cBinWidth);
  1215. vcmHex,vcmDec:
  1216. Result := GetPrevLineFixed(FCustom.ValuesPerLine);
  1217. vcmText, vcmWrap, vcmBook:
  1218. Result := GetPrevLineText;
  1219. else
  1220. Result := aPosition;
  1221. end;
  1222. end;
  1223. function TViewerControl.GetStartOfNextLine(aPosition: PtrInt): PtrInt;
  1224. function GetNextLineText: PtrInt;
  1225. var
  1226. tmpPos: PtrInt;
  1227. DataLength: PtrInt;
  1228. prevChar: Cardinal;
  1229. CharLenInBytes: Integer;
  1230. begin
  1231. tmpPos := aPosition;
  1232. // This might not be a real start of line (it may be start of wrapped line).
  1233. // Search for start of line.
  1234. while (tmpPos > FLowLimit) do
  1235. begin
  1236. prevChar := GetPrevCharAsAscii(tmpPos, CharLenInBytes);
  1237. if CharLenInBytes = 0 then
  1238. Break;
  1239. if (prevChar in [10, 13]) then
  1240. Break
  1241. else
  1242. Dec(tmpPos, CharLenInBytes);
  1243. end;
  1244. // Now we know we are at the start of a line, search the start of next line.
  1245. while True do
  1246. begin
  1247. CalcTextLineLength(tmpPos, FHighLimit, DataLength);
  1248. if tmpPos >= aPosition then
  1249. Exit(tmpPos); // Found start of line
  1250. end;
  1251. end;
  1252. function GetNextLineFixed(aFixedWidth: Integer): PtrInt;
  1253. begin
  1254. Result := aPosition - (aPosition mod aFixedWidth);
  1255. if Result + aFixedWidth < FHighLimit then
  1256. Result := Result + aFixedWidth;
  1257. end;
  1258. var
  1259. i: Integer;
  1260. begin
  1261. if aPosition < FLowLimit then
  1262. aPosition := FLowLimit // search from the start of the file
  1263. else if aPosition >= FHighLimit then
  1264. aPosition := FHighLimit; // search from the end of the file
  1265. // Speedup for currently displayed positions.
  1266. if (FLineList.Count > 0) and
  1267. (aPosition >= FLineList.Items[0]) and
  1268. (aPosition <= FLineList.Items[FLineList.Count - 1]) then
  1269. begin
  1270. for i := 0 to FLineList.Count - 1 do
  1271. if FLineList.Items[i] > aPosition then
  1272. Exit(FLineList.Items[i]);
  1273. end;
  1274. case FViewerControlMode of
  1275. vcmBin:
  1276. Result := GetNextLineFixed(cBinWidth);
  1277. vcmHex,vcmDec:
  1278. Result := GetNextLineFixed(FCustom.ValuesPerLine);
  1279. vcmText, vcmWrap, vcmBook:
  1280. Result := GetNextLineText;
  1281. else
  1282. Result := aPosition;
  1283. end;
  1284. end;
  1285. procedure TViewerControl.PageUp;
  1286. var
  1287. H: Integer;
  1288. begin
  1289. H := GetClientHeightInLines * FColCount - 1;
  1290. if H <= 0 then
  1291. H := 1;
  1292. Scroll(-H);
  1293. end;
  1294. procedure TViewerControl.HPageUp;
  1295. var
  1296. H: Integer;
  1297. begin
  1298. H := FHPosition - FTextWidth;
  1299. if H <= 0 then
  1300. H := FHPosition else H:= FTextWidth;
  1301. HScroll(-H);
  1302. end;
  1303. procedure TViewerControl.PageDown;
  1304. var
  1305. H: Integer;
  1306. begin
  1307. H := GetClientHeightInLines * FColCount - 1;
  1308. if H <= 0 then
  1309. H := 1;
  1310. Scroll(H);
  1311. end;
  1312. procedure TViewerControl.HPageDown;
  1313. var
  1314. H: Integer;
  1315. begin
  1316. H := FHLowEnd - FHPosition;
  1317. if H > FTextWidth then H := FTextWidth ;
  1318. HScroll(H);
  1319. end;
  1320. procedure TViewerControl.GoHome;
  1321. begin
  1322. Position := FLowLimit;
  1323. end;
  1324. procedure TViewerControl.GoEnd;
  1325. begin
  1326. Position := FHighLimit;
  1327. end;
  1328. procedure TViewerControl.HGoHome;
  1329. begin
  1330. HScroll (-FHPosition);
  1331. end;
  1332. procedure TViewerControl.HGoEnd;
  1333. begin
  1334. HScroll (FHLowEnd-FHPosition);
  1335. end;
  1336. procedure TViewerControl.CaretGoHome;
  1337. begin
  1338. HScroll (-FHPosition);
  1339. CaretPos := GetStartOfLine(CaretPos);
  1340. end;
  1341. procedure TViewerControl.CaretGoEnd;
  1342. begin
  1343. if FViewerControlMode in [vcmBin, vcmHex, vcmDec] then
  1344. CaretPos := GetEndOfLine(CaretPos) - 1
  1345. else begin
  1346. CaretPos := GetEndOfLine(CaretPos);
  1347. end;
  1348. if FViewerControlMode = vcmText then
  1349. begin
  1350. if not IsVisible(CaretPos) then
  1351. begin
  1352. if (FVisibleOffset < FHPosition) or
  1353. (FVisibleOffset > FHPosition + FTextWidth) then
  1354. begin
  1355. SetHPosition(FVisibleOffset);
  1356. HScroll(-1);
  1357. end;
  1358. end;
  1359. end;
  1360. end;
  1361. procedure TViewerControl.SetFileName(const sFileName: String);
  1362. begin
  1363. if not (csDesigning in ComponentState) then
  1364. begin
  1365. UnMapFile;
  1366. if sFileName <> '' then
  1367. begin
  1368. if MapFile(sFileName) then
  1369. begin
  1370. FFileName := sFileName;
  1371. // Detect encoding if needed.
  1372. if FEncoding = veAutoDetect then
  1373. FEncoding := DetectEncoding;
  1374. ReReadFile;
  1375. CaretPos := FLowLimit;
  1376. end;
  1377. end;
  1378. end
  1379. else
  1380. FFileName := sFileName;
  1381. end;
  1382. function TViewerControl.MapFile(const sFileName: String): Boolean;
  1383. function ReadFile: Boolean; inline;
  1384. begin
  1385. FMappedFile := GetMem(FFileSize);
  1386. Result := (FileRead(FFileHandle, FMappedFile^, FFileSize) = FFileSize);
  1387. if not Result then
  1388. begin
  1389. FLastError := mbSysErrorMessage;
  1390. FreeMemAndNil(FMappedFile);
  1391. end;
  1392. FileClose(FFileHandle);
  1393. FFileHandle := 0;
  1394. end;
  1395. {$IFDEF LINUX}
  1396. var
  1397. Sbfs: TStatFS;
  1398. {$ENDIF}
  1399. begin
  1400. Result := False;
  1401. FLastError := EmptyStr;
  1402. if Assigned(FMappedFile) then
  1403. UnMapFile; // if needed
  1404. if Assigned(FOnFileOpen) then
  1405. FFileHandle := FOnFileOpen(sFileName, fmOpenRead or fmShareDenyNone)
  1406. else begin
  1407. FFileHandle := mbFileOpen(sFileName, fmOpenRead or fmShareDenyNone);
  1408. end;
  1409. if FFileHandle = feInvalidHandle then
  1410. begin
  1411. FLastError := mbSysErrorMessage;
  1412. FFileHandle := 0;
  1413. Exit;
  1414. end;
  1415. FFileSize := FileGetSize(FFileHandle);
  1416. if (FFileSize < 0) then
  1417. begin
  1418. FLastError := mbSysErrorMessage;
  1419. FileClose(FFileHandle);
  1420. FFileHandle := 0;
  1421. Exit;
  1422. end;
  1423. {$IFDEF LINUX}
  1424. if (fpFStatFS(FFileHandle, @Sbfs) = 0) then
  1425. begin
  1426. // Special case for PROC_FS and SYS_FS
  1427. if (sbfs.fstype = PROC_SUPER_MAGIC) or (sbfs.fstype = SYSFS_MAGIC) then
  1428. begin
  1429. FMappedFile := GetMem(MaxMemSize - 1);
  1430. FFileSize := FileRead(FFileHandle, FMappedFile^, MaxMemSize - 1);
  1431. Result := (FFileSize >= 0);
  1432. if not Result then
  1433. begin
  1434. FLastError := mbSysErrorMessage;
  1435. FreeMemAndNil(FMappedFile);
  1436. end;
  1437. FileClose(FFileHandle);
  1438. FFileHandle := 0;
  1439. Exit;
  1440. end;
  1441. end;
  1442. {$ENDIF}
  1443. if (FFileSize < MaxMemSize) then
  1444. begin
  1445. Result := ReadFile;
  1446. Exit;
  1447. end;
  1448. {$IFDEF MSWINDOWS}
  1449. FMappingHandle := CreateFileMapping(FFileHandle, nil, PAGE_READONLY, 0, 0, nil);
  1450. if FMappingHandle = 0 then
  1451. begin
  1452. FLastError := mbSysErrorMessage;
  1453. FMappedFile := nil;
  1454. UnMapFile;
  1455. end
  1456. else begin
  1457. FMappedFile := MapViewOfFile(FMappingHandle, FILE_MAP_READ, 0, 0, 0);
  1458. if (FMappedFile = nil) then
  1459. begin
  1460. FLastError := mbSysErrorMessage;
  1461. UnMapFile;
  1462. end;
  1463. end;
  1464. {$ELSE}
  1465. FMappedFile := fpmmap(nil, FFileSize, PROT_READ, MAP_PRIVATE{SHARED}, FFileHandle, 0);
  1466. if FMappedFile = MAP_FAILED then
  1467. begin
  1468. FLastError := mbSysErrorMessage;
  1469. FMappedFile:= nil;
  1470. FileClose(FFileHandle);
  1471. FFileHandle := 0;
  1472. Exit;
  1473. end;
  1474. {$ENDIF}
  1475. Result := Assigned(FMappedFile);
  1476. end;
  1477. procedure TViewerControl.UnMapFile;
  1478. begin
  1479. if FMappedFile = Pointer(FText) then
  1480. begin
  1481. FMappedFile:= nil;
  1482. FText:= EmptyStr;
  1483. end;
  1484. if (FFileSize < MaxMemSize) then
  1485. begin
  1486. if Assigned(FMappedFile) then
  1487. begin
  1488. FreeMem(FMappedFile);
  1489. FMappedFile := nil;
  1490. end;
  1491. end;
  1492. {$IFDEF MSWINDOWS}
  1493. if Assigned(FMappedFile) then
  1494. begin
  1495. UnmapViewOfFile(FMappedFile);
  1496. FMappedFile := nil;
  1497. end;
  1498. if FMappingHandle <> 0 then
  1499. begin
  1500. CloseHandle(FMappingHandle);
  1501. FMappingHandle := 0;
  1502. end;
  1503. {$ELSE}
  1504. if Assigned(FMappedFile) then
  1505. begin
  1506. if fpmunmap(FMappedFile, FFileSize) = -1 then
  1507. DebugLn('Error unmapping file: ', SysErrorMessage(fpgeterrno));
  1508. FMappedFile := nil;
  1509. end;
  1510. {$ENDIF}
  1511. if FFileHandle <> 0 then
  1512. begin
  1513. FileClose(FFileHandle);
  1514. FFileHandle := 0;
  1515. end;
  1516. FFileName := '';
  1517. FFileSize := 0;
  1518. Position := 0;
  1519. FLowLimit := 0;
  1520. FHighLimit := 0;
  1521. FBOMLength := 0;
  1522. FBlockBeg := 0;
  1523. FBlockEnd := 0;
  1524. end;
  1525. procedure TViewerControl.WriteText;
  1526. var
  1527. yIndex, xIndex, w, i: Integer;
  1528. LineStart, iPos: PtrInt;
  1529. CharLenInBytes: Integer;
  1530. DataLength: PtrInt;
  1531. sText: String;
  1532. procedure DrawCaret(X, Y: Integer; LinePos: PtrInt);
  1533. begin
  1534. if FShowCaret and (FCaretPos = LinePos) then
  1535. begin
  1536. FCaretPoint.X:= X;
  1537. FCaretPoint.Y:= Y;
  1538. end;
  1539. end;
  1540. begin
  1541. iPos := FPosition;
  1542. if Mode = vcmBook then
  1543. w := Width div FColCount
  1544. else begin
  1545. w := 0;
  1546. end;
  1547. for xIndex := 0 to FColCount-1 do
  1548. begin
  1549. for yIndex := 0 to GetClientHeightInLines(False) - 1 do
  1550. begin
  1551. if iPos > FHighLimit then
  1552. Break;
  1553. if iPos = FHighLimit then
  1554. begin
  1555. if GetPrevCharAsAscii(iPos, CharLenInBytes) = 10 then
  1556. begin
  1557. DrawCaret(0, yIndex * FTextHeight, iPos);
  1558. end;
  1559. Break;
  1560. end;
  1561. AddLineOffset(iPos);
  1562. LineStart := iPos;
  1563. i := CalcTextLineLength(iPos, FHighLimit, DataLength);
  1564. if i > FHLowEnd then FHLowEnd:= i;
  1565. if DataLength = 0 then
  1566. DrawCaret(0, yIndex * FTextHeight, LineStart)
  1567. else begin
  1568. if (Mode = vcmText) and (FHPosition > 0) then
  1569. begin
  1570. for i:= 1 to FHPosition do
  1571. begin
  1572. GetNextCharAsAscii(LineStart, CharLenInBytes);
  1573. DataLength -= CharLenInBytes;
  1574. LineStart += CharLenInBytes;
  1575. end;
  1576. if (DataLength <= 0) then Continue;
  1577. end;
  1578. sText := GetText(LineStart, DataLength, 0);
  1579. OutText(FLeftMargin + xIndex * w, yIndex * FTextHeight, sText, LineStart, DataLength);
  1580. end;
  1581. end;
  1582. end;
  1583. end;
  1584. procedure TViewerControl.WriteCustom;
  1585. // this method render visible page of text
  1586. var
  1587. yIndex: Integer;
  1588. iPos, LineStart: PtrInt;
  1589. s: string;
  1590. begin
  1591. iPos := FPosition;
  1592. for yIndex := 0 to GetClientHeightInLines(False) - 1 do
  1593. begin
  1594. if iPos >= FHighLimit then
  1595. Break;
  1596. LineStart := iPos;
  1597. AddLineOffset(iPos);
  1598. s := TransformCustom(iPos, FHighLimit); // get line text for render
  1599. if s <> '' then
  1600. OutCustom(FLeftMargin, yIndex * FTextHeight, s, LineStart, iPos - LineStart); // render line to canvas
  1601. end;
  1602. end;
  1603. procedure TViewerControl.WriteBin;
  1604. var
  1605. yIndex: Integer;
  1606. iPos, LineStart: PtrInt;
  1607. s: string;
  1608. begin
  1609. iPos := FPosition;
  1610. for yIndex := 0 to GetClientHeightInLines(False) - 1 do
  1611. begin
  1612. if iPos >= FHighLimit then
  1613. Break;
  1614. LineStart := iPos;
  1615. AddLineOffset(iPos);
  1616. s := TransformBin(iPos, FHighLimit);
  1617. if s <> '' then
  1618. OutBin(FLeftMargin, yIndex * FTextHeight, s, LineStart, iPos - LineStart);
  1619. end;
  1620. end;
  1621. function TViewerControl.GetDataAdr: Pointer;
  1622. begin
  1623. case FViewerControlMode of
  1624. vcmText, vcmWrap, vcmBook:
  1625. Result := FMappedFile + FBOMLength;
  1626. else
  1627. Result := FMappedFile;
  1628. end;
  1629. end;
  1630. procedure TViewerControl.SetPosition(Value: PtrInt);
  1631. begin
  1632. SetPosition(Value, False);
  1633. end;
  1634. procedure TViewerControl.SetHPosition(Value: Integer);
  1635. begin
  1636. SetHPosition(Value, False);
  1637. end;
  1638. procedure TViewerControl.SetHPosition(Value: Integer; Force: Boolean);
  1639. begin
  1640. if not IsFileOpen then
  1641. Exit;
  1642. FHPosition := Value;
  1643. // Set new scroll position.
  1644. if (FHPosition > 0) and (FHLowEnd - FTextWidth > 0) then
  1645. FHScrollBarPosition := FHPosition * 100 div (FHLowEnd - FTextWidth)
  1646. else
  1647. FHScrollBarPosition := 0;
  1648. // Update scrollbar position.
  1649. if FUpdateScrollBarPos then
  1650. begin
  1651. if FScrollBarHorz.Position <> FHScrollBarPosition then
  1652. begin
  1653. // Workaround for bug: http://bugs.freepascal.org/view.php?id=23815
  1654. {$IF DEFINED(LCLQT) and (LCL_FULLVERSION < 1010000)}
  1655. FScrollBarHorz.OnScroll := nil;
  1656. FScrollBarHorz.Position := FHScrollBarPosition;
  1657. Application.ProcessMessages; // Skip message
  1658. FScrollBarHorz.OnScroll := @ScrollBarHorzScroll;
  1659. {$ELSE}
  1660. FScrollBarHorz.Position := FHScrollBarPosition;
  1661. {$ENDIF}
  1662. end;
  1663. end;
  1664. // else the scrollbar position will be updated in ScrollBarVertScroll
  1665. Invalidate;
  1666. end;
  1667. procedure TViewerControl.SetPosition(Value: PtrInt; Force: Boolean);
  1668. var
  1669. LinesTooMany: Integer;
  1670. LastLineReached: Boolean;
  1671. begin
  1672. if not IsFileOpen then
  1673. Exit;
  1674. // Double byte text can have only even position
  1675. if (Encoding in ViewerEncodingDoubleByte) and Odd(Value) then
  1676. begin
  1677. Value := Value - 1;
  1678. end;
  1679. // Speedup if total nr of lines is less then nr of lines that can be displayed.
  1680. if (FPosition = FLowLimit) and // only if already at the top
  1681. (FLineList.Count > 0) and (FLineList.Count < GetClientHeightInLines)
  1682. then
  1683. Value := FLowLimit
  1684. else
  1685. // Boundary checks are done in GetStartOfLine.
  1686. Value := GetStartOfLine(Value);
  1687. if (Value <> FPosition) or Force then
  1688. begin
  1689. // Don't allow empty lines at the bottom of the control.
  1690. LinesTooMany := GetClientHeightInLines - GetLinesTillEnd(Value, LastLineReached);
  1691. if LinesTooMany > 0 then
  1692. begin
  1693. // scroll back upwards
  1694. ScrollPosition(Value, -LinesTooMany);
  1695. end;
  1696. FPosition := Value;
  1697. if Assigned(FOnPositionChanged) then
  1698. FOnPositionChanged(Self);
  1699. Invalidate;
  1700. // Set new scroll position.
  1701. if LastLineReached and (Value > 0) then
  1702. FScrollBarPosition := 100
  1703. else
  1704. FScrollBarPosition := Percent;
  1705. end;
  1706. // Update scrollbar position.
  1707. if FUpdateScrollBarPos then
  1708. begin
  1709. if FScrollBarVert.Position <> FScrollBarPosition then
  1710. begin
  1711. // Workaround for bug: http://bugs.freepascal.org/view.php?id=23815
  1712. {$IF DEFINED(LCLQT) and (LCL_FULLVERSION < 1010000)}
  1713. FScrollBarVert.OnScroll := nil;
  1714. FScrollBarVert.Position := FScrollBarPosition;
  1715. Application.ProcessMessages; // Skip message
  1716. FScrollBarVert.OnScroll := @ScrollBarVertScroll;
  1717. {$ELSE}
  1718. FScrollBarVert.Position := FScrollBarPosition;
  1719. {$ENDIF}
  1720. end;
  1721. end;
  1722. // else the scrollbar position will be updated in ScrollBarVertScroll
  1723. end;
  1724. procedure TViewerControl.SetEncoding(AEncoding: TViewerEncoding);
  1725. begin
  1726. if not (csDesigning in ComponentState) then
  1727. begin
  1728. if AEncoding = veAutoDetect then
  1729. FEncoding := DetectEncoding
  1730. else
  1731. FEncoding := AEncoding;
  1732. ReReadFile;
  1733. end
  1734. else
  1735. FEncoding := AEncoding;
  1736. end;
  1737. function TViewerControl.GetEncodingName: string;
  1738. begin
  1739. Result := ViewerEncodingsNames[FEncoding];
  1740. end;
  1741. procedure TViewerControl.SetEncodingName(AEncodingName: string);
  1742. var
  1743. i: TViewerEncoding;
  1744. begin
  1745. for i := Low(TViewerEncoding) to High(TViewerEncoding) do
  1746. if NormalizeEncoding(ViewerEncodingsNames[i]) = NormalizeEncoding(AEncodingName) then
  1747. begin
  1748. SetEncoding(i);
  1749. break;
  1750. end;
  1751. end;
  1752. function TViewerControl.GetClientHeightInLines(Whole: Boolean): Integer;
  1753. begin
  1754. if FTextHeight > 0 then
  1755. begin
  1756. if Whole then
  1757. Result := GetViewerRect.Height div FTextHeight
  1758. else
  1759. Result := Ceil(GetViewerRect.Height / FTextHeight);
  1760. end
  1761. else
  1762. Result := 0;
  1763. end;
  1764. function TViewerControl.GetLinesTillEnd(FromPosition: PtrInt;
  1765. out LastLineReached: Boolean): Integer;
  1766. var
  1767. iPos: PtrInt;
  1768. yIndex: Integer;
  1769. DataLength: PtrInt;
  1770. CharLenInBytes: Integer;
  1771. begin
  1772. Result := 0;
  1773. iPos := FromPosition;
  1774. for yIndex := 0 to GetClientHeightInLines - 1 do
  1775. begin
  1776. if iPos >= FHighLimit then
  1777. Break;
  1778. Inc(Result, 1);
  1779. case Mode of
  1780. vcmBin:
  1781. iPos := iPos + cBinWidth;
  1782. vcmHex,vcmDec:
  1783. iPos := iPos + FCustom.ValuesPerLine;
  1784. vcmText, vcmWrap, vcmBook:
  1785. CalcTextLineLength(iPos, FHighLimit, DataLength);
  1786. end;
  1787. end;
  1788. LastLineReached := (iPos >= FHighLimit);
  1789. if LastLineReached and (FViewerControlMode in [vcmText, vcmWrap, vcmBook]) then
  1790. begin
  1791. if (GetPrevCharAsAscii(FHighLimit, CharLenInBytes) = 10) then
  1792. Inc(Result);
  1793. end;
  1794. end;
  1795. procedure TViewerControl.SetShowCaret(AValue: Boolean);
  1796. begin
  1797. if FShowCaret <> AValue then
  1798. begin
  1799. FShowCaret:= AValue;
  1800. if HandleAllocated then
  1801. begin
  1802. if FShowCaret then
  1803. begin
  1804. LCLIntf.CreateCaret(Handle, 0, 2, FTextHeight);
  1805. LCLIntf.ShowCaret(Handle);
  1806. FCaretVisible:= True;
  1807. Invalidate;
  1808. end
  1809. else begin
  1810. FCaretVisible:= False;
  1811. LCLIntf.HideCaret(Handle);
  1812. LCLIntf.DestroyCaret(Handle);
  1813. end;
  1814. end;
  1815. end;
  1816. end;
  1817. procedure TViewerControl.SetCaretPos(AValue: PtrInt);
  1818. begin
  1819. if FCaretPos <> AValue then
  1820. begin
  1821. FCaretPos := AValue;
  1822. if FShowCaret then Invalidate;
  1823. end;
  1824. end;
  1825. function TViewerControl.GetPercent: Integer;
  1826. begin
  1827. if FHighLimit - FLowLimit > 0 then
  1828. Result := (Int64(FPosition - FLowLimit) * 100) div Int64(FHighLimit - FLowLimit)
  1829. else
  1830. Result := 0;
  1831. end;
  1832. procedure TViewerControl.SetPercent(const AValue: Integer);
  1833. begin
  1834. if FHighLimit - FLowLimit > 0 then
  1835. Position := Int64(AValue) * (Int64(FHighLimit - FLowLimit) div 100) + FLowLimit
  1836. else
  1837. Position := 0;
  1838. end;
  1839. procedure TViewerControl.SetBlockBegin(const AValue: PtrInt);
  1840. begin
  1841. if (AValue >= FLowLimit) and (AValue < FHighLimit) then
  1842. begin
  1843. if FBlockEnd < AValue then
  1844. FBlockEnd := AValue;
  1845. FBlockBeg := AValue;
  1846. Invalidate;
  1847. end;
  1848. end;
  1849. procedure TViewerControl.SetBlockEnd(const AValue: PtrInt);
  1850. begin
  1851. if (AValue >= FLowLimit) and (AValue < FHighLimit) then
  1852. begin
  1853. if FBlockBeg > AValue then
  1854. FBlockBeg := AValue;
  1855. FBlockEnd := AValue;
  1856. Invalidate;
  1857. end;
  1858. end;
  1859. procedure TViewerControl.OutText(x, y: Integer; const sText: String;
  1860. StartPos: PtrInt; DataLength: Integer);
  1861. var
  1862. pBegLine, pEndLine: PtrInt;
  1863. iBegDrawIndex, iEndDrawIndex: PtrInt;
  1864. begin
  1865. pBegLine := StartPos;
  1866. pEndLine := pBegLine + DataLength;
  1867. Canvas.Font.Color := Font.Color;
  1868. if FShowCaret and (FCaretPos >= pBegLine) and (FCaretPos <= pEndLine) then
  1869. begin
  1870. FCaretPoint.Y:= Y;
  1871. FCaretPoint.X:= X + Canvas.TextWidth(GetText(StartPos, FCaretPos - pBegLine, 0));
  1872. end;
  1873. // Out of selection, draw normal
  1874. if ((FBlockEnd - FBlockBeg) = 0) or ((FBlockBeg < pBegLine) and (FBlockEnd < pBegLine)) or // before
  1875. ((FBlockBeg > pEndLine) and (FBlockEnd > pEndLine)) then // after
  1876. begin
  1877. Canvas.TextOut(x, y, sText);
  1878. Exit;
  1879. end;
  1880. // Get selection start
  1881. if (FBlockBeg <= pBegLine) then
  1882. iBegDrawIndex := pBegLine
  1883. else
  1884. iBegDrawIndex := FBlockBeg;
  1885. // Get selection end
  1886. if (FBlockEnd < pEndLine) then
  1887. iEndDrawIndex := FBlockEnd
  1888. else
  1889. iEndDrawIndex := pEndLine;
  1890. // Text after selection.
  1891. if pEndLine - iEndDrawIndex > 0 then
  1892. Canvas.TextOut(x, y, sText);
  1893. // Text before selection + selected text
  1894. Canvas.Brush.Color := clHighlight;
  1895. Canvas.Font.Color := clHighlightText;
  1896. Canvas.TextOut(X, Y, GetText(StartPos, iEndDrawIndex - pBegLine, 0));
  1897. // Restore previous canvas settings
  1898. Canvas.Brush.Color := Color;
  1899. Canvas.Font.Color := Font.Color;
  1900. // Text before selection
  1901. if iBegDrawIndex - pBegLine > 0 then
  1902. Canvas.TextOut(X, Y, GetText(StartPos, iBegDrawIndex - pBegLine, 0));
  1903. end;
  1904. procedure TViewerControl.OutCustom(x, y: Integer; const sText: String;
  1905. StartPos: PtrInt; DataLength: Integer);
  1906. var
  1907. sTmpText: String;
  1908. pBegLine, pEndLine: PtrInt;
  1909. iBegDrawIndex, iEndDrawIndex: PtrInt;
  1910. begin
  1911. pBegLine := StartPos;
  1912. pEndLine := pBegLine + DataLength;
  1913. Canvas.Font.Color := Font.Color;
  1914. if FShowCaret and (FCaretPos >= pBegLine) and (FCaretPos <= pEndLine) then
  1915. begin
  1916. FCaretPoint.Y:= Y;
  1917. FCaretPoint.X:= X + Canvas.TextWidth(Copy(sText, 1, FCustom.StartAscii + (FCaretPos - pBegLine)));
  1918. end;
  1919. // Out of selection, draw normal
  1920. if ((FBlockEnd - FBlockBeg) = 0) or ((FBlockBeg < pBegLine) and (FBlockEnd <= pBegLine)) or // before
  1921. ((FBlockBeg > pEndLine) and (FBlockEnd > pEndLine)) then // after
  1922. begin
  1923. // Offset + hex part + space between hex and ascii
  1924. sTmpText:= Copy(sText, 1, FCustom.EndOfs) + ' ';
  1925. Canvas.TextOut(x, y, sTmpText);
  1926. x := x + Canvas.TextWidth(sTmpText);
  1927. // Ascii part
  1928. sTmpText := Copy(sText, 1 + FCustom.StartAscii, MaxInt);
  1929. Canvas.TextOut(x, y, sTmpText);
  1930. Exit;
  1931. end;
  1932. // Get selection start
  1933. if (FBlockBeg <= pBegLine) then
  1934. iBegDrawIndex := pBegLine
  1935. else begin
  1936. iBegDrawIndex := FBlockBeg;
  1937. end;
  1938. // Get selection end
  1939. if (FBlockEnd < pEndLine) then
  1940. iEndDrawIndex := FBlockEnd
  1941. else begin
  1942. iEndDrawIndex := pEndLine;
  1943. end;
  1944. // Text after selection (hex part)
  1945. if pEndLine - iEndDrawIndex > 0 then
  1946. begin
  1947. sTmpText := Copy(sText, 1, FCustom.StartOfs + (pEndLine - pBegLine) * (FCustom.MaxValueDigits + FCustom.SpaceCount));
  1948. Canvas.TextOut(x, y, sTmpText);
  1949. end;
  1950. // Text before selection + selected text (hex part)
  1951. sTmpText := Copy(sText, 1, FCustom.StartOfs + (iEndDrawIndex - pBegLine) * (FCustom.MaxValueDigits + FCustom.SpaceCount) - 1);
  1952. Canvas.Brush.Color := clHighlight;
  1953. Canvas.Font.Color := clHighlightText;
  1954. Canvas.TextOut(x, y, sTmpText);
  1955. // Restore previous canvas settings
  1956. Canvas.Brush.Color := Color;
  1957. Canvas.Font.Color := Font.Color;
  1958. // Offset + text before selection (hex part)
  1959. sTmpText := Copy(sText, 1, FCustom.StartOfs + (iBegDrawIndex - pBegLine) * (FCustom.MaxValueDigits + FCustom.SpaceCount));
  1960. Canvas.TextOut(x, y, sTmpText);
  1961. // Offset + hex part + space between hex and ascii
  1962. sTmpText:= Copy(sText, 1, FCustom.EndOfs) + ' ';
  1963. x := x + Canvas.TextWidth(sTmpText);
  1964. // Text after selection (ascii part)
  1965. if pEndLine - iEndDrawIndex > 0 then
  1966. begin
  1967. sTmpText := Copy(sText, FCustom.StartAscii + 1, MaxInt);
  1968. Canvas.TextOut(x, y, sTmpText);
  1969. end;
  1970. // Text before selection + selected text (ascii part)
  1971. if (iEndDrawIndex - pBegLine) = FCustom.ValuesPerLine then
  1972. sTmpText := Copy(sText, 1 + FCustom.StartAscii, MaxInt)
  1973. else begin
  1974. sTmpText := UTF8Copy(sText, 1 + FCustom.StartAscii, iEndDrawIndex - pBegLine);
  1975. end;
  1976. Canvas.Brush.Color := clHighlight;
  1977. Canvas.Font.Color := clHighlightText;
  1978. Canvas.TextOut(x, y, sTmpText);
  1979. // Restore background color
  1980. Canvas.Brush.Color := Color;
  1981. Canvas.Font.Color := Font.Color;
  1982. // Text before selection (ascii part)
  1983. if iBegDrawIndex - pBegLine > 0 then
  1984. begin
  1985. sTmpText := UTF8Copy(sText, 1 + FCustom.StartAscii, iBegDrawIndex - pBegLine);
  1986. Canvas.TextOut(x, y, sTmpText);
  1987. end;
  1988. end;
  1989. procedure TViewerControl.OutBin(x, y: Integer; const sText: String;
  1990. StartPos: PtrInt; DataLength: Integer);
  1991. var
  1992. pBegLine, pEndLine: PtrInt;
  1993. iBegDrawIndex, iEndDrawIndex: PtrInt;
  1994. begin
  1995. pBegLine := StartPos;
  1996. pEndLine := pBegLine + DataLength;
  1997. Canvas.Font.Color := Font.Color;
  1998. if FShowCaret and (FCaretPos >= pBegLine) and (FCaretPos <= pEndLine) then
  1999. begin
  2000. FCaretPoint.Y:= Y;
  2001. FCaretPoint.X:= X + Canvas.TextWidth(Copy(sText, 1, FCaretPos - pBegLine));
  2002. end;
  2003. // Out of selection, draw normal
  2004. if ((FBlockEnd - FBlockBeg) = 0) or ((FBlockBeg < pBegLine) and (FBlockEnd < pBegLine)) or // before
  2005. ((FBlockBeg > pEndLine) and (FBlockEnd > pEndLine)) then //after
  2006. begin
  2007. Canvas.TextOut(x, y, sText);
  2008. Exit;
  2009. end;
  2010. // Get selection start/end.
  2011. if (FBlockBeg <= pBegLine) then
  2012. iBegDrawIndex := pBegLine
  2013. else begin
  2014. iBegDrawIndex := FBlockBeg;
  2015. end;
  2016. if (FBlockEnd < pEndLine) then
  2017. iEndDrawIndex := FBlockEnd
  2018. else begin
  2019. iEndDrawIndex := pEndLine;
  2020. end;
  2021. // Text after selection.
  2022. if pEndLine - iEndDrawIndex > 0 then
  2023. Canvas.TextOut(x, y, sText);
  2024. // Text before selection + selected text
  2025. Canvas.Brush.Color := clHighlight;
  2026. Canvas.Font.Color := clHighlightText;
  2027. // Whole line selected
  2028. if (iEndDrawIndex - pBegLine) = DataLength then
  2029. Canvas.TextOut(X, Y, sText)
  2030. else begin
  2031. Canvas.TextOut(X, Y, UTF8Copy(sText, 1, iEndDrawIndex - pBegLine));
  2032. end;
  2033. // Restore previous canvas settings
  2034. Canvas.Brush.Color := Color;
  2035. Canvas.Font.Color := Font.Color;
  2036. // Text before selection
  2037. if iBegDrawIndex - pBegLine > 0 then
  2038. Canvas.TextOut(X, Y, UTF8Copy(sText, 1, iBegDrawIndex - pBegLine));
  2039. end;
  2040. procedure TViewerControl.AddLineOffset(const iOffset: PtrInt);
  2041. begin
  2042. FLineList.Add(iOffset);
  2043. end;
  2044. procedure TViewerControl.KeyDown(var Key: word; Shift: TShiftState);
  2045. var
  2046. CharLenInBytes: Integer;
  2047. begin
  2048. if Shift = [] then
  2049. begin
  2050. case Key of
  2051. VK_DOWN:
  2052. begin
  2053. Key := 0;
  2054. Scroll(1);
  2055. end;
  2056. VK_UP:
  2057. begin
  2058. Key := 0;
  2059. Scroll(-1);
  2060. end;
  2061. VK_RIGHT:
  2062. begin
  2063. Key := 0;
  2064. HScroll(1);
  2065. end;
  2066. VK_LEFT:
  2067. begin
  2068. Key := 0;
  2069. HScroll(-1);
  2070. end;
  2071. VK_HOME:
  2072. begin
  2073. Key := 0;
  2074. CaretGoHome;
  2075. end;
  2076. VK_END:
  2077. begin
  2078. Key := 0;
  2079. CaretGoEnd;
  2080. end;
  2081. VK_PRIOR:
  2082. begin
  2083. Key := 0;
  2084. PageUp;
  2085. end;
  2086. VK_NEXT:
  2087. begin
  2088. Key := 0;
  2089. PageDown;
  2090. end;
  2091. else
  2092. inherited KeyDown(Key, Shift);
  2093. end;
  2094. end
  2095. else if Shift = [ssCtrl] then
  2096. begin
  2097. case Key of
  2098. VK_HOME:
  2099. begin
  2100. Key := 0;
  2101. CaretPos := FLowLimit;
  2102. MakeVisible(FCaretPos)
  2103. end;
  2104. VK_END:
  2105. begin
  2106. Key := 0;
  2107. CaretPos := FHighLimit;
  2108. MakeVisible(FCaretPos);
  2109. end;
  2110. else
  2111. inherited KeyDown(Key, Shift);
  2112. end;
  2113. end
  2114. else
  2115. inherited KeyDown(Key, Shift);
  2116. end;
  2117. function TViewerControl.FindAsciiSetForward(aPosition, aMaxBytes: PtrInt;
  2118. const AsciiChars: String;
  2119. bFindNotIn: Boolean): PtrInt;
  2120. var
  2121. i: Integer;
  2122. found: Boolean;
  2123. u: Cardinal;
  2124. CharLenInBytes: Integer;
  2125. begin
  2126. Result := -1;
  2127. while aMaxBytes > 0 do
  2128. begin
  2129. u := GetNextCharAsAscii(aPosition, CharLenInBytes);
  2130. if CharLenInBytes = 0 then
  2131. Exit;
  2132. if not bFindNotIn then
  2133. begin
  2134. for i := 1 to Length(AsciiChars) do
  2135. if u = ord(AsciiChars[i]) then
  2136. Exit(aPosition);
  2137. end
  2138. else
  2139. begin
  2140. found := False;
  2141. for i := 1 to Length(AsciiChars) do
  2142. if u = ord(AsciiChars[i]) then
  2143. begin
  2144. found := True;
  2145. break;
  2146. end;
  2147. if not found then
  2148. Exit(aPosition);
  2149. end;
  2150. Inc(aPosition, CharLenInBytes);
  2151. Dec(aMaxBytes, CharLenInBytes);
  2152. end;
  2153. end;
  2154. function TViewerControl.FindAsciiSetBackward(aPosition, aMaxBytes: PtrInt;
  2155. const AsciiChars: String;
  2156. bFindNotIn: Boolean): PtrInt;
  2157. var
  2158. i: Integer;
  2159. found: Boolean;
  2160. u: Cardinal;
  2161. CharLenInBytes: Integer;
  2162. begin
  2163. Result := -1;
  2164. while aMaxBytes > 0 do
  2165. begin
  2166. u := GetPrevCharAsAscii(aPosition, CharLenInBytes);
  2167. if CharLenInBytes = 0 then
  2168. Exit;
  2169. if not bFindNotIn then
  2170. begin
  2171. for i := 1 to Length(AsciiChars) do
  2172. if u = ord(AsciiChars[i]) then
  2173. Exit(aPosition);
  2174. end
  2175. else
  2176. begin
  2177. found := False;
  2178. for i := 1 to Length(AsciiChars) do
  2179. if u = ord(AsciiChars[i]) then
  2180. begin
  2181. found := True;
  2182. break;
  2183. end;
  2184. if not found then
  2185. Exit(aPosition);
  2186. end;
  2187. Dec(aPosition, CharLenInBytes);
  2188. Dec(aMaxBytes, CharLenInBytes);
  2189. end;
  2190. end;
  2191. procedure TViewerControl.MouseDown(Button: TMouseButton; Shift: TShiftState;
  2192. X, Y: Integer);
  2193. var
  2194. LineBegin, LineEnd: PtrInt;
  2195. ClickPos: PtrInt;
  2196. CharSide: TCharSide;
  2197. CharLenInBytes: Integer;
  2198. begin
  2199. inherited;
  2200. SetFocus;
  2201. if not IsFileOpen then
  2202. Exit;
  2203. case Button of
  2204. mbLeft:
  2205. begin
  2206. if Shift * [ssDouble, ssTriple] = [] then
  2207. begin
  2208. // Single click.
  2209. ClickPos := XYPos2Adr(x, y, CharSide);
  2210. if ClickPos <> -1 then
  2211. begin
  2212. FBlockBeg := ClickPos;
  2213. FBlockEnd := ClickPos;
  2214. FCaretPos := ClickPos;
  2215. FMouseBlockBeg := ClickPos;
  2216. FMouseBlockSide := CharSide;
  2217. FSelecting := True;
  2218. if CharSide in [csRight, csAfter] then
  2219. begin
  2220. if FViewerControlMode in [vcmDec, vcmHex, vcmBin] then
  2221. CharLenInBytes := 1
  2222. else begin
  2223. GetNextCharAsAscii(FCaretPos, CharLenInBytes);
  2224. end;
  2225. FCaretPos := FCaretPos + CharLenInBytes;
  2226. end;
  2227. Invalidate;
  2228. end
  2229. else
  2230. FSelecting := False;
  2231. end
  2232. else // if double click or triple click
  2233. begin
  2234. FSelecting := False;
  2235. LineBegin := GetStartOfLine(FMouseBlockBeg);
  2236. LineEnd := GetEndOfLine(FMouseBlockBeg);
  2237. if ssDouble in Shift then
  2238. begin
  2239. // Select word with double-click.
  2240. FBlockBeg := FindAsciiSetBackward(FMouseBlockBeg,
  2241. FMouseBlockBeg - LineBegin, sNonCharacter, False);
  2242. FBlockEnd := FindAsciiSetForward(FMouseBlockBeg,
  2243. LineEnd - FMouseBlockBeg, sNonCharacter, False);
  2244. end
  2245. else if ssTriple in Shift then
  2246. begin
  2247. // Select line with triple-click.
  2248. FBlockBeg := FindAsciiSetForward(LineBegin,
  2249. LineEnd - LineBegin, sWhiteSpace, True);
  2250. FBlockEnd := FindAsciiSetBackward(LineEnd,
  2251. LineEnd - LineBegin, sWhiteSpace, True);
  2252. end;
  2253. if FBlockBeg = -1 then
  2254. FBlockBeg := LineBegin;
  2255. if FBlockEnd = -1 then
  2256. FBlockEnd := LineEnd;
  2257. if FBlockBeg > FBlockEnd then
  2258. FBlockEnd := FBlockBeg;
  2259. if FAutoCopy then
  2260. CopyToClipboard;
  2261. Invalidate;
  2262. end;
  2263. end; // mbLeft
  2264. end; // case
  2265. end;
  2266. procedure TViewerControl.MouseMove(Shift: TShiftState; X, Y: Integer);
  2267. procedure MoveOneChar(var aPosition: PtrInt);
  2268. var
  2269. CharLenInBytes: Integer;
  2270. begin
  2271. if FViewerControlMode in [vcmDec, vcmHex, vcmBin] then
  2272. CharLenInBytes := 1
  2273. else begin
  2274. GetNextCharAsAscii(aPosition, CharLenInBytes);
  2275. end;
  2276. aPosition := aPosition + CharLenInBytes;
  2277. end;
  2278. procedure MoveOneCharByMouseSide(var aPosition: PtrInt);
  2279. begin
  2280. if FMouseBlockSide in [csRight, csAfter] then
  2281. MoveOneChar(aPosition);
  2282. end;
  2283. var
  2284. ClickPos: PtrInt;
  2285. CharSide: TCharSide;
  2286. begin
  2287. inherited;
  2288. if FSelecting then
  2289. begin
  2290. if y < FTextHeight then
  2291. Scroll(-3)
  2292. else if y > ClientHeight - FTextHeight then
  2293. Scroll(3);
  2294. ClickPos := XYPos2Adr(x, y, CharSide);
  2295. if ClickPos <> -1 then
  2296. begin
  2297. if ClickPos < FMouseBlockBeg then
  2298. begin
  2299. // Got a new beginning.
  2300. FBlockBeg := ClickPos;
  2301. FBlockEnd := FMouseBlockBeg;
  2302. // Move end beyond last character.
  2303. MoveOneCharByMouseSide(FBlockEnd);
  2304. // When selecting from right to left, the current selected side must be
  2305. // either csLeft or csBefore, otherwise current position is not included.
  2306. if not (CharSide in [csLeft, csBefore]) then
  2307. begin
  2308. // Current position should not be included in selection.
  2309. // Move beginning after first character.
  2310. MoveOneChar(FBlockBeg);
  2311. end;
  2312. FCaretPos:= FBlockBeg;
  2313. end
  2314. else if ClickPos > FMouseBlockBeg then
  2315. begin
  2316. // Got a new end.
  2317. FBlockBeg := FMouseBlockBeg;
  2318. FBlockEnd := ClickPos;
  2319. // Move beginning after first character.
  2320. MoveOneCharByMouseSide(FBlockBeg);
  2321. // When selecting from left to right, the current selected side must be
  2322. // either csRight or csAfter, otherwise current position is not included.
  2323. if CharSide in [csRight, csAfter] then
  2324. begin
  2325. // Current position should be included in selection.
  2326. // Move end beyond last character.
  2327. MoveOneChar(FBlockEnd);
  2328. end;
  2329. FCaretPos:= FBlockEnd;
  2330. end
  2331. else if FMouseBlockSide <> CharSide then
  2332. begin
  2333. // Same position but changed side of the character.
  2334. FBlockBeg := FMouseBlockBeg;
  2335. FBlockEnd := FMouseBlockBeg;
  2336. if ((FMouseBlockSide in [csBefore, csLeft]) and
  2337. (CharSide in [csRight, csAfter])) or
  2338. ((FMouseBlockSide in [csRight, csAfter]) and
  2339. (CharSide in [csBefore, csLeft])) then
  2340. begin
  2341. // Move end beyond last character.
  2342. MoveOneChar(FBlockEnd);
  2343. end;
  2344. FCaretPos:= FBlockEnd;
  2345. end
  2346. else
  2347. begin
  2348. FBlockBeg := FMouseBlockBeg;
  2349. FBlockEnd := FMouseBlockBeg;
  2350. end;
  2351. Invalidate;
  2352. end;
  2353. end;
  2354. end;
  2355. procedure TViewerControl.MouseUp(Button: TMouseButton; Shift: TShiftState;
  2356. X, Y: Integer);
  2357. begin
  2358. inherited;
  2359. if FSelecting and (Button = mbLeft) and (Shift * [ssDouble, ssTriple] = []) then
  2360. begin
  2361. if FAutoCopy then
  2362. CopyToClipboard;
  2363. FSelecting := False;
  2364. end;
  2365. end;
  2366. function TViewerControl.DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean;
  2367. begin
  2368. Result := inherited;
  2369. if not Result then
  2370. Result := Scroll(Mouse.WheelScrollLines);
  2371. end;
  2372. function TViewerControl.DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean;
  2373. begin
  2374. Result := inherited;
  2375. if not Result then
  2376. Result := Scroll(-Mouse.WheelScrollLines);
  2377. end;
  2378. function TViewerControl.DoMouseWheelLeft(Shift: TShiftState; MousePos: TPoint): Boolean;
  2379. begin
  2380. Result:= inherited DoMouseWheelLeft(Shift, MousePos);
  2381. if not Result then
  2382. Result := HScroll(-Mouse.WheelScrollLines);
  2383. end;
  2384. function TViewerControl.DoMouseWheelRight(Shift: TShiftState; MousePos: TPoint): Boolean;
  2385. begin
  2386. Result:= inherited DoMouseWheelRight(Shift, MousePos);
  2387. if not Result then
  2388. Result := HScroll(Mouse.WheelScrollLines);
  2389. end;
  2390. procedure TViewerControl.DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy; const AXProportion, AYProportion: Double);
  2391. begin
  2392. FScrollBarVert.Width := LCLIntf.GetSystemMetrics(SM_CYVSCROLL);
  2393. FScrollBarHorz.Height := LCLIntf.GetSystemMetrics(SM_CYHSCROLL);
  2394. inherited DoAutoAdjustLayout(AMode, AXProportion, AYProportion);
  2395. end;
  2396. function TViewerControl.XYPos2Adr(x, y: Integer; out CharSide: TCharSide): PtrInt;
  2397. var
  2398. yIndex: Integer;
  2399. StartLine, EndLine: PtrInt;
  2400. function XYPos2AdrBin: PtrInt;
  2401. var
  2402. I, J, L: Integer;
  2403. charWidth: Integer;
  2404. textWidth: Integer;
  2405. tmpPosition: PtrInt;
  2406. s, ss, sText: String;
  2407. InvalidCharLen: Integer;
  2408. begin
  2409. J:= 1;
  2410. ss := EmptyStr;
  2411. tmpPosition := StartLine;
  2412. sText := TransformBin(tmpPosition, EndLine);
  2413. L:= Length(sText);
  2414. for I := 1 to L do
  2415. begin
  2416. charWidth:= SafeUTF8NextCharLen(PByte(@sText[J]), (L - J) + 1, InvalidCharLen);
  2417. s:= Copy(sText, J, charWidth);
  2418. Inc(J, charWidth);
  2419. ss := ss + s;
  2420. textWidth := Canvas.TextWidth(ss);
  2421. if textWidth > x then
  2422. begin
  2423. charWidth := Canvas.TextWidth(s);
  2424. if textWidth - charWidth div 2 > x then
  2425. CharSide := csLeft
  2426. else
  2427. CharSide := csRight;
  2428. Exit(StartLine + I - 1); // -1 because we count from 1
  2429. end;
  2430. end;
  2431. CharSide := csBefore;
  2432. Result := EndLine;
  2433. end;
  2434. function XYPos2AdrCustom: PtrInt;
  2435. // | offset part | custom part | native part |
  2436. // | 0000AAAA: | FF AA CC AE | djfjks |
  2437. var
  2438. I, J, L: Integer;
  2439. charWidth: Integer;
  2440. textWidth: Integer;
  2441. tmpPosition: PtrInt;
  2442. InvalidCharLen: Integer;
  2443. ss, sText, sPartialText: String;
  2444. begin
  2445. tmpPosition := StartLine;
  2446. sText := TransformCustom(tmpPosition, EndLine);
  2447. if sText = '' then Exit;
  2448. // Clicked on offset part
  2449. ss := Copy(sText, 1, FCustom.StartOfs);
  2450. textWidth := Canvas.TextWidth(ss);
  2451. if textWidth > x then
  2452. begin
  2453. CharSide := csBefore;
  2454. Exit(StartLine);
  2455. end;
  2456. // Clicked on custom part
  2457. for I := 0 to FCustom.ValuesPerLine - 1 do
  2458. begin
  2459. sPartialText := Copy(sText, 1 + FCustom.StartOfs + I * (FCustom.MaxValueDigits + FCustom.SpaceCount), FCustom.MaxValueDigits);
  2460. ss := ss + sPartialText;
  2461. textWidth := Canvas.TextWidth(ss);
  2462. if textWidth > x then
  2463. begin
  2464. // Check if we're not after end of data.
  2465. if StartLine + I >= EndLine then
  2466. begin
  2467. CharSide := csBefore;
  2468. Exit(EndLine);
  2469. end;
  2470. charWidth := Canvas.TextWidth(sPartialText);
  2471. if textWidth - charWidth div 2 > x then
  2472. CharSide := csLeft
  2473. else
  2474. CharSide := csRight;
  2475. Exit(StartLine + I);
  2476. end;
  2477. // Space after hex number.
  2478. ss := ss + string(sText[1 + FCustom.StartOfs + I * (FCustom.MaxValueDigits + 1) + FCustom.MaxValueDigits]);
  2479. textWidth := Canvas.TextWidth(ss);
  2480. if textWidth > x then
  2481. begin
  2482. CharSide := csAfter;
  2483. Exit(StartLine + I);
  2484. end;
  2485. end;
  2486. // Clicked between hex and ascii.
  2487. sPartialText := Copy(sText, 1 + FCustom.StartOfs, FCustom.StartAscii - FCustom.EndOfs);
  2488. ss := ss + sPartialText;
  2489. textWidth := Canvas.TextWidth(ss);
  2490. if textWidth > x then
  2491. begin
  2492. Exit(-1); // No position.
  2493. end;
  2494. // Clicked on ascii part.
  2495. L:= Length(sText);
  2496. J:= 1 + FCustom.StartAscii;
  2497. for I := 0 to FCustom.ValuesPerLine - 1 do
  2498. begin
  2499. charWidth := SafeUTF8NextCharLen(PByte(@sText[J]), (L - J) + 1, InvalidCharLen);
  2500. sPartialText := Copy(sText, J, charWidth);
  2501. Inc(J, charWidth);
  2502. ss := ss + sPartialText;
  2503. textWidth := Canvas.TextWidth(ss);
  2504. if textWidth > x then
  2505. begin
  2506. // Check if we're not after end of data.
  2507. if StartLine + I >= EndLine then
  2508. begin
  2509. CharSide := csBefore;
  2510. Exit(EndLine);
  2511. end;
  2512. charWidth := Canvas.TextWidth(sPartialText);
  2513. if textWidth - charWidth div 2 > x then
  2514. CharSide := csLeft
  2515. else
  2516. CharSide := csRight;
  2517. Exit(StartLine + I);
  2518. end;
  2519. end;
  2520. CharSide := csBefore;
  2521. Result := EndLine;
  2522. end;
  2523. function XYPos2AdrText: PtrInt;
  2524. var
  2525. i: PtrInt;
  2526. Dos: Boolean;
  2527. charWidth: Integer;
  2528. textWidth: Integer;
  2529. len: Integer = 0;
  2530. CharLenInBytes: Integer;
  2531. s: String;
  2532. ss: String;
  2533. begin
  2534. ss := '';
  2535. i := StartLine;
  2536. Dos:= FEncoding in ViewerEncodingOem;
  2537. while i < EndLine do
  2538. begin
  2539. s := GetNextCharAsUtf8(i, CharLenInBytes);
  2540. if CharLenInBytes = 0 then
  2541. Break;
  2542. // Check if the conversion to UTF-8 was successful.
  2543. if Length(s) > 0 then
  2544. begin
  2545. if s = #9 then
  2546. begin
  2547. s := StringOfChar(' ', FTabSpaces - len mod FTabSpaces);
  2548. len := len + (FTabSpaces - len mod FTabSpaces);
  2549. end
  2550. else
  2551. Inc(len); // Assume there is one character after conversion
  2552. // (otherwise use Inc(len, UTF8Length(s))).
  2553. if (Mode = vcmText) and (len <= FHPosition) then
  2554. begin
  2555. i := i + CharLenInBytes;
  2556. Continue;
  2557. end;
  2558. if (CharLenInBytes = 1) and (s[1] < ' ') then
  2559. begin
  2560. if Dos then
  2561. s := ASCII_TABLE[Ord(s[1])]
  2562. else
  2563. s := ' ';
  2564. end;
  2565. ss := ss + s;
  2566. textWidth := Canvas.TextWidth(ss);
  2567. if textWidth > x then
  2568. begin
  2569. charWidth := Canvas.TextWidth(s);
  2570. if textWidth - charWidth div 2 > x then
  2571. CharSide := csLeft
  2572. else
  2573. CharSide := csRight;
  2574. Exit(i);
  2575. end;
  2576. end;
  2577. i := i + CharLenInBytes;
  2578. end;
  2579. CharSide := csBefore;
  2580. Result := EndLine;
  2581. end;
  2582. begin
  2583. if FLineList.Count = 0 then
  2584. Exit(-1);
  2585. if (x < FLeftMargin) then
  2586. x := 0
  2587. else begin
  2588. x := x - FLeftMargin;
  2589. end;
  2590. yIndex := y div FTextHeight;
  2591. if yIndex >= FLineList.Count then
  2592. yIndex := FLineList.Count - 1;
  2593. if yIndex < 0 then
  2594. yIndex := 0;
  2595. // Get position of first character of the line.
  2596. StartLine := FLineList.Items[yIndex];
  2597. // Get position of last character of the line.
  2598. EndLine := GetEndOfLine(StartLine);
  2599. if (x = 0) and ((Mode <> vcmText) or (FHPosition = 0)) then
  2600. begin
  2601. CharSide := csBefore;
  2602. Exit(StartLine);
  2603. end;
  2604. case Mode of
  2605. vcmBin:
  2606. Result := XYPos2AdrBin;
  2607. vcmHex,vcmDec:
  2608. Result := XYPos2AdrCustom; // XYPos2AdrHex;
  2609. vcmText, vcmWrap, vcmBook:
  2610. Result := XYPos2AdrText;
  2611. else
  2612. raise Exception.Create('Invalid viewer mode');
  2613. end;
  2614. end;
  2615. procedure TViewerControl.SelectAll;
  2616. begin
  2617. SelectText(FLowLimit, FHighLimit);
  2618. end;
  2619. procedure TViewerControl.SelectText(AStart, AEnd: PtrInt);
  2620. begin
  2621. if AStart < FLowLimit then
  2622. AStart := FLowLimit;
  2623. if AEnd > FHighLimit then
  2624. AEnd := FHighLimit;
  2625. if AStart <= AEnd then
  2626. begin
  2627. FBlockBeg := AStart;
  2628. FBlockEnd := AEnd;
  2629. Invalidate;
  2630. end;
  2631. end;
  2632. procedure TViewerControl.CopyToClipboard;
  2633. var
  2634. sText, utf8Text: string;
  2635. begin
  2636. if (FBlockEnd - FBlockBeg) <= 0 then
  2637. Exit;
  2638. if (FBlockEnd - FBlockBeg) > 1024 * 1024 then // Max 1 MB to clipboard
  2639. Exit;
  2640. SetString(sText, GetDataAdr + FBlockBeg, FBlockEnd - FBlockBeg);
  2641. utf8Text := ConvertToUTF8(sText);
  2642. {$IFDEF LCLGTK2}
  2643. // Workaround for Lazarus bug #0021453. LCL adds trailing zero to clipboard in Clipboard.AsText.
  2644. Clipboard.Clear;
  2645. Clipboard.AddFormat(PredefinedClipboardFormat(pcfText), utf8Text[1], Length(utf8Text));
  2646. {$ELSE}
  2647. Clipboard.AsText := utf8Text;
  2648. {$ENDIF}
  2649. end;
  2650. procedure TViewerControl.CopyToClipboardF;
  2651. var
  2652. s,sText, utf8Text: string;
  2653. len: Integer;
  2654. begin
  2655. len:=FBlockEnd-FBlockBeg;
  2656. if len=0 then exit;
  2657. sText:=TransformCustomBlock(FBlockBeg,len,False,False,s);
  2658. utf8Text := ConvertToUTF8(sText);
  2659. {$IFDEF LCLGTK2}
  2660. // Workaround for Lazarus bug #0021453. LCL adds trailing zero to clipboard in Clipboard.AsText.
  2661. Clipboard.Clear;
  2662. Clipboard.AddFormat(PredefinedClipboardFormat(pcfText), utf8Text[1], Length(utf8Text));
  2663. {$ELSE}
  2664. Clipboard.AsText := utf8Text;
  2665. {$ENDIF}
  2666. end;
  2667. function TViewerControl.Selection: String;
  2668. const
  2669. MAX_LEN = 512;
  2670. var
  2671. sText: String;
  2672. AIndex: PtrInt;
  2673. ALength: PtrInt;
  2674. CharLenInBytes: Integer;
  2675. begin
  2676. if (FBlockEnd - FBlockBeg) <= 0 then
  2677. Exit(EmptyStr);
  2678. ALength:= FBlockEnd - FBlockBeg;
  2679. if ALength <= MAX_LEN then
  2680. begin
  2681. SetString(sText, GetDataAdr + FBlockBeg, ALength);
  2682. Result := ConvertToUTF8(sText);
  2683. end
  2684. else begin
  2685. Result:= EmptyStr;
  2686. AIndex:= FBlockBeg;
  2687. ALength:= AIndex + MAX_LEN;
  2688. while AIndex < ALength do
  2689. begin
  2690. sText := GetNextCharAsUtf8(AIndex, CharLenInBytes);
  2691. if CharLenInBytes = 0 then
  2692. Break;
  2693. Result:= Result + sText;
  2694. AIndex:= AIndex + CharLenInBytes;
  2695. end;
  2696. end;
  2697. end;
  2698. function TViewerControl.GetNextCharAsAscii(const iPosition: PtrInt; out CharLenInBytes: Integer): Cardinal;
  2699. var
  2700. u1, u2: Word;
  2701. InvalidCharLen: Integer;
  2702. begin
  2703. Result := 0;
  2704. case FEncoding of
  2705. veUtf8, veUtf8bom:
  2706. begin
  2707. if iPosition < FHighLimit then
  2708. begin
  2709. CharLenInBytes := SafeUTF8NextCharLen(GetDataAdr + iPosition,
  2710. FHighLimit - iPosition,
  2711. InvalidCharLen);
  2712. // It's enough to only return Ascii.
  2713. if CharLenInBytes = 1 then
  2714. Result := PByte(GetDataAdr)[iPosition];
  2715. // Full conversion:
  2716. // Result := UTF8CodepointToUnicode(PAnsiChar(GetDataAdr + iPosition), CharLenInBytes);
  2717. end
  2718. else
  2719. CharLenInBytes := 0;
  2720. end;
  2721. veAnsi, veOem,
  2722. veCp1250..veCp874,
  2723. veIso88591,
  2724. veIso88592,
  2725. veKoi8r,
  2726. veKoi8u,
  2727. veKoi8ru:
  2728. if iPosition < FHighLimit then
  2729. begin
  2730. Result := PByte(GetDataAdr)[iPosition];
  2731. CharLenInBytes := 1;
  2732. end
  2733. else
  2734. CharLenInBytes := 0;
  2735. veUcs2be:
  2736. if iPosition + SizeOf(Word) - 1 < FHighLimit then
  2737. begin
  2738. Result := BEtoN(PWord(GetDataAdr + iPosition)[0]);
  2739. CharLenInBytes := SizeOf(Word);
  2740. end
  2741. else
  2742. CharLenInBytes := 0;
  2743. veUcs2le:
  2744. if iPosition + SizeOf(Word) - 1 < FHighLimit then
  2745. begin
  2746. Result := LEtoN(PWord(GetDataAdr + iPosition)[0]);
  2747. CharLenInBytes := SizeOf(Word);
  2748. end
  2749. else
  2750. CharLenInBytes := 0;
  2751. veUtf16be:
  2752. if iPosition + SizeOf(Word) - 1 < FHighLimit then
  2753. begin
  2754. u1 := BEtoN(PWord(GetDataAdr + iPosition)[0]);
  2755. CharLenInBytes := UTF16CharacterLength(@u1);
  2756. if CharLenInBytes = 1 then
  2757. begin
  2758. Result := u1;
  2759. end
  2760. else if iPosition + SizeOf(Word) * CharLenInBytes - 1 < FHighLimit then
  2761. begin
  2762. u2 := BEtoN(PWord(GetDataAdr + iPosition)[1]);
  2763. Result := utf16PairToUnicode(u1, u2);
  2764. end;
  2765. CharLenInBytes := CharLenInBytes * SizeOf(Word);
  2766. end
  2767. else
  2768. CharLenInBytes := 0;
  2769. veUtf16le:
  2770. if iPosition + SizeOf(Word) - 1 < FHighLimit then
  2771. begin
  2772. u1 := LEtoN(PWord(GetDataAdr + iPosition)[0]);
  2773. CharLenInBytes := UTF16CharacterLength(@u1);
  2774. if CharLenInBytes = 1 then
  2775. begin
  2776. Result := u1;
  2777. end
  2778. else if iPosition + SizeOf(Word) * CharLenInBytes - 1 < FHighLimit then
  2779. begin
  2780. u2 := LEtoN(PWord(GetDataAdr + iPosition)[1]);
  2781. Result := utf16PairToUnicode(u1, u2);
  2782. end
  2783. else
  2784. CharLenInBytes := 0;
  2785. CharLenInBytes := CharLenInBytes * SizeOf(Word);
  2786. end
  2787. else
  2788. CharLenInBytes := 0;
  2789. veUtf32be:
  2790. if iPosition + SizeOf(LongWord) - 1 < FHighLimit then
  2791. begin
  2792. Result := BEtoN(PLongWord(GetDataAdr + iPosition)[0]);
  2793. CharLenInBytes := SizeOf(LongWord);
  2794. end
  2795. else
  2796. CharLenInBytes := 0;
  2797. veUtf32le:
  2798. if iPosition + SizeOf(LongWord) - 1 < FHighLimit then
  2799. begin
  2800. Result := LEtoN(PLongWord(GetDataAdr + iPosition)[0]);
  2801. CharLenInBytes := SizeOf(LongWord);
  2802. end
  2803. else
  2804. CharLenInBytes := 0;
  2805. veCp932, // Unsupported variable-width encodings
  2806. veCp936, // TODO: Add cp932, cp936, cp949, cp950 encoding support
  2807. veCp949,
  2808. veCp950:
  2809. if iPosition < FHighLimit then
  2810. begin
  2811. Result := PByte(GetDataAdr)[iPosition];
  2812. CharLenInBytes := 1;
  2813. end
  2814. else
  2815. CharLenInBytes := 0;
  2816. else
  2817. raise Exception.Create('Unsupported viewer encoding');
  2818. end;
  2819. end;
  2820. function TViewerControl.GetPrevCharAsAscii(const iPosition: PtrInt; out CharLenInBytes: Integer): Cardinal;
  2821. var
  2822. u1, u2: Word;
  2823. InvalidCharLen: Integer;
  2824. begin
  2825. Result := 0;
  2826. case FEncoding of
  2827. veUtf8, veUtf8bom:
  2828. begin
  2829. if iPosition > FLowLimit then
  2830. begin
  2831. CharLenInBytes := SafeUTF8PrevCharLen(GetDataAdr + iPosition,
  2832. iPosition - FLowLimit,
  2833. InvalidCharLen);
  2834. // It's enough to only return Ascii.
  2835. if CharLenInBytes = 1 then
  2836. Result := PByte(GetDataAdr)[iPosition - 1];
  2837. // Full conversion:
  2838. // Result := UTF8CodepointToUnicode(PAnsiChar(GetDataAdr + iPosition - CharLenInBytes), CharLenInBytes);
  2839. end
  2840. else
  2841. CharLenInBytes := 0;
  2842. end;
  2843. veAnsi, veOem,
  2844. veCp1250..veCp874,
  2845. veIso88591,
  2846. veIso88592,
  2847. veKoi8r,
  2848. veKoi8u,
  2849. veKoi8ru:
  2850. if iPosition > FLowLimit then
  2851. begin
  2852. Result := PByte(GetDataAdr + iPosition)[-1];
  2853. CharLenInBytes := 1;
  2854. end
  2855. else
  2856. CharLenInBytes := 0;
  2857. veUcs2be:
  2858. if iPosition >= FLowLimit + SizeOf(Word) then
  2859. begin
  2860. Result := BEtoN(PWord(GetDataAdr + iPosition)[-1]);
  2861. CharLenInBytes := SizeOf(Word);
  2862. end
  2863. else
  2864. CharLenInBytes := 0;
  2865. veUcs2le:
  2866. if iPosition >= FLowLimit + SizeOf(Word) then
  2867. begin
  2868. Result := LEtoN(PWord(GetDataAdr + iPosition)[-1]);
  2869. CharLenInBytes := SizeOf(Word);
  2870. end
  2871. else
  2872. CharLenInBytes := 0;
  2873. veUtf16be:
  2874. if iPosition >= FLowLimit + SizeOf(Word) then
  2875. begin
  2876. u1 := BEtoN(PWord(GetDataAdr + iPosition)[-1]);
  2877. CharLenInBytes := UTF16CharacterLength(@u1);
  2878. if CharLenInBytes = 1 then
  2879. begin
  2880. Result := u1;
  2881. end
  2882. else if iPosition >= FLowLimit + SizeOf(Word) * CharLenInBytes then
  2883. begin
  2884. u2 := BEtoN(PWord(GetDataAdr + iPosition)[-2]);
  2885. // u2 is the first, u1 is the second value of the pair
  2886. Result := utf16PairToUnicode(u2, u1);
  2887. end;
  2888. CharLenInBytes := CharLenInBytes * SizeOf(Word);
  2889. end
  2890. else
  2891. CharLenInBytes := 0;
  2892. veUtf16le:
  2893. if iPosition >= FLowLimit + SizeOf(Word) then
  2894. begin
  2895. u1 := LEtoN(PWord(GetDataAdr + iPosition)[-1]);
  2896. CharLenInBytes := UTF16CharacterLength(@u1);
  2897. if CharLenInBytes = 1 then
  2898. begin
  2899. Result := u1;
  2900. end
  2901. else if iPosition >= FLowLimit + SizeOf(Word) * CharLenInBytes then
  2902. begin
  2903. u2 := LEtoN(PWord(GetDataAdr + iPosition)[-2]);
  2904. // u2 is the first, u1 is the second value of the pair
  2905. Result := utf16PairToUnicode(u2, u1);
  2906. end;
  2907. CharLenInBytes := CharLenInBytes * SizeOf(Word);
  2908. end
  2909. else
  2910. CharLenInBytes := 0;
  2911. veUtf32be:
  2912. if iPosition >= FLowLimit + SizeOf(LongWord) then
  2913. begin
  2914. Result := BEtoN(PLongWord(GetDataAdr + iPosition)[-1]);
  2915. CharLenInBytes := SizeOf(LongWord);
  2916. end
  2917. else
  2918. CharLenInBytes := 0;
  2919. veUtf32le:
  2920. if iPosition >= FLowLimit + SizeOf(LongWord) then
  2921. begin
  2922. Result := LEtoN(PLongWord(GetDataAdr + iPosition)[-1]);
  2923. CharLenInBytes := SizeOf(LongWord);
  2924. end
  2925. else
  2926. CharLenInBytes := 0;
  2927. veCp932, // Unsupported variable-width encodings
  2928. veCp936, // TODO: Add cp932, cp936, cp949, cp950 encoding support
  2929. veCp949,
  2930. veCp950:
  2931. if iPosition > FLowLimit then
  2932. begin
  2933. Result := PByte(GetDataAdr + iPosition)[-1];
  2934. CharLenInBytes := 1;
  2935. end
  2936. else
  2937. CharLenInBytes := 0;
  2938. else
  2939. raise Exception.Create('Unsupported viewer encoding');
  2940. end;
  2941. end;
  2942. function TViewerControl.GetNextCharAsUtf8(const iPosition: PtrInt; out CharLenInBytes: Integer): String;
  2943. var
  2944. u1: Word;
  2945. s: string;
  2946. InvalidCharLen: Integer;
  2947. begin
  2948. Result := '';
  2949. case FEncoding of
  2950. veUtf8, veUtf8bom:
  2951. CharLenInBytes := SafeUTF8NextCharLen(GetDataAdr + iPosition,
  2952. FHighLimit - iPosition,
  2953. InvalidCharLen);
  2954. veAnsi, veOem,
  2955. veCp1250..veCp874,
  2956. veIso88591,
  2957. veIso88592,
  2958. veKoi8r,
  2959. veKoi8u,
  2960. veKoi8ru:
  2961. CharLenInBytes := 1;
  2962. veUcs2be, veUcs2le:
  2963. CharLenInBytes := 2;
  2964. veUtf16be:
  2965. if iPosition + SizeOf(Word) - 1 < FHighLimit then
  2966. begin
  2967. u1 := BEtoN(PWord(GetDataAdr + iPosition)[0]);
  2968. CharLenInBytes := UTF16CharacterLength(@u1) * SizeOf(Word);
  2969. end
  2970. else
  2971. CharLenInBytes := 0;
  2972. veUtf16le:
  2973. if iPosition + SizeOf(Word) - 1 < FHighLimit then
  2974. begin
  2975. u1 := LEtoN(PWord(GetDataAdr + iPosition)[0]);
  2976. CharLenInBytes := UTF16CharacterLength(@u1) * SizeOf(Word);
  2977. end
  2978. else
  2979. CharLenInBytes := 0;
  2980. veUtf32be, veUtf32le:
  2981. CharLenInBytes := 4;
  2982. veCp932, // Unsupported variable-width encodings
  2983. veCp936, // TODO: Add cp932, cp936, cp949, cp950 encoding support
  2984. veCp949,
  2985. veCp950:
  2986. CharLenInBytes := 1;
  2987. else
  2988. raise Exception.Create('Unsupported viewer encoding');
  2989. end;
  2990. if (CharLenInBytes > 0) and (iPosition + CharLenInBytes - 1 < FHighLimit) then
  2991. begin
  2992. SetString(s, GetDataAdr + iPosition, CharLenInBytes);
  2993. Result := ConvertToUTF8(s);
  2994. end
  2995. else
  2996. Result := '';
  2997. end;
  2998. function TViewerControl.ConvertToUTF8(const sText: AnsiString): String;
  2999. begin
  3000. if FEncoding = veAutoDetect then
  3001. FEncoding := DetectEncoding; // Force detect encoding.
  3002. case FEncoding of
  3003. veAutoDetect: ;
  3004. veAnsi:
  3005. Result := CeAnsiToUtf8(sText);
  3006. veOem:
  3007. Result := CeOemToUtf8(sText);
  3008. veUtf8, veUtf8bom:
  3009. Result := Utf8ReplaceBroken(sText);
  3010. veUtf16be:
  3011. Result := Utf16BEToUtf8(sText);
  3012. veUtf16le:
  3013. Result := Utf16LEToUtf8(sText);
  3014. veUtf32be:
  3015. Result := Utf32BEToUtf8(sText);
  3016. veUtf32le:
  3017. Result := Utf32LEToUtf8(sText);
  3018. else
  3019. Result := LConvEncoding.ConvertEncoding(sText,
  3020. ViewerEncodingsNames[FEncoding], EncodingUTF8);
  3021. end;
  3022. end;
  3023. function TViewerControl.ConvertFromUTF8(const sText: String): AnsiString;
  3024. begin
  3025. if FEncoding = veAutoDetect then
  3026. FEncoding := DetectEncoding; // Force detect encoding.
  3027. case FEncoding of
  3028. veAutoDetect: ;
  3029. veAnsi:
  3030. Result := CeUtf8ToAnsi(sText);
  3031. veOem:
  3032. Result := CeUtf8ToOem(sText);
  3033. veUtf8, veUtf8bom:
  3034. Result := sText;
  3035. veUtf16be:
  3036. Result := Utf8ToUtf16BE(sText);
  3037. veUtf16le:
  3038. Result := Utf8ToUtf16LE(sText);
  3039. veUtf32be:
  3040. Result := '';//Utf8ToUtf32BE(sText);
  3041. veUtf32le:
  3042. Result := '';//Utf8ToUtf32LE(sText);
  3043. else
  3044. Result := LConvEncoding.ConvertEncoding(sText,
  3045. EncodingUTF8, ViewerEncodingsNames[FEncoding]);
  3046. end;
  3047. end;
  3048. function TViewerControl.IsVisible(const aPosition: PtrInt): Boolean;
  3049. var
  3050. StartPos: PtrInt;
  3051. CharLenInBytes: Integer;
  3052. begin
  3053. if IsFileOpen and (FLineList.Count > 0) then
  3054. begin
  3055. FVisibleOffset:= 0;
  3056. StartPos:= GetStartOfLine(aPosition);
  3057. // Calculate horizontal offset in symbols
  3058. while (StartPos < aPosition) do
  3059. begin
  3060. GetNextCharAsAscii(StartPos, CharLenInBytes);
  3061. Inc(StartPos, CharLenInBytes);
  3062. Inc(FVisibleOffset);
  3063. end;
  3064. Result := (aPosition >= FLineList.Items[0]) and
  3065. (aPosition <= FLineList.Items[FLineList.Count - 1]) and
  3066. (FVisibleOffset >= FHPosition) and
  3067. (FVisibleOffset <= FHPosition + FTextWidth);
  3068. end
  3069. else
  3070. Result := False;
  3071. end;
  3072. procedure TViewerControl.MakeVisible(const aPosition: PtrInt);
  3073. var
  3074. Offset: Integer;
  3075. LastLine: Boolean;
  3076. begin
  3077. if not IsVisible(aPosition) then
  3078. begin
  3079. SetPosition(aPosition);
  3080. Offset:= GetLinesTillEnd(aPosition, LastLine);
  3081. if (Offset > 4) and (LastLine = False) then Scroll(-4);
  3082. Update;
  3083. if FViewerControlMode = vcmText then
  3084. begin
  3085. if (FVisibleOffset < FHPosition) or
  3086. (FVisibleOffset > FHPosition + FTextWidth) then
  3087. begin
  3088. SetHPosition(FVisibleOffset);
  3089. HScroll(-1);
  3090. end;
  3091. end;
  3092. end;
  3093. end;
  3094. procedure TViewerControl.ScrollBarVertScroll(Sender: TObject;
  3095. ScrollCode: TScrollCode; var ScrollPos: Integer);
  3096. begin
  3097. FUpdateScrollBarPos := False;
  3098. case ScrollCode of
  3099. scLineUp: Scroll(-1);
  3100. scLineDown: Scroll(1);
  3101. scPageUp: PageUp;
  3102. scPageDown: PageDown;
  3103. scTop: GoHome;
  3104. scBottom: GoEnd;
  3105. scTrack,
  3106. scPosition:
  3107. begin
  3108. // This check helps avoiding loops if changing ScrollPos below
  3109. // triggers another scPosition message.
  3110. if (ScrollCode = scTrack) or (ScrollPos <> FScrollBarPosition) then
  3111. begin
  3112. if ScrollPos = 0 then
  3113. GoHome
  3114. else if ScrollPos = 100 then
  3115. GoEnd
  3116. else
  3117. Percent := ScrollPos;
  3118. end;
  3119. end;
  3120. scEndScroll:
  3121. begin
  3122. end;
  3123. end;
  3124. ScrollPos := FScrollBarPosition;
  3125. FUpdateScrollBarPos := True;
  3126. end;
  3127. procedure TViewerControl.ScrollBarHorzScroll(Sender: TObject;
  3128. ScrollCode: TScrollCode; var ScrollPos: Integer);
  3129. begin
  3130. FUpdateScrollBarPos := False;
  3131. case ScrollCode of
  3132. scLineUp: HScroll(-1);
  3133. scLineDown: HScroll(1);
  3134. scPageUp: HPageUp;
  3135. scPageDown: HPageDown;
  3136. scTop: HGoHome;
  3137. scBottom: HGoEnd;
  3138. scTrack,
  3139. scPosition:
  3140. begin
  3141. // This check helps avoiding loops if changing ScrollPos below
  3142. // triggers another scPosition message.
  3143. if (ScrollCode = scTrack) or (ScrollPos <> FHScrollBarPosition) then
  3144. begin
  3145. if ScrollPos = 0 then
  3146. HGoHome
  3147. else if ScrollPos = 100 then
  3148. HGoEnd
  3149. else
  3150. HScroll((FHLowEnd - FTextWidth) * ScrollPos div 100 - FHPosition);
  3151. end;
  3152. end;
  3153. scEndScroll:
  3154. begin
  3155. end;
  3156. end;
  3157. ScrollPos := FHScrollBarPosition;
  3158. FUpdateScrollBarPos := True;
  3159. end;
  3160. procedure TViewerControl.UpdateScrollbars;
  3161. begin
  3162. FScrollBarVert.LargeChange := GetClientHeightInLines - 1;
  3163. case Mode of
  3164. vcmBin, vcmHex:
  3165. begin
  3166. //FScrollBarVert.PageSize :=
  3167. // ((FHighLimit div cHexWidth - GetClientHeightInLines) div 100);
  3168. end
  3169. else
  3170. FScrollBarVert.PageSize := 1;
  3171. end;
  3172. FScrollBarHorz.Visible:= (FViewerControlMode = vcmText);
  3173. end;
  3174. procedure TViewerControl.ViewerResize(Sender: TObject);
  3175. begin
  3176. UpdateScrollbars;
  3177. // Force recalculating position.
  3178. SetPosition(FPosition);
  3179. SetHPosition(FHPosition);
  3180. end;
  3181. procedure TViewerControl.ReReadFile;
  3182. begin
  3183. FBlockBeg := 0;
  3184. FBlockEnd := 0;
  3185. FBOMLength := GetBomLength;
  3186. UpdateLimits;
  3187. UpdateScrollbars;
  3188. Invalidate;
  3189. end;
  3190. function TViewerControl.IsFileOpen: Boolean;
  3191. begin
  3192. Result := Assigned(FMappedFile);
  3193. end;
  3194. function TViewerControl.DetectEncoding: TViewerEncoding;
  3195. var
  3196. DetectStringLength: Integer = 4096; // take first 4kB of the file to detect encoding
  3197. DetectString: String;
  3198. DetectedEncodingName: String;
  3199. Enc: TViewerEncoding;
  3200. begin
  3201. if IsFileOpen then
  3202. begin
  3203. // Default to Ansi in case encoding cannot be detected or is unsupported.
  3204. Result := veAnsi;
  3205. if FFileSize < DetectStringLength then
  3206. DetectStringLength := FFileSize;
  3207. SetString(DetectString, PAnsiChar(FMappedFile), DetectStringLength);
  3208. if Assigned(FOnGuessEncoding) then
  3209. DetectedEncodingName := FOnGuessEncoding(DetectString)
  3210. else
  3211. DetectedEncodingName := LConvEncoding.GuessEncoding(DetectString);
  3212. if DetectedEncodingName <> '' then
  3213. begin
  3214. DetectedEncodingName := NormalizeEncoding(DetectedEncodingName);
  3215. // Map UCS-2 to UTF-16.
  3216. if DetectedEncodingName = 'ucs2le' then
  3217. DetectedEncodingName := 'utf16le'
  3218. else if DetectedEncodingName = 'ucs2be' then
  3219. DetectedEncodingName := 'utf16be';
  3220. for Enc := Low(TViewerEncoding) to High(TViewerEncoding) do
  3221. begin
  3222. if NormalizeEncoding(ViewerEncodingsNames[Enc]) = DetectedEncodingName then
  3223. begin
  3224. Result := Enc;
  3225. break;
  3226. end;
  3227. end;
  3228. end;
  3229. end
  3230. else
  3231. Result := veAutoDetect;
  3232. end;
  3233. procedure TViewerControl.GetSupportedEncodings(List: TStrings);
  3234. var
  3235. Enc: TViewerEncoding;
  3236. begin
  3237. for Enc := Low(TViewerEncoding) to High(TViewerEncoding) do
  3238. List.Add(ViewerEncodingsNames[Enc]);
  3239. end;
  3240. function TViewerControl.GetBomLength: Integer;
  3241. begin
  3242. Result := 0;
  3243. case FEncoding of
  3244. veUtf8, veUtf8bom:
  3245. if (FFileSize >= 3) and
  3246. (PByte(FMappedFile)[0] = $EF) and
  3247. (PByte(FMappedFile)[1] = $BB) and
  3248. (PByte(FMappedFile)[2] = $BF) then
  3249. begin
  3250. Result := 3;
  3251. end;
  3252. veUcs2be, veUtf16be:
  3253. if (FFileSize >= 2) and
  3254. (PByte(FMappedFile)[0] = $FE) and
  3255. (PByte(FMappedFile)[1] = $FF) then
  3256. begin
  3257. Result := 2;
  3258. end;
  3259. veUcs2le, veUtf16le:
  3260. if (FFileSize >= 2) and
  3261. (PByte(FMappedFile)[0] = $FF) and
  3262. (PByte(FMappedFile)[1] = $FE) then
  3263. begin
  3264. Result := 2;
  3265. end;
  3266. veUtf32be:
  3267. if (FFileSize >= 4) and
  3268. (PByte(FMappedFile)[0] = $00) and
  3269. (PByte(FMappedFile)[1] = $00) and
  3270. (PByte(FMappedFile)[2] = $FE) and
  3271. (PByte(FMappedFile)[3] = $FF) then
  3272. begin
  3273. Result := 4;
  3274. end;
  3275. veUtf32le:
  3276. if (FFileSize >= 4) and
  3277. (PByte(FMappedFile)[0] = $00) and
  3278. (PByte(FMappedFile)[1] = $00) and
  3279. (PByte(FMappedFile)[2] = $FF) and
  3280. (PByte(FMappedFile)[3] = $FE) then
  3281. begin
  3282. Result := 4;
  3283. end;
  3284. end;
  3285. end;
  3286. procedure TViewerControl.UpdateLimits;
  3287. begin
  3288. if FEncoding = veAutoDetect then
  3289. FEncoding := DetectEncoding;
  3290. FBOMLength := GetBomLength;
  3291. case FViewerControlMode of
  3292. vcmText, vcmWrap, vcmBook:
  3293. begin
  3294. FLowLimit := 0;
  3295. FHighLimit := FFileSize - FBOMLength;
  3296. end;
  3297. else
  3298. begin
  3299. FLowLimit := 0;
  3300. FHighLimit := FFileSize;
  3301. end;
  3302. end;
  3303. end;
  3304. procedure TViewerControl.UpdateSelection;
  3305. procedure Check(var aPosition: PtrInt; Backwards: Boolean);
  3306. var
  3307. CharStart: Pointer;
  3308. begin
  3309. case FEncoding of
  3310. veUtf8, veUtf8bom:
  3311. begin
  3312. if not Backwards then
  3313. begin
  3314. CharStart := SafeUTF8NextCharStart(GetDataAdr + aPosition,
  3315. FHighLimit - aPosition);
  3316. if Assigned(CharStart) then
  3317. aPosition := CharStart - GetDataAdr
  3318. else
  3319. aPosition := 0;
  3320. end
  3321. else
  3322. begin
  3323. CharStart := SafeUTF8PrevCharEnd(GetDataAdr + aPosition,
  3324. aPosition - FLowLimit);
  3325. if Assigned(CharStart) then
  3326. aPosition := CharStart - GetDataAdr
  3327. else
  3328. aPosition := 0;
  3329. end;
  3330. end;
  3331. veAnsi, veOem,
  3332. veCp1250..veCp874,
  3333. veIso88591,
  3334. veIso88592,
  3335. veKoi8r,
  3336. veKoi8u,
  3337. veKoi8ru:
  3338. ; // any position allowed
  3339. veUcs2be, veUcs2le:
  3340. aPosition := ((aPosition - FLowLimit) and not 1) + FLowLimit;
  3341. veUtf16be, veUtf16le:
  3342. // todo: check if not in the middle of utf-16 character
  3343. aPosition := ((aPosition - FLowLimit) and not 1) + FLowLimit;
  3344. veUtf32be, veUtf32le:
  3345. aPosition := ((aPosition - FLowLimit) and not 3) + FLowLimit;
  3346. veCp932, // Unsupported variable-width encodings
  3347. veCp936, // TODO: Add cp932, cp936, cp949, cp950 encoding support
  3348. veCp949,
  3349. veCp950:
  3350. ;
  3351. else
  3352. raise Exception.Create('Unsupported viewer encoding');
  3353. end;
  3354. end;
  3355. begin
  3356. if (FBlockBeg < FLowLimit) or (FBlockBeg >= FHighLimit) or
  3357. (FBlockEnd < FLowLimit) or (FBlockEnd >= FHighLimit) then
  3358. begin
  3359. FBlockBeg := FLowLimit;
  3360. FBlockEnd := FLowLimit;
  3361. end
  3362. else
  3363. begin
  3364. case FViewerControlMode of
  3365. vcmText, vcmWrap, vcmBook:
  3366. begin
  3367. Check(FBlockBeg, False);
  3368. Check(FBlockEnd, True);
  3369. if (FBlockBeg < FLowLimit) or (FBlockBeg >= FHighLimit) or
  3370. (FBlockEnd < FLowLimit) or (FBlockEnd >= FHighLimit) or
  3371. (FBlockEnd < FBlockBeg) then
  3372. begin
  3373. FBlockBeg := FLowLimit;
  3374. FBlockEnd := FLowLimit;
  3375. end;
  3376. end;
  3377. // In non-text modes any selection is valid.
  3378. end;
  3379. end;
  3380. end;
  3381. function TViewerControl.FindUtf8Text(iStartPos: PtrInt; const sSearchText: String;
  3382. bCaseSensitive: Boolean; bSearchBackwards: Boolean): PtrInt;
  3383. var
  3384. SearchTextLength: Integer;
  3385. sSearchChars: array of String;
  3386. pCurrentAddr, pEndAddr: PtrInt;
  3387. i, charLen: Integer;
  3388. function sPos2(pAdr: PtrInt):Boolean;
  3389. var
  3390. curChr:String;
  3391. i, charLen: Integer;
  3392. begin
  3393. Result := False;
  3394. for i := 0 to SearchTextLength-1 do
  3395. begin
  3396. curChr:=GetNextCharAsUtf8(pAdr,charLen);
  3397. case bCaseSensitive of
  3398. False: if UTF8UpperCase(curChr) <> UTF8UpperCase(sSearchChars[i]) then Exit;
  3399. True : if curChr <> sSearchChars[i] then Exit;
  3400. end;
  3401. if charLen>0 then
  3402. pAdr:=pAdr+charLen
  3403. else
  3404. Inc(pAdr);
  3405. end;
  3406. Result:=True;
  3407. end;
  3408. begin
  3409. Result := PtrInt(-1);
  3410. SearchTextLength := UTF8Length(sSearchText);
  3411. if (SearchTextLength <= 0) then
  3412. Exit;
  3413. setLength(sSearchChars,SearchTextLength);
  3414. for i:=1 to SearchTextLength do
  3415. sSearchChars[i-1]:=UTF8Copy(sSearchText,i,1);
  3416. pCurrentAddr := iStartPos;
  3417. pEndAddr := FHighLimit - Length(ConvertFromUTF8(sSearchText));
  3418. if bSearchBackwards and (pCurrentAddr > pEndAddr) then
  3419. // Move to the first possible position for searching backwards.
  3420. pCurrentAddr := pEndAddr;
  3421. if (pEndAddr < 0) or (pCurrentAddr < 0) or (pCurrentAddr > pEndAddr) then
  3422. Exit;
  3423. while True do
  3424. begin
  3425. if (pCurrentAddr > pEndAddr) or (pCurrentAddr < 0) then
  3426. Exit;
  3427. if sPos2(pCurrentAddr) then
  3428. begin
  3429. Result := pCurrentAddr;
  3430. Exit;
  3431. end;
  3432. case bSearchBackwards of
  3433. False:
  3434. begin
  3435. GetNextCharAsUtf8(pCurrentAddr,charLen);
  3436. if charLen>0 then
  3437. pCurrentAddr:=pCurrentAddr+charLen
  3438. else
  3439. Inc(pCurrentAddr);
  3440. end;
  3441. True : Dec(pCurrentAddr);
  3442. end;
  3443. end;
  3444. end;
  3445. procedure TViewerControl.ResetEncoding;
  3446. begin
  3447. FEncoding:= veAutoDetect;
  3448. end;
  3449. procedure Register;
  3450. begin
  3451. RegisterComponents('SeksiCmd', [TViewerControl]);
  3452. end;
  3453. end.