umain.pas

16进制HEX编辑器DELPHI控件源码。

  LIntProgress: Integer;
  LRctTemp: TRect;
begin
  if Panel.Index = 7 then
  begin
    LIntProgress := StrToIntDef(Panel.Text, -1);
    if LIntProgress > -1 then
    begin
      if LIntProgress = 100
      then
        Panel.Text := '-' // progressing finished
      else
      begin
        // fill percentag of rect
        LRctTemp := Rect;
        InflateRect(LRctTemp,-2,-2);
        with StatusBar.Canvas do
        begin
          Frame3D(StatusBar.Canvas, LRctTemp, clBtnShadow, clBtnHighlight, 1);
          //InflateRect(LRctTemp,-1,-1);
          with LRctTemp
          do
            Right := Left+Round((Right - Left) / 100 * LIntProgress);
          Brush.Color := clActiveCaption;
          FillRect(LRctTemp);
        end;
      end;
    end;
  end;
end;

procedure TfmMain.acFileSaveExecute(Sender: TObject);
begin
  SaveFile(False);
end;

procedure TfmMain.acFileSaveAsExecute(Sender: TObject);
begin
  SaveFile(True);
end;

procedure TfmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  // eventually save modified file
  CanClose := CheckChanges;
  SaveBookmarks;
  if CanClose
  then
    SaveEditorProps;
end;

procedure TfmMain.acFileExitExecute(Sender: TObject);
begin
  Close;
end;

procedure TfmMain.acEditUndoExecute(Sender: TObject);
begin
  MPHexEditorEx1.Undo;
end;

procedure TfmMain.acEditRedoExecute(Sender: TObject);
begin
  MPHexEditorEx1.Redo;
end;

procedure TfmMain.acEditCopyExecute(Sender: TObject);
begin
  MPHexEditorEx1.CBCopy;
end;

procedure TfmMain.acEditCutExecute(Sender: TObject);
begin
  MPHexEditorEx1.CBCut;
end;

procedure TfmMain.acEditPasteExecute(Sender: TObject);
begin
  MPHexEditorEx1.CBPaste;
end;

procedure TfmMain.acEditSelectAllExecute(Sender: TObject);
begin
  MPHexEditorEx1.SelectAll;
end;

procedure TfmMain.acEditInsertNibbleExecute(Sender: TObject);
begin
  with MPHexEditorEx1
  do
    InsertNibble(GetCursorPos, InCharField or ((Col mod 2) = 0));
end;

procedure TfmMain.acEditDeleteNibbleExecute(Sender: TObject);
begin
  with MPHexEditorEx1
  do
    DeleteNibble(GetCursorPos, InCharField or ((Col mod 2) = 0));
end;

procedure TfmMain.acEditFindExecute(Sender: TObject);
var
  LIntSize: Integer;
begin
  if FindGetOptions(FFindRec) then
  begin
    with FFindRec do
    begin
      if not BoolFindText then
      begin
        // convert hex data to string
        SetLength(StrData, Length(StrText));
        UniqueString(StrData);
        ConvertHexToBin(PChar(StrText), PChar(StrData), Length(StrText), MPHexEditorEx1.SwapNibbles, LIntSize);
        SetLength(StrData, LIntSize);
      end;
      if Length(StrData) > 0 then
      begin
        // start find
        acEditFindNext.Enabled := True;
        acEditFindNext.Execute;
      end;
    end;
  end;
end;

procedure TfmMain.acEditFindNextExecute(Sender: TObject);
var
  LIntFound,
    LIntPos: Integer;
  LStrFind: string;
