{
   Component ViewerControl (Free Pascal)
   show file in text (wraped or not) or bin or hex mode

   This is part of Seksi Commander

   To searching use uFindMmap,
   to movement call Upxxxx, Downxxxx, or set Position

   Realised under GNU GPL 2
   author Radek Cervinka (radek.cervinka@centrum.cz)

   changes:
   5.7. (RC)
     - selecting text with mouse
     - CopyToclipBoard, SelectAll
   ?.6. - LoadFromStdIn and loading first 64Kb of files with size=0 :) (/proc fs ..)
   17.6. (RC)
     - mapfile (in error set FMappedFile=nil)
     - writetext TABs fixed (tab is replaced by 9 spaces)
     - set correct position for modes hex, bin (SetPosition)
   21.7
     - wrap text on 80 character lines works better now (by Radek Polak)
     - problems with function UpLine for specific lines:
       (lines of 80(=cTextWidth) character ended with ENTER (=#10)
   6.2. (RC)
     - ported to fpc for linux (CustomControl and gtk)
   7.2. (RC)
     - use temp to new implementation of LoadFromStdIn (and mmap temp file)
     - faster drawing of text (I hope)

   contributors:

   Copyright (C) 2006-2013 Alexander Koblov (alexx2000@mail.ru)


   TODO:
   a) File mapping blocks writing into file by other processes.
      Either:
      + Open small text files by reading them all into memory (done).
      - Change file mapping to custom loading/caching portions of file in memory
        and only reading from file when neccessary.

   b) Searching in Unicode encodings and case-insensitive searching.

   c) Selecting text does not work well with composed Unicode characters
      (characters that are composed of multiple Unicode characters).

   d) Drawing/selecting text does not work correctly with RTL (right to left) text.

   e) FTextHeight is unreliable with complex unicode characters. It should be
      calculated based on currently displayed text (get max from each line's height).

}

unit ViewerControl;

{$mode objfpc}{$H+}

interface

uses
  SysUtils, Classes, Controls, StdCtrls, fgl;

const
  MaxMemSize = $400000; // 4 Mb

type
  TViewerMode = (vmBin, vmHex, vmText, vmWrap, vmBook);
  TDataAccess = (dtMmap, dtNothing);
  TCharSide = (csBefore, csLeft, csRight, csAfter);

  TPtrIntList = specialize TFPGList<PtrInt>;

  TGuessEncodingEvent = function(const s: string): string;

type
  // If additional encodings are added they should be also supported by:
  // - GetNextCharAsAscii
  // - GetPrevCharAsAscii
  // - GetNextCharAsUtf8
  // - ConvertToUTF8
  // - UpdateSelection
  TViewerEncoding = (veAutoDetect,
                     veUtf8,
                     veUtf8bom,
                     veAnsi,
                     veCp1250,
                     veCp1251,
                     veCp1252,
                     veCp1253,
                     veCp1254,
                     veCp1255,
                     veCp1256,
                     veCp1257,
                     veCp1258,
                     veCp437,
                     veCp850,
                     veCp852,
                     veCp866,
                     veCp874,
                     veCp932,
                     veCp936,
                     veCp949,
                     veCp950,
                     veIso88591,
                     veIso88592,
                     veKoi8,
                     veUcs2le,
                     veUcs2be,
                     veUtf16le,
                     veUtf16be,
                     veUtf32le,  // = ucs4le
                     veUtf32be); // = ucs4be

const
  ViewerEncodingsNames: array [TViewerEncoding] of string =
                   ('Auto-detect',
                    'UTF-8',
                    'UTF-8BOM',
                    'Ansi',
                    'CP1250',
                    'CP1251',
                    'CP1252',
                    'CP1253',
                    'CP1254',
                    'CP1255',
                    'CP1256',
                    'CP1257',
                    'CP1258',
                    'CP437',
                    'CP850',
                    'CP852',
                    'CP866',
                    'CP874',
                    'CP932',
                    'CP936',
                    'CP949',
                    'CP950',
                    'ISO-8859-1',
                    'ISO-8859-2',
                    'KOI-8',
                    'UCS-2LE',
                    'UCS-2BE',
                    'UTF-16LE',
                    'UTF-16BE',
                    'UTF-32LE',
                    'UTF-32BE');

type

  { TViewerControl }

  TViewerControl = class(TCustomControl)
  private
    FEncoding:           TViewerEncoding;
    FViewerMode:         TViewerMode;
    FFileName:           UTF8String;
    FFileHandle:         THandle;
    FFileSize:           Int64;
    FMappingHandle:      THandle;
    FMappedFile:         Pointer;
    FPosition:           PtrInt;
    FHPosition:          Integer;  // Tab for text during horizontal scroll
    FHLowEnd:            Integer;  // End for HPosition (string with max char)
    FVisibleOffset:      PtrInt;   // Offset in symbols for current line (see IsVisible and MakeVisible)
    FLowLimit:           PtrInt;   // Lowest possible value for Position
    FHighLimit:          PtrInt;   // Position cannot reach this value
    FBOMLength:          Integer;
    FLineList:           TPtrIntList;
    FBlockBeg:           PtrInt;
    FBlockEnd:           PtrInt;
    FMouseBlockBeg:      PtrInt;
    FMouseBlockSide:     TCharSide;
    FSelecting:          Boolean;
    FTextWidth: 	 Integer; // max char count or width in window
    FTextHeight:         Integer; // measured values of font, rec calc at font changed
    FScrollBarVert:      TScrollBar;
    FScrollBarHorz:      TScrollBar;
    FOnPositionChanged:  TNotifyEvent;
    FUpdateScrollBarPos: Boolean; // used to block updating of scrollbar
    FScrollBarPosition:  Integer;  // for updating vertical scrollbar based on Position
    FHScrollBarPosition: Integer;  // for updating horizontal scrollbar based on HPosition
    FColCount:           Integer;
    FOnGuessEncoding:    TGuessEncodingEvent;

    function GetPercent: Integer;
    procedure SetPercent(const AValue: Integer);
    procedure SetBlockBegin(const AValue: PtrInt);
    procedure SetBlockEnd(const AValue: PtrInt);
    procedure SetPosition(Value: PtrInt);
    procedure SetHPosition(Value: Integer);
    procedure SetPosition(Value: PtrInt; Force: Boolean); overload;
    procedure SetHPosition(Value: Integer; Force: Boolean); overload;
    procedure SetEncoding(AEncoding: TViewerEncoding);
    function GetEncodingName: string;
    procedure SetEncodingName(AEncodingName: string);
    procedure SetViewerMode(Value: TViewerMode);
    procedure SetColCount(const AValue: Integer);

    {en
       Returns how many lines (given current FTextHeight) will fit into the window.
    }
    function GetClientHeightInLines: Integer; inline;

    {en
       Calculates how many lines can be displayed from given position.
       @param(FromPosition
              Position from which to check. It should point to a start of a line.)
       @param(LastLineReached
              If it is set to @true when the function returns, then the last
              line of text was reached when scanning.
              This means that there are no more lines to be displayed other than
              the ones scanned from FromPosition. In other words:
                SetPosition(GetStartOfNextLine(FromPosition)) will be one line
                too many and will be scrolled back.)
    }
    function GetLinesTillEnd(FromPosition: PtrInt; out LastLineReached: Boolean): Integer;

    function GetBomLength: Integer;

    procedure UpdateLimits;

    {en
       @param(iStartPos
              Should point to start of a line.
              It is increased by the amount of parsed data (with line endings).)
       @param(aLimit
              Position which cannot be reached while reading from file.)
       @param(DataLength
              It is length in bytes of parsed data without any line endings.
              iStartPos is moved beyond the line endings though.)
    }
    function CalcTextLineLength(var iStartPos: PtrInt; const aLimit: Int64; out DataLength: PtrInt): Integer;

    function GetStartOfLine(aPosition: PtrInt): PtrInt;
    function GetEndOfLine(aPosition: PtrInt): PtrInt;

    function GetStartOfPrevLine(aPosition: PtrInt): PtrInt;
    function GetStartOfNextLine(aPosition: PtrInt): PtrInt;

    {en
       Changes the value of aPosition to X lines back or forward.
       @param(aPosition
              File position to change.)
       @param(iLines
              Nr of lines to scroll.
              If positive the position is increased by iLines lines,
              if negative the position is decreased by -iLines lines.)
    }
    function ScrollPosition(var aPosition: PtrInt; iLines: Integer): Boolean;

    {en
       Calculates (x,y) cursor position to a position within file.
       @param(x
              Client X coordinate of mouse cursor.)
       @param(y
              Client Y coordinate of mouse cursor.)
       @param(CharSide
              To which side of a character at returned position the (x,y) points to.
              Only valid if returned position is not -1.)
       @returns(Position in file to which (x,y) points to, based on what is
                currently displayed.
                Returns -1 if (x,y) doesn't point to any position (outside of
                the text for example).)
    }
    function XYPos2Adr(x, y: Integer; out CharSide: TCharSide): PtrInt;

    procedure OutText(x, y: Integer; StartPos: PtrInt; DataLength: Integer);
    procedure OutHex(x, y: Integer; sText: string; StartPos: PtrInt; DataLength: Integer);
    procedure OutBin(x, y: Integer; sText: string; StartPos: PtrInt; DataLength: Integer);
    procedure WriteText;
    procedure WriteHex;
    procedure WriteBin;
    function TransformText(const sText: UTF8String; const Xoffset: Integer): UTF8String;
    function TransformHex(var aPosition: PtrInt; aLimit: PtrInt): AnsiString;
    function TransformBin(var aPosition: PtrInt; aLimit: PtrInt): AnsiString;

    procedure AddLineOffset(iOffset: PtrInt); inline;

    function MapFile(const sFileName: UTF8String): Boolean;
    procedure UnMapFile;
    procedure SetFileName(const sFileName: UTF8String);

    procedure UpdateScrollbars;

    procedure ViewerResize(Sender: TObject);

    {en
       Returns next unicode character from the file, depending on Encoding.
       It is a faster version, which does as little conversion as possible,
       but only Ascii values are guaranteed to be valid (0-127).
       Other unicode values may/may not be valid, so shouldn't be tested.
       This function is used for reading pure ascii characters such as
       line endings, tabs, white spaces, etc.
    }
    function GetNextCharAsAscii(const iPosition: PtrInt; out CharLenInBytes: Integer): Cardinal;
    function GetPrevCharAsAscii(const iPosition: PtrInt; out CharLenInBytes: Integer): Cardinal;

    {en
       Retrieve next character from the file depending on encoding and
       automatically convert it to UTF-8.
       If CharLenInBytes is greater than 0 but the result is an empty string
       then it's possible there was no appropriate UTF-8 character for the
       next character of the current encoding.
    }
    function GetNextCharAsUtf8(const iPosition: PtrInt; out CharLenInBytes: Integer): UTF8String;

    procedure ReReadFile;
    function IsFileOpen: Boolean; inline;

    {en
       Searches for an ASCII character.
       @param(aPosition
              Position from where the search starts.)
       @param(aMaxBytes
              How many bytes are available for reading.)
       @param(AsciiChars
              The function searches for any character that this string contains.)
       @param(bFindNotIn
              If @true searches for first character not included in AsciiChars.
              If @false searches for first character included in AsciiChars.)
    }
    function FindAsciiSetForward(aPosition, aMaxBytes: PtrInt;
                                 const AsciiChars: String;
                                 bFindNotIn: Boolean): PtrInt;

    {en
       Same as FindForward but it searches backwards from pAdr.
       aMaxBytes must be number of available bytes for reading backwards from pAdr.
    }
    function FindAsciiSetBackward(aPosition, aMaxBytes: PtrInt;
                                  const AsciiChars: String;
                                  bFindNotIn: Boolean): PtrInt;

    {en
       Checks if current selection is still valid given current viewer mode and encoding.
       For example checks if selection is not in the middle of a unicode character.
    }
    procedure UpdateSelection;

    procedure ScrollBarVertScroll(Sender: TObject; ScrollCode: TScrollCode;
      var ScrollPos: Integer);
    procedure ScrollBarHorzScroll(Sender: TObject; ScrollCode: TScrollCode;
      var ScrollPos: Integer);

    function GetText(const StartPos, Len: PtrInt; const Xoffset: Integer): string;

  protected
    procedure KeyDown(var Key: word; Shift: TShiftState); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override;
    function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override;

  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure Paint; override;

    {en
       Scrolls the displayed text in the window.

       @param(iLines
              Nr of lines to scroll.
              If positive the text is scrolled downwards,
              if negative the text is scrolled upwards.)
       @returns(@true if the text was scrolled.)
    }
    function Scroll(iLines: Integer): Boolean;
    function HScroll(iSymbols: Integer): Boolean;

    procedure PageUp;
    procedure PageDown;
    procedure GoHome;
    procedure GoEnd;

    procedure HPageUp;
    procedure HPageDown;
    procedure HGoHome;
    procedure HGoEnd;

    function GetDataAdr: Pointer;

    procedure SelectAll;
    procedure SelectText(AStart, AEnd: PtrInt);
    procedure CopyToClipboard;

    function IsVisible(const aPosition: PtrInt): Boolean; overload;
    procedure MakeVisible(const aPosition: PtrInt);

    function ConvertToUTF8(const sText: AnsiString): UTF8String;
    function ConvertFromUTF8(const sText: UTF8String): AnsiString;

    function DetectEncoding: TViewerEncoding;

    procedure GetSupportedEncodings(List: TStrings);

    property Percent: Integer Read GetPercent Write SetPercent;
    property Position: PtrInt Read FPosition Write SetPosition;
    property FileSize: Int64 Read FFileSize;
    property SelectionStart: PtrInt Read FBlockBeg Write SetBlockBegin;
    property SelectionEnd: PtrInt Read FBlockEnd Write SetBlockEnd;
    property EncodingName: string Read GetEncodingName Write SetEncodingName;
    property ColCount: Integer Read FColCount Write SetColCount;
    property OnGuessEncoding: TGuessEncodingEvent Read FOnGuessEncoding Write FOnGuessEncoding;

  published
    property ViewerMode: TViewerMode Read FViewerMode Write SetViewerMode default vmWrap;
    property FileName: UTF8String Read FFileName Write SetFileName;
    property Encoding: TViewerEncoding Read FEncoding Write SetEncoding default veAutoDetect;
    property OnPositionChanged: TNotifyEvent Read FOnPositionChanged Write FOnPositionChanged;

    property OnClick;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property Align;
    property Color;
    property Cursor default crIBeam;
    property Font;
    property ParentColor default False;
    property TabStop default True;
  end;

