帮忙修改一段小代码~关于16进制的显示 ( 积分: 100 )

  • 主题发起人 主题发起人 dreamones
  • 开始时间 开始时间
D

dreamones

Unregistered / Unconfirmed
GUEST, unregistred user!
从网上找到这么一段代码,可以将打开的文件以16进制的方式打开.
但发现有一个缺陷,就是这段代码是把文件转化为16进制串,然后载入内存,再一次性显示出来,所以,在打开比较大文件的时候,内存消耗会很大.不小心还会当机!
所以,我想这样修改:如果打开的文件大于某个数值(比如1M),那么就让它分成N段,每一段大小1M,显示完1M的数据之后再接着转换下一段数据,再显示出来......

无奈小弟比较菜,在这段代码改了半天,没改出个所以然来,所以希望各位帮忙修改一下,如果分数不够,我可以再加!谢谢啦

unit main;
{ Recently I needed a hex viewer with copy-to-clipboard facility,
which gave me an excuse to use the rich edit TConversion class.
The code is nothing flash, but as there's very little documentation
of the class I figured others might appreciate it.

This was meant for use with 64K-256K EPROM images, so don't expect
blazing performance with multi-megabyte files!

G.Walker, November 1996 Delphi 2.0 freeware
gw@enternet.com.au Use at own risk, etc
Version 1.4
}
interface

uses
Windows, Messages, SysUtils, Classes, Controls, Forms, Dialogs,
Menus, StdCtrls, ComCtrls;

type
TMainForm = class(TForm)
MainMenu1: TMainMenu;
MenuFile: TMenuItem;
MenuOpen: TMenuItem;
MenuSaveAs: TMenuItem;
N1: TMenuItem;
MenuExit: TMenuItem;
OpenDlg: TOpenDialog;
SaveDlg: TSaveDialog;
Rich: TRichEdit;
StatusBar: TStatusBar;
MenuPopup: TPopupMenu;
MenuSelectAll: TMenuItem;
MenuCopy: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure MenuOpenClick(Sender: TObject);
procedure MenuSaveAsClick(Sender: TObject);
procedure MenuExitClick(Sender: TObject);
procedure MenuPopupPopup(Sender: TObject);
procedure MenuSelectAllClick(Sender: TObject);
procedure MenuCopyClick(Sender: TObject);
private
procedure Progress(Address:LongInt);
end;

var
MainForm: TMainForm;

implementation

{$R *.DFM}

type
THexConversion = class(TConversion)
public
function ConvertReadStream(Stream:TStream; Buffer:PChar;
BufSize:integer): integer; override;
end;