begin
  with MPHexEditorEx1, FFindRec
  do
    if StrData <> '' then
    begin
      LIntPos := Max(0, GetCursorPos);
      if (Length(StrData) = 1) and ((SelCount) = 1)
      then
        Inc(LIntPos);
      if LIntPos >= DataSize
      then
        LIntFound := -1
      else
      begin
        LStrFind := PrepareFindReplaceData(StrData, BoolIgnoreCase, BoolFindText);
        if (Length(LStrFind) mod BytesPerUnit) <> 0 then
        begin
          MessageDlg(STR_ERR_BPU_FINDTEXT, mtError, [mbOK], 0);
          Exit;
        end;
        LIntFound := Find(PChar(LStrFind), Length(LStrFind), LIntPos, DataSize -1,
          BoolIgnoreCase);
      end;
      if LIntFound = -1
      then
        ShowMessage(STR_NOT_FOUND)
      else
      begin
        SelStart := LIntFound + Length(LStrFind)-1;
        SelEnd := LIntFound;
      end;
    end;
end;

procedure TfmMain.acEditConvertExecute(Sender: TObject);
var
  LEnumFrom,
  LEnumTo: TMPHTranslationKind;
  LIntStart,
  LIntEnd: Integer;
begin
  with MPHexEditorEx1 do
  begin
    LEnumFrom := Translation;
    LEnumTo := Translation;
    if SelectConvertTranslation(LEnumFrom, LEnumTo) and (LEnumFrom <> LEnumTo) then
    begin
      if SelCount > 0 then
      begin
        // just selection
        LIntStart := Min(SelStart, SelEnd);
        LIntEnd := Max(SelStart, SelEnd);
      end
      else
      begin
        // whole file
        LIntStart := 0;
        LIntEnd := Pred(DataSize);
      end;
      ConvertRange(LIntStart, LIntEnd, LEnumFrom, LEnumTo);
      if SelCount = 0
      then
        Translation := LEnumTo;
    end;
  end;
end;

procedure TfmMain.acViewTranslationEditCustomExecute(Sender: TObject);
begin
  with MPHexEditorEx1
  do
    if EditCustomTranslation and (Translation = tkCustom)
    then
      Repaint;
end;

procedure TfmMain.TranslationExecute(Sender: TObject);
begin
  with TAction(Sender)
  do
    MPHexEditorEx1.Translation := TMPHTranslationKind(Tag);
end;


procedure TfmMain.acEditReplaceExecute(Sender: TObject);
var
  LIntSize,
  LIntPos,
  LIntDone,
  LIntPos2: Integer;

  LStrFind,
    LStrReplace: string;
begin
  if ReplaceGetOptions(FReplaceRec)
  then
    with MPHexEditorEx1, FReplaceRec do
    try
      if not BoolFindText then
      begin
        // convert hex data to string
        SetLength(StrDataToFind, Length(StrTextToFind));
        UniqueString(StrDataToFind);
        ConvertHexToBin(PChar(StrTextToFind), PChar(StrDataToFind),
          Length(StrTextToFind), SwapNibbles, LIntSize);
        SetLength(StrDataToFind, LIntSize);
      end;
      UniqueString(StrDataToReplace);
      if (not BoolReplaceText) and (StrTextToReplace <> '') then
      begin
        // convert hex data to string
        SetLength(StrDataToReplace, Length(StrTextToReplace));
        ConvertHexToBin(PChar(StrTextToReplace), PChar(StrDataToReplace),
          Length(StrTextToReplace), SwapNibbles, LIntSize);
        SetLength(StrDataToReplace, LIntSize);
      end;

      LStrFind := PrepareFindReplaceData(StrDataToFind, BoolIgnoreCase, BoolFindText);
      LStrReplace := PrepareFindReplaceData(StrDataToReplace, False, BoolReplaceText);

      if BoolReplaceAll
      then
        LIntPos := 0
      else
        LIntPos := Max(0, GetCursorPos);

      LIntDone := 0;

      // check length of data to find and data to replace depending on bytesperunit
      if (Length(LStrFind) mod BytesPerUnit) <> 0 then
      begin
        MessageDlg(STR_ERR_BPU_FINDTEXT, mtError, [mbOK], 0);
        Exit;
      end;

      if (Length(LStrReplace) mod BytesPerUnit) <> 0 then
      begin
        MessageDlg(STR_ERR_BPU_REPLACETEXT, mtError, [mbOK], 0);
        Exit;
      end;

      repeat
        LIntPos2 := Find(PChar(LStrFind), Length(LStrFind), LIntPos, DataSize -1,
          BoolIgnoreCase);
        if LIntPos2 = -1
        then
          Break;
        Inc(LIntDone);
        SelStart := LIntPos2;
        SelEnd := LIntPos2 + Length(LStrFind)-1;
        if LStrReplace <> ''
        then
          ReplaceSelection(PChar(LStrReplace), Length(LStrReplace), '', False)
        else
          DeleteSelection;
        LIntPos := LIntPos2 + Length(LStrReplace);

        with StatusBar1 do
        begin
          Panels[7].Text := IntToStr(Round(LIntPos2/DataSize*100));
          Update;
        end;
      until not BoolReplaceAll;

      if LIntDone = 0
      then
        Raise Exception.Create(STR_NOT_FOUND)
      else
        if BoolReplaceAll
        then
          ShowMessage(Format(STR_NUM_REPLACED,[LIntDone]));
    finally
      StatusBar1.Panels[7].Text := '-';
    end;