procedure Register;

implementation

uses
  LCLType, LCLVersion, Graphics, Forms, LCLProc, Clipbrd, LConvEncoding,
  UnicodeUtils, LCLIntf
  {$IF DEFINED(UNIX)}
  , BaseUnix, Unix
  {$ELSEIF DEFINED(WINDOWS)}
  , Windows
  {$ENDIF};

const
  //cTextWidth      = 80;  // wrap on 80 chars
  cBinWidth       = 80;
  cMaxTextWidth   = 65535; // maximum of chars on one line unwrapped text
  cHexWidth       = 16;
  cTabSpaces      = 8;   // tab stop - allow to set in settings
  cHexOffsetWidth = 8;
  cHexStartHex    = cHexOffsetWidth + 2;  // ': '
  cHexEndHex      = cHexStartHex + (cHexWidth * 3);
  cHexStartAscii  = cHexStartHex + (cHexWidth * 3) + 2;  // '  '

  // These strings must be Ascii only.
  sNonCharacter: string = ' !"#$%&''()*+,-./:;<=>?@[\]^`{|}~'#13#10#9;
  sWhiteSpace  : string = ' '#13#10#9#8;

// ----------------------------------------------------------------------------

constructor TViewerControl.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Cursor := crIBeam;
  ParentColor := False;
  DoubleBuffered := True;
  ControlStyle := ControlStyle + [csTripleClicks, csOpaque];
  TabStop := True; // so that it can get keyboard focus

  FEncoding := veAutoDetect;
  FViewerMode := vmText;
  FFileName := '';
  FMappedFile := nil;
  FFileHandle := 0;
  FMappingHandle := 0;
  FPosition := 0;
  FHPosition := 0;
  FHLowEnd := 0;
  FLowLimit := 0;
  FHighLimit := 0;
  FBOMLength := 0;
  FTextHeight := 14; // dummy value
  FColCount := 1;

  FLineList := TPtrIntList.Create;

  FScrollBarVert          := TScrollBar.Create(Self);
  FScrollBarVert.Parent   := Self;
  FScrollBarVert.Kind     := sbVertical;
  FScrollBarVert.Align    := alRight;
  FScrollBarVert.OnScroll := @ScrollBarVertScroll;
  FScrollBarVert.TabStop  := False;
  FScrollBarVert.PageSize := 0;

  FScrollBarHorz          := TScrollBar.Create(Self);
  FScrollBarHorz.Parent   := Self;
  FScrollBarHorz.Kind     := sbHorizontal;
  FScrollBarHorz.Align    := alBottom;
  FScrollBarHorz.OnScroll := @ScrollBarHorzScroll;
  FScrollBarHorz.TabStop  := False;
  FScrollBarHorz.PageSize := 0;

  FUpdateScrollBarPos := True;
  FScrollBarPosition  := 0;
  FHScrollBarPosition := 0;

  FOnPositionChanged := nil;
  FOnGuessEncoding   := nil;

  OnResize := @ViewerResize;
end;

destructor TViewerControl.Destroy;
begin
  UnMapFile;

  if Assigned(FLineList) then
    FreeAndNil(FLineList);

  inherited Destroy;
end;

procedure TViewerControl.Paint;
begin
  if not IsFileOpen then
    Exit;

  Canvas.Font := Self.Font;
  Canvas.Brush.Color := Self.Color;
  {$IF DEFINED(LCLQT) and (LCL_FULLVERSION < 093100)}
  Canvas.Brush.Style := bsSolid;
  Canvas.FillRect(ClientRect);
  {$ENDIF}
  Canvas.Brush.Style := bsClear;
  FTextHeight := Canvas.TextHeight('Wg') + 2;

  if FViewerMode = vmBook then
    FTextWidth := ((ClientWidth - (Canvas.TextWidth('W') * FColCount)) div FColCount)
  else
    FTextWidth := ClientWidth  div Canvas.TextWidth('W') - 2;

  FLineList.Clear;

  case FViewerMode of
    vmBin : WriteBin;
    vmHex : WriteHex;
    vmText: WriteText;
    vmWrap: WriteText;
    vmBook: WriteText;
  end;
end;

procedure TViewerControl.SetViewerMode(Value: TViewerMode);
begin
  if not (csDesigning in ComponentState) then
  begin
    FLineList.Clear; // do not use cache from previous mode

    // Take limits into account for selection.
    FBlockBeg := FBlockBeg + (GetDataAdr - FMappedFile);
    FBlockEnd := FBlockEnd + (GetDataAdr - FMappedFile);

    FViewerMode := Value;

    FHPosition := 0;
    FBOMLength := GetBomLength;
    UpdateLimits;

    // Take limits into account for selection.
    FBlockBeg := FBlockBeg - (GetDataAdr - FMappedFile);
    FBlockEnd := FBlockEnd - (GetDataAdr - FMappedFile);

    UpdateSelection;

    // Force recalculating position.
    SetPosition(FPosition, True);
    SetHPosition(FHPosition, True);

    UpdateScrollbars;
    Invalidate;
  end
  else
    FViewerMode := Value;
end;

procedure TViewerControl.SetColCount(const AValue: Integer);
begin
  if AValue > 0 then FColCount := AValue
    else FColCount := 1;
end;

function TViewerControl.ScrollPosition(var aPosition: PtrInt; iLines: Integer): Boolean;
var
  i:      Integer;
  NewPos: PtrInt;
begin
  Result := False;
  NewPos := aPosition;
  if iLines < 0 then
    for i := 1 to -iLines do
      NewPos := GetStartOfPrevLine(NewPos)
  else
    for i := 1 to iLines do
      NewPos := GetStartOfNextLine(NewPos);

  Result    := aPosition <> NewPos;
  aPosition := NewPos;
end;

function TViewerControl.Scroll(iLines: Integer): Boolean;
var
  aPosition: PtrInt;
begin
  aPosition := FPosition;
  Result := ScrollPosition(aPosition, iLines);
  if aPosition <> FPosition then
    SetPosition(aPosition);
end;

function TViewerControl.HScroll(iSymbols: Integer): Boolean;
var
  newPos: integer;
begin
  newPos := FHPosition;
  if (FHLowEnd - FTextWidth) > 0 then
    begin
      newPos := newPos+ iSymbols;
      if newPos < 0 then newPos := 0;
      if newPos > FHLowEnd-FTextWidth then newPos := FHLowEnd-FTextWidth;
    end;
  if newPos <> FHPosition then
    SetHPosition(newPos);
end;

function TViewerControl.GetText(const StartPos, Len: PtrInt; const Xoffset: Integer): string;
begin
  SetString(Result, GetDataAdr + StartPos, Len);
  Result := TransformText(ConvertToUTF8(Result), Xoffset);
end;

function TViewerControl.CalcTextLineLength(var iStartPos: PtrInt; const aLimit: Int64; out DataLength: PtrInt): Integer;
var
  MaxLineLength: Boolean;
  CharLenInBytes: Integer;
  OldPos, LastSpacePos: PtrInt;
  LastSpaceResult: Integer;
begin
  Result := 0;
  DataLength := 0;
  LastSpacePos := -1;
  MaxLineLength := True;
  OldPos := iStartPos;

  while MaxLineLength and (iStartPos < aLimit) do
  begin
    case GetNextCharAsAscii(iStartPos, CharLenInBytes) of
      9:             // tab
        Inc(Result, cTabSpaces - Result mod cTabSpaces);
      10:            // stroka
        begin
          DataLength := iStartPos - OldPos;
          iStartPos := iStartPos + CharLenInBytes;
          Exit;
        end;
      13:             // karetka
        begin
          DataLength := iStartPos - OldPos;
          iStartPos := iStartPos + CharLenInBytes;
          // Move after possible #10.
          if (iStartPos < aLimit) and (GetNextCharAsAscii(iStartPos, CharLenInBytes) = 10) then
            Inc(iStartPos, CharLenInBytes);
          Exit;
        end;
      32, 33, 40, 41, 44, 45, 46, 47, 92, 58, 59, 63, 91, 93:              //probel
        begin
          Inc(Result, 1);
          LastSpacePos := iStartPos + CharLenInBytes;
          LastSpaceResult := Result;
        end;
      else
        Inc(Result, 1);
    end;

    if CharLenInBytes = 0 then  // End of data or invalid character.
      break;

    iStartPos := iStartPos + CharLenInBytes;
    DataLength := iStartPos - OldPos;
    case FViewerMode of
    vmText:   MaxLineLength := Result < cMaxTextWidth;
    vmWrap:   MaxLineLength := Result < FTextWidth;
    vmBook:   MaxLineLength := Canvas.TextWidth(GetText(OldPos, DataLength, 0)) < FTextWidth;
    else
      Exit;
    end;
  end;

  if (not MaxLineLength) and (LastSpacePos <> -1) then
  begin
    iStartPos := LastSpacePos;
    Result := LastSpaceResult;
    DataLength := iStartPos - OldPos;
  end;
end;

function TViewerControl.TransformText(const sText: UTF8String; const Xoffset: Integer): UTF8String;
var
  c: AnsiChar;
  i: Integer;
begin
  Result := '';
  for i := 1 to Length(sText) do
  begin
    c := sText[i];
    // Parse only ASCII chars.
    case c of
      #9:
        Result := Result + StringOfChar(' ',
                    cTabSpaces - (UTF8Length(Result) + Xoffset) mod cTabSpaces);
      else
        begin
          {if c < ' ' then
            Result := Result + ' '
          else}
            Result := Result + c;
        end;
    end;
  end;
end;

