hexedit.pas

=== === === MiniHex 1.61 源程序说明 ============================== “$(MiniHex)Source”目录中的所有

{**********************************************************}
{                                                          }
{  HexEdit Component Version 1.2                           }
{                                                          }
{  Author: DayDream Studio                                 }
{  Email: [e-mail]                                   }
{  URL: http://haoxg.yeah.net                              }
{  Last Modify Date: 2003-12-25                            }
{                                                          }
{**********************************************************}

unit HexEdit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Clipbrd;

const
  BookmarkCount = 10;
  DefUndoLimit = 10;
  MaxUndoLimit = 100;

  SHEDeleteError = 'Cannot delete whole buffer';
  SHEFontPitchError = 'Font must have the same width';
  
type

{ Exception classes }

  EHexEdit = class(Exception);

{ classes }

  TCustomHexEdit = class;  

{ records }

  TCharAttr = record
    FColor: TColor;
    BColor: TColor;
  end;

  TSelection = record
    Active: Boolean;
    StartOffset: Integer;      //based 0
    EndOffset: Integer;
  end;

  TBookmark = record
    Active: Boolean;
    DLen: Integer;
    CurInHex: Boolean;
  end;

{ THexEditActsMgr }

  // 动作类型
  THexEditActType = (atNone, atModify, atInsert, atDelete);

  PHexEditAct = ^THexEditAct;
  THexEditAct = record             // 动作记录
    Enabled: Boolean;              // 该动作是否能用
    ActType: THexEditActType;      // 动作类型
    Buf: string;                   // 缓冲区
    Offset: Integer;               // 偏移
    Count: Integer;                // 字节数
    CurPos: Integer;               // 光标位置
    Prev: PHexEditAct;             // Prev指针
    Next: PHexEditAct;             // Next指针
  end;

  THexEditActs = array of THexEditAct;

  THexEditActsMgr = class
  private
    FUndoActs: THexEditActs;       // Undo队列
    FUndoHead: PHexEditAct;        // 队列头指针
    FUndoTail: PHexEditAct;        // 队列尾指针
    FRedoActs: THexEditActs;       // Redo队列
    FRedoHead: PHexEditAct;        // 队列头指针
    FRedoTail: PHexEditAct;        // 队列尾指针
    FUndoLimit: Integer;           // 最大Undo次数

    procedure SetUndoLimit(Value: Integer);
    procedure InitAct(var Act: THexEditAct);
  public
    constructor Create(AUndoLimit: Integer);
    destructor Destroy; override;

    property UndoLimit: Integer read FUndoLimit write SetUndoLimit;

    function AddUndoItem: PHexEditAct;
    function AddRedoItem: PHexEditAct;
    function Undo: PHexEditAct;
    function Redo: PHexEditAct;
    function CanUndo: Boolean;
    function CanRedo: Boolean;
  end;

{ THexEditColors }

  THexEditColors = class(TPersistent)
  private
    FOwner: TCustomHexEdit;
    FAddressColor: TCharAttr;     // 地址区颜色
    FHexColor: TCharAttr;         // Hex区颜色
    FCharColor: TCharAttr;        // 字符区颜色
    FCaretColor: TCharAttr;       // 光标颜色
    FSelectionColor: TCharAttr;   // 块颜色

    function GetAddressColor(const Index: Integer): TColor;
    function GetHexColor(const Index: Integer): TColor;
    function GetCharColor(const Index: Integer): TColor;
    function GetCaretColor(const Index: Integer): TColor;
    function GetSelectionColor(const Index: Integer): TColor;

    procedure SetAddressColor(const Index: Integer; const Value: TColor);
    procedure SetHexColor(const Index: Integer; const Value: TColor);
    procedure SetCharColor(const Index: Integer; const Value: TColor);
    procedure SetCaretColor(const Index: Integer; const Value: TColor);
    procedure SetSelectionColor(const Index: Integer; const Value: TColor);
  public
    constructor Create(AOwner: TCustomHexEdit); virtual;
    destructor Destroy; override;

    property AddressColor: TCharAttr read FAddressColor;
    property HexColor: TCharAttr read FHexColor;
    property CharColor: TCharAttr read FCharColor;
    property CaretColor: TCharAttr read FCaretColor;
    property SelectionColor: TCharAttr read FSelectionColor;
  published
    property AddressBackColor: TColor index 0 read GetAddressColor write SetAddressColor default clWhite;
    property AddressForeColor: TColor index 1 read GetAddressColor write SetAddressColor default clBlue;
    property HexBackColor: TColor index 0 read GetHexColor write SetHexColor default clWhite;
    property HexForeColor: TColor index 1 read GetHexColor write SetHexColor default clBlack;
    property CharBackColor: TColor index 0 read GetCharColor write SetCharColor default clWhite;
    property CharForeColor: TColor index 1 read GetCharColor write SetCharColor default clBlack;
    property CaretBackColor: TColor index 0 read GetCaretColor write SetCaretColor default clBlue;
    property CaretForeColor: TColor index 1 read GetCaretColor write SetCaretColor default clWhite;
    property SelectionBackColor: TColor index 0 read GetSelectionColor write SetSelectionColor default clNavy;
    property SelectionForeColor: TColor index 1 read GetSelectionColor write SetSelectionColor default clWhite;
  end;

{ TCustomHexEdit }

  TScrollKind = (skHorizontal, skVertical);
  // 字符显示方式(常规、特殊字符用点表示、显示双字节字符)
  TDrawCharStyle = (dcGeneral, dcDotForSpec, dcDblByteChar);
  // 编辑器选项
  THexEditOption = (hoEditing, hoShowCaret, hoAutoHideSelection, hoAllowSelect);
  THexEditOptions = set of THexEditOption;
  // 移动光标的方式
  TMoveCaretMode = (mcStart, mcEnd, mcSelStart, mcSelEnd, mcLineStart, mcLineEnd);

  TIntegerType = (itShortInt, itSmallInt, itLongInt, itInt64, itByte, itWord, itLongWord);
  TFloatType = (ftSingle, ftDouble, ftReal48, ftExtended);
  // 查找文本选项
  TSearchTextOptions = record
    MatchCase: Boolean;
    WholeWord: Boolean;
    Unicode: Boolean;
    OnlyBlock: Boolean;
    UseWild: Boolean;
    WildChar: Char;
    WildCount: Integer;
  end;
  // 查找十六进制串选项
  TSearchHexOptions = record
    OnlyBlock: Boolean;
    UseWild: Boolean;
    WildChar: Char;
    WildCount: Integer;
  end;
  // 查找整型数选项
  TSearchIntOptions = record
    IntegerType: TIntegerType;
    OnlyBlock: Boolean;
  end;
  // 查找浮点数选项
  TSearchFloatOptions = record
    FloatType: TFloatType;
    Blur: Boolean;
    BlurValue: Extended;
    OnlyBlock: Boolean;
  end;

  TCustomHexEdit = class(TCustomControl)
  private
    FStream: TMemoryStream;       // 缓冲区
    FRowCount: Integer;           // 总行数
    FTopRow: Integer;             // 顶行的绝对行号(based 0)
    FLeftCol: Integer;            // 最左行的绝对列号(based 0)
    FCurRow: Integer;             // 光标所在的绝对行号(based 0)
    FCurCol: Integer;             // 光标所在的列号(based 0)
    FVisRowCount: Integer;        // 窗口所能容纳的行数
    FCurInHex: Boolean;           // 光标是否在HEX区域
    FCurInHigh: Boolean;          // 光标是否在高4位区域
    FCtrlKPressed: Boolean;       // Ctrl + K 是否按下
    FCtrlQPressed: Boolean;       // Ctrl + Q 是否按下
    FMouseDownFlag: Boolean;      // Mouse是否按下
    FMouseDblClkFlag: Boolean;    // Mouse是否Double Click
    FMsDownOffset: Integer;       // Mouse按下时指针所在位置的偏移值
    FMsMoveSameItem: Boolean;     // Mouse拖动定义块时，是否还在按下时的字节上
    FSelection: TSelection;       // 选中区域
    FBookmark: array[0..BookmarkCount-1] of TBookmark;   // 书签
    FModified: Boolean;           // 是否被修改
    FCharWidth: Integer;          // 字符宽度
    FCharHeight: Integer;         // 字符高度
    FFocused: Boolean;            // 当前是否得到焦点
    FActsMgr: THexEditActsMgr;    // 管理 Undo Redo

    FBorderStyle: TBorderStyle;
    FScrollBars: TScrollStyle;
    FColors: THexEditColors;      // 背景和字符的颜色
    FDrawCharStyle: TDrawCharStyle; // 显示字符的方式
    FMargin: Integer;             // 边界宽度
    FOptions: THexEditOptions;    // 编辑器选项

    FOnChange: TNotifyEvent;
    FOnSelectionChange: TNotifyEvent;
    FOnCaretMove: TNotifyEvent;

    function GetDataAddr: PChar;
    function GetDataSize: Integer;
    function GetRowCount(Size: Integer): Integer;
    function GetRowPointer(AbsRow: Integer): PChar;
    function GetRowColPointer(AbsRow, Col: Integer): PChar;
    function GetOffset(AbsRow, Col: Integer): Integer; overload;
    function GetOffset: Integer; overload;
    function GetOffsetForProperty: Integer;
    function GetDLen(AbsRow, Col: Integer; CurInHigh: Boolean): Integer; overload;
    function GetDLen: Integer; overload;
    function GetRowTotalWidth: Integer;
    function GetAddrAreaLeft: Integer;
    function GetHexAreaLeft: Integer;
    function GetChrAreaLeft: Integer;
    function GetCharAttrByRowCol(AbsRow, Col: Integer; CurInHex: Boolean): TCharAttr;
    function GetOffsetByMove(DLenOffset: Integer): Integer;
    function GetOffsetByMoveTo(DLen: Integer): Integer;
    function GetHexAreaStr(AbsRow: Integer): string;
    function GetChrAreaStr(AbsRow: Integer): string;
    function GetStrAtPos(Offset, Count: Integer; var S: string): Boolean;
    function GetUndoLimit: Integer;
    function GetFont: TFont;
    function GetSelStart: Integer;
    function GetSelLength: Integer;
    function GetSelData: string;

    procedure SetDataSize(Value: Integer);
    procedure SetOffset(Value: Integer);
    procedure SetTopRow(Value: Integer);
    procedure SetBorderStyle(Value: TBorderStyle);
    procedure SetScrollBars(Value: TScrollStyle);
    procedure SetDrawCharStyle(Value: TDrawCharStyle);
    procedure SetUndoLimit(Value: Integer);
    procedure SetOptions(Value: THexEditOptions);
    procedure SetFont(Value: TFont);
    procedure SetSelStart(Value: Integer);
    procedure SetSelLength(Value: Integer);
    procedure SetSelData(const S: string);

    procedure DataLoaded;
    procedure InitCharSize;
    procedure InitFont;
    procedure InitSearchOptions;

    function DLenToOffset(DLen: Integer): Integer;
    function OffsetToDLen(AOffset: Integer): Integer;
    procedure PosToDLen(var DLen: Integer; AbsRow, Col: Integer; CurInHigh: Boolean);
    procedure DLenToPos(var AbsRow, Col: Integer; var CurInHigh: Boolean; DLen: Integer);
    function  XYToRowCol(var OffRow, Col: Integer;
      var CurInHex, CurInHigh: Boolean; X, Y: Integer): Boolean;

    procedure MoveCaret(DLenOffset: Integer; Force: Boolean = False); overload;
    procedure MoveCaretTo(DLen: Integer; Force: Boolean = False);
    procedure RestrictCaret;
    function CheckCaretInWindow: Boolean;

    procedure AdjustSelectionA(Offset1, Offset2: Integer);
    procedure AdjustSelectionB(Offset1, Offset2: Integer);
    procedure SetSelection(StartOffset, EndOffset: Integer; Redraw: Boolean = False);
    procedure SetSelectionStart(StartOffset: Integer; Redraw: Boolean = False);
    procedure SetSelectionEnd(EndOffset: Integer; Redraw: Boolean = False);
    procedure SetSelectionVisible(Value: Boolean = True);
    procedure CancelSelection(Redraw: Boolean = False);
    procedure CancelSelByUser(Redraw: Boolean = False);
    procedure RestrictSelection;
    function CheckInSelection(Offset: Integer): Boolean;
    procedure GetOffsetRange(var StartOffset, EndOffset: Integer; OnlyBlock, FromCursor: Boolean);

    procedure UpdateVertScrollBar;
    procedure UpdateHorzScrollBar;
    procedure UpdateScrollPage(AScrollKind: TScrollKind; APage: Integer);
    procedure UpdateScrollMax(AScrollKind: TScrollKind; AMax: Integer);
    procedure UpdateScrollPos(AScrollKind: TScrollKind; APos: Integer);

    procedure DrawText(X, Y: Integer; S: string; CharAttr: TCharAttr);
    procedure DrawAddrRow(OffRow, AbsRow: Integer);
    procedure DrawHexRow(OffRow, AbsRow: Integer);
    procedure DrawChrRow(OffRow, AbsRow: Integer);
    procedure DrawStrForChrRow(S: string; OffRow, Col: Integer; CharAttr: TCharAttr);
    procedure DrawOneRow(OffRow, AbsRow: Integer);
    procedure DrawSpcRow(OffRow: Integer);
    procedure DrawHexItem(OffRow, Col: Integer; HexCharAttr: TCharAttr);
    procedure DrawChrItem(OffRow, Col: Integer; ChrCharAttr: TCharAttr);
    procedure DrawItem(OffRow, Col: Integer; HexCharAttr, ChrCharAttr: TCharAttr);
    procedure DrawCurItem(Show: Boolean = True);
    procedure DrawCurItemHighlight(Show: Boolean = True);
    procedure DrawAllRow;

    procedure DoUpKey(ShiftPressed: Boolean);
    procedure DoDownKey(ShiftPressed: Boolean);
    procedure DoLeftKey(ShiftPressed: Boolean);
    procedure DoRightKey(ShiftPressed: Boolean);
    procedure DoPageUpKey(ShiftPressed: Boolean);
    procedure DoPageDownKey(ShiftPressed: Boolean);
    procedure DoHomeKey(ShiftPressed: Boolean);
    procedure DoEndKey(ShiftPressed: Boolean);
    procedure DoTabKey;
    procedure DoCtrlJKey;
    procedure DoCtrlKKey(Key: Word);
    procedure DoCtrlQKey(Key: Word);
    procedure DoCtrlKNumKey(Key: Word);
    procedure DoCtrlKBKey(Key: Word);
    procedure DoCtrlKKKey(Key: Word);
    procedure DoCtrlKHKey(Key: Word);
    procedure DoCtrlKWKey(Key: Word);
    procedure DoCtrlQNumKey(Key: Word);
    procedure DoCtrlUpKey(MoveCaret: Boolean = True);
    procedure DoCtrlDownKey(MoveCaret: Boolean = True);
    procedure DoCtrlLeftKey;
    procedure DoCtrlRightKey;
    procedure DoCtrlPageUpKey(ShiftPressed: Boolean);
    procedure DoCtrlPageDownKey(ShiftPressed: Boolean);
    procedure DoCharKey(Key: Char);
    procedure DoCharKeyForHexArea(Key: Char);
    procedure DoCharKeyForChrArea(Key: Char);

    function CreateUndoForModify(Offset, OldCount, NewCount: Integer): Boolean;
    function CreateUndoForInsert(Offset, Count: Integer): Boolean;
    function CreateUndoForDelete(Offset, Count: Integer): Boolean;
    function CreateRedoForModify(Offset, OldCount, NewCount: Integer): Boolean;
    function CreateRedoForInsert(Offset, Count: Integer): Boolean;
    function CreateRedoForDelete(Offset, Count: Integer): Boolean;

    procedure DoCreateCaret;
    procedure DoMouseRoll;
    procedure DoPaint;
    procedure DoResize;
    function  DoScroll(AScrollKind: TScrollKind; Msg: TWMScroll): Integer;
    procedure DoOnChange;
    procedure DoOnSelectionChange;
    procedure DoOnCaretMove;

    procedure InternalInsertData(Offset: Integer; const S: string);
    procedure InternalDeleteData(Offset, Count: Integer);
    procedure InternalModifyData(Offset: Integer; const S: string); overload;
    procedure InternalModifyData(Offset, Count: Integer; const S: string); overload;

    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
    procedure WMGetDlgCode(var Msg: TWMGetDlgCode); message WM_GETDLGCODE;
    procedure WMHScroll(var Msg: TWMHScroll); message WM_HSCROLL;
    procedure WMVScroll(var Msg: TWMVScroll); message WM_VSCROLL;
    procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
    procedure WMKillFocus(var Message: TWMSetFocus); message WM_KILLFOCUS;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure Paint; override;
    procedure DoEnter; override;
    procedure DoExit; override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyUp(var Key: Word; Shift: TShiftState); override;
    procedure KeyPress(var Key: Char); 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 DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean; override;
    function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override;
    function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override;
    procedure Click; override;
    procedure DblClick; override;
    procedure Resize; override;
    procedure Loaded; override;
    procedure AdjustSize; override;
  public
    SearchTextOptions: TSearchTextOptions;
    SearchHexOptions: TSearchHexOptions;
    SearchIntOptions: TSearchIntOptions;
    SearchFloatOptions: TSearchFloatOptions;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    function CanUndo: Boolean;
    function CanRedo: Boolean;
    function Undo: Boolean;
    function Redo: Boolean;
    function CanPaste: Boolean;
    procedure CutToClipboard;
    procedure CopyToClipboard;
    procedure PasteFromClipboard;
    procedure SelectAll;
    function IsEmpty: Boolean;
    procedure MoveCaret(MoveMode: TMoveCaretMode); overload;
    procedure SetBookmark(BkmkIndex: Integer);
    procedure GotoBookmark(BkmkIndex: Integer);
    function BookmarkExists(BkmkIndex: Integer): Boolean;

    procedure LoadFromFile(const FileName: string);
    procedure SaveToFile(const FileName: string);
    procedure LoadFromStream(Stream: TStream);
    procedure SaveToStream(Stream: TStream);
    procedure LoadFromBuffer(const Buffer; Count: Longint);
    function SaveToBuffer(var Buffer; Count: Longint): Longint;
    procedure GetEditorText(Lines: TStrings; IncludeAddr, OnlyBlock: Boolean);

    procedure InsertData(Offset: Integer; const Buffer; BufferSize: Integer;
      AllowUndo: Boolean = False); overload;
    procedure DeleteData(Offset, Count: Integer; AllowUndo: Boolean = False);
    procedure DeleteSelection(AllowUndo: Boolean = False);
    procedure ModifyData(Offset: Integer; const Buffer; BufferSize: Integer;
      AllowUndo: Boolean = False); overload;
    procedure ModifyData(Offset, Count: Integer; const Buffer; BufferSize: Integer;
      AllowUndo: Boolean = False); overload;

    function SearchText(const Text: string; FromCursor: Boolean): Boolean;
    function SearchHex(const HexStr: string; FromCursor: Boolean): Boolean;
    function SearchInt(Value: Int64; FromCursor: Boolean): Boolean;
    function SearchFloat(Value: Extended; FromCursor: Boolean): Boolean;

    property DataSize: Integer read GetDataSize write SetDataSize;
    property DataAddr: PChar read GetDataAddr;
    property Offset: Integer read GetOffsetForProperty write SetOffset;
    property TopRow: Integer read FTopRow write SetTopRow;
    property RowCount: Integer read FRowCount;
    property Modified: Boolean read FModified write FModified;
    property SelStart: Integer read GetSelStart write SetSelStart;
    property SelLength: Integer read GetSelLength write SetSelLength;
    property SelData: string read GetSelData write SetSelData;

    property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle;
    property ScrollBars: TScrollStyle read FScrollBars write SetScrollBars default ssBoth;
    property DrawCharStyle: TDrawCharStyle read FDrawCharStyle write SetDrawCharStyle default dcDblByteChar;
    property UndoLimit: Integer read GetUndoLimit write SetUndoLimit default DefUndoLimit;
    property Colors: THexEditColors read FColors write FColors;
    property Options: THexEditOptions read FOptions write SetOptions
      default [hoEditing, hoShowCaret, hoAutoHideSelection, hoAllowSelect];
    property Font: TFont read GetFont write SetFont;

    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property OnSelectionChange: TNotifyEvent read FOnSelectionChange write FOnSelectionChange;
    property OnCaretMove: TNotifyEvent read FOnCaretMove write FOnCaretMove;
  end;

{ THexEdit }

  THexEdit = class(TCustomHexEdit)
  published
    property BorderStyle;