hexedit.pas

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

function TCustomHexEdit.GetHexAreaLeft: Integer;
begin
  Result := GetAddrAreaLeft + FCharWidth * 10;
end;

function TCustomHexEdit.GetChrAreaLeft: Integer;
begin
  Result := GetHexAreaLeft + FCharWidth * 48;
end;

function TCustomHexEdit.GetCharAttrByRowCol(AbsRow, Col: Integer; CurInHex: Boolean): TCharAttr;
var
  Offset: Integer;
begin
  if FSelection.Active then
  begin
    Offset := GetOffset(AbsRow, Col);
    if (Offset >= FSelection.StartOffset) and (Offset <= FSelection.EndOffset) then
      Result := FColors.SelectionColor
    else
      Result := FColors.HexColor;
  end else
  begin
    if CurInHex then Result := FColors.HexColor
    else Result := FColors.CharColor;
  end;
end;

function TCustomHexEdit.GetOffsetByMove(DLenOffset: Integer): Integer;
var
  DLen, AbsRow, Col: Integer;
  CurInHigh: Boolean;
begin
  PosToDLen(DLen, FCurRow, FCurCol, FCurInHigh);
  DLen := DLen + DLenOffset;
  if DLen < 1 then DLen := 1
  else if DLen > GetDataSize * 2 then DLen := GetDataSize * 2;
  DLenToPos(AbsRow, Col, CurInHigh, DLen);
  Result := AbsRow * 16 + Col;
end;

function TCustomHexEdit.GetOffsetByMoveTo(DLen: Integer): Integer;
var
  AbsRow, Col: Integer;
  CurInHigh: Boolean;
begin
  if DLen < 1 then DLen := 1
  else if DLen > GetDataSize * 2 then DLen := GetDataSize * 2;
  DLenToPos(AbsRow, Col, CurInHigh, DLen);
  Result := AbsRow * 16 + Col;
end;

function TCustomHexEdit.GetHexAreaStr(AbsRow: Integer): string;
var
  S: string;
  RowPointer: PChar;
  I, ColCount: Integer;
begin
  RowPointer := GetRowPointer(AbsRow);
  S := '';

  if (AbsRow < FRowCount -1) then
    ColCount := 16
  else begin
    if (GetDataSize mod 16 > 0) then ColCount := GetDataSize mod 16
    else ColCount := 16;
  end;

  for I := 0 to ColCount - 1 do
  begin
    S := S + IntToHex(Integer(RowPointer^), 2);
    if I <> 7 then S := S + ' '
    else S := S + '-';
    Inc(RowPointer);
  end;
  for I := ColCount to 15 do
    S := S + '   ';
  Result := S;
end;

function TCustomHexEdit.GetChrAreaStr(AbsRow: Integer): string;
var
  S: string;
  RowPointer: PChar;
  I, ColCount: Integer;
begin
  RowPointer := GetRowPointer(AbsRow);
  S := '';

  if (AbsRow < FRowCount -1) then
    ColCount := 16
  else begin
    if (GetDataSize mod 16 > 0) then ColCount := GetDataSize mod 16
    else ColCount := 16;
  end;

  for I := 0 to ColCount - 1 do
  begin
    S := S + RowPointer^;
    Inc(RowPointer);
  end;
  for I := ColCount to 15 do
    S := S + ' ';

  Result := S;
end;

function TCustomHexEdit.GetStrAtPos(Offset, Count: Integer; var S: string): Boolean;
begin
  SetString(S, GetDataAddr + Offset, Count);
  Result := True;
end;

function TCustomHexEdit.GetUndoLimit: Integer;
begin
  Result := FActsMgr.UndoLimit;
end;

function TCustomHexEdit.GetFont: TFont;
begin
  Result := inherited Font;
end;

function TCustomHexEdit.GetSelStart: Integer;
begin
  if FSelection.Active then
    Result := FSelection.StartOffset
  else
    Result := GetOffset;
end;

function TCustomHexEdit.GetSelLength: Integer;
begin
  if FSelection.Active then
  begin
    Result := FSelection.EndOffset - FSelection.StartOffset + 1;
    if Result < 0 then Result := -Result;
  end else
    Result := 0;
end;

function TCustomHexEdit.GetSelData: string;
begin
  if FSelection.Active then
  begin
    GetStrAtPos(FSelection.StartOffset, GetSelLength, Result);
  end else
  begin
    Result := '';
  end;
