(*



  TMPHexEditorEx v 02-06-2006<br>



  @author((C) markus stephany, vcl[at]mirkes[dot]de, all rights reserved.)

  @abstract(TMPHexEditorEx, an enhanced TMPHexEditor: print and preview, ole drag and drop,

            ole clipboard handling, file backups...)

  @lastmod(02-06-2006)



  credits to :<br><br>

  - John Hamm, http://users.snapjax.com/john/<br><br>



  - Christophe Le Corfec for introducing the EBCDIC format and the nice idea about

    half byte insert/delete<br><br>



  - Philippe Chessa for his suggestions about AsText, AsHex and better support for

    the french keyboard layout<br><br>



  - Daniel Jensen for octal offset display and the INS-key recognition stuff<br><br>



  - Shmuel Zeigerman for introducing more flexible offset display formats<br><br>



  - Vaf, http://carradio.al.ru for reporting missing delver.inc and suggesting OnChange<br><br>



  - Eugene Tarasov for reporting that setting the BytesPerColumn value to 4 at design

    time didn't work<br><br>



  - FuseBurner for BytesPerUnit/RulerBytesPerUnit related suggestions<br><br>



  - Motzi for SyncView/ShowPositionIfNotFocused related suggestions<br><br>



  - Martin Hsiao for bcb compatibility and reporting some bugs when moving cursor beyond eof<br><br>



  - Miyu for delphi 7 defines<br><br>



  - Nils Hoyer for bcb testing and his help on creating a BCB6 package<br><br>



  - Skamnitsly S.V for reporting a bug when doubleclicking the ruler bar<br><br>



  - Pete Fraser for reporting problems with array properties under BCB<br><br>



  - Andrew Novikov for bug reports and suggestions<br><br>



  - Al for bug reports<br><br>



  - Dieter Köhler for reporting the delphi vcl related CanFocus bug<br><br>



  - Piotr Likus for reporting a cardinal&lt;-&gt;integer related bug in the Undo method<br><br>



  - Marc Girod for bug reports<br><br>



  - Gerd Schwartz for reporting a bug with printing headers/footers that contain long texts<br><br>



  - Bogdan Ureche for reporting an integer overflow when moving the cursor over a large selection<br><br>



  <h3>history:</h3>

  <p><ul>

  <li>v 02-06-2006: february 06, 2006<br><br>

         - changes in the base class (@link(TCustomMPHexEditor)) only <br><br></li>



  <li>v 05-23-2005: may 23, 2005<br><br>

         - changes in the base class (@link(TCustomMPHexEditor)) only <br><br></li>



  <li>v 12-29-2004: december 29, 2004<br><br>

         - initialized Result to '' in some string functions/methods to avoid

           non empty Result vars at function startup due to compiler

           optimizations (particularly on d4), e.g. printing did not work

           correctly under d4<br>

         - updated some of the sample projects (fixed the broken bcb6 sample,

           added printing to the hex viewer and the bcb6 editor sample) <br><br></li>



  <li>v 12-28-2004: december 28, 2004<br><br>

         - changes in the base class (@link(TCustomMPHexEditor)) only <br><br></li>



  <li>v 12-21-2004: december 21, 2004<br><br>

         - changes in the base class (@link(TCustomMPHexEditor))<br>

         - support for CF_HTML clipboard format<br><br></li>



  <li>v 11-12-2004: november 12, 2004<br><br>

         - changes in the base class (@link(TCustomMPHexEditor))<br>

         - ole drag and drop move operation is now disabled if the editor's

           ReadOnlyView property is set to True<br><br></li>



  <li>v 10-26-2004: october 26, 2004<br><br>

         - changes in the base class (@link(TCustomMPHexEditor))/unit (@link(mphexeditor)) only <br><br></li>



  <li>v 08-29-2004: august 29, 2004<br><br>

         - changes in the base class (@link(TCustomMPHexEditor))<br>

         - added pfIncludeRuler to @link(TMPHPrintFlag)<br><br></li>



  <li>v 08-14-2004: august 14, 2004<br><br>

         - changed printing (color handling, pfSelectionBold meaning)<br><br></li>



  <li>v 06-15-2004: june 15, 2004<br><br>

         - changes in the base class (@link(TCustomMPHexEditor)) and some more inherited

           published properties <br><br></li>



  <li>v 06-10-2004: june 10, 2004<br><br>

         - changes in the base class (@link(TCustomMPHexEditor)) only <br><br></li>



  <li>v 06-07-2004: june 07, 2004<br><br>

         - changes in the base class (@link(TCustomMPHexEditor)) only <br><br></li>



  <li>v 05-27-2004: may 27, 2004<br><br>

         - changes in the base class (@link(TCustomMPHexEditor)) only <br><br></li>



  <li>v 05-13-2004: may 13, 2004<br><br>

         - changes in the base class (@link(TCustomMPHexEditor)) only <br><br></li>



  <li>v 04-18-2004: april 18, 2004<br><br>

         - changes in the base class (@link(TCustomMPHexEditor)) only <br><br></li>



  <li>v 01-08-2004: january 08, 2004<br><br>

         - changes in the base class (@link(TCustomMPHexEditor)) only <br><br></li>



  <li>v 12-16-2003: december 16, 2003<br><br>

         - changes in the base class (@link(TCustomMPHexEditor)) only <br><br></li>



  <li>v 12-10-2003: december 10, 2003<br><br>

         - changes in the base class (@link(TCustomMPHexEditor)) only <br><br></li>



  <li>v 09-24-2003: september 24, 2003 <br><br>

         - modified the BCB6 package <br><br></li>



  <li>v 09-09-2003: september 09, 2003<br><br>

         - changed @link(UndoBeginUpdate) and @link(UndoEndUpdate) behaviour to automatically create an undo record

           on UndoBeginUpdate and check it on UndoEndUpdate, see also @link(CreateUndoOnUndoUpdate)<br>

         - added property @link(CreateUndoOnUndoUpdate) <br>

         - added defines for delphi7, renamed delver.inc to mpdelver.inc <br>

         - @link(PasteData) method added <br><br></li>



  <li>v 07-05-2003: july 05, 2003<br><br>

         - added support for pasting clipboard data in fixed filesize mode<br>

         - added RegEdit_HexData clipboard support<br><br></li>



  <li>v 05-25-2003-b: may 25, 2003<br><br>

         - fixed a bug (moving the cursor beyond eof)<br><br></li>



  <li>v 05-25-2003: may 25, 2003<br><br>

         - no ':' is printed when offset display is not used<br>

         - added hpp generating statements for bcb compatibility<br><br></li>



  <li>v 05-20-2003: may 20, 2003<br><br>

         - added unicode support in printing<br><br></li>



  <li>v 05-17-2003: may 17, 2003<br><br>

         - moved some property related functions to protected<br>

         - corrected bottom margin handling when printing<br>

         - corrected upper/lowercase hex chars in printing<br>

         - the current unit is selected now when doubleclicking data<br>

         - added flags pfCurrentViewOnly (just print the currently

           visible data) to @link(PrintOptions).Flags<br><br></li>



  <li>v 08-18-2002: august 18, 2002<br><br>

         - first release</li>

  </ul></p>



*)