end;

procedure TfmMain.acFilePrintSetupExecute(Sender: TObject);
begin
  PrinterSetupDialog1.Execute;
end;

procedure TfmMain.acFilePrintExecute(Sender: TObject);
begin
  PrintPreview(MPHexEditorEx1, acFilePrintSetup, False);
end;

procedure TfmMain.acViewOffsetEditFormatExecute(Sender: TObject);
var
  LStrPrefix: string;
begin
  with MPHexEditorEx1 do
  begin
    LStrPrefix := OffsetFormat;
    if InputQuery(STR_QT_OFFSETPREFIX, STR_Q_OFFSETPREFIX, LStrPrefix)
    then
      OffsetFormat := LStrPrefix;
  end;
end;

procedure TfmMain.acViewOffsetHexExecute(Sender: TObject);
begin
  MPHexEditorEx1.OffsetFormat := MPHOffsetHex;
  MPHexEditorEx1.RulerNumberBase := 16;
end;

procedure TfmMain.acViewOffsetDecExecute(Sender: TObject);
begin
  MPHexEditorEx1.OffsetFormat := MPHOffsetDec;
  MPHexEditorEx1.RulerNumberBase := 10;
end;

procedure TfmMain.acViewOffsetOctExecute(Sender: TObject);
begin
  MPHexEditorEx1.OffsetFormat := MPHOffsetOct;
  MPHexEditorEx1.RulerNumberBase := 8;
end;

procedure TfmMain.LoadBookmarks;
begin
  with MPHexEditorEx1
  do
    if HasFile
    then
      BookMarksAsString := FIni.ReadString(STR_INI_BOOKMARKS, FileName, '')
end;

procedure TfmMain.SaveBookmarks;
begin
  with MPHexEditorEx1
  do
    if HasFile then
    begin
      if BookmarksAsString = ''
      then
        FIni.DeleteKey(STR_INI_BOOKMARKS, FileName)
      else
        FIni.WriteString(STR_INI_BOOKMARKS, FileName, BookmarksAsString)
    end;
end;

procedure TfmMain.acViewBytesPerRowExecute(Sender: TObject);
var
  LIntVal: Integer;
begin
  with MPHexEditorEx1 do
  begin
    LIntVal := BytesPerRow;
    if InputNumber(STR_INP_BPR,LIntVal, 0, 255) then
    begin
      if LIntVal = 0 then
        AutoBytesPerRow := True
      else
      begin
        AutoBytesPerRow := False;
        BytesPerRow := LIntVal
      end;
    end;
  end;
end;

procedure TfmMain.acViewBytesPerColumnExecute(Sender: TObject);
var
  LIntVal: Integer;
begin
  with MPHexEditorEx1 do
  begin
    LIntVal := BytesPerColumn;
    if InputNumber(STR_INP_BPC,LIntVal, 1, 255)
    then
      BytesPerColumn := LIntVal
  end;