function TViewerControl.TransformHex(var aPosition: PtrInt; aLimit: PtrInt): AnsiString;

  function LineFormat(const sHex, sAscii: AnsiString; iOffset: PtrInt): AnsiString;
  begin
    Result := Format('%s: %s', [IntToHex(iOffset, cHexOffsetWidth), sHex]);
    if Length(sHex) < cHexWidth * 3 then
      Result := Result + StringOfChar(' ', cHexWidth * 3 - Length(sHex));
    Result := Result + '  ';
    Result := Result + sAscii;
  end;

var
  c: AnsiChar;
  i: Integer;
  sStr: string = '';
  sHex: string = '';
  aStartOffset: PtrInt;
begin
  if aPosition >= aLimit then
    Exit('');

  aStartOffset := aPosition;
  for i := 0 to cHexWidth - 1 do
  begin
    if aPosition >= aLimit then
      Break;
    c := PAnsiChar(GetDataAdr)[aPosition];
    if c < ' ' then
      sStr := sStr + '.'
    else if c > #127 then
      sStr := sStr + '.'
    else
      sStr := sStr + c;

    sHex := sHex + IntToHex(Ord(c), 2);
    if ((i and 7) = 7) and (i <> cHexWidth - 1) then
      sHex := sHex + '|'
    else
      sHex := sHex + ' ';

    Inc(aPosition);
  end;

  Result := LineFormat(sHex, sStr, aStartOffset)
end;

function TViewerControl.TransformBin(var aPosition: PtrInt; aLimit: PtrInt): AnsiString;
var
  c: AnsiChar;
  i: Integer;
begin
  Result := '';
  for i := 0 to cBinWidth - 1 do
  begin
    if aPosition >= aLimit then
      Break;
    c := PAnsiChar(GetDataAdr)[aPosition];
    if c < ' ' then
      Result := Result + '.'
    else if c > #127 then
      Result := Result + '.'
    else
      Result := Result + c;

    Inc(aPosition);
  end;
end;

function TViewerControl.GetStartOfLine(aPosition: PtrInt): PtrInt;

  function GetStartOfLineText: PtrInt;
  var
    tmpPos, LineStartPos: PtrInt;
    DataLength: PtrInt;
    prevChar: Cardinal;
    CharLenInBytes: Integer;
  begin
    prevChar := GetPrevCharAsAscii(aPosition, CharLenInBytes);
    if CharLenInBytes = 0 then
      Exit(aPosition);

    // Check if this already is not a start of line (if previous char is #10).
    if prevChar = 10 then
      Exit(aPosition);

    tmpPos := aPosition - CharLenInBytes;

    if tmpPos <= FLowLimit then
      Exit(FLowLimit);

    // Check if we're not in the middle of line ending
    // (previous char is #13, current char is #10).
    if (prevChar = 13) and
       (GetNextCharAsAscii(aPosition, CharLenInBytes) = 10) then
    begin
      prevChar := GetPrevCharAsAscii(tmpPos, CharLenInBytes);
      if CharLenInBytes = 0 then
        Exit(aPosition);
      Dec(tmpPos, CharLenInBytes);
    end;

    if tmpPos <= FLowLimit then
      Exit(FLowLimit);

    // Search for real start of line.
    while (not (prevChar in [10, 13])) and (tmpPos > FLowLimit) do
    begin
      prevChar := GetPrevCharAsAscii(tmpPos, CharLenInBytes);
      if CharLenInBytes = 0 then
        Break;
      Dec(tmpPos, CharLenInBytes);
    end;

    // Move forward to first non-line ending character.
    Inc(tmpPos, CharLenInBytes);

    // Search for start of real line or wrapped line.
    while True do
    begin
      LineStartPos := tmpPos;
      CalcTextLineLength(tmpPos, FHighLimit, DataLength);

      if tmpPos = aPosition then
      begin
        if aPosition < FHighLimit then
          Exit(aPosition)       // aPosition is already at start of a line
        else
          Exit(LineStartPos);   // aPosition points to end of file so return start of this line
      end
      else if tmpPos > aPosition then
        Exit(LineStartPos);     // Found start of line
    end;
  end;

  function GetStartOfLineFixed(aFixedWidth: Integer): PtrInt;
  begin
    Result := aPosition - (aPosition mod aFixedWidth);
  end;

var
  i: Integer;
begin
  if aPosition <= FLowLimit then
    Exit(FLowLimit)
  else if aPosition >= FHighLimit then
    aPosition := FHighLimit;   // search from the end of the file

  // Speedup for currently displayed positions.
  if (FLineList.Count > 0) and
     (aPosition >= FLineList.Items[0]) and
     (aPosition <= FLineList.Items[FLineList.Count - 1]) then
  begin
    for i := FLineList.Count - 1 downto 0 do
      if FLineList.Items[i] <= aPosition then
        Exit(FLineList.Items[i]);
  end;

  case FViewerMode of
    vmBin:
      Result := GetStartOfLineFixed(cBinWidth);
    vmHex:
      Result := GetStartOfLineFixed(cHexWidth);
    vmText, vmWrap, vmBook:
      Result := GetStartOfLineText;
    else
      Result := aPosition;
  end;
end;

function TViewerControl.GetEndOfLine(aPosition: PtrInt): PtrInt;

  function GetEndOfLineText: PtrInt;
  var
    tmpPos: PtrInt;
    DataLength: PtrInt;
  begin
    Result := GetStartOfLine(aPosition);
    tmpPos := Result;
    CalcTextLineLength(tmpPos, FHighLimit, DataLength);
    Result := Result + DataLength;
    if Result < aPosition then
      Result := aPosition;
  end;

  function GetEndOfLineFixed(aFixedWidth: Integer): PtrInt;
  begin
    Result := aPosition - (aPosition mod aFixedWidth) + aFixedWidth;
  end;

begin
  case FViewerMode of
    vmBin:
      Result := GetEndOfLineFixed(cBinWidth);
    vmHex:
      Result := GetEndOfLineFixed(cHexWidth);
    vmText, vmWrap, vmBook:
      Result := GetEndOfLineText;
    else
      Result := aPosition;
  end;
end;

function TViewerControl.GetStartOfPrevLine(aPosition: PtrInt): PtrInt;

  function GetPrevLineText: PtrInt;
  var
    tmpPos, LineStartPos: PtrInt;
    DataLength: PtrInt;
    prevChar: Cardinal;
    CharLenInBytes: Integer;
  begin
    prevChar := GetPrevCharAsAscii(aPosition, CharLenInBytes);
    if CharLenInBytes = 0 then
      Exit(aPosition);

    tmpPos := aPosition - CharLenInBytes; // start search from previous character

    if tmpPos <= FLowLimit then
      Exit(FLowLimit);

    // Check if we're not in the middle of line ending
    // (previous char is #13, current char is #10).
    if (prevChar = 13) and
       (GetNextCharAsAscii(aPosition, CharLenInBytes) = 10) then
    begin
      prevChar := GetPrevCharAsAscii(tmpPos, CharLenInBytes);
      if CharLenInBytes = 0 then
        Exit(aPosition);
      Dec(tmpPos, CharLenInBytes);
    end
    else
    begin
      // Bypass possible end of previous line.
      if prevChar = 10 then
      begin
        prevChar := GetPrevCharAsAscii(tmpPos, CharLenInBytes);
        if CharLenInBytes = 0 then
          Exit(aPosition);
        Dec(tmpPos, CharLenInBytes);
      end;
      if prevChar = 13 then
      begin
        prevChar := GetPrevCharAsAscii(tmpPos, CharLenInBytes);
        if CharLenInBytes = 0 then
          Exit(aPosition);
        Dec(tmpPos, CharLenInBytes);
      end;
    end;

    if tmpPos <= FLowLimit then
      Exit(FLowLimit);

    // Search for real start of line.
    while (not (prevChar in [10, 13])) and (tmpPos > FLowLimit) do
    begin
      prevChar := GetPrevCharAsAscii(tmpPos, CharLenInBytes);
      if CharLenInBytes = 0 then
        Break;
      Dec(tmpPos, CharLenInBytes);
    end;

    // Move forward to first non-line ending character.
    Inc(tmpPos, CharLenInBytes);

    // Search for start of real line or wrapped line.
    while True do
    begin
      LineStartPos := tmpPos;
      CalcTextLineLength(tmpPos, aPosition, DataLength);

      if tmpPos >= aPosition then
        Exit(LineStartPos);  // Found start of line
    end;
  end;

  function GetPrevLineFixed(aFixedWidth: Integer): PtrInt;
  begin
    Result := aPosition - (aPosition mod aFixedWidth);
    if Result >= aFixedWidth then
      Result := Result - aFixedWidth;
  end;

var
  i: Integer;
begin
  if aPosition <= FLowLimit then
    Exit(FLowLimit)
  else if aPosition >= FHighLimit then
    aPosition := FHighLimit;   // search from the end of the file

  // Speedup for currently displayed positions.
  if (FLineList.Count > 0) and
     (aPosition >= FLineList.Items[0]) and
     (aPosition <= FLineList.Items[FLineList.Count - 1]) then
  begin
    for i := FLineList.Count - 1 downto 0 do
      if FLineList.Items[i] < aPosition then
        Exit(FLineList.Items[i]);
  end;

  case FViewerMode of
    vmBin:
      Result := GetPrevLineFixed(cBinWidth);
    vmHex:
      Result := GetPrevLineFixed(cHexWidth);
    vmText, vmWrap, vmBook:
      Result := GetPrevLineText;
    else
      Result := aPosition;
  end;
end;

function TViewerControl.GetStartOfNextLine(aPosition: PtrInt): PtrInt;

  function GetNextLineText: PtrInt;
  var
    tmpPos: PtrInt;
    DataLength: PtrInt;
    prevChar: Cardinal;
    CharLenInBytes: Integer;
  begin
    tmpPos := aPosition;

    // This might not be a real start of line (it may be start of wrapped line).
    // Search for start of line.
    while (tmpPos > FLowLimit) do
    begin
      prevChar := GetPrevCharAsAscii(tmpPos, CharLenInBytes);
      if CharLenInBytes = 0 then
        Break;
      if (prevChar in [10, 13]) then
        Break
      else
        Dec(tmpPos, CharLenInBytes);
    end;

    // Now we know we are at the start of a line, search the start of next line.
    while True do
    begin
      CalcTextLineLength(tmpPos, FHighLimit, DataLength);

      if tmpPos >= aPosition then
        Exit(tmpPos);  // Found start of line
    end;
  end;

  function GetNextLineFixed(aFixedWidth: Integer): PtrInt;
  begin
    Result := aPosition - (aPosition mod aFixedWidth);
    if Result + aFixedWidth < FHighLimit then
      Result := Result + aFixedWidth;
  end;

var
  i: Integer;
begin
  if aPosition < FLowLimit then
    aPosition := FLowLimit         // search from the start of the file
  else if aPosition >= FHighLimit then
    aPosition := FHighLimit;   // search from the end of the file

  // Speedup for currently displayed positions.
  if (FLineList.Count > 0) and
     (aPosition >= FLineList.Items[0]) and
     (aPosition <= FLineList.Items[FLineList.Count - 1]) then
  begin
    for i := 0 to FLineList.Count - 1 do
      if FLineList.Items[i] > aPosition then
        Exit(FLineList.Items[i]);
  end;

  case FViewerMode of
    vmBin:
      Result := GetNextLineFixed(cBinWidth);
    vmHex:
      Result := GetNextLineFixed(cHexWidth);
    vmText, vmWrap, vmBook:
      Result := GetNextLineText;
    else
      Result := aPosition;
  end;
end;

procedure TViewerControl.PageUp;
var
  H: Integer;
begin
  H := GetClientHeightInLines * FColCount - 1;
  if H <= 0 then
    H := 1;
  Scroll(-H);
end;

procedure TViewerControl.HPageUp;
var
  H: Integer;
begin
  H := FHPosition - FTextWidth;
  if H <= 0 then
    H := FHPosition else H:= FTextWidth;
  HScroll(-H);
end;

procedure TViewerControl.PageDown;
var
  H: Integer;