{$IFDEF BCB}

{$HPPEMIT 'DECLARE_DINTERFACE_TYPE(IDropTarget)'}

{$HPPEMIT 'DECLARE_DINTERFACE_TYPE(IDropSource)'}

{$HPPEMIT 'DECLARE_DINTERFACE_TYPE(IEnumFORMATETC)'}

{$ENDIF}



unit MPHexEditorEx;



{$I MPDELVER.INC}



interface



uses

  Windows, Messages, SysUtils, Classes, Controls, Forms,

  MPHexEditor, ActiveX, Graphics, Printers,

  ShlObj, Menus;



type

  //@exclude

  // is data dropped or pasted

  TMPHOLEOperation = (oleDrop, oleClipboard);



  // @exclude(available clipboard / IDataObject formats)

  TClipFormats = array of TClipFormat;



  // @exclude(ole drop handler class)

  TMPHDropTarget = class;



  // @exclude(persistent print options)

  TMPHPrintOptions = class;



  (* print option flags:<br><br>

    - pfSelectionOnly: only print data currently selected<br>

    - pfSelectionBold: render the current selection using either a bold font or inverted colors (if pfSelectionOnly isn't set)<br>

    - pfMonochrome: don't use colors, print/preview black on white<br>

    - pfUseBackgroundColor: fill the margin rect with the editor's background color (if pfMonochrome isn't set)<br>

    - pfCurrentViewOnly: just print the data currently displayed<br>

    - pfIncludeRuler: draw the ruler at every page's top<br>

  *)

  TMPHPrintFlag = (pfSelectionOnly, pfSelectionBold, pfMonochrome,

    pfUseBackgroundColor, pfCurrentViewOnly, pfIncludeRuler);

  // @exclude()

  TMPHPrintFlags = set of TMPHPrintFlag;



  // @exclude(print header/footer)

  TMPHPrintHeaders = array[0..1] of string;



  (* this event is called when @link(PropertiesAsString) is read or written. TMPHexEditorEx

    has a fixed list of properties that can be read/written using PropertiesAsString.

    you can exclude some of the properties by setting IsPublic to False.

  *)



  TMPHQueryPublicPropertyEvent = procedure(Sender: TObject; const PropertyName:

    string;

    var IsPublic: boolean) of object;



  // enhanced hex editor

  TMPHexEditorEx = class(TCustomMPHexEditor)

  private

    { Private-Deklarationen }

    FCreateBackups: boolean;

    FBackupFileExt: string;

    FOleDragDrop: boolean;

    FDropTarget: TMPHDropTarget;

    FOleFormat: array[TMPHOLEOperation] of TClipFormat;

    FOleDragging, FOleStartDrag: boolean;

    FOleDragX, FOleDragY: integer;

    FOleWasTarget: boolean;

    FPrintOptions: TMPHPrintOptions;



    FPrintPages: integer;



    FPrintFont: TFont;

    FUseEditorFontForPrinting: boolean;

    FClipboardAsHexText: boolean;

    FClipData: IDataObject;

    FFlushClipboardAtShutDown: boolean;

    FSupportsOtherClipFormats: boolean;

    FOffsetPopupMenu: TPopupMenu;

    FZoomOnWheel: boolean;

    FPaintUpdateCounter: integer;

    FOnQueryPublicProperty: TMPHQueryPublicPropertyEvent;

    FHasDoubleClicked: boolean;

    FBookmarksNoChange: boolean;

    FCreateUndoOnUndoUpdate: boolean;

    FModifiedNoUndo: boolean;

    procedure SetOleDragDrop(const Value: boolean);

    function OLEHasSupportedFormat(const dataObj: IDataObject;

      const Formats: array of TClipFormat; var Format: TClipFormat): boolean;

    function GetMyOLEFormats: TClipFormats;

    procedure WMDestroy(var Message: TWMDestroy); message WM_DESTROY;

    procedure SetPrintOptions(const Value: TMPHPrintOptions);



    function PrintToCanvas(ACanvas: TCanvas; const APage: integer;

      const AMargins: TRect): integer;

    function PrinterMarginRect: TRect;



    procedure SetPrintFont(const Value: TFont);

    procedure SetOffsetPopupMenu(const Value: TPopupMenu);

    function GetOffsetPopupMenu: TPopupMenu;

    function GetBookmarksAsString: string;

    procedure SetBookMarksAsString(Value: string);

  protected

    { Protected-Deklarationen }

    function CanCreateUndo(const aKind: TMPHUndoFlag; const aCount, aReplCount:

      integer): Boolean; override;

{$IFDEF DELPHI6UP}

    // @exclude()

    function GetPropertiesAsString: string; virtual;

    // @exclude()

    procedure SetPropertiesAsString(const Value: string); virtual;

    // @exclude()



    function IsPropPublic(PropName: string): boolean; virtual;



{$ENDIF}

    // @exclude(check if in offset col, if yes, popup offsetcontextmenu)

    procedure Notification(AComponent: TComponent; Operation: TOperation);

      override;

{$IFDEF DELPHI6UP}

    // @exclude()

    procedure DoContextPopup(MousePos: TPoint; var Handled: boolean); override;