end;

procedure TCustomHexEdit.SetDataSize(Value: Integer);
var
  OldSize: Integer;
begin
  if GetDataSize <> Value then
  begin
    OldSize := FStream.Size;
    FStream.SetSize(Value);
    FillChar((PChar(FStream.Memory) + OldSize)^, Value - OldSize, 0);

    FRowCount := GetRowCount(GetDataSize);
    if FTopRow > FRowCount - FVisRowCount then
      FTopRow := FRowCount - FVisRowCount;
    if FTopRow < 0 then FTopRow := 0;

    UpdateVertScrollBar;
    FModified := True;
    DoResize;
    DoPaint;
    DoOnChange;
  end;
end;

procedure TCustomHexEdit.SetOffset(Value: Integer);
begin
  if (Value >= 0) and (Value < GetDataSize - 1) then
  begin
    MoveCaretTo(Value * 2 + 1);
    //CancelSelection(True);
  end;
end;

procedure TCustomHexEdit.SetTopRow(Value: Integer);
begin
  if FTopRow <> Value then
  begin
    if (Value >= 0) and (Value < FRowCount) then
    begin
      FTopRow := Value;
      DrawAllRow;
    end;
  end;
end;

procedure TCustomHexEdit.SetBorderStyle(Value: TBorderStyle);
begin
  if FBorderStyle <> Value then
  begin
    FBorderStyle := Value;
    RecreateWnd;
  end;
end;

procedure TCustomHexEdit.SetScrollBars(Value: TScrollStyle);
begin
  if FScrollBars <> Value then
  begin
    FScrollBars := Value;
    RecreateWnd;
    DoResize;
  end;
end;

procedure TCustomHexEdit.SetDrawCharStyle(Value: TDrawCharStyle);
begin
  if FDrawCharStyle <> Value then
  begin
    FDrawCharStyle := Value;
    DoPaint;
  end;
end;

procedure TCustomHexEdit.SetUndoLimit(Value: Integer);
begin
  if Value < 0 then Value := 0;
  if Value > MaxUndoLimit then Value := MaxUndoLimit;

  if FActsMgr.UndoLimit <> Value then
    FActsMgr.UndoLimit := Value;
end;

procedure TCustomHexEdit.SetOptions(Value: THexEditOptions);
var
  Temp: THexEditOptions;
begin
  if FOptions <> Value then
  begin
    Temp := Value;
    if (hoEditing in Value) and not (hoEditing in FOptions) then
    begin
      Include(Temp, hoShowCaret);
      Include(Temp, hoEditing);
    end;
    if not (hoShowCaret in Value) and (hoShowCaret in FOptions) then
    begin
      Exclude(Temp, hoEditing);
      Exclude(Temp, hoShowCaret);
    end;
    FOptions := Temp;
  end;
end;

procedure TCustomHexEdit.SetFont(Value: TFont);
var
  T: TTextMetric;
begin
  { TODO : This does not work fine. }
  GetTextMetrics(Handle, T);
  if (T.tmPitchAndFamily and TMPF_FIXED_PITCH) > 0	then
    raise EHexEdit.Create(SHEFontPitchError);

  inherited Font := Value;
end;

procedure TCustomHexEdit.SetSelStart(Value: Integer);
begin
  CancelSelection(False);
  Offset := Value;
end;

procedure TCustomHexEdit.SetSelLength(Value: Integer);
begin
  if Value > 0 then
  begin
    SetSelection(GetOffset, GetOffset + Value - 1, True);
  end else
  begin
    if FSelection.Active then
      CancelSelection(True)
    else
      DoPaint;
  end;
end;

procedure TCustomHexEdit.SetSelData(const S: string);
var
  SelLen, NewLen, AOffset: Integer;
begin
  NewLen := Length(S);
  if FSelection.Active then
  begin
    SelLen := GetSelLength;
    AOffset := FSelection.StartOffset;
    CreateUndoForModify(AOffset, SelLen, NewLen);
    InternalModifyData(AOffset, SelLen, S);
    CreateRedoForModify(AOffset, SelLen, NewLen);
    if NewLen > 0 then
      SetSelection(AOffset, AOffset + NewLen - 1, True)
    else
      CancelSelection(True);
    MoveCaretTo(OffsetToDLen(AOffset));
  end else
  begin
    if NewLen > 0 then
    begin
      AOffset := GetOffset;
      CreateUndoForModify(AOffset, NewLen, NewLen);
      InternalModifyData(AOffset, S);
      CreateRedoForModify(AOffset, NewLen, NewLen);
      SetSelection(AOffset, AOffset + NewLen - 1, True);
    end;
  end;
