{ @abstract(This unit contains the TKHexEditor component and all supporting classes)
@author(Tomas Krysl (tk@tkweb.eu))
@created(12 Oct 2005)
@lastmod(20 Jun 2010)
This unit provides a powerfull hexadecimal editor component @link(TKHexEditor)
with following major features:
<UL>
<LI><I>advanced editing capabilities</I></LI>
<LI><I>advanced rendering styles</I></LI>
<LI><I>clipboard operations</I></LI>
<LI><I>virtually unlimited undo/redo operations</I></LI>
<LI><I>key mapping functionality</I></LI>
<LI><I>fast search/replace function</I></LI>
<LI><I>print/preview function</I></LI>
</UL>
Copyright © 2006 Tomas Krysl (tk@@tkweb.eu)<BR><BR>
<B>License:</B><BR>
This code is distributed as a freeware. You are free to use it as part
of your application for any purpose including freeware, commercial and
shareware applications. The origin of this source code must not be
misrepresented; you must not claim your authorship. You may modify this code
solely for your own purpose. Please feel free to contact the author if you
think your changes might be useful for other users. You may distribute only
the original package. The author accepts no liability for any damage
that may result from using this code. }
unit KHexEditor;
{$include kcontrols.inc}
{$WEAKPACKAGEUNIT ON}
interface
uses
{$IFDEF FPC}
LCLType, LCLIntf, LMessages, LCLProc, LResources,
{$ELSE}
Windows, Messages,
{$ENDIF}
SysUtils, Classes, Graphics, Controls,
ExtCtrls, StdCtrls, Forms, KFunctions, KControls, KEditCommon;
resourcestring
{ @exclude }
sAddressText = 'Address area text';
{ @exclude }
sAddressBkGnd = 'Address area background';
{ @exclude }
sBkGnd = 'Editor background';
{ @exclude }
sDigitTextEven = 'Digit area even column';
{ @exclude }
sDigitTextOdd = 'Digit area odd column';
{ @exclude }
sDigitBkgnd = 'Digit area background';
{ @exclude }
sHorzLines = 'Horizontal lines';
{ @exclude }
sInactiveCaretBkGnd = 'Inactive caret background';
{ @exclude }
sInactiveCaretSelBkGnd = 'Selected inactive caret background';
{ @exclude }
sInactiveCaretSelText = 'Selected inactive caret text';
{ @exclude }
sInactiveCaretText = 'Inactive caret text';
{ @exclude }
sLinesHighLight = 'Lines highlight';
{ @exclude }
sSelBkGnd = 'Selection background';
{ @exclude }
sSelBkGndFocused = 'Focused selection background';
{ @exclude }
sSelText = 'Selection text';
{ @exclude }
sSelTextFocused = 'Focused selection text';
{ @exclude }
sSeparators = 'Area separating lines';
{ @exclude }
sTextText = 'Text area text';
{ @exclude }
sTextBkGnd = 'Text area background';
{ @exclude }
sVertLines = 'Vertical lines';
type
{ Declares possible values for the @link(TKCustomHexEditor.AddressMode) property }
TKHexEditorAddressMode = (
{ Address will be shown in decimal format }
eamDec,
{ Address will be shown in hexadecimal format }
eamHex
);
{ Declares possible values e.g. for the @link(TKCustomHexEditor.EditArea) property }
TKHexEditorArea = (
{ No area is selected, e.g. when clicked outside of visible text }
eaNone,
{ Address area selected/used }
eaAddress,
{ Digits area selected/used }
eaDigits,
{ Text area selected/used }
eaText
);
{ @abstract(Contains dimensions of all areas in characters)
<UL>
<LH>Members:</LH>
<LI><I>Address</I> - address area width</LI>
<LI><I>AddressOut</I> - address area leadout</LI>
<LI><I>Digits</I> - digits area width</LI>
<LI><I>DigitsIn</I> - digits area leadin</LI>
<LI><I>DigitsOut</I> - digits area leadout</LI>
<LI><I>Text</I> - text area width</LI>
<LI><I>TextIn</I> - text area leadin</LI>
<LI><I>TotalHorz</I> - total width of all defined areas</LI>
<LI><I>TotalVert</I> - total number of lines</LI>
</UL>
}
TKHexEditorAreaDimensions = record
Address,
AddressOut,
Digits,
DigitsIn,
DigitsOut,
Text,
TextIn,
TotalHorz,
TotalVert: Integer;
end;
{ Declares possible indexes e.g. for the @link(TKHexEditorColors.Color) property. }
TKHexEditorColorIndex = Integer;
{ @abstract(Declares @link(TKHexEditorColors) color item description)
<UL>
<LH>Members:</LH>
<LI><I>Def</I> - default color value</LI>
<LI><I>Name</I> - color name (can be localized)</LI>
</UL>
}
TKHexEditorColorSpec = record
Def: TColor;
Name: string;
end;
{ Declares possible values for the @link(TKCustomHexEditor.DisabledDrawStyle) property }
TKHexEditorDisabledDrawStyle = (
{ The lines will be painted with brighter colors when editor is disabled }
eddBright,
{ The lines will be painted with gray text and white background when editor is disabled }
eddGrayed,
{ The lines will be painted normally when editor is disabled }
eddNormal
);
{ Declares drawing styles - possible values for the @link(TKCustomHexEditor.DrawStyles) property }
TKHexEditorDrawStyle = (
{ Show adress area }
edAddress,
{ Show digits area }
edDigits,
{ Show text area }
edText,
{ Show horizontal leading lines }
edHorzLines,
{ Show caret position when editor is inactive (has no input focus) }
edInactiveCaret,
{ Show vertical area separating lines }
edSeparators,
{ Show vertical leading lines (digits area only) }
edVertLines,
{ @link(TKHexEditorColors.BkGnd) is used for all areas if included }
edSingleBkGnd
);
{ Drawing styles can be arbitrary combined }
TKHexEditorDrawStyles = set of TKHexEditorDrawStyle;
{ @abstract(Declares the paint data structure for the @link(TKCustomHexEditor.PaintLines) method)
<UL>
<LH>Members:</LH>
<LI><I>Canvas</I> - destination canvas</LI>
<LI><I>PainRect</I> - bounding rectangle for painted lines (no clipping necessary,
this is performed by window/page client area)</LI>
<LI><I>TopLine</I> - first line painted (vertical scroll offset)</LI>
<LI><I>BottomLine</I> - last line painted</LI>
<LI><I>LeftChar</I> - first character painted (horizontal scroll offset)</LI>
<LI><I>CharWidth</I> - character width in pixels for supplied canvas</LI>
<LI><I>CharHeight</I> - character height in pixels for supplied canvas</LI>
<LI><I>CharSpacing</I> - inter-character spacing in pixels for supplied canvas</LI>
<LI><I>Printing</I> - determines whether normal painting or page printing should be performed</LI>
<LI><I>PaintAll</I> - when Printing is True, specifies whether all data or selection only
should be painted, this applies only to the first and/or last painted line</LI>
<LI><I>PaintColors</I> - when Printing is True, specifies whether to paint with colors or grayscale</LI>
<LI><I>PaintSelection</I> - when Printing is True, specifies whether to indicate the selection</LI>
</UL>
}
TKHexEditorPaintData = record
Canvas: TCanvas;
PaintRect: TRect;
TopLine,
BottomLine,
LeftChar,
CharWidth,
CharHeight,
CharSpacing: Integer;
Printing,
PaintAll,
PaintColors,
PaintSelection,
CaretShown: Boolean;
end;
{ @abstract(Declares the selection structure)
<UL>
<LH>Members:</LH>
<LI><I>Index</I> - byte index</LI>
<LI><I>Digit</I> - digit index</LI>
</UL>
}
TKHexEditorSelection = record
Index: Integer;
Digit: Integer;
end;
{ @abstract(Declares the structure for the @link(TKCustomHexEditor.SelText) property)
<UL>
<LH>Members:</LH>
<LI><I>AsBinaryRaw</I> - selected data as binary characters not mapped</LI>
<LI><I>AsBinaryMapped</I> - selected data as binary characters mapped</LI>
<LI><I>AsDigits</I> - selected data as hexadecimal digits</LI>
<LI><I>AsDigitsByteAligned</I> - selected data as hexadecimal digits
without regarding cross-byte selections</LI>
</UL>
}
TKHexEditorSelText = record
AsBinaryRaw,
AsBinaryMapped,
AsDigits,
AsDigitsByteAligned: AnsiString;
end;
{ Declares hex editor states - possible values for the @link(TKCustomHexEditor.States) property
(protected) }
TKHexEditorState = (
{ Caret is visible }
elCaretVisible,
{ Caret is being updated }
elCaretUpdate,
{ Ignore following WM_CHAR message }
elIgnoreNextChar,
{ Buffer modified }
elModified,
{ Mouse captured }
elMouseCapture,
{ Overwrite mode active }
elOverwrite,
{ Read only editor }
elReadOnly
);
{ Hex editor states can be arbitrary combined }
TKHexEditorStates = set of TKHexEditorState;
{ @abstract(Declares the color description structure returned by @link(TKHexEditorColors.ColorData) property)
<UL>
<LH>Members:</LH>
<LI><I>Index</I> - color index</LI>
<LI><I>Color</I> - current color value</LI>
<LI><I>Default</I> - default color value</LI>
<LI><I>Name</I> - color name</LI>
</UL>
}
TKHexEditorColorData = record
Index: TKHexEditorColorIndex;
Color: TColor;
Default: TColor;
Name: string;
end;
{ Declares possible values for the @link(TKHexEditorColors.ColorScheme) property }
TKHexEditorColorScheme = (
{ GetColor returns normal color currently defined for each item }
ecsNormal,
{ GetColor returns gray for text and line colors and white for background colors }
ecsGrayed,
{ GetColor returns brighter version of normal color }
ecsBright,
{ GetColor returns grayscaled color versions }
ecsGrayScale
);
const
{ Minimum for the @link(TKCustomHexEditor.AddressSize) property }
cAddressSizeMin = 2;
{ Maximum for the @link(TKCustomHexEditor.AddressSize) property }
cAddressSizeMax = 10;
{ Default value for the @link(TKCustomHexEditor.AddressSize) property }
cAddressSizeDef = 8;
{ Minimum for the @link(TKCustomHexEditor.AreaSpacing) property }
cAreaSpacingMin = 1;
{ Maximum for the @link(TKCustomHexEditor.AreaSpacing) property }
cAreaSpacingMax = 20;
{ Default value for the @link(TKCustomHexEditor.AreaSpacing) property }
cAreaSpacingDef = 1;
{ Minimum for the @link(TKCustomHexEditor.CharSpacing) property }
cCharSpacingMin = 0;
{ Maximum for the @link(TKCustomHexEditor.CharSpacing) property }
cCharSpacingMax = 100;
{ Default value for the @link(TKCustomHexEditor.CharSpacing) property }
cCharSpacingDef = 0;
{ Minimum for the @link(TKCustomHexEditor.DigitGrouping) property }
cDigitGroupingMin = 1;
{ Maximum for the @link(TKCustomHexEditor.DigitGrouping) property }
cDigitGroupingMax = 8;
{ Default value for the @link(TKCustomHexEditor.DigitGrouping) property }
cDigitGroupingDef = 2;
{ Minimum for the @link(TKCustomHexEditor.LineHeightPercent) property }
cLineHeightPercentMin = 10;
{ Maximum for the @link(TKCustomHexEditor.LineHeightPercent) property }
cLineHeightPercentMax = 1000;
{ Default value for the @link(TKCustomHexEditor.LineHeightPercent) property }
cLineHeightPercentDef = 130;
{ Minimum for the @link(TKCustomHexEditor.UndoLimit) property }
cUndoLimitMin = 100;
{ Maximum for the @link(TKCustomHexEditor.UndoLimit) property }
cUndoLimitMax = 10000;
{ Default value for the @link(TKCustomHexEditor.UndoLimit) property }
cUndoLimitDef = 1000;
{ Minimum for the @link(TKCustomHexEditor.LineSize) property }
cLineSizeMin = 1;
{ Maximum for the @link(TKCustomHexEditor.LineSize) property }
cLineSizeMax = 128;
{ Default value for the @link(TKCustomHexEditor.LineSize) property }
cLineSizeDef = 16;
{ Minimum for the @link(TKCustomHexEditor.ScrollSpeed) property }
cScrollSpeedMin = 50;
{ Maximum for the @link(TKCustomHexEditor.ScrollSpeed) property }
cScrollSpeedMax = 1000;
{ Default value for the @link(TKCustomHexEditor.ScrollSpeed) property }
cScrollSpeedDef = 100;
{ Minimum for the @link(TKHexEditor.Font).Size property }
cFontSizeMin = 8;
{ Maximum for the @link(TKHexEditor.Font).Size property }
cFontSizeMax = 100;
{ Default value for the @link(TKHexEditor.Font).Size property }
cFontSizeDef = 11;
{ Default value for the @link(TKHexEditorColors.AddressText) color property }
cAddressTextDef = clWindowText;
{ Default value for the @link(TKHexEditorColors.AddressBkGnd) color property }
cAddressBkgndDef = clWindow;
{ Default value for the @link(TKHexEditorColors.BkGnd) color property }
cBkGndDef = clWindow;
{ Default value for the @link(TKHexEditorColors.DigitTextEven) color property }
cDigitTextEvenDef = clMaroon;
{ Default value for the @link(TKHexEditorColors.DigitTextOdd) color property }
cDigitTextOddDef = clRed;
{ Default value for the @link(TKHexEditorColors.DigitBkGnd) color property }
cDigitBkGndDef = clWindow;
{ Default value for the @link(TKHexEditorColors.HorzLines) color property }
cHorzLinesDef = clWindowText;
{ Default value for the @link(TKHexEditorColors.InactiveCaretBkGnd) color property }
cInactiveCaretBkGndDef = clBlack;
{ Default value for the @link(TKHexEditorColors.InactiveCaretSelBkGnd) color property }
cInactiveCaretSelBkGndDef = clBlack;
{ Default value for the @link(TKHexEditorColors.InactiveCaretSelText) color property }
cInactiveCaretSelTextDef = clYellow;
{ Default value for the @link(TKHexEditorColors.InactiveCaretText) color property }
cInactiveCaretTextDef = clYellow;
{ Default value for the @link(TKHexEditorColors.LinesHighLight) color property }
cLinesHighLightDef = clHighLightText;
{ Default value for the @link(TKHexEditorColors.SelBkGnd) color property }
cSelBkGndDef = clGrayText;
{ Default value for the @link(TKHexEditorColors.SelBkGndFocused) color property }
cSelBkGndFocusedDef = clHighlight;
{ Default value for the @link(TKHexEditorColors.SelText) color property }
cSelTextDef = clHighlightText;
{ Default value for the @link(TKHexEditorColors.SelTextFocused) color property }
cSelTextFocusedDef = clHighlightText;
{ Default value for the @link(TKHexEditorColors.Separators) color property }
cSeparatorsDef = clWindowText;
{ Default value for the @link(TKHexEditorColors.TextText) color property }
cTextTextDef = clWindowText;
{ Default value for the @link(TKHexEditorColors.TextBkgnd) color property }
cTextBkgndDef = clWindow;
{ Default value for the @link(TKHexEditorColors.VertLines) color property }
cVertLinesDef = clWindowText;
{ Index for the @link(TKHexEditorColors.AddressText) color property }
ciAddressText = TKHexEditorColorIndex(0);
{ Index for the @link(TKHexEditorColors.AddressBkGnd) color property }
ciAddressBkGnd = TKHexEditorColorIndex(1);
{ Index for the @link(TKHexEditorColors.BkGnd) color property }
ciBkGnd = TKHexEditorColorIndex(2);
{ Index for the @link(TKHexEditorColors.DigitTextEven) color property }
ciDigitTextEven = TKHexEditorColorIndex(3);
{ Index for the @link(TKHexEditorColors.DigitTextOdd) color property }
ciDigitTextOdd = TKHexEditorColorIndex(4);
{ Index for the @link(TKHexEditorColors.DigitBkGnd) color property }
ciDigitBkGnd = TKHexEditorColorIndex(5);
{ Index for the @link(TKHexEditorColors.HorzLines) color property }
ciHorzLines = TKHexEditorColorIndex(6);
{ Index for the @link(TKHexEditorColors.InactiveCaretBkGnd) color property }
ciInactiveCaretBkGnd = TKHexEditorColorIndex(7);
{ Index for the @link(TKHexEditorColors.InactiveCaretSelBkGnd) color property }
ciInactiveCaretSelBkGnd = TKHexEditorColorIndex(8);
{ Index for the @link(TKHexEditorColors.InactiveCaretSelText) color property }
ciInactiveCaretSelText = TKHexEditorColorIndex(9);
{ Index for the @link(TKHexEditorColors.InactiveCaretText) color property }
ciInactiveCaretText = TKHexEditorColorIndex(10);
{ Index for the @link(TKHexEditorColors.LinesHighLight) color property }
ciLinesHighLight = TKHexEditorColorIndex(11);
{ Index for the @link(TKHexEditorColors.SelBkGnd) color property }
ciSelBkGnd = TKHexEditorColorIndex(12);
{ Index for the @link(TKHexEditorColors.SelBkGndFocused) color property }
ciSelBkGndFocused = TKHexEditorColorIndex(13);
{ Index for the @link(TKHexEditorColors.SelText) color property }
ciSelText = TKHexEditorColorIndex(14);
{ Index for the @link(TKHexEditorColors.SelTextFocused) color property }
ciSelTextFocused = TKHexEditorColorIndex(15);
{ Index for the @link(TKHexEditorColors.Separators) color property }
ciSeparators = TKHexEditorColorIndex(16);
{ Index for the @link(TKHexEditorColors.TextText) color property }
ciTextText = TKHexEditorColorIndex(17);
{ Index for the @link(TKHexEditorColors.TextBkgnd) color property }
ciTextBkGnd = TKHexEditorColorIndex(18);
{ Index for the @link(TKHexEditorColors.VertLines) color property }
ciVertLines = TKHexEditorColorIndex(19);
{ Maximum color array index }
ciHexEditorColorsMax = ciVertLines;
{ Default value for the @link(TKCustomHexEditor.AddressMode) property }
cAddressModeDef = eamHex;
{ Default value for the @link(TKCustomHexEditor.Addressoffset) property }
cAddressOffsetDef = 0;
{ Default value for the @link(TKCustomHexEditor.DisabledDrawStyle) property }
cDisabledDrawStyleDef = eddBright;
{ Default value for the @link(TKCustomHexEditor.DrawStyles) property }
cDrawStylesDef = [edAddress, edDigits, edText, edInactiveCaret, edSeparators];
{ Default value for the @link(TKCustomHexEditor.AddressPrefix) property }
cAddressPrefixDef = '0x';
{ Default value for the @link(TKHexEditor.Font).Name property }
cFontNameDef = {$IFDEF MSWINDOWS}'Courier New'{$ELSE}'Courier'{$ENDIF};
{ Default value for the @link(TKHexEditor.Font).Style property }
cFontStyleDef = [fsBold];
{ Declares the Index member of the @link(TKHexEditorSelection) record invalid}
cInvalidIndex = -1;
{ Default value for the @link(TKCustomHexEditor.AddressCursor) property }
cAddressCursorDef = crHandPoint;
{ Default value for the @link(TKHexEditor.Height) property }
cHeight = 300;
{ Default value for the @link(TKHexEditor.Width) property }
cWidth = 400;
type
TKCustomHexEditor = class;
{ @abstract(Container for all colors used by @link(TKCustomHexEditor) class)
This container allows to group many colors into one item in object inspector.
Colors are accessible via published properties or several public Color*
properties.
}
TKHexEditorColors = class(TPersistent)
private
FOwner: TKCustomHexEditor;
FBrightColors: TKColorArray;
FColors: TKColorArray;
FColorScheme: TKHexEditorColorScheme;
FSingleBkGnd: Boolean;
function GetColor(Index: TKHexEditorColorIndex): TColor;
function GetColorData(Index: TKHexEditorColorIndex): TKHexEditorColorData;
function GetColorEx(Index: TKHexEditorColorIndex): TColor;
function GetColorName(Index: TKHexEditorColorIndex): string;
procedure SetColor(Index: TKHexEditorColorIndex; Value: TColor);
procedure SetColorEx(Index: TKHexEditorColorIndex; Value: TColor);
procedure SetColors(const Value: TKColorArray);
public
{ Performs necessary initializations }
constructor Create(AOwner: TKCustomHexEditor);
{ Takes property values from another TKHexEditorColors class }
procedure Assign(Source: TPersistent); override;
{ Clears cached brighter colors }
procedure ClearBrightColors;
{ Initializes the color array. }
procedure Initialize; virtual;
{ Specifies color scheme for reading of published properties - see GetColor in source code}
property ColorScheme: TKHexEditorColorScheme read FColorScheme write FColorScheme;
{ Returns always normal color - regardless of the ColorScheme setting }
property Color[Index: TKHexEditorColorIndex]: TColor read GetColorEx write SetColorEx;
{ Returns always a complete color description }
property ColorData[Index: TKHexEditorColorIndex]: TKHexEditorColorData read GetColorData;
{ Returns (localizable) color name }
property ColorName[Index: TKHexEditorColorIndex]: string read GetColorName;
{ Returns array of normal colors }
property Colors: TKColorArray read FColors write SetColors;
{ @link(TKHexEditorColors.BkGnd) is used for all areas if True - @link(edSingleBkGnd) forward }
property SingleBkGnd: Boolean read FSingleBkGnd write FSingleBkGnd;
published
{ Address area text color }
property AddressText: TColor index ciAddressText read GetColor write SetColor default cAddressTextDef;
{ Address area background color }
property AddressBkGnd: TColor index ciAddressBkgnd read GetColor write SetColor default cAddressBkGndDef;
{ Hex editor client area background }
property BkGnd: TColor index ciBkGnd read GetColor write SetColor default cBkGndDef;
{ Digits area text color - even digit group }
property DigitTextEven: TColor index ciDigitTextEven read GetColor write SetColor default cDigitTextEvenDef;
{ Digits area text color - odd digit group }
property DigitTextOdd: TColor index ciDigitTextOdd read GetColor write SetColor default cDigitTextOddDef;
{ Digits area background color }
property DigitBkGnd: TColor index ciDigitBkGnd read GetColor write SetColor default cDigitBkGndDef;
{ Color of the horizontal leading lines }
property HorzLines: TColor index ciHorzLines read GetColor write SetColor default cHorzLinesDef;
{ Inactive (hex editor without focus) caret background color - caret mark is not part of a selection }
property InactiveCaretBkGnd: TColor index ciInactiveCaretBkGnd read GetColor write SetColor default cInactiveCaretBkGndDef;
{ Inactive (hex editor without focus) caret background color - caret mark is part of a selection }
property InactiveCaretSelBkGnd: TColor index ciInactiveCaretSelBkGnd read GetColor write SetColor default cInactiveCaretSelBkGndDef;
{ Inactive (hex editor without focus) caret text color - caret mark is part of a selection }
property InactiveCaretSelText: TColor index ciInactiveCaretSelText read GetColor write SetColor default cInactiveCaretSelTextDef;
{ Inactive (hex editor without focus) caret text color - caret mark is not part of a selection }
property InactiveCaretText: TColor index ciInactiveCaretText read GetColor write SetColor default cInactiveCaretTextDef;
{ Color of horizontal leading lines involved into a selection }
property LinesHighLight: TColor index ciLinesHighLight read GetColor write SetColor default cLinesHighLightDef;
{ Selection background - inactive edit area }
property SelBkGnd: TColor index ciSelBkGnd read GetColor write SetColor default cSelBkGndDef;
{ Selection background - active edit area }
property SelBkGndFocused: TColor index ciSelBkGndFocused read GetColor write SetColor default cSelBkGndFocusedDef;
{ Selection text - inactive edit area }
property SelText: TColor index ciSelText read GetColor write SetColor default cSelTextDef;
{ Selection text - active edit area }
property SelTextFocused: TColor index ciSelTextFocused read GetColor write SetColor default cSelTextFocusedDef;
{ Color of the vertical area separating lines }
property Separators: TColor index ciSeparators read GetColor write SetColor default cSeparatorsDef;
{ Text area text color }
property TextText: TColor index ciTextText read GetColor write SetColor default cTextTextDef;
{ Text area background color }
property TextBkgnd: TColor index ciTextBkgnd read GetColor write SetColor default cTextBkGndDef;
{ Color of the vertical leading lines }
property VertLines: TColor index ciVertLines read GetColor write SetColor default cVertLinesDef;
end;
{ Declares possible values for the ItemReason member of the @link(TKHexEditorChangeItem) structure }
TKHexEditorChangeReason = (
{ Save caret position only }
crCaretPos,
{ Save inserted character to be able to delete it }
crDeleteChar,
{ Save inserted hexadecimal digits to be able to delete them }
crDeleteDigits,
{ Save inserted binary string to be able to delete it }
crDeleteString,
{ Save deleted character to be able to insert it }
crInsertChar,
{ Save deleted hexadecimal digits to be able to insert them }
crInsertDigits,
{ Save deleted binary string to be able to insert it }
crInsertString
);
{ @abstract(Declares @link(TKHexEditorChangeList.OnChange) event handler)
<UL>
<LH>Parameters:</LH>
<LI><I>Sender</I> - identifies the event caller</LI>
<LI><I>ItemReason</I> - specifies the undo/redo reason</LI>
</UL>
}
TKHexEditorUndoChangeEvent = procedure(Sender: TObject;
ItemReason: TKHexEditorChangeReason) of object;
{ @abstract(Declares the undo/redo item description structure used by the @link(TKHexEditorChangeList) class)
<UL>
<LH>Members:</LH>
<LI><I>Data</I> - characters (binary or digit string) needed to execute this item</LI>
<LI><I>EditArea</I> - active edit area at the time this item was recorded</LI>
<LI><I>Group</I> - identifies the undo/redo group. Some editor modifications
produce a sequence of 2 or more undo items. This sequence is called undo/redo
group and is always interpreted as a single undo/redo item. Moreover,
if there is eoGroupUndo in @link(TKCustomHexEditor.Options),
a single ecUndo or ecRedo command manipulates all following undo groups
of the same kind (reason) as if they were a single undo/redo item. </LI>
<LI><I>GroupReason</I> - reason (kind) of this undo group</LI>
<LI><I>ItemReason</I> - reason (kind) of this item</LI>
<LI><I>SelEnd</I> - end of the selection at the time this item was recorded</LI>
<LI><I>SelStart</I> - start of the selection at the time this item was recorded</LI>
</UL>
}
TKHexEditorChangeItem = record
Data: AnsiString;
EditArea: TKHexEditorArea;
Group: Cardinal;
GroupReason: TKHexEditorChangeReason;
Inserted: Boolean;
ItemReason: TKHexEditorChangeReason;
SelEnd: TKHexEditorSelection;
SelStart: TKHexEditorSelection;
end;
{ Pointer to @link(TKHexEditorChangeItem) }
PKHexEditorChangeItem = ^TKHexEditorChangeItem;
{ @abstract(Change (undo/redo item) list manager) }
TKHexEditorChangeList = class(TList)
private
FEditor: TKCustomHexEditor;
FGroup: Cardinal;
FGroupUseLock: Integer;
FGroupReason: TKHexEditorChangeReason;
FIndex: Integer;
FModifiedIndex: Integer;
FLimit: Integer;
FRedoList: TKHexEditorChangeList;
FOnChange: TKHexEditorUndoChangeEvent;
function GetModified: Boolean;
procedure SetLimit(Value: Integer);
procedure SetModified(Value: Boolean);
protected
{ Redefined to properly destroy the items }
procedure Notify(Ptr: Pointer; Action: TListNotification); override;
public
{ Performs necessary initializations
<UL>
<LH>Parameters:</LH>
<LI><I>AEditor</I> - identifies the undo/redo list owner</LI>
<LI><I>RedoList</I> - when this instance is used as undo list, specify
a redo list to allow clear it at each valid AddChange call</LI>
</UL>}
constructor Create(AEditor: TKCustomHexEditor; RedoList: TKHexEditorChangeList);
{ Inserts a undo/redo item
<UL>
<LH>Parameters:</LH>
<LI><I>ItemReason</I> - specifies the undo/redo item reason. The change list doesn't
allow to insert succesive crCaretPos items unless Inserted is True</LI>
<LI><I>Data</I> - specifies the item data. Some items (crCaretPos)
don't need to supply any data</LI>
<LI><I>Inserted</I> - for the urInsert* items, specifies whether the item
was recorded with @link(TKCustomHexEditor.InsertMode) on (True) or
off (False). See ItemReason for crCaretPos behavior.</LI>
</UL>}
procedure AddChange(ItemReason: TKHexEditorChangeReason; const Data: AnsiString = '';
Inserted: Boolean = True); virtual;
{ Tells the undo list a new undo/redo group is about to be created. Each
BeginGroup call must have a corresponding EndGroup call (use try-finally).
BeginGroup calls may be nested, however, only the first call will create an
undo/redo group. Use the GroupReason parameter to specify the reason of this group. }
procedure BeginGroup(GroupReason: TKHexEditorChangeReason); virtual;
{ Informs whether there are any undo/redo items available - i.e. CanUndo/CanRedo}
function CanPeek: Boolean;
{ Clears the entire list - overriden to execute some adjustments }
procedure Clear; override;
{ Completes the undo/redo group. See @link(TKHexEditorChangeList.BeginGroup) for details }
procedure EndGroup; virtual;
{ Returns the topmost item to handle or inspect it}
function PeekItem: PKHexEditorChangeItem;
{ If there is no reason to handle an item returned by PeekItem, it has to be
poked back with this function to become active for next undo/redo command }
procedure PokeItem;
{ For redo list only - each undo command creates a redo command with the same
group information - see source }
procedure SetGroupData(Group: Integer; GroupReason: TKHexEditorChangeReason);
{ Specifies maximum number of items - not groups }
property Limit: Integer read FLimit write SetLimit;
{ For undo list only - returns True if undo list contains some items with regard
to the eoUndoAfterSave option }
property Modified: Boolean read GetModified write SetModified;
{ Allows to call TKCustomHexEditor.@link(TKCustomHexEditor.OnChange) event}
property OnChange: TKHexEditorUndoChangeEvent read FOnChange write FOnChange;
end;
{ @abstract(Hexadecimal editor base component) }
TKCustomHexEditor = class(TKCustomControl)
private
FAddressCursor: TCursor;
FAddressMode: TKHexEditorAddressMode;
FAddressOffset: Integer;
FAddressPrefix: string;
FAddressSize: Integer;
FAreaSpacing: Integer;
FBuffer: PBytes;
FCharHeight: Integer;
FCharMapping: TKEditCharMapping;
FCharSpacing: Integer;
FCharWidth: Integer;
FClipboardFormat: Word;
FColors: TKHexEditorColors;
FDigitGrouping: Integer;
FDisabledDrawStyle: TKHexEditorDisabledDrawStyle;
FDrawStyles: TKHexEditorDrawStyles;
FEditArea: TKHexEditorArea;
FKeyMapping: TKEditKeyMapping;
FLeftChar: Integer;
FLineHeightPercent: Integer;
FLineSize: Integer;
FMouseWheelAccumulator: Integer;
FOptions: TKEditOptions;
FRedoList: TKHexEditorChangeList;
FScrollBars: TScrollStyle;
FScrollDeltaX: Integer;
FScrollDeltaY: Integer;
FScrollSpeed: Cardinal;
FScrollTimer: TTimer;
FSelEnd: TKHexEditorSelection;
FSelStart: TKHexEditorSelection;
FSize: Integer;
FStates: TKHexEditorStates;
FTopLine: Integer;
FTotalCharSpacing: Integer;
FUndoList: TKHexEditorChangeList;
FOnChange: TNotifyEvent;
FOnDropFiles: TKEditDropFilesEvent;
FOnReplaceText: TKEditReplaceTextEvent;
function GetCommandKey(Index: TKEditCommand): TKEditKey;
function GetCaretVisible: Boolean;
function GetData: TDataSize;
function GetEmpty: Boolean;
function GetFirstVisibleIndex: Integer;
function GetInsertMode: Boolean;
function GetLastVisibleIndex: Integer;
function GetLineCount: Integer;
function GetLines(Index: Integer): TDataSize;
function GetModified: Boolean;
function GetReadOnly: Boolean;
function GetSelLength: TKHexEditorSelection;
function GetSelText: TKHexEditorSelText;
function GetUndoLimit: Integer;
function IsAddressPrefixStored: Boolean;
function IsDrawStylesStored: Boolean;
function IsOptionsStored: Boolean;
procedure ScrollTimerHandler(Sender: TObject);
procedure SetAddressCursor(Value: TCursor);
procedure SetAddressMode(Value: TKHexEditorAddressMode);
procedure SetAddressOffset(Value: Integer);
procedure SetAddressPrefix(const Value: string);
procedure SetAddressSize(Value: Integer);
procedure SetAreaSpacing(Value: Integer);
procedure SetCharSpacing(Value: Integer);
procedure SetColors(Value: TKHexEditorColors);
procedure SetCommandKey(Index: TKEditCommand; Value: TKEditKey);
procedure SetData(Value: TDataSize);
procedure SetDigitGrouping(Value: Integer);
procedure SetDisabledDrawStyle(Value: TKHexEditorDisabledDrawStyle);
procedure SetDrawStyles(const Value: TKHexEditorDrawStyles);
procedure SetEditArea(Value: TKHexEditorArea);
procedure SetLeftChar(Value: Integer);
procedure SetLineHeightPercent(Value: Integer);
procedure SetLines(Index: Integer; const Value: TDataSize);
procedure SetLineSize(Value: Integer);
procedure SetModified(Value: Boolean);
procedure SetOptions(const Value: TKEditOptions);
procedure SetReadOnly(Value: Boolean);
procedure SetScrollBars(Value: TScrollStyle);
procedure SetScrollSpeed(Value: Cardinal);
procedure SetSelEnd(Value: TKHexEditorSelection);
procedure SetSelLength(Value: TKHexEditorSelection);
procedure SetSelStart(Value: TKHexEditorSelection);
procedure SetTopLine(Value: Integer);
procedure SetUndoLimit(Value: Integer);
procedure CMEnabledChanged(var Msg: TLMessage); message CM_ENABLEDCHANGED;
procedure CMSysColorChange(var Msg: TLMessage); message CM_SYSCOLORCHANGE;
{$IFNDEF FPC}
// no way to get filenames in Lazarus inside control (why??)
procedure WMDropFiles(var Msg: TLMessage); message LM_DROPFILES;
{$ENDIF}
procedure WMEraseBkgnd(var Msg: TLMessage); message LM_ERASEBKGND;
procedure WMGetDlgCode(var Msg: TLMNoParams); message LM_GETDLGCODE;
procedure WMHScroll(var Msg: TLMHScroll); message LM_HSCROLL;
procedure WMKillFocus(var Msg: TLMKillFocus); message LM_KILLFOCUS;
procedure WMSetFocus(var Msg: TLMSetFocus); message LM_SETFOCUS;
procedure WMVScroll(var Msg: TLMVScroll); message LM_VSCROLL;
protected
{ Inserts a single crCaretPos item into undo list. Unless Force is set to True,
this change will be inserted only if previous undo item is not crCaretPos. }
procedure AddUndoCaretPos(Force: Boolean = True);
{ Inserts a single byte change into undo list.
<UL>
<LH>Parameters:</LH>
<LI><I>ItemReason</I> - specifies the undo/redo item reason - most likely
crInsertChar or crDeleteChar.</LI>
<LI><I>Data</I> - specifies the data byte needed to restore the original
buffer state</LI>
<LI><I>Inserted</I> - for the urInsert* items, specifies the current
@link(TKCustomHexEditor.InsertMode) status.</LI>
</UL>}
procedure AddUndoByte(ItemReason: TKHexEditorChangeReason; Data: Byte;
Inserted: Boolean = True);
{ Inserts a byte array change into undo list.
<UL>
<LH>Parameters:</LH>
<LI><I>ItemReason</I> - specifies the undo/redo item reason - crInsert* or
crDelete*.</LI>
<LI><I>Data</I> - specifies the data bytes needed to restore the original
buffer state</LI>
<LI><I>Inserted</I> - for the urInsert* items, specifies the current
@link(TKCustomHexEditor.InsertMode) status.</LI>
</UL>}
procedure AddUndoBytes(ItemReason: TKHexEditorChangeReason; Data: PBytes;
Length: Integer; Inserted: Boolean = True);
{ Inserts a string change into undo list. Has the same functionality as AddUndoBytes
only Data is supplied as a string. }
procedure AddUndoString(ItemReason: TKHexEditorChangeReason; const S: AnsiString;
Inserted: Boolean = True);
{ Begins a new undo group. Use the GroupReason parameter to label it. }
procedure BeginUndoGroup(GroupReason: TKHexEditorChangeReason);
{ Performs necessary adjustments when the buffer is modified programatically
(not by user) }
procedure BufferChanged;
{ Determines whether an ecScroll* command can be executed }
function CanScroll(Command: TKEditCommand): Boolean; virtual;
{ Clears a character at position At. Doesn't perform any succesive adjustments. }
procedure ClearChar(At: Integer);
{ Clears a the digit fields both in SelStart and SelEnd. Doesn't perform any succesive adjustments.}
procedure ClearDigitSelection;
{ Clears a string of the Size length at position At. Doesn't perform any succesive adjustments. }
procedure ClearString(At, Size: Integer);
{ Overriden method - defines additional styles for the hex editor window (scrollbars etc.)}
procedure CreateParams(var Params: TCreateParams); override;
{ Overriden method - adjusts file drag&drop functionality }
procedure CreateWnd; override;
{ Overriden method - adjusts file drag&drop functionality }
procedure DestroyWnd; override;
{ Calls the @link(TKCustomHexEditor.OnChange) event }
procedure DoChange; virtual;
{ Overriden method - handles mouse wheel messages }
function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
MousePos: TPoint): Boolean; override;
{ Validates the EditArea property after it has been modified }
procedure EditAreaChanged; virtual;
{ Closes the undo group created by @link(TKCustomHexEditor.BeginUndoGroup) }
procedure EndUndoGroup;
{ Ensures that font pitch is always fpFixed and Font.Size is not too small or big }
procedure FontChange(Sender: TObject); virtual;
{ Returns the horizontal page extent for the current edit area. This function is
used by the ecPageLeft and ecPageRight commands. }
function GetPageHorz: Integer; virtual;
{ Determines if the editor has input focus. }
function HasFocus: Boolean; virtual;
{ Hides the caret. }
procedure HideEditorCaret; virtual;
{ Inserts a character at specified position. Doesn't perform any succesive adjustments.
<UL>
<LH>Parameters:</LH>
<LI><I>At</I> - position where the character should be inserted.</LI>
<LI><I>Value</I> - character (data byte)</LI>
</UL> }
procedure InsertChar(At: Integer; Value: Byte);
{ Inserts a string at specified position. Doesn't perform any succesive adjustments.
<UL>
<LH>Parameters:</LH>
<LI><I>At</I> - position where the string should be inserted.</LI>
<LI><I>Value</I> - data byte string</LI>
<LI><I>Size</I> - length of the data byte string</LI>
</UL> }
procedure InsertString(At: Integer; const Value: AnsiString; Size: Integer);
{ Returns True if the control has a selection. }
function InternalGetSelAvail: Boolean; override;
{ Moves the caret one position left. Doesn't perform any succesive adjustments.}
procedure InternalMoveLeft; virtual;
{ Moves the caret one position right. Doesn't perform any succesive adjustments.}
procedure InternalMoveRight; virtual;
{ Overriden method - processes virtual key strokes according to current @link(TKCustomHexEditor.KeyMapping) }
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
{ Overriden method - processes character key strokes - data editing }
procedure KeyPress(var Key: Char); override;
{ Updates information about printed shape. }
procedure MeasurePages(var Info: TKPrintMeasureInfo); override;
{ Processes scrollbar messages.
<UL>
<LH>Parameters:</LH>
<LI><I>ScrollBar</I> - scrollbar type from OS</LI>
<LI><I>ScrollCode</I> - scrollbar action from OS</LI>
<LI><I>Delta</I> - scrollbar position change</LI>
<LI><I>UpdateNeeded</I> - set to True if you want to invalidate
and update caret position</LI>
</UL> }
procedure ModifyScrollBar(ScrollBar, ScrollCode, Delta: Integer;
UpdateNeeded: Boolean);
{ Overriden method - updates caret position/selection }
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
{ Overriden method - updates caret position/selection and initializes scrolling
when needed. }
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
{ Overriden method - releases mouse capture acquired by MouseDown }
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
{ Overriden method - calls PaintLines for drawing the hex editor outline
into window client area }
procedure PaintToCanvas(ACanvas: TCanvas); override;
{ Paints/prints hex editor outline. This function must retain its reentrancy.
<UL>
<LH>Parameters:</LH>
<LI><I>Data</I> - paint settings</LI>
</UL> }
procedure PaintLines(const Data: TKHexEditorPaintData); virtual;
{ Paints a page to a printer/preview canvas. }
procedure PaintPage; override;
{ Grants the input focus to the control when possible and the control has had none before }
procedure SafeSetFocus;
{ Performs necessary adjustments after a selection property changed.
<UL>
<LH>Parameters:</LH>
<LI><I>StartEqualEnd</I> - forces SelStart equal to SelEnd</LI>
<LI><I>ScrollToView</I> - forces scrolling if SelEnd (caret) became invisible</LI>
</UL> }
procedure SelectionChanged(StartEqualEnd: Boolean; ScrollToView: Boolean = True);
{ Scrolls the hex editor window horizontaly by HChars characters and/or
vertically by VChars characters }
procedure ScrollBy(HChars, VChars: Integer; UpdateNeeded: Boolean);
{ Scrolls the hex editor window to ensure data under defined (mouse) coordinates are visible
<UL>
<LH>Parameters:</LH>
<LI><I>Point</I> - (mouse) coordinates</LI>
<LI><I>Timed</I> - set to True to continue scroll via a timer. The scrolling
will continue until the mouse cursor is outside of the modified client rect
(@link(TKCustomHexEditor.GetModifiedClientRect)).</LI>
<LI><I>AlwaysScroll</I> - set to True to disable new line overscrolling</LI>
</UL> }
procedure ScrollTo(Point: TPoint; Timed, AlwaysScroll: Boolean); virtual;
{ Updates mouse cursor according to the state determined from current mouse
position. Returns True if cursor has been changed. }
function SetMouseCursor(X, Y: Integer): Boolean; override;
{ Shows the caret. }
procedure ShowEditorCaret; virtual;
{ Calls the @link(TKCustomHexEditor.DoChange) method}
procedure UndoChange(Sender: TObject; ItemReason: TKHexEditorChangeReason);
{ Updates caret position, shows/hides caret according to the input focus
<UL>
<LH>Parameters:</LH>
<LI><I>Recreate</I> - set to True to recreate the caret after it has already
been created and displayed</LI>
</UL> }
procedure UpdateEditorCaret(Recreate: Boolean = False); virtual;
{ Updates font based dimensions }
procedure UpdateCharMetrics; virtual;
{ Updates mouse cursor }
procedure UpdateMouseCursor; virtual;
{ Updates the scrolling range }
procedure UpdateScrollRange; virtual;
{ Updates selection according to the supplied coordinates.
<UL>
<LH>Parameters:</LH>
<LI><I>Point</I> - specifies the coordinates </LI>
<LI><I>ClipToClient</I> - specifies whether the coordinates should be clipped
to modified client rectangle (@link(TKCustomHexEditor.GetModifiedClientRect))
first</LI>
</UL> }
procedure UpdateSelEnd(Point: TPoint; ClipToClient: Boolean); virtual;
{ Updates the control size. }
procedure UpdateSize; override;
{ Data buffer - made accessible for descendant classes }
property Buffer: PBytes read FBuffer write FBuffer;
{ Redo list manager - made accessible for descendant classes }
property RedoList: TKHexEditorChangeList read FRedoList;
{ Data buffer size - made accessible for descendant classes }
property Size: Integer read FSize write FSize;
{ States of this class - made accessible for descendant classes }
property States: TKHexEditorStates read FStates write FStates;
{ Undo list manager - made accessible for descendant classes }
property UndoList: TKHexEditorChangeList read FUndoList;
public
{ Performs necessary initializations - default values to properties, create
undo/redo list managers }
constructor Create(AOwner: TComponent); override;
{ Destroy instance, undo/redo list managers, dispose buffer... }
destructor Destroy; override;
{ Appends data at current position. Use TKHexEditor.Data.Size for At parameter
to append at the end of the buffer. }
procedure Append(At: Integer; Data: TDataSize); overload; virtual;
{ Appends data at current position. Use TKHexEditor.Data.Size for At parameter
to append at the end of the buffer. }
procedure Append(At: Integer; const Data: AnsiString); overload; virtual;
{ Takes property values from another TKCustomHexEditor class }
procedure Assign(Source: TPersistent); override;
{ Determines whether the caret is visible }
function CaretInView: Boolean;
{ Clears entire data buffer. Unlike ecClearAll this method clears everything
inclusive undo a redo lists. }
procedure Clear;
{ Clears undo (and redo) list }
procedure ClearUndo;
{ Determines whether given command can be executed at this time. Use this
function in TAction.OnUpdate events.
<UL>
<LH>Parameters:</LH>
<LI><I>Command</I> - specifies the command to inspect</LI>
</UL> }
function CommandEnabled(Command: TKEditCommand): Boolean; virtual;
{ Executes given command. This function first calls CommandEnabled to
assure given command can be executed.
<UL>
<LH>Parameters:</LH>
<LI><I>Command</I> - specifies the command to execute</LI>
<LI><I>Data</I> - specifies the data needed for the command</LI>
</UL> }
function ExecuteCommand(Command: TKEditCommand; Data: Pointer = nil): Boolean; virtual;
{ Returns dimensions of all 3 possible areas according to current area
definition }
function GetAreaDimensions: TKHexEditorAreaDimensions; virtual;
{ Returns current character mapping. }
function GetCharMapping: TKEditCharMapping;
{ Returns number of characters that vertically fit into client window }
function GetClientHeightChars: Integer; virtual;
{ Returns number of characters that horizontally fit into client window }
function GetClientWidthChars: Integer; virtual;
{ Returns the current key stroke mapping scheme. }
function GetKeyMapping: TKEditKeyMapping;
{ Returns modified client rect - a window client rect aligned to character width and
character height }
function GetModifiedClientRect: TRect; virtual;
{ Returns current maximum value for the @link(TKCustomHexEditor.LeftChar) property
<UL>
<LH>Parameters:</LH>
<LI><I>Extent</I> - specify @link(TKHexEditorAreaDimensions).TotalHorz
here, otherwise the function calculates it itself</LI>
</UL> }
function GetMaxLeftChar(Extent: Integer = 0): Integer; virtual;
{ Returns current maximum value for the @link(TKCustomHexEditor.TopLine) property
<UL>
<LH>Parameters:</LH>
<LI><I>Extent</I> - specify @link(TKHexEditorAreaDimensions).TotalVert
here, otherwise the function calculates it itself</LI>
</UL> }
function GetMaxTopLine(Extent: Integer = 0): Integer; virtual;
{ Returns "real" selection end - with always higher index value than selection
start value }
function GetRealSelEnd: TKHexEditorSelection;
{ Returns "real" selection start - with always lower index value than selection
end value }
function GetRealSelStart: TKHexEditorSelection;
{ Loads data from a file }
procedure LoadFromFile(const FileName: TFileName);
{ Loads data from a stream - stream position remains untouched }
procedure LoadFromStream(Stream: TStream);
{ Paints the editor outline to another canvas
<UL>
<LH>Parameters:</LH>
<LI><I>ACanvas</I> - canvas to paint the outline to</LI>
<LI><I>ARect</I> - given rectangle in the canvas</LI>
<LI><I>ALeftChar</I> - first left visible character</LI>
<LI><I>ATopLine</I> - first top visible line</LI>
</UL> }
procedure PaintToCanvasEx(ACanvas: TCanvas; ARect: TRect; ALeftChar, ATopLine: Integer);
{ Converts window coordinates into a selection
<UL>
<LH>Parameters:</LH>
<LI><I>P</I> - window client coordinates</LI>
<LI><I>OutOfArea</I> - uses the Area parameter to compute selection for
this area even if the supplied coordinates are outside of the area outline</LI>
<LI><I>Area</I> output parameter if OutOfArea = False, otherwise
input parameter</LI>
</UL> }
function PointToSel(P: TPoint; OutOfArea: Boolean; var Area: TKHexEditorArea): TKHexEditorSelection; virtual;
{ Saves data into a file }
procedure SaveToFile(const FileName: TFileName);
{ Saves data into a stream - stream position remains untouched }
procedure SaveToStream(Stream: TStream);
{ Determines whether a seletion (not digit selection) is available }
function SelAvail: Boolean;
{ Determines whether a given selection is valid for given area
<UL>
<LH>Parameters:</LH>
<LI><I>Value</I> - selection to examine</LI>
<LI><I>Area</I> - area for which the selection must be examined</LI>
</UL> }
function SelectionValid(Value: TKHexEditorSelection; Area: TKHexEditorArea): Boolean; virtual;
{ Converts a selection into window coordinates
<UL>
<LH>Parameters:</LH>
<LI><I>Value</I> - selection to convert</LI>
<LI><I>Area</I> - the same selection delivers another coordinates for each area</LI>
</UL> }
function SelToPoint(Value: TKHexEditorSelection; Area: TKHexEditorArea): TPoint; virtual;
{ Specifies character mapping. The main purpose of this is to avoid non-printable
characters in the text area and in AsText copies. Avoid non-printable characters
when delivering a new character mapping. }
procedure SetCharMapping(const Value: TKEditCharMapping);
{ Specifies the current key stroke mapping scheme }
procedure SetKeyMapping(const Value: TKEditKeyMapping);
{ Validates a selection for given area
<UL>
<LH>Parameters:</LH>
<LI><I>Value</I> - selection to validate</LI>
<LI><I>Area</I> - area for which the selection must be validated</LI>
</UL> }
procedure ValidateSelection(var Value: TKHexEditorSelection; Area: TKHexEditorArea); virtual;
{ Specifies the address area mouse cursor. Other areas have crIBeam - should not
be needed to modify that }
property AddressCursor: TCursor read FAddressCursor write SetAddressCursor default cAddressCursorDef;
{ Specifies the radix of addresses }
property AddressMode: TKHexEditorAddressMode read FAddressMode write SetAddressMode default cAddressModeDef;
{ Specifies the address offset }
property AddressOffset: Integer read FAddressOffset write SetAddressOffset default cAddressOffsetDef;
{ Specifies the address number prefix i.e. 0x or $ - modify together with AddressMode }
property AddressPrefix: string read FAddressPrefix write SetAddressPrefix stored IsAddressPrefixStored;
{ Specifies the number of address digits - up to 10 for decimal addresses }
property AddressSize: Integer read FAddressSize write SetAddressSize default cAddressSizeDef;
{ Defines space between neighbour areas }
property AreaSpacing: Integer read FAreaSpacing write SetAreaSpacing default cAreaSpacingDef;
{ Returns current caret position = selection end }
property CaretPos: TKHexEditorSelection read FSelEnd;
{ Returns True if caret is visible }
property CaretVisible: Boolean read GetCaretVisible;
{ Returns current character width = not necessarily equal to font character width }
property CharWidth: Integer read FCharWidth;
{ Defines additional inter-character spacing }
property CharSpacing: Integer read FCharSpacing write SetCharSpacing default cCharSpacingDef;
{ Returns current character height = not equal to font character height }
property CharHeight: Integer read FCharHeight;
{ Returns the binary data clipboard format }
property ClipboardFormat: Word read FClipboardFormat;
{ Makes it possible to take all color properties from another TKCustomHexEditor class }
property Colors: TKHexEditorColors read FColors write SetColors;
{ Specifies a new key stroke combination for given command }
property CommandKey[Index: TKEditCommand]: TKEditKey read GetCommandKey write SetCommandKey;
{ This property provides direct access to the data buffer }
property Data: TDataSize read GetData write SetData;
{ Specifies the byte grouping in the digits area }
property DigitGrouping: Integer read FDigitGrouping write SetDigitGrouping default cDigitGroupingDef;
{ Specifies the style how the outline is drawn when editor is disabled }
property DisabledDrawStyle: TKHexEditorDisabledDrawStyle read FDisabledDrawStyle write SetDisabledDrawStyle default cDisabledDrawStyleDef;
{ Defines areas to paint, whether to paint horizontal and vertical trailing lines,
area separator lines and caret mark when the editor has no input focus }
property DrawStyles: TKHexEditorDrawStyles read FDrawStyles write SetDrawStyles stored IsDrawStylesStored;
{ Specifies the current area for editing }
property EditArea: TKHexEditorArea read FEditArea write SetEditArea default eaDigits;
{ Returns True if data buffer is empty }
property Empty: Boolean read GetEmpty;
{ Returns the first visible index }
property FirstVisibleIndex: Integer read GetFirstVisibleIndex;
{ Returns True if insert mode is on }
property InsertMode: Boolean read GetInsertMode;
{ Returns the last visible index }
property LastVisibleIndex: Integer read GetLastVisibleIndex;
{ Specifies the horizontal scroll position }
property LeftChar: Integer read FLeftChar write SetLeftChar;
{ Determines the number of lines }
property LineCount: Integer read GetLineCount;
{ Specifies the line height. 100% is the current font height }
property LineHeightPercent: Integer read FLineHeightPercent write SetLineHeightPercent default cLineHeightPercentDef;
{ Allows to modify/add data lines. If greater than LineSize, the Size member
of the supplied TDataSize structure will be always trimmed to LineSize.
If Index points to last incomplete line or even higher, last line will be
extended/completed, i.e new data will be added to the buffer }
property Lines[Index: Integer]: TDataSize read GetLines write SetLines;
{ Specifies the size (length) of a single line }
property LineSize: Integer read FLineSize write SetLineSize default cLineSizeDef;
{ Returns True if the buffer was modified - eoUndoAfterSave taken into
account }
property Modified: Boolean read GetModified write SetModified;
{ Specifies the editor options that do not affect painting }
property Options: TKEditOptions read FOptions write SetOptions stored IsOptionsStored;
{ Specifies whether the editor has to be read only editor }
property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
{ Defines visible scrollbars - horizontal, vertical or both }
property ScrollBars: TScrollStyle read FScrollBars write SetScrollBars default ssBoth;
{ Specifies how fast the scrolling by timer should be }
property ScrollSpeed: Cardinal read FScrollSpeed write SetScrollSpeed default cScrollSpeedDef;
{ Specifies the current selection end }
property SelEnd: TKHexEditorSelection read FSelEnd write SetSelEnd;
{ Specifies the current selection length. SelStart remains unchanged, SelEnd will be
updated accordingly. To mark a selection, either set both SelStart and SelEnd properties
or both SelStart and SelLength properties }
property SelLength: TKHexEditorSelection read GetSelLength write SetSelLength;
{ Specifies the current selection start }
property SelStart: TKHexEditorSelection read FSelStart write SetSelStart;
{ Returns selected text in many different formats }
property SelText: TKHexEditorSelText read GetSelText;
{ Specifies the vertical scroll position }
property TopLine: Integer read FTopLine write SetTopLine;
{ Specifies the maximum number of undo items. Please note this value
affects the undo item limit, not undo group limit. }
property UndoLimit: Integer read GetUndoLimit write SetUndoLimit default cUndoLimitDef;
{ When assigned, this event will be invoked at each buffer change, made either
by the user or programmatically by public functions }
property OnChange: TNotifyEvent read FOnChange write FOnChange;
{ When assigned, this event will be invoked when the user drops any files onto
the window }
property OnDropFiles: TKEditDropFilesEvent read FOnDropFiles write FOnDropFiles;
{ When assigned, this event will be invoked at each prompt-forced search match }
property OnReplaceText: TKEditReplaceTextEvent read FOnReplaceText write FOnReplaceText;
end;
{ @abstract(Hexadecimal editor design-time component) }
TKHexEditor = class(TKCustomHexEditor)
published
{ See TKCustomHexEditor.@link(TKCustomHexEditor.AddressCursor) for details }
property AddressCursor;
{ See TKCustomHexEditor.@link(TKCustomHexEditor.AddressMode) for details }
property AddressMode;
{ See TKCustomHexEditor.@link(TKCustomHexEditor.AddressOffset) for details }
property AddressOffset;
{ See TKCustomHexEditor.@link(TKCustomHexEditor.AddressPrefix) for details }
property AddressPrefix;
{ See TKCustomHexEditor.@link(TKCustomHexEditor.AddressSize) for details }
property AddressSize;
{ Inherited property - see Delphi help }
property Align;
{ Inherited property - see Delphi help }
property Anchors;
{ See TKCustomControl.@link(TKCustomControl.BorderStyle) for details }
property BorderStyle;
{ Inherited property - see Delphi help }
property BorderWidth;
{ See TKCustomHexEditor.@link(TKCustomHexEditor.CharSpacing) for details }
property CharSpacing;
{ See TKCustomHexEditor.@link(TKCustomHexEditor.Colors) for details }
property Colors;
{ Inherited property - see Delphi help }
property Constraints;
{$IFNDEF FPC}
{ Inherited property - see Delphi help. }
property Ctl3D;
{$ENDIF}
{ See TKCustomHexEditor.@link(TKCustomHexEditor.DigitGrouping) for details }
property DigitGrouping;
{ See TKCustomHexEditor.@link(TKCustomHexEditor.DisabledDrawStyle) for details }
property DisabledDrawStyle;
{ Inherited property - see Delphi help }
property DragCursor;
{ Inherited property - see Delphi help }
property DragKind;
{ Inherited property - see Delphi help }
property DragMode;
{ See TKCustomHexEditor.@link(TKCustomHexEditor.DrawStyles) for details }
property DrawStyles;
{ See TKCustomHexEditor.@link(TKCustomHexEditor.EditArea) for details }
property EditArea;
{ Inherited property - see Delphi help }
property Enabled;
{ Inherited property - see Delphi help. Font pitch must always remain fpFixed
- specify fixed fonts only. Font.Size will also be trimmed if too small or big }
property Font;
{ Inherited property - see Delphi help }
property Height default cHeight;
{ See TKCustomHexEditor.@link(TKCustomHexEditor.LineHeightPercent) for details }
property LineHeightPercent;
{ See TKCustomHexEditor.@link(TKCustomHexEditor.LineSize) for details }
property LineSize;
{ See TKCustomHexEditor.@link(TKCustomHexEditor.Options) for details }
property Options;
{ Inherited property - see Delphi help }
property ParentShowHint;
{ Inherited property - see Delphi help }
property PopupMenu;
{ See TKCustomHexEditor.@link(TKCustomHexEditor.ReadOnly) for details }
property ReadOnly;
{ See TKCustomHexEditor.@link(TKCustomHexEditor.ScrollBars) for details }
property ScrollBars;
{ See TKCustomHexEditor.@link(TKCustomHexEditor.ScrollSpeed) for details }
property ScrollSpeed;
{ Inherited property - see Delphi help }
property ShowHint;
{ Inherited property - see Delphi help }
property TabOrder;
{ Inherited property - see Delphi help }
property TabStop default True;
{ See TKCustomHexEditor.@link(TKCustomHexEditor.UndoLimit) for details }
property UndoLimit;
{ Inherited property - see Delphi help }
property Visible;
{ Inherited property - see Delphi help }
property Width default cWidth;
{ See TKCustomHexEditor.@link(TKCustomHexEditor.OnChange) for details }
property OnChange;
{ Inherited property - see Delphi help }
property OnClick;
{ Inherited property - see Delphi help }
property OnContextPopup;
{ Inherited property - see Delphi help }
property OnDblClick;
{ Inherited property - see Delphi help }
property OnDockDrop;
{ Inherited property - see Delphi help }
property OnDockOver;
{ Inherited property - see Delphi help }
property OnDragDrop;
{ Inherited property - see Delphi help }
property OnDragOver;
{ See TKCustomHexEditor.@link(TKCustomHexEditor.OnDropFiles) for details }
property OnDropFiles;
{ Inherited property - see Delphi help }
property OnEndDock;
{ Inherited property - see Delphi help }
property OnEndDrag;
{ Inherited property - see Delphi help }
property OnEnter;
{ Inherited property - see Delphi help }
property OnExit;
{ Inherited property - see Delphi help }
property OnGetSiteInfo;
{ Inherited property - see Delphi help }
property OnKeyDown;
{ Inherited property - see Delphi help }
property OnKeyPress;
{ Inherited property - see Delphi help }
property OnKeyUp;
{ Inherited property - see Delphi help }
property OnMouseDown;
{ Inherited property - see Delphi help }
property OnMouseMove;
{ Inherited property - see Delphi help }
property OnMouseUp;
{ Inherited property - see Delphi help }
property OnMouseWheel;
{ Inherited property - see Delphi help }
property OnMouseWheelDown;
{ Inherited property - see Delphi help }
property OnMouseWheelUp;
{ See TKCustomControl.@link(TKCustomControl.OnPrintNotify) for details }
property OnPrintNotify;
{ See TKCustomControl.@link(TKCustomControl.OnPrintPaint) for details }
property OnPrintPaint;
{ See TKCustomHexEditor.@link(TKCustomHexEditor.OnReplaceText) for details }
property OnReplaceText;
{ Inherited property - see Delphi help }
property OnResize;
{ Inherited property - see Delphi help }
property OnStartDock;
{ Inherited property - see Delphi help }
property OnStartDrag;
{ Inherited property - see Delphi help }
property OnUnDock;
end;
{ Creates a selection structure from given Index and Digit parameters }
function MakeSelection(Index, Digit: Integer): TKHexEditorSelection;
{ Converts a hexadecimal digit character ('0'..'F') to binary value }
function DigitToBin(Value: AnsiChar): Integer;
{ Examines/converts hexadecimal digit string to binary value string. Returns
True if the digit string is valid.
<UL>
<LH>Parameters:</LH>
<LI><I>S</I> - hexadecimal digit string (e.g. 'AF01 DC05 3'). White spaces will
be ignored. When Convert is True, the converted binary value string will be returned
via this parameter (in this exammple '#A#F#0#1#D#C#0#5#3').</LI>
<LI><I>Convert</I> - the digit string will be converted if True, otherwise it will
be examined only.</LI>
</UL> }
function DigitsToBinStr(var S: AnsiString; Convert: Boolean = True): Boolean;
{ Converts a binary value string into binary data. If the binary value string
is not divisible by 2, it will be right padded with zero. Example:
'#A#F#0#1#D#C#0#5#3' is converted into '#AF#01#DC#05#30'. }
function BinStrToBinary(const S: AnsiString): AnsiString;
{ Converts binary data into hexadecimal digit string.
<UL>
<LH>Parameters:</LH>
<LI><I>Buffer</I> - binary data - intended for @link(TKCustomHexEditor.Buffer)</LI>
<LI><I>SelStart, SelEnd</I> - specifies which part of the buffer is about to be
converted. SelStart.Index must be lower or equal to SelEnd.Index - intended for
@link(TKCustomHexEditor.GetRealSelStart) and @link(TKCustomHexEditor.GetRealSelEnd).</LI>
</UL> }
function BinaryToDigits(Buffer: PBytes; SelStart, SelEnd: TKHexEditorSelection): AnsiString;
{ Converts binary data into text using given character mapping.
<UL>
<LH>Parameters:</LH>
<LI><I>Buffer</I> - binary data - intended for @link(TKCustomHexEditor.Buffer)</LI>
<LI><I>SelStart, SelEnd</I> - specifies which part of the buffer is about to be
converted. SelStart must be lower or equal to SelEnd. These parameters are integers
since no digit selections are necessary.</LI>
<LI><I>CharMapping</I> - required character mapping scheme</LI>
</UL> }
function BinaryToText(Buffer: PBytes; SelStart, SelEnd: Integer;
CharMapping: PKEditCharMapping): AnsiString;
{ Replaces a hexadecimal digit in the given binary value. Returns the original
value with a replaced digit.
<UL>
<LH>Parameters:</LH>
<LI><I>Value</I> - original binary value</LI>
<LI><I>Digit</I> - digit value (0..15)</LI>
<LI><I>Pos</I> - digit position (order)</LI>
</UL>
Example: Value = $A18D, Digit = $C, Pos = 3: Result = $AC8D }
function ReplaceDigit(Value, Digit, Pos: Integer): Integer;
{ Returns the instance-independent color specification for
the given color index }
function GetColorSpec(Index: TKHexEditorColorIndex): TKHexEditorColorSpec;
implementation
uses
{$IFDEF USE_THEMES}
Themes,
{$ENDIF}
Math,
{$IFDEF USE_WINAPI}
ShellApi,
{$ENDIF}
ClipBrd, Printers,
Types, KGraphics;
const
cFmtText = '%.2x';
cBase = 16;
cDigitCount = 2;
function MakeSelection(Index, Digit: Integer): TKHexEditorSelection;
begin
Result.Index := Index;
Result.Digit := Digit;
end;
function DigitToBin(Value: AnsiChar): Integer;
begin
if ((Value >= 'a') and (Value <= 'f')) then Result := Ord(Value) - Ord('a') + 10
else if ((Value >= 'A') and (Value <= 'F')) then Result := Ord(Value) - Ord('A') + 10
else if ((Value >= '0') and (Value <= '9')) then Result := Ord(Value) - Ord('0')
else Result := -1;
end;
function DigitsToBinStr(var S: AnsiString; Convert: Boolean = True): Boolean;
var
I, J, K: Integer;
T: AnsiString;
begin
// check and convert text characters to hex values 0..15
Result := True;
if Convert then
SetLength(T, Length(S));
J := 0;
for I := 1 to Length(S) do if not CharInSetEx(S[I], [#9, #32]) then
begin
K := DigitToBin(S[I]);
if K >= 0 then
begin
if Convert then
begin
Inc(J);
T[J] := AnsiChar(K)
end;
end else
begin
Result := False;
Break;
end;
end;
if Result and Convert then
begin
SetLength(T, J);
S := T;
end;
end;
function BinStrToBinary(const S: AnsiString): AnsiString;
var
I, J, L: Integer;
B1, B2: Byte;
begin
L := Length(S);
Result := '';
if L > 0 then
begin
SetLength(Result, DivUp(L, 2));
if L = 1 then
Result := S
else
begin
J := 1;
for I := 1 to Length(Result) do
begin
B1 := Byte(S[J]); Inc(J);
if J <= L then
begin
B2 := Byte(S[J]); Inc(J);
end else
B2 := 0;
Result[I] := AnsiChar(B1 shl 4 + B2);
end;
end;
end;
end;
function BinaryToDigits(Buffer: PBytes; SelStart, SelEnd: TKHexEditorSelection): AnsiString;
var
I, J: Integer;
S: AnsiString;
begin
Result := '';
S := '%s' + cFmtText;
for I := SelStart.Index to SelEnd.Index do
begin
Result := AnsiString(Format(string(S), [Result, Buffer[I]]));
if I = SelStart.Index then
begin
for J := 0 to SelStart.Digit - 1 do
Delete(Result, 1, 1);
end;
if I = SelEnd.Index then
begin
for J := SelEnd.Digit to cDigitCount - 1 do
Delete(Result, Length(Result), 1);
end;
end;
end;
function BinaryToText(Buffer: PBytes; SelStart, SelEnd: Integer;
CharMapping: PKEditCharMapping): AnsiString;
var
I: Integer;
begin
if SelEnd > SelStart then
begin
SetLength(Result, SelEnd - SelStart);
System.Move(Buffer[SelStart], Result[1], SelEnd - SelStart);
if CharMapping <> nil then
for I := 1 to Length(Result) do
Result[I] := CharMapping^[Byte(Result[I])];
end else
Result := '';
end;
function ReplaceDigit(Value, Digit, Pos: Integer): Integer;
var
I, Mask, O: Integer;
begin
O := 1;
for I := Pos to cDigitCount - 2 do
O := O * cBase;
Mask := cBase - 1;
Result := (((Value div O) and not Mask) + (Digit and Mask)) * O + Value mod O;
end;
function OppositeReason(ItemReason: TKHexEditorChangeReason): TKHexEditorChangeReason;
begin
case ItemReason of
crDeleteChar: Result := crInsertChar;
crDeleteDigits: Result := crInsertDigits;
crDeleteString: Result := crInsertString;
crInsertChar: Result := crDeleteChar;
crInsertDigits: Result := crDeleteDigits;
crInsertString: Result := crDeleteString;
else
Result := ItemReason;
end;
end;
{ TKHexEditorColors }
constructor TKHexEditorColors.Create(AOwner: TKCustomHexEditor);
begin
FOwner := AOwner;
Initialize;
ClearBrightColors;
end;
procedure TKHexEditorColors.Assign(Source: TPersistent);
begin
if Source is TKHexEditorColors then
begin
Colors := TKHexEditorColors(Source).Colors;
FOwner.Invalidate;
end
else
inherited;
end;
procedure TKHexEditorColors.ClearBrightColors;
var
I: TKHexEditorColorIndex;
begin
for I := 0 to Length(FBrightColors) - 1 do
FBrightColors[I] := clNone;
end;
function TKHexEditorColors.GetColor(Index: TKHexEditorColorIndex): TColor;
const
AreaBkGndSet = [ciAddressBkgnd, ciDigitBkGnd, ciTextBkGnd];
BkGndSet = [ciAddressBkgnd, ciBkGnd, ciDigitBkGnd, ciInactiveCaretBkGnd,
ciInactiveCaretSelBkGnd, ciSelBkGnd, ciSelBkGndFocused, ciTextBkgnd];
begin
case FColorScheme of
ecsGrayed: if Index in BkGndSet then Result := clWindow else Result := clGrayText;
ecsBright:
begin
if FBrightColors[Index] = clNone then
FBrightColors[Index] := BrightColor(FColors[Index], 0.5, bsOfTop);
if FSingleBkGnd and (Index in AreaBkGndSet) then
Result := FBrightColors[ciBkGnd]
else
Result := FBrightColors[Index];
end;
ecsGrayScale: Result := ColorToGrayScale(FColors[Index]);
else
if FSingleBkGnd and (Index in AreaBkGndSet) then
Result := FColors[ciBkGnd]
else
Result := FColors[Index];
end;
end;
function TKHexEditorColors.GetColorData(Index: TKHexEditorColorIndex): TKHexEditorColorData;
var
ColorSpec: TKHexEditorColorSpec;
begin
Result.Index := Index;
Result.Color := FColors[Index];
ColorSpec := GetColorSpec(Index);
Result.Default := ColorSpec.Def;
Result.Name := ColorSpec.Name;
end;
function TKHexEditorColors.GetColorEx(Index: TKHexEditorColorIndex): TColor;
begin
Result := FColors[Index];
end;
function TKHexEditorColors.GetColorName(Index: TKHexEditorColorIndex): string;
begin
Result := GetColorSpec(Index).Name;
end;
procedure TKHexEditorColors.Initialize;
var
I: TKHexEditorColorIndex;
begin
SetLength(FColors, ciHexEditorColorsMax + 1);
SetLength(FBrightColors, ciHexEditorColorsMax + 1);
for I := 0 to Length(FColors) - 1 do
FColors[I] := GetColorSpec(I).Def;
end;
procedure TKHexEditorColors.SetColor(Index: TKHexEditorColorIndex; Value: TColor);
begin
if FColors[Index] <> Value then
begin
FColors[Index] := Value;
FBrightColors[Index] := clNone;
if not (csLoading in FOwner.ComponentState) and FOwner.HandleAllocated then
FOwner.Invalidate;
end;
end;
procedure TKHexEditorColors.SetColorEx(Index: TKHexEditorColorIndex; Value: TColor);
begin
if FColors[Index] <> Value then
begin
FColors[Index] := Value;
FBrightColors[Index] := clNone;
end;
end;
procedure TKHexEditorColors.SetColors(const Value: TKColorArray);
begin
FColors := Value;
ClearBrightColors;
end;
{ TKHexEditorChangeList }
constructor TKHexEditorChangeList.Create(AEditor: TKCustomHexEditor;
RedoList: TKHexEditorChangeList);
begin
inherited Create;
FEditor := AEditor;
FGroupUseLock := 0;
FLimit := cUndoLimitDef;
FIndex := -1;
FModifiedIndex := FIndex;
FRedoList := RedoList;
FOnChange := nil;
end;
procedure TKHexEditorChangeList.AddChange(ItemReason: TKHexEditorChangeReason;
const Data: AnsiString; Inserted: Boolean);
var
P: PKHexEditorChangeItem;
begin
// don't allow succesive crCaretPos
if (ItemReason = crCaretPos) and not Inserted and (FIndex >= 0) and
(PKHexEditorChangeItem(Items[FIndex]).ItemReason = crCaretPos) then
Exit;
if FIndex < FLimit - 1 then
begin
if FIndex < Count - 1 then
Inc(FIndex)
else
FIndex := Add(New(PKHexEditorChangeItem));
P := Items[FIndex];
if FGroupUseLock > 0 then
begin
P.Group := FGroup;
P.GroupReason := FGroupReason;
end else
begin
P.Group := 0;
P.GroupReason := ItemReason;
end;
P.ItemReason := ItemReason;
P.EditArea := FEditor.EditArea;
P.SelEnd := FEditor.SelEnd;
P.SelStart := FEditor.SelStart;
P.Data := Data;
P.Inserted := Inserted;
if FRedoList <> nil then
FRedoList.Clear;
if Assigned(FOnChange) then
FOnChange(Self, ItemReason);
end;
end;
procedure TKHexEditorChangeList.BeginGroup(GroupReason: TKHexEditorChangeReason);
begin
if FGroupUseLock = 0 then
begin
FGroupReason := GroupReason;
Inc(FGroup);
if FGroup = 0 then Inc(FGroup);
end;
Inc(FGroupUseLock);
end;
function TKHexEditorChangeList.CanPeek: Boolean;
begin
Result := FIndex >= 0;
end;
procedure TKHexEditorChangeList.Clear;
begin
inherited;
FGroupUseLock := 0;
FIndex := -1;
FModifiedIndex := FIndex;
end;
procedure TKHexEditorChangeList.EndGroup;
begin
if FGroupUseLock > 0 then
Dec(FGroupUseLock);
end;
function TKHexEditorChangeList.GetModified: Boolean;
function CaretPosOnly: Boolean;
var
I: Integer;
begin
Result := True;
for I := FModifiedIndex + 1 to FIndex do
begin
if PKHexEditorChangeItem(Items[I]).ItemReason <> crCaretPos then
begin
Result := False;
Exit;
end;
end;
end;
begin
Result := (FIndex > FModifiedIndex) and not CaretPosOnly;
end;
procedure TKHexEditorChangeList.Notify(Ptr: Pointer; Action: TListNotification);
var
P: PKHexEditorChangeItem;
begin
case Action of
lnDeleted:
if Ptr <> nil then
begin
P := Ptr;
Dispose(P);
end;
end;
end;
function TKHexEditorChangeList.PeekItem: PKHexEditorChangeItem;
begin
if CanPeek then
begin
Result := Items[FIndex];
Dec(FIndex);
end else
Result := nil;
end;
procedure TKHexEditorChangeList.PokeItem;
begin
if FIndex < Count - 1 then
Inc(FIndex);
end;
procedure TKHexEditorChangeList.SetGroupData(Group: Integer;
GroupReason: TKHexEditorChangeReason);
begin
FGroup := Group;
FGroupReason := GroupReason;
FGroupUseLock := 1;
end;
procedure TKHexEditorChangeList.SetLimit(Value: Integer);
begin
if Value <> FLimit then
begin
FLimit := MinMax(Value, cUndoLimitMin, cUndoLimitMax);
while Count > FLimit do
Delete(0);
FIndex := Min(FIndex, FLimit - 1);
end;
end;
procedure TKHexEditorChangeList.SetModified(Value: Boolean);
begin
if not Value then
FModifiedIndex := FIndex;
end;
{ TKCustomHexEditor }
constructor TKCustomHexEditor.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Color := clWindow;
ControlStyle := [csOpaque, csClickEvents, csDoubleClicks, csCaptureMouse];
Font.Name := cFontNameDef;
Font.Style := cFontStyleDef;
Font.Size := cFontSizeDef;
Font.Pitch := fpFixed;
Font.OnChange := FontChange;
Height := cHeight;
ParentColor := False;
ParentFont := False;
TabStop := True;
Width := cWidth;
FAddressCursor := cAddressCursorDef;
FAddressMode := cAddressModeDef;
FAddressOffset := cAddressOffsetDef;
FAddressPrefix := cAddressPrefixDef;
FAddressSize := cAddressSizeDef;
FAreaSpacing := cAreaSpacingDef;
FBuffer := nil;
{$IFNDEF FPC}
FClipBoardFormat := RegisterClipboardFormat('Any binary data');
{$ENDIF}
FColors := TKHexEditorColors.Create(Self);
FCharHeight := 8;
FCharMapping := DefaultCharMapping;
FCharSpacing := cCharSpacingDef;
FCharWidth := 6;
FDigitGrouping := cDigitGroupingDef;
FDisabledDrawStyle := cDisabledDrawStyleDef;
FDrawStyles := cDrawStylesDef;
FEditArea := eaDigits;
FLeftChar := 0;
FLineHeightPercent := cLineHeightPercentDef;
FLineSize := cLineSizeDef;
FMouseWheelAccumulator := 0;
FOptions := [eoGroupUndo];
FKeyMapping := CreateDefaultKeyMapping;
FRedoList := TKHexEditorChangeList.Create(Self, nil);
FScrollBars := ssBoth;
FScrollSpeed := cScrollSpeedDef;
FScrollTimer := TTimer.Create(Self);
FScrollTimer.Enabled := False;
FScrollTimer.Interval := FScrollSpeed;
FScrollTimer.OnTimer := ScrollTimerHandler;
FSelStart := MakeSelection(0, 0);
FSelEnd := MakeSelection(0, 0);
FStates := [];
FTopLine := 0;
FTotalCharSpacing := 0;
FUndoList := TKHexEditorChangeList.Create(Self, FRedoList);
FUndoList.OnChange := UndoChange;
FOnChange := nil;
FOnReplaceText := nil;
UpdateCharMetrics;
end;
destructor TKCustomHexEditor.Destroy;
begin
inherited;
FOnChange := nil;
FColors.Free;
FUndoList.Free;
FRedoList.Free;
FreeMem(FBuffer);
FBuffer := nil;
end;
procedure TKCustomHexEditor.AddUndoCaretPos(Force: Boolean);
begin
FUndoList.AddChange(crCaretPos, '', Force);
end;
procedure TKCustomHexEditor.AddUndoByte(ItemReason: TKHexEditorChangeReason; Data: Byte;
Inserted: Boolean = True);
begin
FUndoList.AddChange(ItemReason, AnsiChar(Data), Inserted);
end;
procedure TKCustomHexEditor.AddUndoBytes(ItemReason: TKHexEditorChangeReason;
Data: PBytes; Length: Integer; Inserted: Boolean = True);
var
S: AnsiString;
begin
if Length > 0 then
begin
SetLength(S, Length);
Move(Data^, S[1], Length);
FUndoList.AddChange(ItemReason, S, Inserted);
end;
end;
procedure TKCustomHexEditor.AddUndoString(ItemReason: TKHexEditorChangeReason;
const S: AnsiString; Inserted: Boolean = True);
begin
if S <> '' then
FUndoList.AddChange(ItemReason, S, Inserted);
end;
procedure TKCustomHexEditor.Append(At: Integer; Data: TDataSize);
var
S: AnsiString;
begin
if (Data.Size > 0) and (Data.Data <> nil) then
begin
SetString(S, PAnsiChar(Data.Data), Data.Size);
InsertString(At, S, Data.Size);
end;
end;
procedure TKCustomHexEditor.Append(At: Integer; const Data: AnsiString);
begin
InsertString(At, Data, Length(Data));
end;
procedure TKCustomHexEditor.Assign(Source: TPersistent);
begin
if Source is TKCustomHexEditor then with Source as TKCustomHexEditor do
begin
Self.AddressCursor := AddressCursor;
Self.AddressMode := AddressMode;
Self.AddressPrefix := AddressPrefix;
Self.AddressSize := AddressSize;
Self.Align := Align;
Self.Anchors := Anchors;
Self.AutoSize := AutoSize;
Self.BiDiMode := BiDiMode;
Self.BorderStyle := BorderStyle;
Self.BorderWidth := BorderWidth;
Self.CharSpacing := CharSpacing;
Self.Color := Color;
Self.Colors := Colors;
Self.Constraints.Assign(Constraints);
{$IFNDEF FPC}
Self.Ctl3D := Ctl3D;
{$ENDIF}
Self.Data := Data;
Self.DigitGrouping := DigitGrouping;
Self.DisabledDrawStyle := DisabledDrawStyle;
Self.DragCursor := DragCursor;
Self.DragKind := DragKind;
Self.DragMode := DragMode;
Self.DrawStyles := DrawStyles;
Self.EditArea := EditArea;
Self.Enabled := Enabled;
Self.Font := Font;
{$IFNDEF FPC}
Self.ImeMode := ImeMode;
Self.ImeName := ImeName;
{$ENDIF}
Self.LineHeightPercent := LineHeightPercent;
Self.LineSize := LineSize;
Self.Modified := False;
Self.Options := Options;
Self.ParentBiDiMode := ParentBiDiMode;
Self.ParentColor := ParentColor;
{$IFNDEF FPC}
Self.ParentCtl3D := ParentCtl3D;
{$ENDIF}
Self.ParentFont := ParentFont;
Self.ParentShowHint := ParentShowHint;
Self.PopupMenu := PopupMenu;
Self.ScrollBars := ScrollBars;
Self.SelEnd := SelEnd;
Self.SelStart := SelStart;
Self.SetCharMapping(GetCharMapping);
Self.SetKeyMapping(GetKeyMapping);
Self.ShowHint := ShowHint;
Self.TabOrder := TabOrder;
Self.TabStop := TabStop;
Self.Visible := Visible;
end
else
inherited;
end;
procedure TKCustomHexEditor.BeginUndoGroup(GroupReason: TKHexEditorChangeReason);
begin
FUndoList.BeginGroup(GroupReason);
end;
procedure TKCustomHexEditor.BufferChanged;
begin
FUndoList.Clear;
FRedoList.Clear;
UpdateScrollRange;
SelectionChanged(False);
DoChange;
end;
function TKCustomHexEditor.CanScroll(Command: TKEditCommand): Boolean;
var
XMax, YMax: Integer;
P: TPoint;
AD: TKHExEditorAreaDimensions;
begin
AD := GetAreaDimensions;
XMax := GetMaxLeftChar(AD.TotalHorz);
YMax := GetMaxTopLine(AD.TotalVert);
case Command of
ecScrollUp: Result := FTopLine > 0;
ecScrollDown: Result := FTopLine < YMax;
ecScrollLeft: Result := FLeftChar > 0;
ecScrollRight: Result := FLeftChar < XMax;
ecScrollCenter:
begin
P := SelToPoint(FSelEnd, FEditArea);
P.X := P.X - ClientWidth div 2;
P.Y := P.Y - ClientHeight div 2;
Result := (FLeftChar > 0) and (P.X < 0) or (FLeftChar < XMax) and (P.X > FCharWidth) or
(FTopLine > 0) and (P.Y < 0) or (FTopLine < YMax) and (P.Y > FCharHeight);
end;
else
Result := False;
end;
end;
function TKCustomHexEditor.CaretInView: Boolean;
begin
Result := PtInRect(GetModifiedClientRect, SelToPoint(FSelEnd, FEditArea));
end;
procedure TKCustomHexEditor.Clear;
begin
if FBuffer <> nil then
begin
FreeMem(FBuffer);
FBuffer := nil;
FSize := 0;
BufferChanged;
end;
end;
procedure TKCustomHexEditor.ClearChar(At: Integer);
begin
ClearString(At, 1);
end;
procedure TKCustomHexEditor.ClearDigitSelection;
begin
FSelStart.Digit := 0;
FSelEnd.Digit := 0;
end;
procedure TKCustomHexEditor.ClearString(At, Size: Integer);
begin
if (FBuffer <> nil) and (Size > 0) and (At >= 0) and (At + Size <= FSize) then
begin
Move(FBuffer[At + Size], FBuffer[At], (FSize - At - Size) * SizeOf(Byte));
Dec(FSize, Size);
ReallocMem(FBuffer, FSize);
UpdateScrollRange;
Invalidate;
end;
end;
procedure TKCustomHexEditor.ClearUndo;
begin
FUndoList.Clear;
FRedoList.Clear;
end;
procedure TKCustomHexEditor.CMEnabledChanged(var Msg: TLMessage);
begin
inherited;
UpdateEditorCaret;
Invalidate;
end;
procedure TKCustomHexEditor.CMSysColorChange(var Msg: TLMessage);
begin
inherited;
FColors.ClearBrightColors;
end;
function TKCustomHexEditor.CommandEnabled(Command: TKEditCommand): Boolean;
var
L: TKHexEditorSelection;
begin
if Enabled and Visible and not (csDesigning in ComponentState) then
begin
L := SelLength;
case Command of
// movement commands
ecLeft, ecSelLeft: Result := (FSelEnd.Index > 0) or (FEditArea = eaDigits) and (FSelEnd.Digit > 0);
ecRight, ecSelRight: Result := (FEditArea <> eaNone) and (FSelEnd.Index < FSize);
ecUp, ecSelUp: Result := FSelEnd.Index >= FLineSize;
ecDown, ecSelDown: Result := (FEditArea <> eaNone) and (FSelEnd.Index < FSize);
ecLineStart, ecSelLineStart: Result := (FEditArea <> eaNone) and (FSelEnd.Index mod FLineSize > 0);
ecLineEnd, ecSelLineEnd: Result := (FEditArea <> eaNone) and (FSelEnd.Index mod FLineSize < Min(FLineSize - 1, FSize));
ecPageUp, ecSelPageUp: Result := FSelEnd.Index >= FlineSize;
ecPageDown, ecSelPageDown: Result := (FEditArea <> eaNone) and (FSelEnd.Index < FSize div FLineSize * FLineSize);
ecPageLeft, ecSelPageLeft: Result := (FEditArea <> eaNone) and (GetPageHorz > 0) and (FSelEnd.Index mod FLineSize > 0);
ecPageRight, ecSelPageRight: Result := (FEditArea <> eaNone) and (GetPageHorz > 0) and (FSelEnd.Index mod FLineSize < Min(FLineSize - 1, FSize));
ecPageTop, ecSelPageTop: Result := (FEditArea <> eaNone) and (FSelEnd.Index > 0) and (SelToPoint(MakeSelection(FSelEnd.Index, 0), FEditArea).Y div FCharHeight <> 0);
ecPageBottom, ecSelPageBottom: Result := (FEditArea <> eaNone) and (FSelEnd.Index < FSize) and ((ClientHeight - SelToPoint(MakeSelection(FSelEnd.Index, 0), FEditArea).Y) div FCharHeight - 1 <> 0);
ecEditorTop, ecSelEditorTop: Result := FSelEnd.Index > 0;
ecEditorBottom, ecSelEditorBottom: Result := (FEditArea <> eaNone) and (FSelEnd.Index < FSize);
ecGotoXY, ecSelGotoXY: Result := True;
// scroll commands
ecScrollUp, ecScrollDown, ecScrollLeft, ecScrollRight, ecScrollCenter: Result := CanScroll(Command);
// editing commands
ecUndo: Result := not ReadOnly and FUndoList.CanPeek;
ecRedo: Result := not ReadOnly and FRedoList.CanPeek;
ecCopy, ecCut: Result := not Empty and (not ReadOnly or (Command = ecCopy)) and ((L.Index <> 0) or (L.Digit <> 0));
ecPaste: Result := not ReadOnly and (FEditArea <> eaNone) and (ClipBoard.FormatCount > 0);
ecInsertChar: Result := not ReadOnly and (FEditArea <> eaNone);
ecInsertDigits: Result := not ReadOnly and (FEditArea = eaDigits);
ecInsertString: Result := not ReadOnly and (FEditArea <> eaNone);
ecDeleteLastChar: Result := not (Empty or ReadOnly) and (FEditArea <> eaNone) and ((L.Index > 0) or (FSelEnd.Index > 0));
ecDeleteChar: Result := not (Empty or ReadOnly) and (FEditArea <> eaNone) and ((L.Index > 0) or (FSelEnd.Index < FSize));
ecDeleteBOL: Result := not (Empty or ReadOnly) and (FEditArea <> eaNone) and ((L.Index > 0) or (FSelEnd.Index mod FLineSize > 0));
ecDeleteEOL: Result := not (Empty or ReadOnly) and (FEditArea <> eaNone) and ((L.Index > 0) or (FSelEnd.Index mod FLineSize < Min(FLineSize, FSize)));
ecDeleteLine: Result := not (Empty or ReadOnly) and (FEditArea <> eaNone) and ((L.Index > 0) or (FSelEnd.Index mod FLineSize > 0) or (FSelEnd.Index < FSize));
ecSelectAll: Result := not (Empty or ReadOnly) and (FEditArea <> eaNone);
ecClearAll: Result := not (Empty or ReadOnly) and (FEditArea <> eaNone);
ecClearIndexSelection, ecClearSelection: Result := not (Empty or ReadOnly) and (FEditArea <> eaNone) and (L.Index > 0);
ecSearch: Result := not Empty;
ecReplace: Result := not (Empty or ReadOnly);
ecInsertMode: Result := elOverwrite in FStates;
ecOverwriteMode: Result := not (elOverwrite in FStates);
else
Result := True;
end;
end else
Result := False;
end;
procedure TKCustomHexEditor.CreateParams(var Params: TCreateParams);
begin
inherited;
with Params do
begin
if FScrollBars in [ssVertical, ssBoth] then Style := Style or WS_VSCROLL;
if FScrollBars in [ssHorizontal, ssBoth] then Style := Style or WS_HSCROLL;
end;
end;
procedure TKCustomHexEditor.CreateWnd;
begin
inherited;
{$IFDEF USE_WINAPI}
if (eoDropFiles in FOptions) and not (csDesigning in ComponentState) then
DragAcceptFiles(Handle, TRUE);
{$ENDIF}
end;
procedure TKCustomHexEditor.DestroyWnd;
begin
{$IFDEF USE_WINAPI}
if (eoDropFiles in FOptions) and not (csDesigning in ComponentState) then
DragAcceptFiles(Handle, FALSE);
{$ENDIF}
inherited;
end;
procedure TKCustomHexEditor.DoChange;
begin
if Assigned(FOnChange) then
FOnChange(Self);
end;
function TKCustomHexEditor.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
MousePos: TPoint): Boolean;
const
WHEEL_DIVISOR = 120;
var
LinesToScroll, WheelClicks: Integer;
begin
Result := inherited DoMouseWheel(Shift, WheelDelta, MousePos);
if not Result then
begin
if ssCtrl in Shift then
LinesToScroll := GetModifiedClientRect.Bottom div FCharHeight
else
LinesToScroll := 3;
Inc(FMouseWheelAccumulator, WheelDelta);
WheelClicks := FMouseWheelAccumulator div WHEEL_DIVISOR;
FMouseWheelAccumulator := FMouseWheelAccumulator mod WHEEL_DIVISOR;
ScrollBy(0, - WheelClicks * LinesToScroll, True);
Result := True;
end;
end;
procedure TKCustomHexEditor.EditAreaChanged;
begin
if FEditArea = eaNone then
FEditArea := eaDigits;
if not (edAddress in FDrawStyles) and (FEditArea = eaAddress) then
FEditArea := eaDigits;
if not (edDigits in FDrawStyles) and (FEditArea = eaDigits) then
FEditArea := eaText;
if not (edText in FDrawStyles) and (FEditArea = eaText) then
if edDigits in FDrawStyles then
FEditArea := eaDigits
else
FEditArea := eaNone;
end;
procedure TKCustomHexEditor.EndUndoGroup;
begin
FUndoList.EndGroup;
end;
function TKCustomHexEditor.ExecuteCommand(Command: TKEditCommand;
Data: Pointer): Boolean;
var
I, J, K, M, N, O: Integer;
CanInsert, MoreBytes, Found, MatchCase: Boolean;
C1, C2, C3: AnsiChar;
S, S_FirstChar, S_LastChar, T: AnsiString;
P: TPoint;
Area: TKHexEditorArea;
L, OldSelStart, OldSelEnd, Sel1, Sel2: TKHexEditorSelection;
PChI, PChI_First, PChI_Next: PKHexEditorChangeItem;
PSD: PKEditSearchData;
ReplaceAction: TKEditReplaceAction;
{$IFNDEF FPC}
BA: PBytes;
H: THandle;
{$ENDIF}
begin
Result := False;
if CommandEnabled(Command) then
begin
Result := True;
L := SelLength;
OldSelEnd := FSelEnd;
OldSelStart := FSelStart;
case Command of
ecLeft..ecSelGotoXY: AddUndoCaretPos(False);
end;
case Command of
ecLeft, ecSelLeft:
begin
InternalMoveLeft;
SelectionChanged(Command <> ecSelLeft);
end;
ecRight, ecSelRight:
begin
InternalMoveRight;
SelectionChanged(Command <> ecSelRight);
end;
ecUp, ecSelUp:
begin
Dec(FSelEnd.Index, FLineSize);
SelectionChanged(Command <> ecSelUp);
end;
ecDown, ecSelDown:
begin
Inc(FSelEnd.Index, FLineSize);
SelectionChanged(Command <> ecSelDown);
end;
ecLineStart, ecSelLineStart:
begin
FSelEnd := MakeSelection((FSelEnd.Index div FLineSize) * FLineSize, 0);
SelectionChanged(Command <> ecSelLineStart);
end;
ecLineEnd, ecSelLineEnd:
begin
FSelEnd := MakeSelection((FSelEnd.Index div FLineSize) * FLineSize + FLineSize - 1, cDigitCount - 1);
SelectionChanged(Command <> ecSelLineEnd);
end;
ecPageUp, ecSelPageUp:
begin
Dec(FSelEnd.Index, Min(ClientHeight div FCharHeight, FSelEnd.Index div FLineSize) * FLineSize);
SelectionChanged(Command <> ecSelPageUp);
end;
ecPageDown, ecSelPageDown:
begin
Inc(FSelEnd.Index, Min(ClientHeight div FCharHeight, (FSize - FSelEnd.Index) div FLineSize) * FLineSize);
SelectionChanged(Command <> ecSelPageDown);
end;
ecPageLeft, ecSelPageLeft:
begin
Dec(FSelEnd.Index, Min(GetPageHorz, FSelEnd.Index mod FLineSize));
SelectionChanged(Command <> ecSelPageLeft);
end;
ecPageRight, ecSelPageRight:
begin
Inc(FSelEnd.Index, Min(GetPageHorz, FLineSize - 1 - FSelEnd.Index mod FLineSize));
SelectionChanged(Command <> ecSelPageRight);
end;
ecPageTop, ecSelPageTop:
begin
P := SelToPoint(MakeSelection(FSelEnd.Index, 0), FEditArea);
Dec(FSelEnd.Index, P.Y div FCharHeight * FLineSize);
SelectionChanged(Command <> ecSelPageTop);
end;
ecPageBottom, ecSelPageBottom:
begin
P := SelToPoint(MakeSelection(FSelEnd.Index, 0), FEditArea);
Inc(FSelEnd.Index, ((ClientHeight - P.Y) div FCharHeight - 1) * FLineSize);
SelectionChanged(Command <> ecSelPageBottom);
end;
ecEditorTop, ecSelEditorTop:
begin
FSelEnd := MakeSelection(0, 0);
SelectionChanged(Command <> ecSelEditorTop);
end;
ecEditorBottom, ecSelEditorBottom:
begin
FSelEnd := MakeSelection(FSize, 0);
SelectionChanged(Command <> ecSelEditorBottom);
end;
ecGotoXY, ecSelGotoXY:
begin
Sel1 := PointToSel(PPoint(Data)^, False, Area);
if Area <> eaNone then
begin
FSelEnd := Sel1;
FEditArea := Area;
SelectionChanged(Command <> ecSelGotoXY);
end else
Result := False;
end;
// scroll commands
ecScrollUp:
begin
if (FEditArea <> eaNone) and (SelToPoint(FSelEnd, FEditArea).Y >= GetModifiedClientRect.Bottom - FCharHeight) then
begin
ScrollBy(0, -1, False);
Dec(FSelEnd.Index, FLineSize);
SelectionChanged(True, False);
Invalidate;
end else
ScrollBy(0, -1, True);
end;
ecScrollDown:
begin
if (FEditArea <> eaNone) and (SelToPoint(FSelEnd, FEditArea).Y <= GetModifiedClientRect.Top) then
begin
ScrollBy(0, 1, False);
Inc(FSelEnd.Index, FLineSize);
SelectionChanged(True, False);
Invalidate;
end else
ScrollBy(0, 1, True);
end;
ecScrollLeft:
begin
if FEditArea <> eaNone then
begin
// overscroll check
P := SelToPoint(MakeSelection(0, 0), FEditArea);
if P.X < GetModifiedClientRect.Right - FCharWidth then
begin
ScrollBy(-1, 0, True);
P := SelToPoint(FSelEnd, FEditArea);
if (P.X >= GetModifiedClientRect.Right) and ((FSelEnd.Index mod FLineSize > 0) or (FSelEnd.Digit > 0)) then
ExecuteCommand(ecLeft)
end;
end else
ScrollBy(-1, 0, True);
end;
ecScrollRight:
begin
if FEditArea <> eaNone then
begin
// overscroll check
P := SelToPoint(MakeSelection(FLineSize - 1, cDigitCount - 1), FEditArea);
if P.X > 0 then
begin
ScrollBy(1, 0, True);
P := SelToPoint(FSelEnd, FEditArea);
if (P.X < 0) and ((FSelEnd.Index mod FLineSize < FLineSize - 1) or (FSelEnd.Digit < cDigitCount - 1)) then
ExecuteCommand(ecRight)
end;
end else
ScrollBy(1, 0, True);
end;
ecScrollCenter:
begin
P := SelToPoint(FSelEnd, FEditArea);
I := (P.X - ClientWidth div 2) div FCharWidth;
J := (P.Y - ClientHeight div 2) div FCharHeight;
ScrollBy(I, J, True);
end;
// editing commands
ecUndo:
begin
PChI := FUndoList.PeekItem;
PChI_First := PChI;
while PChI <> nil do
begin
I := Length(PChI.Data);
J := Min(I, FSize - PChI.SelEnd.Index);
FRedoList.SetGroupData(PChI.Group, PChI.GroupReason);
case PChI.ItemReason of
crCaretPos:
FRedoList.AddChange(crCaretPos, '');
crDeleteChar, crDeleteDigits, crDeleteString:
begin
if FBuffer <> nil then
begin
SetLength(S, J);
System.Move(FBuffer[PChI.SelEnd.Index], S[1], J);
end else
S := '';
FRedoList.AddChange(OppositeReason(PChI.ItemReason), S, PChI.Inserted);
end;
crInsertChar, crInsertDigits, crInsertString:
FRedoList.AddChange(OppositeReason(PChI.ItemReason), PChI.Data);
end;
FSelEnd := PChI.SelEnd;
FSelStart := PChI.SelStart;
FEditArea := PChI.EditArea;
case PChI.ItemReason of
crDeleteChar, crDeleteDigits, crDeleteString:
begin
if PChI.Inserted then
ClearString(PChI.SelEnd.Index, I)
else if FBuffer <> nil then
begin
System.Move(PChI.Data[1], FBuffer[PChI.SelEnd.Index], J);
Invalidate;
end;
end;
crInsertChar, crInsertDigits, crInsertString:
InsertString(GetRealSelStart.Index, PChI.Data, I);
end;
EditAreaChanged;
SelectionChanged(False, False);
if PChI.ItemReason <> crCaretPos then
DoChange;
PChI_Next := FUndoList.PeekItem;
if (PChI_Next <> nil) and not ((PChI.Group <> 0) and (PChI.Group = PChI_Next.Group) or
(eoGroupUndo in FOptions) and (PChI_First.GroupReason = PChI_Next.GroupReason)) then
begin
FUndoList.PokeItem;
Break;
end;
PChI := PChI_Next;
end;
if not CaretInView then
ExecuteCommand(ecScrollCenter);
end;
ecRedo:
begin
PChI := FRedoList.PeekItem;
PChI_First := PChI;
while PChI <> nil do
begin
FUndoList.PokeItem;
I := Length(PChI.Data);
Sel1 := GetRealSelStart;
case PChI.ItemReason of
crInsertChar, crInsertDigits, crInsertString:
begin
if PChI.Inserted then
InsertString(Sel1.Index, PChI.Data, I)
else if FBuffer <> nil then
begin
System.Move(PChI.Data[1], FBuffer[Sel1.Index], Min(I, FSize - FSelEnd.Index));
Invalidate;
end;
end;
crDeleteChar, crDeleteDigits, crDeleteString:
ClearString(Sel1.Index, I);
end;
FSelEnd := PChI.SelEnd;
FSelStart := PChI.SelStart;
FEditArea := PChI.EditArea;
EditAreaChanged;
SelectionChanged(False, False);
if PChI.ItemReason <> crCaretPos then
DoChange;
PChI_Next := FRedoList.PeekItem;
if (PChI_Next <> nil) and not ((PChI.Group <> 0) and (PChI.Group = PChI_Next.Group) or
(eoGroupUndo in FOptions) and (PChI_First.GroupReason = PChI_Next.GroupReason)) then
begin
FRedoList.PokeItem;
Break;
end;
PChI := PChI_Next;
end;
if not CaretInView then
ExecuteCommand(ecScrollCenter);
end;
ecCopy:
begin
Sel1 := GetRealSelStart;
Sel2 := GetRealSelEnd;
{$IFDEF FPC}
ClipBoard.AsText := string(BinaryToDigits(FBuffer, Sel1, Sel2))
{$ELSE}
if FEditArea = eaDigits then
ClipBoard.AsText := string(BinaryToDigits(FBuffer, Sel1, Sel2))
else if L.Index <> 0 then
begin
S := BinaryToText(FBuffer, Sel1.Index, Sel2.Index, @FCharMapping);
H := GlobalAlloc(GMEM_MOVEABLE + GMEM_DDESHARE, L.Index);
try
BA := GlobalLock(H);
try
System.Move(FBuffer[Sel1.Index], BA^, L.Index);
finally
GlobalUnlock(H);
end;
ClipBoard.Open;
try
ClipBoard.SetAsHandle(FClipboardFormat, H);
ClipBoard.AsText := string(S);
finally
ClipBoard.Close;
end;
except
GlobalFree(H);
end;
end;
{$ENDIF}
end;
ecCut:
begin
ExecuteCommand(ecCopy);
ExecuteCommand(ecClearSelection);
end;
ecPaste:
begin
if L.Index > 0 then
ExecuteCommand(ecClearSelection);
if ClipBoard.FormatCount > 0 then
begin
S := '';
{$IFNDEF FPC}
H := 0;
// paste as binary data
if ClipBoard.HasFormat(FClipboardFormat) then
H := ClipBoard.GetAsHandle(FClipboardFormat) else
{$ENDIF}
if ClipBoard.HasFormat(CF_TEXT) then
begin
S := AnsiString(ClipBoard.AsText);
if S <> '' then
begin
M := Length(S);
if (FEditArea = eaDigits) and ExecuteCommand(ecInsertDigits, Pointer(S)) then
begin
S := '';
if M >= cDigitCount then
begin
Inc(FSelEnd.Index, M div cDigitCount)
end else
begin
Inc(FSelEnd.Digit, M);
if FSelEnd.Digit >= cDigitCount then
begin
Inc(FSelEnd.Index);
FSelEnd.Digit := FSelEnd.Digit mod cDigitCount;
end;
end;
SelectionChanged(True);
end else
ExecuteCommand(ecInsertString, Pointer(S));
end;
end
{$IFNDEF FPC}
else
H := ClipBoard.GetAsHandle(ClipBoard.Formats[0]);
if H <> 0 then
begin
BA := GlobalLock(H);
try
I := GlobalSize(H);
if I > 0 then
begin
SetLength(S, I);
System.Move(BA^, S[1], I);
end;
finally
GlobalUnlock(H);
end;
if S <> '' then
ExecuteCommand(ecInsertString, Pointer(S));
end
{$ENDIF}
;
if S <> '' then
begin
Inc(FSelEnd.Index, Length(S));
FSelEnd.Digit := 0;
SelectionChanged(True);
end;
end;
end;
ecInsertChar:
begin
BeginUndoGroup(crInsertChar);
try
N := PByte(Data)^;
if L.Index > 0 then
ExecuteCommand(ecClearSelection);
ValidateSelection(FSelEnd, FEditArea);
if FBuffer <> nil then
I := FBuffer[FSelEnd.Index]
else
I := 0;
CanInsert := (FBuffer = nil) or (FSelEnd.Digit = 0) and
(not (elOverwrite in FStates) or (FSelEnd.Index = FSize));
AddUndoByte(crDeleteChar, I, CanInsert);
if CanInsert then
InsertChar(FSelEnd.Index, 0)
else
Invalidate;
case FEditArea of
eaDigits:
begin
FBuffer[FSelEnd.Index] := ReplaceDigit(FBuffer[FSelEnd.Index], N, FSelEnd.Digit);
InternalMoveRight;
end;
eaText:
begin
FBuffer[FSelEnd.Index] := N;
InternalMoveRight;
end;
end;
SelectionChanged(True);
finally
EndUndoGroup;
end;
end;
ecInsertDigits:
begin
S := AnsiString(Data);
if (S <> '') and DigitsToBinStr(S) then
begin
BeginUndoGroup(crInsertDigits);
try
if L.Index > 0 then
ExecuteCommand(ecClearSelection);
ValidateSelection(FSelEnd, FEditArea);
MoreBytes := Length(S) >= cDigitCount;
if MoreBytes then
// we don't move digit positions of the remaining block
SetLength(S, Length(S) div cDigitCount * cDigitCount);
J := 0;
if (FBuffer <> nil) and (not MoreBytes or (FSelEnd.Digit > 0)) then
begin
I := FBuffer[FSelEnd.Index];
S_FirstChar := AnsiChar(I);
S_LastChar := S_FirstChar;
// split current byte
AddUndoByte(crInsertChar, I);
ClearChar(FSelEnd.Index);
N := Length(S);
for I := FSelEnd.Digit to cDigitCount - 1 do
begin
if J < N then
begin
Inc(J);
S_FirstChar := AnsiChar(ReplaceDigit(Ord(S_FirstChar[1]), Ord(S[J]), I));
end else
Break;
end;
K := Length(S);
if K > J then
for I := FSelEnd.Digit - 1 downto 0 do
begin
if K > J then
begin
S_LastChar := AnsiChar(ReplaceDigit(Ord(S_LastChar[1]), Ord(S[K]), I));
Dec(K);
end else
Break;
end
else
S_LastChar := '';
O := cDigitCount;
end else
begin
S_FirstChar := '';
S_LastChar := '';
O := 0;
end;
T := '';
if MoreBytes then
begin
N := Length(S) - O;
O := J;
for I := 0 to N div cDigitCount - 1 do
begin
K := 0;
for J := 1 to cDigitCount do
begin
K := K * cBase;
M := I * 2 + J + O;
Inc(K, Ord(S[M]));
end;
T := AnsiString(Format('%s%s', [T, Char(K)]));
end;
end;
S := S_FirstChar + T + S_LastChar;
// always insert (don't overwrite)
AddUndoString(crDeleteDigits, S);
InsertString(FSelEnd.Index, S, Length(S));
SelectionChanged(True);
finally
EndUndoGroup;
end;
end else
Result := False;
end;
ecInsertString:
begin
S := AnsiString(Data);
if S <> '' then
begin
BeginUndoGroup(crInsertString);
try
if L.Index > 0 then
ExecuteCommand(ecClearIndexSelection);
// always insert (don't overwrite)
AddUndoString(crDeleteString, S);
InsertString(FSelEnd.Index, S, Length(S));
SelectionChanged(True);
finally
EndUndoGroup;
end;
end else
Result := False;
end;
ecDeleteLastChar:
begin
if L.Index <> 0 then ExecuteCommand(ecClearSelection) else
begin
BeginUndoGroup(crDeleteString);
try
AddUndoCaretPos;
FSelStart.Index := FSelEnd.Index - 1;
ExecuteCommand(ecClearIndexSelection)
finally
EndUndoGroup;
end;
end;
end;
ecDeleteChar:
begin
if L.Index <> 0 then ExecuteCommand(ecClearSelection) else
begin
BeginUndoGroup(crDeleteString);
try
AddUndoCaretPos;
FSelStart.Index := FSelEnd.Index + 1;
ExecuteCommand(ecClearIndexSelection)
finally
EndUndoGroup;
end;
end;
end;
ecDeleteBOL:
begin
if L.Index <> 0 then ExecuteCommand(ecClearSelection) else
begin
BeginUndoGroup(crDeleteString);
try
AddUndoCaretPos;
FSelStart.Index := (FSelEnd.Index div FLineSize) * FLineSize;
ExecuteCommand(ecClearIndexSelection)
finally
EndUndoGroup;
end;
end;
end;
ecDeleteEOL:
begin
if L.Index <> 0 then ExecuteCommand(ecClearSelection) else
begin
BeginUndoGroup(crDeleteString);
try
AddUndoCaretPos;
FSelStart.Index := Min((FSelEnd.Index div FLineSize + 1) * FLineSize, FSize);
ExecuteCommand(ecClearIndexSelection)
finally
EndUndoGroup;
end;
end;
end;
ecDeleteLine:
begin
if L.Index <> 0 then ExecuteCommand(ecClearSelection) else
begin
BeginUndoGroup(crDeleteString);
try
AddUndoCaretPos;
FSelStart.Index := (FSelEnd.Index div FLineSize) * FLineSize;
FSelEnd.Index := Min(FSelStart.Index + FLineSize, FSize);
ExecuteCommand(ecClearIndexSelection)
finally
EndUndoGroup;
end;
end;
end;
ecSelectAll:
begin
AddUndoCaretPos;
FSelStart := MakeSelection(0, 0);
FSelEnd := MakeSelection(FSize, 0);
SelectionChanged(False);
end;
ecClearAll:
begin
ExecuteCommand(ecSelectAll);
ExecuteCommand(ecClearIndexSelection);
end;
ecClearIndexSelection:
begin
I := GetRealSelStart.Index;
AddUndoBytes(crInsertString, PBytes(@FBuffer[I]), L.Index, True);
ClearString(I, L.Index);
FSelEnd := MakeSelection(I, 0);
SelectionChanged(True);
end;
ecClearSelection:
begin
Sel1 := GetRealSelStart;
Sel2 := GetRealSelEnd;
if (Sel1.Digit > 0) {and (Sel1.Digit + Sel2.Digit = cDigitCount) }then
begin
BeginUndoGroup(crDeleteDigits);
try
// digit clear mode
AddUndoCaretPos;
FSelEnd := MakeSelection(Sel1.Index + 1, 0);
FSelStart := FSelEnd;
if Sel2.Digit = 0 then
begin
Dec(L.Index);
N := FBuffer[Sel2.Index - 1];
end else
N := FBuffer[Sel2.Index];
AddUndoBytes(crInsertDigits, PBytes(@FBuffer[FSelEnd.Index]), L.Index, True);
ClearString(FSelEnd.Index, L.Index);
FSelEnd := Sel1;
AddUndoByte(crDeleteChar, FBuffer[Sel1.Index], False);
for I := Sel1.Digit to cDigitCount - 1 do
begin
FBuffer[Sel1.Index] := ReplaceDigit(FBuffer[Sel1.Index], N mod cBase, I);
N := N div cBase;
end;
SelectionChanged(True);
finally
EndUndoGroup;
end;
end else
ExecuteCommand(ecClearIndexSelection);
end;
ecSearch, ecReplace:
begin
// doesn't search for single digits
PSD := Data;
if PSD <> nil then
begin
PSD.ErrorReason := eseOk;
S := AnsiString(PSD.TextToFind);
if Command = ecReplace then
begin
T := AnsiString(PSD.TextToReplace);
ReplaceAction := eraYes;
end;
if esoSelectedOnly in PSD.Options then
if esoFirstSearch in PSD.Options then
begin
PSD.SelStart := GetRealSelStart.Index;
PSD.SelEnd := GetRealSelEnd.Index;
end else
begin
PSD.SelStart := MinMax(PSD.SelStart, 0, FSize);
PSD.SelEnd := MinMax(PSD.SelEnd, 0, FSize);
end;
if esoFirstSearch in PSD.Options then
Exclude(PSD.Options, esoWereDigits);
if esoTreatAsDigits in PSD.Options then
begin
if DigitsToBinStr(S) then
begin
S := BinStrToBinary(S);
if Command = ecReplace then
begin
if DigitsToBinStr(T) then
begin
T := BinStrToBinary(T);
PSD.TextToFind := string(S);
PSD.TextToReplace := string(T);
Exclude(PSD.Options, esoTreatAsDigits);
Include(PSD.Options, esoWereDigits);
end else
PSD.ErrorReason := eseNoDigitsReplace;
end else
begin
PSD.TextToFind := string(S);
Exclude(PSD.Options, esoTreatAsDigits);
Include(PSD.Options, esoWereDigits);
end;
end else
PSD.ErrorReason := eseNoDigitsFind;
end;
if PSD.ErrorReason = eseOk then
begin
N := Length(S);
if esoBackwards in PSD.Options then
begin
O := -1;
if (esoEntireScope in PSD.Options) and (esoFirstSearch in PSD.Options) then
I := FSize
else
I := GetRealSelStart.Index - 1;
if esoSelectedOnly in PSD.Options then
begin
M := PSD.SelStart;
if esoFirstSearch in PSD.Options then
I := PSD.SelEnd
end else
M := 0;
I := Min(I, FSize - N);
if I < M then
PSD.ErrorReason := eseNoMatch
end else
begin
O := 1;
if (esoEntireScope in PSD.Options) and (esoFirstSearch in PSD.Options) then
I := 0
else
I := GetRealSelEnd.Index;
if esoSelectedOnly in PSD.Options then
begin
M := PSD.SelEnd;
if esoFirstSearch in PSD.Options then
I := PSD.SelStart
end else
M := FSize;
M := Min(M, FSize - N);
if I >= M then
PSD.ErrorReason := eseNoMatch
end;
if PSD.ErrorReason = eseOk then
begin
Found := False;
MatchCase := PSD.Options * [esoMatchCase, esoWereDigits] <> [];
if MatchCase then
C1 := S[1]
else
C1 := UpCase(S[1]);
I := MinMax(I, 0, FSize - 1);
while I <> M do
begin
if MatchCase then
C2 := AnsiChar(FBuffer[I])
else
C2 := UpCase(AnsiChar(FBuffer[I]));
if C1 = C2 then
begin
if FSize - I >= N then
begin
J := 2;
Dec(I);
while (J <= N) do
begin
if MatchCase then
begin
C2 := AnsiChar(FBuffer[I + J]);
C3 := S[J];
end else
begin
C2 := Upcase(AnsiChar(FBuffer[I + J]));
C3 := Upcase(S[J]);
end;
if C2 = C3 then
Inc(J)
else
Break;
end;
Inc(I);
if J = N + 1 then
begin
Found := True;
FSelStart := MakeSelection(I, 0);
FSelEnd := MakeSelection(I + N, 0);
if Command = ecReplace then
begin
if (esoPrompt in PSD.Options) and Assigned(FOnReplaceText) then
begin
SelectionChanged(False, False);
if not CaretInView then
ExecuteCommand(ecScrollCenter);
FOnReplaceText(Self, string(S), string(T), ReplaceAction)
end else
ReplaceAction := eraYes;
case ReplaceAction of
eraCancel: Break;
eraYes, eraAll:
begin
if T = '' then
ExecuteCommand(ecClearIndexSelection)
else
ExecuteCommand(ecInsertString, Pointer(T));
FSelEnd := MakeSelection(I + Length(T), 0);
AddUndoCaretPos;
if ReplaceAction = eraAll then
Include(PSD.Options, esoAll);
end;
end;
if not (esoAll in PSD.Options) then
Break;
end else
Break;
end
end;
end;
Inc(I, O);
end;
if Found then
begin
SelectionChanged(False, False);
if not CaretInView then
ExecuteCommand(ecScrollCenter);
end else
PSD.ErrorReason := eseNoMatch;
end;
end;
Exclude(PSD.Options, esoFirstSearch);
end else
Result := False;
end;
ecInsertMode:
begin
Exclude(FStates, elOverwrite);
UpdateEditorCaret(True);
end;
ecOverwriteMode:
begin
Include(FStates, elOverwrite);
UpdateEditorCaret(True);
end;
ecToggleMode:
begin
if elOverwrite in FStates then
Exclude(FStates, elOverwrite)
else
Include(FStates, elOverwrite);
UpdateEditorCaret(True);
end;
// focus change
ecGotFocus,
ecLostFocus:
begin
UpdateEditorCaret;
Invalidate;
end;
end;
if (OldSelStart.Index <> OldSelEnd.Index) or (FSelStart.Index <> FSelEnd.Index) or
(OldSelStart.Digit <> OldSelEnd.Digit) or (FSelStart.Digit <> FSelEnd.Digit) or
not (elCaretVisible in FStates) and (edInactiveCaret in FDrawStyles) and
((FSelStart.Index <> OldSelStart.Index) or (FSelStart.Digit <> OldSelStart.Digit) or
(FSelEnd.Index <> OldSelEnd.Index) or (FSelEnd.Digit <> OldSelEnd.Digit)) then
Invalidate;
end;
end;
procedure TKCustomHexEditor.FontChange(Sender: TObject);
begin
if not (csDestroying in ComponentState) then
begin
Font.Pitch := fpFixed;
if Font.Size >= 0 then
Font.Size := MinMax(Font.Size, cFontSizeMin, cFontSizeMax);
UpdateCharMetrics;
UpdateScrollRange;
end;
end;
function TKCustomHexEditor.GetAreaDimensions: TKHexEditorAreaDimensions;
begin
FillChar(Result, SizeOf(Result), 0);
with Result do
begin
if edAddress in FDrawStyles then
begin
Address := Length(FAddressPrefix) + FAddressSize;
if FDrawStyles * [edDigits, edText] <> [] then
AddressOut := FAreaSpacing;
end;
if edDigits in FDrawStyles then
begin
Digits := FLineSize * cDigitCount + FLineSize div FDigitGrouping;
if FLineSize mod FDigitGrouping = 0 then
Dec(Digits);
if edAddress in FDrawStyles then
DigitsIn := FAreaSpacing;
if edText in FDrawStyles then
DigitsOut := FAreaSpacing;
end;
if edText in FDrawStyles then
begin
Text := FLineSize;
if FDrawStyles * [edAddress, edDigits] <> [] then
TextIn := FAreaSpacing;
end;
TotalHorz := Address + AddressOut + Digits + DigitsIn + DigitsOut + Text + TextIn;
if [edAddress, edDigits, edText] * FDrawStyles <> [] then
TotalVert := LineCount
else
TotalVert := 0;
end;
end;
function TKCustomHexEditor.GetCaretVisible: Boolean;
begin
Result := elCaretVisible in FStates;
end;
function TKCustomHexEditor.GetCharMapping: TKEditCharMapping;
begin
Result := FCharMapping;
end;
function TKCustomHexEditor.GetClientHeightChars: Integer;
begin
Result := ClientHeight div FCharHeight;
end;
function TKCustomHexEditor.GetClientWidthChars: Integer;
begin
Result := ClientWidth div FCharWidth;
end;
function TKCustomHexEditor.GetCommandKey(Index: TKEditCommand): TKEditKey;
var
I: Integer;
begin
Result.Key := 0;
Result.Shift := [];
for I := 0 to Length(FKeyMapping) - 1 do
if FKeyMapping[I].Command = Index then
begin
Result := FKeyMapping[I].Key;
Exit;
end;
end;
function TKCustomHexEditor.GetData: TDataSize;
begin
Result.Data := FBuffer;
Result.Size := FSize;
end;
function TKCustomHexEditor.GetEmpty: Boolean;
begin
Result := FBuffer = nil;
end;
function TKCustomHexEditor.GetFirstVisibleIndex: Integer;
begin
Result := PointToSel(Point(0, 0), False, FEditArea).Index;
end;
function TKCustomHexEditor.GetInsertMode: Boolean;
begin
Result := not (elOverwrite in FStates);
end;
function TKCustomHexEditor.GetKeyMapping: TKEditKeyMapping;
begin
Result := FKeyMapping;
end;
function TKCustomHexEditor.GetLastVisibleIndex: Integer;
begin
Result := PointToSel(GetModifiedClientRect.BottomRight, False, FEditArea).Index;
end;
function TKCustomHexEditor.GetLineCount: Integer;
begin
Result := DivUp(FSize + 1, FLineSize);
end;
function TKCustomHexEditor.GetLines(Index: Integer): TDataSize;
var
I: Integer;
begin
I := Index * FLineSize;
if (FBuffer <> nil) and (I >= 0) and (I < FSize) then
begin
Result.Data := @FBuffer[I];
Result.Size := Min(FLineSize, FSize - I);
end else
begin
Result.Data := nil;
Result.Size := 0;
end;
end;
function TKCustomHexEditor.GetModified: Boolean;
begin
Result := (elModified in FStates) or FUndoList.Modified;
end;
function TKCustomHexEditor.GetModifiedClientRect: TRect;
begin
Result := Rect(0, 0, GetClientWidthChars * FCharWidth, GetClientHeightChars * FCharHeight);
end;
function TKCustomHexEditor.GetMaxLeftChar(Extent: Integer): Integer;
begin
if Extent <= 0 then
Extent := GetAreaDimensions.TotalHorz;
Result := Max(Extent - GetClientWidthChars, 0);
end;
function TKCustomHexEditor.GetMaxTopLine(Extent: Integer): Integer;
begin
if Extent <= 0 then
Extent := GetAreaDimensions.TotalVert;
Result := Max(Extent - GetClientHeightChars, 0);
end;
function TKCustomHexEditor.GetPageHorz: Integer;
begin
case FEditArea of
eaDigits: Result := ClientWidth * FDigitgrouping div (FCharWidth * (cDigitCount * FDigitGrouping + 1));
eaText: Result := ClientWidth div FCharWidth;
else
Result := 0;
end;
end;
function TKCustomHexEditor.GetReadOnly: Boolean;
begin
Result := elReadOnly in FStates;
end;
function TKCustomHexEditor.GetRealSelEnd: TKHexEditorSelection;
begin
if FSelStart.Index <= FSelEnd.Index then
Result := FSelEnd
else
Result := FSelStart;
end;
function TKCustomHexEditor.GetRealSelStart: TKHexEditorSelection;
begin
if FSelStart.Index <= FSelEnd.Index then
Result := FSelStart
else
Result := FSelEnd;
end;
function TKCustomHexEditor.GetSelLength: TKHexEditorSelection;
begin
if FSelStart.Index <= FSelEnd.Index then
Result.Index := FSelEnd.Index - FSelStart.Index
else
Result.Index := FSelStart.Index - FSelEnd.Index;
if FSelStart.Digit <= FSelEnd.Digit then
Result.Digit := FSelEnd.Digit - FSelStart.Digit
else
Result.Digit := FSelStart.Digit - FSelEnd.Digit;
end;
function TKCustomHexEditor.GetSelText: TKHexEditorSelText;
var
L, Sel1, Sel2: TKHexEditorSelection;
begin
L := SelLength;
with Result do
begin
if L.Index > 0 then
begin
Sel1 := GetRealSelStart;
Sel2 := GetRealSelEnd;
AsBinaryRaw := BinaryToText(FBuffer, Sel1.Index, Sel2.Index, nil);
AsBinaryMapped := BinaryToText(FBuffer, Sel1.Index, Sel2.Index, @FCharMapping);
AsDigits := BinaryToDigits(FBuffer, Sel1, Sel2);
Sel1.Digit := 0;
Sel2.Digit := 0;
AsDigitsByteAligned := BinaryToDigits(FBuffer, Sel1, Sel2);
end else
begin
AsBinaryRaw := '';
AsBinaryMapped := '';
AsDigits := '';
AsDigitsByteAligned := '';
end;
end;
end;
function TKCustomHexEditor.GetUndoLimit: Integer;
begin
Result := FUndoList.Limit;
end;
function TKCustomHexEditor.HasFocus: Boolean;
var
Form: TCustomForm;
begin
Form := GetParentForm(Self);
if (Form <> nil) and Form.Visible and Form.Enabled and Form.Active then
Result := (Form.ActiveControl = Self)
else
Result := False;
end;
procedure TKCustomHexEditor.InsertChar(At: Integer; Value: Byte);
begin
InsertString(At, AnsiChar(Value), 1);
end;
procedure TKCustomHexEditor.InsertString(At: Integer; const Value: AnsiString; Size: Integer);
begin
if (At >= 0) and (At <= FSize) and (Length(Value) > 0) then
begin
Inc(FSize, Size);
ReallocMem(FBuffer, FSize);
if At < FSize - Size then
Move(FBuffer[At], FBuffer[At + Size], (FSize - At - Size) * SizeOf(Byte));
Move(Value[1], FBuffer[At], Size);
UpdateScrollRange;
end;
end;
function TKCustomHexEditor.InternalGetSelAvail: Boolean;
begin
Result := SelAvail;
end;
procedure TKCustomHexEditor.InternalMoveLeft;
begin
if FEditArea = eaDigits then
begin
if FSelEnd.Digit > 0 then
Dec(FSelEnd.Digit)
else if FSelEnd.Index > 0 then
begin
FSelEnd.Digit := cDigitCount - 1;
Dec(FSelEnd.Index);
end
end else
Dec(FSelEnd.Index);
end;
procedure TKCustomHexEditor.InternalMoveRight;
begin
if FEditArea = eaDigits then
begin
if (FSelEnd.Index < FSize) and (FSelEnd.Digit < cDigitCount - 1) then
Inc(FSelEnd.Digit)
else
begin
FSelEnd.Digit := 0;
Inc(FSelEnd.Index);
end
end else
Inc(FSelEnd.Index);
end;
function TKCustomHexEditor.IsAddressPrefixStored: Boolean;
begin
Result := FAddressPrefix <> '0x';
end;
function TKCustomHexEditor.IsDrawStylesStored: Boolean;
begin
Result := FDrawStyles <> cDrawStylesDef;
end;
function TKCustomHexEditor.IsOptionsStored: Boolean;
begin
Result := FOptions <> [eoGroupUndo];
end;
procedure TKCustomHexEditor.KeyDown(var Key: Word; Shift: TShiftState);
var
I: Integer;
HK: TKEditKey;
begin
inherited;
Exclude(FStates, elIgnoreNextChar);
if not (csDesigning in ComponentState) then
begin
for I := 0 to Length(FKeyMapping) - 1 do
begin
HK := FKeyMapping[I].Key;
if (HK.Key = Key) and (HK.Shift = Shift) then
begin
ExecuteCommand(FKeyMapping[I].Command);
Key := 0;
Include(FStates, elIgnoreNextChar);
Exit;
end;
end;
if Key = VK_ESCAPE then
Include(FStates, elIgnoreNextChar);
end;
end;
procedure TKCustomHexEditor.KeyPress(var Key: Char);
var
I: Integer;
begin
inherited;
if not (csDesigning in ComponentState) then
begin
if not (elIgnoreNextChar in FStates) then
begin
case FEditArea of
eaDigits: I := DigitToBin(AnsiChar(Key));
eaText: I := Ord(Key);
else
I := -1;
end;
if I >= 0 then
ExecuteCommand(ecInsertChar, @I);
end else
Exclude(FStates, elIgnoreNextChar);
end;
end;
procedure TKCustomHexEditor.LoadFromFile(const FileName: TFileName);
var
Stream: TFileStream;
begin
Stream := TFileStream.Create(FileName, fmOpenRead);
try
LoadFromStream(Stream);
finally
Stream.Free;
end;
end;
procedure TKCustomHexEditor.LoadFromStream(Stream: TStream);
var
Size: Integer;
begin
Size := Stream.Size - Stream.Position;
if Size > 0 then
begin
Clear;
FSize := Size;
GetMem(FBuffer, FSize);
Stream.Read(FBuffer^, FSize);
BufferChanged;
end;
end;
procedure TKCustomHexEditor.MeasurePages(var Info: TKPrintMeasureInfo);
var
AD: TKHexEditorAreaDimensions;
PageLines, ActiveLines: Integer;
FitToPage, SelOnly: Boolean;
Scale: Double;
APageSetup: TKPrintPageSetup;
begin
APageSetup := PageSetup;
FitToPage := poFitToPage in APageSetup.Options;
SelOnly := APageSetup.Range = prSelectedOnly;
Scale := APageSetup.Scale / 100;
AD := GetAreaDimensions;
Info.OutlineWidth := AD.TotalHorz * FCharWidth;
if FitToPage then
Scale := APageSetup.PaintAreaWidth / Info.OutlineWidth;
PageLines := Round(APageSetup.PaintAreaHeight / Scale) div FCharHeight;
if SelOnly then
ActiveLines := DivUp(GetRealSelEnd.Index, FLineSize) - GetRealSelStart.Index div FLineSize
else
ActiveLines := LineCount;
Info.OutlineHeight := PageLines * FCharHeight;
Info.HorzPageCount := 1; // cut text off
Info.VertPageCount := DivUp(ActiveLines, PageLines);
Info.PageCount := Info.VertPageCount;
end;
procedure TKCustomHexEditor.ModifyScrollBar(ScrollBar, ScrollCode,
Delta: Integer; UpdateNeeded: Boolean);
var
I, J, K: Integer;
HasScrollBar: Boolean;
SI: TScrollInfo;
begin
HasScrollBar := (ScrollBar = SB_HORZ) and (ScrollBars = ssHorizontal) or
(ScrollBar = SB_VERT) and (ScrollBars = ssVertical) or (ScrollBars = ssBoth);
if HasScrollBar then
begin
FillChar(SI, SizeOf(TScrollInfo), 0);
SI.cbSize := SizeOf(TScrollInfo);
SI.fMask := SIF_PAGE or SIF_TRACKPOS;
GetScrollInfo(Handle, ScrollBar, SI);
{$IF DEFINED(LCLGTK2)}
{.$WARNING "scrollbar arrows still not working properly on GTK2 in some cases!"}
SI.nTrackPos := Delta;
{$IFEND}
end;
if ScrollBar = SB_HORZ then
begin
I := FLeftChar;
J := GetMaxLeftChar;
end else
begin
I := FTopLine;
J := GetMaxTopLine;
end;
K := I;
if ScrollCode = cScrollDelta then
Inc(I, Delta)
else if HasScrollBar then
case ScrollCode of
SB_LINEUP: Dec(I);
SB_LINEDOWN: Inc(I);
SB_PAGEUP: Dec(I, SI.nPage);
SB_PAGEDOWN: Inc(I, SI.nPage);
SB_THUMBTRACK, SB_THUMBPOSITION: I := SI.nTrackPos;
end;
I := MinMax(I, 0, J);
if K <> I then
begin
if HasScrollBar then
begin
FillChar(SI, SizeOf(TScrollInfo), 0);
SI.nPos := I;
SI.fMask := SIF_POS;
SetScrollInfo(Handle, ScrollBar, SI, True);
end;
if ScrollBar = SB_HORZ then
FLeftChar := I
else
FTopLine := I;
if UpdateNeeded then
begin
UpdateEditorCaret;
Invalidate;
end;
end;
end;
procedure TKCustomHexEditor.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
var
P: TPoint;
Command: TKEditCommand;
begin
inherited;
if Enabled and (Button = mbLeft) and not (ssDouble in Shift) then
begin
SafeSetFocus;
P := Point(X, Y);
if ssShift in Shift then
Command := ecSelGotoXY
else
Command := ecGotoXY;
if ExecuteCommand(Command, @P) then
Include(FStates, elMouseCapture);
end;
end;
procedure TKCustomHexEditor.MouseMove(Shift: TShiftState; X, Y: Integer);
var
P: TPoint;
R: TRect;
begin
inherited;
if (elMouseCapture in FStates) then
begin
P := Point(X, Y);
R := GetModifiedClientRect;
if PtInRect(R, P) then
UpdateSelEnd(P, False)
else if not FScrollTimer.Enabled then
ScrollTo(P, True, False);
end;
end;
procedure TKCustomHexEditor.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
inherited;
Exclude(FStates, elMouseCapture);
end;
procedure TKCustomHexEditor.PaintLines(const Data: TKHexEditorPaintData);
var
HalfPosWidth, I, Index, J, K, L, M, MaxAddress, WHorz, WVert, WSep,
LeftIndent, VTextIndent: Integer;
BC1, BC2, FC1, FC2, PC1: TColor;
EditorFocused, DrawInactiveCaret, DrawNormal, DigitSep, SelCondition: Boolean;
S: AnsiString;
Fmt: string;
C: Char;
R, R1, RClip: TRect;
OldColorScheme: TKHexEditorColorScheme;
ASelStart, ASelEnd: TKHexEditorSelection;
AD: TKHexEditorAreaDimensions;
begin
{ this function must be reentrant because of print function
so there is necessary to backup all changes to global properties}
OldColorScheme := FColors.ColorScheme;
with Data.Canvas do
try
R := Data.PaintRect;
AD := GetAreaDimensions;
// add possible inter-character spacing (in Lazarus not fully implemented yet)
SetTextCharacterExtra(Handle, Data.CharSpacing);
LeftIndent := R.Left - Data.LeftChar * Data.CharWidth;
VTextIndent := (Data.CharHeight - Abs(Font.Height)) div 2;
HalfPosWidth := Data.CharWidth div 2;
Fmt := '';
MaxAddress := 0;
L := LineCount;
DrawInactiveCaret := not (Data.Printing or Data.CaretShown) and
(edInactiveCaret in FDrawStyles);
DrawNormal := not Data.Printing;
EditorFocused := HasFocus;
if FSelStart.Index <= FSelEnd.Index then
begin
ASelStart := FSelStart;
ASelEnd := FSelEnd;
end else
begin
ASelStart := FSelEnd;
ASelEnd := FSelStart;
end;
// preserve space for lines and separators
if edHorzLines in FDrawStyles then
WVert := Max(1, Data.CharHeight div 25)
else
WVert := 0;
if edVertLines in FDrawStyles then
WHorz := Max(1, Data.CharWidth div 20)
else
WHorz := 0;
if edSeparators in FDrawStyles then
WSep := Max(1, Data.CharWidth div 20)
else
WSep := 0;
// address area pre-comp
if edAddress in FDrawStyles then
begin
if FAddressMode = eamDec then
begin
C := 'd';
J := 10;
end else
begin
C := 'x';
J := 16;
end;
Fmt := Format('%s%%.%d%s', [FAddressPrefix, FAddressSize, C]);
MaxAddress := 1;
for I := 1 to FAddressSize do
MaxAddress := MaxAddress * J;
end;
// update color scheme
if Data.Printing then
begin
if Data.PaintColors then
FColors.ColorScheme := ecsNormal
else
FColors.ColorScheme := ecsGrayScale;
end else
begin
if Enabled or (FDisabledDrawStyle = eddNormal) then
FColors.ColorScheme := ecsNormal
else if FDisabledDrawStyle = eddGrayed then
FColors.ColorScheme := ecsGrayed
else
FColors.ColorScheme := ecsBright
end;
FColors.SingleBkGnd := edSingleBkGnd in FDrawStyles;
// get clip box for updating;
if Data.Printing then
RClip := R
else
GetClipBox(Handle, {$IFDEF FPC}@{$ENDIF}RClip);
// now paint text lines
for I := Data.TopLine to Min(L - 1, Data.BottomLine) do
begin
Brush.Style := bsSolid;
K := LeftIndent;
R.Bottom := R.Top + Data.CharHeight - WVert;
if (R.Top <= RClip.Bottom) and (R.Bottom >= RClip.Top) then
begin
if edAddress in FDrawStyles then
begin
Index := I * FLineSize;
Brush.Color := clRed;
if (DrawNormal or Data.PaintSelection) and ((ASelStart.Index <> ASelEnd.Index) or (ASelStart.Digit <> ASelEnd.Digit)) and
(Index + FLineSize - 1 >= ASelStart.Index) and (Index < ASelEnd.Index) then
begin
PC1 := FColors.LinesHighLight;
if (FEditArea = eaAddress) and (EditorFocused or Data.PaintSelection) then
begin
FC1 := FColors.SelTextFocused;
BC1 := FColors.SelBkGndFocused;
end else
begin
FC1 := FColors.SelText;
BC1 := FColors.SelBkGnd;
end;
end else
begin
PC1 := FColors.HorzLines;
FC1 := FColors.AddressText;
BC1 := FColors.AddressBkGnd;
end;
Brush.Color := BC1;
Font.Color := FC1;
R.Left := K;
Inc(K, AD.Address * Data.CharWidth);
R.Right := K;
J := I * FLineSize + FAddressOffset;
if MaxAddress <> 0 then J := J mod MaxAddress;
FillRect(R);
TextOut(R.Left, R.Top + VTextIndent, Format(Fmt, [J]));
if edHorzLines in FDrawStyles then
begin
Brush.Color := PC1;
FillRect(Rect(R.Left, R.Bottom, R.Right, R.Bottom + WVert));
end;
if AD.AddressOut > 0 then
begin
R.Left := K;
Inc(K, AD.AddressOut * Data.CharWidth);
R.Right := K;
Brush.Color := FColors.AddressBkGnd;
FillRect(Rect(R.Left, R.Top, R.Right - WSep, R.Bottom));
if edHorzLines in FDrawStyles then
begin
Brush.Color := FColors.HorzLines;
FillRect(Rect(R.Left, R.Bottom, R.Right - WSep, R.Bottom + WVert));
end;
end;
end;
if edDigits in FDrawStyles then
begin
if AD.DigitsIn > 0 then
begin
R.Left := K;
Inc(K, AD.DigitsIn * Data.CharWidth);
R.Right := K;
Brush.Color := FColors.DigitBkGnd;
FillRect(Rect(R.Left + WSep, R.Top, R.Right, R.Bottom));
if edHorzLines in FDrawStyles then
begin
Brush.Color := FColors.HorzLines;
FillRect(Rect(R.Left + WSep, R.Bottom, R.Right, R.Bottom + WVert));
end;
end;
Index := 0;
for J := 0 to FLineSize - 1 do
begin
Index := I * FLineSize + J;
DigitSep := (J < FLineSize - 1) and ((J + 1) mod FDigitGrouping = 0);
R.Left := K;
Inc(K, cDigitCount * Data.CharWidth);
R.Right := K;
if Index <= FSize then
begin
if Index < FSize then
S := AnsiString(Format(cFmtText, [FBuffer[Index]]))
else
S := ' ';
if (Index <> FSelStart.Index) and (Index <> FSelEnd.Index) then
begin
SelCondition := (Index >= ASelStart.Index) and (Index < ASelEnd.Index);
if (DrawNormal or Data.PaintSelection) and SelCondition then
begin
PC1 := FColors.LinesHighLight;
if (FEditArea = eaDigits) and (EditorFocused or Data.PaintSelection) then
begin
FC1 := FColors.SelTextFocused;
BC1 := FColors.SelBkGndFocused;
end else
begin
FC1 := FColors.SelText;
BC1 := FColors.SelBkGnd;
end;
FC2 := FColors.InactiveCaretSelText;
BC2 := FColors.InactiveCaretSelBkGnd;
end else
begin
PC1 := FColors.HorzLines;
if DrawNormal or Data.PaintAll or SelCondition then
begin
if (J div FDigitGrouping) and 1 = 0 then
FC1 := FColors.DigitTextEven
else
FC1 := FColors.DigitTextOdd;
end else
FC1 := FColors.DigitBkGnd;
BC1 := FColors.DigitBkGnd;
FC2 := FColors.InactiveCaretText;
BC2 := FColors.InactiveCaretBkGnd;
end;
Brush.Color := BC1;
Font.Color := FC1;
Brush.Style := bsSolid;
FillRect(R);
Brush.Style := bsClear;
TextOut(R.Left, R.Top + VTextIndent, Char(S[1]));
TextOut(R.Left + Data.CharWidth, R.Top + VTextIndent, Char(S[2]));
if (Index = FSelEnd.Index) and DrawInactiveCaret then
begin
// draw inactive caret - place into previous drawn text
R1 := R;
Inc(R1.Left, Data.CharWidth * Min(FSelEnd.Digit, cDigitCount - 1));
R1.Right := R1.Left + Data.CharWidth;
Font.Color := FC2;
Brush.Color := BC2;
Brush.Style := bsSolid;
FillRect(R1);
Brush.Style := bsClear;
TextOut(R1.Left, R1.Top + VTextIndent, string(S));
end;
if edHorzLines in FDrawStyles then
begin
Brush.Color := PC1;
Brush.Style := bsSolid;
FillRect(Rect(R.Left, R.Bottom, R.Right, R.Bottom + WVert));
end;
end else
begin
R1 := R;
R1.Right := R1.Left;
Inc(R1.Right, Data.CharWidth);
for M := 0 to cDigitCount - 1 do
begin
SelCondition :=
(ASelStart.Index = ASelEnd.Index) and (
(M >= ASelStart.Digit) and (M < ASelEnd.Digit) or
(M >= ASelEnd.Digit) and (M < ASelStart.Digit)
)
or
(ASelStart.Index <> ASelEnd.Index) and (
(Index = ASelStart.Index) and (M >= ASelStart.Digit) or
(Index = ASelEnd.Index) and (M < ASelEnd.Digit)
);
if (DrawNormal or Data.PaintSelection) and SelCondition then
begin
PC1 := FColors.LinesHighLight;
if DrawInactiveCaret and (Index = FSelEnd.Index) and (M = FSelEnd.Digit) then
begin
FC1 := FColors.InactiveCaretSelText;
BC1 := FColors.InactiveCaretSelBkGnd;
end
else if (FEditArea = eaDigits) and (EditorFocused or Data.PaintSelection) then
begin
FC1 := FColors.SelTextFocused;
BC1 := FColors.SelBkGndFocused;
end else
begin
FC1 := FColors.SelText;
BC1 := FColors.SelBkGnd;
end;
end else
begin
PC1 := FColors.HorzLines;
if DrawInactiveCaret and (Index = FSelEnd.Index) and (M = FSelEnd.Digit) then
begin
FC1 := FColors.InactiveCaretText;
BC1 := FColors.InactiveCaretBkGnd;
end else
begin
if DrawNormal or Data.PaintAll or SelCondition then
begin
if (J div FDigitGrouping) and 1 = 0 then
FC1 := FColors.DigitTextEven
else
FC1 := FColors.DigitTextOdd;
end else
FC1 := FColors.DigitBkGnd;
BC1 := FColors.DigitBkGnd;
end;
end;
Brush.Color := BC1;
Font.Color := FC1;
Brush.Style := bsSolid;
FillRect(R1);
Brush.Style := bsClear;
TextOut(R1.Left, R1.Top + VTextIndent, Char(S[M + 1]));
if edHorzLines in FDrawStyles then
begin
Brush.Color := PC1;
Brush.Style := bsSolid;
FillRect(Rect(R1.Left, R1.Bottom, R1.Right, R1.Bottom + WVert));
end;
R1.Left := R1.Right;
Inc(R1.Right, Data.CharWidth);
end;
end;
if DigitSep then
begin
if Index < FSize then
M := Data.CharWidth
else
M := HalfPosWidth;
Brush.Color := FColors.DigitBkGnd;
Brush.Style := bsSolid;
FillRect(Rect(R.Right, R.Top, R.Right + Data.CharWidth, R.Bottom));
if edHorzLines in FDrawStyles then
begin
Brush.Color := FColors.HorzLines;
FillRect(Rect(R.Right, R.Bottom, R.Right + M, R.Bottom + WVert));
end;
if edVertLines in FDrawStyles then
begin
M := R.Right + HalfPosWidth;
Brush.Color := FColors.VertLines;
FillRect(Rect(M, R.Top, M + WHorz, R.Bottom));
end;
Inc(K, Data.CharWidth);
end;
end else
begin
Inc(K, Integer(DigitSep) * Data.CharWidth);
Brush.Color := FColors.DigitBkGnd;
Brush.Style := bsSolid;
FillRect(Rect(R.Left, R.Top, K, R.Bottom + WVert));
end;
end;
if AD.DigitsOut > 0 then
begin
R.Left := K;
Inc(K, AD.DigitsOut * Data.CharWidth);
R.Right := K;
Brush.Style := bsSolid;
Brush.Color := FColors.DigitBkGnd;
FillRect(Rect(R.Left, R.Top, R.Right - WSep, R.Bottom));
if edHorzLines in FDrawStyles then
begin
if Index < FSize then
Brush.Color := FColors.HorzLines
else
Brush.Color := FColors.DigitBkGnd;
FillRect(Rect(R.Left, R.Bottom, R.Right - WSep, R.Bottom + WVert));
end;
end;
end;
if edText in FDrawStyles then
begin
if AD.TextIn > 0 then
begin
R.Left := K;
Inc(K, AD.TextIn * Data.CharWidth);
R.Right := K;
Brush.Color := FColors.TextBkGnd;
Brush.Style := bsSolid;
FillRect(Rect(R.Left + WSep, R.Top, R.Right, R.Bottom));
if edHorzLines in FDrawStyles then
begin
Brush.Color := FColors.HorzLines;
FillRect(Rect(R.Left + WSep, R.Bottom, R.Right, R.Bottom + WVert));
end;
end;
for J := 0 to FLineSize - 1 do
begin
Index := I * FLineSize + J;
R.Left := K;
Inc(K, Data.CharWidth);
R.Right := K;
if Index <= FSize then
begin
SelCondition := (Index >= ASelStart.Index) and (Index < ASelEnd.Index);
if (DrawNormal or Data.PaintSelection) and SelCondition then
begin
PC1 := FColors.LinesHighLight;
if DrawInactiveCaret and (Index = FSelEnd.Index) then
begin
FC1 := FColors.InactiveCaretSelText;
BC1 := FColors.InactiveCaretSelBkGnd;
end
else if (FEditArea = eaText) and (EditorFocused or Data.PaintSelection) then
begin
FC1 := FColors.SelTextFocused;
BC1 := FColors.SelBkGndFocused;
end else
begin
FC1 := FColors.SelText;
BC1 := FColors.SelBkGnd;
end;
end else
begin
PC1 := FColors.HorzLines;
if DrawInactiveCaret and (Index = FSelEnd.Index) then
begin
FC1 := FColors.InactiveCaretText;
BC1 := FColors.InactiveCaretBkGnd;
end else
begin
if DrawNormal or Data.PaintAll or SelCondition then
FC1 := FColors.TextText
else
FC1 := FColors.TextBkgnd;
BC1 := FColors.TextBkgnd;
end;
end;
Brush.Color := BC1;
Brush.Style := bsSolid;
FillRect(R);
Brush.Style := bsClear;
if Index < FSize then
begin
Font.Color := FC1;
TextOut(R.Left, R.Top + VTextIndent, Char(FCharMapping[FBuffer[Index]]));
end;
if edHorzLines in FDrawStyles then
begin
Brush.Color := PC1;
Brush.Style := bsSolid;
FillRect(Rect(R.Left, R.Bottom, R.Right, R.Bottom + WVert));
end;
end else
begin
Brush.Color := FColors.TextBkGnd;
Brush.Style := bsSolid;
FillRect(Rect(R.Left, R.Top, K, R.Bottom + WVert));
end;
end;
end;
end;
Inc(R.Top, Data.CharHeight);
end;
// now complete blank areas below text and optionally paint separators
K := LeftIndent;
R.Bottom := Data.PaintRect.Bottom;
Brush.Style := bsSolid;
if edAddress in FDrawStyles then
begin
R.Left := K;
Inc(K, (AD.Address + AD.AddressOut) * Data.CharWidth);
R.Right := K; if FDrawStyles * [edDigits, edText] <> [] then Dec(R.Right, WSep);
if R.Top < R.Bottom then
begin
Brush.Color := FColors.AddressBkGnd;
FillRect(R);
end;
if (edSeparators in FDrawStyles) and (FDrawStyles * [edDigits, edText] <> []) then
begin
Brush.Color := FColors.Separators;
FillRect(Rect(K - WSep, Data.PaintRect.Top, K + WSep, Data.PaintRect.Bottom));
end;
end;
if edDigits in FDrawStyles then
begin
R.Left := K; if edAddress in FDrawStyles then Inc(R.Left, WSep);
Inc(K, (AD.Digits + AD.DigitsIn + AD.DigitsOut) * Data.CharWidth);
R.Right := K; if edText in FDrawStyles then Dec(R.Right, WSep);
if R.Top < R.Bottom then
begin
Brush.Color := FColors.DigitBkGnd;
FillRect(R);
end;
if (edSeparators in FDrawStyles) and (edText in FDrawStyles) then
begin
Brush.Color := FColors.Separators;
FillRect(Rect(K - WSep, Data.PaintRect.Top, K + WSep, Data.PaintRect.Bottom));
end;
end;
if edText in FDrawStyles then
begin
R.Left := K; if FDrawStyles * [edAddress, edDigits] <> [] then Inc(R.Left, WSep);
Inc(K, (AD.TextIn + AD.Text) * Data.CharWidth);
R.Right := K;
if R.Top < R.Bottom then
begin
Brush.Color := FColors.TextBkGnd;
FillRect(R);
end;
end;
if K < ClientWidth then
begin
Brush.Color := FColors.BkGnd;
FillRect(Rect(K, 0, ClientWidth, ClientHeight));
end;
finally
FColors.ColorScheme := OldColorScheme;
end;
end;
procedure TKCustomHexEditor.PaintPage;
var
ActiveLines, AreaWidth, AreaHeight, FirstLine, PageLines: Integer;
SelOnly: Boolean;
TmpRect, TmpRect1: TRect;
APageSetup: TKPrintPageSetup;
Data: TKHexEditorPaintData;
begin
APageSetup := PageSetup;
SelOnly := APageSetup.Range = prSelectedOnly;
AreaWidth := Round(APageSetup.PaintAreaWidth / APageSetup.CurrentScale);
AreaHeight := Round(APageSetup.PaintAreaHeight / APageSetup.CurrentScale);
PageLines := AreaHeight div FCharHeight;
if SelOnly then
begin
FirstLine := GetRealSelStart.Index div FLineSize;
ActiveLines := DivUp(GetRealSelEnd.Index, FLineSize) - FirstLine;
end else
begin
FirstLine := 0;
ActiveLines := LineCount;
end;
TmpRect := Rect(0, 0, APageSetup.OutlineWidth, APageSetup.OutlineHeight);
TmpRect1 := Rect(0, 0, AreaWidth, AreaHeight);
IntersectRect(TmpRect, TmpRect, TmpRect1);
TmpRect1 := TmpRect;
TranslateRectToDevice(APageSetup.Canvas.Handle, TmpRect1);
SelectClipRect(APageSetup.Canvas.Handle, TmpRect1);
Data.Canvas := APageSetup.Canvas;
Data.Canvas.Font := Font;
Data.Canvas.Font.Height := Abs(Font.Height);
Data.PaintRect := TmpRect;
Data.TopLine := (APageSetup.CurrentPage - 1) * PageLines;
Data.BottomLine := Min(Data.TopLine + PageLines, ActiveLines) - 1;
Inc(Data.TopLine, FirstLine);
Inc(Data.BottomLine, FirstLine);
Data.LeftChar := 0;
Data.CharWidth := FCharWidth;
Data.CharHeight := FCharHeight;
Data.CharSpacing := FTotalCharSpacing;
Data.Printing := True;
Data.PaintSelection := poPaintSelection in APageSetup.Options;
Data.PaintAll := not SelOnly;
Data.PaintColors := poUseColor in APageSetup.Options;
PaintLines(Data);
end;
procedure TKCustomHexEditor.PaintToCanvas(ACanvas: TCanvas);
var
Data: TKHexEditorPaintData;
begin
ACanvas.Font := Font;
with Data do
begin
Canvas := ACanvas;
PaintRect := ClientRect;
LeftChar := FLeftChar;
TopLine := FTopLine;
CharWidth := FCharWidth;
CharHeight := FCharHeight;
BottomLine := TopLine + ClientHeight div FCharHeight;
CharSpacing := FTotalCharSpacing;
Printing := False;
PaintSelection := False;
CaretShown := elCaretVisible in FStates;
end;
{$IFDEF FPC}
if Data.CaretShown then
HideEditorCaret;
try
{$ENDIF}
PaintLines(Data);
{$IFDEF FPC}
finally
if Data.CaretShown then
ShowEditorCaret;
end;
{$ENDIF}
end;
procedure TKCustomHexEditor.PaintToCanvasEx(ACanvas: TCanvas; ARect: TRect; ALeftChar, ATopLine: Integer);
var
Data: TKHexEditorPaintData;
Region: HRGN;
begin
ACanvas.Font := Font;
with Data do
begin
Canvas := ACanvas;
PaintRect := ARect;
LeftChar := ALeftChar;
TopLine := ATopLine;
CharWidth := FCharWidth;
CharHeight := FCharHeight;
BottomLine := TopLine + (ARect.Bottom - ARect.Top) div FCharHeight;
CharSpacing := FTotalCharSpacing;
Printing := False;
PaintSelection := False;
end;
Region := CreateRectRgnIndirect(ARect);
try
SelectClipRgn(ACanvas.Handle, Region);
try
PaintLines(Data);
finally
SelectClipRgn(ACanvas.Handle, 0);
end;
finally
DeleteObject(Region);
end;
end;
function TKCustomHexEditor.PointToSel(P: TPoint; OutOfArea: Boolean; var Area: TKHexEditorArea): TKHexEditorSelection;
var
Digit, HalfPosWidth, I, X, X1, XMax: Integer;
DigitSep: Boolean;
AD: TKHexEditorAreaDimensions;
Sel: TKHexEditorSelection;
begin
Result := MakeSelection(cInvalidIndex, 0);
P.X := P.X + FLeftChar * FCharWidth;
P.Y := P.Y div FCharHeight + FTopLine;
AD := GetAreaDimensions;
HalfPosWidth := FCharWidth div 2;
X := 0;
if OutOfArea then
P.Y := MinMax(P.Y, 0, LineCount - 1)
else
Area := eaNone;
if P.Y < LineCount then
begin
if edAddress in FDrawStyles then
begin
XMax := X + (AD.Address + AD.AddressOut) * FCharWidth;
if not OutOfArea or (Area = eaAddress) then
if (P.X >= X) and (P.X < XMax) then
begin
Result := MakeSelection(P.Y * FLineSize, 0);
Area := eaAddress;
end
else if Area = eaAddress then // OutOfArea = True
begin
Result.Index := P.Y * FLineSize;
if P.X >= XMax then
Inc(Result.Index, FLineSize);
end;
X := XMax;
end;
if (P.X >= X) or OutOfArea then
begin
if edDigits in FDrawStyles then
begin
XMax := X + (AD.Digits + AD.DigitsIn + AD.DigitsOut) * FCharWidth;
if not OutOfArea or (Area = eaDigits) then
if (P.X >= X) and (P.X < XMax) then
begin
Inc(X, AD.DigitsIn * FCharWidth);
for I := 0 to FLineSize - 1 do
begin
DigitSep := (I < FLineSize - 1) and ((I + 1) mod FDigitGrouping = 0);
X1 := X;
Inc(X, cDigitCount * FCharWidth);
if DigitSep then
Inc(X, HalfPosWidth)
else if I = FLineSize - 1 then
Inc(X, AD.DigitsOut * FCharWidth);
if P.X < X then
begin
Digit := (Max(P.X - X1, 0) + HalfPosWidth) div FCharWidth;
Sel := MakeSelection(P.Y * FLineSize + I, Digit);
if (Digit >= cDigitCount) and (Sel.Index < FSize) then // don't split the FSize character box
begin
Inc(Sel.Index);
Sel.Digit := 0;
end;
if (Sel.Index <= FSize) or OutOfArea then
begin
Result := Sel;
Area := eaDigits;
end;
Break;
end;
if DigitSep then
Inc(X, HalfPosWidth);
end;
end
else if Area = eaDigits then // OutOfArea = True
begin
Result.Index := P.Y * FLineSize;
if P.X >= XMax then
Inc(Result.Index, FLineSize);
end;
X := XMax;
end;
if ((P.X >= X) or OutOfArea) and (edText in FDrawStyles) then
begin
XMax := X + (AD.Text + AD.TextIn) * FCharWidth;
if not OutOfArea or (Area = eaText) then
if (P.X >= X) and (P.X < XMax) then
begin
Inc(X, AD.TextIn * FCharWidth);
Sel := MakeSelection(P.Y * FLineSize, 0);
I := Max(P.X - X, 0) div FCharWidth;
if Sel.Index + I = FSize then
Sel.Index := FSize // don't split the FSize character box
else
Inc(Sel.Index, (Max(P.X - X, 0) + HalfPosWidth) div FCharWidth);
if (Sel.Index <= FSize) or OutOfArea then
begin
Result := Sel;
Area := eaText;
end;
end
else if Area = eaText then // OutOfArea = True
begin
Result.Index := P.Y * FLineSize;
if P.X >= XMax then
Inc(Result.Index, FLineSize);
end;
end;
end;
end;
ValidateSelection(Result, Area);
end;
procedure TKCustomHexEditor.SafeSetFocus;
var
Form: TCustomForm;
begin
Form := GetParentForm(Self);
if (Form <> nil) and Form.Visible and Form.Enabled and not (csDestroying in Form.ComponentState)
and Visible and Enabled then
Form.ActiveControl := Self;
end;
procedure TKCustomHexEditor.SaveToFile(const FileName: TFileName);
var
Stream: TFileStream;
begin
Stream := TFileStream.Create(FileName, fmCreate);
try
SaveToStream(Stream);
finally
Stream.Free;
end;
end;
procedure TKCustomHexEditor.SaveToStream(Stream: TStream);
begin
if FBuffer <> nil then
Stream.Write(FBuffer^, FSize);
end;
procedure TKCustomHexEditor.ScrollBy(HChars, VChars: Integer; UpdateNeeded: Boolean);
begin
if HChars <> 0 then
ModifyScrollBar(SB_HORZ, cScrollDelta, HChars, UpdateNeeded);
if VChars <> 0 then
ModifyScrollBar(SB_VERT, cScrollDelta, VChars, UpdateNeeded);
end;
procedure TKCustomHexEditor.ScrollTo(Point: TPoint; Timed, AlwaysScroll: Boolean);
var
ScrollHorz: Boolean;
R: TRect;
begin
// disable horizontal overscroll when scrolling e.g. with mouse
ScrollHorz := AlwaysScroll or (FSelEnd.Index mod FLineSize <> 0) and
(FSelEnd.Index < FSize) or (FSelEnd.Digit > 0);
R := GetModifiedClientRect;
if ScrollHorz then
begin
if Point.X < R.Left then
FScrollDeltaX := DivDown(Point.X, FCharWidth)
else if Point.X >= R.Right then
FScrollDeltaX := (Point.X - R.Right) div FCharWidth + 1
else
FScrollDeltaX := 0;
end else
FScrollDeltaX := 0;
if Point.Y < R.Top then
FScrollDeltaY := DivDown(Point.Y, FCharHeight)
else if Point.Y >= R.Bottom then
FScrollDeltaY := (Point.Y - R.Bottom) div FCharHeight + 1
else
FScrollDeltaY := 0;
if (FScrollDeltaX <> 0) or (FScrollDeltaY <> 0) then
if Timed then
begin
ScrollBy(FScrollDeltaX, FScrollDeltaY, False);
FScrollTimer.Enabled := True;
end else
ScrollBy(FScrollDeltaX, FScrollDeltaY, True);
UpdateSelEnd(Point, True);
end;
procedure TKCustomHexEditor.ScrollTimerHandler(Sender: TObject);
var
P: TPoint;
begin
GetCursorPos(P);
P := ScreenToClient(P);
if (elMouseCapture in FStates) and not (Dragging or
PtInRect(GetModifiedClientRect, P)) then
ScrollTo(P, True, False)
else
FScrollTimer.Enabled := False;
end;
function TKCustomHexEditor.SelAvail: Boolean;
begin
Result := SelLength.Index > 0;
end;
procedure TKCustomHexEditor.SelectionChanged(StartEqualEnd: Boolean; ScrollToView: Boolean = True);
begin
ValidateSelection(FSelEnd, FEditArea);
if StartEqualEnd then
FSelStart := FSelEnd
else
ValidateSelection(FSelStart, FEditArea);
if HasParent then
begin
if ScrollToView and (FEditArea <> eaNone) then
ScrollTo(SelToPoint(FSelEnd, FEditArea), False, True);
UpdateEditorCaret;
Invalidate;
InvalidatePageSetup;
end;
end;
function TKCustomHexEditor.SelectionValid(Value: TKHexEditorSelection; Area: TKHexEditorArea): Boolean;
begin
Result := (Area <> eaNone) and (
(Value.Index >= 0) and (Value.Index < FSize) or
(Value.Index = FSize) and (Value.Digit = 0))
end;
function TKCustomHexEditor.SelToPoint(Value: TKHexEditorSelection; Area: TKHexEditorArea): TPoint;
var
AD: TKHexEditorAreaDimensions;
begin
Result := Point(0, 0);
AD := GetAreaDimensions;
ValidateSelection(Value, Area);
if (Area = eaDigits) and (edDigits in FDrawStyles) then
begin
Result.X := ((Value.Index mod FLineSize) div FDigitGrouping * (cDigitCount * FDigitGrouping + 1) +
(Value.Index mod FLineSize) mod FDigitGrouping * cDigitCount + Value.Digit + AD.DigitsIn)
end else if (Area = eaText) and (edText in FDrawStyles) then
Result.X := (Value.Index mod FLineSize + AD.DigitsIn + AD.Digits + AD.DigitsOut + AD.TextIn)
else if Area = eaAddress then
begin
if edDigits in FDrawStyles then
Result.X := AD.DigitsIn
else if edText in FDrawStyles then
Result.X := AD.TextIn;
end;
Result.X := (Result.X + AD.Address + AD.AddressOut - FLeftChar) * FCharWidth;
Result.Y := (Value.Index div FLineSize - FTopLine) * FCharHeight;
end;
procedure TKCustomHexEditor.SetAddressCursor(Value: TCursor);
begin
if Value <> FAddressCursor then
begin
FAddressCursor := Value;
UpdateMouseCursor;
end;
end;
procedure TKCustomHexEditor.SetAddressMode(Value: TKHexEditorAddressMode);
begin
if Value <> FAddressMode then
begin
FAddressMode := Value;
Invalidate;
end;
end;
procedure TKCustomHexEditor.SetAddressOffset(Value: Integer);
begin
if Value <> FAddressOffset then
begin
FAddressOffset := Value;
Invalidate;
end;
end;
procedure TKCustomHexEditor.SetAddressPrefix(const Value: string);
begin
if Value <> FAddressPrefix then
begin
FAddressPrefix := Value;
UpdateScrollRange;
end;
end;
procedure TKCustomHexEditor.SetAddressSize(Value: Integer);
begin
Value := MinMax(Value, cAddressSizeMin, cAddressSizeMax);
if Value <> FAddressSize then
begin
FAddressSize := Value;
UpdateScrollRange;
end;
end;
procedure TKCustomHexEditor.SetAreaSpacing(Value: Integer);
begin
Value := MinMax(Value, cAreaSpacingMin, cAreaSpacingMax);
if Value <> FAreaSpacing then
begin
FAreaSpacing := Value;
UpdateScrollRange;
end;
end;
procedure TKCustomHexEditor.SetCharMapping(const Value: TKEditCharMapping);
begin
if not CompareMem(@Value, @FCharMapping, SizeOf(TKEditCharMapping)) and
(edText in FDrawStyles) then
Invalidate;
end;
procedure TKCustomHexEditor.SetCharSpacing(Value: Integer);
begin
Value := MinMax(Value, cCharSpacingMin, cCharSpacingMax);
if Value <> FCharSpacing then
begin
FCharSpacing := Value;
UpdateCharMetrics;
UpdateScrollRange;
end;
end;
procedure TKCustomHexEditor.SetColors(Value: TKHexEditorColors);
begin
FColors.Assign(Value);
end;
procedure TKCustomHexEditor.SetCommandKey(Index: TKEditCommand; Value: TKEditKey);
var
I: Integer;
begin
for I := 0 to Length(FKeyMapping) - 1 do
if FKeyMapping[I].Command = Index then
begin
FKeyMapping[I].Key := Value;
Exit;
end;
end;
procedure TKCustomHexEditor.SetData(Value: TDataSize);
begin
if (Value.Data <> FBuffer) or (Value.Size <> FSize) then
begin
Clear;
if Value.Data <> nil then
begin
FSize := Value.Size;
GetMem(FBuffer, FSize);
System.Move(Value.Data^, FBuffer^, FSize);
BufferChanged;
end;
end;
end;
procedure TKCustomHexEditor.SetDigitGrouping(Value: Integer);
begin
Value := MinMax(Value, cDigitGroupingMin, Min(FLineSize, cDigitGroupingMax));
if Value <> FDigitGrouping then
begin
FDigitGrouping := Value;
UpdateScrollRange;
end;
end;
procedure TKCustomHexEditor.SetDisabledDrawStyle(Value: TKHexEditorDisabledDrawStyle);
begin
if Value <> FDisabledDrawStyle then
begin
FDisabledDrawStyle := Value;
if not Enabled then
Invalidate;
end;
end;
procedure TKCustomHexEditor.SetDrawStyles(const Value: TKHexEditorDrawStyles);
begin
if Value <> FDrawStyles then
begin
FDrawStyles := Value;
EditAreaChanged; // must be called first
UpdateScrollRange;
end;
end;
procedure TKCustomHexEditor.SetEditArea(Value: TKHexEditorArea);
begin
if Value <> FEditArea then
begin
FEditArea := Value;
EditAreaChanged;
if Value <> FEditArea then
Invalidate;
end;
end;
procedure TKCustomHexEditor.SetKeyMapping(const Value: TKEditKeyMapping);
begin
SetLength(FKeyMapping, Length(Value));
Move(Value, FKeyMapping, Length(Value) * SizeOf(TKEditCommandAssignment));
end;
procedure TKCustomHexEditor.SetLineHeightPercent(Value: Integer);
begin
Value := MinMax(Value, cLineHeightPercentMin, cLineHeightPercentMax);
if Value <> FLineHeightPercent then
begin
FLineHeightPercent := Value;
UpdateCharMetrics;
UpdateScrollRange;
end;
end;
procedure TKCustomHexEditor.SetLeftChar(Value: Integer);
begin
Value := MinMax(Value, 0, GetMaxLeftChar);
if Value <> FLeftChar then
ScrollBy(Value - FLeftChar, 0, True);
end;
procedure TKCustomHexEditor.SetLines(Index: Integer; const Value: TDataSize);
var
I, Size: Integer;
begin
I := Index * FLineSize;
if (Value.Data <> nil) and (Value.Size > 0) and (I >= 0) and (I <= FSize) then
begin
Size := Min(FLineSize, Value.Size);
if I + Size > FSize then
begin
FSize := Size;
ReallocMem(FBuffer, FSize);
end;
System.Move(Value.Data^, FBuffer[I], Size);
BufferChanged;
end;
end;
procedure TKCustomHexEditor.SetLineSize(Value: Integer);
begin
Value := MinMax(Value, cLineSizeMin, cLineSizeMax);
if Value <> FLineSize then
begin
FLineSize := Value;
UpdateScrollRange;
end;
end;
procedure TKCustomHexEditor.SetModified(Value: Boolean);
begin
if Value <> GetModified then
begin
if Value then
Include(FStates, elModified)
else
begin
Exclude(FStates, elModified);
if eoUndoAfterSave in FOptions then
FUndoList.Modified := False
else
begin
FUndoList.Clear;
FRedoList.Clear;
end;
end;
end;
end;
function TKCustomHexEditor.SetMouseCursor(X, Y: Integer): Boolean;
var
ACursor: TCursor;
P: TPoint;
Area: TKHexEditorArea;
begin
P := Point(X, Y);
PointToSel(P, False, Area);
if PtInRect(ClientRect, P) then
begin
case Area of
eaAddress: ACursor := FAddressCursor;
eaDigits: ACursor := crIBeam;
eaText: ACursor := crIBeam;
else
ACursor := crDefault;
end;
end else
ACursor := crDefault;
{$IFDEF FPC}
FCursor := ACursor;
SetTempCursor(ACursor);
{$ELSE}
Windows.SetCursor(Screen.Cursors[ACursor]);
{$ENDIF}
Result := True;
end;
procedure TKCustomHexEditor.SetOptions(const Value: TKEditOptions);
{$IFDEF USE_WINAPI}
var
UpdateDropFiles: Boolean;
{$ENDIF}
begin
if Value <> FOptions then
begin
{$IFDEF USE_WINAPI}
UpdateDropFiles := (eoDropFiles in Value) <> (eoDropFiles in FOptions);
FOptions := Value;
// (un)register HWND as drop target
if UpdateDropFiles and not (csDesigning in ComponentState) and HandleAllocated then
DragAcceptFiles(Handle, (eoDropFiles in fOptions));
{$ELSE}
FOptions := Value;
{$ENDIF}
end;
end;
procedure TKCustomHexEditor.SetReadOnly(Value: Boolean);
begin
if Value <> GetReadOnly then
begin
if Value then
Include(FStates, elReadOnly)
else
Exclude(FStates, elReadOnly);
end;
end;
procedure TKCustomHexEditor.SetScrollBars(Value: TScrollStyle);
begin
if Value <> FScrollBars then
begin
FScrollBars := Value;
{$IFDEF FPC}
UpdateSize;
{$ELSE}
RecreateWnd;
{$ENDIF}
end;
end;
procedure TKCustomHexEditor.SetScrollSpeed(Value: Cardinal);
begin
Value := MinMax(Integer(Value), cScrollSpeedMin, cScrollSpeedMax);
if Value <> FScrollSpeed then
begin
FScrollSpeed := Value;
FScrollTimer.Enabled := False;
FScrollTimer.Interval := FScrollSpeed;
end;
end;
procedure TKCustomHexEditor.SetSelEnd(Value: TKHexEditorSelection);
begin
if (Value.Index <> FSelEnd.Index) or (Value.Digit <> FSelEnd.Digit) then
begin
FSelEnd := Value;
SelectionChanged(False, False);
Invalidate;
end;
end;
procedure TKCustomHexEditor.SetSelLength(Value: TKHexEditorSelection);
var
X: TKHexEditorSelection;
begin
X := GetSelLength;
if (Value.Index <> X.Index) or (Value.Digit <> X.Digit) then
begin
FSelEnd.Index := FSelStart.Index + Value.Index;
FSelEnd.Digit := FSelStart.Digit + Value.Digit;
if FSelEnd.Digit >= cDigitCount then
Inc(FSelEnd.Index);
SelectionChanged(False, False);
Invalidate;
end;
end;
procedure TKCustomHexEditor.SetSelStart(Value: TKHexEditorSelection);
begin
if (Value.Index <> FSelStart.Index) or (Value.Digit <> FSelStart.Digit) then
begin
FSelStart := Value;
SelectionChanged(False, False);
Invalidate;
end;
end;
procedure TKCustomHexEditor.SetTopLine(Value: Integer);
begin
Value := MinMax(Value, 0, GetMaxTopLine);
if Value <> FTopLine then
ScrollBy(0, Value - FTopLine, True);
end;
procedure TKCustomHexEditor.SetUndoLimit(Value: Integer);
begin
Value := MinMax(Value, cUndoLimitMin, cUndoLimitMax);
if Value <> FUndoList.Limit then
begin
FUndoList.Limit := Value;
FRedoList.Limit := Value;
end;
end;
procedure TKCustomHexEditor.HideEditorCaret;
var
P: TPoint;
begin
P := SelToPoint(FSelEnd, FEditArea);
HideCaret(Handle);
{$IFDEF FPC}SetCaretPosEx(Handle,{$ELSE}SetCaretPos({$ENDIF} P.X, P.Y + 1);
end;
procedure TKCustomHexEditor.ShowEditorCaret;
var
P: TPoint;
begin
P := SelToPoint(FSelEnd, FEditArea);
{$IFDEF FPC}SetCaretPosEx(Handle,{$ELSE}SetCaretPos({$ENDIF} P.X, P.Y + 1);
ShowCaret(Handle);
end;
procedure TKCustomHexEditor.UndoChange(Sender: TObject; ItemReason: TKHexEditorChangeReason);
begin
if (Sender = FUndoList) and (ItemReason <> crCaretPos) then
DoChange;
end;
procedure TKCustomHexEditor.UpdateEditorCaret(Recreate: Boolean = False);
var
CW, CH: Integer;
begin
Include(FStates, elCaretUpdate);
try
if Enabled and Focused and (FEditArea in [eaDigits, eaText]) and not (csDesigning in ComponentState) then
begin
if not (elCaretVisible in FStates) or Recreate then
begin
if elOverwrite in FStates then
CW := FCharWidth
else
CW := Max(2, (Abs(Font.Height) * 2) div 25);
if edHorzLines in FDrawStyles then
CH := FCharHeight - Max(1, FCharHeight div 25)
else
CH := FCharHeight;
{$IFDEF FPC}
CreateCaret(Handle, 0, CW, CH - 2);
{$ELSE}
if CreateCaret(Handle, 0, CW, CH - 2) then
{$ENDIF}
Include(FStates, elCaretVisible);
Invalidate;
end;
if elCaretVisible in FStates then
ShowEditorCaret;
end else
begin
Exclude(FStates, elCaretVisible);
HideEditorCaret;
{$IFDEF FPC}
DestroyCaret(Handle);
{$ELSE}
DestroyCaret;
{$ENDIF}
end;
finally
Exclude(FStates, elCaretUpdate);
end;
end;
procedure TKCustomHexEditor.UpdateCharMetrics;
var
DC: HDC;
TM: TTextMetric;
begin
DC := GetDC(0);
try
SelectObject(DC, Font.Handle);
GetTextMetrics(DC, TM);
FTotalCharSpacing := FCharSpacing * 2;
// ensure even char spacing because of PointToSel
if TM.tmAveCharWidth and 1 <> 0 then
Inc(FTotalCharSpacing);
FCharWidth := TM.tmAveCharWidth + FTotalCharSpacing;
FCharHeight := TM.tmHeight * FLineHeightPercent div 100;
finally
ReleaseDC(0, DC);
end;
end;
procedure TKCustomHexEditor.UpdateMouseCursor;
var
P: TPoint;
begin
P := ScreenToClient(Mouse.CursorPos);
SetMouseCursor(P.X, P.Y);
end;
procedure TKCustomHexEditor.UpdateScrollRange;
var
I: Integer;
AD: TKHexEditorAreaDimensions;
SI: TScrollInfo;
begin
if HandleAllocated then
begin
AD := GetAreaDimensions;
// update horizontal scroll position
I := FLeftChar - GetMaxLeftChar(AD.TotalHorz);
if I > 0 then
Dec(FLeftChar, I);
FLeftChar := Max(FLeftChar, 0);
// update vertical scroll position
I := FTopLine - GetMaxTopLine(AD.TotalVert);
if I > 0 then
Dec(FTopLine, I);
FTopLine := Max(FTopLine, 0);
if FScrollBars in [ssBoth, ssHorizontal, ssVertical] then
begin
SI.cbSize := SizeOf(TScrollInfo);
SI.fMask := SIF_RANGE or SIF_PAGE or SIF_POS {$IFDEF UNIX}or SIF_UPDATEPOLICY{$ENDIF};
SI.nMin := 0;
{$IFDEF UNIX}
SI.ntrackPos := SB_POLICY_CONTINUOUS;
{$ENDIF}
if FScrollBars in [ssBoth, ssHorizontal] then
begin
SI.nMax := AD.TotalHorz{$IFNDEF FPC}- 1{$ENDIF};
SI.nPage := GetClientWidthChars;
SI.nPos := FLeftChar;
SetScrollInfo(Handle, SB_HORZ, SI, True);
ShowScrollBar(Handle, SB_HORZ, Integer(SI.nPage) < AD.TotalHorz);
end else
ShowScrollBar(Handle, SB_HORZ, False);
if FScrollBars in [ssBoth, ssVertical] then
begin
SI.nMax := AD.TotalVert{$IFNDEF FPC}- 1{$ENDIF};
SI.nPage := GetClientHeightChars;
SI.nPos := FTopLine;
SetScrollInfo(Handle, SB_VERT, SI, True);
ShowScrollBar(Handle, SB_VERT, Integer(SI.nPage) < AD.TotalVert);
end else
ShowScrollBar(Handle, SB_VERT, False);
end;
UpdateEditorCaret(True);
Invalidate;
InvalidatePageSetup;
end;
end;
procedure TKCustomHexEditor.UpdateSelEnd(Point: TPoint; ClipToClient: Boolean);
var
R: TRect;
Sel: TKHexEditorSelection;
begin
if ClipToClient then
begin
R := GetModifiedClientRect;
Dec(R.Right, FCharWidth);
Dec(R.Bottom, FCharHeight);
if CanScroll(ecScrollLeft) and (Point.X < R.Left) then
Point.X := R.Left
else if CanScroll(ecScrollRight) and (Point.X > R.Right) then
Point.X := R.Right;
if CanScroll(ecScrollUp) and (Point.Y < R.Top) then
Point.Y := R.Top
else if CanScroll(ecScrollDown) and (Point.Y > R.Bottom) then
Point.Y := R.Bottom;
end;
Sel := PointToSel(Point, True, FEditArea);
if (Sel.Index <> cInvalidIndex) and
((Sel.Index <> FSelEnd.Index) or (Sel.Digit <> FSelEnd.Digit)) then
begin
FSelEnd := Sel;
UpdateEditorCaret;
Invalidate;
InvalidatePageSetup;
end;
end;
procedure TKCustomHexEditor.UpdateSize;
begin
UpdateScrollRange;
end;
procedure TKCustomHexEditor.ValidateSelection(var Value: TKHexEditorSelection; Area: TKHexEditorArea);
begin
if Area <> eaNone then
begin
Value.Index := MinMax(Value.Index, 0, FSize);
if Value.Index = FSize then
Value.Digit := 0
else
Value.Digit := MinMax(Value.Digit, 0, cDigitCount - 1);
end else
Value := MakeSelection(cInvalidIndex, 0);
end;
{$IFNDEF FPC}
procedure TKCustomHexEditor.WMDropFiles(var Msg: TLMessage);
var
I, FileCount: Integer;
PathName: array[0..260] of Char;
Point: TPoint;
FilesList: TStringList;
begin
try
if Assigned(FOnDropFiles) then
begin
FilesList := TStringList.Create;
try
FileCount := DragQueryFile(THandle(Msg.wParam), Cardinal(-1), nil, 0);
DragQueryPoint(THandle(Msg.wParam), Point);
for i := 0 to FileCount - 1 do
begin
DragQueryFile(THandle(Msg.wParam), I, PathName, SizeOf(PathName));
FilesList.Add(PathName);
end;
FOnDropFiles(Self, Point.X, Point.Y, FilesList);
finally
FilesList.Free;
end;
end;
finally
Msg.Result := 0;
DragFinish(THandle(Msg.wParam));
end;
end;
{$ENDIF}
procedure TKCustomHexEditor.WMEraseBkgnd(var Msg: TLMessage);
begin
Msg.Result := 1;
end;
procedure TKCustomHexEditor.WMGetDlgCode(var Msg: TLMNoParams);
begin
Msg.Result := DLGC_WANTARROWS;
end;
procedure TKCustomHexEditor.WMHScroll(var Msg: TLMHScroll);
begin
SafeSetFocus;
ModifyScrollBar(SB_HORZ, Msg.ScrollCode, Msg.Pos, True);
end;
procedure TKCustomHexEditor.WMKillFocus(var Msg: TLMKillFocus);
begin
inherited;
ExecuteCommand(ecLostFocus);
end;
procedure TKCustomHexEditor.WMSetFocus(var Msg: TLMSetFocus);
begin
inherited;
ExecuteCommand(ecGotFocus);
end;
procedure TKCustomHexEditor.WMVScroll(var Msg: TLMVScroll);
begin
SafeSetFocus;
ModifyScrollBar(SB_VERT, Msg.ScrollCode, Msg.Pos, True);
end;
function GetColorSpec(Index: TKHexEditorColorIndex): TKHexEditorColorSpec;
begin
case Index of
ciAddressText: begin Result.Def := cAddressTextDef; Result.Name := sAddressText; end;
ciAddressBkGnd: begin Result.Def := cAddressBkgndDef; Result.Name := sAddressBkGnd; end;
ciBkGnd: begin Result.Def := cBkGndDef; Result.Name := sBkGnd; end;
ciDigitTextEven: begin Result.Def := cDigitTextEvenDef; Result.Name := sDigitTextEven; end;
ciDigitTextOdd: begin Result.Def := cDigitTextOddDef; Result.Name := sDigitTextOdd; end;
ciDigitBkGnd: begin Result.Def := cDigitBkGndDef; Result.Name := sDigitBkgnd; end;
ciHorzLines: begin Result.Def := cHorzLinesDef; Result.Name := sHorzLines; end;
ciInactiveCaretBkGnd: begin Result.Def := cInactiveCaretBkGndDef; Result.Name := sInactiveCaretBkGnd; end;
ciInactiveCaretSelBkGnd: begin Result.Def := cInactiveCaretSelBkGndDef; Result.Name := sInactiveCaretSelBkGnd; end;
ciInactiveCaretSelText: begin Result.Def := cInactiveCaretSelTextDef; Result.Name := sInactiveCaretSelText; end;
ciInactiveCaretText: begin Result.Def := cInactiveCaretTextDef; Result.Name := sInactiveCaretText; end;
ciLinesHighLight: begin Result.Def := cLinesHighLightDef; Result.Name := sLinesHighLight; end;
ciSelBkGnd: begin Result.Def := cSelBkGndDef; Result.Name := sSelBkGnd; end;
ciSelBkGndFocused: begin Result.Def := cSelBkGndFocusedDef; Result.Name := sSelBkGndFocused; end;
ciSelText: begin Result.Def := cSelTextDef; Result.Name := sSelText; end;
ciSelTextFocused: begin Result.Def := cSelTextFocusedDef; Result.Name := sSelTextFocused; end;
ciSeparators: begin Result.Def := cSeparatorsDef; Result.Name := sSeparators; end;
ciTextText: begin Result.Def := cTextTextDef; Result.Name := sTextText; end;
ciTextBkGnd: begin Result.Def := cTextBkgndDef; Result.Name := sTextBkGnd; end;
ciVertLines: begin Result.Def := cVertLinesDef; Result.Name := sVertLines; end;
else
Result.Def := clNone;
Result.Name := '';
end;
end;
end.