{$ENDIF}

    // @exclude(parse control keys)

    procedure KeyDown(var Key: word; Shift: TShiftState); override;

    // @exclude(overwrite mouse wheel for zooming)

    function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): boolean;

      override;

    // @exclude(overwrite mouse wheel for zooming)

    function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): boolean;

      override;

    // @exclude(create backups in savefile)

    procedure PrepareOverwriteDiskFile; override;

    // @exclude(overwrite mouse handling for ole drag and drop)

    procedure MouseMove(Shift: TShiftState; X, Y: integer); override;

    // @exclude(overwrite mouse handling for ole drag and drop)

    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: integer);

      override;

    // @exclude(overwrite mouse handling for ole drag and drop)

    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y:

      integer);

      override;

    // @exclude(reset drop target's HWND)

    procedure CreateWnd; override;

    // @exclude(supported dnd/clipboard data available?)

    function SupportsOLEData(const dataObj: IDataObject; const grfKeyState:

      longint; const pt: TPoint; var dwEffect: longint; const Operation:

      TMPHOLEOperation): HRESULT;

    // @exclude(insert ole-dropped data)

    function InsertOLEData(const dataObj: IDataObject; const grfKeyState:

      longint; const pt: TPoint; var dwEffect: longint; const Operation:

      TMPHOLEOperation): HRESULT;

    // @exclude(modify drageffect depending on key states and data format)

    function ModifyOLEDropEffect(const grfKeyState: longint; const pt: TPoint;

      var dwEffect: longint): HRESULT;

    // @exclude(paint handler)

    procedure Paint; override;

    // @exclude(doubleclick handler for unit selection)

    procedure DblClick; override;

    // @exclude(override to avoid much updates when using setbookmarksasstring);

    procedure BookmarkChanged; override;

  public

    { Public-Deklarationen }

    // @exclude(Init)

    constructor Create(AOwner: TComponent); override;

    // @exclude(Done)

    destructor Destroy; override;

    // see inherited @inherited

    procedure WriteBuffer(const Buffer; const Index, Count: Integer); override;

    (* if set to True (default is False), an undo record is automatically created on calling

      @link(UndoBeginUpdate) and on calling @link(UndoEndUpdate) the record is deleted if the

      data has not been changed between UndoBegin- and UndoEndUpdate *)

    property CreateUndoOnUndoUpdate: boolean read FCreateUndoOnUndoUpdate write

      FCreateUndoOnUndoUpdate;

    (* each call to BeginUpdate increments an internal counter that prevents from repainting

       (see also @link(EndUpdate))

    *)

    function BeginUpdate: integer;

    (* each call to EndUpdate decrements an internal counter that prevents from repainting.

       the return value is the value of this counter. if the counter is reset to zero,

       repainting is permitted again (see also @link(BeginUpdate))

    *)

    function EndUpdate: integer;

    (* each call to UndoBeginUpdate increments an internal counter that prevents using

       undo storage and also disables undo functionality (see also @link(UndoEndUpdate))

    *)

    function UndoBeginUpdate(const StrUndoDesc: string = ''): integer;

      reintroduce;

    (* each call to UndoEndUpdate decrements an internal counter that prevents using

       undo storage and also disables undo functionality. the return value is the value

       of this counter. if the counter is reset to zero, undo creation is permitted again

       (see also @link(UndoBeginUpdate))

    *)

    function UndoEndUpdate: integer; override;

    // create an undo for a range of bytes

    procedure CreateRangeUndo(const aStart, aCount: integer; sDesc: string);

    // is pasting from clipboard possible?

    function CanPaste: boolean;

    // is copying to clipboard possible?

    function CanCopy: boolean;

    // is cutting to clipboard possible?

    function CanCut: boolean;

    // copy selection to clipboard

    function CBCopy: boolean;

    // cut selection to clipboard

    function CBCut: boolean;

    // paste clipboard's contents over current selection

    function CBPaste: boolean;

    // do we own the clipboard data?

    function OwnsClipBoard: boolean;

    // flush or empty the clipboard (if we own the IDataObject)

    procedure ReleaseClipboard(const Flush: boolean);

    // save to file (overwrite)

    procedure Save;

    // @exclude(dump undo storage)

    function DumpUndoStorage(const FileName: string): boolean;

    (* creates a TMetaFile object and renders the specified page

       on its canvas. Freeing of the TMetaFile is up to the caller!

    *)



    function PrintPreview(const Page: integer): TMetaFile;

    (* print the given page to the default printer.

      Printer.BeginDoc, Printer.NewPage and Printer.EndDoc must be issued by the caller!

    *)

    procedure Print(const Page: integer);

    // get the number of pages to print

    function PrintNumPages: integer;



    // paste data (in clipboardmanner: check current selection and so on)

    procedure PasteData(P: Pointer; const ACount: integer; const UndoDesc: string

      = '');

    // get/set bookmarks as text (for storing in registry, ini-file)

    property BookMarksAsString: string read GetBookmarksAsString write

      SetBookMarksAsString;

{$IFDEF DELPHI6UP}

    // get set properties as text (for storing in registry, ini-file);

    property PropertiesAsString: string read GetPropertiesAsString write

      SetPropertiesAsString;