// This implements a callback procedure used by TRichEdit when loading
// a file. Gets called repeatedly until stream is empty.
//
function THexConversion.ConvertReadStream(Stream:TStream; Buffer:PChar;
BufSize:integer): integer;
var s:string;
buf:array[1..16] of char;
i,n:integer;
begin
Result := 0;
if BufSize <= 82 then Exit;
s := Format(';%.5x ',[Stream.Position]);
n := Stream.Read(buf,16);
if n = 0 then Exit;
for i := 1 to n do
begin
AppendStr(s,IntToHex(ord(buf),2)+' ');
if i mod 4 = 0 then AppendStr(s,' ');
end;
AppendStr(s,StringOfChar(' ',62-length(s)));
for i := 1 to n do
begin
if (buf < #32) or (buf > #126) then
buf := '.';
AppendStr(s,buf);
end;
AppendStr(s,#13#10);
StrPCopy(Buffer,s);
Result := length(s);
if Stream.Position and $FFF = 0 then MainForm.Progress(Stream.Position);
end;

procedure TMainForm.Progress(Address:LongInt);
begin
StatusBar.SimpleText := 'Reading... $'+IntToHex(Address,5);
StatusBar.Update;
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
Rich.RegisterConversionFormat('bin',THexConversion);
Rich.RegisterConversionFormat('obj',THexConversion);
Rich.RegisterConversionFormat('exe',THexConversion);
end;

procedure TMainForm.MenuOpenClick(Sender: TObject);
var fname:string;
begin
if OpenDlg.Execute then
begin
try
Screen.Cursor := crHourglass;
fname := ExtractFileName(OpenDlg.Filename);
StatusBar.SimpleText := 'Reading...';
Rich.Lines.Clear;
Application.ProcessMessages;
try
Rich.Lines.LoadFromFile(OpenDlg.Filename);
StatusBar.SimpleText := fname;
except on E:EFOpenError do
begin
StatusBar.SimpleText := '';
MessageDlg(Format('Can''t open file %s.',[fname]),mtError,[mbOk],0);
end;
end;
finally
Screen.Cursor := crDefault;
end;
end;
end;


procedure TMainForm.MenuSaveAsClick(Sender: TObject);
begin
SaveDlg.Filename := ChangeFileExt(OpenDlg.FileName,'.txt');
if SaveDlg.Execute then
Rich.Lines.SaveToFile(SaveDlg.FileName);
end;

procedure TMainForm.MenuExitClick(Sender: TObject);
begin
Close;
end;

procedure TMainForm.MenuPopupPopup(Sender: TObject);
var SelStart,SelEnd:LongInt;
begin
Rich.Perform(EM_GETSEL,WPARAM(@SelStart),WPARAM(@SelEnd));
MenuCopy.Enabled := SelStart <> SelEnd;
end;

procedure TMainForm.MenuSelectAllClick(Sender: TObject);
begin
Rich.Perform(EM_SETSEL,0,-1);
end;

procedure TMainForm.MenuCopyClick(Sender: TObject);
begin
Rich.Perform(WM_COPY,0,0);
end;

end.

哦,对了.这个RegisterConversionFormat是什么东东,哪位兄弟能讲讲它的用途和功能.谢谢@!
 
从网上找到这么一段代码,可以将打开的文件以16进制的方式打开.
但发现有一个缺陷,就是这段代码是把文件转化为16进制串,然后载入内存,再一次性显示出来,所以,在打开比较大文件的时候,内存消耗会很大.不小心还会当机!
所以,我想这样修改:如果打开的文件大于某个数值(比如1M),那么就让它分成N段,每一段大小1M,显示完1M的数据之后再接着转换下一段数据,再显示出来......

无奈小弟比较菜,在这段代码改了半天,没改出个所以然来,所以希望各位帮忙修改一下,如果分数不够,我可以再加!谢谢啦

unit main;
{ Recently I needed a hex viewer with copy-to-clipboard facility,
which gave me an excuse to use the rich edit TConversion class.
The code is nothing flash, but as there's very little documentation
of the class I figured others might appreciate it.

This was meant for use with 64K-256K EPROM images, so don't expect
blazing performance with multi-megabyte files!

G.Walker, November 1996 Delphi 2.0 freeware
gw@enternet.com.au Use at own risk, etc
Version 1.4
}
interface

uses
Windows, Messages, SysUtils, Classes, Controls, Forms, Dialogs,
Menus, StdCtrls, ComCtrls;

type
TMainForm = class(TForm)
MainMenu1: TMainMenu;
MenuFile: TMenuItem;
MenuOpen: TMenuItem;
MenuSaveAs: TMenuItem;
N1: TMenuItem;
MenuExit: TMenuItem;
OpenDlg: TOpenDialog;
SaveDlg: TSaveDialog;
Rich: TRichEdit;
StatusBar: TStatusBar;
MenuPopup: TPopupMenu;
MenuSelectAll: TMenuItem;
MenuCopy: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure MenuOpenClick(Sender: TObject);
procedure MenuSaveAsClick(Sender: TObject);
procedure MenuExitClick(Sender: TObject);
procedure MenuPopupPopup(Sender: TObject);
procedure MenuSelectAllClick(Sender: TObject);
procedure MenuCopyClick(Sender: TObject);
private
procedure Progress(Address:LongInt);
end;

var
MainForm: TMainForm;

implementation

{$R *.DFM}

type
THexConversion = class(TConversion)
public
function ConvertReadStream(Stream:TStream; Buffer:PChar;
BufSize:integer): integer; override;
end;


// This implements a callback procedure used by TRichEdit when loading
// a file. Gets called repeatedly until stream is empty.
//
function THexConversion.ConvertReadStream(Stream:TStream; Buffer:PChar;
BufSize:integer): integer;
var s:string;
buf:array[1..16] of char;
i,n:integer;
begin
Result := 0;
if BufSize <= 82 then Exit;
s := Format(';%.5x ',[Stream.Position]);
n := Stream.Read(buf,16);
if n = 0 then Exit;
for i := 1 to n do
begin
AppendStr(s,IntToHex(ord(buf),2)+' ');
if i mod 4 = 0 then AppendStr(s,' ');
end;
AppendStr(s,StringOfChar(' ',62-length(s)));
for i := 1 to n do
begin
if (buf < #32) or (buf > #126) then
buf := '.';
AppendStr(s,buf);
end;
AppendStr(s,#13#10);
StrPCopy(Buffer,s);
Result := length(s);
if Stream.Position and $FFF = 0 then MainForm.Progress(Stream.Position);
end;

procedure TMainForm.Progress(Address:LongInt);
begin
StatusBar.SimpleText := 'Reading... $'+IntToHex(Address,5);
StatusBar.Update;
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
Rich.RegisterConversionFormat('bin',THexConversion);
Rich.RegisterConversionFormat('obj',THexConversion);
Rich.RegisterConversionFormat('exe',THexConversion);
end;

procedure TMainForm.MenuOpenClick(Sender: TObject);
var fname:string;
begin
if OpenDlg.Execute then
begin
try
Screen.Cursor := crHourglass;
fname := ExtractFileName(OpenDlg.Filename);
StatusBar.SimpleText := 'Reading...';
Rich.Lines.Clear;
Application.ProcessMessages;
try
Rich.Lines.LoadFromFile(OpenDlg.Filename);
StatusBar.SimpleText := fname;
except on E:EFOpenError do
begin
StatusBar.SimpleText := '';
MessageDlg(Format('Can''t open file %s.',[fname]),mtError,[mbOk],0);
end;
end;
finally
Screen.Cursor := crDefault;
end;
end;
end;


procedure TMainForm.MenuSaveAsClick(Sender: TObject);
begin
SaveDlg.Filename := ChangeFileExt(OpenDlg.FileName,'.txt');
if SaveDlg.Execute then
Rich.Lines.SaveToFile(SaveDlg.FileName);
end;

procedure TMainForm.MenuExitClick(Sender: TObject);
begin
Close;
end;

procedure TMainForm.MenuPopupPopup(Sender: TObject);
var SelStart,SelEnd:LongInt;
begin
Rich.Perform(EM_GETSEL,WPARAM(@SelStart),WPARAM(@SelEnd));
MenuCopy.Enabled := SelStart <> SelEnd;
end;

procedure TMainForm.MenuSelectAllClick(Sender: TObject);
begin
Rich.Perform(EM_SETSEL,0,-1);
end;

procedure TMainForm.MenuCopyClick(Sender: TObject);
begin
Rich.Perform(WM_COPY,0,0);
end;

end.

哦,对了.这个RegisterConversionFormat是什么东东,哪位兄弟能讲讲它的用途和功能.谢谢@!
 
用RichEdit是无法达到你想要的那种效果的，你不妨找个专门的十六进制编辑器组件；
RegisterConversionFormat你可以查一下TRichEdit的帮助。
 
我不要组件啊.....
 
真的没人帮忙吗??
应该不难啊...........
 
跟踪执行会发现，THexConversion一次执行读入4000多个字节，这是死的，变不了了。
如果自己用TStream读入的话，当装载入Richedit时，会发生很多错误，很麻烦
 
那应该怎么办呢?
请问Bluesadman,有没有比较好一点的方案?
 
procedure TMainForm.MenuOpenClick(Sender: TObject);
var fname:string;
begin
if OpenDlg.Execute then
begin
try
Screen.Cursor := crHourglass;
fname := ExtractFileName(OpenDlg.Filename);
StatusBar.SimpleText := 'Reading...';
Rich.Lines.Clear;
Application.ProcessMessages;
try
Rich.Lines.LoadFromFile(OpenDlg.Filename);//不要用这种方法读入文件,他肯定会全部读入
StatusBar.SimpleText := fname;
except on E:EFOpenError do
begin
StatusBar.SimpleText := '';
MessageDlg(Format('Can''t open file %s.',[fname]),mtError,[mbOk],0);
end;
end;
finally
Screen.Cursor := crDefault;
end;
end;
end;
 
还是推荐别的控件，如 SynEdit，RichEdit 等会全部载入，比较好的方法是用内存映象文件，他不会全部载入，只有在用时读取，这个与 winhex、ultraedit 的处理方式是一致的。
 
一个N久前写的hex显示控件的最初的版本，里面还不少垃圾，显示时效率也不太高，好像按键也没有处理。后来改进的找不到了：（不过这个东西，最后没有能坚持写完，发出来或许对你有点帮助。
要分段载入的话，改一下procedure THexEdt.LoadFile(fName:string);
把stream改为用映射文件打开，自己读入需要显示的部分，不难。
或者找minihex，有源码的。

unit myhexgrid;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Clipbrd;

type
TColorTheme=record
FColor:TColor;
BColor:TColor;
end;

TTextBorder=(baTop,baLeft,baRight,baBottom);
TBorderState=(bsActive,bsHover,bsDeactive);

TBorderColors=record
AcitveColorTheme:TColorTheme;
HoverColorTheme:TColorTheme;
DeacitveColorTheme:TColorTheme;
end;

TBorderAttr=record
TextBorder:TTextBorder;
BorderState:TBorderState;
BorderColors:TBorderColors;
end;

TTextAttr=record
FColor:TColor;
BColor:TColor;
BorderAttr:TBorderAttr;
end;

TColType=(inAddrCol,inHexCol,inChrCol,inMargin);

TCurCrood=record
Row:integer;
Col:integer;
ColType:TColType;
CommentRow:bool;
end;

TCurCharPos=record
XPos:integer;
YPos:integer;
HiBtye:bool;
end;

THexEdt=class(TCustomControl)
private
FStream:TMemoryStream; //缓冲区
FRowCount:integer; //总行数
FTopRow:integer; //顶行的绝对行号(based 0)
FAbsRow:integer; //光标所在的绝对行号(based 0)
FCurCol:integer; //光标所在的列号(based 0)
FVisRowCount:integer; //窗口所能容纳的行数
FCharWidth: Integer; //字符宽度
FCharHeight: Integer; //字符高度
FColors:TColorTheme;
FMargin: Integer; //边界宽度
public
procedure DrawAddr(AbsRow:integer);
procedure DrawHex(AbsRow:integer);
procedure DrawChr(AbsRow:integer);
procedure DrawCompoundRow(AbsRow:integer);
procedure DrawHexRow(AbsRow:integer);
procedure DrawCommentRow(AbsRow:integer);
procedure DrawAllVisRow(stRow:integer);
procedure Clear;

procedure DoScroll(OffRow:integer;Immedia:bool);

function MouseCoord(X,Y:integer):TCurCrood;
function GetCurCharPos(CurCrood:TCurCrood):TCurCharPos;

procedure LoadFile(fName:string);

constructor Create(AOwner: TComponent); override;
destructor Destroy; override;

procedure test1;
procedure WMVScroll(var Msg: TWMVScroll); message WM_VSCROLL;
protected
procedure CreateParams(var Params: TCreateParams); override;
procedure Loaded; override;
procedure Paint; override;
procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
procedure WMSize(var Message:TWMSIZE);message WM_SIZE;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
{ procedure KeyUp(var Key: Word; Shift: TShiftState); override;
procedure KeyPress(var Key: Char); override; }
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
{ procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; }
function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean; override;
// function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override;
// function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override;
procedure ResetDsp;
procedure InitCharSize;
procedure InitFont;
end;

const
AddrHexTab:array [0..15] of char='0123456789abcdef';
HexTab:array [0..15] of char='0123456789ABCDEF';
HexRowBufLength=52;
AddrRowBufLength=11;
ChrRowBufLength=16;

var
RowBuf:Array [0..15] of char;
LastLineLength:integer;

implementation

uses hexgrid;

procedure THexEdt.Clear;
begin
FStream.Clear;
ResetDsp;
end;

procedure THexEdt.WMSize(var Message:TWMSIZE);
begin
ResetDsp;
Repaint;
end;

procedure THexEdt.WMSetFocus(var Message: TWMSetFocus);
begin
inherited;
form1.caption:='!!';
ResetDsp;
end;

procedure THexEdt.KeyDown(var Key: Word; Shift: TShiftState);
begin
if FRowCount=0 then exit;
form1.caption:='XX';
case Key of
ord('X'): dec(FTopRow);
end;
SetScrollPos(Handle,SB_VERT,FTopRow,true);
DrawAllVisRow(FTopRow);
exit;
end;

function THexEdt.GetCurCharPos(CurCrood:TCurCrood):TCurCharPos;
begin
result.YPos:=CurCrood.Row;
if CurCrood.ColType=inHexCol then
begin
case CurCrood.Col of
0..2: begin
result.XPos:=1;
if CurCrood.Col=0 then
result.HiBtye:=true
else
result.HiBtye:=false;
end;
3..5: begin
result.XPos:=2;
if CurCrood.Col=3 then
result.HiBtye:=true
else
result.HiBtye:=false;
end;
6..8: begin
result.XPos:=3;
if CurCrood.Col=6 then
result.HiBtye:=true
else
result.HiBtye:=false;
end;
9..11: begin
result.XPos:=4;
if CurCrood.Col=9 then
result.HiBtye:=true
else
result.HiBtye:=false;
end;
end;
end;
end;

function THexEdt.MouseCoord(X,Y:integer):TCurCrood;
//const
// Blank=(2,5,8,11,12,15,18,21,24,25,28,31,34,35,38,41,44,47);
var
// cx,cy:integer;
row,col:integer;
hr,cr:integer;
begin
hr:=fmargin+fcharwidth*AddrRowBufLength;
cr:=fmargin*2+fcharwidth*(AddrRowBufLength+HexRowBufLength);
if (x-fmargin)>0 then
begin
if x<hr then //Addr
begin
col:=(x-fmargin) div FCharWidth;
result.ColType:=inAddrCol;
end
else if (x<cr) then //Hex
begin
col:=(x-fmargin-hr) div FCharWidth;
result.ColType:=inHexCol;
end
else if x>=cr then //Char
begin
col:=(x-cr-FMargin) div FCharWidth;
if col>ChrRowBufLength then col:=ChrRowBufLength-1;
result.ColType:=inChrCol;
end;
end
else
result.ColType:=inMargin;
if y-Fmargin>0 then
row:=(y-FMargin) div FCharHeight
else
result.ColType:=inMargin;

Result.Row:=row div 2;
Result.Col:=Col;
if row mod 2=0 then
begin
Result.CommentRow:=false
end
else
begin
Result.CommentRow:=true;
end;
end;

procedure THexEdt.WMVScroll(var Msg: TWMVScroll);
var
tmp: Integer;
ScrInfo: TScrollInfo;
begin
tmp:=FTopRow;
FillChar(ScrInfo, SizeOf(ScrInfo), 0);
ScrInfo.cbSize := SizeOf(ScrInfo);
ScrInfo.fMask := SIF_ALL;
GetScrollInfo(Handle, SB_VERT, ScrInfo);
case Msg.ScrollCode of
SB_LINEUP : DoScroll(-1,false);
SB_LINEDOWN : DoScroll(1,false);
SB_PAGEUP : DoScroll(-FVisRowCount,false);
SB_PAGEDOWN : DoScroll(FVisRowCount,false);
SB_THUMBTRACK, SB_THUMBPOSITION : DoScroll(ScrInfo.nTrackPos,true);
SB_TOP : DoScroll(0,true);
SB_BOTTOM : DoScroll(ScrInfo.nPos-FVisRowCount,true);
end;
if tmp<>FTopRow then DrawAllVisRow(FTopRow);
SetFocus;
end;

procedure THexEdt.DoScroll(OffRow:integer;Immedia:bool);
begin
if not Immedia then inc(FTopRow,OffRow) else FTopRow:=OffRow;
if FTopRow<0 then FTopRow:=0 else if FTopRow>FRowCount-FVisRowCount+5 then FTopRow:=FRowCount-FVisRowCount;
SetScrollPos(Handle,SB_VERT,FTopRow,true);
end;

function THexEdt.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean;
var
i,tmp:integer;
begin
if FRowCount=0 then exit;
tmp:=FTopRow;
i:=WheelDelta div 120;
if i=1 then DoScroll(-1,false)
else if i=-1 then DoScroll(1,false)
else if i>1 then DoScroll(-3*(i-1),false)
else if i<-1 then DoScroll(-3*(i+1),false);
// form1.Caption:=inttostr(xxx);
if tmp<>FTopRow then DrawAllVisRow(FTopRow);
Result := true;
end;

procedure THexEdt.MouseDown(Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
cc:TCurCrood;
s:string;
begin
SetFocus;
if FRowCount=0 then exit;
cc:=MouseCoord(X,Y);
// GetCurCharPos(cc).YPos;
if cc.ColType<>inMargin then
begin
FCurCol:=cc.Col;
FabsRow:=cc.Row+FTopRow;
end;

form1.Caption:=inttostr(cc.Row+FTopRow)+':'+inttostr(GetCurCharPos(cc).XPos);
case cc.ColType of
inaddrcol:s:='ADDR';
inHexcol:s:='hex';
inchrcol:s:='char';
inMargin:s:='Margin';
end;
if cc.CommentRow then
form1.Caption:=form1.Caption+'<<'+'Comment!!'
else
form1.Caption:=form1.Caption+'<<'+s;
end;

procedure THexEdt.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
with Params do
begin
Style := Style or WS_TABSTOP;
Style := Style or WS_VSCROLL;
WindowClass.style := CS_DBLCLKS;
Style := Style and not WS_BORDER;
ExStyle := ExStyle or WS_EX_STATICEDGE;
end;
end;

procedure THexEdt.test1;
begin
LoadFile('C:/2.txt');
FTopRow:=0;
DrawAllVisRow(0);
end;

procedure THexEdt.Paint;
begin
inherited;
// if self.Showing then exit;
DrawAllVisRow(FTopRow);
end;

constructor THexEdt.Create(AOwner: TComponent);
const
EditStyle = [csClickEvents, csSetCaption, csCaptureMouse,
csDoubleClicks, csFixedHeight];
begin
inherited;
DoubleBuffered:=true;
// if NewStyleControls then
// ControlStyle := EditStyle else
ControlStyle := EditStyle + [csFramed];
FStream:=TMemoryStream.Create;
FColors.BColor:=clWhite;
FColors.FColor:=clBlack;
FRowCount:=0;
end;

destructor THexEdt.Destroy;
begin
FStream.Clear;
inherited;
end;

procedure THexEdt.Loaded;
begin
inherited;
// ResetDsp;
end;

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

procedure THexEdt.InitFont;
begin
with Canvas.Font do
begin
Name := 'Courier New';
Size :=-12;
Pitch:=fpFixed;
Charset := DEFAULT_CHARSET;
Color := clBlack;
end;
end;

procedure THexEdt.LoadFile(fName:string);
begin
LastLineLength:=0;
FCurCol:=0;
FAbsRow:=0;
try
FStream.LoadFromFile(fName);
FStream.Position:=0;
if FStream.Size mod 16=0 then
FRowCount:=FStream.Size div 16
else
FRowCount:=FStream.Size div 16 +1;
finally
ResetDsp;
Repaint;
end;
end;

procedure THexEdt.DrawAddr(AbsRow:integer);
var
X,Y:integer;
AddrChr:Array [1..11] of char;
begin
X:=0;
y:=(AbsRow-FTopRow)*FCharHeight+FMargin;
Canvas.Brush.Color := FColors.BColor;
Canvas.FillRect(Rect(0,Y-FMargin,X+FCharWidth*11+FMargin,Y+FCharHeight));
// Canvas.Brush.Color := FColors.BColor;
Canvas.Font.Color := FColors.FColor;
AbsRow:=AbsRow*$10;
AddrChr[1]:=AddrHexTab[(AbsRow and $F0000000) shr 28];
AddrChr[2]:=AddrHexTab[(AbsRow and $0F000000) shr 24];
AddrChr[3]:=AddrHexTab[(AbsRow and $00F00000) shr 20];
AddrChr[4]:=AddrHexTab[(AbsRow and $000F0000) shr 16];
AddrChr[5]:=AddrHexTab[(AbsRow and $0000F000) shr 12];
AddrChr[6]:=AddrHexTab[(AbsRow and $00000F00) shr 8];
AddrChr[7]:=AddrHexTab[(AbsRow and $000000F0) shr 4];
AddrChr[8]:=AddrHexTab[(AbsRow and $0000000F)];
AddrChr[9]:='h';
AddrChr[10]:=':';
AddrChr[11]:=' ';
Canvas.TextOut(X+FMargin, Y, AddrChr);
end;

procedure THexEdt.DrawHex(AbsRow:integer);
var
X,Y:integer;
HexBuf:Array [0..HexRowBufLength]of char;
i,j:integer;
begin
X:=FCharWidth*AddrRowBufLength+FMargin;
y:=(AbsRow-FTopRow)*FCharHeight+FMargin;
Canvas.Brush.Color := FColors.BColor;
Canvas.FillRect(Rect(X,Y-FMargin,X+FCharWidth*HexRowBufLength+FMargin*2,Y+FCharHeight));
// Canvas.Brush.Color := FColors.BColor;
Canvas.Font.Color := FColors.FColor;
FStream.Position:=AbsRow*16;
FillMemory(@RowBuf,16,$20);
LastLineLength:=FStream.Read(RowBuf,16);
FillChar(HexBuf,HexRowBufLength,$20);
i:=0;
j:=0;
repeat
HexBuf:=HexTab[(ord(RowBuf[j]) and $F0) shr 4];
HexBuf[i+1]:=HexTab[ord(RowBuf[j]) and $0F];
inc(i,3); inc(j);
case j of 4,8,12:inc(i); end;
until (i>=HexRowBufLength) or (j=LastLineLength);
Canvas.TextOut(X+FMargin, Y, HexBuf+';');
end;

procedure THexEdt.DrawChr(AbsRow:integer);
var
X,Y:integer;
i:integer;
begin
X:=FCharWidth*(HexRowBufLength+AddrRowBufLength)+FMargin*2;
y:=(AbsRow-FTopRow)*FCharHeight+FMargin;
Canvas.Brush.Color := FColors.BColor;
Canvas.FillRect(Rect(X,Y-FMargin,Width,Y+FCharHeight));
// Canvas.Brush.Color := FColors.BColor;
Canvas.Font.Color := FColors.FColor;
for i:=0 to 15 do if (ord(RowBuf)<$20) or (ord(RowBuf)=$FF) then RowBuf:='.';
Canvas.TextOut(X+FMargin, Y, RowBuf);
end;

procedure THexEdt.DrawCommentRow(AbsRow:integer);
var
X,Y:integer;
begin
X:=FMargin;
y:=((AbsRow-FTopRow)*2+1)*FCharHeight+FMargin;
Canvas.Brush.Color := FColors.BColor;
Canvas.FillRect(Rect(0,Y-FMargin,Width,Y+FCharHeight));
end;

procedure THexEdt.DrawCompoundRow(AbsRow:integer);
begin
DrawHexRow(AbsRow);
// DrawCommentRow(AbsRow);
end;

procedure THexEdt.DrawHexRow(AbsRow:integer);
begin
DrawAddr(AbsRow);
DrawHex(AbsRow);
DrawChr(AbsRow);
end;

procedure THexEdt.DrawAllVisRow(stRow:integer);
var
i,j:integer;
begin
if stRow<0 then exit;
j:=stRow + FVisRowCount;
if j>=FRowCount then
begin
j:=FRowCount-1;
Canvas.Brush.Color := FColors.BColor;
Canvas.FillRect(ClientRect);
end;
for i:=j downto stRow do//to j do
DrawCompoundRow(i);
form1.caption:=inttostr(j);
end;

procedure THexEdt.ResetDsp;
begin
FColors.BColor:=clWhite;
FColors.FColor:=clBlack;
InitFont;
InitCharSize;
FVisRowCount:=(Height div FCharHeight + 1);// div 2;
FColors.FColor:=clBlack;
FColors.BColor:=clWhite;
FMargin:=3;
Canvas.Brush.Color := FColors.BColor;
Canvas.FillRect(ClientRect);
SetScrollRange(Handle,SB_VERT,0,FRowCount-FVisRowCount-1,True);
end;


end.
 
哇,好长........
我慢慢消化...
 
多人接受答案了。
 
您必须登录或注册才可回复。

Similar threads

J
为什么我删除不了进程呢？看看下面的代码(100分)
回复
8
查看
225
jadesun
J
X
菜鸟不会进行时间计算，请大侠帮忙，假设我设定我的软件2003-5-27号过期，我的代码怎么不好使啊？(50分)
回复
5
查看
155
zhukewen
Z
你
帮我看看我段代码是关于加密，解密的(50分)
回复
2
查看
195
你若有情
你
L
我想用下面代码实现下载文件（这已实行），问怎样显示下载进度！ (100分)
回复
10
查看
152
iapollo
I
未
读内存 16进制显示(500分)(100分)
2
回复
38
查看
479
未来107
未
后退
顶部