begin
  H := GetClientHeightInLines * FColCount - 1;
  if H <= 0 then
    H := 1;
  Scroll(H);
end;

procedure TViewerControl.HPageDown;
var
  H: Integer;
begin
  H := FHLowEnd - FHPosition;
  if H > FTextWidth then H := FTextWidth ;
  HScroll(H);
end;

procedure TViewerControl.GoHome;
begin
  Position := FLowLimit;
end;

procedure TViewerControl.GoEnd;
begin
  Position := FHighLimit;
end;

procedure TViewerControl.HGoHome;
begin
  HScroll (-FHPosition);
end;

procedure TViewerControl.HGoEnd;
begin
  HScroll (FHLowEnd-FHPosition);
end;

procedure TViewerControl.SetFileName(const sFileName: UTF8String);
begin
  if not (csDesigning in ComponentState) then
  begin
    UnMapFile;

    if sFileName <> '' then
    begin
      if MapFile(sFileName) then
      begin
        FFileName  := sFileName;

        // Detect encoding if needed.
        if FEncoding = veAutoDetect then
          FEncoding := DetectEncoding;

        ReReadFile;
      end;
    end;
  end
  else
    FFileName  := sFileName;
end;

function TViewerControl.MapFile(const sFileName: UTF8String): Boolean;

  function ReadFile: Boolean; inline;
  begin
    FMappedFile := GetMem(FFileSize);
    Result := (FileRead(FFileHandle, FMappedFile^, FFileSize) = FFileSize);
    FileClose(FFileHandle);
    FFileHandle := 0;
  end;

{$IFDEF MSWINDOWS}
var
  wFileName: WideString;
begin
  Result := False;
  if Assigned(FMappedFile) then
    UnMapFile; // if needed

  wFileName   := UTF8Decode(sFileName);
  FFileHandle := CreateFileW(PWChar(wFileName), GENERIC_READ,
      FILE_SHARE_READ or FILE_SHARE_WRITE or FILE_SHARE_DELETE, nil,
      OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);

  if FFileHandle = INVALID_HANDLE_VALUE then
  begin
    FFileHandle := 0;
    Exit;
  end;

  FFileSize := GetFileSize(FFileHandle, nil);

  if (FFileSize < MaxMemSize) then
  begin
    Result := ReadFile;
    Exit;
  end;

  FMappingHandle := CreateFileMapping(FFileHandle, nil, PAGE_READONLY, 0, 0, nil);

  if FMappingHandle <> 0 then
    FMappedFile := MapViewOfFile(FMappingHandle, FILE_MAP_READ, 0, 0, 0)
  else
  begin
    FMappedFile := nil;
    FileClose(FFileHandle);
    FFileHandle := 0;
    Exit;
  end;

  Result := True;
end;
{$ELSE}
var
  StatBuf: Stat;
begin
  Result := False;
  if Assigned(FMappedFile) then
    UnMapFile; // if needed

  FFileHandle := fpOpen(PChar(sFileName), O_RDONLY);
  if FFileHandle = feInvalidHandle then
  begin
    FFileHandle := 0;
    Exit;
  end;

  if fpFStat(FFileHandle, StatBuf) <> 0 then
  begin
    fpClose(FFileHandle);
    FFileHandle := 0;
    Exit;
  end;

  FFileSize := StatBuf.st_size;

  if (FFileSize < MaxMemSize) then
  begin
    Result := ReadFile;
    Exit;
  end;

  FMappedFile := fpmmap(nil, FFileSize, PROT_READ, MAP_PRIVATE{SHARED}, FFileHandle, 0);
  if FMappedFile = MAP_FAILED then
  begin
    FMappedFile:= nil;
    fpClose(FFileHandle);
    FFileHandle := 0;
    Exit;
  end;

  Result:= True;
end;
{$ENDIF}

procedure TViewerControl.UnMapFile;
begin
  if (FFileSize < MaxMemSize) then
  begin
    if Assigned(FMappedFile) then
    begin
      FreeMem(FMappedFile);
      FMappedFile := nil;
    end;
  end;

{$IFDEF MSWINDOWS}

  if Assigned(FMappedFile) then
  begin
    UnmapViewOfFile(FMappedFile);
    FMappedFile := nil;
  end;

  if FMappingHandle <> 0 then
  begin
    CloseHandle(FMappingHandle);
    FMappingHandle := 0;
  end;

  if FFileHandle <> 0 then
  begin
    FileClose(FFileHandle);
    FFileHandle := 0;
  end;

{$ELSE}

  if Assigned(FMappedFile) then
  begin
    if fpmunmap(FMappedFile, FFileSize) = -1 then
      DebugLn('Error unmapping file: ', SysErrorMessage(fpgeterrno));
    FMappedFile := nil;
  end;

  if FFileHandle <> 0 then
  begin
    fpClose(FFileHandle);
    FFileHandle := 0;
  end;

{$ENDIF}

  FFileName  := '';
  FFileSize  := 0;
  Position   := 0;
  FLowLimit  := 0;
  FHighLimit := 0;
  FBOMLength := 0;
  FBlockBeg  := 0;
  FBlockEnd  := 0;
end;

procedure TViewerControl.WriteText;
var
  yIndex, xIndex, w, scrollTab, i: Integer;
  LineStart, iPos: PtrInt;
  DataLength: PtrInt;
begin
  iPos := FPosition;
  if ViewerMode = vmBook then
     w := Width div FColCount
  else
     w := 0;
  if (ViewerMode = vmText) and (FHPosition>0) then
    scrollTab := -FHPosition * Canvas.TextWidth('W')
  else
    scrollTab :=0;
  for xIndex := 0 to FColCount-1 do
    begin
      for yIndex := 0 to GetClientHeightInLines - 1 do
      begin
        if iPos >= FHighLimit then
          Break;
        AddLineOffset(iPos);
        LineStart := iPos;
        i := CalcTextLineLength(iPos, FHighLimit, DataLength);
        if i > FHLowEnd then FHLowEnd:=i;
        if DataLength > 0 then
          OutText(scrollTab+xIndex*w, yIndex * FTextHeight, LineStart, DataLength)
      end;
    end;
end;

procedure TViewerControl.WriteHex;
var
  yIndex: Integer;
  iPos, LineStart: PtrInt;
  s: string;
begin
  iPos := FPosition;
  for yIndex := 0 to GetClientHeightInLines - 1 do
  begin
    if iPos >= FHighLimit then
      Break;
    LineStart := iPos;
    AddLineOffset(iPos);
    s := TransformHex(iPos, FHighLimit);
    if s <> '' then
      OutHex(0, yIndex * FTextHeight, s, LineStart, iPos - LineStart);
  end;
end;

procedure TViewerControl.WriteBin;
var
  yIndex: Integer;
  iPos, LineStart: PtrInt;
  s: string;
begin
  iPos := FPosition;
  for yIndex := 0 to GetClientHeightInLines - 1 do
  begin
    if iPos >= FHighLimit then
      Break;
    LineStart := iPos;
    AddLineOffset(iPos);
    s := TransformBin(iPos, FHighLimit);
    if s <> '' then
      OutBin(0, yIndex * FTextHeight, s, LineStart, iPos - LineStart);
  end;
end;

function TViewerControl.GetDataAdr: Pointer;
begin
  case FViewerMode of
    vmText, vmWrap, vmBook:
      Result := FMappedFile + FBOMLength;
    else
      Result := FMappedFile;
  end;
end;

procedure TViewerControl.SetPosition(Value: PtrInt);
begin
  SetPosition(Value, False);
end;

procedure TViewerControl.SetHPosition(Value: Integer);
begin
  SetHPosition(Value, False);
end;

procedure TViewerControl.SetHPosition(Value: Integer; Force: Boolean);
begin
  if not IsFileOpen then
    Exit;

  FHPosition := Value;
  // Set new scroll position.
  if (FHLowEnd - FTextWidth) > 0 then
  begin
    if FHPosition > 0 then
      FHScrollBarPosition := FHPosition * 100 div (FHLowEnd - FTextWidth)
    else
      FHScrollBarPosition := 0;
  end;
  // Update scrollbar position.
  if FUpdateScrollBarPos then
  begin
    if FScrollBarHorz.Position <> FHScrollBarPosition then
    begin
      // Workaround for bug: http://bugs.freepascal.org/view.php?id=23815
      {$IF DEFINED(LCLQT) and (LCL_FULLVERSION < 1010000)}
      FScrollBarHorz.OnScroll := nil;
      FScrollBarHorz.Position := FHScrollBarPosition;
      Application.ProcessMessages; // Skip message
      FScrollBarHorz.OnScroll := @ScrollBarHorzScroll;
      {$ELSE}
      FScrollBarHorz.Position := FHScrollBarPosition;
      {$ENDIF}
    end;
  end;
  // else the scrollbar position will be updated in ScrollBarVertScroll
  Invalidate;
end;

procedure TViewerControl.SetPosition(Value: PtrInt; Force: Boolean);
var
  LinesTooMany:    Integer;
  LastLineReached: Boolean;
begin
  if not IsFileOpen then
    Exit;

  // Speedup if total nr of lines is less then nr of lines that can be displayed.
  if (FPosition = FLowLimit) and                // only if already at the top
     (FLineList.Count > 0) and (FLineList.Count < GetClientHeightInLines)
  then
    Value := FLowLimit
  else
    // Boundary checks are done in GetStartOfLine.
    Value := GetStartOfLine(Value);

  if (Value <> FPosition) or Force then
  begin
    // Don't allow empty lines at the bottom of the control.
    LinesTooMany := GetClientHeightInLines - GetLinesTillEnd(Value, LastLineReached);
    if LinesTooMany > 0 then
      ScrollPosition(Value, -LinesTooMany); // scroll back upwards

    FPosition := Value;
    if Assigned(FOnPositionChanged) then
      FOnPositionChanged(Self);
    Invalidate;

    // Set new scroll position.
    if LastLineReached then
      FScrollBarPosition := 100
    else
      FScrollBarPosition := Percent;
  end;

  // Update scrollbar position.
  if FUpdateScrollBarPos then
  begin
    if FScrollBarVert.Position <> FScrollBarPosition then
    begin
      // Workaround for bug: http://bugs.freepascal.org/view.php?id=23815
      {$IF DEFINED(LCLQT) and (LCL_FULLVERSION < 1010000)}
      FScrollBarVert.OnScroll := nil;
      FScrollBarVert.Position := FScrollBarPosition;
      Application.ProcessMessages; // Skip message
      FScrollBarVert.OnScroll := @ScrollBarVertScroll;
      {$ELSE}
      FScrollBarVert.Position := FScrollBarPosition;
      {$ENDIF}
    end;
  end;
  // else the scrollbar position will be updated in ScrollBarVertScroll
end;

procedure TViewerControl.SetEncoding(AEncoding: TViewerEncoding);
begin
  if not (csDesigning in ComponentState) then
  begin
    if AEncoding = veAutoDetect then
      FEncoding := DetectEncoding
    else
      FEncoding := AEncoding;

    ReReadFile;
  end
  else
    FEncoding := AEncoding;
end;

function TViewerControl.GetEncodingName: string;
begin
  Result := ViewerEncodingsNames[FEncoding];
end;

procedure TViewerControl.SetEncodingName(AEncodingName: string);
var
  i: TViewerEncoding;
begin
  for i := Low(TViewerEncoding) to High(TViewerEncoding) do
    if NormalizeEncoding(ViewerEncodingsNames[i]) = NormalizeEncoding(AEncodingName) then
    begin
      SetEncoding(i);
      break;
    end;
end;

function TViewerControl.GetClientHeightInLines: Integer;
begin
  if FViewerMode <> vmText then
    Result:= 0
  else // Take horizontal scrollbar into account
    Result:= GetSystemMetrics(SM_CYHSCROLL);

  if FTextHeight > 0 then
    Result := (ClientRect.Bottom - ClientRect.Top - Result) div FTextHeight
             // or Self.Height div FTextHeight?
  else
    Result := 0;
end;

function TViewerControl.GetLinesTillEnd(FromPosition: PtrInt;
  out LastLineReached: Boolean): Integer;