{$ENDIF}

  published

    { Published-Deklarationen }

    // create a backup on save ? (see also @link(BackupExtension))

    property CreateBackup: boolean read FCreateBackups write FCreateBackups

      default True;

    // add this extension to the file if making backups, see @link(CreateBackup)

    property BackupExtension: string read FBackupFileExt write FBackupFileExt;

    (* if set To True, OLE drag and drop will used automatically when dragging starts

       or supported OLE data has been dropped on the hex editor

    *)

    property OleDragDrop: boolean read FOleDragDrop write SetOleDragDrop default

      False;

    // if set to True, CF_TEXT on the clipboard will be treated as hex formatted text

    property ClipboardAsHexText: boolean read FClipboardAsHexText write

      FClipboardAsHexText default False;

    // flush or empty clipboard at shutdown

    property FlushClipboardAtShutDown: boolean read FFlushClipboardAtShutDown

      write FFlushClipboardAtShutDown default False;

    // do we support other formats than CF_MPHEXEDITOR and CF_HDROP?

    property SupportsOtherClipFormats: boolean read FSupportsOtherClipFormats

      write FSupportsOtherClipFormats default True;

    // print/preview options, see @link(TMPHPrintOptions)

    property PrintOptions: TMPHPrintOptions read FPrintOptions write

      SetPrintOptions;

    // print using this font

    property PrintFont: TFont read FPrintFont write SetPrintFont;

    // if set to True, the editor's font will be used for printing

    property UseEditorFontForPrinting: boolean read FUseEditorFontForPrinting

      write FUseEditorFontForPrinting default True;

    (* if this property is assigned to a TPopupMenu, it will be shown on right clicking

      the offset display pane. then the normal PopupMenu will open on right

      clicking the character and hex pane.

    *)

    property OffsetPopupMenu: TPopupMenu read GetOffsetPopupMenu write

      SetOffsetPopupMenu;

    // auto-zoom on mouse wheel?

    property ZoomOnWheel: boolean read FZoomOnWheel write FZoomOnWheel default

      True;

    (* this event is called when @link(PropertiesAsString) is read or written.

       (see @link(TMPHQueryPublicPropertyEvent))

    *)

    property OnQueryPublicProperty: TMPHQueryPublicPropertyEvent read

      FOnQueryPublicProperty write FOnQueryPublicProperty;

    // @exclude(inherited)

    property Align;

    // @exclude(inherited)

    property Anchors;

    // @exclude(inherited)

    property BiDiMode;

    // @exclude(inherited)

    property BorderStyle;

    // @exclude(inherited)

    property Constraints;

    // @exclude(inherited)

    property Ctl3D;

    // @exclude(inherited)

    property DragCursor;

    // @exclude(inherited)

    property DragKind;

    // @exclude(inherited)

    property DragMode;

    // @exclude(inherited)

    property Enabled;

    // @exclude(inherited)

    property Font;

    // @exclude(inherited)

    property ImeMode;

    // @exclude(inherited)

    property ImeName;

    // @exclude(inherited)

    property OnClick;

    // @exclude(inherited)

    property OnDblClick;

    // @exclude(inherited)

    property OnDragDrop;

    // @exclude(inherited)

    property OnDragOver;

    // @exclude(inherited)

    property OnEndDock;

    // @exclude(inherited)

    property OnEndDrag;

    // @exclude(inherited)

    property OnEnter;

    // @exclude(inherited)

    property OnExit;

    // @exclude(inherited)

    property OnKeyDown;

    // @exclude(inherited)

    property OnKeyPress;

    // @exclude(inherited)

    property OnKeyUp;

    // @exclude(inherited)

    property OnMouseDown;

    // @exclude(inherited)

    property OnMouseMove;

    // @exclude(inherited)

    property OnMouseUp;

    // @exclude(inherited)

    property OnMouseWheel;

    // @exclude(inherited)

    property OnMouseWheelDown;

    // @exclude(inherited)

    property OnMouseWheelUp;

    // @exclude(inherited)

    property OnStartDock;

    // @exclude(inherited)

    property OnStartDrag;

    // @exclude(inherited)

    property ParentBiDiMode;

    // @exclude(inherited)

    property ParentCtl3D;

    // @exclude(inherited)

    property ParentFont;

    // @exclude(inherited)

    property ParentShowHint;

    // @exclude(inherited)

    property PopupMenu;

    // @exclude(inherited)

    property ScrollBars;

    // @exclude(inherited)

    property ShowHint;

    // @exclude(inherited)

    property TabOrder;

    // @exclude(inherited)

    property TabStop;

    // @exclude(inherited)

    property Visible;



    // see inherited @inherited

    property BytesPerRow;

    // see inherited @inherited

    property BytesPerColumn;

    // see inherited @inherited

    property Translation;

    // see inherited @inherited

    property OffsetFormat;

    // see inherited @inherited

    property CaretKind;

    // see inherited @inherited

    property Colors;

    // see inherited @inherited

    property FocusFrame;

    // see inherited @inherited

    property SwapNibbles;

    // see inherited @inherited

    property MaskChar;

    // see inherited @inherited

    property NoSizeChange;

    // see inherited @inherited

    property AllowInsertMode;

    // see inherited @inherited

    property DrawGridLines;

    // see inherited @inherited

    property WantTabs;

    // see inherited @inherited

    property ReadOnlyView;

    // see inherited @inherited

    property HideSelection;

    // see inherited @inherited

    property GraySelectionIfNotFocused;

    // see inherited @inherited

    property GutterWidth;

    // see inherited @inherited

    property BookmarkBitmap;



    // see inherited @inherited

    property Version;



    // see inherited @inherited

    property MaxUndo;

    // see inherited @inherited

    property InsertMode;

    // see inherited @inherited

    property HexLowerCase;

    // see inherited @inherited

    property OnProgress;

    // see inherited @inherited

    property OnInvalidKey;

    // see inherited @inherited

    property OnTopLeftChanged;

    // see inherited @inherited

    property OnChange;

    // see inherited @inherited

    property DrawGutter3D;

    // see inherited @inherited

    property ShowRuler;

    // see inherited @inherited

    property BytesPerUnit;

    // see inherited @inherited

    property RulerBytesPerUnit;

    // see inherited @inherited

    property ShowPositionIfNotFocused;

    // see inherited @inherited

    property OnSelectionChanged;

    // see inherited @inherited

    property UnicodeChars;

    // see inherited @inherited

    property UnicodeBigEndian;



    // see inherited @inherited

    property OnDrawCell;



    // see inherited @inherited

    property OnBookmarkChanged;

    // see inherited @inherited

    property OnGetOffsetText;

    // see inherited @inherited

    property BytesPerBlock;

    // see inherited @inherited

    property SeparateBlocksInCharField;

    // see inherited @inherited

    property FindProgress;

    // see inherited @inherited

    property RulerNumberBase;

  end;



  // @exclude(ole drop target class)

  TMPHDropTarget = class(TInterfacedObject, IDropTarget)

  private

    FEditor: TMPHexEditorEx;

    FEditorHandle: THandle;

    FActive: boolean;

    procedure SetActive(const Value: boolean);

  public

    constructor Create(Editor: TMPHexEditorEx);

    procedure BeforeDestruction; override;

    function DragEnter(const dataObj: IDataObject; grfKeyState: longint; pt:

      TPoint; var dwEffect: longint): HResult; stdcall;

    function DragOver(grfKeyState: longint; pt: TPoint; var dwEffect: longint):

      HResult; stdcall;

    function DragLeave: HResult; stdcall;

    function Drop(const dataObj: IDataObject; grfKeyState: longint; pt: TPoint;

      var dwEffect: longint): HResult; stdcall;

    property Active: boolean read FActive write SetActive;

  end;



  // print / preview options

  TMPHPrintOptions = class(TPersistent)

  private

    FMargins: TRect;

    FHeaders: TMPHPrintHeaders;

    FFlags: TMPHPrintFlags;

    function GetHeader(const Index: integer): string;

    function GetMargin(const Index: integer): integer;

    procedure SetHeader(const Index: integer; const Value: string);

    procedure SetMargin(const Index, Value: integer);

  public

    // @exclude(Init)

    constructor Create;

    // @exclude()

    procedure Assign(Source: TPersistent); override;

  published

    // left margin in Millimeters

    property MarginLeft: integer index 1 read GetMargin write SetMargin;

    // top margin in Millimeters

    property MarginTop: integer index 2 read GetMargin write SetMargin;

    // right margin in Millimeters

    property MarginRight: integer index 3 read GetMargin write SetMargin;

    // bottom margin in Millimeters

    property MarginBottom: integer index 4 read GetMargin write SetMargin;

    (* this line will be rendered on top of the printed page, some characters have special meanings:<br><br>

       - the string may contain three parts separated by a "|" (pipe) character (left|center|right)<br>

       - each part knows some special variables:

       <ul>

       <li><b>%f</b>: substituted with the filename part of the editor's filename</li>

       <li><b>%F</b>: substituted with the expanded name of the editor's filename</li>

       <li><b>%p</b>: substituted with the number of the current page</li>

       <li><b>%P</b>: substituted with the number of pages</li>

       <li><b>%t</b>: substituted with the current time</li>

       <li><b>%d</b>: substituted with the current date</li>

       <li><b>%&gt;</b>: substituted with the long description of the editor's current @link(Translation)</li>

       <li><b>%&lt;</b>: substituted with the short description of the editor's current @link(Translation)</li>

       </ul>

    *)

    property PageHeader: string index 0 read GetHeader write SetHeader;

    // this line will be rendered on the bottom of the printed page (see @link(PageHeader))

    property PageFooter: string index 1 read GetHeader write SetHeader;

    (* printing flags:<br><br>

      - pfSelectionOnly: only print data currently selected<br>

      - pfSelectionBold: render the current selection using either a bold font or inverted colors (if pfSelectionOnly isn't set)<br>

      - pfMonochrome: don't use colors, print/preview black on white<br>

      - pfUseBackgroundColor: fill the margin rect with the editor's background color (if pfMonochrome isn't set)<br>

      - pfCurrentViewOnly: just print the data currently displayed

    *)

    property Flags: TMPHPrintFlags read FFlags write FFlags;

  end;



  // default print margins