end;

procedure TfmMain.acEditGotoExecute(Sender: TObject);
var
  LChrRel: Char;
  LIntPos: Integer;
  LStrTemp: string;
begin
  with MPHexEditorEx1
  do
    if InputQuery(STR_QT_GOTO, STR_Q_GOTO, FGoto) and (FGoto <> '') then
    begin
      LChrRel := #0;
      LStrTemp := FGoto;
      if LStrTemp[1] in ['-','+','!'] then
      begin
        LChrRel := LStrTemp[1];
        Delete(LStrTemp,1,1);
      end;
      LIntPos := CheckRadixToInt(LStrTemp);
      case LChrRel of
        '-': Seek(-LIntPos, soFromCurrent);
        '+': Seek(LIntPos, soFromCurrent);
        '!': Seek(-LIntPos, soFromEnd);
      else
        Seek(LIntPos, soFromBeginning);
      end;
    end;
end;



procedure TfmMain.FormDestroy(Sender: TObject);
begin
  FIni.UpdateFile;
  FIni.Free;
end;

procedure TfmMain.LoadEditorProps;
var
  LsrlData: TStrings;
begin
  LsrlData := TStringList.Create;
  try
    FIni.ReadSectionValues(STR_INI_EDITOR, LsrlData);
    if LsrlData.Count > 1 then
    try
      MPHexEditorEx1.PropertiesAsString := LsrlData.Text;
    except
    end;
  finally
    LsrlData.Free;
  end;
end;

procedure TfmMain.SaveEditorProps;
var
  LsrlData: TStrings;
  LIntPos: Integer;
begin
  LsrlData := TStringList.Create;
  try
    FIni.EraseSection(STR_INI_EDITOR);
    with LsrlData do
    begin
      Text := MPHexEditorEx1.PropertiesAsString;
      if Count > 0
      then
        for LIntPos := 0 to Pred(Count)
        do
          FIni.WriteString(STR_INI_EDITOR, Names[LIntPos], Values[Names[LIntPos]]);
    end;
  finally
    LsrlData.Free;
  end;
end;

procedure TfmMain.acViewReadOnlyViewExecute(Sender: TObject);
begin
  with MPHexEditorEx1
  do
    ReadOnlyView := not ReadOnlyView;
end;

procedure TfmMain.acViewOptionsExecute(Sender: TObject);
var
  LStrOptions: string;
begin
  with MPHexEditorEx1 do
  begin
    LStrOptions := PropertiesAsString;
    if EditEditorOptions(LStrOptions)
    then
      PropertiesAsString := LStrOptions;
  end;
end;

procedure TfmMain.acViewBytesPerUnitExecute(Sender: TObject);
var
  LIntVal: Integer;
begin
  with MPHexEditorEx1 do
  begin
    LIntVal := BytesPerUnit;
    if InputNumber(STR_INP_BPU,LIntVal, 1, 8)
    then
      BytesPerUnit := LIntVal
  end;
end;

procedure TfmMain.AboutTMPHexEditor1Click(Sender: TObject);
begin
  MessageDlg('TMPHexEditor version:'#13#10+MPHexEditorEx1.Version, mtInformation,[mbOK],0);
end;

procedure TfmMain.acViewUnicodeExecute(Sender: TObject);
begin
  with MPHexEditorEx1 do
    UnicodeChars := not UnicodeChars;
end;

procedure TfmMain.acViewUnicodeBEExecute(Sender: TObject);
begin
  with MPHexEditorEx1 do
    UnicodeBigEndian := not UnicodeBigEndian;
end;


procedure TfmMain.acViewBytesPerBlockExecute(Sender: TObject);
var
  LIntVal: Integer;
begin
  with MPHexEditorEx1 do
  begin
    LIntVal := BytesPerBlock;
    if InputNumber(STR_INP_BPB,LIntVal, -1, BytesPerRow)
    then
      BytesPerBlock := LIntVal
  end;
end;

end.