var
  yIndex: Integer;
  iPos:   PtrInt;
  DataLength: PtrInt;
begin
  Result := 0;
  iPos   := FromPosition;
  for yIndex := 0 to GetClientHeightInLines - 1 do
  begin
    if iPos >= FHighLimit then
      Break;
    Inc(Result, 1);
    case ViewerMode of
      vmBin:
        iPos := iPos + cBinWidth;
      vmHex:
        iPos := iPos + cHexWidth;
      vmText, vmWrap, vmBook:
        CalcTextLineLength(iPos, FHighLimit, DataLength);
    end;
  end;
  LastLineReached := (iPos >= FHighLimit);
end;

function TViewerControl.GetPercent: Integer;
begin
  if FHighLimit - FLowLimit > 0 then
    Result := (Int64(FPosition - FLowLimit) * 100) div Int64(FHighLimit - FLowLimit)
  else
    Result := 0;
end;

procedure TViewerControl.SetPercent(const AValue: Integer);
begin
  if FHighLimit - FLowLimit > 0 then
    Position := Int64(AValue) * (Int64(FHighLimit  - FLowLimit) div 100) + FLowLimit
  else
    Position := 0;
end;

procedure TViewerControl.SetBlockBegin(const AValue: PtrInt);
begin
  if (AValue >= FLowLimit) and (AValue < FHighLimit) then
  begin
    if FBlockEnd < AValue then
      FBlockEnd := AValue;
    FBlockBeg   := AValue;
    Invalidate;
  end;
end;

procedure TViewerControl.SetBlockEnd(const AValue: PtrInt);
begin
  if (AValue >= FLowLimit) and (AValue < FHighLimit) then
  begin
    if FBlockBeg > AValue then
      FBlockBeg := AValue;
    FBlockEnd   := AValue;
    Invalidate;
  end;
end;

procedure TViewerControl.OutText(x, y: Integer;
  StartPos: PtrInt; DataLength: Integer);
var
  pBegLine, pEndLine: PtrInt;
  iBegDrawIndex, iEndDrawIndex: PtrInt;
  xOffset: Integer;
  sText: string;
begin
  pBegLine := StartPos;
  pEndLine := pBegLine + DataLength;

  if ((FBlockEnd - FBlockBeg) = 0) or ((FBlockBeg < pBegLine) and (FBlockEnd < pBegLine)) or // before
     ((FBlockBeg > pEndLine) and (FBlockEnd > pEndLine)) then //after
  begin
    // out of selection, draw normal
    Canvas.Font.Color := Font.Color;
    Canvas.TextOut(x, y, GetText(StartPos, DataLength, 0));
    Exit;
  end;

  // Get selection start/end.
  if (FBlockBeg <= pBegLine) then
    iBegDrawIndex := pBegLine
  else
    iBegDrawIndex := FBlockBeg;
  if (FBlockEnd < pEndLine) then
    iEndDrawIndex := FBlockEnd
  else
    iEndDrawIndex := pEndLine;

  xOffset := 0;

  // Text before selection.
  if iBegDrawIndex - pBegLine > 0 then
  begin
    sText := GetText(StartPos, iBegDrawIndex - pBegLine, xOffset);
    Canvas.Font.Color := Font.Color;
    Canvas.TextOut(x, y, sText);
    x := x + Canvas.TextWidth(sText);
    xOffset := xOffset + UTF8Length(sText);
  end;

  // Selected text.
  sText := GetText(StartPos + iBegDrawIndex - pBegLine,
                   iEndDrawIndex - iBegDrawIndex, xOffset);

  Canvas.Brush.Color := clHighlight;
  Canvas.Font.Color  := clHighlightText;

  // Cannot simply draw text with brush with TextOut
  // because it differs between widgetsets.
  Canvas.Brush.Style := bsSolid;
  Canvas.FillRect(Bounds(x, y, Canvas.TextWidth(sText), FTextHeight));
  Canvas.Brush.Style := bsClear;

  // Or use TextRect instead of TextOut with Opaque = True.
  //ts := Canvas.TextStyle;
  //ts.Opaque := True;
  //ts.Clipping := True;
  //Canvas.TextRect(Bounds(X, Y, Canvas.TextWidth(sText), FTextHeight), X, Y, sText, ts);

  Canvas.TextOut(x, y, sText);
  x := x + Canvas.TextWidth(sText);
  xOffset := xOffset + UTF8Length(sText);

  // restore previous canvas settings
  Canvas.Brush.Color := Color;
  Canvas.Font.Color  := Font.Color;

  // Text after selection.
  if pEndLine - iEndDrawIndex > 0 then
  begin
    sText := GetText(StartPos + iEndDrawIndex - pBegLine,
                     pEndLine - iEndDrawIndex, xOffset);
    Canvas.TextOut(x, y, sText);
  end;
end;

procedure TViewerControl.OutHex(x, y: Integer; sText: string;
  StartPos: PtrInt; DataLength: Integer);
var
  pBegLine, pEndLine: PtrInt;
  iBegDrawIndex, iEndDrawIndex: PtrInt;
  sNextText: String = '';
  sTmpText: String;
begin
  pBegLine := StartPos;
  pEndLine := pBegLine + DataLength;

  if ((FBlockEnd - FBlockBeg) = 0) or ((FBlockBeg < pBegLine) and (FBlockEnd <= pBegLine)) or // before
     ((FBlockBeg > pEndLine) and (FBlockEnd > pEndLine)) then //after
  begin
    // out of selection, draw normal
    Canvas.Font.Color := Font.Color;
    Canvas.TextOut(x, y, sText);
    Exit;
  end;

  // Get selection start/end.
  if (FBlockBeg <= pBegLine) then
    iBegDrawIndex := pBegLine
  else
    iBegDrawIndex := FBlockBeg;
  if (FBlockEnd < pEndLine) then
    iEndDrawIndex := FBlockEnd
  else
    iEndDrawIndex := pEndLine;

  // Text before selection (offset and hex part).
  sTmpText := Copy(sText, 1, cHexStartHex + (iBegDrawIndex - pBegLine) * 3);
  Canvas.Font.Color := Font.Color;
  Canvas.TextOut(x, y, sTmpText);
  x := x + Canvas.TextWidth(sTmpText);

  // Selected text (hex part).
  sTmpText := Copy(sText, 1 + cHexStartHex + (iBegDrawIndex - pBegLine) * 3,
                                             (iEndDrawIndex - iBegDrawIndex) * 3);

  // Move last character from selection to not selected text.
  sNextText := Copy(sTmpText, Length(sTmpText), 1);
  Delete(sTmpText, Length(sTmpText), 1);

  Canvas.Brush.Color := clHighlight;
  Canvas.Font.Color  := clHighlightText;

  Canvas.Brush.Style := bsSolid;
  Canvas.FillRect(Bounds(x, y, Canvas.TextWidth(sTmpText), FTextHeight));
  Canvas.Brush.Style := bsClear;
  Canvas.TextOut(x, y, sTmpText);
  x := x + Canvas.TextWidth(sTmpText);

  // restore previous canvas settings
  Canvas.Brush.Color := Color;
  Canvas.Font.Color  := Font.Color;

  // Text after selection (hex part).
  if pEndLine - iEndDrawIndex > 0 then
  begin
    sTmpText := sNextText +
      Copy(sText, 1 + cHexStartHex + (iEndDrawIndex - pBegLine) * 3,
                                     (pEndLine - iEndDrawIndex) * 3);
    sNextText := '';
    Canvas.TextOut(x, y, sTmpText);
    x := x + Canvas.TextWidth(sTmpText);
  end;

  // Space after hex if data doesn't span full line.
  if DataLength < cHexWidth then
    sNextText := sNextText + Copy(sText, 1 + cHexStartHex + DataLength * 3,
                                         (cHexWidth - DataLength) * 3);

  // Space between hex and ascii.
  sTmpText := sNextText + '  ';
  Canvas.TextOut(x, y, sTmpText);
  x := x + Canvas.TextWidth(sTmpText);

  // Text before selection (ascii part).
  if iBegDrawIndex - pBegLine > 0 then
  begin
    sTmpText := Copy(sText, 1 + cHexStartAscii, iBegDrawIndex - pBegLine);
    Canvas.TextOut(x, y, sTmpText);
    x := x + Canvas.TextWidth(sTmpText);
  end;

  // Selected text (ascii part).
  sTmpText := Copy(sText, 1 + cHexStartAscii + iBegDrawIndex - pBegLine,
                                               iEndDrawIndex - iBegDrawIndex);
  Canvas.Brush.Color := clHighlight;
  Canvas.Font.Color  := clHighlightText;
  Canvas.Brush.Style := bsSolid;
  Canvas.FillRect(Bounds(x, y, Canvas.TextWidth(sTmpText), FTextHeight));
  Canvas.Brush.Style := bsClear;
  Canvas.TextOut(x, y, sTmpText);
  x := x + Canvas.TextWidth(sTmpText);

  // restore background color
  Canvas.Brush.Color := Color;
  Canvas.Font.Color  := Font.Color;

  // Text after selection.
  if pEndLine - iEndDrawIndex > 0 then
  begin
    sTmpText := Copy(sText, 1 + cHexStartAscii + iEndDrawIndex - pBegLine,
                                                 pEndLine - iEndDrawIndex);
    Canvas.TextOut(x, y, sTmpText);
  end;
end;

procedure TViewerControl.OutBin(x, y: Integer; sText: string; StartPos: PtrInt;
  DataLength: Integer);
var
  pBegLine, pEndLine: PtrInt;
  iBegDrawIndex, iEndDrawIndex: PtrInt;
  sTmpText: String;
begin
  pBegLine := StartPos;
  pEndLine := pBegLine + DataLength;

  if ((FBlockEnd - FBlockBeg) = 0) or ((FBlockBeg < pBegLine) and (FBlockEnd < pBegLine)) or // before
     ((FBlockBeg > pEndLine) and (FBlockEnd > pEndLine)) then //after
  begin
    // out of selection, draw normal
    Canvas.Font.Color := Font.Color;
    Canvas.TextOut(x, y, sText);
    Exit;
  end;

  // Get selection start/end.
  if (FBlockBeg <= pBegLine) then
    iBegDrawIndex := pBegLine
  else
    iBegDrawIndex := FBlockBeg;
  if (FBlockEnd < pEndLine) then
    iEndDrawIndex := FBlockEnd
  else
    iEndDrawIndex := pEndLine;

  // Text before selection.
  if iBegDrawIndex - pBegLine > 0 then
  begin
    sTmpText := Copy(sText, 1, iBegDrawIndex - pBegLine);
    Canvas.Font.Color := Font.Color;
    Canvas.TextOut(x, y, sTmpText);
    x := x + Canvas.TextWidth(sTmpText);
  end;

  // Selected text.
  sTmpText := Copy(sText, 1 + iBegDrawIndex - pBegLine, iEndDrawIndex - iBegDrawIndex);

  Canvas.Brush.Color := clHighlight;
  Canvas.Font.Color  := clHighlightText;
  Canvas.Brush.Style := bsSolid;
  Canvas.FillRect(Bounds(x, y, Canvas.TextWidth(sTmpText), FTextHeight));
  Canvas.Brush.Style := bsClear;
  Canvas.TextOut(x, y, sTmpText);
  x := x + Canvas.TextWidth(sTmpText);

  // restore previous canvas settings
  Canvas.Brush.Color := Color;
  Canvas.Font.Color  := Font.Color;

  // Text after selection.
  if pEndLine - iEndDrawIndex > 0 then
  begin
    sTmpText := Copy(sText, 1 + iEndDrawIndex - pBegLine, pEndLine - iEndDrawIndex);
    Canvas.TextOut(x, y, sTmpText);
  end;
end;

procedure TViewerControl.AddLineOffset(iOffset: PtrInt);
begin
  FLineList.Add(iOffset);
end;

