hexedit.pas

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

    property ScrollBars;
    property TabStop default True;
    property Align;
    property Anchors;
    property BiDiMode;
    property Color;
    property Constraints;
    property Ctl3D;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Font;
    property ParentBiDiMode;
    property ParentColor default False;
    property ParentCtl3D;
    property ParentFont default False;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property Visible;

    property DrawCharStyle;
    property UndoLimit;
    property Colors;
    property Options;

    property OnChange;
    property OnSelectionChange;
    property OnCaretMove;

    property OnClick;
    property OnContextPopup;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnMouseWheelDown;
    property OnMouseWheelUp;
    property OnStartDock;
    property OnStartDrag;
  end;

var
  CF_HEXEDITDATA: Word;

function GetCharAttr(FColor, BColor: TColor): TCharAttr;

implementation

{ Misc routines }

function GetCharAttr(FColor, BColor: TColor): TCharAttr;
begin
  Result.FColor := FColor;
  Result.BColor := BColor;
end;

procedure SwapInt(var V1, V2: Integer);
var
  Temp: Integer;
begin
  Temp := V1;
  V1 := V2;
  V2 := Temp;
end;

function CharUpperCase(Ch: Char): Char;
begin
  if (Ch >= 'a') and (Ch <= 'z') then Dec(Ch, 32);
  Result := Ch;
end;

function IsHexChar(C: Char): Boolean;
begin
  Result := (C >= '0') and (C <= '9') or
            (C >= 'A') and (C <= 'F') or
            (C >= 'a') and (C <= 'f');
end;

function IsAlphaChar(C: Char): Boolean;
begin
  Result := (C >= 'A') and (C <= 'Z') or
            (C >= 'a') and (C <= 'z');
end;

function IsDigitChar(Ch: Char): Boolean;
begin
  Result := (Ch >= '0') and (Ch <= '9');
end;

function IsSpecChar(C: Char): Boolean;
begin
  Result := (Ord(C) < 32) or (Ord(C) > 126);
end;

function IsBorderChar(Ch: Char): Boolean;
begin
  Result := not IsAlphaChar(Ch) and not IsDigitChar(Ch);
end;

function IsHexStr(S: string): Boolean;
var
  I: Integer;
begin
  for I := 1 to Length(S) do
  begin
    if not IsHexChar(S[I]) then
    begin
      Result := False;
      Exit;
    end;
  end;
  Result := True;
end;

function StrToIntAsHex(var V: Cardinal; S: string): Boolean;
var
  I, J: Cardinal;
begin
  Result := IsHexStr(S);
  if not Result then Exit;

  V := 0;
  S := UpperCase(S);
  for I := 1 to Length(S) do
  begin
    if IsDigitChar(S[I]) then J := Ord(S[I]) - Ord('0')
    else J := Ord(S[I]) - Ord('A') + 10;
    V := (V shl 4) + J;
  end;
  Result := True;
end;

{ THexEditActsMgr }

constructor THexEditActsMgr.Create(AUndoLimit: Integer);
begin
  SetUndoLimit(AUndoLimit);
end;

destructor THexEditActsMgr.Destroy;
begin
  SetLength(FUndoActs, 0);
  SetLength(FRedoActs, 0);
end;

procedure THexEditActsMgr.SetUndoLimit(Value: Integer);
var
  I: Integer;
begin
  FUndoLimit := Value;
  SetLength(FUndoActs, FUndoLimit + 1);
  for I := 0 to FUndoLimit do
  begin
    if I = FUndoLimit then
      FUndoActs[I].Next := @FUndoActs[0]
    else
      FUndoActs[I].Next := @FUndoActs[I+1];
    if I = 0 then
      FUndoActs[I].Prev := @FUndoActs[FUndoLimit]
    else
      FUndoActs[I].Prev := @FUndoActs[I-1];
    FUndoActs[I].Enabled := False;
  end;
  FUndoHead := @FUndoActs[0];
  FUndoTail := @FUndoActs[0];

  SetLength(FRedoActs, FUndoLimit + 1);
  for I := 0 to FUndoLimit do
  begin
    if I = FUndoLimit then
      FRedoActs[I].Next := @FRedoActs[0]
    else
      FRedoActs[I].Next := @FRedoActs[I+1];
    if I = 0 then
      FRedoActs[I].Prev := @FRedoActs[FUndoLimit]
    else
      FRedoActs[I].Prev := @FRedoActs[I-1];
    FRedoActs[I].Enabled := False;
  end;
  FRedoHead := @FRedoActs[0];
  FRedoTail := @FRedoActs[0];