const

  MPH_DEF_PRINT_MARGINS: TRect = (Left: 20; Top: 15; Right: 25; Bottom: 25);



implementation



uses

  Consts, StdCtrls, ShellAPI, ComObj, TypInfo;



resourcestring



  // error messages

  ERR_NOFILE = 'No filename specified';

  ERR_INVALID_PAGE = 'Invalid page index';

  ERR_PRINTING_FAILED = 'Printing failed';

  ERR_BACKUP_DELETE = 'Cannot delete previous backup %s. (%s)';

  ERR_BACKUP_CREATE = 'Cannot create backup %s. (%s)';

  ERR_INVALID_BOOKFMT = 'Invalid bookmark format';



  // additional undo descriptions

  UNDO_PASTECB = 'Paste from clipboard';

  UNDO_CUTCB = 'Cut to clipboard';

  UNDO_DROPPED = 'Data dropped';

  UNDO_MOVED = 'Data moved';



  // select clipb/ole format dialog strings

  SELECT_FORMAT_CAPTION = 'Select data format';

  SELECT_FORMAT_ASHEX = 'Hex text';



  // when data dropped to explorer, give it this filename; first %s filename w/o ext, (second %s original file ext)

  STR_SCRAPFILE = 'Dump of %s.bin';



  // native clipboard format name

  MPTH_CF = 'TMPHexeditorEx Clipboard Format';



  // predefined clipboard format names

  STR_CF_TEXT = 'Text';

  STR_CF_BITMAP = 'Bitmap Picture';

  STR_CF_METAFILEPICT = 'Metafile Picture';

  STR_CF_SYLK = 'Microsoft Symbolic Link (SYLK) data';

  STR_CF_DIF = 'Software Arts'' Data Interchange Format';

  STR_CF_TIFF = 'Tagged Image File Format (TIFF) Picture';

  STR_CF_OEMTEXT = 'OEM Text';

  STR_CF_DIB = 'Device Independent Bitmap Picture';

  STR_CF_PALETTE = 'Color Palete';

  STR_CF_PENDATA = 'Pen Data';

  STR_CF_RIFF = 'RIFF Audio Data';

  STR_CF_WAVE = 'Wave Audio';

  STR_CF_UNICODETEXT = 'Unicode Text';

  STR_CF_ENHMETAFILE = 'Enhanced Metafile Picture';

  STR_CF_HDROP = 'File List';

  STR_CF_LOCALE = 'Text Locale';



type

  // my clipboard data struct

  PClipData = ^TClipData;

  TClipData = packed record

    Signature: DWORD;

    Version: DWORD;

    Size: integer;

    Data: array[0..0] of char;

  end;



  PRegEditHexData = ^TRegEditHexData;

  TRegEditHexData = packed record

    Size: integer;

    Data: array[0..0] of char;

  end;



const

  // signature of own format clipboard data

  CLIP_SIG = $4854504D; // MPTH;

  // version of own format clipboard data

  CLIP_VER = $00010001;



  // initial file extension of backups

  BACKUP_EXT = '.bak';



  // not so predefined common/known clipboard format names

  CFSTR_RTF = 'Rich Text Format';

  CFSTR_LOGICALPERFORMEDDROPEFFECT = 'Logical Performed DropEffect';

  CFSTR_REGEDIT_HEXDATA = 'RegEdit_HexData';

  CFSTR_HTML = 'HTML Format';



var

  // custom/ shell CF format

  CF_MPHEXEDITOR,

    CF_RTF,

    CF_FILECONTENTS,

    CF_PERFORMEDDROPEFFECT,

    CF_LOGICALPERFORMEDDROPEFFECT,

    CF_FILEDESCRIPTOR,

    CF_HTML,

    CF_REGEDIT_HEXDATA: TClipFormat;



type

  // private idataobject format enumerator

  TFormatEnum = class

  private

    FFormats: array of TFormatETC;

  public

    constructor Create(const dataObject: IDataObject);

    destructor Destroy; override;

    function HasFormat(const cfFormat: TClipFormat): boolean;

    function GetFormatETC(const cfFormat: TClipFormat): TFormatETC;

  end;



const

  // number of clip formats that we can provide

  MY_SUPPORTED_FORMATS = 4;