end;

procedure TCustomHexEdit.DataLoaded;
begin
  FRowCount := GetRowCount(GetDataSize);
  FCurRow := 0;
  FCurCol := 0;
  FTopRow := 0;
  FLeftCol := 0;
  FCurInHex := True;
  FCurInHigh := True;
  UpdateVertScrollBar;
  UpdateHorzScrollBar;
  DoResize;
  DoPaint;
end;

procedure TCustomHexEdit.InitCharSize;
begin
  FCharWidth := Canvas.TextWidth('H');
  FCharHeight := Canvas.TextHeight('H');
end;

procedure TCustomHexEdit.InitFont;
var
  TempFont: TFont;
begin
  TempFont := TFont.Create;
  try
    with TempFont do
    begin
      Name := 'Fixedsys';
      Size := 12;
      Height := -16;
      Pitch := fpDefault;
      Style := [];
      Charset := DEFAULT_CHARSET;
      Color := clBlack;
    end;
    inherited Font := TempFont;
  finally
    TempFont.Free;
  end;
end;

procedure TCustomHexEdit.InitSearchOptions;
begin
  with SearchTextOptions do
  begin
    MatchCase := False;
    WholeWord := True;
    Unicode := False;
    OnlyBlock := False;
    UseWild := False;
    WildChar := '?';
    WildCount := 1;
  end;
  with SearchHexOptions do
  begin
    OnlyBlock := False;
    UseWild := False;
    WildChar := '?';
    WildCount := 1;
  end;
  with SearchIntOptions do
  begin
    OnlyBlock := False;
    IntegerType := itLongword;
  end;
  with SearchFloatOptions do
  begin
    FloatType := ftDouble;
    Blur := True;
    BlurValue := 0.001;
    OnlyBlock := False;
  end;
end;

function TCustomHexEdit.DLenToOffset(DLen: Integer): Integer;
var
  I: Integer;
begin
  if DLen > 0 then I := DLen - 1
  else I := DLen;
  Result := I div 2;
end;

function TCustomHexEdit.OffsetToDLen(AOffset: Integer): Integer;
begin
  Result := AOffset * 2 + 1;
end;

procedure TCustomHexEdit.PosToDLen(var DLen: Integer; AbsRow, Col: Integer; CurInHigh: Boolean);
begin
  DLen := (AbsRow * 16 + Col) * 2 + 1;
  if not CurInHigh then Inc(DLen);
end;

procedure TCustomHexEdit.DLenToPos(var AbsRow, Col: Integer; var CurInHigh: Boolean; DLen: Integer);
var
  Offset: Integer;
begin
  Offset := DLenToOffset(DLen);
  AbsRow := Offset div 16;
  Col := Offset mod 16;
  if (DLen mod 2) <> 0 then CurInHigh := True
  else CurInHigh := False;
end;

function  TCustomHexEdit.XYToRowCol(var OffRow, Col: Integer;
  var CurInHex, CurInHigh: Boolean; X, Y: Integer): Boolean;
var
  I: Integer;
  X1, Y1, X2, Y2: Integer;
  CharW, CharH: Integer;
  HexAreaLeft, ChrAreaLeft: Integer;
begin
  if IsEmpty then
  begin
    Result := False;
    Exit;
  end;

  CharW := FCharWidth;
  CharH := FCharHeight;
  HexAreaLeft := GetHexAreaLeft;
  ChrAreaLeft := GetChrAreaLeft;
  OffRow := -1;
  Col := -1;
  for I := 0 to FVisRowCount - 1 do
  begin
    Y1 := CharH * I;
    Y2 := Y1 + CharH;
    if (Y >= Y1) and (Y <= Y2) then OffRow := I;
  end;
  for I := 0 to 15 do
  begin
    X1 := HexAreaLeft + CharW * I * 3;
    X2 := X1 + CharW * 3;
    if (X >= X1) and (X <= X2) then
    begin
      Col := I;
      CurInHex := True;
      CurInHigh := (X <= X1 + CharW);
      Break;
    end;
    X1 := ChrAreaLeft + CharW * I;
    X2 := X1 + CharW;