end;

procedure THexEditActsMgr.InitAct(var Act: THexEditAct);
begin
  with Act do
  begin
    Enabled := True;
    Buf := '';
    Offset := 0;
    Count := 0;
    CurPos := 0;
  end;
end;

function THexEditActsMgr.AddUndoItem: PHexEditAct;
begin
  InitAct(FUndoHead^);
  Result := FUndoHead;

  if FUndoHead^.Next = FUndoTail then
    FUndoTail := FUndoTail^.Next;
  FUndoHead := FUndoHead^.Next;
  FUndoHead^.Enabled := False;
end;

function THexEditActsMgr.AddRedoItem: PHexEditAct;
begin
  InitAct(FRedoHead^);
  Result := FRedoHead;

  if FRedoHead^.Next = FRedoTail then
    FRedoTail := FRedoTail^.Next;
  FRedoHead := FRedoHead^.Next;
  FRedoHead^.Enabled := False;
end;

function THexEditActsMgr.Undo: PHexEditAct;
begin
  if not CanUndo then
  begin
    Result := nil;
    Exit;
  end;
  FUndoHead := FUndoHead^.Prev;
  FRedoHead := FRedoHead^.Prev;
  Result := FUndoHead;
end;

function THexEditActsMgr.Redo: PHexEditAct;
begin
  if not CanRedo then
  begin
    Result := nil;
    Exit;
  end;
  Result := FRedoHead;
  FRedoHead := FRedoHead^.Next;
  FUndoHead := FUndoHead^.Next;
end;

function THexEditActsMgr.CanUndo: Boolean;
begin
  Result := (FUndoHead <> FUndoTail);
end;

function THexEditActsMgr.CanRedo: Boolean;
begin
  Result := FRedoHead^.Enabled;
end;

{ THexEditColors }

constructor THexEditColors.Create(AOwner: TCustomHexEdit);
begin
  inherited Create;
  FOwner := AOwner;

  FAddressColor := GetCharAttr(clBlue, clWhite);
  FHexColor := GetCharAttr(clBlack, clWhite);
  FCharColor := GetCharAttr(clBlack, clWhite);
  FCaretColor := GetCharAttr(clWhite, clBlue);
  FSelectionColor := GetCharAttr(clWhite, clNavy);
end;

destructor THexEditColors.Destroy;
begin
  inherited;
end;

function THexEditColors.GetAddressColor(const Index: Integer): TColor;
begin
  if Index = 0 then Result := FAddressColor.BColor
  else Result := FAddressColor.FColor;
end;

function THexEditColors.GetHexColor(const Index: Integer): TColor;
begin
  if Index = 0 then Result := FHexColor.BColor
  else Result := FHexColor.FColor;
end;

function THexEditColors.GetCharColor(const Index: Integer): TColor;
begin
  if Index = 0 then Result := FCharColor.BColor
  else Result := FCharColor.FColor;
end;

function THexEditColors.GetCaretColor(const Index: Integer): TColor;
begin
  if Index = 0 then Result := FCaretColor.BColor
  else Result := FCaretColor.FColor;
end;

function THexEditColors.GetSelectionColor(const Index: Integer): TColor;
begin
  if Index = 0 then Result := FSelectionColor.BColor
  else Result := FSelectionColor.FColor;
end;

procedure THexEditColors.SetAddressColor(const Index: Integer; const Value: TColor);
begin
  if Index = 0 then FAddressColor.BColor := Value
  else FAddressColor.FColor := Value;
  FOwner.DoPaint;
end;

procedure THexEditColors.SetHexColor(const Index: Integer; const Value: TColor);
begin
  if Index = 0 then FHexColor.BColor := Value
  else FHexColor.FColor := Value;
  FOwner.DoPaint;