type

  // ole "public" format enumerator for own data

  TMPHEnumFormatETC = class(TInterfacedObject, IEnumFormatETC)

  private

    FFormats: packed array[0..MY_SUPPORTED_FORMATS - 1] of TFormatETC;

    FIndex: integer;

  public

    constructor Create;

    function Next(celt: longint; out elt; pceltFetched: PLongint): HResult;

      stdcall;

    function Skip(celt: longint): HResult; stdcall;

    function Reset: HResult; stdcall;

    function Clone(out Enum: IEnumFormatEtc): HResult; stdcall;

  end;



  // ole drop source

  TMPHDropSource = class(TInterfacedObject, IDropSource)

  public

    function QueryContinueDrag(fEscapePressed: BOOL; grfKeyState: longint):

      HResult; stdcall;

    function GiveFeedback(dwEffect: longint): HResult; stdcall;

  end;



  // ole data container

  TMPHDataObject = class(TInterfacedObject, IDataObject)

  private

    FData: Pointer;

    FDataSize: integer;

    FFileName: ShortString;

    FHasDropEffect: boolean;

    FDropEffect: cardinal;

    FTextAsHex: boolean;

    FSwapNibbles: boolean;

  public

    constructor Create(Data: Pointer; DataSize: integer; ScrapFileName:

      ShortString; TextAsHex, SwapNibbles: boolean);

    constructor CreateFromStream(Stream: TStream; Position, DataSize: integer;

      ScrapFileName: ShortString; TextAsHex, SwapNibbles: boolean);

    procedure BeforeDestruction; override;

    function GetData(const formatetcIn: TFormatEtc; out medium: TStgMedium):

      HResult; stdcall;

    function GetDataHere(const formatetc: TFormatEtc; out medium: TStgMedium):

      HResult; stdcall;

    function QueryGetData(const formatetc: TFormatEtc): HResult; stdcall;

    function GetCanonicalFormatEtc(const formatetc: TFormatEtc; out

      formatetcOut: TFormatEtc): HResult; stdcall;

    function SetData(const formatetc: TFormatEtc; var medium: TStgMedium;

      fRelease: BOOL): HResult; stdcall;

    function EnumFormatEtc(dwDirection: longint; out enumFormatEtc:

      IEnumFormatEtc): HResult; stdcall;

    function DAdvise(const formatetc: TFormatEtc; advf: longint; const advSink:

      IAdviseSink; out dwConnection: longint): HResult; stdcall;

    function DUnadvise(dwConnection: longint): HResult; stdcall;

    function EnumDAdvise(out enumAdvise: IEnumStatData): HResult; stdcall;

  end;



  // draw hex on canvas

  TMPHCanvasPrinter = class(TObject)

  private

    FMargins: TRect;

    FHeaders,

      FPrintHeaders: TMPHPrintHeaders;

    FLinesPerPage: integer;

    FFlags: TMPHPrintFlags;

    FPages: integer;

    FEditor: TMPHexEditorEx;

    FCanvas: TCanvas;

    function GetLinesPerPage: integer;

    function BuildHeader(const S: string; const Page: integer): string;

  protected

    function DrawOrCalc(const JustCalc: boolean; const Page: integer): integer;

  public

    constructor Create(AEditor: TMPHexEditorEx; ACanvas: TCanvas; AFlags:

      TMPHPrintFlags; AMargins: TRect; AHeaders: TMPHPrintHeaders);

    procedure Draw(const Page: integer);

    property LinesPerPage: integer read GetLinesPerPage;

    property Pages: integer read FPages;

  end;



var

  // most recent selected clip format

  LAST_USED_CF: integer = -1;



  // returns the stgmedium struct for a given idataobject/format specification



function GetIDataObjectData(const dataObj: IDataObject; const Format:

  TClipFormat; out Medium: TStgMedium): HRESULT;

var

  LobjEnum: TFormatEnum;

begin

  LobjEnum := TFormatEnum.Create(dataObj);

  try

    if not LobjEnum.HasFormat(Format) then

      Result := E_FAIL

    else

      Result := dataObj.GetData(LobjEnum.GetFormatETC(Format), Medium);

  finally

    LobjEnum.Free;

  end;

end;



// cast/copy hglobal to data structure depending on the format



function GetSomeData(const PData: Pointer; const HGlobal: THandle; Format:

  TClipFormat; const DataSize: integer; const UnicodeBigEndian: Boolean):

  string;

var

  LWStrTemp: widestring;

  LRecBmpHeader: TBitmapFileheader;

  LRecPalette: TMaxLogPalette;

  LIntTemp: integer;

  LbmpTemp: TBitmap;

  LmefTemp: TMetaFile;

  LmstData: TMemoryStream;

  LIntLoop: integer;

begin

  Result := '';



  // to use case..of (cf_rtf is not a constant)

  if (Format = CF_RTF) or (Format = CF_HTML) then

    Format := CF_TEXT;



  if Format = CF_MPHEXEDITOR then

  begin

    with PClipData(PData)^ do

      if (Signature = CLIP_SIG) and (Version = CLIP_VER) then

        SetString(Result, Data, Size)

  end

  else if Format = CF_REGEDIT_HEXDATA then

  begin

    with PRegEditHexData(PData)^ do

      SetString(Result, Data, Size);

  end

  else

    case Format of

      CF_TEXT,

        CF_OEMTEXT: Result := PChar(PData);

      CF_UNICODETEXT:

        begin

          LWStrTemp := PWideChar(PData);

          if UnicodeBigEndian then

          begin

            for LIntLoop := 1 to Length(LWstrTemp) do

              SwapWideChar(LWstrTemp[LIntLoop]);

          end;

{$WARNINGS OFF}

          // don't convert, get wide data as is

          SetString(Result, PChar(LWStrTemp), Length(LWStrTemp) *

            (sizeof(widechar) div sizeof(char)));