procedure TViewerControl.KeyDown(var Key: word; Shift: TShiftState);
begin
  if Shift = [] then
  begin
    case Key of
      VK_DOWN:
        begin
          Key := 0;
          Scroll(1);
        end;
      VK_UP:
        begin
          Key := 0;
          Scroll(-1);
        end;
      VK_HOME:
        begin
          Key := 0;
          GoHome;
        end;
      VK_END:
        begin
          Key := 0;
          GoEnd;
        end;
      VK_PRIOR:
        begin
          Key := 0;
          PageUp;
        end;
      VK_NEXT:
        begin
          Key := 0;
          PageDown;
        end;
      else
        inherited KeyDown(Key, Shift);
    end;
  end
  else if Shift = [ssCtrl] then
  begin
    case Key of
      VK_HOME:
        begin
          Key := 0;
          GoHome;
        end;
      VK_END:
        begin
          Key := 0;
          GoEnd;
        end;
      else
        inherited KeyDown(Key, Shift);
    end;
  end
  else
    inherited KeyDown(Key, Shift);
end;

function TViewerControl.FindAsciiSetForward(aPosition, aMaxBytes: PtrInt;
                                            const AsciiChars: String;
                                            bFindNotIn: Boolean): PtrInt;
var
  i: Integer;
  found: Boolean;
  u: Cardinal;
  CharLenInBytes: Integer;
begin
  Result := -1;
  while aMaxBytes > 0 do
  begin
    u := GetNextCharAsAscii(aPosition, CharLenInBytes);
    if CharLenInBytes = 0 then
      Exit;

    if not bFindNotIn then
    begin
      for i := 1 to Length(AsciiChars) do
        if u = ord(AsciiChars[i]) then
          Exit(aPosition);
    end
    else
    begin
      found := False;
      for i := 1 to Length(AsciiChars) do
        if u = ord(AsciiChars[i]) then
        begin
          found := True;
          break;
        end;

      if not found then
        Exit(aPosition);
    end;

    Inc(aPosition, CharLenInBytes);
    Dec(aMaxBytes, CharLenInBytes);
  end;
end;

function TViewerControl.FindAsciiSetBackward(aPosition, aMaxBytes: PtrInt;
                                             const AsciiChars: String;
                                             bFindNotIn: Boolean): PtrInt;
var
  i: Integer;
  found: Boolean;
  u: Cardinal;
  CharLenInBytes: Integer;
begin
  Result := -1;
  while aMaxBytes > 0 do
  begin
    u := GetPrevCharAsAscii(aPosition, CharLenInBytes);
    if CharLenInBytes = 0 then
      Exit;

    if not bFindNotIn then
    begin
      for i := 1 to Length(AsciiChars) do
        if u = ord(AsciiChars[i]) then
          Exit(aPosition);
    end
    else
    begin
      found := False;
      for i := 1 to Length(AsciiChars) do
        if u = ord(AsciiChars[i]) then
        begin
          found := True;
          break;
        end;

      if not found then
        Exit(aPosition);
    end;

    Dec(aPosition, CharLenInBytes);
    Dec(aMaxBytes, CharLenInBytes);
  end;
end;

procedure TViewerControl.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
var
  LineBegin, LineEnd: PtrInt;
  ClickPos: PtrInt;
  CharSide: TCharSide;
begin
  inherited;

  SetFocus;

  if not IsFileOpen then
    Exit;

  case Button of
    mbLeft:
      begin
        if Shift * [ssDouble, ssTriple] = [] then
        begin
          // Single click.
          ClickPos := XYPos2Adr(x, y, CharSide);
          if ClickPos <> -1 then
          begin
            FBlockBeg       := ClickPos;
            FBlockEnd       := ClickPos;
            FMouseBlockBeg  := ClickPos;
            FMouseBlockSide := CharSide;
            FSelecting      := True;
            Invalidate;
          end
          else
            FSelecting := False;
        end
        else // if double click or triple click
        begin
          FSelecting := False;
          LineBegin  := GetStartOfLine(FMouseBlockBeg);
          LineEnd    := GetEndOfLine(FMouseBlockBeg);

          if ssDouble in Shift then
          begin
            // Select word with double-click.
            FBlockBeg := FindAsciiSetBackward(FMouseBlockBeg,
                           FMouseBlockBeg - LineBegin, sNonCharacter, False);

            FBlockEnd := FindAsciiSetForward(FMouseBlockBeg,
                           LineEnd - FMouseBlockBeg, sNonCharacter, False);
          end
          else if ssTriple in Shift then
          begin
            // Select line with triple-click.
            FBlockBeg := FindAsciiSetForward(LineBegin,
                           LineEnd - LineBegin, sWhiteSpace, True);

            FBlockEnd := FindAsciiSetBackward(LineEnd,
                           LineEnd - LineBegin, sWhiteSpace, True);
          end;

          if FBlockBeg = -1 then
            FBlockBeg := LineBegin;
          if FBlockEnd = -1 then
            FBlockEnd := LineEnd;

          if FBlockBeg > FBlockEnd then
            FBlockEnd := FBlockBeg;

          CopyToClipboard;
          Invalidate;
        end;
      end; // mbLeft
  end; // case
end;

procedure TViewerControl.MouseMove(Shift: TShiftState; X, Y: Integer);

  procedure MoveOneChar(var aPosition: PtrInt);
  var
    CharLenInBytes: Integer;
  begin
    GetNextCharAsAscii(aPosition, CharLenInBytes);
    aPosition := aPosition + CharLenInBytes;
  end;

  procedure MoveOneCharByMouseSide(var aPosition: PtrInt);
  begin
    if FMouseBlockSide in [csRight, csAfter] then
      MoveOneChar(aPosition);
  end;

var
  ClickPos: PtrInt;
  CharSide: TCharSide;
begin
  inherited;

  if FSelecting then
  begin
    if y < FTextHeight then
      Scroll(-3)
    else if y > ClientHeight - FTextHeight then
      Scroll(3);

    ClickPos := XYPos2Adr(x, y, CharSide);
    if ClickPos <> -1 then
    begin
      if ClickPos < FMouseBlockBeg then
      begin
        // Got a new beginning.
        FBlockBeg := ClickPos;
        FBlockEnd := FMouseBlockBeg;

        // Move end beyond last character.
        MoveOneCharByMouseSide(FBlockEnd);

        // When selecting from right to left, the current selected side must be
        // either csLeft or csBefore, otherwise current position is not included.
        if not (CharSide in [csLeft, csBefore]) then
        begin
          // Current position should not be included in selection.
          // Move beginning after first character.
          MoveOneChar(FBlockBeg);
        end;
      end
      else if ClickPos > FMouseBlockBeg then
      begin
        // Got a new end.
        FBlockBeg := FMouseBlockBeg;
        FBlockEnd := ClickPos;

        // Move beginning after first character.
        MoveOneCharByMouseSide(FBlockBeg);

        // When selecting from left to right, the current selected side must be
        // either csRight or csAfter, otherwise current position is not included.
        if CharSide in [csRight, csAfter] then
        begin
          // Current position should be included in selection.
          // Move end beyond last character.
          MoveOneChar(FBlockEnd);
        end;
      end
      else if FMouseBlockSide <> CharSide then
      begin
        // Same position but changed side of the character.
        FBlockBeg := FMouseBlockBeg;
        FBlockEnd := FMouseBlockBeg;

        if ((FMouseBlockSide in [csBefore, csLeft]) and
            (CharSide in [csRight, csAfter])) or
           ((FMouseBlockSide in [csRight, csAfter]) and
            (CharSide in [csBefore, csLeft])) then
        begin
          // Move end beyond last character.
          MoveOneChar(FBlockEnd);
        end;
      end
      else
      begin
        FBlockBeg := FMouseBlockBeg;
        FBlockEnd := FMouseBlockBeg;
      end;

      Invalidate;
    end;
  end;
end;

procedure TViewerControl.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  inherited;

  if FSelecting and (Button = mbLeft) and (Shift * [ssDouble, ssTriple] = []) then
  begin
    CopyToClipboard;
    FSelecting := False;
  end;
end;

function TViewerControl.DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean;
begin
  Result := inherited;
  if not Result then
    Result := Scroll(Mouse.WheelScrollLines);
end;

function TViewerControl.DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean;
begin
  Result := inherited;
  if not Result then
    Result := Scroll(-Mouse.WheelScrollLines);
end;

function TViewerControl.XYPos2Adr(x, y: Integer; out CharSide: TCharSide): PtrInt;
var
  yIndex:  Integer;
  StartLine, EndLine: PtrInt;

  function XYPos2AdrBin: PtrInt;
  var
    i:  Integer;
    px: Integer = 0;
    charWidth: Integer;
    sText: String;
    tmpPosition: PtrInt;
  begin
    tmpPosition := StartLine;
    sText := TransformBin(tmpPosition, EndLine);
    for i := 1 to Length(sText) do
    begin
      charWidth := Canvas.TextWidth(string(sText[i]));
      if px + charWidth > x then
      begin
        if px + charWidth div 2 > x then
          CharSide := csLeft
        else
          CharSide := csRight;

        Exit(StartLine + i - 1);  // -1 because we count from 1
      end;
      px  := px + charWidth;
    end;
    CharSide := csBefore;
    Result := EndLine;
  end;

  function XYPos2AdrHex: PtrInt;
  var
    i:  Integer;
    px: Integer = 0;
    charWidth: Integer;
    sText, sPartialText: String;
    tmpPosition: PtrInt;
  begin
    tmpPosition  := StartLine;
    sText := TransformHex(tmpPosition, EndLine);

    // Clicked on offset.
    sPartialText := Copy(sText, 1, cHexStartHex);
    charWidth := Canvas.TextWidth(sPartialText);
    px := px + charWidth;
    if px > x then
    begin
      CharSide := csBefore;
      Exit(StartLine);
    end;

    // Clicked on hex part.
    for i := 0 to cHexWidth - 1 do
    begin
      sPartialText := Copy(sText, 1 + cHexStartHex + i * 3, 2);
      charWidth := Canvas.TextWidth(sPartialText);
      if px + charWidth > x then
      begin
        // Check if we're not after end of data.
        if StartLine + i >= EndLine then
        begin
          CharSide := csBefore;
          Exit(EndLine);
        end;

        if px + charWidth div 2 > x then
          CharSide := csLeft
        else
          CharSide := csRight;

        Exit(StartLine + i);
      end;

      // Space after hex number.
      charWidth := charWidth +
                   Canvas.TextWidth(string(sText[1 + cHexStartHex + i * 3 + 2]));

      if px + charWidth > x then
      begin
        CharSide := csAfter;
        Exit(StartLine + i);
      end;

      px := px + charWidth;
    end;

    // Clicked between hex and ascii.
    sPartialText := Copy(sText, 1 + cHexEndHex, cHexStartAscii - cHexEndHex);
    charWidth := Canvas.TextWidth(sPartialText);
    if px + charWidth > x then
    begin
      Exit(-1); // No position.
    end;
    px := px + charWidth;

    // Clicked on ascii part.
    for i := 0 to cHexWidth - 1 do
    begin
      charWidth := Canvas.TextWidth(string(sText[1 + cHexStartAscii + i]));
      if px + charWidth > x then
      begin
        // Check if we're not after end of data.
        if StartLine + i >= EndLine then
        begin
          CharSide := csBefore;
          Exit(EndLine);
        end;

        if px + charWidth div 2 > x then
          CharSide := csLeft
        else
          CharSide := csRight;

        Exit(StartLine + i);
      end;
      px := px + charWidth;
    end;

    CharSide := csBefore;
    Result := EndLine;
  end;

  function XYPos2AdrText: PtrInt;
  var
    i: Integer;
    px: Integer = 0;
    charWidth: Integer;
    len: Integer = 0;
    CharLenInBytes: Integer;
    s: UTF8String;
  begin
    i := StartLine;

    while i < EndLine do
    begin
      s := GetNextCharAsUtf8(i, CharLenInBytes);
      if CharLenInBytes = 0 then
        Break;

      // Check if the conversion to UTF-8 was successful.
      if Length(s) > 0 then
      begin
        if s = #9 then
        begin
          s := StringOfChar(' ', cTabSpaces - len mod cTabSpaces);
          len := len + (cTabSpaces - len mod cTabSpaces);
        end
        else
          Inc(len); // Assume there is one character after conversion
                    // (otherwise use Inc(len, UTF8Length(s))).

      if len <= FHPosition then
        begin
          i := i + CharLenInBytes;
          Continue;
        end;

        charWidth := Canvas.TextWidth(s);
        if px + charWidth > x then
        begin
          if px + charWidth div 2 > x then
            CharSide := csLeft
          else
            CharSide := csRight;

          Exit(i);
        end;

        px := px + charWidth;
      end;

      i := i + CharLenInBytes;
    end;

    CharSide := csBefore;
    Result := EndLine;
  end;