end;

procedure THexEditColors.SetCharColor(const Index: Integer; const Value: TColor);
begin
  if Index = 0 then FCharColor.BColor := Value
  else FCharColor.FColor := Value;
  FOwner.DoPaint;
end;

procedure THexEditColors.SetCaretColor(const Index: Integer; const Value: TColor);
begin
  if Index = 0 then FCaretColor.BColor := Value
  else FCaretColor.FColor := Value;
  FOwner.DoPaint;
end;

procedure THexEditColors.SetSelectionColor(const Index: Integer; const Value: TColor);
begin
  if Index = 0 then FSelectionColor.BColor := Value
  else FSelectionColor.FColor := Value;
  FOwner.DoPaint;
end;

{ TCustomHexEdit }

constructor TCustomHexEdit.Create(AOwner: TComponent);
const
  EditStyle = [csClickEvents, csSetCaption, csCaptureMouse,
    csDoubleClicks, csFixedHeight];
var
  I: Integer;
begin
  inherited;
  InitSearchOptions;
  if NewStyleControls then
    ControlStyle := EditStyle else
    ControlStyle := EditStyle + [csFramed];
  FScrollBars := ssBoth;
  FBorderStyle := bsSingle;
  Color := clWindow;
  ParentColor := False;
  ParentFont := False;
  TabStop := True;
  Width := 195;
  Height := 90;

  FActsMgr := THexEditActsMgr.Create(DefUndoLimit);
  FStream := TMemoryStream.Create;
  CancelSelection(False);
  for I := 0 to BookmarkCount - 1 do
    FBookmark[I].Active := False;
  FRowCount := 0;
  FTopRow := 0;
  FLeftCol := 0;
  FCurRow := 0;
  FCurCol := 0;
  FVisRowCount := 0;
  FCurInHex := False;
  FCurInHigh := False;
  FCtrlKPressed := False;
  FCtrlQPressed := False;
  FModified := False;

  FColors := THexEditColors.Create(Self);
  FDrawCharStyle := dcDblByteChar;
  FMargin := 5;
  FOptions := [hoEditing, hoShowCaret, hoAutoHideSelection, hoAllowSelect];
end;

destructor TCustomHexEdit.Destroy;
begin
  FColors.Free;
  FActsMgr.Free;
  FStream.Free;
  inherited;
end;

function TCustomHexEdit.GetDataAddr: PChar;
begin
  Result := PChar(FStream.Memory);
end;

function TCustomHexEdit.GetDataSize: Integer;
begin
  Result := FStream.Size;
end;

function TCustomHexEdit.GetRowCount(Size: Integer): Integer;
begin
  Result := Size div 16;
  if Size mod 16 <> 0 then Inc(Result);
end;

function TCustomHexEdit.GetRowPointer(AbsRow: Integer): PChar;
begin
  Result := GetDataAddr + AbsRow * 16;
end;

function TCustomHexEdit.GetRowColPointer(AbsRow, Col: Integer): PChar;
begin
  Result := GetDataAddr + AbsRow * 16 + Col;
end;

function TCustomHexEdit.GetOffset(AbsRow, Col: Integer): Integer;
begin
  Result := AbsRow * 16 + Col;
end;

function TCustomHexEdit.GetOffset: Integer;
begin
  Result := FCurRow * 16 + FCurCol;
end;

function TCustomHexEdit.GetOffsetForProperty: Integer;
begin
  Result := GetOffset;
end;

function TCustomHexEdit.GetDLen(AbsRow, Col: Integer; CurInHigh: Boolean): Integer;
begin
  PosToDLen(Result, AbsRow, Col, CurInHigh);
end;

function TCustomHexEdit.GetDLen: Integer;
begin
  PosToDLen(Result, FCurRow, FCurCol, FCurInHigh);
end;

function TCustomHexEdit.GetRowTotalWidth: Integer;
begin
  Result := FCharWidth * 74 + FMargin * 2;
end;

function TCustomHexEdit.GetAddrAreaLeft: Integer;
begin
  Result := FMargin;
end;