{$WARNINGS ON}

        end;

      CF_LOCALE:

        begin

          // locale id , word pointed to by the global handle

          SetLength(Result, sizeof(word));

          Move(PWord(PData)^, Result[1], sizeof(word));

        end;

      CF_DIB:

        begin

          // stored as bitmap without header, so prefix a bmp header

          FillChar(LRecBMPHeader, sizeof(LRecBMPHeader), #0);

          LRecBMPHeader.bfType := $4D42; // BM

          SetLength(Result, sizeof(LRecBMPHeader) + DataSize);

          Move(LRecBMPHeader, Result[1], sizeof(LRecBmpHeader));

          Move(PData^, Result[1 + sizeof(LRecBMPHeader)], DataSize);

        end;

      CF_PALETTE:

        begin

          // copy palette entries

          LIntTemp := 0;

          if (GetObject(HGlobal, sizeof(LIntTemp), @LIntTemp) <> 0) and (LIntTemp

            > 0) then

          begin

            with LRecPalette do

            begin

              palVersion := $0300;

              palNumEntries := LIntTemp;

              GetPaletteEntries(HGlobal, 0, LIntTemp, palPalEntry);

            end;

            SetLength(Result, sizeof(TLogPalette) + ((LintTemp - 1) *

              sizeof(TPaletteEntry)));

            Move(LRecPalette, Result[1], Length(Result));

          end;

        end;

      CF_BITMAP:

        begin

          // data not stored in global mem, but as a bitmap handle

          LbmpTemp := TBitmap.Create;

          try

            LbmpTemp.Handle := CopyImage(HGlobal, IMAGE_BITMAP, 0, 0,

              LR_COPYRETURNORG);

            LmstData := TMemoryStream.Create;

            try

              LbmpTemp.SaveToStream(LmstData);

              SetString(Result, PChar(LmstData.Memory), LmstData.Size);

            finally

              LmstData.Free;

            end;

          finally

            LbmpTemp.Free;

          end;

        end;

      CF_METAFILEPICT:

        begin

          // global mem contains mf struct

          LIntTemp := GetMetaFileBitsEx(PMetafilePict(PData)^.hMF, 0, nil);

          if LIntTemp > 0 then

          begin

            SetLength(Result, LIntTemp);

            GetMetaFileBitsEx(PMetafilePict(PData)^.hMF, LIntTemp, @Result[1]);

          end;

        end;

      CF_ENHMETAFILE:

        begin

          // emf handle

          LmefTemp := TMetaFile.Create;

          try

            LmefTemp.Handle := CopyEnhMetafile(HGlobal, nil);

            LmstData := TMemoryStream.Create;

            try

              LmefTemp.SaveToStream(LmstData);

              SetString(Result, PChar(LmstData.Memory), LmstData.Size);

            finally

              LmstData.Free;

            end;

          finally

            LmefTemp.Free;

          end;

        end;

    else

      // format not yet known

      SetString(Result, PChar(PData), DataSize);

    end;

end;



type

  // special dialog for format selection

  TFormatSelDialog = class(TForm)

  private

    LbtnOK: TButton;

    LbtnCancel: TButton;

    LlbxFormats: TListBox;

    LcbxTextAsHex: TCheckBox;

    procedure ListDoubleClick(Sender: TObject);

    procedure ListSelect(Sender: TObject);

  end;



  // select a format out of an array of available formats



function SelectClipFormat(const Formats: array of TClipFormat; var Format:

  TClipFormat; var TextIsHexData: boolean): boolean;

var

  LfrmDialog: TFormatSelDialog;

  LIntLoop: integer;

  LWrdCurrent: TClipFormat;

  LStrFormatName: string;

  LszBuffer: array[0..511] of char;

begin

  Result := False;



  // create and show a dialog for clipboard format selection

  LfrmDialog := TFormatSelDialog.CreateNew(Application);

  with lfrmDialog do

  try

    BorderStyle := bsDialog;

    Width := Screen.Width div 4;

    Height := Screen.Height div 4;

{$IFDEF DELPHI6UP}

    Position := poOwnerFormCenter;

{$ELSE}

    Position := poScreenCenter;

{$ENDIF}

    Caption := SELECT_FORMAT_CAPTION;



    LbtnOK := TButton.Create(LfrmDialog);

    LbtnCancel := TButton.Create(LfrmDialog);

    LcbxTextAsHex := TCheckBox.Create(LfrmDialog);

    LlbxFormats := TListBox.Create(LfrmDialog);

    try

      with lbtnOK do

      begin

        Parent := LfrmDialog;

        ModalResult := mrOk;

        Caption := SOKButton;

        Default := True;

        Width := (LfrmDialog.Width div 2) - 32;

        Top := LfrmDialog.ClientHeight - Height - 8;

        Left := 16;

        Enabled := False;

      end;



      with LbtnCancel do

      begin

        Parent := LfrmDialog;

        ModalResult := mrCancel;

        Cancel := True;

        Caption := SCancelButton;

        Width := (LfrmDialog.Width div 2) - 32;

        Top := LfrmDialog.ClientHeight - Height - 8;

        Left := LfrmDialog.ClientWidth - Width - 16;

      end;



      with LcbxTextAsHex do

      begin

        Parent := LfrmDialog;

        Enabled := False;

        Caption := SELECT_FORMAT_ASHEX;

        Top := LbtnCancel.Top - Height - 8;

        Left := LbtnOK.Left;

        Width := LfrmDialog.ClientWidth - Left;

        Checked := TextIsHexData;

      end;



      with LlbxFormats do

      begin

        Parent := LfrmDialog;

        Align := alTop;

        Height := LfrmDialog.ClientHeight - 16 - LbtnCancel.Height - 8 -

          LcbxTextAsHex.Height;

        OnDblClick := ListDoubleClick;

        OnClick := ListSelect;



        for LIntLoop := Low(Formats) to High(Formats) do

        begin

          LWrdCurrent := Formats[LIntLoop];

          case LWrdCurrent of

            CF_TEXT: LStrFormatName := STR_CF_TEXT;

            CF_BITMAP: LStrFormatName := STR_CF_BITMAP;

            CF_METAFILEPICT: LStrFormatName := STR_CF_METAFILEPICT;

            CF_SYLK: LStrFormatName := STR_CF_SYLK;

            CF_DIF: LStrFormatName := STR_CF_DIF;

            CF_TIFF: LStrFormatName := STR_CF_TIFF;

            CF_OEMTEXT: LStrFormatName := STR_CF_OEMTEXT;

            CF_DIB: LStrFormatName := STR_CF_DIB;

            CF_PALETTE: LStrFormatName := STR_CF_PALETTE;

            CF_PENDATA: LStrFormatName := STR_CF_PENDATA;

            CF_RIFF: LStrFormatName := STR_CF_RIFF;

            CF_WAVE: LStrFormatName := STR_CF_WAVE;

            CF_UNICODETEXT: LStrFormatName := STR_CF_UNICODETEXT;

            CF_ENHMETAFILE: LStrFormatName := STR_CF_ENHMETAFILE;

            CF_HDROP: LStrFormatName := STR_CF_HDROP;

            CF_LOCALE: LStrFormatName := STR_CF_LOCALE;

          else

            SetString(LStrFormatName, LszBuffer,

              GetClipboardFormatName(LWrdCurrent, LszBuffer,

              sizeof(LszBuffer)));

            LStrFormatName := Trim(LStrFormatName);

          end;

          if LStrFormatName = '' then

            LStrFormatName := '(' + IntToRadix(LWrdCurrent, 10) + ')';

          Items.AddObject(LStrFormatName, Pointer(LWrdCurrent));

          LbtnOK.Enabled := True;

          ItemIndex := Items.IndexOfObject(Pointer(LAST_USED_CF));

          if ItemIndex = -1 then

            ItemIndex := 0;

        end;

      end;



      // enable hextext checkbox depending on selected format

      ListSelect(nil);



      if (ShowModal = mrOk) and (LlbxFormats.ItemIndex > -1) then

      begin

        Format := TClipFormat(LlbxFormats.Items.Objects[LlbxFormats.ItemIndex]);

        if Format in [CF_TEXT, CF_OEMTEXT] then

          TextIsHexData := LcbxTextAsHex.Checked;

        Result := True;

        LAST_USED_CF := Format;

      end;

    finally

      // not sure if they automatically get freed?

      LbtnOK.Free;

      LbtnCancel.Free;

      LcbxTextAsHex.Free;

      LlbxFormats.Free;

    end;

  finally

    Free;

  end;

end;



// query a data object's supported formats and check if we can "paste" them



function QueryOLEFormat(const SupportedFormats: array of TClipFormat; const

  dataObj: IDataObject; var Format: TClipFormat; var TextIsHexData: boolean):

  boolean;

var

  LWrdFormats: array of TClipFormat;

  LIntLoop: integer;

  LobjEnum: TFormatEnum;

begin

  Result := False;

  LWrdFormats := nil;

  LobjEnum := TFormatEnum.Create(dataObj);

  try

    // enum all available formats

    if Length(SupportedFormats) > 0 then

    begin

      for LIntLoop := Low(SupportedFormats) to High(SupportedFormats) do

        if LObjEnum.HasFormat(SupportedFormats[LIntLoop]) then

        begin

          SetLength(LWrdFormats, Succ(Length(LWrdFormats)));

          LWrdFormats[Pred(Length(LWrdFormats))] := SupportedFormats[LIntLoop];

        end;

      case Length(LWrdFormats) of

        0: Exit;

        1:

          begin

            Format := LWrdFormats[0];

            Result := True;

            Exit;

          end;

      else

        // show a dialog for data format selection

        Result := SelectClipFormat(LWrdFormats, Format, TextIsHexData);

      end;

    end;

  finally

    LObjEnum.Free;

    LWrdFormats := nil;

  end;

end;



{ TMPHexEditorEx }



// constructor



constructor TMPHexEditorEx.Create(AOwner: TComponent);

begin

  inherited;

  FModifiedNoUndo := False;

  FCreateUndoOnUndoUpdate := False;

  FBookmarksNoChange := False;

  FHasDoubleClicked := False;

  FPaintUpdateCounter := 0;

  FClipData := nil;

  FZoomOnWheel := True;

  FCreateBackups := True;

  FBackupFileExt := BACKUP_EXT;

  FOleDragDrop := False;

  FOleStartDrag := False;

  FOleDragging := False;

  FClipboardAsHexText := False;

  FFlushClipboardAtShutDown := False;

  FSupportsOtherClipFormats := True;

  FPrintOptions := TMPHPrintOptions.Create;

  FPrintFont := TFont.Create;

  FPrintFont.Assign(Font);

  FUseEditorFontForPrinting := True;

  FOffsetPopupMenu := nil;

  if not (csDesigning in ComponentState) then

    FDropTarget := TMPHDropTarget.Create(self); // not in delphi ide

end;



// destructor



destructor TMPHexEditorEx.Destroy;

begin

  // empty or flush clipboard

  ReleaseClipboard(FFlushClipboardAtShutDown);

  FPrintOptions.Free;

  FPrintFont.Free;

  if not (csDesigning in ComponentState) then

    FDropTarget.Free;

  inherited;

end;



// cb copy possible



function TMPHexEditorEx.CanCopy: boolean;

begin

  Result := (DataSize > 0) and (SelCount > 0);

end;



// cb cut possible



function TMPHexEditorEx.CanCut: boolean;

begin

  Result := CanCopy and not (ReadOnlyView or NoSizeChange);

end;



// cb paste possible



function TMPHexEditorEx.CanPaste: boolean;

var

  LifData: IDataObject;

  LIntEffect: integer;

begin

  LIntEffect := DROPEFFECT_COPY;

  Result := (not (ReadOnlyView (*or NoSizeChange*))) and

    Succeeded(OLEGetClipboard(LifData)) and (SupportsOLEData(LifData, 0,

    Point(0,

    0), LintEffect, oleClipboard) = S_OK);

  if Result and NoSizeChange then

    Result := DataSize > 0;

end;



// copy to clipboard



function TMPHexEditorEx.CBCopy: boolean;

begin

  Result := CanCopy;

  if Result then

  begin

    WaitCursor;

    try

      FClipData := TMPHDataObject.CreateFromStream(DataStorage, Min(SelStart,

        SelEnd), SelCount, ExtractFileName(FileName), FClipboardAsHexText,

        SwapNibbles);

      OleCheck(OleSetClipboard(FClipData));

    finally

      OldCursor;

    end;

  end;

end;



// cut to clipboard



function TMPHexEditorEx.CBCut: boolean;

begin

  Result := CanCut and CBCopy;

  if Result then

  begin

    WaitCursor;

    try

      DeleteSelection(UNDO_CUTCB);

    finally

      OldCursor;

    end;

  end;

end;



// paste from clipboard



function TMPHexEditorEx.CBPaste: boolean;

var

  LifData: IDataObject;

  LIntEffect: integer;

begin

  LIntEffect := DROPEFFECT_COPY;

  Result := CanPaste and Succeeded(OLEGetClipboard(LifData)) and

    Succeeded(InsertOLEData(LifData, 0, Point(0, 0), LIntEffect, oleClipboard));

end;



// create an undo for a range of bytes



procedure TMPHexEditorEx.CreateRangeUndo(const aStart, aCount: integer;

  sDesc: string);

var

  bMod: boolean;

begin

  bMod := FModified;

  try

    if aCount < 1 then

      CreateUndo(ufKindAllData, 0, 0, 0, sDesc)

    else

      CreateUndo(ufKindReplace, aStart, aCount, aCount, sDesc);

  finally

    FModified := bMod;

  end;

end;



function TMPHexEditorEx.BeginUpdate: integer;

begin

  Inc(FPaintUpdateCounter);

  Result := FPaintUpdateCounter;

end;



function TMPHexEditorEx.EndUpdate: integer;

begin

  Dec(FPaintUpdateCounter);

  if FPaintUpdateCounter < 0 then

    FPaintUpdateCounter := 0;

  if FPaintUpdateCounter = 0 then

    Invalidate;

  Result := FPaintUpdateCounter;

end;



// mouse wheel overriding for zooming (font size) if CTRL/SHIFT is pressed,

// or bytes per line changing if CTRL pressed



function TMpHexEditorEx.DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint):

  boolean;

