unit main; //{$DEFINE DEBUG} interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, ExtCtrls, Grids, StdCtrls, ActnList, Dialogs, Buttons, ComCtrls, Menus, ImgList, Spin, ToolWin, myFileDialog, myLabel, // myNumEdit, myStream, myStaticText, myStringGrid, myGrid; const lciBIN_WIDTH = 16; //Byte type T_RowData = record // Data : PAnsiChar; iLength : Integer; iRow : Integer; //グリッドのRow iAddress : Int64; //開始バイト sAddrStr, //開始バイト 10進値文字列(3桁区切り入り) // sAddrHex, //開始バイト 16進値文字列 sDump, //16進ダンプ sAnsi : AnsiString; //Shift-JIS sUniLE, //Unicodeリトルエンディアン sUniBE, //Unicodeビッグエンディアン sUtf8 : WideString; //UTF-8 end; P_RowData = ^T_RowData; T_RowList = class(TObject) private F_slList : TList; F_Grid : TDrawGrid; function F_GetIndex (iRow : Integer) : Integer; // function F_GetData (iRow : Integer) : PAnsiChar; function F_GetLength (iRow : Integer) : Integer; function F_GetRow (iRow : Integer) : Integer; function F_GetAddress(iRow : Integer) : Int64; function F_GetAddrStr(iRow : Integer) : AnsiString; // function F_GetAddrHex(iRow : Integer) : AnsiString; function F_GetDump (iRow : Integer) : AnsiString; function F_GetAnsi (iRow : Integer) : AnsiString; function F_GetUniLE (iRow : Integer) : WideString; function F_GetUniBE (iRow : Integer) : WideString; function F_GetUtf8 (iRow : Integer) : WideString; public constructor Create(AGrid : TDrawGrid); destructor Destroy; override; procedure Clear; procedure SetItem(iRow : Integer; AStream : TMyFileStream); // property Data [iRow : Integer] : PAnsiChar read F_GetData; property iLength [iRow : Integer] : Integer read F_GetLength; property iRow [iRow : Integer] : Integer read F_GetRow; property iAddress[iRow : Integer] : Int64 read F_GetAddress; property sAddrStr[iRow : Integer] : AnsiString read F_GetAddrStr; // property sAddrHex[iRow : Integer] : AnsiString read F_GetAddrHex; property sDump [iRow : Integer] : AnsiString read F_GetDump; property sAnsi [iRow : Integer] : AnsiString read F_GetAnsi; property sUtf16LE[iRow : Integer] : WideString read F_GetUniLE; property sUtf16BE[iRow : Integer] : WideString read F_GetUniBE; property sUtf8 [iRow : Integer] : WideString read F_GetUtf8; end; {$R CustomFileDialog.RES} //brcc32 CustomFileDialog.RC type TApp_TOOLWBin = class(TForm) ActionList1: TActionList; actFile_Open: TAction; actFile_Close: TAction; actFile_Execute: TAction; actFile_SendTo: TAction; actFile_SendToShortFileName: TAction; actFile_Exit: TAction; actFind_Address: TAction; actFind_AddressGoTo: TAction; actFind_AddressDown: TAction; actFind_AddressUp: TAction; actFind_AddressInput: TAction; actEdit_CopyAddress: TAction; actEdit_PasteAddress: TAction; actEdit_BackAddress: TAction; actEdit_ClearAddress: TAction; actFind_DataInput: TAction; actFind_Addr16: TAction; actFind_Data: TAction; actFind_String: TAction; actFind_DataException: TAction; actFind_DataDown: TAction; actFind_DataUp: TAction; actFind_Cancel: TAction; actOpt_ScrollLikeListBox: TAction; actDisp_Value: TAction; actHelp_VersionInfo: TAction; MainMenu1: TMainMenu; mniFile: TMenuItem; mniFile_Open: TMenuItem; mniFile_Close: TMenuItem; mniFile_Line1: TMenuItem; mniFile_SendTo: TMenuItem; mniFile_Line2: TMenuItem; mniFile_Exit: TMenuItem; mniFind: TMenuItem; mniFind_AddressGoTo: TMenuItem; mniFind_AddressDown: TMenuItem; mniFind_AddressUp: TMenuItem; mniFind_AddressInput: TMenuItem; mniOpt: TMenuItem; mniOpt_Address: TMenuItem; mniHelp: TMenuItem; mniHelp_VersionInfo: TMenuItem; PopupMenu1: TPopupMenu; mniPFile_Open: TMenuItem; mniPFile_Close: TMenuItem; mniPLine1: TMenuItem; mniPFile_SendTo: TMenuItem; mniPLine2: TMenuItem; mniPOpt_Address: TMenuItem; mniPLine3: TMenuItem; mniPFile_Exit: TMenuItem; mnuFindAddres: TPopupMenu; mniPEdit_CopyAddress: TMenuItem; mniPEdit_PasteAddress: TMenuItem; mniPEdit_ClearAddress: TMenuItem; mniPEditAddress_Line1: TMenuItem; mniPFind_AddressInput: TMenuItem; mnuFind_Data: TPopupMenu; ToolBar1: TToolBar; btnToolFile_Open: TToolButton; btnToolFile_Close: TToolButton; btnToolFile_SendTo: TToolButton; btnSpc1: TToolButton; pnlFind_Address: TPanel; celFind_Address: TMyStringGrid; spnFind_Address: TSpinButton; btnToolFind_Address: TToolButton; btnToolFind_AddressDown: TToolButton; btnToolFind_AddressUp: TToolButton; btnToolFind_Addr10: TToolButton; btnSpc2: TToolButton; btnToolFind_DataDown: TToolButton; btnToolFind_DataUp: TToolButton; pnlFind_Data: TPanel; lstFind_Data: TComboBox; edtFind_String: TEdit; lblFind_Data: TLabel; pnlKey_Address: TPanel; shpKeyNum: TShape; btnKeyNum_0: TSpeedButton; btnKeyNum_1: TSpeedButton; btnKeyNum_2: TSpeedButton; btnKeyNum_3: TSpeedButton; btnKeyNum_4: TSpeedButton; btnKeyNum_5: TSpeedButton; btnKeyNum_6: TSpeedButton; btnKeyNum_7: TSpeedButton; btnKeyNum_8: TSpeedButton; btnKeyNum_9: TSpeedButton; btnKeyNum_A: TSpeedButton; btnKeyNum_B: TSpeedButton; btnKeyNum_C: TSpeedButton; btnKeyNum_D: TSpeedButton; btnKeyNum_E: TSpeedButton; btnKeyNum_F: TSpeedButton; btnKeyNum_BS: TSpeedButton; btnKeyNum_Close: TSpeedButton; btnKeyNum_Paste: TSpeedButton; btnKeyNum_Clear: TSpeedButton; pnlFileInfo: TPanel; lblFileName: TMyLabel; Shape1: TShape; ImageList1: TImageList; dlgOpenFile: TMyOpenFileDialog; dlgSendTo: TMyOpenFileDialog; pnlFileDialog_CustomBase: TPanel; chkFile_SendToShortFileName: TCheckBox; edtHelp: TMemo; mniFind_Line1: TMenuItem; mniFind_DataDwon: TMenuItem; mniFind_DataUp: TMenuItem; mniFind_Address: TMenuItem; mniPEdit_BackAddress: TMenuItem; mniPEditAddress_Line2: TMenuItem; mniPFind_AddressGoTo: TMenuItem; mniPFind_AddressDown: TMenuItem; mniPFind_AddressUp: TMenuItem; mniFind_Data: TMenuItem; mniFind_DataException: TMenuItem; mniFile_Execute: TMenuItem; mnuFind: TPopupMenu; mniFind_String: TMenuItem; mniFind_Line2: TMenuItem; mniOpt_Line1: TMenuItem; mniDisp_Value: TMenuItem; Timer1: TTimer; btnToolDisp_Value: TToolButton; btnSpc3: TToolButton; Splitter1: TSplitter; pnlBase: TPanel; celDisp: TDrawGrid; pnlStatus: TPanel; lblInfo_Address: TLabel; shpBorder: TShape; lblInfo_Synchsafe: TLabel; lblInfo_DWord: TLabel; lblInfo_Word: TLabel; lblInfo_Byte: TLabel; pnlFind_Progress: TPanel; lblFind_Progress: TLabel; ProgressBar1: TProgressBar; btnFind_Cancel: TButton; celValue: TStringGrid; Button1: TButton; procedure actNop (Sender: TObject); procedure actFile_OpenExecute (Sender: TObject); procedure actFile_CloseExecute (Sender: TObject); procedure actFile_SendToExecute (Sender: TObject); procedure actFile_ExecuteExecute (Sender: TObject); procedure actFile_ExitExecute (Sender: TObject); procedure actFind_DataInputExecute (Sender: TObject); procedure actEdit_CopyAddressExecute (Sender: TObject); procedure actEdit_PasteAddressExecute(Sender: TObject); procedure actEdit_ClearAddressExecute(Sender: TObject); procedure actEdit_BackAddressExecute (Sender: TObject); procedure actFind_AddressGoToExecute (Sender: TObject); procedure actFind_AddressInputExecute(Sender: TObject); procedure actFind_DataDownExecute (Sender: TObject); procedure actFind_DataUpExecute (Sender: TObject); procedure actFind_Addr16Execute (Sender: TObject); procedure actFind_AddressExecute (Sender: TObject); procedure actFind_DataExecute (Sender: TObject); procedure edtFind_StringChange (Sender: TObject); procedure actFind_CancelExecute (Sender: TObject); procedure actDisp_ValueExecute (Sender: TObject); procedure actHelp_VersionInfoExecute (Sender: TObject); procedure FormCreate (Sender: TObject); procedure FormDestroy(Sender: TObject); procedure FormResize (Sender: TObject); procedure PopupMenu1Popup (Sender: TObject); procedure celDispDrawCell (Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); procedure celDispTopLeftChanged(Sender: TObject); procedure celDispSelectCell (Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean); procedure celDispMouseDown (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure celDispMouseUp (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure celDispMouseWheelDown(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); procedure celDispMouseWheelUp (Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); procedure mnuFindAddresPopup (Sender: TObject); procedure spnFind_AddressDownClick (Sender: TObject); procedure spnFind_AddressUpClick (Sender: TObject); procedure edtFind_AddressEnter (Sender: TObject); procedure edtFind_AddressMouseDown (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure btnKeyNum_0Click (Sender: TObject); procedure btnKeyNum_CloseClick (Sender: TObject); procedure shpKeyNumMouseDown (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure celFind_AddressResize (Sender: TObject); procedure celFind_AddressKeyDown (Sender: TObject; var Key: Word; Shift: TShiftState); procedure celFind_AddressKeyUp (Sender: TObject; var Key: Word; Shift: TShiftState); procedure celFind_AddressMouseWheelDown(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); procedure celFind_AddressMouseWheelUp (Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); procedure celFind_AddressDrawCell (Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); procedure mniFind_DataClick (Sender: TObject); procedure lstFind_DataDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState); procedure Timer1Timer(Sender: TObject); private { Private 宣言 } F_sFileName : WideString; F_List : T_RowList; F_iFileSize : Int64; //ファイルサイズ F_iAddrWidth : Integer; F_iTopRow, F_iRowCount : Integer; F_bChanging, F_bMouseDown, F_bMouseWheel : Boolean; F_iColum : Longint; F_iCharWidth : Integer; // F_iDumpLine1, // F_iDumpLine2, // F_iDumpLine3 : Integer; F_fProgress : Single; F_bFindCancel : Boolean; procedure F_DumpData (iStart, iEnd : Integer); procedure F_DispInfo (iRow : Integer); procedure F_UpdateCell(iCol, iRow : Integer); procedure F_UpdateRow ( iRow : Integer); function F_IsNum(iCode : Word) : Boolean; function F_GetNumStr(iNum : Int64) : String; function F_GetNumInt(sNum : String) : Int64; function F_GetAddressNum(sNum : String; iInc : Integer = 0) : String; function F_GetNowAddress : Int64; procedure F_GoToAddress(iAddress : Int64); function F_FindDown(AStream : TStream; iStart : Int64; pData : PAnsiChar; iCount : Integer) : Int64; function F_FindUp (AStream : TStream; iStart : Int64; pData : PAnsiChar; iCount : Integer) : Int64; procedure WMDropFiles(var Msg : TWMDropFiles); message WM_DROPFILES; protected procedure WndProc(var Msg: TMessage); override; public { Public 宣言 } end; var App_TOOLWBin: TApp_TOOLWBin; implementation uses {$IFDEF DEBUG} myDebug, {$ENDIF} Clipbrd, ShellAPI, NkStream, myControl, myDragAndDrop, myFile, myHelpVersionInfo, myMessageBox, myNum, myParam, myString, myWindow, myWStrings, read_struct, read_value; {$R *.dfm} const lciCOL_ADDRESS = 0; lciCOL_DUMP = 1; //16進ダンプ lciCOL_ANSI = 2; //Shift-JIS lciCOL_UTF16LE = 3; //Unicode LE lciCOL_UTF16BE = 4; //Unicode BE lciCOL_UTF8 = 5; //UTF-8 const lcsTITLE : array[lciCOL_ADDRESS..lciCOL_UTF8] of AnsiString = ( 'ADDRESS', '+0 +1 +2 +3 +4 +5 +6 +7 +8 +9 +A +B +C +D +E +F', '0123456789ABCDEF', 'UTF-16LE', 'UTF-16BE', 'UTF-8' ); //値一覧 const lciVALUE_COL_DUMPLE = 1; lciVALUE_COL_VALUELE = 2; lciVALUE_COL_DUMPBE = 3; lciVALUE_COL_VALUEBE = 4; lciVALUE_BYTE = 1; lciVALUE_WORD = 2; lciVALUE_LONGWORD = 3; lciVALUE_SHORTINT = 4; lciVALUE_SMALLINT = 5; lciVALUE_LONGINT = 6; lciVALUE_INT64 = 7; lciVALUE_SYNCHSAFE = 8; const lciMARGIN = 2; //============================================================================== function lfnsAddrStrGet(iAddress : Int64) : AnsiString; var lf_Addr : Extended; begin lf_Addr := iAddress; Result := Format('%.0n', [lf_Addr]); end; function lfnsAddrHexGet(iAddress : Int64) : AnsiString; begin Result := Format('%x', [iAddress]); end; //------------------------------------------------------------------------------ {T_RowList} constructor T_RowList.Create(AGrid : TDrawGrid); begin inherited Create; F_Grid := AGrid; F_slList := TList.Create; end; destructor T_RowList.Destroy; begin Self.Clear; F_slList.Free; inherited; end; procedure T_RowList.Clear; var i : Integer; lp_Item : P_RowData; begin for i := F_slList.Count-1 downto 0 do begin if (F_slList.Items[i] <> nil) then begin lp_Item := P_RowData(F_slList.Items[i]); lp_Item.iLength := 0; lp_Item.iRow := -1; lp_Item.iAddress := -1; lp_Item.sAddrStr := ''; // lp_Item.sAddrHex := ''; lp_Item.sDump := ''; lp_Item.sAnsi := ''; lp_Item.sUniLE := ''; lp_Item.sUniBE := ''; lp_Item.sUtf8 := ''; Dispose(lp_Item); end; F_slList.Delete(i); end; F_slList.Clear; end; procedure T_RowList.SetItem(iRow : Integer; AStream : TMyFileStream); //procedure T_RowList.SetItem(iRow : Integer; hHandle : THandle); const lcs_CTRLCHAR = '.'; lcs_CONVERT : array[0..lciBIN_WIDTH -1] of AnsiChar = '0123456789ABCDEF'; var l_Data : array[0..lciBIN_WIDTH -1] of AnsiChar; li_Address : Int64; ls_Dump : array[0..(lciBIN_WIDTH * 3) -1 -1] of AnsiChar; //最後の半角スペースを削除する分で -1 ls_Utf8, ls_Ansi : array[0..lciBIN_WIDTH -1] of AnsiChar; ls_Utf16LE, ls_Utf16BE : array[0..lciBIN_WIDTH -1 +2] of AnsiChar; //後でWideStringでキャストして取り出せるように#0#0の分で+2 li_Byte : Byte; i, k, li_Read, li_Index, li_Colum : Integer; //Shift-JISの第2バイトの判定用 lb_SJISFlag : Boolean; //UTF-16BE用 lp_Endian : PWideChar; li_Len : Integer; lp_Item, l_RowData : P_RowData; begin //AIU if not(gfnbIsGridRowVisible(F_Grid, iRow)) then begin Exit; end; //まず処理したいデータがリスト中にあるか検索。 //あれば処理を抜ける。 for i := 0 to F_slList.Count-1 do begin l_RowData := P_RowData(F_slList.Items[i]); if (l_RowData.iRow = iRow) then begin Exit; end; end; //処理済データではなかったので処理に入る。 try // li_Address := 0; //2013-09-26:Int64でキャストしないと範囲外エラーになる li_Address := Int64((iRow - F_Grid.FixedRows)) * lciBIN_WIDTH; // li_Count := iRow - F_Grid.FixedRows; // li_Address := li_Count * lciBIN_WIDTH; FillChar(l_Data, SizeOf(l_Data), #0); AStream.Position := li_Address; li_Read := AStream.Read(l_Data, lciBIN_WIDTH); FillChar(ls_Dump, SizeOf(ls_Dump), #$20); FillChar(ls_Utf16LE, SizeOf(ls_Utf16LE), #0); FillChar(ls_Utf16BE, SizeOf(ls_Utf16BE), #0); Move(l_Data, ls_Ansi, lciBIN_WIDTH); Move(l_Data, ls_Utf8, lciBIN_WIDTH); Move(l_Data, ls_Utf16LE, lciBIN_WIDTH); Move(l_Data, ls_Utf16BE, lciBIN_WIDTH); lb_SJISFlag := False; li_Colum := 0; for k := 0 to li_Read -1 do begin Application.ProcessMessages; if (Application.Terminated) then begin Exit; end; //ダンプ ls_Dump[li_Colum] := lcs_CONVERT[Byte(l_Data[k]) shr 4]; Inc(li_Colum); ls_Dump[li_Colum] := lcs_CONVERT[Byte(l_Data[k]) and $F]; if (k = (lciBIN_WIDTH div 2) -1) then begin Inc(li_Colum); ls_Dump[li_Colum] := '-'; Inc(li_Colum); end else begin Inc(li_Colum, 2); end; //Shift-JISとUTF-8 li_Byte := Ord(l_Data[k]); //BOM if (li_Address = 0) then begin //UTF-8のBOM if ((li_Byte = $EF) and (k = 0)) or ((li_Byte = $BB) and (k = 1)) or ((li_Byte = $BF) and (k = 2)) then begin //BOMは'.'として表示 ls_Utf8[k] := lcs_CTRLCHAR; end; //UTF-16のBOM //$FF$FEもしくは$FE$FFを一文字の'.'として表示 if (k = 1) then begin if (l_Data[k -1] = #$FE) and (l_Data[k] = #$FF) then begin //ビッグエンディアンのBOM ls_Utf16BE[0] := #0; ls_Utf16BE[1] := lcs_CTRLCHAR; //#$2E; //'.' end else if (l_Data[k -1] = #$FF) and (l_Data[k] = #$FE) then begin //リトルエンディアンのBOM ls_Utf16LE[0] := lcs_CTRLCHAR; //#$2E; //'.' ls_Utf16LE[1] := #0; end; end; end; case li_Byte of $81..$9F, $E0..$EF : begin //Shift-JISの第1バイト if (k = li_Read -1) then begin ls_Ansi[k] := lcs_CTRLCHAR; lb_SJISFlag := False; end else if not(lb_SJISFlag) then begin lb_SJISFlag := True; end else begin lb_SJISFlag := False; end; end; else begin case li_Byte of $0..$1F, $7F : begin //制御コード //'.'として表示 ls_Ansi[k] := lcs_CTRLCHAR; ls_Utf8[k] := lcs_CTRLCHAR; //Unicode //制御コードを'.'(#$2E)に置き換える。 if (k mod 2 = 1) then begin //ビッグエンディアン if (l_Data[k -1] = #0) then begin ls_Utf16BE[k -1] := #0; ls_Utf16BE[k] := lcs_CTRLCHAR; //#$2E; //'.' end; end else if (k < li_Read) then begin //リトルエンディアン if (l_Data[k +1] = #0) then begin ls_Utf16LE[k +1] := #0; ls_Utf16LE[k] := lcs_CTRLCHAR; //#$2E; //'.' end; end; end; $FD..$FF : begin //Shift-JISの範囲外なので'.'として表示 ls_Ansi[k] := lcs_CTRLCHAR; end; $A1..$DF : begin //半角カタカナ //Shift-JISは第1バイト目でも第2バイト目でもOK end; $80, $A0, $F0..$FC : begin //Shift-JISの第2バイト if not(lb_SJISFlag) then begin //直前のバイトがShift-JISの第1バイトでないので'.'として表示 ls_Ansi[k] := lcs_CTRLCHAR; end; end; end; lb_SJISFlag := False; end; end; end; //リストにセット li_Index := -1; for i := 0 to F_slList.Count-1 do begin l_RowData := P_RowData(F_slList.Items[i]); if not(gfnbIsGridRowVisible(F_Grid, l_RowData.iRow)) then begin li_Index := i; Break; end; end; //li_Indexに有効な値(0以上)がセットされていれば上書き、-1ならば追加。 if (li_Index <= 0) then begin New(lp_Item); end else begin lp_Item := P_RowData(F_slList.Items[li_Index]); end; lp_Item.iLength := li_Read; // lp_Item.Data := l_Data; lp_Item.iRow := iRow; lp_Item.iAddress := li_Address; lp_Item.sAddrStr := lfnsAddrStrGet(li_Address); // lp_Item.sAddrHex := lfnsAddrHexGet(li_Address); lp_Item.sDump := ls_Dump; lp_Item.sAnsi := ls_Ansi; //UTF-16リトルエンディアン lp_Item.sUniLE := WideString(PWideChar(PAnsiChar(@ls_Utf16LE))); //UTF-16ビッグエンディアン li_Len := lciBIN_WIDTH; lp_Endian := AllocMem(li_Len +2); try LCMapStringW(GetUserDefaultLCID(), LCMAP_BYTEREV, PWideChar(PAnsiChar(@ls_Utf16BE)), -1, lp_Endian, li_Len); lp_Item.sUniBE := WideString(lp_Endian); finally FreeMem(lp_Endian); end; //UTF-8 lp_Item.sUtf8 := gfnsUtf8ToWide(ls_Utf8); if (li_Index <= 0) then begin F_slList.Add(lp_Item); end; except on E: Exception do begin gpcShowMessage(E.Message); end; end; end; function T_RowList.F_GetIndex(iRow : Integer) : Integer; var i : Integer; l_Item : P_RowData; begin for i := 0 to F_slList.Count-1 do begin l_Item := P_RowData(F_slList.Items[i]); if (l_Item.iRow = iRow) then begin Result := i; Exit; end; end; //本来ここに来ることはないはず Result := -1; end; { function T_RowList.F_GetData(iRow : Integer) : PAnsiChar; var li_Index : Integer; begin li_Index := F_GetIndex(iRow); if (li_Index >= 0) then begin Result := P_RowData(F_slList.Items[li_Index]).Data; end else begin Result := nil; end; end; } function T_RowList.F_GetLength(iRow : Integer) : Integer; var li_Index : Integer; begin li_Index := F_GetIndex(iRow); if (li_Index >= 0) then begin Result := P_RowData(F_slList.Items[li_Index]).iLength; end else begin Result := 0; end; end; function T_RowList.F_GetRow(iRow : Integer) : Integer; var li_Index : Integer; begin li_Index := F_GetIndex(iRow); if (li_Index >= 0) then begin Result := P_RowData(F_slList.Items[li_Index]).iRow; end else begin Result := -1; end; end; function T_RowList.F_GetAddress(iRow : Integer) : Int64; var li_Index : Integer; begin li_Index := F_GetIndex(iRow); if (li_Index >= 0) then begin Result := P_RowData(F_slList.Items[li_Index]).iAddress; end else begin Result := 0; end; end; function T_RowList.F_GetAddrStr(iRow : Integer) : AnsiString; var li_Index : Integer; begin li_Index := F_GetIndex(iRow); if (li_Index >= 0) then begin Result := P_RowData(F_slList.Items[li_Index]).sAddrStr; end else begin Result := ''; end; end; { function T_RowList.F_GetAddrHex(iRow : Integer) : AnsiString; var li_Index : Integer; begin li_Index := F_GetIndex(iRow); if (li_Index >= 0) then begin Result := P_RowData(F_slList.Items[li_Index]).sAddrHex; end else begin Result := ''; end; end; } function T_RowList.F_GetDump(iRow : Integer) : AnsiString; var li_Index : Integer; begin li_Index := F_GetIndex(iRow); if (li_Index >= 0) then begin Result := P_RowData(F_slList.Items[li_Index]).sDump; end else begin Result := ''; end; end; function T_RowList.F_GetAnsi(iRow : Integer) : AnsiString; var li_Index : Integer; begin li_Index := F_GetIndex(iRow); if (li_Index >= 0) then begin Result := P_RowData(F_slList.Items[li_Index]).sAnsi; end else begin Result := ''; end; end; function T_RowList.F_GetUniLE(iRow : Integer) : WideString; var li_Index : Integer; begin li_Index := F_GetIndex(iRow); if (li_Index >= 0) then begin Result := P_RowData(F_slList.Items[li_Index]).sUniLE; end else begin Result := ''; end; end; function T_RowList.F_GetUniBE(iRow : Integer) : WideString; var li_Index : Integer; begin li_Index := F_GetIndex(iRow); if (li_Index >= 0) then begin Result := P_RowData(F_slList.Items[li_Index]).sUniBE; end else begin Result := ''; end; end; function T_RowList.F_GetUtf8(iRow : Integer) : WideString; var li_Index : Integer; begin li_Index := F_GetIndex(iRow); if (li_Index >= 0) then begin Result := P_RowData(F_slList.Items[li_Index]).sUtf8; end else begin Result := ''; end; end; //------------------------------------------------------------------------------ function lfnsWideToAnsi(sStr: WideString): AnsiString; var li_Len : Integer; begin li_Len := Length(sStr) + 1; SetLength(Result, li_Len * 2); lstrcpynw(PWideChar(PAnsiChar(Result)), PWideChar(sStr), li_Len); end; function lfnsAnsiToWide(sStr: AnsiString): WideString; var lp_Src : PAnsiChar; lp_Wide : PWideChar absolute lp_Src; begin if (sStr <> '') then begin lp_Src := PAnsiChar(sStr); Result := WideString(lp_Wide); end else begin Result := ''; end; end; //ドラッグアンドドロップ procedure TApp_TOOLWBin.WMDropFiles(var Msg: TWMDROPFILES); var l_Drop: TMyDropFiles; begin l_Drop := TMyDropFiles.Create(Msg, Self); try dlgOpenFile.FileName := l_Drop.Files[0]; actFile_OpenExecute(nil); finally l_Drop.Free; end; end; procedure TApp_TOOLWBin.FormCreate(Sender: TObject); var i : Integer; l_MenuItem : TMenuItem; begin {$IFDEF DEBUG} myDebug.gpcExeMode; {$ENDIF} F_List := T_RowList.Create(celDisp); pnlBase.Align := alClient; F_iColum := -1; gpcGridInit(celDisp); with celDisp do begin Align := alClient; DefaultRowHeight := Trunc(Abs(Font.Height) * 1.5); ColWidths[lciCOL_DUMP] := gfniGridCanvasTextWidth(celDisp, 'FF ') * lciBIN_WIDTH + (lciMARGIN * 2); ColWidths[lciCOL_ANSI] := gfniGridCanvasTextWidth(celDisp, '0') * lciBIN_WIDTH + (lciMARGIN * 2); ColWidths[lciCOL_UTF16BE] := ColWidths[lciCOL_ANSI]; ColWidths[lciCOL_UTF16LE] := ColWidths[lciCOL_ANSI]; ColWidths[lciCOL_UTF8] := ColWidths[lciCOL_ANSI]; // F_iAddrWidth := 0; // actOpt_AddressExecute(nil); end; F_iCharWidth := gfniGridCanvasTextWidth(celDisp, 'A'); // F_iDumpLine1 := -(F_iCharWidth div 2) + (F_iCharWidth * 3) * 4; // F_iDumpLine2 := F_iDumpLine1 + (F_iCharWidth * 3) * 4; // F_iDumpLine3 := F_iDumpLine2 + (F_iCharWidth * 3) * 4; Button1.Parent := celDisp; Button1.Left := (celDisp.ColWidths[0] + 1);// * 2; Button1.Top := (celDisp.RowHeights[0] + 1);// * 2; Button1.Height := celDisp.RowHeights[1]; // App_TOOLWBinValue := TApp_TOOLWBinValue.Create(Self); with celValue do begin DefaultRowHeight := Trunc(Abs(Font.Height) * 1.5); Cells[0, 0] := '型'; Cells[lciVALUE_COL_DUMPLE , 0] := 'ﾘﾄﾙｴﾝﾃﾞｨｱﾝ'; Cells[lciVALUE_COL_VALUELE, 0] := '値'; Cells[lciVALUE_COL_DUMPBE , 0] := 'ﾋﾞｯｸﾞｴﾝﾃﾞｨｱﾝ'; Cells[lciVALUE_COL_VALUEBE, 0] := '値'; Cells[5, 0] := '備考'; Cells[0, lciVALUE_BYTE ] := 'BYTE' ; Cells[5, lciVALUE_BYTE ] := '符号なし8ビット整数'; Cells[0, lciVALUE_WORD ] := 'WORD' ; Cells[5, lciVALUE_WORD ] := '符号なし16ビット整数'; Cells[0, lciVALUE_LONGWORD ] := 'DWORD' ; Cells[5, lciVALUE_LONGWORD ] := '符号なし32ビット整数'; Cells[0, lciVALUE_SHORTINT ] := 'CHAR' ; Cells[5, lciVALUE_SHORTINT ] := '符号付き8ビット整数'; Cells[0, lciVALUE_SMALLINT ] := 'SHORT' ; Cells[5, lciVALUE_SMALLINT ] := '符号付き16ビット整数'; Cells[0, lciVALUE_LONGINT ] := 'INT' ; Cells[5, lciVALUE_LONGINT ] := '符号付き32ビット整数'; Cells[0, lciVALUE_INT64 ] := 'Int64' ; Cells[5, lciVALUE_INT64 ] := '符号付き64ビット整数'; // Cells[0, lciVALUE_SINGLE ] := 'Single' ; Cells[5, lciVALUE_SINGLE ] := '単精度実数(float)'; // Cells[0, lciVALUE_DOUBLE ] := 'Double' ; Cells[5, lciVALUE_DOUBLE ] := '倍精度実数'; Cells[0, lciVALUE_SYNCHSAFE] := 'Synchsafe'; Cells[5, lciVALUE_SYNCHSAFE] := 'Synchsafe整数(ID3タグで使用)'; ColWidths[0] := gfniGridCanvasTextWidth(celValue, Cells[0, lciVALUE_SYNCHSAFE]) + (lciMARGIN * 2); ColWidths[lciVALUE_COL_DUMPLE] := gfniGridCanvasTextWidth(celValue, '0xFFFFFFFFFFFFFFFF') + (lciMARGIN * 2); // ColWidths[lciVALUE_COL_VALUELE] := gfniGridCanvasTextWidth(celValue, Cells[0, lciVALUE_WIDESTRING]) + (lciMARGIN * 2); ColWidths[lciVALUE_COL_DUMPBE] := gfniGridCanvasTextWidth(celValue, '0xFFFFFFFFFFFFFFFF') + (lciMARGIN * 2); // ColWidths[lciVALUE_COL_VALUEBE] := gfniGridCanvasTextWidth(celValue, Cells[0, lciVALUE_WIDESTRING]) + (lciMARGIN * 2); // ColWidths[5] := celValue.Width - ColWidths[0] - ColWidths[1] - ColWidths[2] - ColWidths[3] - ColWidths[4] - GridLineWidth * ColCount; end; // gpcWindowStyleAdd(edtFind_Address.Handle, ES_RIGHT); // gpcWindowStyleAdd(lstFind_Data. Handle, ES_RIGHT); //データ検索値作成 for i := 0 to High(Byte) do begin lstFind_Data.Items.Add(Format('%.2x', [i])); end; lstFind_Data.ItemIndex := 0; pnlFind_Progress.Width := btnFind_Cancel.Width + lblFind_Progress.Width + ProgressBar1.Width; lblFind_Progress.Caption := ''; pnlKey_Address.Height := shpKeyNum.Height; edtFind_StringChange(nil); //入力メニュー作成 for i := 0 to High(Byte) do begin l_MenuItem := NewItem( Format('%.2x', [i]), //Caption 0, //ShortCut False, //Checked True, //Enabled mniFind_DataClick, //OnClickイベント 0, //HelpContext Format('mniPInput_%.2x', [i]) //Name ); l_MenuItem.Tag := i; if (i mod 16 = 0) and (i > 1) then begin l_MenuItem.Break := mbBarBreak; end; mnuFind_Data.Items.Add(l_MenuItem); end; if (ParamCount > 0) then begin dlgOpenFile.FileName := ParamStr(1); actFile_OpenExecute(nil); end else begin actFile_CloseExecute(nil); end; DragAcceptFiles(Handle, True); end; procedure TApp_TOOLWBin.FormDestroy(Sender: TObject); begin F_List.Free; end; procedure TApp_TOOLWBin.actFile_ExitExecute(Sender: TObject); begin Close; end; procedure TApp_TOOLWBin.FormResize(Sender: TObject); begin with celValue do begin ColWidths[5] := celValue.Width - ColWidths[0] - ColWidths[1] - ColWidths[2] - ColWidths[3] - ColWidths[4] - GridLineWidth * ColCount; end; if (Application.Terminated) or (F_sFileName = '') then begin Exit; end; // F_iRowCount := gfniGridVisibleRowCount(celDisp); F_iRowCount := celDisp.VisibleRowCount; celDispTopLeftChanged(nil); end; procedure TApp_TOOLWBin.actFile_OpenExecute(Sender: TObject); var li_RowCount : Integer; lf_Size : Extended; li_Mod : Integer; ls_FileSize : AnsiString; begin if (Sender = nil) or (dlgOpenFile.Execute) then begin actFile_CloseExecute(nil); F_sFileName := dlgOpenFile.FileName; F_iFileSize := gfniFileSizeGet(F_sFileName); lf_Size := F_iFileSize; ls_FileSize := Format(' %.0n Byte (%s)', [lf_Size, gfnsFileSizeGet(F_sFileName)]); lblFileName.Caption := WideFormat('%s %s', [ls_FileSize, F_sFileName]); Self.Caption := WideFormat(' %s - [%s]', [Application.Title, gfnsWideToAnsi(gfnsFileNameGet(F_sFileName))]); li_RowCount := Trunc(F_iFileSize / lciBIN_WIDTH); li_Mod := F_iFileSize mod lciBIN_WIDTH; if (li_Mod > 0) then begin Inc(li_RowCount); end; celDisp.RowCount := li_RowCount +1; //アドレスの幅調整 actFind_Addr16Execute(nil); actFile_Close.Enabled := True; actFile_SendTo.Enabled := actFile_Close.Enabled; actFile_Execute.Enabled := actFile_Close.Enabled; actFind_AddressGoTo.Enabled := True; actFind_AddressDown.Enabled := actFind_AddressGoTo.Enabled; actFind_AddressUp.Enabled := actFind_AddressGoTo.Enabled; pnlFind_Address.Enabled := actFind_AddressGoTo.Enabled; celFind_Address.Enabled := actFind_AddressGoTo.Enabled; actFind_AddressInput.Enabled := actFind_AddressGoTo.Enabled; // lstFind_Data.Enabled := actFind_AddressGoTo.Enabled; actFind_DataDown.Enabled := actFind_AddressGoTo.Enabled; actFind_DataUp.Enabled := actFind_AddressGoTo.Enabled; //この中でデータの解析を行うルーチンを呼んでいる。 FormResize(nil); end; end; procedure TApp_TOOLWBin.actFile_CloseExecute(Sender: TObject); //閉じる begin F_sFileName := ''; //これをデータを読み込むかどうかのフラグに使うので頭にもってくること。 Self.Caption := Application.Title; F_List.Clear; lblInfo_Address.Caption := ''; lblInfo_Byte.Caption := ''; lblInfo_Word.Caption := ''; lblInfo_DWord.Caption := ''; lblInfo_Synchsafe.Caption := ''; lblFileName.Caption := ''; F_iColum := -1; F_iTopRow := -1; F_iAddrWidth := 0; F_iFileSize := 0; actFile_Close.Enabled := False; actFile_SendTo.Enabled := actFile_Close.Enabled; actFile_Execute.Enabled := actFile_Close.Enabled; actFind_AddressGoTo.Enabled := False; actFind_AddressDown.Enabled := actFind_AddressGoTo.Enabled; actFind_AddressUp.Enabled := actFind_AddressGoTo.Enabled; pnlFind_Address.Enabled := actFind_AddressGoTo.Enabled; celFind_Address.Enabled := actFind_AddressGoTo.Enabled; // spnFind_Address.Enabled := actFind_AddressGoTo.Enabled; // spnFind_AddressDownClick(nil); //移動エディットの値を初期化する。 celFind_Address.Cells[0, 0] := '0'; actFind_AddressInput.Enabled := actFind_AddressGoTo.Enabled; // lstFind_Data.Enabled := actFind_AddressGoTo.Enabled; actFind_DataDown.Enabled := actFind_AddressGoTo.Enabled; actFind_DataUp.Enabled := actFind_AddressGoTo.Enabled; F_iRowCount := 0; celDisp.RowCount := 2; actFind_Addr16Execute(nil); end; procedure TApp_TOOLWBin.actFile_SendToExecute(Sender: TObject); //他のプログラムから開く var ls_File : WideString; begin if (dlgSendTo.Execute) then begin if (actFile_SendToShortFileName.Checked) then begin ls_File := gfnsShortFileNameGet(F_sFileName); end else begin ls_File := F_sFileName; end; gpcExecute(dlgSendTo.FileName, WideFormat(' "%s"', [ls_File])); end; end; procedure TApp_TOOLWBin.actFile_ExecuteExecute(Sender: TObject); //実行 begin // gpcExecute(WideFormat('"%s"', [F_sFileName])); end; procedure TApp_TOOLWBin.F_DumpData(iStart, iEnd : Integer); var i : Integer; l_Stream : TMyFileStream; begin if (F_sFileName = '') then begin Exit; end; try l_Stream := TMyFileStream.Create(F_sFileName, GENERIC_READ, FILE_SHARE_READ or FILE_SHARE_WRITE); try for i := iStart to iEnd do begin //SetItemに渡すのはFixedRowsも含んだグリッドの行 F_List.SetItem(i, l_Stream); end; finally l_Stream.Free; end; except gpcShowMessage(WideFormat('ファイルにアクセスできませんでした'#13'%s', [F_sFileName])); end; end; procedure TApp_TOOLWBin.celDispTopLeftChanged(Sender: TObject); var i, li_Old, li_New : Integer; li_Shift, li_Count : Integer; li_Start, li_End : Integer; begin if (F_sFileName = '') then begin F_iTopRow := -1; Exit; end; li_Old := F_iTopRow; li_New := celDisp.TopRow; li_Shift := li_New - li_Old; li_Count := Abs(li_Shift); if (F_iTopRow < 0) //読み込んでから初めての場合 or (li_Count >= F_iRowCount) //(表示される)ライン全部を書き換え then begin li_Start := celDisp.TopRow; // li_End := gfniGridBottomRow(celDisp, True); li_End := celDisp.TopRow + celDisp.VisibleRowCount -1; end else begin if (li_Shift < 0) then begin //先頭へ li_Start := li_Old - li_Count; li_End := li_Old +1; end else {if (li_Shift > 0) then} begin //後方へ li_Start := F_iTopRow + F_iRowCount -1; li_End := gfniGridBottomRow(celDisp, True); end; end; F_DumpData(li_Start, li_End); for i := li_Start to li_End do begin F_UpdateRow(i); end; F_iTopRow := celDisp.TopRow; end; procedure TApp_TOOLWBin.F_DispInfo(iRow : Integer); function lfns_StrToInt(sStr : String) : Byte; var li_Err : Integer; begin Val('$' + sStr, Result, li_Err); end; procedure lfns_DataGet(out AData: array of Byte; sDump : String; iColum : Integer); var i : Integer; begin for i := 0 to High(AData) do begin AData[i] := lfns_StrToInt(Copy(sDump, ((iColum +i) * 3) +1, 2)); end; end; var li_Addr : Int64; lf_Addr : Double; l_Data : array[0..7] of Byte; ls_Dump : AnsiString; l_BinData : T_BinData; // li_Count : Int64; begin // if (F_List.iRow[iRow] < 0) then begin F_DumpData(iRow, iRow +1); // end; if (F_List.iRow[iRow] = 0) or (F_sFileName = '') then begin lblInfo_Address.Caption := ''; lblInfo_Byte.Caption := ''; lblInfo_Word.Caption := ''; lblInfo_DWord.Caption := ''; lblInfo_Synchsafe.Caption := ''; Exit; end; //アドレス F_iColum := gfniNumLimit(F_iColum, 0, F_List.iLength[iRow] -1); li_Addr := ((F_List.iRow[iRow] -1) * lciBIN_WIDTH) + F_iColum; lf_Addr := li_Addr; lblInfo_Address.Caption := Format('[ADDR 0x%.*x %.0n] ', [F_iAddrWidth, li_Addr, lf_Addr]); //ダンプ文字列からデータを復元 ls_Dump := F_List.sDump[iRow] + ' ' + F_List.sDump[iRow +1]; // lfns_DataGet(l_DataLE.iData, l_DataBE.iData, ls_Dump, F_iColum); lfns_DataGet(l_Data, ls_Dump, F_iColum); l_BinData := T_BinData.Create(l_Data, gfniMin([8, F_iFileSize - li_Addr])); try lblInfo_Byte.Caption := Format('[BYTE 0x%s %s] ', [l_BinData.GetByte(False, True), l_BinData.GetByte]); lblInfo_Word.Caption := Format('[WORD 0x%s %s] ', [l_BinData.GetWord(False, True), l_BinData.GetWord]); lblInfo_DWord.Caption := Format('[DWORD 0x%s %s] ', [l_BinData.GetLongword(False, True), l_BinData.GetLongword]); lblInfo_Synchsafe.Caption := Format('[Synchsafe 0x%s %s]', [l_BinData.GetSynchsafe(True), l_BinData.GetSynchsafe]); if (celValue.Visible) then begin //リトルエンディアン、ダンプ celValue.Cells[lciVALUE_COL_DUMPLE, lciVALUE_BYTE] := '0x' + l_BinData.GetByte (False, True); celValue.Cells[lciVALUE_COL_DUMPLE, lciVALUE_WORD] := '0x' + l_BinData.GetWord (False, True); celValue.Cells[lciVALUE_COL_DUMPLE, lciVALUE_LONGWORD] := '0x' + l_BinData.GetLongword(False, True); celValue.Cells[lciVALUE_COL_DUMPLE, lciVALUE_SHORTINT] := '0x' + l_BinData.GetShortint(False, True); celValue.Cells[lciVALUE_COL_DUMPLE, lciVALUE_SMALLINT] := '0x' + l_BinData.GetSmallint(False, True); celValue.Cells[lciVALUE_COL_DUMPLE, lciVALUE_LONGINT] := '0x' + l_BinData.GetLongint (False, True); celValue.Cells[lciVALUE_COL_DUMPLE, lciVALUE_INT64] := '0x' + l_BinData.GetInt64 (False, True); // celValue.Cells[lciVALUE_COL_DUMPLE, lciVALUE_SINGLE] := '0x' + l_BinData.GetSingle (False, True); // celValue.Cells[lciVALUE_COL_DUMPLE, lciVALUE_DOUBLE] := '0x' + l_BinData.GetDouble (False, True); celValue.Cells[lciVALUE_COL_DUMPLE, lciVALUE_SYNCHSAFE] := '-'; //ID3タグのSynchsafe整数はビッグエンディアンであるのでこの値は必要なし //リトルエンディアン、値 celValue.Cells[lciVALUE_COL_VALUELE, lciVALUE_BYTE] := l_BinData.GetByte; celValue.Cells[lciVALUE_COL_VALUELE, lciVALUE_WORD] := l_BinData.GetWord; celValue.Cells[lciVALUE_COL_VALUELE, lciVALUE_LONGWORD] := l_BinData.GetLongword; celValue.Cells[lciVALUE_COL_VALUELE, lciVALUE_SHORTINT] := l_BinData.GetShortint; celValue.Cells[lciVALUE_COL_VALUELE, lciVALUE_SMALLINT] := l_BinData.GetSmallint; celValue.Cells[lciVALUE_COL_VALUELE, lciVALUE_LONGINT] := l_BinData.GetLongint; celValue.Cells[lciVALUE_COL_VALUELE, lciVALUE_INT64] := l_BinData.GetInt64; // celValue.Cells[lciVALUE_COL_VALUELE, lciVALUE_SINGLE] := ABinData.GetSingle; // celValue.Cells[lciVALUE_COL_VALUELE, lciVALUE_DOUBLE] := ABinData.GetDouble; celValue.Cells[lciVALUE_COL_VALUELE, lciVALUE_SYNCHSAFE] := '-'; //ID3タグのSynchsafe整数はビッグエンディアンであるのでこの値は必要なし //ビッグエンディアン、ダンプ celValue.Cells[lciVALUE_COL_DUMPBE, lciVALUE_BYTE] := '0x' + l_BinData.GetByte (True, True); celValue.Cells[lciVALUE_COL_DUMPBE, lciVALUE_WORD] := '0x' + l_BinData.GetWord (True, True); celValue.Cells[lciVALUE_COL_DUMPBE, lciVALUE_LONGWORD] := '0x' + l_BinData.GetLongword (True, True); celValue.Cells[lciVALUE_COL_DUMPBE, lciVALUE_SHORTINT] := '0x' + l_BinData.GetShortint (True, True); celValue.Cells[lciVALUE_COL_DUMPBE, lciVALUE_SMALLINT] := '0x' + l_BinData.GetSmallint (True, True); celValue.Cells[lciVALUE_COL_DUMPBE, lciVALUE_LONGINT] := '0x' + l_BinData.GetLongint (True, True); celValue.Cells[lciVALUE_COL_DUMPBE, lciVALUE_INT64] := '0x' + l_BinData.GetInt64 (True, True); // celValue.Cells[lciVALUE_COL_DUMPBE, lciVALUE_SINGLE] := '0x' + l_BinData.GetSingle (True, True); // celValue.Cells[lciVALUE_COL_DUMPBE, lciVALUE_DOUBLE] := '0x' + l_BinData.GetDouble (True, True); celValue.Cells[lciVALUE_COL_DUMPBE, lciVALUE_SYNCHSAFE] := '0x' + l_BinData.GetSynchsafe(True); //ビッグエンディアン、値 celValue.Cells[lciVALUE_COL_VALUEBE, lciVALUE_BYTE] := l_BinData.GetByte (True, False); celValue.Cells[lciVALUE_COL_VALUEBE, lciVALUE_WORD] := l_BinData.GetWord (True, False); celValue.Cells[lciVALUE_COL_VALUEBE, lciVALUE_LONGWORD] := l_BinData.GetLongword (True, False); celValue.Cells[lciVALUE_COL_VALUEBE, lciVALUE_SHORTINT] := l_BinData.GetShortint (True, False); celValue.Cells[lciVALUE_COL_VALUEBE, lciVALUE_SMALLINT] := l_BinData.GetSmallint (True, False); celValue.Cells[lciVALUE_COL_VALUEBE, lciVALUE_LONGINT] := l_BinData.GetLongint (True, False); celValue.Cells[lciVALUE_COL_VALUEBE, lciVALUE_INT64] := l_BinData.GetInt64 (True, False); // celValue.Cells[lciVALUE_COL_VALUEBE, lciVALUE_SINGLE] := l_BinData.GetSingle (True, False); // celValue.Cells[lciVALUE_COL_VALUEBE, lciVALUE_DOUBLE] := l_BinData.GetDouble (True, False); celValue.Cells[lciVALUE_COL_VALUEBE, lciVALUE_SYNCHSAFE] := l_BinData.GetSynchsafe; end; finally l_BinData.Free; end; end; procedure TApp_TOOLWBin.celDispSelectCell(Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean); begin if (F_sFileName = '') then begin Exit; end; if (F_bMouseDown) or (F_bMouseWheel) then begin F_DispInfo(ARow); end; F_bMouseWheel := False; end; procedure TApp_TOOLWBin.celDispMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var l_Grid : TGridCoord; lrc_Rect : TRect; li_Width : Integer; li_Col : Integer; //アップデートするセルを指定 begin if (F_sFileName = '') then begin Exit; end; if (Button = mbLeft) then begin l_Grid := celDisp.MouseCoord(X, Y); if (l_Grid.Y > 0) then begin if (l_Grid.X = lciCOL_DUMP) or (l_Grid.X = lciCOL_ANSI) then begin //クリックしたバイトの位置を算出 if (l_Grid.X = lciCOL_DUMP) then begin li_Width := F_iCharWidth * 3; li_Col := lciCOL_ANSI; end else {if (l_Grid.X = lciCOL_ANSI) then} begin li_Width := F_iCharWidth; li_Col := lciCOL_DUMP; end; lrc_Rect := celDisp.CellRect(l_Grid.X, l_Grid.Y); if (PtInRect(lrc_Rect, Point(X, Y))) then begin if (l_Grid.X = lciCOL_DUMP) then begin F_iColum := ((X - lrc_Rect.Left) div li_Width); end else begin F_iColum := ((X - lrc_Rect.Left{ - (F_iCharWidth div 2) + lciMARGIN}) div li_Width); end; F_DispInfo(l_Grid.Y); F_bMouseDown := True; end; F_UpdateCell(li_Col, l_Grid.Y); end; end; end; end; procedure TApp_TOOLWBin.celDispMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin F_bMouseDown := False; end; procedure TApp_TOOLWBin.celDispMouseWheelDown(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); //スクロールをリストボックスと同じように var l_Msg : TMessage; begin if (actOpt_ScrollLikeListBox.Checked) then begin FillChar(l_Msg, SizeOf(l_Msg), 0); l_Msg.WParamLo := SB_LINEDOWN; l_Msg.Result := 0; SendMessage(celDisp.Handle, WM_VSCROLL, l_Msg.WParam, l_Msg.LParam); Handled := True; end else begin F_bMouseWheel := True; Handled := False; end; end; procedure TApp_TOOLWBin.celDispMouseWheelUp(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); //スクロールをリストボックスと同じように var l_Msg : TMessage; begin if (actOpt_ScrollLikeListBox.Checked) then begin FillChar(l_Msg, SizeOf(l_Msg), 0); l_Msg.WParamLo := SB_LINEUP; l_Msg.Result := 0; SendMessage(celDisp.Handle, WM_VSCROLL, l_Msg.WParam, l_Msg.LParam); Handled := True; end else begin F_bMouseWheel := True; Handled := False; end; end; procedure TApp_TOOLWBin.F_UpdateCell(iCol, iRow : Integer); begin celDispDrawCell(nil, iCol, iRow, celDisp.CellRect(iCol, iRow), []); end; procedure TApp_TOOLWBin.F_UpdateRow(iRow : Integer); var i : Integer; begin for i := lciCOL_ADDRESS to lciCOL_UTF8 do begin F_UpdateCell(i, iRow); end; end; procedure TApp_TOOLWBin.celDispDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); var lrc_Col, lrc_Rect : TRect; ls_Address : AnsiString; li_Width : Integer; ls_ValueA : AnsiString; ls_ValueW : WideString; begin lrc_Rect := Rect; Inc(lrc_Rect.Left, lciMARGIN); //選択カラムの表示 li_Width := -1; if (F_iColum >= 0) then begin if (ARow = celDisp.Row) //選択行 // or (ARow = 0) //タイトル then begin if (ACol = lciCOL_DUMP) then begin li_Width := F_iCharWidth * 3; end else if (ACol = lciCOL_ANSI) then begin li_Width := F_iCharWidth; end; lrc_Col.Left := Rect.Left + (li_Width * F_iColum) + lciMARGIN; if (ACol = lciCOL_DUMP) then begin Inc(lrc_Col.Left, F_iCharWidth div 2); //ダンプはマージンも含めて3文字分の幅だけれども2文字分を強調するだけなのでここで調整する。 li_Width := F_iCharWidth * 2; end; lrc_Col.Right := lrc_Col.Left + li_Width; lrc_Col.Top := Rect.Top; lrc_Col.Bottom := Rect.Bottom; Dec(lrc_Col.Left); //少し幅を広げる end; end; with celDisp do begin Canvas.Font.Assign(Font); if (ARow = 0) then begin //タイトル Canvas.Brush.Color := clBtnFace; Canvas.Font.Color := clBtnText; Canvas.FillRect(Rect); if (ACol = lciCOL_DUMP) or (ACol = lciCOL_ANSI) then begin //16進ダンプとShift-JISは左詰 if (ACol = lciCOL_DUMP) then begin Inc(lrc_Rect.Left, F_iCharWidth div 2); end; DrawTextA(celDisp.Canvas.Handle, PAnsiChar(lcsTITLE[ACol]), -1, lrc_Rect, DT_NOPREFIX or DT_SINGLELINE or DT_VCENTER); end else begin DrawTextA(celDisp.Canvas.Handle, PAnsiChar(lcsTITLE[ACol]), -1, lrc_Rect, DT_NOPREFIX or DT_SINGLELINE or DT_VCENTER or DT_CENTER); end; Canvas.Pen.Color := clBtnShadow; Canvas.MoveTo(Rect.Left, Rect.Bottom -1); Canvas.LineTo(Rect.Right, Rect.Bottom -1); Canvas.MoveTo(Rect.Right, Rect.Top); Canvas.LineTo(Rect.Right, Rect.Bottom); end else begin if (ACol = lciCOL_ADDRESS) then begin Canvas.Brush.Color := clBtnFace; Canvas.Font.Color := clBtnText; end else begin Canvas.Brush.Color := Color; Canvas.Font.Color := Font.Color; end; Canvas.FillRect(Rect); case ACol of lciCOL_ADDRESS: begin //開始バイト if (F_sFileName <> '') then begin Dec(lrc_Rect.Right);//, lciMARGIN); if (actFind_Addr16.Checked) then begin //16進表示 ls_Address := Format('%.*x', [F_iAddrWidth, F_List.iAddress[ARow]]); end else begin //10進表示。3桁の位取り ls_Address := F_List.sAddrStr[ARow]; end; DrawTextA(celDisp.Canvas.Handle, PAnsiChar(ls_Address), -1, lrc_Rect, DT_NOCLIP or DT_NOPREFIX or DT_SINGLELINE or DT_VCENTER or DT_RIGHT); end; end; lciCOL_DUMP: begin //ダンプ ls_ValueA := F_List.sDump[ARow]; Inc(lrc_Rect.Left, F_iCharWidth div 2); DrawTextA(Canvas.Handle, PAnsiChar(ls_ValueA), -1, lrc_Rect, DT_NOCLIP or DT_NOPREFIX or DT_SINGLELINE or DT_VCENTER); end; lciCOL_ANSI: begin //Shift-JIS ls_ValueA := F_List.sAnsi[ARow]; DrawTextA(Canvas.Handle, PAnsiChar(ls_ValueA), -1, lrc_Rect, DT_NOCLIP or DT_NOPREFIX or DT_SINGLELINE or DT_VCENTER); end; lciCOL_UTF16LE: begin //UTF-16LE ls_ValueW := F_List.sUtf16LE[ARow]; DrawTextW(Canvas.Handle, PWideChar(ls_ValueW), -1, lrc_Rect, DT_NOCLIP or DT_NOPREFIX or DT_SINGLELINE or DT_VCENTER); end; lciCOL_UTF16BE: begin //UTF-16BE ls_ValueW := F_List.sUtf16BE[ARow]; DrawTextW(Canvas.Handle, PWideChar(ls_ValueW), -1, lrc_Rect, DT_NOCLIP or DT_NOPREFIX or DT_SINGLELINE or DT_VCENTER); end; lciCOL_UTF8: begin //UTF-8 ls_ValueW := F_List.sUtf8[ARow]; DrawTextW(Canvas.Handle, PWideChar(ls_ValueW), -1, lrc_Rect, DT_NOCLIP or DT_NOPREFIX or DT_SINGLELINE or DT_VCENTER); end; end; end; { //16進ダンプの4バイトごとの区切り if (F_sFileName <> '') and (ACol = lciCOL_DUMP) then begin if (ARow = 0) then begin Canvas.Pen.Color := clBtnShadow; end else begin Canvas.Pen.Color := clBtnFace; end; Canvas.MoveTo(lrc_Rect.Left -lciMARGIN + F_iDumpLine1, lrc_Rect.Top); Canvas.LineTo(lrc_Rect.Left -lciMARGIN + F_iDumpLine1, lrc_Rect.Bottom); Canvas.MoveTo(lrc_Rect.Left -lciMARGIN + F_iDumpLine2, lrc_Rect.Top); Canvas.LineTo(lrc_Rect.Left -lciMARGIN + F_iDumpLine2, lrc_Rect.Bottom); Canvas.MoveTo(lrc_Rect.Left -lciMARGIN + F_iDumpLine3, lrc_Rect.Top); Canvas.LineTo(lrc_Rect.Left -lciMARGIN + F_iDumpLine3, lrc_Rect.Bottom); end; } //選択行 if (ARow = celDisp.Row) then begin // Canvas.Pen.Width := 1; Canvas.Pen.Color := Canvas.Font.Color; Canvas.MoveTo(Rect.Left, Rect.Bottom -1); Canvas.LineTo(Rect.Right, Rect.Bottom -1); end; //選択カラムの強調 if (li_Width >= 0) then begin // Canvas.Pen.Width := 1; Canvas.Pen.Color := clHighlight; Canvas.MoveTo(lrc_Col.Left, lrc_Col.Bottom -2); Canvas.LineTo(lrc_Col.Right, lrc_Col.Bottom -2); Canvas.MoveTo(lrc_Col.Left, lrc_Col.Bottom -3); Canvas.LineTo(lrc_Col.Right, lrc_Col.Bottom -3); end; end; end; procedure TApp_TOOLWBin.actNop(Sender: TObject); begin // end; procedure TApp_TOOLWBin.actHelp_VersionInfoExecute(Sender: TObject); //ヘルプ begin gpcVersionInfoCreate; gpcVersionInfoMemoFixedFontSet(True); gpcVersionInfoMemoSet(edtHelp.Text); gpcVersionInfoURLSet('http://drang.s4.xrea.com/program/tool/tool/wbin/help/'); gpcVersionInfoShowModal; gpcVersionInfoRelease; end; procedure TApp_TOOLWBin.actFind_Addr16Execute(Sender: TObject); var ls_Address : AnsiString; li_Width : Integer; begin if (actFind_Addr16.Checked) then begin ls_Address := lfnsAddrHexGet(F_iFileSize); end else begin ls_Address := lfnsAddrStrGet(F_iFileSize); end; F_iAddrWidth := Length(ls_Address); pnlFind_Address.Width := celFind_Address.Left + (gfniMax([F_iAddrWidth, 8]) + 4) * Self.Canvas.TextWidth('0') //4文字分幅を広げておく + spnFind_Address.Width ; // spnFind_AddressDownClick(spnFind_Address); celDisp.ColWidths[lciCOL_ADDRESS] := gfniMax([gfniGridCanvasTextWidth(celDisp, ls_Address), gfniGridCanvasTextWidth(celDisp, lcsTITLE[lciCOL_ADDRESS])]) + (lciMARGIN * 2); li_Width := gfniGridWidthGet(celDisp); if (F_sFileName <> '') then begin Inc(li_Width, GetSystemMetrics(SM_CXVSCROLL)); end; Self.ClientWidth := li_Width; if (F_sFileName <> '') then begin celDisp.Repaint; end; end; procedure TApp_TOOLWBin.WndProc(var Msg: TMessage); begin if (Self.Menu <> nil) and (Msg.Msg = WM_INITMENU) and (Msg.WParam = WPARAM(Self.Menu.Handle)) then begin PopupMenu1Popup(nil); end; inherited WndProc(Msg); end; procedure TApp_TOOLWBin.PopupMenu1Popup(Sender: TObject); begin actFile_SendTo.Enabled := gfnbFileExists(F_sFileName); end; procedure TApp_TOOLWBin.F_GoToAddress(iAddress : Int64); var li_Row : Integer; begin actFind_AddressInput.Checked := False; F_iColum := iAddress mod lciBIN_WIDTH; li_Row := iAddress div lciBIN_WIDTH +1; if not(gfnbIsGridRowVisible(celDisp, li_Row)) then begin celDisp.TopRow := li_Row; end; celDisp.Row := li_Row; celDisp.Repaint; F_DispInfo(celDisp.Row); end; function TApp_TOOLWBin.F_GetNowAddress : Int64; //現在位置を返す。 begin Result := ((F_List.iRow[celDisp.Row] -1) * lciBIN_WIDTH) + F_iColum; end; function TApp_TOOLWBin.F_FindDown(AStream : TStream; iStart : Int64; pData : PAnsiChar; iCount : Integer) : Int64; var i : Int64; k : Integer; l_Dat : AnsiChar; //http://www.asahi-net.or.jp/~ha3t-nkmr/tips020.htm l_BuffStream : TNkBufferedStream; begin Result := -1; if (iCount <= 0) or (iStart < 0) or (iStart >= AStream.Size) then begin Exit; end; // Screen.Cursor := crHourGlass; celDisp.Cursor := crHourGlass; celDisp.Enabled := False; ToolBar1.Enabled := False; pnlFind_Progress.Show; l_BuffStream := TNKBufferedStream.Create(AStream, 4096); try i := iStart; while (i < l_BuffStream.Size) and (Application.Terminated = False) and (F_bFindCancel = False) do begin F_fProgress := (l_BuffStream.Position - iStart) / (l_BuffStream.Size - iStart) * 100; // ProgressBar1.Position := Trunc(F_fProgress); Application.ProcessMessages; l_BuffStream.Position := i; l_BuffStream.Read(l_Dat, 1); if (l_Dat = pData[0]) then begin if (iCount = 1) then begin Result := i; Exit; end else begin try //pData[0]は既に一致しているので1から始める for k := 1 to iCount-1 do begin l_BuffStream.Position := i + k; l_BuffStream.Read(l_Dat, 1); if (l_Dat <> pData[k]) then begin Abort; //exceptに飛ぶ end; end; Result := l_BuffStream.Position - iCount; Exit; except //単なるラベル代わり end; end; end; Inc(i); end; finally l_BuffStream.Free; pnlFind_Progress.Hide; ToolBar1.Enabled := True; celDisp.Enabled := True; celDisp.Cursor := crDefault; // Screen.Cursor := crDefault; end; end; function TApp_TOOLWBin.F_FindUp(AStream : TStream; iStart : Int64; pData : PAnsiChar; iCount : Integer) : Int64; var i : Int64; k : Integer; l_Dat : AnsiChar; l_BuffStream : TNkBufferedStream; begin Result := -1; if (iCount <= 0) or (iStart < 0) or (iStart >= AStream.Size) then begin Exit; end; // Screen.Cursor := crHourGlass; celDisp.Cursor := crHourGlass; celDisp.Enabled := False; ToolBar1.Enabled := False; pnlFind_Progress.Show; l_BuffStream := TNKBufferedStream.Create(AStream, 4096); try i := iStart; while (i >= 0) and (Application.Terminated = False) and (F_bFindCancel = False) do begin F_fProgress := (iStart - AStream.Position) / iStart * 100; // ProgressBar1.Position := Trunc(F_fProgress); Application.ProcessMessages; l_BuffStream.Position := i; l_BuffStream.Read(l_Dat, 1); if (l_Dat = pData[0]) then begin if (iCount = 1) then begin Result := i; Exit; end else begin try //pData[0]は既に一致しているので1から始める for k := 1 to iCount-1 do begin l_BuffStream.Position := i + k; l_BuffStream.Read(l_Dat, 1); if (l_Dat <> pData[k]) then begin Abort; //exceptに飛ぶ end; end; Result := l_BuffStream.Position - iCount; Exit; except //単なるラベル代わり end; end; end; Dec(i); end; finally l_BuffStream.Free; pnlFind_Progress.Hide; ToolBar1.Enabled := True; celDisp.Enabled := True; celDisp.Cursor := crDefault; // Screen.Cursor := crDefault; end; end; procedure TApp_TOOLWBin.Timer1Timer(Sender: TObject); begin lblFind_Progress.Caption := Format(' %.2f%% ', [F_fProgress]); // ProgressBar1.Position := Trunc(F_fProgress); ProgressBar1.Position := gfniRoundUp(F_fProgress); end; procedure TApp_TOOLWBin.actFind_DataDownExecute(Sender: TObject); //下方検索 var li_Address : Int64; l_Stream : TMyFileStream; begin if (F_sFileName = '') or (edtFind_String.Text = '') then begin Exit; end; F_bFindCancel := False; try l_Stream := TMyFileStream.Create(F_sFileName, GENERIC_READ, FILE_SHARE_READ or FILE_SHARE_WRITE); try lblFind_Progress.Caption := ''; F_fProgress := 0.0; Timer1.Enabled := True; if (Sender = actFind_DataUp) then begin li_Address := F_FindUp (l_Stream, F_GetNowAddress -1, PAnsiChar(edtFind_String.Text), Length(edtFind_String.Text)); end else begin li_Address := F_FindDown(l_Stream, F_GetNowAddress +1, PAnsiChar(edtFind_String.Text), Length(edtFind_String.Text)); end; Timer1.Enabled := False; if (li_Address > 0) then begin F_GoToAddress(li_Address); end else begin if (Application.Terminated) then begin //プログラム終了なのでメッセージは出さない end else if (F_bFindCancel) then begin //ユーザーが中止ボタンを押したのでメッセージは出さない // gpcShowMessage('検索が中止されました'); end else begin gpcShowMessage('検索に一致するデータはありませんでした'); end; end; finally l_Stream.Free; end; except gpcShowMessage(WideFormat('ファイルにアクセスできませんでした'#13'%s', [F_sFileName])); end; end; (* procedure TApp_TOOLWBin.actFind_DataDownExecute(Sender: TObject); //下方検索 const lci_READ = 64 * 1024; //64KB var li_Address : Int64; l_Stream : TMyFileStream; l_Data : array[0..lci_READ-1] of AnsiChar; li_Read, i, k : Integer; li_Loop : Integer; ls_Search : AnsiChar; lb_Hit : Boolean; begin if (F_sFileName = '') then begin Exit; end; li_Address := F_GetNowAddress +1; ls_Search := AnsiChar(lstFind_Data.ItemIndex); try l_Stream := TMyFileStream.Create(F_sFileName, GENERIC_READ, FILE_SHARE_READ or FILE_SHARE_WRITE); try l_Stream.Position := li_Address; li_Loop := gfniRoundUp((l_Stream.Size - li_Address) / lci_READ); lb_Hit := False; for i := 0 to li_Loop do begin li_Read := l_Stream.Read(l_Data, lci_READ); for k := 0 to li_Read -1 do begin if (actFind_DataException.Checked) then begin if (l_Data[k] <> ls_Search) then begin lb_Hit := True; end; end else if (l_Data[k] = ls_Search) then begin lb_Hit := true; end; if (lb_Hit) then begin F_GoToAddress(li_Address + (lci_READ * i) + k); Exit; end; end; end; finally l_Stream.Free; end; except gpcShowMessage(WideFormat('ファイルにアクセスできませんでした'#13'%s', [F_sFileName])); end; end; *) procedure TApp_TOOLWBin.actFind_DataUpExecute(Sender: TObject); //上方検索 //const // lci_READ = 64 * 1024; //64KB var li_Address : Int64; l_Stream : TMyFileStream; // l_Data : array[0..lci_READ-1] of AnsiChar; l_Data : AnsiChar; // li_Read, i : Integer; // k, // li_Loop : Integer; ls_Search : AnsiChar; lb_Hit : Boolean; begin if (F_sFileName = '') then begin Exit; end; try l_Stream := TMyFileStream.Create(F_sFileName, GENERIC_READ, FILE_SHARE_READ or FILE_SHARE_WRITE); try li_Address := F_GetNowAddress -1; ls_Search := AnsiChar(lstFind_Data.ItemIndex); lb_Hit := False; for i := li_Address downto 0 do begin l_Stream.Position := i; l_Stream.Read(l_Data, 1); if (actFind_DataException.Checked) then begin if (l_Data <> ls_Search) then begin lb_Hit := True; end; end else if (l_Data = ls_Search) then begin lb_Hit := true; end; if (lb_Hit) then begin F_GoToAddress(i); Exit; end; end; finally l_Stream.Free; end; except gpcShowMessage(WideFormat('ファイルにアクセスできませんでした'#13'%s', [F_sFileName])); end; end; function TApp_TOOLWBin.F_GetNumStr(iNum: Int64): String; begin // iNum := gfniNumLimit(iNum, 0, gfniMax([F_iFileSize -1, 0])); if (F_iFileSize <= 0) then begin iNum := 0; end else begin // iNum := F_iFileSize -1; end; if (actFind_Addr16.Checked) then begin Result := Format('%x', [iNum]); end else begin Result := Format('%d', [iNum]); end; end; function TApp_TOOLWBin.F_GetNumInt(sNum: String): Int64; var li_Pos : Integer; begin if (actFind_Addr16.Checked) then begin li_Pos := Pos('x', LowerCase(sNum)); if (li_Pos > 0) then begin sNum := Copy(sNum, li_Pos +1, MAXINT); end; if (sNum <> '') then begin sNum := '$' + sNum; end; end; if (sNum = '') then begin Result := 0; end else begin Result := gfniStrToInt(sNum); end; end; function TApp_TOOLWBin.F_GetAddressNum(sNum : String; iInc : Integer = 0) : String; begin Result := F_GetNumStr(F_GetNumInt(sNum) + iInc); end; procedure TApp_TOOLWBin.spnFind_AddressDownClick(Sender: TObject); var li_UpDown : Integer; begin if (F_bChanging) then begin //無限ループを防止 Exit; end; F_bChanging := True; li_UpDown := -1; if (gfnbKeyState(VK_SHIFT)) then begin li_UpDown := li_UpDown * lciBIN_WIDTH; end; celFind_Address.Cells[0, 0] := F_GetAddressNum(celFind_Address.Cells[0, 0], li_UpDown); F_bChanging := False; end; procedure TApp_TOOLWBin.spnFind_AddressUpClick(Sender: TObject); var li_UpDown : Integer; ls_Test : String; begin if (F_bChanging) then begin //無限ループを防止 Exit; end; F_bChanging := True; li_UpDown := +1; if (gfnbKeyState(VK_SHIFT)) then begin li_UpDown := li_UpDown * lciBIN_WIDTH; end; ls_Test := F_GetAddressNum(celFind_Address.Cells[0, 0], li_UpDown); celFind_Address.Cells[0, 0] := F_GetAddressNum(celFind_Address.Cells[0, 0], li_UpDown); F_bChanging := False; end; function TApp_TOOLWBin.F_IsNum(iCode : Word) : Boolean; begin Result := False; case iCode of VK_0..VK_9 : begin //数値。許可 Result := True; end; VK_A..VK_F{, Ord('a')..Ord('f')} : begin //A-Z //16進値表示なら許可 Result := actFind_Addr16.Checked; end; Ord(',') : begin //3桁の区切り //10進値表示なら許可。 Result := not(actFind_Addr16.Checked); end; end; end; procedure TApp_TOOLWBin.actFind_AddressExecute(Sender: TObject); //アドレス移動 begin if not(celFind_Address.Focused) then begin if (celFind_Address.CanFocus) then begin celFind_Address.SetFocus; end; { end else begin if (celDisp.CanFocus) then begin celDisp.SetFocus; end; } end; end; procedure TApp_TOOLWBin.actFind_DataExecute(Sender: TObject); //データ検索 begin if not(Sender is TAction) then begin Exit; end; TAction(Sender).Checked := True; if (Sender = actFind_Data) then begin edtFind_String.Hide; lstFind_Data.Show; //データ検索 if not(lstFind_Data.Focused) then begin if (lstFind_Data.CanFocus) then begin lstFind_Data.SetFocus; end; end; end else if (Sender = actFind_String) then begin //文字列検索 lstFind_Data.Hide; edtFind_String.Show; if not(edtFind_String.Focused) then begin if (edtFind_String.CanFocus) then begin edtFind_String.SetFocus; end; end; end; end; procedure TApp_TOOLWBin.actFind_AddressGoToExecute(Sender: TObject); //指定値移動 var li_Num : Int64; begin // if (F_sFileName = '') then begin Exit; end; celFind_Address.Cells[0, 0] := F_GetNumStr(F_GetNumInt(celFind_Address.Cells[0, 0])); li_Num := F_GetNumInt(celFind_Address.Cells[0, 0]); if (Sender = actFind_AddressDown) then begin li_Num := F_GetNowAddress + li_Num; end else if (Sender = actFind_AddressUp) then begin li_Num := F_GetNowAddress - li_Num; end; li_Num := gfniNumLimit(li_Num, 0, gfniFileSizeGet(F_sFileName) -1); F_GoToAddress(li_Num); end; procedure TApp_TOOLWBin.actFind_AddressInputExecute(Sender: TObject); begin if(actFind_AddressInput.Checked) then begin pnlKey_Address.SetBounds(pnlFind_Address.Left, ToolBar1.Height, pnlKey_Address.Width, pnlKey_Address.Height); end; pnlKey_Address.Visible := actFind_AddressInput.Checked; end; procedure TApp_TOOLWBin.btnKeyNum_CloseClick(Sender: TObject); begin actFind_AddressInput.Checked := False; actFind_AddressInputExecute(nil); end; procedure TApp_TOOLWBin.mnuFindAddresPopup(Sender: TObject); begin // actEditNum_Copy.Enabled := (celFind_Address.Cells[0, 0] <> ''); actEdit_PasteAddress.Enabled := Clipboard.HasFormat(CF_TEXT); end; procedure TApp_TOOLWBin.actEdit_CopyAddressExecute(Sender: TObject); begin // if (celFind_Address.Cells[0, 0] <> '') then begin Clipboard.AsText := celFind_Address.Cells[0, 0]; // end; end; procedure TApp_TOOLWBin.actEdit_PasteAddressExecute(Sender: TObject); var i : Integer; ls_Num : String; begin if (Clipboard.HasFormat(CF_TEXT)) then begin ls_Num := Clipboard.AsText; for i := 1 to Length(ls_Num) do begin if not(F_IsNum(Ord(ls_Num[i]))) then begin if (i > 1) then begin ls_Num := Copy(ls_Num, 1, i -1); end else begin ls_Num := ''; end; Break; end; end; if (actFind_Addr16.Checked) and (ls_Num <> '') then begin //16進値で表示 ls_Num := '$' + ls_Num; end; celFind_Address.Cells[0, 0] := F_GetNumStr(gfniStrToInt(ls_Num)); end; end; procedure TApp_TOOLWBin.actEdit_ClearAddressExecute(Sender: TObject); begin celFind_Address.Cells[0, 0] := '0'; end; //------------------------------------------------------------------------------ //マウスでもオートセレクト procedure TApp_TOOLWBin.edtFind_AddressEnter(Sender: TObject); var l_Edit : TCustomEdit; begin if not(Sender is TCustomEdit) then begin Exit; end; l_Edit := Sender as TCustomEdit; if (gfnbKeyState(VK_LBUTTON)) or (gfnbKeyState(VK_RBUTTON)) then begin l_Edit.Tag := 1; end else begin l_Edit.Tag := 0; end; end; procedure TApp_TOOLWBin.edtFind_AddressMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var l_Edit : TCustomEdit; begin if not(Sender is TCustomEdit) then begin Exit; end; l_Edit := Sender as TCustomEdit; if (l_Edit.Tag = 1) then begin l_Edit.Tag := 0; l_Edit.SelectAll; end; end; //--- アドレス入力ボード ------------------------------------------------------- procedure TApp_TOOLWBin.shpKeyNumMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); //つかんで移動 begin if (Button = mbLeft) then begin ReleaseCapture; SendMessage(pnlKey_Address.Handle, WM_SYSCOMMAND, WPARAM(SC_SIZE or 9), 0); end; end; procedure TApp_TOOLWBin.btnKeyNum_0Click(Sender: TObject); //0..F入力 var ls_Num : String; li_Len : Integer; begin ls_Num := gfnsStrHeadTrim(celFind_Address.Cells[0, 0], '0'); li_Len := Length(ls_Num); if (li_Len >= F_iAddrWidth) then begin Beep; Exit; end else begin celFind_Address.Cells[0, 0] := ls_Num + Format('%x', [(Sender as TSpeedButton).Tag]); end; end; procedure TApp_TOOLWBin.actEdit_BackAddressExecute(Sender: TObject); //Back var ls_Num : String; begin //Back ls_Num := celFind_Address.Cells[0, 0]; if (gfniStrToInt(ls_Num) = 0) then begin //0なら何もしない end else begin //表示数値へ変換 ls_Num := Copy(ls_Num, 1, Length(ls_Num) -1); celFind_Address.Cells[0, 0] := F_GetAddressNum(ls_Num); end; end; procedure TApp_TOOLWBin.celFind_AddressResize(Sender: TObject); begin celFind_Address.ColWidths [0] := celFind_Address.ClientWidth; celFind_Address.RowHeights[0] := celFind_Address.ClientHeight; end; procedure TApp_TOOLWBin.celFind_AddressKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); //アドレス入力ボックス procedure lpc_AddrStrAdd(var iKey : Word); var ls_Num : String; li_Len : Integer; begin ls_Num := gfnsStrHeadTrim(celFind_Address.Cells[0, 0], '0'); li_Len := gfniMax([Length(ls_Num), 1]); if (li_Len >= F_iAddrWidth) then begin Beep; iKey := 0; Exit; end else begin celFind_Address.Cells[0, 0] := F_GetNumStr(F_GetNumInt(ls_Num + Char(iKey))); end; end; begin if (ssCtrl in Shift) then begin case Key of VK_UP : begin actFind_AddressGoToExecute(actFind_AddressUp); end; VK_DOWN : begin actFind_AddressGoToExecute(actFind_AddressDown); end; end; //デフォルト処理はすべて無効にする Key := 0; Exit; end; case Key of VK_0..VK_9, VK_NUMPAD0..VK_NUMPAD9 : begin //数値。許可。 lpc_AddrStrAdd(Key); end; VK_A..VK_F : begin //A-Z if (actFind_Addr16.Checked) then begin //16進表示。 lpc_AddrStrAdd(Key); end else begin //10進表示なら不許可。 Beep; Key := 0; end; end; Ord(',') : begin //3桁の区切り if (actFind_Addr16.Checked) then begin //16進表示なら不許可。 Beep; Key := 0; end else begin //10進表示なら許可。 lpc_AddrStrAdd(Key); end; end; VK_UP : begin //数値アップ spnFind_AddressUpClick(spnFind_Address); Key := 0; end; VK_DOWN : begin //数値ダウン spnFind_AddressDownClick(spnFind_Address); Key := 0; end; VK_BACK : begin //後退 actEdit_BackAddressExecute(nil); Key := 0 end; VK_DELETE : begin //消去 actEdit_ClearAddressExecute(nil); Key := 0; end; VK_ESCAPE : begin //閉じる btnKeyNum_CloseClick(nil); end; // VK_CONTROL, VK_SHIFT, VK_TAB, // VK_DELETE, // VK_BACK, VK_LEFT, VK_RIGHT, VK_HOME, VK_END : begin //許可 end; else begin Beep; Key := 0; end; end; end; procedure TApp_TOOLWBin.celFind_AddressKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); begin // if (ssCtrl in Shift) then begin case Key of VK_C : begin //コピー actEdit_CopyAddressExecute(nil); end; VK_V : begin //貼り付け actEdit_PasteAddressExecute(nil); end; end; //デフォルト処理はすべて無効にする Key := 0; Exit; end; case Key of VK_RETURN : begin //移動 actFind_AddressGoToExecute(nil); Key := 0; end; end; end; procedure TApp_TOOLWBin.celFind_AddressMouseWheelDown(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); begin spnFind_AddressDownClick(nil); end; procedure TApp_TOOLWBin.celFind_AddressMouseWheelUp(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); begin spnFind_AddressUpClick(nil); end; procedure TApp_TOOLWBin.celFind_AddressDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); const lci_MARGIN = 2; var lrc_Rect : TRect; begin lrc_Rect := Rect; with celFind_Address.Canvas do begin Font.Assign(celFind_Address.Font); // if (F_bAddrEnter) then begin if (GetFocus = celFind_Address.Handle) then begin Brush.Color := clHighlight; Font.Color := clHighlightText; end else if not(celFind_Address.Enabled) then begin Brush.Color := celFind_Address.Color; Font.Color := clGrayText; end else begin Brush.Color := celFind_Address.Color; Font.Color := celFind_Address.Font.Color; end; FillRect(lrc_Rect); Dec(lrc_Rect.Right, lci_MARGIN); DrawText(Handle, PChar(celFind_Address.Cells[ACol, ARow]), -1, lrc_Rect, DT_SINGLELINE or DT_NOPREFIX or DT_VCENTER or DT_RIGHT); end; end; //--- データ検索 --------------------------------------------------------------- procedure TApp_TOOLWBin.mniFind_DataClick(Sender: TObject); begin //メニューアイテムから呼ばれる。 if not(Sender is TMenuItem) then begin Exit; end; lstFind_Data.ItemIndex := (Sender as TMenuItem).MenuIndex; end; procedure TApp_TOOLWBin.actFind_DataInputExecute(Sender: TObject); begin // end; procedure TApp_TOOLWBin.lstFind_DataDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState); const lci_MARGIN = 2; var lrc_Rect : TRect; begin lrc_Rect := Rect; with lstFind_Data.Canvas do begin Font.Assign(lstFind_Data.Font); if (GetFocus = lstFind_Data.Handle) then begin Brush.Color := clHighlight; Font.Color := clHighlightText; end else if not(lstFind_Data.Enabled) then begin Brush.Color := lstFind_Data.Color; Font.Color := clGrayText; end else begin Brush.Color := lstFind_Data.Color; Font.Color := lstFind_Data.Font.Color; end; FillRect(lrc_Rect); Dec(lrc_Rect.Right, lci_MARGIN); DrawText(Handle, PChar(lstFind_Data.Items[Index]), -1, lrc_Rect, DT_SINGLELINE or DT_NOPREFIX or DT_VCENTER or DT_RIGHT); end; end; procedure TApp_TOOLWBin.edtFind_StringChange(Sender: TObject); begin lblFind_Data.Caption := gfnsStrToDump(edtFind_String.Text); end; procedure TApp_TOOLWBin.actFind_CancelExecute(Sender: TObject); begin F_bFindCancel := True; end; procedure TApp_TOOLWBin.actDisp_ValueExecute(Sender: TObject); begin if (actDisp_Value.Checked) then begin celValue.Show; Splitter1.Show; end else begin Splitter1.Hide; celValue.Hide; F_iTopRow := -1; celDispTopLeftChanged(nil); end; end; end.