begin
  if FLineList.Count = 0 then
    Exit(-1);

  yIndex := y div FTextHeight;
  if yIndex >= FLineList.Count then
    yIndex := FLineList.Count - 1;
  if yIndex < 0 then
    yIndex := 0;

  // Get position of first character of the line.
  StartLine := FLineList.Items[yIndex];
  // Get position of last character of the line.
  EndLine   := GetEndOfLine(StartLine);

  if x = 0 then
  begin
    CharSide := csBefore;
    Exit(StartLine);
  end;

  case ViewerMode of
    vmBin:
      Result := XYPos2AdrBin;
    vmHex:
      Result := XYPos2AdrHex;
    vmText, vmWrap, vmBook:
      Result := XYPos2AdrText;
    else
      raise Exception.Create('Invalid viewer mode');
  end;
end;

procedure TViewerControl.SelectAll;
begin
  SelectText(FLowLimit, FHighLimit);
end;

procedure TViewerControl.SelectText(AStart, AEnd: PtrInt);
begin
  if AStart < FLowLimit then
    AStart := FLowLimit;
  if AEnd > FHighLimit then
    AEnd := FHighLimit;

  if AStart <= AEnd then
  begin
    FBlockBeg := AStart;
    FBlockEnd := AEnd;
    Invalidate;
  end;
end;

procedure TViewerControl.CopyToClipboard;
var
  sText, utf8Text: string;
begin
  if (FBlockEnd - FBlockBeg) <= 0 then
    Exit;
  if (FBlockEnd - FBlockBeg) > 1024 * 1024 then // Max 1 MB to clipboard
    Exit;
  SetString(sText, GetDataAdr + FBlockBeg, FBlockEnd - FBlockBeg);
  utf8Text := ConvertToUTF8(sText);
  {$IFDEF LCLGTK2}
  // Workaround for Lazarus bug #0021453. LCL adds trailing zero to clipboard in Clipboard.AsText.
  Clipboard.Clear;
  Clipboard.AddFormat(PredefinedClipboardFormat(pcfText), utf8Text[1], Length(utf8Text));
  {$ELSE}
  Clipboard.AsText := utf8Text;
  {$ENDIF}
end;

function TViewerControl.GetNextCharAsAscii(const iPosition: PtrInt; out CharLenInBytes: Integer): Cardinal;
var
  u1, u2: Word;
  InvalidCharLen: Integer;
begin
  Result := 0;
  case FEncoding of
    veUtf8, veUtf8bom:
      begin
        if iPosition < FHighLimit then
        begin
          CharLenInBytes := SafeUTF8NextCharLen(GetDataAdr + iPosition,
                                                FHighLimit - iPosition,
                                                InvalidCharLen);

          // It's enough to only return Ascii.
          if CharLenInBytes = 1 then
            Result := PByte(GetDataAdr)[iPosition];

          // Full conversion:
          // Result := UTF8CharacterToUnicode(PAnsiChar(GetDataAdr + iPosition), CharLenInBytes);
        end
        else
          CharLenInBytes := 0;
      end;

    veAnsi,
    veCp1250..veCp950,
    veIso88591,
    veIso88592,
    veKoi8:
      if iPosition < FHighLimit then
      begin
        Result := PByte(GetDataAdr)[iPosition];
        CharLenInBytes := 1;
      end
      else
        CharLenInBytes := 0;

    veUcs2be:
      if iPosition + SizeOf(Word) - 1 < FHighLimit then
      begin
        Result := BEtoN(PWord(GetDataAdr + iPosition)[0]);
        CharLenInBytes := SizeOf(Word);
      end
      else
        CharLenInBytes := 0;

    veUcs2le:
      if iPosition + SizeOf(Word) - 1 < FHighLimit then
      begin
        Result := LEtoN(PWord(GetDataAdr + iPosition)[0]);
        CharLenInBytes := SizeOf(Word);
      end
      else
        CharLenInBytes := 0;

    veUtf16be:
      if iPosition + SizeOf(Word) - 1 < FHighLimit then
      begin
        u1 := BEtoN(PWord(GetDataAdr + iPosition)[0]);
        CharLenInBytes := UTF16CharacterLength(@u1);
        if CharLenInBytes = 1 then
        begin
          Result := u1;
        end
        else if iPosition + SizeOf(Word) * CharLenInBytes - 1 < FHighLimit then
        begin
          u2 := BEtoN(PWord(GetDataAdr + iPosition)[1]);
          Result := utf16PairToUnicode(u1, u2);
        end;

        CharLenInBytes := CharLenInBytes * SizeOf(Word);
      end
      else
        CharLenInBytes := 0;

    veUtf16le:
      if iPosition + SizeOf(Word) - 1 < FHighLimit then
      begin
        u1 := LEtoN(PWord(GetDataAdr + iPosition)[0]);
        CharLenInBytes := UTF16CharacterLength(@u1);
        if CharLenInBytes = 1 then
        begin
          Result := u1;
        end
        else if iPosition + SizeOf(Word) * CharLenInBytes - 1 < FHighLimit then
        begin
          u2 := LEtoN(PWord(GetDataAdr + iPosition)[1]);
          Result := utf16PairToUnicode(u1, u2);
        end
        else
          CharLenInBytes := 0;

        CharLenInBytes := CharLenInBytes * SizeOf(Word);
      end
      else
        CharLenInBytes := 0;

    veUtf32be:
      if iPosition + SizeOf(LongWord) - 1 < FHighLimit then
      begin
        Result := BEtoN(PLongWord(GetDataAdr + iPosition)[0]);
        CharLenInBytes := SizeOf(LongWord);
      end
      else
        CharLenInBytes := 0;

    veUtf32le:
      if iPosition + SizeOf(LongWord) - 1 < FHighLimit then
      begin
        Result := LEtoN(PLongWord(GetDataAdr + iPosition)[0]);
        CharLenInBytes := SizeOf(LongWord);
      end
      else
        CharLenInBytes := 0;

    else
      raise Exception.Create('Unsupported viewer encoding');
  end;
end;

function TViewerControl.GetPrevCharAsAscii(const iPosition: PtrInt; out CharLenInBytes: Integer): Cardinal;
var
  u1, u2: Word;
  InvalidCharLen: Integer;
begin
  Result := 0;
  case FEncoding of
    veUtf8, veUtf8bom:
      begin
        if iPosition > FLowLimit then
        begin
          CharLenInBytes := SafeUTF8PrevCharLen(GetDataAdr + iPosition,
                                                iPosition - FLowLimit,
                                                InvalidCharLen);

          // It's enough to only return Ascii.
          if CharLenInBytes = 1 then
            Result := PByte(GetDataAdr)[iPosition - 1];

          // Full conversion:
          // Result := UTF8CharacterToUnicode(PAnsiChar(GetDataAdr + iPosition - CharLenInBytes), CharLenInBytes);
        end
        else
          CharLenInBytes := 0;
      end;

    veAnsi,
    veCp1250..veCp950,
    veIso88591,
    veIso88592,
    veKoi8:
      if iPosition > FLowLimit then
      begin
        Result := PByte(GetDataAdr + iPosition)[-1];
        CharLenInBytes := 1;
      end
      else
        CharLenInBytes := 0;

    veUcs2be:
      if iPosition >= FLowLimit + SizeOf(Word) then
      begin
        Result := BEtoN(PWord(GetDataAdr + iPosition)[-1]);
        CharLenInBytes := SizeOf(Word);
      end
      else
        CharLenInBytes := 0;

    veUcs2le:
      if iPosition >= FLowLimit + SizeOf(Word) then
      begin
        Result := LEtoN(PWord(GetDataAdr + iPosition)[-1]);
        CharLenInBytes := SizeOf(Word);
      end
      else
        CharLenInBytes := 0;

    veUtf16be:
      if iPosition >= FLowLimit + SizeOf(Word) then
      begin
        u1 := BEtoN(PWord(GetDataAdr + iPosition)[-1]);
        CharLenInBytes := UTF16CharacterLength(@u1);
        if CharLenInBytes = 1 then
        begin
          Result := u1;
        end
        else if iPosition >= FLowLimit + SizeOf(Word) * CharLenInBytes then
        begin
          u2 := BEtoN(PWord(GetDataAdr + iPosition)[-2]);
          // u2 is the first, u1 is the second value of the pair
          Result := utf16PairToUnicode(u2, u1);
        end;

        CharLenInBytes := CharLenInBytes * SizeOf(Word);
      end
      else
        CharLenInBytes := 0;

    veUtf16le:
      if iPosition >= FLowLimit + SizeOf(Word) then
      begin
        u1 := LEtoN(PWord(GetDataAdr + iPosition)[-1]);
        CharLenInBytes := UTF16CharacterLength(@u1);
        if CharLenInBytes = 1 then
        begin
          Result := u1;
        end
        else if iPosition >= FLowLimit + SizeOf(Word) * CharLenInBytes then
        begin
          u2 := LEtoN(PWord(GetDataAdr + iPosition)[-2]);
          // u2 is the first, u1 is the second value of the pair
          Result := utf16PairToUnicode(u2, u1);
        end;

        CharLenInBytes := CharLenInBytes * SizeOf(Word);
      end
      else
        CharLenInBytes := 0;

    veUtf32be:
      if iPosition >= FLowLimit + SizeOf(LongWord) then
      begin
        Result := BEtoN(PLongWord(GetDataAdr + iPosition)[-1]);
        CharLenInBytes := SizeOf(LongWord);
      end
      else
        CharLenInBytes := 0;

    veUtf32le:
      if iPosition >= FLowLimit + SizeOf(LongWord) then
      begin
        Result := LEtoN(PLongWord(GetDataAdr + iPosition)[-1]);
        CharLenInBytes := SizeOf(LongWord);
      end
      else
        CharLenInBytes := 0;

    else
      raise Exception.Create('Unsupported viewer encoding');
  end;
end;

function TViewerControl.GetNextCharAsUtf8(const iPosition: PtrInt; out CharLenInBytes: Integer): UTF8String;
var
  u1: Word;
  s: string;
  InvalidCharLen: Integer;
begin
  Result := '';
  case FEncoding of
    veUtf8, veUtf8bom:
      CharLenInBytes := SafeUTF8NextCharLen(GetDataAdr + iPosition,
                                            FHighLimit - iPosition,
                                            InvalidCharLen);
    veAnsi,
    veCp1250..veCp950,
    veIso88591,
    veIso88592,
    veKoi8:
      CharLenInBytes := 1;
    veUcs2be, veUcs2le:
      CharLenInBytes := 2;
    veUtf16be:
      if iPosition + SizeOf(Word) - 1 < FHighLimit then
      begin
        u1 := BEtoN(PWord(GetDataAdr + iPosition)[0]);
        CharLenInBytes := UTF16CharacterLength(@u1) * SizeOf(Word);
      end
      else
        CharLenInBytes := 0;
    veUtf16le:
      if iPosition + SizeOf(Word) - 1 < FHighLimit then
      begin
        u1 := LEtoN(PWord(GetDataAdr + iPosition)[0]);
        CharLenInBytes := UTF16CharacterLength(@u1) * SizeOf(Word);
      end
      else
        CharLenInBytes := 0;
    veUtf32be, veUtf32le:
      CharLenInBytes := 4;
    else
      raise Exception.Create('Unsupported viewer encoding');
  end;

  if (CharLenInBytes > 0) and (iPosition + CharLenInBytes - 1 < FHighLimit) then
  begin
    SetString(s, GetDataAdr + iPosition, CharLenInBytes);
    Result := ConvertToUTF8(s);
  end
  else
    Result := '';