begin

  if FZoomOnWheel and (Shift = [ssCtrl]) and (BytesPerRow > 1) then

  begin

    Result := True;

    BytesPerRow := BytesPerRow - 1;

    Invalidate;

  end

  else if FZoomOnWheel and (Shift = [ssShift, ssCtrl]) and (Font.Size > 2) then

  begin

    Result := True;

    Font.Size := Font.Size - 1;

  end

  else

    Result := inherited DoMouseWheelDown(Shift, MousePos);

end;



function TMpHexEditorEx.DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint):

  boolean;

begin

  if FZoomOnWheel and (Shift = [ssCtrl]) and (BytesPerRow < 256) then

  begin

    Result := True;

    BytesPerRow := BytesPerRow + 1;

    Invalidate;

  end

  else if FZoomOnWheel and (Shift = [ssShift, ssCtrl]) then

  begin

    Result := True;

    Font.Size := Font.Size + 1;

  end

  else

    Result := inherited DoMouseWheelUp(Shift, MousePos);

end;



// overwrite key handling



procedure TMPHexEditorEx.KeyDown(var Key: word; Shift: TShiftState);

begin

  inherited;

  case Key of

    // CTRL+A: select all

    Ord('A'): if Shift = [ssCtrl] then

      begin

        SelectAll;…