├── atbinhex ├── atstreamsearchoptions.inc ├── atbinhex.dcr ├── atstreamsearch.dcr ├── res │ ├── mouse_scroll.cur │ ├── mouse_scroll.png │ ├── mouse_scroll_150.png │ ├── mouse_scroll_200.png │ ├── mouse_scroll_up.cur │ ├── atbinhexresources.res │ ├── mouse_scroll_down.cur │ ├── mouse_scroll_left.cur │ ├── mouse_scroll_right.cur │ └── make_res.sh ├── atbinhexoptions.inc ├── atbinhex_register.pas ├── atbinhex_clipboard.pas ├── atbinhex_package.pas ├── atbinhex_hexproc.pas ├── atbinhex_package.lpk ├── atbinhex_msg.pas ├── atbinhex_encoding.pas ├── atbinhex_canvasproc.pas ├── atbinhex_stringproc.pas ├── atbinhex_strproc.pas └── atstreamsearch.pas ├── demo_main ├── demo.res ├── demo.lpr ├── demo.lpi ├── formmain.lfm └── formmain.pas ├── license.txt ├── help_delphi ├── ATBinHex.chm └── source │ ├── c.bat │ ├── ATBinHex.hhp │ ├── ModeHex.gif │ ├── ModeText.gif │ ├── ModeUHex.gif │ ├── ModeBinary.gif │ ├── ModeUnicode.gif │ ├── Index.hhk │ ├── Contacts.html │ ├── Installation.html │ ├── Main.css │ ├── Copyrights.html │ ├── License.html │ ├── Usage Thread-safety.html │ ├── AddLibraries.html │ ├── Introduction.html │ ├── Table of Contents.hhc │ ├── Usage Hints.html │ ├── Usage Events.html │ ├── History.html │ ├── Usage Methods.html │ └── Usage Properties.html ├── .gitignore ├── readme.md └── history.txt /atbinhex/atstreamsearchoptions.inc: -------------------------------------------------------------------------------- 1 | //{$define REGEX} 2 | //{$define TNT} 3 | -------------------------------------------------------------------------------- /demo_main/demo.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Alexey-T/ATBinHex-Lazarus/HEAD/demo_main/demo.res -------------------------------------------------------------------------------- /atbinhex/atbinhex.dcr: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Alexey-T/ATBinHex-Lazarus/HEAD/atbinhex/atbinhex.dcr -------------------------------------------------------------------------------- /license.txt: -------------------------------------------------------------------------------- 1 | You can use ATBinHex under 2 licenses: MPL 2.0 or LGPL. 2 | Copyright (c) Alexey Torgashin 3 | -------------------------------------------------------------------------------- /help_delphi/ATBinHex.chm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Alexey-T/ATBinHex-Lazarus/HEAD/help_delphi/ATBinHex.chm -------------------------------------------------------------------------------- /help_delphi/source/c.bat: -------------------------------------------------------------------------------- 1 | @echo off 2 | cls 3 | "C:\Program Files\HTML Help Workshop\hhc.exe" ATBinHex.hhp 4 | -------------------------------------------------------------------------------- /atbinhex/atstreamsearch.dcr: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Alexey-T/ATBinHex-Lazarus/HEAD/atbinhex/atstreamsearch.dcr -------------------------------------------------------------------------------- /atbinhex/res/mouse_scroll.cur: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Alexey-T/ATBinHex-Lazarus/HEAD/atbinhex/res/mouse_scroll.cur -------------------------------------------------------------------------------- /atbinhex/res/mouse_scroll.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Alexey-T/ATBinHex-Lazarus/HEAD/atbinhex/res/mouse_scroll.png -------------------------------------------------------------------------------- /help_delphi/source/ATBinHex.hhp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Alexey-T/ATBinHex-Lazarus/HEAD/help_delphi/source/ATBinHex.hhp -------------------------------------------------------------------------------- /help_delphi/source/ModeHex.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Alexey-T/ATBinHex-Lazarus/HEAD/help_delphi/source/ModeHex.gif -------------------------------------------------------------------------------- /help_delphi/source/ModeText.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Alexey-T/ATBinHex-Lazarus/HEAD/help_delphi/source/ModeText.gif -------------------------------------------------------------------------------- /help_delphi/source/ModeUHex.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Alexey-T/ATBinHex-Lazarus/HEAD/help_delphi/source/ModeUHex.gif -------------------------------------------------------------------------------- /atbinhex/res/mouse_scroll_150.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Alexey-T/ATBinHex-Lazarus/HEAD/atbinhex/res/mouse_scroll_150.png -------------------------------------------------------------------------------- /atbinhex/res/mouse_scroll_200.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Alexey-T/ATBinHex-Lazarus/HEAD/atbinhex/res/mouse_scroll_200.png -------------------------------------------------------------------------------- /atbinhex/res/mouse_scroll_up.cur: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Alexey-T/ATBinHex-Lazarus/HEAD/atbinhex/res/mouse_scroll_up.cur -------------------------------------------------------------------------------- /help_delphi/source/ModeBinary.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Alexey-T/ATBinHex-Lazarus/HEAD/help_delphi/source/ModeBinary.gif -------------------------------------------------------------------------------- /atbinhex/res/atbinhexresources.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Alexey-T/ATBinHex-Lazarus/HEAD/atbinhex/res/atbinhexresources.res -------------------------------------------------------------------------------- /atbinhex/res/mouse_scroll_down.cur: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Alexey-T/ATBinHex-Lazarus/HEAD/atbinhex/res/mouse_scroll_down.cur -------------------------------------------------------------------------------- /atbinhex/res/mouse_scroll_left.cur: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Alexey-T/ATBinHex-Lazarus/HEAD/atbinhex/res/mouse_scroll_left.cur -------------------------------------------------------------------------------- /atbinhex/res/mouse_scroll_right.cur: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Alexey-T/ATBinHex-Lazarus/HEAD/atbinhex/res/mouse_scroll_right.cur -------------------------------------------------------------------------------- /help_delphi/source/ModeUnicode.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Alexey-T/ATBinHex-Lazarus/HEAD/help_delphi/source/ModeUnicode.gif -------------------------------------------------------------------------------- /atbinhex/atbinhexoptions.inc: -------------------------------------------------------------------------------- 1 | //{$define NOTIF} 2 | //{$define PRINT} 3 | //{$define PREVIEW} 4 | {$define SEARCH} 5 | {$define SCROLL} 6 | //{$define REGEX} 7 | -------------------------------------------------------------------------------- /atbinhex/res/make_res.sh: -------------------------------------------------------------------------------- 1 | ~/lazarus/tools/lazres atbinhexresources.res mouse_scroll.cur=ab_move mouse_scroll_up.cur=ab_move_u mouse_scroll_down.cur=ab_move_d mouse_scroll_left.cur=ab_move_l mouse_scroll_right.cur=ab_move_r mouse_scroll.png=ab_move 2 | -------------------------------------------------------------------------------- /help_delphi/source/Index.hhk: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 9 | 10 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.zip 2 | *.dbg 3 | *.ico 4 | *.exe 5 | *.dll 6 | *.bpl 7 | *.bpi 8 | *.dcp 9 | *.so 10 | *.apk 11 | *.drc 12 | *.map 13 | *.dres 14 | *.rsm 15 | *.tds 16 | *.dcu 17 | *.dof 18 | *.deb 19 | *.zip 20 | *.ppu 21 | *.bak 22 | *.lib 23 | *.mes 24 | *.o 25 | *.or 26 | *.lps 27 | 28 | */lib/ 29 | */backup/ 30 | demo 31 | -------------------------------------------------------------------------------- /readme.md: -------------------------------------------------------------------------------- 1 | ATBinHex was originally a Delphi component http://atviewer.sourceforge.net/atbinhex.htm 2 | 3 | This is Lazarus version. 4 | 5 | * Some features disabled via ATBinHexOptions.inc (printing, regex hiliting of URLs) 6 | * Removed method OpenFile (it used Win API), now use OpenStream 7 | * Encodings are supported again, via LConvEncoding, in non-unicode modes only 8 | -------------------------------------------------------------------------------- /atbinhex/atbinhex_register.pas: -------------------------------------------------------------------------------- 1 | unit atbinhex_register; 2 | 3 | {$mode objfpc}{$H+} 4 | 5 | interface 6 | 7 | uses 8 | Classes, SysUtils, ATBinHex; 9 | 10 | procedure Register; 11 | 12 | implementation 13 | 14 | {$R atbinhex.dcr} 15 | 16 | { Registration } 17 | procedure Register; 18 | begin 19 | RegisterComponents('AT Controls', [TATBinHex]); 20 | end; 21 | 22 | end. 23 | 24 | -------------------------------------------------------------------------------- /demo_main/demo.lpr: -------------------------------------------------------------------------------- 1 | program demo; 2 | 3 | {$mode objfpc}{$H+} 4 | 5 | uses 6 | {$IFDEF UNIX}{$IFDEF UseCThreads} 7 | cthreads, 8 | {$ENDIF}{$ENDIF} 9 | Interfaces, // this includes the LCL widgetset 10 | Forms, formmain; 11 | 12 | {$R *.res} 13 | 14 | begin 15 | RequireDerivedFormResource:= True; 16 | Application.Initialize; 17 | Application.CreateForm(TfmMain, fmMain); 18 | Application.Run; 19 | end. 20 | 21 | -------------------------------------------------------------------------------- /help_delphi/source/Contacts.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | Contacts 6 | 7 | 8 | 9 | 10 |

Contacts

11 |
12 | 13 | If you encounter problems with this component, 14 | or you have comments or suggestions, contact the author: 15 | 16 |

17 | Alexey Torgashin
18 | http://www.uvviewsoft.com
19 | 20 | 21 | -------------------------------------------------------------------------------- /atbinhex/atbinhex_clipboard.pas: -------------------------------------------------------------------------------- 1 | unit atbinhex_clipboard; 2 | 3 | interface 4 | 5 | uses 6 | atbinhex_encoding; 7 | 8 | function SCopyToClipboard(const S: AnsiString): Boolean; 9 | function SCopyToClipboardW(const S: UnicodeString): Boolean; 10 | 11 | 12 | implementation 13 | 14 | uses 15 | SysUtils, 16 | Clipbrd; 17 | 18 | function SCopyToClipboard(const S: AnsiString): Boolean; 19 | begin 20 | Clipboard.AsText:= S; 21 | Result:= true; 22 | end; 23 | 24 | function SCopyToClipboardW(const S: UnicodeString): Boolean; 25 | begin 26 | Clipboard.AsText:= UTF8Encode(S); 27 | Result:= true; 28 | end; 29 | 30 | 31 | end. 32 | -------------------------------------------------------------------------------- /help_delphi/source/Installation.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | Installation 6 | 7 | 8 | 9 | 10 |

Installation

11 |
12 | 13 | To install the component in the Delphi/C++Builder IDE: 14 | 19 | 20 |