end;

function TViewerControl.ConvertToUTF8(const sText: AnsiString): UTF8String;
begin
  if FEncoding = veAutoDetect then
    FEncoding := DetectEncoding;  // Force detect encoding.

  case FEncoding of
    veAutoDetect: ;
    veUtf8, veUtf8bom:
      Result := Utf8ReplaceBroken(sText);
    veUtf16be:
      Result := Utf16BEToUtf8(sText);
    veUtf16le:
      Result := Utf16LEToUtf8(sText);
    veUtf32be:
      Result := Utf32BEToUtf8(sText);
    veUtf32le:
      Result := Utf32LEToUtf8(sText);
    else
      Result := LConvEncoding.ConvertEncoding(sText,
                    ViewerEncodingsNames[FEncoding], EncodingUTF8);
  end;
end;

function TViewerControl.ConvertFromUTF8(const sText: UTF8String): AnsiString;
begin
  if FEncoding = veAutoDetect then
    FEncoding := DetectEncoding;  // Force detect encoding.

  case FEncoding of
    veAutoDetect: ;
    veUtf8, veUtf8bom:
      Result := sText;
    veUtf16be:
      Result := Utf8ToUtf16BE(sText);
    veUtf16le:
      Result := Utf8ToUtf16LE(sText);
    veUtf32be:
      Result := '';//Utf8ToUtf32BE(sText);
    veUtf32le:
      Result := '';//Utf8ToUtf32LE(sText);
    else
      Result := LConvEncoding.ConvertEncoding(sText,
                    EncodingUTF8, ViewerEncodingsNames[FEncoding]);
  end;
end;

function TViewerControl.IsVisible(const aPosition: PtrInt): Boolean;
var
  StartPos: PtrInt;
  CharLenInBytes: Integer;
begin
  if IsFileOpen and (FLineList.Count > 0) then
    begin
      FVisibleOffset:= 0;
      StartPos:= GetStartOfLine(aPosition);
      // Calculate horizontal offset in symbols
      while (StartPos < aPosition) do
      begin
        GetNextCharAsAscii(StartPos, CharLenInBytes);
        Inc(StartPos, CharLenInBytes);
        Inc(FVisibleOffset);
      end;

      Result := (aPosition >= FLineList.Items[0]) and
                (aPosition <= FLineList.Items[FLineList.Count - 1]) and
                (FVisibleOffset >= FHPosition) and
                (FVisibleOffset <= FHPosition + FTextWidth);
    end
  else
    Result := False;
end;

procedure TViewerControl.MakeVisible(const aPosition: PtrInt);
begin
  if not IsVisible(aPosition) then
  begin
    SetPosition(aPosition);
    Scroll(-4);

    Update;

    if (FVisibleOffset < FHPosition) or
       (FVisibleOffset > FHPosition + FTextWidth) then
    begin
      SetHPosition(FVisibleOffset);
      HScroll(-1);
    end;
  end;
end;

procedure TViewerControl.ScrollBarVertScroll(Sender: TObject;
  ScrollCode: TScrollCode; var ScrollPos: Integer);
begin
  FUpdateScrollBarPos := False;
  case ScrollCode of
    scLineUp:     Scroll(-1);
    scLineDown:   Scroll(1);
    scPageUp:     PageUp;
    scPageDown:   PageDown;
    scTop:        GoHome;
    scBottom:     GoEnd;
    scTrack,
    scPosition:
      begin
        // This check helps avoiding loops if changing ScrollPos below
        // triggers another scPosition message.
        if (ScrollCode = scTrack) or (ScrollPos <> FScrollBarPosition) then
        begin
          if ScrollPos = 0 then
            GoHome
          else if ScrollPos = 100 then
            GoEnd
          else
            Percent := ScrollPos;
        end;
      end;
    scEndScroll:
      begin
      end;
  end;

  ScrollPos := FScrollBarPosition;
  FUpdateScrollBarPos := True;
end;

procedure TViewerControl.ScrollBarHorzScroll(Sender: TObject;
  ScrollCode: TScrollCode; var ScrollPos: Integer);
begin
  FUpdateScrollBarPos := False;
  case ScrollCode of
    scLineUp:     HScroll(-1);
    scLineDown:   HScroll(1);
    scPageUp:     HPageUp;
    scPageDown:   HPageDown;
    scTop:        HGoHome;
    scBottom:     HGoEnd;
    scTrack,
    scPosition:
      begin
        // This check helps avoiding loops if changing ScrollPos below
        // triggers another scPosition message.
        if (ScrollCode = scTrack) or (ScrollPos <> FHScrollBarPosition) then
        begin
          if ScrollPos = 0 then
            HGoHome
          else if ScrollPos = 100 then
            HGoEnd
            else
         HScroll((FHLowEnd - FTextWidth) * ScrollPos div 100 - FHPosition);
        end;
      end;
    scEndScroll:
      begin
      end;
  end;
  ScrollPos := FHScrollBarPosition;
  FUpdateScrollBarPos := True;
end;

procedure TViewerControl.UpdateScrollbars;
begin
  FScrollBarVert.LargeChange := GetClientHeightInLines - 1;
  case ViewerMode of
    vmBin, vmHex:
    begin
      //FScrollBarVert.PageSize :=
      //  ((FHighLimit div cHexWidth - GetClientHeightInLines) div 100);
    end
    else
      FScrollBarVert.PageSize := 1;
  end;
  FScrollBarHorz.Visible:= (FViewerMode = vmText);
end;

procedure TViewerControl.ViewerResize(Sender: TObject);
begin
  UpdateScrollbars;
  // Force recalculating position.
  SetPosition(FPosition);
  SetHPosition(FHPosition);
end;

procedure TViewerControl.ReReadFile;
begin
  FBlockBeg := 0;
  FBlockEnd := 0;

  FBOMLength := GetBomLength;
  UpdateLimits;

  UpdateScrollbars;
  Invalidate;
end;

function TViewerControl.IsFileOpen: Boolean;
begin
  Result := Assigned(FMappedFile);
end;

function TViewerControl.DetectEncoding: TViewerEncoding;
var
  DetectStringLength: Integer = 2048; // take first 2kB of the file to detect encoding
  DetectString: String;
  DetectedEncodingName: String;
  Enc: TViewerEncoding;
begin
  if IsFileOpen then
  begin
    // Default to Ansi in case encoding cannot be detected or is unsupported.
    Result := veAnsi;

    if FFileSize < DetectStringLength then
      DetectStringLength := FFileSize;

    SetString(DetectString, PAnsiChar(FMappedFile), DetectStringLength);

    if Assigned(FOnGuessEncoding) then
      DetectedEncodingName := FOnGuessEncoding(DetectString)
    else
      DetectedEncodingName := LConvEncoding.GuessEncoding(DetectString);

    if DetectedEncodingName <> '' then
    begin
      DetectedEncodingName := NormalizeEncoding(DetectedEncodingName);

      // Map UCS-2 to UTF-16.
      if DetectedEncodingName = 'ucs2le' then
        DetectedEncodingName := 'utf16le'
      else if DetectedEncodingName = 'ucs2be' then
        DetectedEncodingName := 'utf16be';

      for Enc := Low(TViewerEncoding) to High(TViewerEncoding) do
      begin
        if NormalizeEncoding(ViewerEncodingsNames[Enc]) = DetectedEncodingName then
        begin
          Result := Enc;
          break;
        end;
      end;
    end;
  end
  else
    Result := veAutoDetect;
end;

procedure TViewerControl.GetSupportedEncodings(List: TStrings);
var
  Enc: TViewerEncoding;
begin
  for Enc := Low(TViewerEncoding) to High(TViewerEncoding) do
    List.Add(ViewerEncodingsNames[Enc]);
end;

function TViewerControl.GetBomLength: Integer;
begin
  Result := 0;

  case FEncoding of
    veUtf8, veUtf8bom:
      if (FFileSize >= 3) and
         (PByte(FMappedFile)[0] = $EF) and
         (PByte(FMappedFile)[1] = $BB) and
         (PByte(FMappedFile)[2] = $BF) then
      begin
        Result := 3;
      end;

    veUcs2be, veUtf16be:
      if (FFileSize >= 2) and
         (PByte(FMappedFile)[0] = $FE) and
         (PByte(FMappedFile)[1] = $FF) then
      begin
        Result := 2;
      end;

    veUcs2le, veUtf16le:
      if (FFileSize >= 2) and
         (PByte(FMappedFile)[0] = $FF) and
         (PByte(FMappedFile)[1] = $FE) then
      begin
        Result := 2;
      end;

    veUtf32be:
      if (FFileSize >= 4) and
         (PByte(FMappedFile)[0] = $00) and
         (PByte(FMappedFile)[1] = $00) and
         (PByte(FMappedFile)[2] = $FE) and
         (PByte(FMappedFile)[3] = $FF) then
      begin
        Result := 4;
      end;

    veUtf32le:
      if (FFileSize >= 4) and
         (PByte(FMappedFile)[0] = $00) and
         (PByte(FMappedFile)[1] = $00) and
         (PByte(FMappedFile)[2] = $FF) and
         (PByte(FMappedFile)[3] = $FE) then
      begin
        Result := 4;
      end;
  end;
end;

procedure TViewerControl.UpdateLimits;
begin
  if FEncoding = veAutoDetect then
    FEncoding := DetectEncoding;

  FBOMLength := GetBomLength;

  case FViewerMode of
    vmText, vmWrap, vmBook:
      begin
        FLowLimit  := 0;
        FHighLimit := FFileSize - FBOMLength;
      end;
    else
      begin
        FLowLimit  := 0;
        FHighLimit := FFileSize;
      end;
  end;
end;

procedure TViewerControl.UpdateSelection;

  procedure Check(var aPosition: PtrInt; Backwards: Boolean);
  var
    CharStart: Pointer;
  begin
    case FEncoding of
      veUtf8, veUtf8bom:
        begin
          if not Backwards then
          begin
            CharStart := SafeUTF8NextCharStart(GetDataAdr + aPosition,
                                               FHighLimit - aPosition);
            if Assigned(CharStart) then
              aPosition := CharStart - GetDataAdr
            else
              aPosition := 0;
          end
          else
          begin
            CharStart := SafeUTF8PrevCharEnd(GetDataAdr + aPosition,
                                             aPosition - FLowLimit);
            if Assigned(CharStart) then
              aPosition := CharStart - GetDataAdr
            else
              aPosition := 0;
          end;
        end;

      veAnsi,
      veCp1250..veCp950,
      veIso88591,
      veIso88592,
      veKoi8:
        ; // any position allowed

      veUcs2be, veUcs2le:
        aPosition := ((aPosition - FLowLimit) and not 1) + FLowLimit;
      veUtf16be, veUtf16le:
        // todo: check if not in the middle of utf-16 character
        aPosition := ((aPosition - FLowLimit) and not 1) + FLowLimit;
      veUtf32be, veUtf32le:
        aPosition := ((aPosition - FLowLimit) and not 3) + FLowLimit;

      else
        raise Exception.Create('Unsupported viewer encoding');
    end;
  end;

begin
  if (FBlockBeg < FLowLimit) or (FBlockBeg >= FHighLimit) or
     (FBlockEnd < FLowLimit) or (FBlockEnd >= FHighLimit) then
  begin
    FBlockBeg := FLowLimit;
    FBlockEnd := FLowLimit;
  end
  else
  begin
    case FViewerMode of
      vmText, vmWrap, vmBook:
        begin
          Check(FBlockBeg, False);
          Check(FBlockEnd, True);

          if (FBlockBeg < FLowLimit) or (FBlockBeg >= FHighLimit) or
             (FBlockEnd < FLowLimit) or (FBlockEnd >= FHighLimit) or
             (FBlockEnd < FBlockBeg) then
          begin
            FBlockBeg := FLowLimit;
            FBlockEnd := FLowLimit;
          end;
        end;
      // In non-text modes any selection is valid.
    end;
  end;
end;

procedure Register;
begin
  RegisterComponents('SeksiCmd', [TViewerControl]);
end;

end.