21 | Component will be installed into the "Samples" page of component pallette. 22 | 23 | 24 | 25 | -------------------------------------------------------------------------------- /atbinhex/atbinhex_package.pas: -------------------------------------------------------------------------------- 1 | { This file was automatically created by Lazarus. Do not edit! 2 | This source is only used to compile and install the package. 3 | } 4 | 5 | unit atbinhex_package; 6 | 7 | {$warn 5023 off : no warning about unused units} 8 | interface 9 | 10 | uses 11 | ATBinHex, atbinhex_register, atbinhex_canvasproc, atbinhex_stringproc, 12 | atbinhex_msg, atbinhex_clipboard, atbinhex_encoding, atbinhex_hexproc, 13 | atbinhex_strproc, ATStreamSearch, LazarusPackageIntf; 14 | 15 | implementation 16 | 17 | procedure Register; 18 | begin 19 | RegisterUnit('atbinhex_register', @atbinhex_register.Register); 20 | end; 21 | 22 | initialization 23 | RegisterPackage('atbinhex_package', @Register); 24 | end. 25 | -------------------------------------------------------------------------------- /help_delphi/source/Main.css: -------------------------------------------------------------------------------- 1 | body 2 | { 3 | font-family: Tahoma, Arial, Helvetica, sans-serif; 4 | font-size: 0.8em; 5 | background: #FFF; 6 | } 7 | 8 | table 9 | { 10 | border: 2px #CCC solid; 11 | border-collapse: collapse; 12 | border-spacing: 0px; 13 | margin-top: 0px; 14 | } 15 | 16 | td 17 | { 18 | border: 2px #CCC solid; 19 | font-family: Arial, Helvetica, sans-serif; 20 | font-size: 0.9em; 21 | } 22 | 23 | td.big 24 | { 25 | font-size: 1.1em; 26 | font-weight: bold; 27 | text-align: center; 28 | background-color: #EEE; 29 | } 30 | 31 | td pre 32 | { 33 | background-color: #EEE; 34 | } 35 | 36 | hr 37 | { 38 | border: 0; 39 | color: #CCC; 40 | background-color: #CCC; 41 | height: 2px; 42 | text-align: center; 43 | } 44 | 45 | h1, h2, h3 46 | { 47 | color: darkblue; 48 | } 49 | 50 | .blue 51 | { 52 | color: darkblue; 53 | } 54 | 55 | img 56 | { 57 | border: 0; 58 | vertical-align: middle; 59 | } 60 | -------------------------------------------------------------------------------- /help_delphi/source/Copyrights.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | Copyrights & Links 6 | 7 | 8 | 9 | 10 |

Copyrights & Links

11 |
12 | 13 | 28 | 29 | 30 | 31 | -------------------------------------------------------------------------------- /help_delphi/source/License.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | License 6 | 7 | 8 | 9 | 10 |

License

11 |
12 | 13 | This package, unless otherwise stated in the particular source code file, 14 | is distributed under Mozilla Public License Version 1.1 (the "License"). 15 | You may obtain a copy of the License at 16 | http://www.mozilla.org/MPL/ 17 | 18 |

19 | Software distributed under the License is distributed on an "AS IS" 20 | basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the 21 | License for the specific language governing rights and limitations 22 | under the License. 23 | 24 |

25 | Copyright © 2006-2007 Alexey Torgashin.
26 | 27 | 28 | 29 | -------------------------------------------------------------------------------- /help_delphi/source/Usage Thread-safety.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | Usage: Thread-safety note 6 | 7 | 8 | 9 | 10 |

Thread-safety note

11 |
12 | 13 | The current component version is not thread safe. But if you need to use it in a multi-thread 14 | application, the following hint should help to use it right. For example, you need 15 | to call Open method from several threads. Don't do this, instead do it in message way: 16 | all threads should send a message (it may be some Windows message not used in your application, 17 | e.g. EM_DISPLAYBAND) to main thread, informing it that a filename should be opened. 18 | Pointer to a filename can be passed as message parameter. 19 | So the main message handler calls Open. 20 | 21 |

22 | Note: this may be a risk of receiving messages from several threads at almost the same time, 23 | so additional boolean "Busy flag" should be set on message-handler start and reset on exit. 24 | 25 | 26 | 27 | -------------------------------------------------------------------------------- /history.txt: -------------------------------------------------------------------------------- 1 | 2024.07.01 2 | + add: props MarkerStart, MarkerLength, MarkerLineWidth, TextColorMarker 3 | 4 | 2023.12.01 5 | * change: disabled selection with UTF8 encoding, to hide wrong selection with UTF8 6 | * change: support proportional fonts, but now rendering is slower due to call of TCanvas.TextWidth for each char 7 | + add: DoubleBuffered property, it now allows correct rendering on macOS Retina if set to False 8 | - fix: TextWrap is now working 9 | 10 | 2019.09.19 11 | * change: require package EncConv (in github.com/alexey-t) instead of LConvEncoding 12 | 13 | 2018.04.10 14 | - fix: double-click worked wrong (must react in MouseUp, not in DblClick) 15 | - fix: wrong find of whole words 16 | 17 | 2018.04.07 18 | + add: update resource pic for "middle mouse click scroll" for hi-dpi 19 | + add: rewritten other resource files 20 | 21 | 2017.12.18 22 | + add: use unicode middle-dot U+00B7 for special chars 23 | 24 | 2017.12.15 25 | + big rework. ATStreamSearch works now. ATBinHex methods FindFirst/FindNext work now. Only case-insensitive search don't work for non-ascii text. Hard todo. 26 | + add: buttons Find/FindNext in demo 27 | + add: keys Home/End to goto file begin/end, in fixed modes 28 | + add: hide v-scrollbar in fixed modes (hex/ binary/ u-hex) 29 | - fix: OnScroll wasn't called in many cases 30 | - fix: huge file, if v-scrollbar dragged to end, file must also scroll to end 31 | -------------------------------------------------------------------------------- /help_delphi/source/AddLibraries.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | Additional libraries used 6 | 7 | 8 | 9 | 10 |

Additional libraries used

11 |
12 | 13 | Additional optional libraries used in ATBinHex are: 14 | 15 |
    16 |
  1. 17 |

    DIRegEx: used for RegEx (regular expressions) search. 18 | asoRegEx search option is available only when this library is compiled in. 19 | After you install this library, enable its usage in 20 | ATBinHexOptions.inc and ATStreamSearchOptions.inc files, uncomment the "REGEX" define. 21 |

    22 | 23 |
  2. 24 |

    Tnt Unicode Controls: used for search in Unicode-named files (TTntFileStream class is used). 25 | After you install this library, enable its 26 | usage in file ATStreamSearchOptions.inc, uncomment the "TNT" define. 27 |

    28 | 29 |
  3. 30 |

    ATPrintPreview: used to show the "Print preview" form before the actual printing in 31 | Print and PrintPreview methods. 32 | After you install this library, enable its 33 | usage in file ATBinHexOptions.inc, uncomment the "PREVIEW" define. 34 |

    35 |
36 | 37 | Download links for mentioned libraries are listed in 38 | Copyrights topic. 39 | 40 | 41 | 42 | -------------------------------------------------------------------------------- /help_delphi/source/Introduction.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | Introduction 6 | 7 | 8 | 9 | 10 |

ATBinHex Component

11 |
12 | 13 | ATBinHex is a control that implements the quick file (stream) viewer. 14 | Only visible part of file (or stream) is loaded into viewer, so it's suitable 15 | to show files of unlimited size. Features: 16 | 17 | 23 | 24 |

25 | There are 5 view modes available: 26 |

33 | 34 |
35 |


Text mode 36 |


Binary mode 37 |


Hex mode 38 |


Unicode mode 39 |


Unicode/Hex mode 40 |

41 | 42 |

43 | There is extended version of this component available, 44 | ATViewer, 45 | which can show files in such modes as RTF, Image, Multimedia, Internet and WLX Plugins. 46 | But if you just need to show a plain file dump, ATBinHex should be enough. 47 | 48 |

49 | There is also FreePascal/Lazarus version (ported from original version), 50 | which is maintained by independent developer. 51 | This version is currently in beta stage, some features are not yet implemented. 52 | Refer to LuiPack page. 53 | 54 | 55 | 56 | -------------------------------------------------------------------------------- /help_delphi/source/Table of Contents.hhc: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 |

75 | 76 | -------------------------------------------------------------------------------- /atbinhex/atbinhex_hexproc.pas: -------------------------------------------------------------------------------- 1 | unit atbinhex_hexproc; 2 | 3 | interface 4 | 5 | //Conversion from hex encoded string (e.g. '10 20 AA FF': 4 chars) to normal string. 6 | //Hex string must contain 2*N hex digits. Spaces are ignored. 7 | function SHexToNormal(const HexStr: string; var ResStr: string): Boolean; 8 | 9 | //Conversion of string to hex form, digits are separated with spaces. 10 | function SToHex(const S: AnsiString): AnsiString; 11 | 12 | //Conversion from hex to Integer. 13 | function HexToIntDef(const S: string; const Default: Int64): Int64; 14 | 15 | 16 | implementation 17 | 18 | uses 19 | SysUtils, atbinhex_strproc; 20 | 21 | function SHexDigitToInt(Hex: char; var Int: LongWord): Boolean; 22 | var 23 | ch: char; 24 | begin 25 | Result := True; 26 | Int := 0; 27 | ch := UpCase(Hex); 28 | case ch of 29 | '0'..'9': 30 | Int := Ord(ch) - Ord('0'); 31 | 'A'..'F': 32 | Int := Ord(ch) - Ord('A') + 10; 33 | else 34 | Result := False; 35 | end; 36 | end; 37 | 38 | 39 | function SHexWordToInt(const Hex: string; var Int: LongWord): Boolean; 40 | var 41 | Int1, Int2: LongWord; 42 | begin 43 | Result := False; 44 | if Length(Hex) = 1 then 45 | Result := SHexDigitToInt(Hex[1], Int) 46 | else 47 | if Length(Hex) = 2 then 48 | begin 49 | Result := 50 | SHexDigitToInt(Hex[1], Int1) and 51 | SHexDigitToInt(Hex[2], Int2); 52 | if Result then 53 | Int := Int1 * 16 + Int2; 54 | end; 55 | end; 56 | 57 | 58 | function SHexToNormal(const HexStr: string; var ResStr: string): Boolean; 59 | var 60 | S: string; 61 | Int: LongWord; 62 | i: Integer; 63 | begin 64 | ResStr := ''; 65 | Result := False; 66 | 67 | S := StringReplace(HexStr, ' ', '', [rfReplaceAll]); 68 | 69 | if (Length(S) mod 2) > 0 then Exit; 70 | 71 | for i := 1 to Length(S) div 2 do 72 | begin 73 | if not SHexWordToInt(S[2 * i - 1] + S[2 * i], Int) then Exit; 74 | ResStr := ResStr + Chr(Int); 75 | end; 76 | 77 | Result := True; 78 | end; 79 | 80 | 81 | function SToHex(const S: AnsiString): AnsiString; 82 | var 83 | i: Integer; 84 | begin 85 | Result := ''; 86 | 87 | for i := 1 to Length(S) do 88 | Result := Result + IntToHex(Ord(S[i]), 2) + ' '; 89 | 90 | if Result <> '' then 91 | Delete(Result, Length(Result), 1); 92 | end; 93 | 94 | 95 | function HexToIntDef(const S: string; const Default: Int64): Int64; 96 | var 97 | i: Integer; 98 | N: LongWord; 99 | begin 100 | Result := 0; 101 | for i := 1 to Length(S) do 102 | begin 103 | if not SHexDigitToInt(S[i], N) then 104 | begin Result := Default; Exit end; 105 | Result := Result * $10 + N; 106 | end; 107 | end; 108 | 109 | end. 110 | -------------------------------------------------------------------------------- /atbinhex/atbinhex_package.lpk: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | 70 | 71 | 72 | 73 | 74 | 75 | 76 | 77 | 78 | 79 | <_ExternHelp Items="Count"/> 80 | 81 | 82 | 83 | -------------------------------------------------------------------------------- /help_delphi/source/Usage Hints.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | Usage: Hints and FAQ 6 | 7 | 8 | 9 | 10 |

Hints and FAQ

11 |
12 | 13 |

14 | Q1: How can I load the contents of an AnsiString or WideString? 15 | 16 |

17 | A: You should do it using OpenStream method, giving it a TMemoryStream as 18 | a parameter. Sample procedures for AnsiString and WideString are shown 19 | below. Note that you should free stream only after calling 20 | Viewer.OpenStream(nil), otherwise control will try to read deallocated 21 | memory on scrolling! 22 | 23 |

24 |

25 | 69 |
70 | 71 |

72 |

73 | 74 |

75 | Q2: I have an issue with horizontal scrollbar. Even when text becomes 76 | short enough, scrollbar doesn't disappear... 77 | 78 |

79 | A: This is done as workaround for Windows XP bug: when scrollbar is about 80 | to disappear, this may cause both scrollbars and window border to disappear. 81 | You can disable this workaround by commenting the "HSCROLLBAR_WORKAROUND" 82 | define in ATBinHexOptions.inc. 83 | 84 |

85 | The RichEdit control doesn't have this problem because it precalculates widths for all strings 86 | and sets scrollbar size to the max value. 87 | We cannot do this in ATBinHex control, so the scrollbar size is calculated dinamically. 88 | 89 |

90 |

91 | 92 | 93 |

94 | Q3: After changing a property, it is not applied. 95 | 96 |

97 | A: Many properties require that after changing them, file should 98 | be reopened (using Open/Reload methods). 99 | 100 | 101 | 102 | 103 | -------------------------------------------------------------------------------- /atbinhex/atbinhex_msg.pas: -------------------------------------------------------------------------------- 1 | unit atbinhex_msg; 2 | 3 | interface 4 | 5 | function MsgBox(const Msg, Title: UnicodeString; Flags: Integer; hWnd: THandle = 0): Integer; 6 | procedure MsgInfo(const Msg: UnicodeString; hWnd: THandle = 0); 7 | procedure MsgError(const Msg: UnicodeString; hWnd: THandle = 0); 8 | procedure MsgWarning(const Msg: UnicodeString; hWnd: THandle = 0); 9 | 10 | var 11 | ATViewerMessagesEnabled: Boolean = True; 12 | 13 | var 14 | MsgViewerCaption: UnicodeString = 'Viewer'; 15 | MsgViewerShowCfm: UnicodeString = 'Format unknown'#13'Click here to show binary dump'; 16 | MsgViewerShowEmpty: UnicodeString = 'File is empty'; 17 | MsgViewerErrCannotFindFile: UnicodeString = 'File not found: "%s"'; 18 | MsgViewerErrCannotFindFolder: UnicodeString = 'Folder not found: "%s"'; 19 | MsgViewerErrCannotOpenFile: UnicodeString = 'Cannot open file: "%s"'; 20 | MsgViewerErrCannotLoadFile: UnicodeString = 'Cannot load file: "%s"'; 21 | MsgViewerErrCannotReadFile: UnicodeString = 'Cannot read file: "%s"'; 22 | MsgViewerErrCannotReadStream: UnicodeString = 'Cannot read stream'; 23 | MsgViewerErrCannotReadPos: UnicodeString = 'Read error at offset %s'; 24 | MsgViewerErrDetect: UnicodeString = 'Program could not detect file format'#13'Dump is shown'; 25 | MsgViewerErrImage: UnicodeString = 'Unknown image format'; 26 | MsgViewerErrMedia: UnicodeString = 'Unknown multimedia format'; 27 | MsgViewerErrOffice: UnicodeString = 'MS Office module doesn''t support this file type'; 28 | MsgViewerErrInitControl: UnicodeString = 'Cannot initialize %s'; 29 | MsgViewerErrInitOffice: UnicodeString = 'Cannot initialize MS Office control'; 30 | MsgViewerErrCannotCopyData: UnicodeString = 'Cannot copy data to Clipboard'; 31 | MsgViewerWlxException: UnicodeString = 'Exception in plugin "%s" in function "%s"'; 32 | MsgViewerWlxParentNotSpecified: UnicodeString = 'Cannot load plugins: parent form not specified'; 33 | MsgViewerAniTitle: UnicodeString = 'Title: '; 34 | MsgViewerAniCreator: UnicodeString = 'Creator: '; 35 | MsgViewerPageHint: UnicodeString = 'Previous/Next page'#13'Current page: %d of %d'; 36 | 37 | implementation 38 | 39 | uses 40 | SysUtils, Forms; 41 | 42 | const 43 | IDCANCEL = 2; 44 | MB_ICONASTERISK = $40; 45 | MB_ICONEXCLAMATION = $30; 46 | MB_ICONWARNING = $30; 47 | MB_ICONERROR = $10; 48 | MB_ICONHAND = $10; 49 | MB_ICONQUESTION = $20; 50 | MB_OK = 0; 51 | MB_ICONINFORMATION = $40; 52 | MB_ICONSTOP = $10; 53 | MB_OKCANCEL = $1; 54 | 55 | function MsgBox(const Msg, Title: UnicodeString; Flags: Integer; hWnd: THandle = 0): Integer; 56 | begin 57 | if ATViewerMessagesEnabled then 58 | Result := Application.MessageBox( 59 | PChar(UTF8Encode(Msg)), 60 | PChar(UTF8Encode(Title)), 61 | Flags) 62 | else 63 | Result := IDCANCEL; 64 | end; 65 | 66 | procedure MsgInfo(const Msg: UnicodeString; hWnd: THandle = 0); 67 | begin 68 | MsgBox(Msg, MsgViewerCaption, MB_OK or MB_ICONINFORMATION, hWnd); 69 | end; 70 | 71 | procedure MsgError(const Msg: UnicodeString; hWnd: THandle = 0); 72 | begin 73 | MsgBox(Msg, MsgViewerCaption, MB_OK or MB_ICONERROR, hWnd); 74 | end; 75 | 76 | procedure MsgWarning(const Msg: UnicodeString; hWnd: THandle = 0); 77 | begin 78 | MsgBox(Msg, MsgViewerCaption, MB_OK or MB_ICONEXCLAMATION, hWnd); 79 | end; 80 | 81 | end. 82 | -------------------------------------------------------------------------------- /atbinhex/atbinhex_encoding.pas: -------------------------------------------------------------------------------- 1 | unit atbinhex_encoding; 2 | 3 | interface 4 | 5 | uses 6 | {$ifdef windows} 7 | Windows, 8 | {$endif} 9 | SysUtils, Classes, Menus, 10 | EncConv; 11 | 12 | function SCodepageToUTF8(const AStr: string; AEnc: TEncConvId): string; 13 | function SCodepageFromUTF8(const AStr: string; AEnc: TEncConvId): string; 14 | 15 | type 16 | TAppEncodingRecord = record 17 | Sub: string; 18 | Name: string; 19 | Id: TEncConvId 20 | end; 21 | 22 | const 23 | AppEncodings: array[0..32] of TAppEncodingRecord = ( 24 | (Sub: 'u'; Name: 'UTF-8'; Id: eidUTF8), 25 | (Sub: 'eu'; Name: 'cp1250'; Id: eidCP1250), 26 | (Sub: 'eu'; Name: 'cp1251'; Id: eidCP1251), 27 | (Sub: 'eu'; Name: 'cp1252'; Id: eidCP1252), 28 | (Sub: 'eu'; Name: 'cp1253'; Id: eidCP1253), 29 | (Sub: 'eu'; Name: 'cp1257'; Id: eidCP1257), 30 | (Sub: 'eu'; Name: '-'; Id: eidUTF8), 31 | (Sub: 'eu'; Name: 'cp437'; Id: eidCP437), 32 | (Sub: 'eu'; Name: 'cp850'; Id: eidCP850), 33 | (Sub: 'eu'; Name: 'cp852'; Id: eidCP852), 34 | (Sub: 'eu'; Name: 'cp866'; Id: eidCP866), 35 | (Sub: 'eu'; Name: '-'; Id: eidUTF8), 36 | (Sub: 'eu'; Name: 'iso-8859-1'; Id: eidISO1), 37 | (Sub: 'eu'; Name: 'iso-8859-2'; Id: eidISO2), 38 | (Sub: 'eu'; Name: 'iso-8859-5'; Id: eidISO5), 39 | (Sub: 'eu'; Name: 'iso-8859-9'; Id: eidISO9), 40 | (Sub: 'eu'; Name: 'iso-8859-14'; Id: eidISO14), 41 | (Sub: 'eu'; Name: 'iso-8859-15'; Id: eidISO15), 42 | (Sub: 'eu'; Name: 'iso-8859-16'; Id: eidISO16), 43 | (Sub: 'eu'; Name: 'mac'; Id: eidCPMac), 44 | (Sub: 'mi'; Name: 'cp1254'; Id: eidCP1254), 45 | (Sub: 'mi'; Name: 'cp1255'; Id: eidCP1255), 46 | (Sub: 'mi'; Name: 'cp1256'; Id: eidCP1256), 47 | (Sub: 'mi'; Name: '-'; Id: eidUTF8), 48 | (Sub: 'mi'; Name: 'koi8r'; Id: eidKOI8R), 49 | (Sub: 'mi'; Name: 'koi8u'; Id: eidKOI8U), 50 | (Sub: 'mi'; Name: 'koi8ru'; Id: eidKOI8RU), 51 | (Sub: 'as'; Name: 'cp874'; Id: eidCP874), 52 | (Sub: 'as'; Name: 'cp932'; Id: eidCP932), 53 | (Sub: 'as'; Name: 'cp936'; Id: eidCP936), 54 | (Sub: 'as'; Name: 'cp949'; Id: eidCP949), 55 | (Sub: 'as'; Name: 'cp950'; Id: eidCP950), 56 | (Sub: 'as'; Name: 'cp1258'; Id: eidCP1258) 57 | ); 58 | 59 | 60 | implementation 61 | 62 | (* 63 | function SConvertAnsiToUtf8(const SA: string): string; 64 | begin 65 | {$ifdef windows} 66 | case Windows.GetACP of 67 | 1250: Result:= CP1250ToUTF8(SA); 68 | 1251: Result:= CP1251ToUTF8(SA); 69 | 1252: Result:= CP1252ToUTF8(SA); 70 | 1253: Result:= CP1253ToUTF8(SA); 71 | 1254: Result:= CP1254ToUTF8(SA); 72 | 1255: Result:= CP1255ToUTF8(SA); 73 | 1256: Result:= CP1256ToUTF8(SA); 74 | 1257: Result:= CP1257ToUTF8(SA); 75 | 1258: Result:= CP1258ToUTF8(SA); 76 | 437: Result:= CP437ToUTF8(SA); 77 | else Result:= CP1252ToUTF8(SA); 78 | end; 79 | {$else} 80 | Result:= CP1252ToUTF8(SA); 81 | {$endif} 82 | end; 83 | 84 | function SConvertUtf8ToAnsi(const SA: string): string; 85 | begin 86 | {$ifdef windows} 87 | case Windows.GetACP of 88 | 1250: Result:= UTF8ToCP1250(SA); 89 | 1251: Result:= UTF8ToCP1251(SA); 90 | 1252: Result:= UTF8ToCP1252(SA); 91 | 1253: Result:= UTF8ToCP1253(SA); 92 | 1254: Result:= UTF8ToCP1254(SA); 93 | 1255: Result:= UTF8ToCP1255(SA); 94 | 1256: Result:= UTF8ToCP1256(SA); 95 | 1257: Result:= UTF8ToCP1257(SA); 96 | 1258: Result:= UTF8ToCP1258(SA); 97 | 437: Result:= UTF8ToCP437(SA); 98 | else Result:= UTF8ToCP1252(SA); 99 | end; 100 | {$else} 101 | Result:= UTF8ToCP1252(SA); 102 | {$endif} 103 | end; 104 | *) 105 | 106 | function SCodepageToUTF8(const AStr: string; AEnc: TEncConvId): string; 107 | begin 108 | Result:= EncConvertToUTF8(AStr, AEnc); 109 | end; 110 | 111 | function SCodepageFromUTF8(const AStr: string; AEnc: TEncConvId): string; 112 | begin 113 | Result:= EncConvertFromUTF8(AStr, AEnc); 114 | end; 115 | 116 | end. 117 | 118 | -------------------------------------------------------------------------------- /help_delphi/source/Usage Events.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | Usage: Events 6 | 7 | 8 | 9 | 10 |

Events

11 |
12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 34 | 35 | 36 | 37 | 38 | 52 | 53 | 54 | 55 | 56 | 79 | 80 | 81 | 82 | 83 | 107 | 108 | 109 | 110 | 111 | 118 | 119 | 120 | 121 | 122 |
OnFileReloadFired after file auto-reload complete (when AutoReload = True).
OnSelectionChangeFired on text selection change.
OnOptionsChangeFired after an option has been changed by user.
28 | Examples of such changable options: 29 |
    30 |
  • Text encoding can be changed using right-click menu. 31 |
  • Font size can be changed using Ctrl + Mouse wheel. 32 |
33 |
OnSearchProgressFired on text search progress.
39 | It is of type: 40 | 
 41 |   TATStreamSearchProgress = procedure(
 42 |     const ACurrentPos, AMaximalPos: Int64;
 43 |     var AContinueSearching: Boolean) of object;
44 | Parameters: 45 |
    46 |
  • ACurrentPos: Current search position. 47 |
  • AMaximalPos: Maximal search position. 48 |
  • AContinueSearching: Initially set to True. 49 | If changed to False then search will be stopped. 50 |
51 |
OnDrawLineFired before a line is to be drawn in variable length modes (Text, Unicode).
57 | You can use it to color the entire line or to disable line drawing.
58 | It is of type: 59 | 
 60 |   TATBinHexDrawLine = procedure(
 61 |     ASender: TObject;
 62 |     ACanvas: TCanvas;
 63 |     const AStr, AStrAll: WideString;
 64 |     const ARect: TRect;
 65 |     const ATextPnt: TPoint;
 66 |     var ADone: Boolean) of object;
67 | Parameters:
68 |
    69 |
  • ASender: Sender ATBinHex object. 70 |
  • ACanvas: Canvas which parameters you can change. 71 | It is allowed to change ACanvas.Font.Color and ACanvas.Brush.Color only. 72 |
  • AStr: String part (counting word wrap) which is to be drawn. 73 |
  • AStrAll: String (entire, w/o counting word wrap). 74 |
  • ARect: Rectangle in which string is to be drawn. 75 |
  • ATextPnt: Point after gutter. 76 |
  • ADone: Initially False; if set to True, string will not be drawn. 77 |
78 |
OnDrawLine2Fired after a line has been drawn in variable length modes (Text, Unicode).
84 | You can use it to color some parts of the line.
85 | It is of type: 86 | 
 87 |   TATBinHexDrawLine2 = procedure(
 88 |     ASender: TObject;
 89 |     ACanvas: TCanvas;
 90 |     const AStr: WideString;
 91 |     const APnt: TPoint;
 92 |     const AOptions: TATBinHexOutputOptions) of object;
93 | Parameters:
94 |
    95 |
  • ASender: Sender object. 96 |
  • ACanvas: Canvas object. You should not change canvas parameters. 97 |
  • AStr: String which has been drawn. 98 |
  • APnt: Canvas point at which string has been drawn. 99 |
  • AOptions: Helper options record. See ATBinHex.pas for details. 100 |
101 | Note: 102 |
    103 |
  • To color some part of the line, you should get string extent first. 104 | Use the StringExtent function from ATBinHex.pas for this. 105 |
106 |
OnClickURLFired on URL/mail clicking, when URL highlighting is enabled.
112 | It is of type: 113 | 
114 |   TATBinHexClickURL = procedure(
115 |     ASender: TObject;
116 |     const AString: AnsiString) of object;
117 |
123 | 124 | 125 | 126 | -------------------------------------------------------------------------------- /atbinhex/atbinhex_canvasproc.pas: -------------------------------------------------------------------------------- 1 | {***********************************} 2 | { } 3 | { ATBinHex Component } 4 | { Copyright (C) Alexey Torgashin } 5 | { http://uvviewsoft.com } 6 | { } 7 | {***********************************} 8 | unit ATBinHex_CanvasProc; 9 | 10 | {$mode delphi} 11 | 12 | interface 13 | 14 | uses 15 | Classes, SysUtils, Graphics, Types, 16 | atbinhex_stringproc; 17 | 18 | procedure CanvasTextOut(C: TCanvas; PosX, PosY: integer; const S: UnicodeString); 19 | function CanvasTextWidth(C: TCanvas; const S: atString): integer; 20 | procedure CanvasInvertRect(C: TCanvas; const R: TRect; AColor: TColor); 21 | 22 | 23 | implementation 24 | 25 | uses 26 | {$ifdef windows} 27 | Windows, 28 | {$endif} 29 | LCLIntf; 30 | 31 | function CanvasTextWidth(C: TCanvas; const S: atString): integer; 32 | var 33 | List: array of integer; 34 | begin 35 | Result:= 0; 36 | if S='' then Exit; 37 | SetLength(List, Length(S)); 38 | SCalcCharOffsets(C, S, List); 39 | Result:= List[High(List)]; 40 | end; 41 | 42 | function StringNeedsDxOffsets(const S: UnicodeString): boolean; 43 | var 44 | i: integer; 45 | begin 46 | //we need ExtTextOut offsets for Qt and Cocoa: char widths are float numbers there 47 | {$if defined(LCLQt5) or defined(LCLQt6) or defined(LCLCocoa)} 48 | exit(true); 49 | {$endif} 50 | 51 | for i:= 1 to Length(S) do 52 | if Ord(S[i])>$FF then 53 | exit(true); 54 | Result:= false; 55 | end; 56 | 57 | {$ifdef windows} 58 | procedure CanvasTextOut(C: TCanvas; PosX, PosY: integer; const S: UnicodeString); 59 | begin 60 | Windows.ExtTextOutW(C.Handle, PosX, PosY, 0, nil, PWideChar(S), Length(S), nil); 61 | end; 62 | {$else} 63 | procedure CanvasTextOut(C: TCanvas; PosX, PosY: integer; const S: UnicodeString); 64 | var 65 | ListInt: array of Longint; 66 | Dx: array of Longint; 67 | DxPtr: pointer; 68 | Buf: string; 69 | i: integer; 70 | begin 71 | if S='' then Exit; 72 | 73 | if not StringNeedsDxOffsets(S) then 74 | DxPtr:= nil 75 | else 76 | begin 77 | SetLength(ListInt, Length(S)); 78 | SetLength(Dx, Length(S)); 79 | 80 | SCalcCharOffsets(C, S, ListInt); 81 | 82 | for i:= 0 to High(ListInt) do 83 | if i=0 then 84 | Dx[i]:= ListInt[i] 85 | else 86 | Dx[i]:= ListInt[i]-ListInt[i-1]; 87 | 88 | DxPtr:= @Dx[0]; 89 | end; 90 | 91 | Buf:= UTF8Encode(S); 92 | ExtTextOut(C.Handle, PosX, PosY, 0, nil, PChar(Buf), Length(Buf), DxPtr); 93 | end; 94 | {$endif} 95 | 96 | (* 97 | var 98 | _bmp: Graphics.TBitmap = nil; 99 | const 100 | cInvertMaxX = 40; 101 | cInvertMaxY = 80; 102 | 103 | procedure CanvasInvertRect_Universal(C: TCanvas; const R: TRect); 104 | var 105 | sizeX, sizeY: integer; 106 | i, j: integer; 107 | Rbmp: TRect; 108 | begin 109 | if not Assigned(_bmp) then 110 | begin 111 | _bmp:= Graphics.TBitmap.Create; 112 | _bmp.PixelFormat:= pf24bit; 113 | _bmp.SetSize(cInvertMaxX, cInvertMaxY); 114 | end; 115 | 116 | sizeX:= R.Right-R.Left; 117 | sizeY:= R.Bottom-R.Top; 118 | Rbmp:= Classes.Rect(0, 0, sizeX, sizeY); 119 | 120 | _bmp.Canvas.CopyRect(Rbmp, C, R); 121 | 122 | for j:= 0 to sizeY-1 do 123 | for i:= 0 to sizeX-1 do 124 | with _bmp.Canvas do 125 | Pixels[i, j]:= Pixels[i, j] xor $FFFFFF; 126 | 127 | C.CopyRect(R, _bmp.Canvas, Rbmp); 128 | end; 129 | *) 130 | 131 | {$ifdef windows} 132 | procedure CanvasInvertRect(C: TCanvas; const R: TRect; AColor: TColor); 133 | begin 134 | Windows.InvertRect(C.Handle, R); 135 | end; 136 | {$else} 137 | 138 | var 139 | _Pen: TPen = nil; 140 | 141 | procedure CanvasInvertRect(C: TCanvas; const R: TRect; AColor: TColor); 142 | var 143 | X: integer; 144 | AM: TAntialiasingMode; 145 | begin 146 | if not Assigned(_Pen) then 147 | _Pen:= TPen.Create; 148 | 149 | AM:= C.AntialiasingMode; 150 | _Pen.Assign(C.Pen); 151 | 152 | X:= (R.Left+R.Right) div 2; 153 | C.Pen.Mode:= pmNotXor; 154 | C.Pen.Style:= psSolid; 155 | C.Pen.Color:= AColor; 156 | C.AntialiasingMode:= amOff; 157 | C.Pen.EndCap:= pecFlat; 158 | C.Pen.Width:= R.Right-R.Left; 159 | 160 | C.MoveTo(X, R.Top); 161 | C.LineTo(X, R.Bottom); 162 | 163 | C.Pen.Assign(_Pen); 164 | C.AntialiasingMode:= AM; 165 | C.Rectangle(0, 0, 0, 0); //apply pen 166 | end; 167 | 168 | finalization 169 | if Assigned(_Pen) then 170 | FreeAndNil(_Pen); 171 | 172 | {$endif} 173 | 174 | end. 175 | 176 | -------------------------------------------------------------------------------- /demo_main/demo.lpi: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | <ResourceType Value="res"/> 13 | <UseXPManifest Value="True"/> 14 | </General> 15 | <i18n> 16 | <EnableI18N LFM="False"/> 17 | </i18n> 18 | <BuildModes Count="2"> 19 | <Item1 Name="Default" Default="True"/> 20 | <Item2 Name="gtk3"> 21 | <MacroValues Count="1"> 22 | <Macro1 Name="LCLWidgetType" Value="gtk3"/> 23 | </MacroValues> 24 | <CompilerOptions> 25 | <Version Value="11"/> 26 | <PathDelim Value="\"/> 27 | <Target> 28 | <Filename Value="demo"/> 29 | </Target> 30 | <SearchPaths> 31 | <IncludeFiles Value="$(ProjOutDir)"/> 32 | <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> 33 | </SearchPaths> 34 | <Parsing> 35 | <SyntaxOptions> 36 | <IncludeAssertionCode Value="True"/> 37 | </SyntaxOptions> 38 | </Parsing> 39 | <CodeGeneration> 40 | <Checks> 41 | <RangeChecks Value="True"/> 42 | <OverflowChecks Value="True"/> 43 | <StackChecks Value="True"/> 44 | </Checks> 45 | </CodeGeneration> 46 | <Linking> 47 | <Debugging> 48 | <DebugInfoType Value="dsDwarf3"/> 49 | <UseExternalDbgSyms Value="True"/> 50 | </Debugging> 51 | <Options> 52 | <Win32> 53 | <GraphicApplication Value="True"/> 54 | </Win32> 55 | </Options> 56 | </Linking> 57 | </CompilerOptions> 58 | </Item2> 59 | <SharedMatrixOptions Count="1"> 60 | <Item1 ID="109721410405" Modes="gtk3" Type="IDEMacro" MacroName="LCLWidgetType" Value="gtk3"/> 61 | </SharedMatrixOptions> 62 | </BuildModes> 63 | <PublishOptions> 64 | <Version Value="2"/> 65 | </PublishOptions> 66 | <RunParams> 67 | <FormatVersion Value="2"/> 68 | <Modes Count="1"> 69 | <Mode0 Name="default"/> 70 | </Modes> 71 | </RunParams> 72 | <RequiredPackages Count="3"> 73 | <Item1> 74 | <PackageName Value="encconv_package"/> 75 | </Item1> 76 | <Item2> 77 | <PackageName Value="atbinhex_package"/> 78 | </Item2> 79 | <Item3> 80 | <PackageName Value="LCL"/> 81 | </Item3> 82 | </RequiredPackages> 83 | <Units Count="2"> 84 | <Unit0> 85 | <Filename Value="demo.lpr"/> 86 | <IsPartOfProject Value="True"/> 87 | </Unit0> 88 | <Unit1> 89 | <Filename Value="formmain.pas"/> 90 | <IsPartOfProject Value="True"/> 91 | <ComponentName Value="fmMain"/> 92 | <HasResources Value="True"/> 93 | <ResourceBaseClass Value="Form"/> 94 | </Unit1> 95 | </Units> 96 | </ProjectOptions> 97 | <CompilerOptions> 98 | <Version Value="11"/> 99 | <PathDelim Value="\"/> 100 | <Target> 101 | <Filename Value="demo"/> 102 | </Target> 103 | <SearchPaths> 104 | <IncludeFiles Value="$(ProjOutDir)"/> 105 | <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> 106 | </SearchPaths> 107 | <Parsing> 108 | <SyntaxOptions> 109 | <IncludeAssertionCode Value="True"/> 110 | </SyntaxOptions> 111 | </Parsing> 112 | <CodeGeneration> 113 | <Checks> 114 | <RangeChecks Value="True"/> 115 | <OverflowChecks Value="True"/> 116 | <StackChecks Value="True"/> 117 | </Checks> 118 | </CodeGeneration> 119 | <Linking> 120 | <Debugging> 121 | <DebugInfoType Value="dsDwarf3"/> 122 | <UseExternalDbgSyms Value="True"/> 123 | </Debugging> 124 | <Options> 125 | <Win32> 126 | <GraphicApplication Value="True"/> 127 | </Win32> 128 | </Options> 129 | </Linking> 130 | </CompilerOptions> 131 | <Debugging> 132 | <Exceptions Count="3"> 133 | <Item1> 134 | <Name Value="EAbort"/> 135 | </Item1> 136 | <Item2> 137 | <Name Value="ECodetoolError"/> 138 | </Item2> 139 | <Item3> 140 | <Name Value="EFOpenError"/> 141 | </Item3> 142 | </Exceptions> 143 | </Debugging> 144 | </CONFIG> 145 | -------------------------------------------------------------------------------- /demo_main/formmain.lfm: -------------------------------------------------------------------------------- 1 | object fmMain: TfmMain 2 | Left = 326 3 | Height = 533 4 | Top = 178 5 | Width = 902 6 | Caption = 'ATBinHex demo' 7 | ClientHeight = 533 8 | ClientWidth = 902 9 | Position = poScreenCenter 10 | LCLVersion = '4.99.0.0' 11 | OnCreate = FormCreate 12 | object PanelOpt: TPanel 13 | Left = 708 14 | Height = 514 15 | Top = 0 16 | Width = 194 17 | Align = alRight 18 | ClientHeight = 514 19 | ClientWidth = 194 20 | TabOrder = 0 21 | object btnOpen: TButton 22 | Left = 7 23 | Height = 25 24 | Top = 11 25 | Width = 89 26 | Caption = 'open...' 27 | TabOrder = 0 28 | OnClick = btnOpenClick 29 | end 30 | object GroupBox1: TGroupBox 31 | Left = 7 32 | Height = 144 33 | Top = 100 34 | Width = 149 35 | Caption = 'mode' 36 | ClientHeight = 126 37 | ClientWidth = 147 38 | TabOrder = 5 39 | object bText: TRadioButton 40 | Left = 7 41 | Height = 23 42 | Top = 0 43 | Width = 53 44 | Caption = 'text' 45 | Checked = True 46 | TabOrder = 0 47 | TabStop = True 48 | OnChange = bTextChange 49 | end 50 | object bBin: TRadioButton 51 | Left = 7 52 | Height = 23 53 | Top = 24 54 | Width = 68 55 | Caption = 'binary' 56 | TabOrder = 1 57 | OnChange = bBinChange 58 | end 59 | object bHex: TRadioButton 60 | Left = 7 61 | Height = 23 62 | Top = 48 63 | Width = 49 64 | Caption = 'hex' 65 | TabOrder = 2 66 | OnChange = bHexChange 67 | end 68 | object bUni: TRadioButton 69 | Left = 7 70 | Height = 23 71 | Top = 72 72 | Width = 79 73 | Caption = 'unicode' 74 | TabOrder = 3 75 | OnChange = bUniChange 76 | end 77 | object bUniHex: TRadioButton 78 | Left = 7 79 | Height = 23 80 | Top = 96 81 | Width = 108 82 | Caption = 'unicode/hex' 83 | TabOrder = 4 84 | OnChange = bUniHexChange 85 | end 86 | end 87 | object btnFont: TButton 88 | Left = 7 89 | Height = 25 90 | Top = 40 91 | Width = 89 92 | Caption = 'font...' 93 | TabOrder = 1 94 | OnClick = btnFontClick 95 | end 96 | object edBin: TSpinEdit 97 | Left = 10 98 | Height = 34 99 | Top = 248 100 | Width = 59 101 | MaxValue = 160 102 | MinValue = 40 103 | TabOrder = 6 104 | Value = 80 105 | OnChange = edBinChange 106 | end 107 | object Label1: TLabel 108 | Left = 80 109 | Height = 17 110 | Top = 252 111 | Width = 83 112 | Caption = 'binary width' 113 | ParentColor = False 114 | end 115 | object chkUnpr: TCheckBox 116 | Left = 7 117 | Height = 23 118 | Top = 360 119 | Width = 131 120 | Caption = 'unprinted chars' 121 | TabOrder = 10 122 | OnChange = chkUnprChange 123 | end 124 | object chkGutter: TCheckBox 125 | Left = 7 126 | Height = 23 127 | Top = 336 128 | Width = 68 129 | Caption = 'gutter' 130 | Checked = True 131 | State = cbChecked 132 | TabOrder = 9 133 | OnChange = chkGutterChange 134 | end 135 | object chkWrap: TCheckBox 136 | Left = 7 137 | Height = 23 138 | Top = 312 139 | Width = 60 140 | Caption = 'wrap' 141 | TabOrder = 8 142 | OnChange = chkWrapChange 143 | end 144 | object chkEn: TCheckBox 145 | Left = 7 146 | Height = 23 147 | Top = 384 148 | Width = 80 149 | Caption = 'enabled' 150 | Checked = True 151 | State = cbChecked 152 | TabOrder = 11 153 | OnChange = chkEnChange 154 | end 155 | object btnGoto: TButton 156 | Left = 104 157 | Height = 25 158 | Top = 11 159 | Width = 83 160 | Caption = 'go to...' 161 | TabOrder = 2 162 | OnClick = btnGotoClick 163 | end 164 | object chkEnSel: TCheckBox 165 | Left = 7 166 | Height = 23 167 | Top = 408 168 | Width = 102 169 | Caption = 'enabled sel' 170 | Checked = True 171 | State = cbChecked 172 | TabOrder = 12 173 | OnChange = chkEnSelChange 174 | end 175 | object edTabsize: TSpinEdit 176 | Left = 10 177 | Height = 34 178 | Top = 275 179 | Width = 59 180 | MaxValue = 12 181 | MinValue = 2 182 | TabOrder = 7 183 | Value = 8 184 | OnChange = edTabsizeChange 185 | end 186 | object Label2: TLabel 187 | Left = 79 188 | Height = 17 189 | Top = 280 190 | Width = 52 191 | Caption = 'tab size' 192 | ParentColor = False 193 | end 194 | object btnFind: TButton 195 | Left = 104 196 | Height = 25 197 | Top = 40 198 | Width = 83 199 | Caption = 'find...' 200 | TabOrder = 3 201 | OnClick = btnFindClick 202 | end 203 | object btnFindNext: TButton 204 | Left = 104 205 | Height = 25 206 | Top = 70 207 | Width = 83 208 | Caption = 'find next' 209 | Enabled = False 210 | TabOrder = 4 211 | OnClick = btnFindNextClick 212 | end 213 | object chkUTF8: TCheckBox 214 | Left = 7 215 | Height = 23 216 | Top = 432 217 | Width = 124 218 | Caption = 'UTF8 encoding' 219 | TabOrder = 13 220 | OnChange = chkUTF8Change 221 | end 222 | end 223 | object StatusBar1: TStatusBar 224 | Left = 0 225 | Height = 19 226 | Top = 514 227 | Width = 902 228 | Panels = < 229 | item 230 | Alignment = taCenter 231 | Text = 'pos' 232 | Width = 200 233 | end 234 | item 235 | Alignment = taCenter 236 | Text = 'encoding' 237 | Width = 200 238 | end 239 | item 240 | Width = 50 241 | end> 242 | SimplePanel = False 243 | end 244 | object OpenDialog1: TOpenDialog 245 | Left = 480 246 | Top = 16 247 | end 248 | object FontDialog1: TFontDialog 249 | MinFontSize = 0 250 | MaxFontSize = 0 251 | Left = 472 252 | Top = 64 253 | end 254 | end 255 | -------------------------------------------------------------------------------- /demo_main/formmain.pas: -------------------------------------------------------------------------------- 1 | unit formmain; 2 | 3 | {$mode objfpc}{$H+} 4 | 5 | interface 6 | 7 | uses 8 | Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls, 9 | StdCtrls, Spin, ComCtrls, 10 | EncConv, 11 | ATBinHex, 12 | ATStreamSearch, 13 | math; 14 | 15 | type 16 | { TfmMain } 17 | 18 | TfmMain = class(TForm) 19 | btnOpen: TButton; 20 | btnFont: TButton; 21 | btnGoto: TButton; 22 | btnFind: TButton; 23 | btnFindNext: TButton; 24 | chkUTF8: TCheckBox; 25 | chkEnSel: TCheckBox; 26 | chkEn: TCheckBox; 27 | chkWrap: TCheckBox; 28 | chkUnpr: TCheckBox; 29 | chkGutter: TCheckBox; 30 | FontDialog1: TFontDialog; 31 | GroupBox1: TGroupBox; 32 | Label1: TLabel; 33 | Label2: TLabel; 34 | OpenDialog1: TOpenDialog; 35 | PanelOpt: TPanel; 36 | bText: TRadioButton; 37 | bBin: TRadioButton; 38 | bHex: TRadioButton; 39 | bUni: TRadioButton; 40 | bUniHex: TRadioButton; 41 | edBin: TSpinEdit; 42 | edTabsize: TSpinEdit; 43 | StatusBar1: TStatusBar; 44 | procedure btnFindClick(Sender: TObject); 45 | procedure btnFindNextClick(Sender: TObject); 46 | procedure btnGotoClick(Sender: TObject); 47 | procedure btnOpenClick(Sender: TObject); 48 | procedure bUniChange(Sender: TObject); 49 | procedure bUniHexChange(Sender: TObject); 50 | procedure btnFontClick(Sender: TObject); 51 | procedure chkEnChange(Sender: TObject); 52 | procedure chkEnSelChange(Sender: TObject); 53 | procedure chkGutterChange(Sender: TObject); 54 | procedure chkUnprChange(Sender: TObject); 55 | procedure chkUTF8Change(Sender: TObject); 56 | procedure chkWrapChange(Sender: TObject); 57 | procedure edBinChange(Sender: TObject); 58 | procedure edTabsizeChange(Sender: TObject); 59 | procedure FormCreate(Sender: TObject); 60 | procedure bTextChange(Sender: TObject); 61 | procedure bBinChange(Sender: TObject); 62 | procedure bHexChange(Sender: TObject); 63 | private 64 | { private declarations } 65 | FPrevSearchText: string; 66 | procedure OpenFile(const Filename: string); 67 | procedure ViewerOptionsChange(Sender: TObject); 68 | procedure ViewerScroll(Sender: TObject); 69 | public 70 | { public declarations } 71 | FViewer: TATBinHex; 72 | FFileStream: TFileStream; 73 | FSearch: TATStreamSearch; 74 | end; 75 | 76 | var 77 | fmMain: TfmMain; 78 | 79 | implementation 80 | 81 | {$R *.lfm} 82 | 83 | { TfmMain } 84 | 85 | procedure TfmMain.FormCreate(Sender: TObject); 86 | var 87 | fn: string; 88 | begin 89 | FFileStream:= nil; 90 | 91 | FViewer:= TATBinHex.Create(Self); 92 | FViewer.Parent:= Self; 93 | FViewer.Align:= alClient; 94 | FViewer.Font.Size:= 10; 95 | FViewer.OnScroll:=@ViewerScroll; 96 | FViewer.OnOptionsChange:=@ViewerOptionsChange; 97 | 98 | FViewer.TextGutter:= true; 99 | FViewer.TextGutterLinesStep:= 10; 100 | 101 | fn:= ExtractFilePath(Application.ExeName)+'formmain.pas'; 102 | if FileExists(fn) then 103 | OpenFile(fn); 104 | 105 | FSearch:= TATStreamSearch.Create(Self); 106 | end; 107 | 108 | procedure TfmMain.bTextChange(Sender: TObject); 109 | begin 110 | FViewer.Mode:= vbmodeText; 111 | end; 112 | 113 | procedure TfmMain.bBinChange(Sender: TObject); 114 | begin 115 | FViewer.Mode:= vbmodeBinary; 116 | end; 117 | 118 | procedure TfmMain.bHexChange(Sender: TObject); 119 | begin 120 | FViewer.Mode:= vbmodeHex; 121 | end; 122 | 123 | procedure TfmMain.btnOpenClick(Sender: TObject); 124 | begin 125 | with OpenDialog1 do 126 | if Execute then 127 | OpenFile(Filename); 128 | end; 129 | 130 | procedure TfmMain.btnGotoClick(Sender: TObject); 131 | var 132 | S: string; 133 | N: Int64; 134 | begin 135 | S:= InputBox('Go to', 'Hex offset:', '0'); 136 | if S='' then Exit; 137 | N:= StrToInt64Def('$'+S, -1); 138 | if N<0 then exit; 139 | if N>FFileStream.Size-10 then 140 | begin 141 | ShowMessage('Too big pos, max is '+IntToStr(FFileStream.Size)); 142 | Exit 143 | end; 144 | FViewer.PosAt(N); 145 | end; 146 | 147 | procedure TfmMain.btnFindClick(Sender: TObject); 148 | var 149 | S: string; 150 | NCharSize: integer; 151 | begin 152 | S:= InputBox('Find', 'String:', ''); 153 | if S='' then exit; 154 | 155 | if FViewer.Mode in [vbmodeUnicode, vbmodeUHex] then 156 | NCharSize:= 2 157 | else 158 | NCharSize:= 1; 159 | 160 | FPrevSearchText:= S; 161 | 162 | FSearch.Stream:= FFileStream; 163 | if not FSearch.Find(S, 0, FFileStream.Size, FViewer.TextEncoding, NCharSize, []) then 164 | ShowMessage('Not found') 165 | else 166 | FViewer.SetSelection(FSearch.FoundStart, FSearch.FoundLength, true); 167 | 168 | btnFindNext.Enabled:= true; 169 | end; 170 | 171 | procedure TfmMain.btnFindNextClick(Sender: TObject); 172 | var 173 | NCharSize: integer; 174 | begin 175 | if FPrevSearchText='' then 176 | begin 177 | ShowMessage('Use "Find first" before "Find next"'); 178 | exit; 179 | end; 180 | 181 | if FViewer.Mode in [vbmodeUnicode, vbmodeUHex] then 182 | NCharSize:= 2 183 | else 184 | NCharSize:= 1; 185 | 186 | FSearch.Stream:= FFileStream; 187 | if not FSearch.Find(FPrevSearchText, FSearch.FoundStart+NCharSize, FFileStream.Size, FViewer.TextEncoding, NCharSize, []) then 188 | ShowMessage('Not found') 189 | else 190 | FViewer.SetSelection(FSearch.FoundStart, FSearch.FoundLength, true); 191 | end; 192 | 193 | procedure TfmMain.OpenFile(const Filename: string); 194 | begin 195 | if Assigned(FFileStream) then 196 | begin 197 | FViewer.OpenStream(nil); 198 | FreeAndNil(FFileStream); 199 | end; 200 | 201 | FFileStream:= TFileStream.Create(Filename, fmOpenRead or fmShareDenyNone); 202 | FViewer.OpenStream(FFileStream); 203 | end; 204 | 205 | procedure TfmMain.ViewerOptionsChange(Sender: TObject); 206 | begin 207 | StatusBar1.Panels[1].Text:= cEncConvNames[FViewer.TextEncoding]; 208 | end; 209 | 210 | procedure TfmMain.ViewerScroll(Sender: TObject); 211 | begin 212 | StatusBar1.Panels[0].Text:= IntToStr(FViewer.PosPercent)+'%'; 213 | end; 214 | 215 | procedure TfmMain.bUniChange(Sender: TObject); 216 | begin 217 | FViewer.Mode:= vbmodeUnicode; 218 | end; 219 | 220 | procedure TfmMain.bUniHexChange(Sender: TObject); 221 | begin 222 | FViewer.Mode:= vbmodeUHex; 223 | end; 224 | 225 | procedure TfmMain.btnFontClick(Sender: TObject); 226 | begin 227 | if FontDialog1.Execute then 228 | begin 229 | FViewer.Font:= FontDialog1.Font; 230 | FViewer.Invalidate; 231 | end; 232 | end; 233 | 234 | procedure TfmMain.chkEnChange(Sender: TObject); 235 | begin 236 | FViewer.Enabled:= chkEn.Checked; 237 | FViewer.Invalidate; 238 | end; 239 | 240 | procedure TfmMain.chkEnSelChange(Sender: TObject); 241 | begin 242 | FViewer.TextEnableSel:= chkEnSel.Checked; 243 | end; 244 | 245 | procedure TfmMain.chkGutterChange(Sender: TObject); 246 | begin 247 | FViewer.TextGutter:= chkGutter.Checked; 248 | FViewer.Invalidate; 249 | end; 250 | 251 | procedure TfmMain.chkUnprChange(Sender: TObject); 252 | begin 253 | FViewer.TextNonPrintable:= chkUnpr.Checked; 254 | end; 255 | 256 | procedure TfmMain.chkUTF8Change(Sender: TObject); 257 | begin 258 | if chkUTF8.Checked then 259 | FViewer.TextEncoding:= eidUTF8 260 | else 261 | FViewer.TextEncoding:= eidCP1252; 262 | end; 263 | 264 | procedure TfmMain.chkWrapChange(Sender: TObject); 265 | begin 266 | FViewer.TextWrap:= chkWrap.Checked; 267 | end; 268 | 269 | procedure TfmMain.edBinChange(Sender: TObject); 270 | begin 271 | FViewer.TextWidth:= edBin.Value; 272 | FViewer.Invalidate; 273 | end; 274 | 275 | procedure TfmMain.edTabsizeChange(Sender: TObject); 276 | begin 277 | FViewer.TextTabSize:= edTabsize.Value; 278 | FViewer.Invalidate; 279 | end; 280 | 281 | end. 282 | 283 | -------------------------------------------------------------------------------- /atbinhex/atbinhex_stringproc.pas: -------------------------------------------------------------------------------- 1 | {***********************************} 2 | { } 3 | { ATBinHex Component } 4 | { Copyright (C) Alexey Torgashin } 5 | { http://uvviewsoft.com } 6 | { } 7 | {***********************************} 8 | unit ATBinHex_StringProc; 9 | 10 | {$mode delphi} 11 | 12 | interface 13 | 14 | uses 15 | Classes, SysUtils, Graphics; 16 | 17 | type 18 | atString = UnicodeString; 19 | atChar = WideChar; 20 | 21 | const 22 | cMaxTabPositionToExpand = 1024; 23 | cCharScaleFullwidth = 180; //width of CJK chars 24 | 25 | function IsWordChar(ch: atChar): boolean; 26 | function IsEolCode(N: Word): boolean; 27 | function IsAccentChar(ch: WideChar): boolean; 28 | function IsCharCJKText(ch: widechar): boolean; inline; 29 | function IsCharCJKPunctuation(ch: widechar): boolean; inline; 30 | 31 | function BoolToPlusMinusOne(b: boolean): integer; 32 | 33 | function SSwapEndian(const S: UnicodeString): UnicodeString; 34 | function SGetIndentInChars(const S: atString): integer; 35 | function SGetIndentSize(const S: atString; ATabSize: integer): integer; 36 | 37 | procedure SCalcCharOffsets(C: TCanvas; const S: atString; var AList: array of integer); 38 | function SExpandTabulations(const S: atString; ATabSize: integer): atString; 39 | function SFindClickedPosition(C: TCanvas; 40 | const Str: atString; 41 | APixelsFromLeft, ACharSize, ATabSize: integer; 42 | AAllowVirtualPos: boolean): integer; 43 | 44 | 45 | implementation 46 | 47 | uses 48 | Dialogs, Math; 49 | 50 | function IsEolCode(N: Word): boolean; 51 | begin 52 | Result:= (N=10) or (N=13); 53 | end; 54 | 55 | function IsWordChar(ch: atChar): boolean; 56 | begin 57 | Result:= 58 | ((ch>='0') and (ch<='9')) or 59 | ((ch>='a') and (ch<='z')) or 60 | ((ch>='A') and (ch<='Z')) or 61 | (ch='_'); 62 | end; 63 | 64 | function IsSpaceChar(ch: atChar): boolean; 65 | begin 66 | Result:= (ch=' ') or (ch=#9); 67 | end; 68 | 69 | procedure DoDebugOffsets(const List: array of integer); 70 | var 71 | i: integer; 72 | s: string; 73 | begin 74 | s:= ''; 75 | for i:= Low(List) to High(List) do 76 | s:= s+IntToStr(List[i])+' '; 77 | ShowMessage('Offsets'#10+s); 78 | end; 79 | 80 | function SGetIndentInChars(const S: atString): integer; 81 | begin 82 | Result:= 0; 83 | while (Result<Length(S)) and IsSpaceChar(S[Result+1]) do 84 | Inc(Result); 85 | end; 86 | 87 | function SGetIndentSize(const S: atString; ATabSize: integer): integer; 88 | var 89 | SIndent: atString; 90 | begin 91 | SIndent:= Copy(S, 1, SGetIndentInChars(S)); 92 | Result:= Length(SExpandTabulations(SIndent, ATabSize)); 93 | end; 94 | 95 | function SSwapEndian(const S: UnicodeString): UnicodeString; 96 | var 97 | i: integer; 98 | begin 99 | Result:= S; 100 | for i:= 1 to Length(Result) do 101 | Result[i]:= WideChar(SwapEndian(Ord(Result[i]))); 102 | end; 103 | 104 | function SCalcTabulationSize(const ATabSize, APos: integer): integer; 105 | begin 106 | if APos>cMaxTabPositionToExpand then 107 | Result:= 1 108 | else 109 | begin 110 | Result:= 0; 111 | repeat Inc(Result) until ((APos+Result-1) mod ATabSize)=0; 112 | end; 113 | end; 114 | 115 | function SExpandTabulations(const S: atString; ATabSize: integer): atString; 116 | var 117 | N, NSize: integer; 118 | begin 119 | Result:= S; 120 | repeat 121 | N:= Pos(#9, Result); 122 | if N=0 then Break; 123 | NSize:= SCalcTabulationSize(ATabSize, N); 124 | if NSize<=1 then 125 | Result[N]:= ' ' 126 | else 127 | begin 128 | Delete(Result, N, 1); 129 | Insert(StringOfChar(' ', NSize), Result, N); 130 | end; 131 | until false; 132 | end; 133 | 134 | { 135 | http://en.wikipedia.org/wiki/Combining_character 136 | Combining Diacritical Marks (0300–036F), since version 1.0, with modifications in subsequent versions down to 4.1 137 | Combining Diacritical Marks Extended (1AB0–1AFF), version 7.0 138 | Combining Diacritical Marks Supplement (1DC0–1DFF), versions 4.1 to 5.2 139 | Combining Diacritical Marks for Symbols (20D0–20FF), since version 1.0, with modifications in subsequent versions down to 5.1 140 | Combining Half Marks (FE20–FE2F), versions 1.0, updates in 5.2 141 | } 142 | function IsAccentChar(ch: WideChar): boolean; 143 | begin 144 | case Ord(ch) of 145 | $0300..$036F, 146 | $1AB0..$1AFF, 147 | $1DC0..$1DFF, 148 | $20D0..$20FF, 149 | $FE20..$FE2F: 150 | Result:= true; 151 | else 152 | Result:= false; 153 | end; 154 | end; 155 | 156 | function IsCharCJKText(ch: widechar): boolean; inline; 157 | begin 158 | case Ord(ch) of 159 | $4E00..$9FFF, 160 | $3400..$4DBF, 161 | $F900..$FAFF: 162 | Result := true; 163 | else 164 | Result := false; 165 | end; 166 | end; 167 | 168 | function IsCharCJKPunctuation(ch: widechar): boolean; inline; 169 | begin 170 | case Ord(ch) of 171 | $3002, 172 | $ff01, 173 | $ff0c, 174 | $ff1a, 175 | $ff1b, 176 | $ff1f: 177 | Result := true; 178 | else 179 | Result := false; 180 | end; 181 | end; 182 | 183 | { 184 | Ranges that are FullWidth char 185 | 1100 e1 84 80 .. 115F e1 85 9f 186 | 2329 e2 8c a9 .. 232A e2 8c aa 187 | 2E80 e2 ba 80 .. 303E e3 80 be 188 | 3041 e3 81 81 .. 33FF e3 8f bf 189 | 3400 e3 90 80 .. 4DB5 e4 b6 b5 190 | 4E00 e4 b8 80 .. 9FC3 e9 bf 83 191 | A000 ea 80 80 .. A4C6 ea 93 86 192 | AC00 ea b0 80 .. D7A3 ed 9e a3 193 | F900 ef a4 80 .. FAD9 ef ab 99 194 | FE10 ef b8 90 .. FE19 ef b8 99 195 | FE30 ef b8 b0 .. FE6B ef b9 ab 196 | FF01 ef bc 81 .. FF60 ef bd a0 197 | FFE0 ef bf a0 .. FFE6 ef bf a6 198 | 20000 f0 a0 80 80 .. 2FFFD f0 af bf bd 199 | 30000 f0 b0 80 80 .. 3FFFD f0 bf bf bd 200 | } 201 | function IsCharFullWidth(ch: WideChar): boolean; 202 | begin 203 | case Ord(ch) of 204 | $1100..$115F, 205 | $2329..$232A, 206 | $2E80..$303E, 207 | $3041..$33FF, 208 | $3400..$4DB5, 209 | $4E00..$9FC3, 210 | $A000..$A4C6, 211 | $AC00..$D7A3, 212 | $F900..$FAD9, 213 | $FE10..$FE19, 214 | $FE30..$FE6B, 215 | $FF01..$FF60, 216 | $FFE0..$FFE6: 217 | Result:= true; 218 | else 219 | Result:= false; 220 | end; 221 | end; 222 | 223 | 224 | procedure SCalcCharOffsets(C: TCanvas; const S: atString; var AList: array of integer); 225 | var 226 | Size, SizeDigit, SizeW: integer; 227 | FontMonospaced: boolean; 228 | i: integer; 229 | begin 230 | if Length(AList)<>Length(S) then 231 | raise Exception.Create('bad list parameter in CalcCharOffsets'); 232 | if S='' then Exit; 233 | 234 | SizeDigit:= C.TextWidth('0'); 235 | SizeW:= C.TextWidth('W'); 236 | FontMonospaced:= SizeDigit=SizeW; 237 | 238 | for i:= 1 to Length(S) do 239 | begin 240 | if FontMonospaced and (Ord(S[i])>=32) and (Ord(S[i])<=255) then 241 | Size:= SizeDigit 242 | else 243 | Size:= C.TextWidth(UTF8Encode(UnicodeString(S[i]))); 244 | 245 | if i=1 then 246 | AList[i-1]:= Size 247 | else 248 | AList[i-1]:= AList[i-2]+Size; 249 | end; 250 | end; 251 | 252 | 253 | function SFindClickedPosition( 254 | C: TCanvas; 255 | const Str: atString; 256 | APixelsFromLeft, ACharSize, ATabSize: integer; 257 | AAllowVirtualPos: boolean): integer; 258 | var 259 | ListReal: array of integer; 260 | ListMid: array of integer; 261 | i: integer; 262 | begin 263 | if Str='' then 264 | begin 265 | if AAllowVirtualPos then 266 | Result:= 1+APixelsFromLeft div ACharSize 267 | else 268 | Result:= 1; 269 | Exit; 270 | end; 271 | 272 | SetLength(ListReal, Length(Str)); 273 | SetLength(ListMid, Length(Str)); 274 | SCalcCharOffsets(C, Str, ListReal); 275 | 276 | //positions of each char middle 277 | for i:= 0 to High(ListReal) do 278 | if i=0 then 279 | ListMid[i]:= ListReal[i] div 2 280 | else 281 | ListMid[i]:= (ListReal[i-1]+ListReal[i]) div 2; 282 | 283 | for i:= 0 to High(ListReal) do 284 | if APixelsFromLeft<ListMid[i] then 285 | begin 286 | Result:= i+1; 287 | Exit 288 | end; 289 | 290 | if AAllowVirtualPos then 291 | Result:= Length(Str)+1 + (APixelsFromLeft - ListReal[High(ListReal)]) 292 | else 293 | Result:= Length(Str)+1; 294 | end; 295 | 296 | 297 | function BoolToPlusMinusOne(b: boolean): integer; 298 | begin 299 | if b then Result:= 1 else Result:= -1; 300 | end; 301 | 302 | end. 303 | 304 | -------------------------------------------------------------------------------- /help_delphi/source/History.html: -------------------------------------------------------------------------------- 1 | <!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"> 2 | <html> 3 | <head> 4 | <meta content="text/html; charset=ISO-8859-1" http-equiv="content-type"> 5 | <title>Versions history 6 | 7 | 8 | 9 | 10 |

Versions history

11 |
12 | 13 | 2.8.1 (2012) 14 |
    15 |
  • Added: TextLineSpacing prop. 16 |
  • Added: TextEnableSel prop. 17 |
18 | 19 | 2.8.0 (oct 2010) 20 |
    21 |
  • Added: asoShowAll search option. 22 |
  • Added: TextColorHi prop. 23 |
24 | 25 | 2.7.0 (feb 2010) 26 |
    27 |
  • Added: TextGutterLinesStep prop. 28 |
  • Added: Hex mode: mouse selection on the digits part. 29 |
  • Changed: "HScrollbar_workaround" define renamed to "Scroll". 30 |
  • Changed: "Debug" define renamed to "Test". 31 |
  • changed: parameter added to OnDrawLine. 32 |
  • fixed: "Select line" command for long lines. 33 |
34 | 35 | 2.6.0 (mar 2009) 36 |
    37 |
  • Added: URL/mail highlighting. 38 |
  • Changed: OnDrawLine parameters. 39 |
  • Added: OnDrawLine2 event. 40 |
  • Added: asoRegExMLine search option. 41 |
  • Fixed: On reloading selection is restored too. 42 |
  • Fixed: Tab display for fixed modes. 43 |
44 | 45 | 2.5.0 (7 dec 2008) 46 |
    47 |
  • Added: Delphi 2009 compat. 48 |
  • Added: SearchStarted, SearchString prop. 49 |
  • Added: AutoReloadSimple, AutoReloadSimpleTime prop. 50 |
  • Added: OnDrawLine event (allows to color lines). 51 |
  • Fixed: D2009 text search. 52 |
53 | 54 | 55 | 2.4.0 (06 sep 2008) 56 |
    57 |
  • Added: Line numbers: TextGutterLines*, FontGutter. 58 |
  • Fixed: "Positions out of range" exception. 59 |
  • Fixed: Printing. 60 |
  • Fixed: Reload line up issue. 61 |
62 | 63 | 2.3.0 (21 jun) 64 |
    65 |
  • Added: PosLine property. 66 |
  • Fixed: Tailing issue. 67 |
68 | 69 | 2.2.0 (01 Mar 2008) 70 |
    71 |
  • Added: Printing: 72 |
      73 |
    • Margin* properties. 74 |
    • Margins handling during PrintSetup call. 75 |
    • FontFooter property. 76 |
    • Page numbers are printed. 77 |
    • Changed: Print declaration. 78 |
    79 |
  • Added: Notepad minor feature: follow tail on control resize. 80 |
  • Fixed: Vertical scrollbar may disappear on some files. 81 |
  • Fixed: AutoReload could not apply sometimes. 82 |
83 | 84 | 2.1.0 (27 Jan 2008) 85 |
    86 |
  • Added: FindFirst method has additional asoFromPage option. 87 |
  • Added: FindNext method has additional AFindPrevious parameter to find previous match. 88 |
  • Changed: Printing code separated to ATBinHexPrint.inc. 89 |
  • Removed: VariableScrollbar property. 90 |
  • Fixed: FindNext error after changing view mode. 91 |
92 | 93 | 2.0.0 (17 Dec 2007) 94 |
    95 |
  • Added: TextGutter, TextGutterWidth, TextColorGutter properties. 96 |
  • Added: Tabs (#9) have correct dynamic size (currently only for monospaced fonts). 97 |
  • Fixed: AutoReload option could not apply sometimes. 98 |
  • Fixed: Trailing spaces showing on word wrap. 99 |
100 | 101 | 1.9.2 (28 Oct 2007) 102 |
    103 |
  • Added: TextOemSpecial property. 104 |
  • Added: TextNonPrintable property. 105 |
  • Changed: Msg* properties changed to single TextPopupCaption[] property. 106 |
107 | 108 | 1.9.0 (20 Oct 2007): 109 |
    110 |
  • Added: Many codepages added, see complete list in ATxCodepages.pas. 111 | See notes for TextEncoding property. 112 | Note: RegEx search for custom codepages is not yet implemented. 113 |
  • Added: TextEncodingName property. 114 |
  • Added: TextEncodingsMenu method. 115 |
  • Added: "Encodings menu" popup menu item. 116 |
  • Added: Mouse shortcut for zoom: left button + wheel. 117 |
  • Added: Reload method. 118 |
  • Changed: OnScaleChange event removed, OnOptionsChange added instead. 119 |
  • Fixed: Number of wheel scroll lines now read correctly. 120 |
121 | 122 | 1.8.0 (28 Sep 2007): 123 |
    124 |
  • Added: View mode "Unicode/Hex", similar to FAR manager's one. 125 |
  • Added: Nice scroll by middle mouse click, like in MSIE / Forefox. 126 |
  • Added: Support for KOI8-R codepage. More codepages will be added later. 127 |
  • Added: Properties TextWidthUHex, TextWidthFitUHex. 128 |
  • Added: Properties SelTextShort, SelTextShortW. 129 |
  • Changed: Auto-scroll horz. speed decreased (more smooth scroll). 130 |
131 | 132 | 1.7.0 (01 Aug 2007): 133 |
    134 |
  • Changes regarding printing: 135 |
      136 |
    • Changed: Redraw procedure refactored so now it's possible to use DrawTo 137 | to draw control contents on other bitmaps, not only on screen. 138 |
    • Changed: Print method rewritten, it uses DrawTo, so control prints itself 139 | in exactly the same form as it's shown on screen (but grayscaled). 140 | The printing is now possible in all modes, including Unicode! 141 |
    • Added: ATPrintPreview component is used to show print preview form. 142 | It's enabled by "PREVIEW" define in ATBinHexOptions.inc. 143 |
    • Added: PrintPreview method. 144 |
    145 |
  • Added: Only chars missed in the current font are replaced with dots. 146 |
  • Added: Visual indication of Enabled property (grayed text). 147 |
  • Added: OnScroll event. 148 |
  • Changed: Property ScrollPageSize renamed to VariableScrollbar, it's default value is False now. 149 |
150 | 151 | 1.6.2 (16 Jun 2007): 152 |
    153 |
  • Added: Auto-scroll when mouse is lefter/righter than client area 154 |
  • Added: Shift + Mouse Wheel scrolls text horizontally 155 |
  • Added: Ctrl + Mouse Wheel changes font size 156 |
  • Added: OnScaleChange event 157 |
  • Changed: ATStreamSearch updated for DIRegEx 4.1.1 release 158 |
  • Fixed: Possible AV on text selection under Multi-Byte locales 159 |
160 | 161 | 1.6.0 (28 Mar 2007): 162 |
    163 |
  • Changed: License updated to MPL 1.1 164 |
  • Added: ATStreamSearch helper component 165 |
  • Added: RegEx search option (DIRegEx library must be used) 166 |
  • Changed: FindFirst/FindNext methods added instead of FindText method 167 |
  • Added: Feature like in RichEdit: triple click selects current line 168 |
  • Added: MaxClipboardDataSizeMb property 169 |
  • Changed: TextSearchIndent property renamed to TextSearchIndentVert 170 |
  • Changed: OnSearchProgress event added instead of SearchCallback property 171 |
  • Changed: ATBinHexDef.inc file renamed to ATBinHexOptions.inc, 172 | several options added to it 173 |
174 | 175 | 1.5.8 (24 Feb 2007): 176 |
    177 |
  • Changed: Files are not locked for deletion anymore (Note: not supported in Win9x) 178 |
  • Added: IncreaseFontSize method 179 |
  • Added: OnFileReload event 180 |
181 | 182 | 1.5.6 (14 Dec 2006): 183 |
    184 |
  • Added: FindText method works also in Unicode mode 185 |
  • Added: Scroll method 186 |
  • Added: TextSearchIndentHorz property 187 |
  • Added: Feature similar to RichEdit's: selection can be changed by performing 188 | Click at block start and Shift+Click at end 189 |
  • Changed: Declaration of SetSelection method 190 |
  • Removed: AutoCopy property: it can be done via OnSelectionChange event 191 |
192 | 193 | 1.5.5 (24 Nov 2006): 194 |
    195 |
  • Added: TextPopupCommands property 196 |
  • Added: MaxLengths property 197 |
198 | 199 | 1.5.3 (02 Oct 2006): 200 |
    201 |
  • Added: AutoReload, AutoReloadBeep, AutoReloadFollowTail properties 202 |
  • Added: AutoCopy property 203 |
  • Added: TextTabSize property 204 |
  • Added: TextColorHexBack property 205 |
  • Added: PosOffset, SelText, SelTextW properties 206 |
  • Added: OnSelectionChange event 207 |
208 | 209 | 1.5.2 (09 Sep 2006): 210 |
    211 |
  • Changed: Most of units renamed to AT*.* to avoid name confusions 212 |
  • Added: Thread safety note in the help 213 |
214 | 215 | 1.5.1 (04 Aug 2006): 216 |
    217 |
  • Added: OpenStream method 218 |
  • Added: Feature similar to RichEdit's: double click selects word under cursor 219 |
220 | 221 | 1.5.0 (22 Jul 2006): 222 |
    223 |
  • Added: Implemented Text mode (with variable line length) 224 |
  • Added: Unicode mode is now also has variable line length 225 |
  • Added: Select/Copy commands work in Unicode mode too 226 |
  • Added: FontOEM, ScrollPageSize properties 227 |
228 | 229 | ... 230 |

231 | 232 | 1.3.2 (17 Jun 2006): 233 |

    234 |
  • Initial release (previous versions were included in the ATViewer pack) 235 |
236 | 237 | 238 | 239 | -------------------------------------------------------------------------------- /atbinhex/atbinhex_strproc.pas: -------------------------------------------------------------------------------- 1 | unit atbinhex_strproc; 2 | 3 | interface 4 | 5 | uses 6 | SysUtils, atbinhex_stringproc; 7 | 8 | function SetStringW(Buf: Pointer; Len: Integer; SwapUnicode: boolean): UnicodeString; 9 | function SFileExtensionMatch(const FN, ExtList: string): boolean; 10 | 11 | type 12 | TStringDecodeRecW = record 13 | SFrom, STo: UnicodeString; 14 | end; 15 | 16 | TStringTabOptions = record 17 | TabSize: Integer; 18 | TabPosition: Integer; 19 | FontMonospaced: Boolean; 20 | NonPrintableShow: Boolean; 21 | NonPrintableChar: WideChar; 22 | end; 23 | 24 | function SDecodeW(const S: UnicodeString; const Decode: array of TStringDecodeRecW): UnicodeString; 25 | procedure SReplaceZeros(var S: AnsiString); 26 | procedure SReplaceZerosW(var S: UnicodeString); 27 | procedure SDelLastSpace(var S: AnsiString); 28 | procedure SDelLastSpaceW(var S: UnicodeString); 29 | function STabReplacement(const TabOptions: TStringTabOptions): UnicodeString; 30 | procedure SReplaceTabsW(var S: UnicodeString; var TabOptions: TStringTabOptions); 31 | function SCharCR(ch: WideChar): Boolean; 32 | function SLastCharCR(const S: UnicodeString): Boolean; 33 | 34 | function SFindText(const F, S: string; fForward, fWholeWords, fCaseSens, fLastBlock: Boolean): Integer; 35 | function SFindTextW(const F, S: UnicodeString; fForward, fWholeWords, fCaseSens, fLastBlock: Boolean): Integer; 36 | 37 | procedure ILimitMin(var N: Integer; Value: Integer); 38 | procedure ILimitMax(var N: Integer; Value: Integer); 39 | procedure I64LimitMin(var N: Int64; const Value: Int64); 40 | procedure I64LimitMax(var N: Int64; const Value: Int64); 41 | 42 | implementation 43 | 44 | function SDecodeW(const S: UnicodeString; const Decode: array of TStringDecodeRecW): UnicodeString; 45 | var 46 | i, j: Integer; 47 | DoDecode: Boolean; 48 | begin 49 | Result := ''; 50 | i := 1; 51 | repeat 52 | if i > Length(S) then Break; 53 | DoDecode := False; 54 | for j := Low(Decode) to High(Decode) do 55 | with Decode[j] do 56 | if SFrom = Copy(S, i, Length(SFrom)) then 57 | begin 58 | DoDecode := True; 59 | Result := Result + STo; 60 | Inc(i, Length(SFrom)); 61 | Break 62 | end; 63 | if DoDecode then Continue; 64 | Result := Result + S[i]; 65 | Inc(i); 66 | until False; 67 | end; 68 | 69 | 70 | function SDefaultDelimiters: string; 71 | const 72 | cChars = ':;<=>?' + '@[\]^' + '`{|}~'; 73 | var 74 | i: Integer; 75 | begin 76 | Result := ''; 77 | for i := 0 to Ord('/') do 78 | Result := Result + Chr(i); 79 | Result := Result + cChars; 80 | end; 81 | 82 | //-------------------------------------------------- 83 | function SFindText(const F, S: string; fForward, fWholeWords, fCaseSens, fLastBlock: Boolean): Integer; 84 | var 85 | SBuf, FBuf, Delimiters: string; 86 | Match: Boolean; 87 | LastPos, LengthF, i: Integer; 88 | begin 89 | Result := 0; 90 | 91 | if (S = '') or (F = '') then Exit; 92 | 93 | Delimiters := SDefaultDelimiters; 94 | 95 | SBuf := S; 96 | FBuf := F; 97 | if not fCaseSens then 98 | begin 99 | SBuf := LowerCase(SBuf); 100 | FBuf := LowerCase(FBuf); 101 | end; 102 | 103 | LengthF := Length(F); 104 | LastPos := Length(S) - LengthF + 1; 105 | 106 | if fForward then 107 | //Search forward 108 | for i := 1 to LastPos do 109 | begin 110 | Match := CompareMem(@FBuf[1], @SBuf[i], LengthF); 111 | 112 | if fWholeWords then 113 | Match := Match 114 | and (fLastBlock or (i < LastPos)) 115 | and ((i <= 1) or (Pos(S[i - 1], Delimiters) > 0)) 116 | and ((i >= LastPos) or (Pos(S[i + LengthF], Delimiters) > 0)); 117 | 118 | if Match then 119 | begin 120 | Result := i; 121 | Break 122 | end; 123 | end 124 | else 125 | //Search backward 126 | for i := LastPos downto 1 do 127 | begin 128 | Match := CompareMem(@FBuf[1], @SBuf[i], LengthF); 129 | 130 | if fWholeWords then 131 | Match := Match 132 | and (fLastBlock or (i > 1)) 133 | and ((i <= 1) or (Pos(S[i - 1], Delimiters) > 0)) 134 | and ((i >= LastPos) or (Pos(S[i + LengthF], Delimiters) > 0)); 135 | 136 | if Match then 137 | begin 138 | Result := i; 139 | Break 140 | end; 141 | end; 142 | end; 143 | 144 | //-------------------------------------------------- 145 | function SFindTextW(const F, S: UnicodeString; fForward, fWholeWords, fCaseSens, fLastBlock: Boolean): Integer; 146 | var 147 | SBuf, FBuf, Delimiters: UnicodeString; 148 | Match: Boolean; 149 | LastPos, LengthF, i: Integer; 150 | begin 151 | Result := 0; 152 | 153 | if (S = '') or (F = '') then Exit; 154 | 155 | Delimiters := SDefaultDelimiters; 156 | 157 | SBuf := S; 158 | FBuf := F; 159 | if not fCaseSens then 160 | begin 161 | SBuf := UnicodeLowerCase(SBuf); 162 | FBuf := UnicodeLowerCase(FBuf); 163 | end; 164 | 165 | LengthF := Length(F); 166 | LastPos := Length(S) - LengthF + 1; 167 | 168 | if fForward then 169 | //Search forward 170 | for i := 1 to LastPos do 171 | begin 172 | Match := CompareMem(@FBuf[1], @SBuf[i], LengthF * 2); 173 | 174 | if fWholeWords then 175 | Match := Match 176 | and (fLastBlock or (i < LastPos)) 177 | and ((i <= 1) or (Pos(S[i - 1], Delimiters) > 0)) 178 | and ((i >= LastPos) or (Pos(S[i + LengthF], Delimiters) > 0)); 179 | 180 | if Match then 181 | begin 182 | Result := i; 183 | Break 184 | end; 185 | end 186 | else 187 | //Search backward 188 | for i := LastPos downto 1 do 189 | begin 190 | Match := CompareMem(@FBuf[1], @SBuf[i], LengthF * 2); 191 | 192 | if fWholeWords then 193 | Match := Match 194 | and (fLastBlock or (i > 1)) 195 | and ((i <= 1) or (Pos(S[i - 1], Delimiters) > 0)) 196 | and ((i >= LastPos) or (Pos(S[i + LengthF], Delimiters) > 0)); 197 | 198 | if Match then 199 | begin 200 | Result := i; 201 | Break 202 | end; 203 | end; 204 | end; 205 | 206 | procedure ILimitMin(var N: Integer; Value: Integer); 207 | begin 208 | if N < Value then 209 | N := Value; 210 | end; 211 | 212 | procedure ILimitMax(var N: Integer; Value: Integer); 213 | begin 214 | if N > Value then 215 | N := Value; 216 | end; 217 | 218 | procedure I64LimitMin(var N: Int64; const Value: Int64); 219 | begin 220 | if N < Value then 221 | N := Value; 222 | end; 223 | 224 | procedure I64LimitMax(var N: Int64; const Value: Int64); 225 | begin 226 | if N > Value then 227 | N := Value; 228 | end; 229 | 230 | 231 | procedure SReplaceZeros(var S: AnsiString); 232 | var 233 | i: Integer; 234 | begin 235 | for i := 1 to Length(S) do 236 | if S[i] = #0 then 237 | S[i] := ' '; 238 | end; 239 | 240 | procedure SReplaceZerosW(var S: UnicodeString); 241 | var 242 | i: Integer; 243 | begin 244 | for i := 1 to Length(S) do 245 | if S[i] = #0 then 246 | S[i] := ' '; 247 | end; 248 | 249 | procedure SDelLastSpaceW(var S: UnicodeString); 250 | begin 251 | if (S <> '') and ((S[Length(S)] = ' ') or (S[Length(S)] = #9)) then 252 | SetLength(S, Length(S) - 1); 253 | end; 254 | 255 | procedure SDelLastSpace(var S: AnsiString); 256 | begin 257 | if (S <> '') and (S[Length(S)] = ' ') then 258 | SetLength(S, Length(S) - 1); 259 | end; 260 | 261 | 262 | function STabReplacement(const TabOptions: TStringTabOptions): UnicodeString; 263 | var 264 | ASize: Integer; 265 | APos: Integer; 266 | begin 267 | with TabOptions do 268 | begin 269 | Assert(TabSize > 0, 'Tab size too small'); 270 | if FontMonospaced then 271 | ASize := TabSize - (TabPosition - 1) mod TabSize 272 | else 273 | ASize := TabSize; 274 | Result := StringOfChar(' ', ASize); 275 | APos := Length(Result) div 2 + 1; 276 | if NonPrintableShow then 277 | Result[APos] := NonPrintableChar; 278 | end; 279 | end; 280 | 281 | procedure SReplaceTabsW(var S: UnicodeString; var TabOptions: TStringTabOptions); 282 | var 283 | N: Integer; 284 | begin 285 | repeat 286 | N := Pos(#9, S); 287 | if N = 0 then Break; 288 | TabOptions.TabPosition := N; 289 | S := StringReplace(S, #9, STabReplacement(TabOptions), [rfReplaceAll]); 290 | until False; 291 | end; 292 | 293 | 294 | procedure SDeleteFromStrA(var S: AnsiString; const SubStr: AnsiString); 295 | var 296 | N: Integer; 297 | begin 298 | N := Pos(SubStr, S); 299 | if N > 0 then 300 | SetLength(S, N - 1); 301 | end; 302 | 303 | procedure SDeleteFromStrW(var S: UnicodeString; const SubStr: UnicodeString); 304 | var 305 | N: Integer; 306 | begin 307 | N := Pos(SubStr, S); 308 | if N > 0 then 309 | SetLength(S, N - 1); 310 | end; 311 | 312 | function SCharCR(ch: WideChar): Boolean; 313 | begin 314 | Result := (ch = #13) or (ch = #10); 315 | end; 316 | 317 | function SLastCharCR(const S: UnicodeString): Boolean; 318 | begin 319 | Result := (S <> '') and SCharCR(S[Length(S)]); 320 | end; 321 | 322 | function SetStringW(Buf: Pointer; Len: Integer; SwapUnicode: boolean): UnicodeString; 323 | begin 324 | Result:= ''; 325 | if Len<2 then Exit; 326 | 327 | SetLength(Result, Len div 2); 328 | Move(Buf^, Result[1], Len); 329 | if SwapUnicode then 330 | Result:= SSwapEndian(Result); 331 | end; 332 | 333 | function SFileExtensionMatch(const FN, ExtList: string): boolean; 334 | begin 335 | Result:= false; 336 | end; 337 | 338 | end. 339 | -------------------------------------------------------------------------------- /help_delphi/source/Usage Methods.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | Usage: Methods 6 | 7 | 8 | 9 | 10 |

Methods

11 |
12 | 13 | 14 | 15 | 28 | 29 | 30 | 44 | 45 | 46 | 49 | 50 | 51 | 78 | 79 | 80 | 90 | 91 | 92 | 105 | 106 | 107 | 120 | 121 | 122 | 130 | 131 | 132 | 138 | 139 | 166 | 167 | 168 | 179 | 180 | 181 | 191 | 192 | 193 | 202 | 203 | 204 |
function Open(const AFileName: WideString; ARedraw: Boolean = True): Boolean;
16 | Opens a file and optionally redraws control.
17 | Result is True if file was successfully opened 18 | or False if file was not found or other open error occured.
19 | Pass the empty AFileName string to close the currently open file.
20 | Note:
21 |
    22 |
  • ARedraw parameter must be set to False in the case you create ATBinHex 23 | object at run-time and then call Open('')/OpenStream(nil) in your destructor 24 | to free data. In this case the control must not be redrawn 25 | because this will cause its parent access error. 26 |
27 |
function OpenStream(AStream: TStream; ARedraw: Boolean = True): Boolean;
31 | Opens a stream and optionally redraws control.
32 | Result is True if stream was successfully opened.
33 | Pass nil to stop use the currently used stream.
34 | Notes:
35 |
    36 |
  • See note for Open.
    • 37 |
  • Stream is not freed automatically, you should free it by yourself, 38 | but only after you call OpenStream(nil).
    • 39 |
  • In Delphi 5 TStream.Size is declared as Longint, 40 | so if you are going to open streams larger than 2 Gb, you should 41 | use newer Delphi versions which declare TStream.Size as Int64.
    • 42 |
43 |
procedure Reload;
47 | Reloads current file or stream. 48 |
function FindFirst(const AText: WideString; AOptions: TATStreamSearchOptions): Boolean;
52 | Starts text search.
53 | AText: text to search (Note: Unicode string must be in the Little-Endian format).
54 | AOptions: search options that are set of flags:
55 |
    56 |
  • asoWholeWords: Search for whole words only
    • 57 |
  • asoCaseSens: Case-sensitive search
    • 58 |
  • asoBackward: Backward search (Note: not supported for RegEx search)
    • 59 |
  • asoRegEx: RegEx (regular expressions) search
    • 60 |
  • asoRegExMLine: Multiline regex search (used with asoRegEx)
    • 61 |
  • asoFromPage: Starts search from the current page, otherwise in entire file
    • 62 |
  • asoShowAll: Highlights all occurances of search string
    • 63 |
64 | Result is True if text was found.
65 | Match position and length are saved in SearchResultStart and SearchResultLength properties. 66 | You should manually highlight found match using SetSelection method.
67 | Notes:
68 |
    69 |
  • RegEx search (asoRegEx option) is available only when RegEx library is compiled in. 70 | See ATStreamSearchOptions.inc file.
    • 71 |
  • Unicode-named files can be handled during search only when Tnt Unicode 72 | Controls are compiled in. See ATStreamSearchOptions.inc file.
    • 73 |
  • When non-RegEx search is performed, two 74 | different search functions are used: one for 1-byte Text/Binary/Hex 75 | modes and other for Unicode modes; they give different search results.
    • 76 |
77 |
function FindNext(AFindPrevious: Boolean = False): Boolean;
81 | Continues text search.
82 | AFindPrevious: continue search in reverse direction (Note: not supported for RegEx search).
83 | Result is the same as for FindFirst method.
84 | Note:
85 |
    86 |
  • After you change view mode or reload a file, you cannot continue search immediately, 87 | you must first call FindFirst.
    • 88 |
89 |
procedure CopyToClipboard(AsHex: Boolean = False);
93 | Copies current selection (AnsiString or WideString depending on current view mode) 94 | to Clipboard.
95 | AsHex may be True in Text/Binary/Hex modes, in this case 96 | the hex-encoded string (bytes in the hex form separated by spaces) will be 97 | copied.
98 | Notes:
99 |
    100 |
  • This procedure may fail and show an error message if selection is too big to fit in memory.
    • 101 |
  • To prevent visual "hanging" during copying of too large block, 102 | data size is internally limited by MaxClipboardDataSizeMb value.
    • 103 |
104 |
procedure SetSelection(const AStart, ALength: Int64; AScroll: Boolean; AFireEvent: Boolean = True; ARedraw: Boolean = True);
108 | Sets selection and optionally scrolls control to selection start.
109 | AStart: selection start (0-based),
110 | ALength: selection length,
111 | AScroll: scroll control to selection start afterwards,
112 | AFireEvent: fire the OnSelectionChange event afterwards,
113 | ARedraw: redraw control afterwards.
114 | Note:
115 |
    116 |
  • If AScroll = True, control will be scrolled using the code: 117 | 
      Scroll(AStart, TextSearchIndentVert, TextSearchIndentHorz);
    118 |
119 |
procedure Scroll(const APos: Int64; AIndentVert, AIndentHorz: integer; ARedraw: Boolean = True);
123 | Scrolls control to specified position.
124 | Control will be scrolled vertically so that position APos (0-based) is visible 125 | by AIndentVert lines lower than top border; 126 | if after that the position is still out of screen, control will be 127 | scrolled horizontally so that position is visible by AIndentHorz chars righter than left border.
128 | ARedraw: allow to redraw control afterwards. 129 |
133 | procedure SelectAll;
134 | procedure SelectNone;
135 | Selects all text.
136 | Deselects text. 137 |
140 | 141 | procedure Print( 142 | APrintRange: TPrintRange; 143 | AFromPage: Integer = 1; 144 | AToPage: Integer = MaxInt; 145 | ACopies: Integer = 1; 146 | const ACaption: string = ''); 147 |
148 | Shows "Print preview" dialog and allows user to print text.
149 | APrintRange: print range (type declared in Dialogs.pas): 150 |
    151 |
  • prAllPages: prints all text. 152 |
  • prSelection: prints selection only. 153 |
  • prPageNums: prints pages from AFromPage to AToPage. 154 |
155 | ACopies: number of print copies,
156 | ACaption: caption of print job.
157 | Notes: 158 |
    159 |
  • This method shows "Print preview" form only when ATPrintPreview component 160 | is used by enabling the "PREVIEW" define in ATBinHexOptions.inc. 161 | Otherwise it just prints the text without questions. 162 |
  • Resulting page sizes are affected by Margin* properties 163 | and printer page sizes, not by visible control size. 164 |
165 |
procedure PrintPreview;
169 | Shows "Print preview" dialog for current selection.
170 | When text is selected (SelLength <> 0), this method calls 171 | Print(prSelection), otherwise it calls Print(prAllPages). 172 | Note: 173 |
    174 |
  • This method works only when ATPrintPreview component is used 175 | by enabling the "PREVIEW" define in ATBinHexOptions.inc. 176 | Otherwise it does nothing. 177 |
178 |
function IncreaseFontSize(AIncrement: Boolean): Boolean;
182 | Increases (AIncrement = True) or decreases current font size.
183 | Result is True if font size was changed or False if minimal 184 | or maximal size value is already set.
185 | Note:
186 |
    187 |
  • For raster fonts (the default OEM font is raster) 188 | this size change is not simple increment by one.
    • 189 |
190 |
procedure TextEncodingsMenu(AX, AY: Integer);
194 | Shows menu of all available encodings for the current mode.
195 | Menu is shown at point (AX, AY).
196 | Note:
197 |
    198 |
  • In Unicode modes this method displays the special Unicode menu, 199 | which contains only "UTF-16 LE" and "UTF-16 BE" items. 200 |
201 |
205 | 206 | 207 | 208 | -------------------------------------------------------------------------------- /help_delphi/source/Usage Properties.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | Usage: Properties 6 | 7 | 8 | 9 | 10 |

Properties

11 |
12 | 13 | 14 | 15 | 16 | 26 | 27 | 28 | 29 | 55 | 56 | 57 | 58 | 65 | 66 | 67 | 68 | 71 | 72 | 73 | 78 | 85 | 86 | 87 | 92 | 105 | 106 | 107 | 111 | 117 | 118 | 119 | 120 | 122 | 123 | 124 | 125 | 134 | 135 | 136 | 137 | 148 | 162 | 163 | 164 | 165 | 168 | 177 | 178 | 179 | 180 | 183 | 191 | 192 | 193 | 194 | 200 | 209 | 210 | 211 | 225 | 239 | 240 | 241 | 250 | 261 | 262 | 263 | 264 | 265 | 275 | 276 | 277 | 278 | 281 | 282 | 283 | 284 | 285 | 297 | 298 | 299 | 303 | 304 | 305 | 306 | 307 | 315 | 330 | 331 | 332 | 333 | 340 | 341 | 357 | 358 | 359 | 360 | 368 | 377 | 378 | 379 | 380 | 388 | 391 | 392 | 393 | 394 | 399 | 402 | 403 | 404 | 405 | 410 | 414 | 415 | 416 | 417 |
ModeCurrent view mode.
17 | Possible values:
18 |
    19 |
  • vbmodeText: Text mode
    • 20 |
  • vbmodeBinary: Binary mode
    • 21 |
  • vbmodeHex: Hex mode
    • 22 |
  • vbmodeUnicode: Unicode mode
    • 23 |
  • vbmodeUHex: Combined Unicode/Hex mode
    • 24 |
25 |
TextEncodingCurrent text encoding.
30 | Used in non-Unicode modes.
31 | Possible values:
32 |
    33 |
  • vencANSI: ANSI (locale dependent)
    • 34 |
  • vencOEM: OEM (locale dependent)
    • 35 |
  • vencEBCDIC: IBM EBCDIC US
    • 36 |
  • vencKOI8: KOI8-R
    • 37 |
  • vencISO: ISO (locale dependent)
    • 38 |
  • vencMac: Mac (locale dependent)
    • 39 |
  • plus many others, see the complete list in ATxCodepages.pas. 40 |
41 | Notes: 42 |
    43 |
  • When encoding is OEM, text may be drawn using different font, see FontOEM. 44 |
  • Technical notes: 45 |
      46 |
    • ANSI, OEM, EBCDIC, KOI8, ISO, Mac encodings are always available. 47 |
    • EBCDIC, KOI8, ISO, Mac encodings are used via MultiByteToWideChar API, if possible. 48 | But if they are not installed on OS (for example, on Win9x), 49 | then the hardcoded codepages are used. 50 |
    • All other encodings are used via MultiByteToWideChar API, 51 | they are available only when installed on OS. 52 |
    53 |
54 |
TextEncodingName (public, read-only)Name of current text encoding.
59 | Note:
60 |
    61 |
  • It can be read in all modes, even in Unicode. 62 | In Unicode modes is will show "UTF-16 LE" or "UTF-16 BE". 63 |
64 |
TextWrapEnables word wrap.
69 | Works in Text and Unicode modes. 70 |
74 | TextWidth
75 | TextWidthHex
76 | TextWidthUHex 77 | 		Width of text in fixed-length modes: 79 |
    80 |
  • TextWidth: Binary mode. 81 |
  • TextWidthHex: Hex mode. 82 |
  • TextWidthUHex: Unicode/Hex mode. 83 |
84 |
88 | TextWidthFit
89 | TextWidthFitHex
90 | TextWidthFitUHex 91 | 		Enables width auto-fit in fixed-length modes.
93 |
    94 |
  • TextWidthFit: Binary mode. 95 |
  • TextWidthFitHex: Hex mode. 96 |
  • TextWidthFitUHex: Unicode/Hex mode. 97 |
98 | Note:
99 |
    100 |
  • These properties work correctly only with monospaced fonts. 101 | With fonts of variable width you can get text partially 102 | not fitting in the control. 103 |
104 |
108 | TextSearchIndentVert
109 | TextSearchIndentHorz 110 | 		Text indents, used when text is highlighted with successfull FindText / FindNext methods call. 112 |
    113 |
  • TextSearchIndentVert: number of lines above selection. 114 |
  • TextSearchIndentHorz: average number of chars lefter than selection. 115 |
116 |
TextTabSizeTabulation (#9) size. 121 |
TextOemSpecialEnables usage of special OEM font (when TextEncoding = vencOEM).
126 | Note: 127 |
    128 |
  • This property should be set to True only on older Win9x systems. 129 | NT systems support displaying of OEM text in Unicode 130 | (using MultiByteToWideChar API and Unicode fonts), 131 | so special OEM font is not needed. 132 |
133 |
138 | 139 | TextGutter
140 | TextGutterLines
141 | TextGutterLinesBufSize
142 | TextGutterLinesCount
143 | TextGutterLinesStep
144 | TextGutterLinesExtUse
145 | TextGutterLinesExtList 146 | 147 | 		Gutter (vertical bar on the left) options: 149 |
    150 |
  • Enables gutter. 151 |
  • Enables line numbers on gutter (in var length modes). 152 |
  • Buffer size for line numbers. 153 | Lines below this buffer are not counted. 154 | Recommended is ~300Kb .. 1Mb. 155 |
  • Maximal count of line numbers shown. 156 |
  • Step for line numbers. Minimal is 1, means "show numbers for all lines". 157 |
  • Enables lines numbers only for specified file extensions. 158 |
  • List of file extensions for the previous option. 159 | It can be, for example, 'c,cpp,h,hpp,pas,dpr'. 160 |
161 |
166 | TextUrlHilight 167 | 169 | Enables URL/mail highlighting.
170 | On URL clicking the OnClickURL event occurs.
171 | Note: 172 |
    173 |
  • For this option to work the RegEx library must be compiled in. 174 | See ATBinHexOptions.inc file: "REGEX" and "SEARCH" defines must be enabled. 175 |
176 |
181 | TextNonPrintable 182 | Enables displaying of non-printable characters.
184 | Note: 185 |
    186 |
  • When enabled, spaces are shown as small dots, 187 | tabs (#9) are shown as "right arrows", 188 | and line ends are shown as "paragraphs". 189 |
190 |
195 | Font (inherited)
196 | FontOEM
197 | FontFooter
198 | FontGutter 199 | 		Fonts: 201 |
    202 |
  • Default font. 203 |
  • OEM text font. 204 | Used in Text/Binary/Hex modes when (TextEncoding = vEncOEM) and (TextOemSpecial = True). 205 |
  • Font for printing footer. 206 |
  • Font for gutter line numbers. 207 |
208 |
212 | 213 | Color 214 | (inherited)
215 | 216 | TextColorGutter
217 | TextColorURL
218 | TextColorHi
219 | TextColorHex
220 | TextColorHex2
221 | TextColorHexBack
222 | TextColorLines
223 | TextColorError 224 | 		226 | Colors of: 227 |
    228 |
  • Text background 229 |
  • Gutter 230 |
  • URLs 231 |
  • Search highlight color (for option asoShowAll) 232 |
  • Hex digits (even) 233 |
  • Hex digits (odd) 234 |
  • Hex digits background 235 |
  • Hex mode vertical lines 236 |
  • Error messages (displayed when read error occurs) 237 |
238 |
242 | 243 | AutoReload
244 | AutoReloadBeep
245 | AutoReloadFollowTail
246 | AutoReloadSimple
247 | AutoReloadSimpleTime 248 | 249 | 		File auto-reloading options:
251 |
    252 |
  • Enables auto-reload. 253 |
  • Enables beep on reload. 254 |
  • Enables repositioning at the file end, if previous view position was also at the end. 255 |
  • Sets "simple" notification mode. In this mode 256 | file is just checked by timer, no FindFirstChangeNotification API is used. 257 | This is recommended for network files (API doesn't work for this case). 258 |
  • Timer interval for "simple" notification mode, default is 1000 msec. 259 |
260 |
TextPopupCommandsSet of commands visible in the popup (right-click) menu.
266 | Commands available:
267 |
    268 |
  • vpCmdCopy: Copy selection to Clipboard. 269 |
  • vpCmdCopyHex: Copy selection in hex form in Hex mode. 270 |
  • vpCmdSelectLine: Select current line. 271 |
  • vpCmdSelectAll: Select all text. 272 |
  • vpCmdEncMenu: Show encodings menu. 273 |
274 |
TextPopupCaption[AIndex: TATPopupCommand]
(public, write-only) 		Captions of popup (right-click) menu items.
279 | For possible values of AIndex see TextPopupCommands. 280 |
MaxLengths[AIndex: TATBinHexMode] (public)Maximal line lengths.
286 | These values are for all view modes of ATBinHex control: Text, Binary, Hex, Unicode. 287 | They set internal values that define the maximal length of a single string in a file. 288 | Values are 300 by default. 289 | For example, you may set MaxLengths[vbmodeText] to 1000 if user needs to work 290 | with strings of length 1000 in Text mode.
Notes:
291 |
    292 |
  • Larger values increase size of memory buffer for a file, and slow down file reading. 293 |
  • Values are applied after file reopening, e.g. after calling Open/OpenStream/Reload methods 294 | and after changing Mode property. 295 |
296 |
MaxClipboardDataSizeMb (public)Maximal data size (in Mb) for copying to Clipboard.
300 | Default value is 16 (Mb), which prevents visual "hanging" when too large block 301 | is selected accidentally before copying. 302 |
308 | SelStart (public)
309 | SelLength (public)
310 | SelText (public, read-only)
311 | SelTextW (public, read-only)
312 | SelTextShort (public, read-only)
313 | SelTextShortW (public, read-only) 314 | 		Current selection properties: 316 |
    317 |
  • SelStart: Selection start (Int64, 0-based). 318 |
  • SelLength: Selection length (Int64). 319 |
  • SelText: Selection text (AnsiString) in non-Unicode modes. 320 |
  • SelTextW: Selection text (WideString) in Unicode mode. 321 |
  • SelTextShort: Same as SelText, but limited to the length of 256 chars. 322 |
  • SelTextShortW: Same as SelTextW, but limited to the length of 256 chars. 323 |
324 | Note:
325 |
    326 |
  • You should call SelText/SelTextW inside try...except block, 327 | because when selection is too big, exception is generated. 328 |
329 |
334 | 335 | PosPercent
336 | PosOffset
337 | PosLine 338 | (public) 339 | 		Current scroll position: 342 |
    343 |
  • Relative position in percents (%).
    344 |
  • Absolute offset (Int64, 0-based).
    345 |
  • Line number (1-based, 0 if line number is not found).
    346 |
347 | Notes for line numbers: 348 |
    349 |
  • Lines are separated by: #13#10, #13, #10. 350 |
  • Line numbers are counted only for the first portion of file 351 | (see TextGutterLines*). 352 |
  • Line numbers are counted for the "current" copy of file, 353 | they may be incorrect if file was changed (and not reloaded) 354 | since the last display. 355 |
356 |
361 | 362 | SearchResultStart
363 | SearchResultLength
364 | SearchStarted
365 | SearchString 366 | (public, read-only) 367 | 		Search-related: 369 |
    370 |
  • Search match position (Int64, 0-based). Negative if search was failed. 371 |
  • Search match length. 372 |
  • Property which shows was search started after the last file reload or not. 373 | It is set to False on each file realod. 374 |
  • Last search string used. 375 |
376 |
381 | 382 | MarginLeft
383 | MarginTop
384 | MarginRight
385 | MarginBottom 386 | (public) 387 | 		Printing margins.
389 | Currently in mm. 390 |
395 | 396 | TextLineSpacing 397 | 398 | 400 | Interline spacing in pixels (default is 0). 401 |
406 | 407 | TextEnableSel 408 | 409 | 411 | Enables selection.
412 | If set to False, text cannot be selected by user. 413 |
418 | 419 | 420 | 421 | -------------------------------------------------------------------------------- /atbinhex/atstreamsearch.pas: -------------------------------------------------------------------------------- 1 | {************************************************} 2 | { } 3 | { ATStreamSearch Component } 4 | { Copyright (C) 2007-2008 Alexey Torgashin } 5 | { } 6 | {************************************************} 7 | 8 | {$BOOLEVAL OFF} //Short boolean evaluation required. 9 | 10 | {$I ATStreamSearchOptions.inc} //ATStreamSearch options. 11 | 12 | unit ATStreamSearch; 13 | 14 | interface 15 | 16 | uses 17 | Classes, 18 | {$IFDEF REGEX} 19 | DIRegEx, 20 | {$ENDIF} 21 | {$IFDEF TNT} 22 | TntClasses, 23 | {$ENDIF} 24 | atbinhex_encoding, 25 | EncConv, 26 | Math; 27 | 28 | type 29 | TATStreamSearchOption = ( 30 | asoCaseSens, 31 | asoWholeWords, 32 | asoBackward, 33 | {$IFDEF REGEX} asoRegEx, {$ENDIF} 34 | {$IFDEF REGEX} asoRegExMLine, {$ENDIF} 35 | asoShowAll, //ATBinHex only 36 | asoInSelection //ATBinHex only 37 | ); 38 | 39 | TATStreamSearchOptions = set of TATStreamSearchOption; 40 | 41 | TATStreamSearchProgress = procedure( 42 | const ACurrentPos, AMaximalPos: Int64; 43 | var AContinueSearching: Boolean) of object; 44 | 45 | type 46 | 47 | { TATStreamSearch } 48 | 49 | TATStreamSearch = class(TComponent) 50 | private 51 | FSavedEncoding: TEncConvId; 52 | FStream: TStream; 53 | FStreamOwner: Boolean; 54 | FFileName: string; 55 | FStreamStart: Int64; 56 | FStreamSize: Int64; 57 | FFoundStart: Int64; 58 | FFoundLength: Int64; 59 | 60 | FSavStart: Int64; 61 | FSavLen: Int64; 62 | FSavText: string; 63 | FSavOpt: TATStreamsearchoptions; 64 | FSavEnc: TEncConvId; 65 | 66 | {$IFDEF REGEX} 67 | FRegEx: TDIRegExSearchStream_Enc; 68 | {$ENDIF} 69 | FOnProgress: TATStreamSearchProgress; 70 | FCharSize: Integer; 71 | 72 | FSavedText: string; 73 | FSavedTextLen: integer; 74 | FSavedOptions: TATStreamSearchOptions; 75 | //FSearchForValidUTF16: Boolean; 76 | FSavedStartPos: Int64; 77 | FSavedEndPos: Int64; 78 | 79 | procedure FreeStream; 80 | procedure InitSavedOptions; 81 | function InitProgressFields( 82 | const AStartPos: Int64; 83 | AEncoding: TEncConvId): Boolean; 84 | procedure DoProgress( 85 | const ACurrentPos, AMaximalPos: Int64; 86 | var AContinueSearching: Boolean); 87 | procedure SetFileName(const AFileName: string); 88 | procedure SetStream(AStream: TStream); 89 | 90 | {$IFDEF REGEX} 91 | procedure FreeRegex; 92 | procedure InitRegex; 93 | procedure RegexProgress( 94 | const ASender: TDICustomRegExSearch; 95 | const AProgress: Int64; 96 | var AAbort: Boolean); 97 | function RegexFindFirst( 98 | const AText: string; 99 | const AStartPos: Int64; 100 | AEncoding: TATEncoding; 101 | AOptions: TATStreamSearchOptions): Boolean; 102 | function RegexFindNext: Boolean; 103 | {$ENDIF} 104 | 105 | function TextFind( 106 | const AText: string; 107 | const AStartPos, AEndPos: Int64; 108 | AEncoding: TEncConvId; 109 | AOptions: TATStreamSearchOptions): Int64; 110 | function TextFindFirst( 111 | const AText: string; 112 | const AStartPos, AEndPos: Int64; 113 | AEncoding: TEncConvId; 114 | AOptions: TATStreamSearchOptions): Boolean; 115 | 116 | public 117 | constructor Create(AOwner: TComponent); override; 118 | destructor Destroy; override; 119 | procedure SaveOptions; 120 | procedure RestoreOptions; 121 | 122 | property FileName: string read FFileName write SetFileName; 123 | property Stream: TStream read FStream write SetStream; 124 | property SavedText: string read FSavedText; 125 | property SavedEncoding: TEncConvId read FSavedEncoding; 126 | property SavedOptions: TATStreamSearchOptions read FSavedOptions; 127 | property SavedStartPos: Int64 read FSavedStartPos; 128 | property SavedEndPos: Int64 read FSavedEndPos; 129 | 130 | function Find( 131 | const AText: string; 132 | const AStartPos, AEndPos: Int64; 133 | AEncoding: TEncConvId; 134 | ACharSize: integer; 135 | AOptions: TATStreamSearchOptions): Boolean; 136 | 137 | property FoundStart: Int64 read FFoundStart write FFoundStart; 138 | property FoundLength: Int64 read FFoundLength write FFoundLength; 139 | 140 | published 141 | //property SearchForValidUTF16: Boolean read FSearchForValidUTF16 write FSearchForValidUTF16 default False; 142 | property OnProgress: TATStreamSearchProgress read FOnProgress write FOnProgress; 143 | end; 144 | 145 | var 146 | MsgATStreamSearchRegExError: AnsiString = 'Regular expression pattern error:'#13#10#13#10'%s at offset %d'; 147 | MsgATStreamSearchReadError: AnsiString = 'Read error at offset %d'; 148 | 149 | procedure Register; 150 | 151 | implementation 152 | 153 | uses 154 | {$IFDEF REGEX} 155 | DIRegEx_Api, DIRegEx_SearchStream, DIUtils, 156 | {$ENDIF} 157 | SysUtils, atbinhex_strproc; 158 | 159 | { Constants } 160 | 161 | const 162 | cBlockSize = 64 * 1024; 163 | 164 | { Helper functions } 165 | 166 | function BoolToSign(AValue: Boolean): Integer; 167 | begin 168 | if AValue then 169 | Result := 1 170 | else 171 | Result := -1; 172 | end; 173 | 174 | procedure NormalizePos(var APos: Int64; ACharSize: Integer); 175 | begin 176 | if ACharSize <> 1 then 177 | APos := APos div ACharSize * ACharSize; 178 | end; 179 | 180 | function LastPos(const AFileSize: Int64; ACharSize: Integer): Int64; 181 | begin 182 | Result := AFileSize; 183 | NormalizePos(Result, ACharSize); 184 | Dec(Result, ACharSize); 185 | I64LimitMin(Result, 0); 186 | end; 187 | 188 | { TATStreamSearch } 189 | 190 | constructor TATStreamSearch.Create(AOwner: TComponent); 191 | begin 192 | inherited Create(AOwner); 193 | FStream := nil; 194 | FStreamOwner := False; 195 | FFileName := ''; 196 | FStreamStart := -1; 197 | FStreamSize := 0; 198 | FFoundStart := -1; 199 | FFoundLength := 0; 200 | //FSearchForValidUTF16 := False; 201 | 202 | {$IFDEF REGEX} 203 | FRegEx := nil; 204 | {$ENDIF} 205 | 206 | FOnProgress := nil; 207 | FCharSize:= 1; 208 | InitSavedOptions; 209 | end; 210 | 211 | destructor TATStreamSearch.Destroy; 212 | begin 213 | FreeStream; 214 | {$IFDEF REGEX} 215 | FreeRegex; 216 | {$ENDIF} 217 | inherited; 218 | end; 219 | 220 | procedure TATStreamSearch.FreeStream; 221 | begin 222 | if FStreamOwner then 223 | if Assigned(FStream) then 224 | FreeAndNil(FStream); 225 | end; 226 | 227 | procedure TATStreamSearch.InitSavedOptions; 228 | begin 229 | FSavedText := ''; 230 | FSavedTextLen := 0; 231 | FSavedEncoding := eidCP1252; 232 | FSavedOptions := []; 233 | FSavedStartPos := 0; 234 | FSavedEndPos := High(Int64); 235 | end; 236 | 237 | procedure TATStreamSearch.SetFileName(const AFileName: string); 238 | begin 239 | FreeStream; 240 | 241 | if AFileName <> '' then 242 | begin 243 | InitSavedOptions; 244 | FFileName := AFileName; 245 | FStreamOwner := True; 246 | FStream := {$IFDEF TNT}TTntFileStream{$ELSE}TFileStream{$ENDIF}.Create( 247 | AFileName, fmOpenRead or fmShareDenyNone); 248 | end; 249 | end; 250 | 251 | procedure TATStreamSearch.SetStream(AStream: TStream); 252 | begin 253 | FreeStream; 254 | InitSavedOptions; 255 | FFileName := ''; 256 | FStreamOwner := False; 257 | FStream := AStream; 258 | end; 259 | 260 | function TATStreamSearch.InitProgressFields(const AStartPos: Int64; 261 | AEncoding: TEncConvId): Boolean; 262 | begin 263 | Assert(Assigned(FStream)); 264 | FStreamStart := AStartPos; 265 | FStreamSize := FStream.Size; 266 | Result := FStreamSize >= FCharSize; 267 | end; 268 | 269 | procedure TATStreamSearch.DoProgress( 270 | const ACurrentPos, AMaximalPos: Int64; 271 | var AContinueSearching: Boolean); 272 | begin 273 | AContinueSearching := True; 274 | 275 | if Assigned(FOnProgress) then 276 | FOnProgress(ACurrentPos, AMaximalPos, AContinueSearching); 277 | end; 278 | 279 | //----------------------------------------------------------------- 280 | // RegEx-related code 281 | 282 | {$IFDEF REGEX} 283 | 284 | procedure TATStreamSearch.FreeRegex; 285 | begin 286 | if Assigned(FRegEx) then 287 | FreeAndNil(FRegEx); 288 | end; 289 | 290 | procedure TATStreamSearch.InitRegex; 291 | begin 292 | if not Assigned(FRegEx) then 293 | begin 294 | FRegEx := TDIRegExSearchStream_Enc.Create(Self); 295 | FRegEx.MatchOptions := FRegEx.MatchOptions - [moNotEmpty]; 296 | FRegEx.OnProgress := RegexProgress; 297 | end; 298 | end; 299 | 300 | procedure TATStreamSearch.RegexProgress( 301 | const ASender: TDICustomRegExSearch; 302 | const AProgress: Int64; 303 | var AAbort: Boolean); 304 | var 305 | ContinueSearching: Boolean; 306 | begin 307 | ContinueSearching := True; 308 | DoProgress( 309 | FStreamStart + AProgress, 310 | FStreamSize, 311 | ContinueSearching); 312 | if not ContinueSearching then 313 | AAbort := True; 314 | end; 315 | 316 | function TATStreamSearch.RegexFindFirst( 317 | const AText: string; 318 | const AStartPos: Int64; 319 | AEncoding: TATEncoding; 320 | AOptions: TATStreamSearchOptions): Boolean; 321 | var 322 | RealText: AnsiString; 323 | begin 324 | Result := False; 325 | if AText = '' then Exit; 326 | 327 | //1. Prepare objects and fields 328 | 329 | InitRegex; 330 | 331 | Assert(Assigned(FRegEx), 'RegEx object not initialized'); 332 | Assert(Assigned(FStream), 'Stream object not initialized'); 333 | 334 | if not InitProgressFields(AStartPos, AEncoding) then Exit; 335 | 336 | FStream.Position := AStartPos; 337 | 338 | //2. Prepare RegEx object 339 | 340 | if asoCaseSens in AOptions then 341 | FRegEx.CompileOptions := FRegEx.CompileOptions - [coCaseLess] 342 | else 343 | FRegEx.CompileOptions := FRegEx.CompileOptions + [coCaseLess]; 344 | 345 | if asoRegExMLine in AOptions then 346 | FRegEx.CompileOptions := FRegEx.CompileOptions + [coDotAll] 347 | else 348 | FRegEx.CompileOptions := FRegEx.CompileOptions - [coDotAll]; 349 | 350 | RealText := StrEncodeUtf8(AText); 351 | 352 | if asoWholeWords in AOptions then 353 | begin 354 | //If "Whole Words" option is used, we first need to check 355 | //validity of original regex: 356 | if not FRegEx.CompileMatchPatternStr(RealText) then 357 | begin 358 | raise Exception.Create(Format(MsgATStreamSearchRegExError, 359 | [FRegEx.ErrorMessage, FRegEx.ErrorOffset])); 360 | Exit; 361 | end; 362 | //If it's OK we append '\b...\b' and compile regex again: 363 | RealText := '\b' + RealText + '\b'; 364 | end; 365 | 366 | if not FRegEx.CompileMatchPatternStr(RealText) then 367 | begin 368 | raise Exception.Create(Format(MsgATStreamSearchRegExError, 369 | [FRegEx.ErrorMessage, FRegEx.ErrorOffset])); 370 | Exit; 371 | end; 372 | 373 | case AEncoding of 374 | vencANSI: 375 | FRegEx.SearchInitEnc(FStream, ansi_mbtowc); 376 | vencOEM: 377 | FRegEx.SearchInitEnc(FStream, oem_mbtowc); 378 | vencUnicodeLE: 379 | begin 380 | {if FSearchForValidUTF16 then 381 | FRegex.SearchInitEnc(FStream, utf16le_mbtowc) 382 | else} 383 | FRegEx.SearchInitEnc(FStream, binary16le_mbtowc); 384 | end; 385 | vencUnicodeBE: 386 | begin 387 | {if FSearchForValidUTF16 then 388 | FRegex.SearchInitEnc(FStream, utf16be_mbtowc) 389 | else} 390 | FRegEx.SearchInitEnc(FStream, binary16be_mbtowc); 391 | end; 392 | else 393 | Assert(False, 'Unknown encoding specified'); 394 | end; 395 | 396 | //3. Search 397 | 398 | Result := RegexFindNext; 399 | end; 400 | 401 | function TATStreamSearch.RegexFindNext: Boolean; 402 | var 403 | DummyStart, DummyLength, 404 | MatchStart, MatchLength: Int64; 405 | begin 406 | Assert(Assigned(FRegEx), 'RegEx object not initialized'); 407 | Assert(Assigned(FStream), 'Stream object not initialized'); 408 | 409 | Result := FRegEx.SearchNext( 410 | DummyStart, DummyLength, 411 | MatchStart, MatchLength) >= 0; 412 | 413 | if Result then 414 | begin 415 | FFoundStart := FStreamStart + MatchStart * FCharSize; 416 | FFoundLength := MatchLength * FCharSize; 417 | end 418 | else 419 | begin 420 | FFoundStart := -1; 421 | FFoundLength := 0; 422 | end; 423 | end; 424 | 425 | {$ENDIF} 426 | 427 | //----------------------------------------------------------------- 428 | // Plain search code 429 | 430 | function TATStreamSearch.TextFind( 431 | const AText: string; 432 | const AStartPos, AEndPos: Int64; 433 | AEncoding: TEncConvId; 434 | AOptions: TATStreamSearchOptions): Int64; 435 | var 436 | Buffer: array[0 .. cBlockSize - 1] of char; 437 | BufPosMin, BufPosMax, TotalMax, BufPos, ReadPos: Int64; 438 | ReadSize, BytesRead: DWORD; 439 | SBufferA: string; 440 | SBufferW: UnicodeString; 441 | TextInCodepage: string; 442 | StringPos: Integer; 443 | bForward, bWholeWords, bCaseSens, bContinue: Boolean; 444 | begin 445 | Result := -1; 446 | 447 | if AText = '' then Exit; 448 | 449 | //1. Init objects and fields 450 | 451 | Assert(Assigned(FStream), 'Stream object not initialized'); 452 | 453 | if not InitProgressFields(AStartPos, AEncoding) then Exit; 454 | 455 | //2. Init variables 456 | 457 | bForward := not (asoBackward in AOptions); 458 | bWholeWords := asoWholeWords in AOptions; 459 | bCaseSens := asoCaseSens in AOptions; 460 | 461 | BufPosMin := Min(AStartPos, AEndPos); 462 | BufPosMax := Max(AStartPos, AEndPos); 463 | 464 | TotalMax := LastPos(FStreamSize, FCharSize); 465 | NormalizePos(TotalMax, FCharSize); 466 | if BufPosMax > TotalMax then 467 | BufPosMax := TotalMax; 468 | 469 | BufPos := AStartPos; 470 | NormalizePos(BufPos, FCharSize); 471 | NormalizePos(BufPosMin, FCharSize); 472 | NormalizePos(BufPosMax, FCharSize); 473 | 474 | if FCharSize=1 then 475 | TextInCodepage:= SCodepageFromUTF8(AText, AEncoding) 476 | else 477 | TextInCodepage:= ''; 478 | 479 | if BufPos > BufPosMax then 480 | begin 481 | if bForward then 482 | Exit 483 | else 484 | BufPos := BufPosMax; 485 | end; 486 | 487 | if BufPos < BufPosMin then 488 | begin 489 | if bForward then 490 | BufPos := BufPosMin 491 | else 492 | Exit; 493 | end; 494 | 495 | //3. Search 496 | 497 | bContinue := True; 498 | DoProgress(BufPos, FStreamSize, bContinue); 499 | if not bContinue then Exit; 500 | 501 | repeat 502 | ReadPos := BufPos; 503 | ReadSize := cBlockSize; 504 | 505 | if not bForward then 506 | begin 507 | Dec(ReadPos, cBlockSize - FCharSize); 508 | I64LimitMin(ReadPos, 0); 509 | 510 | ReadSize := BufPos - ReadPos + FCharSize; 511 | if ReadSize > cBlockSize then 512 | ReadSize := cBlockSize; 513 | end 514 | else 515 | begin 516 | // do not find after AEndPos 517 | ReadSize := Min(Int64(ReadSize), AEndPos - ReadPos); 518 | if ReadSize <= 0 then Exit; 519 | end; 520 | 521 | try 522 | FillChar(Buffer, SizeOf(Buffer), 0); 523 | FStream.Position := ReadPos; 524 | BytesRead := FStream.Read(Buffer, ReadSize); 525 | except 526 | raise Exception.Create(Format(MsgATStreamSearchReadError, [ReadPos])); 527 | Exit; 528 | end; 529 | 530 | if FCharSize = 2 then 531 | begin 532 | SBufferW := SetStringW(@Buffer, BytesRead, false); 533 | StringPos := SFindTextW(AText, SBufferW, bForward, bWholeWords, bCaseSens, BytesRead < cBlockSize); 534 | end 535 | else 536 | begin 537 | SetString(SBufferA, Buffer, BytesRead); 538 | StringPos := SFindText(TextInCodepage, SBufferA, bForward, bWholeWords, bCaseSens, BytesRead < cBlockSize); 539 | end; 540 | 541 | if StringPos > 0 then 542 | begin 543 | Result := ReadPos + (StringPos - 1) * FCharSize; 544 | Exit 545 | end; 546 | 547 | bContinue := True; 548 | DoProgress(BufPos, FStreamSize, bContinue); 549 | if not bContinue then Exit; 550 | 551 | Inc(BufPos, Int64(ReadSize) * BoolToSign(bForward)); 552 | Dec(BufPos, Int64(Length(AText) + 1) * FCharSize * BoolToSign(bForward)); 553 | NormalizePos(BufPos, FCharSize); 554 | 555 | if bForward then 556 | begin 557 | if BufPos > BufPosMax then Exit; 558 | end 559 | else 560 | begin 561 | if BufPos < BufPosMin then Exit; 562 | end; 563 | 564 | until BytesRead < cBlockSize; 565 | end; 566 | 567 | function TATStreamSearch.TextFindFirst( 568 | const AText: string; 569 | const AStartPos, AEndPos: Int64; 570 | AEncoding: TEncConvId; 571 | AOptions: TATStreamSearchOptions): Boolean; 572 | begin 573 | FFoundStart := TextFind(AText, AStartPos, AEndPos, AEncoding, AOptions); 574 | Result := FFoundStart >= 0; 575 | 576 | if Result then 577 | FFoundLength := FSavedTextLen 578 | else 579 | FFoundLength := 0; 580 | end; 581 | 582 | 583 | //----------------------------------------------------------------- 584 | // Combined search code 585 | 586 | function TATStreamSearch.Find( 587 | const AText: string; 588 | const AStartPos, AEndPos: Int64; 589 | AEncoding: TEncConvId; 590 | ACharSize: integer; 591 | AOptions: TATStreamSearchOptions): Boolean; 592 | begin 593 | InitSavedOptions; 594 | 595 | FSavedText := AText; 596 | if ACharSize=1 then 597 | FSavedTextLen := Length(SCodepageFromUTF8(AText, AEncoding)) 598 | else 599 | FSavedTextLen := Length(AText) * ACharSize; 600 | 601 | FSavedEncoding := AEncoding; 602 | FSavedOptions := AOptions; 603 | FSavedStartPos := AStartPos; 604 | FSavedEndPos := AEndPos; 605 | FCharSize := ACharSize; 606 | 607 | {$IFDEF REGEX} 608 | if asoRegEx in AOptions then 609 | begin 610 | Assert(not (asoBackward in AOptions), 'Backward search not supported for Regex'); 611 | Result := RegexFindFirst(AText, AStartPos, AEncoding, AOptions); 612 | end 613 | else 614 | {$ENDIF} 615 | Result := TextFindFirst(AText, AStartPos, AEndPos, AEncoding, AOptions); 616 | end; 617 | 618 | procedure TATStreamSearch.SaveOptions; 619 | begin 620 | FSavStart := FFoundStart; 621 | FSavLen := FFoundLength; 622 | FSavEnc := FSavedEncoding; 623 | FSavText := FSavedText; 624 | FSavOpt := FSavedOptions; 625 | end; 626 | 627 | procedure TATStreamSearch.RestoreOptions; 628 | begin 629 | if FSavText = '' then Exit; 630 | FFoundStart := FSavStart; 631 | FFoundLength := FSavLen; 632 | FSavedEncoding := FSavEnc; 633 | FSavedText := FSavText; 634 | FSavedOptions := FSavOpt; 635 | InitProgressFields(FFoundStart, FSavedEncoding); 636 | end; 637 | 638 | 639 | { Registration } 640 | 641 | procedure Register; 642 | begin 643 | RegisterComponents('Samples', [TATStreamSearch]); 644 | end; 645 | 646 | end. 647 | --------------------------------------------------------------------------------