如何以二进制方式把bmp显示在Memo里？ ( 积分: 100 )

请教：如何以二进制方式把bmp显示在Memo里？即01010001101.........

请教：如何以二进制方式把bmp显示在Memo里？即01010001101.........

type
TDisplayProc = procedure(const s: string) of object;

procedure ShowBinary(var Data; Count: Cardinal; DispProc: TDisplayProc);

implementation


procedure ShowBinary(var Data; Count: Cardinal; DispProc: TDisplayProc);
var
line: string[80];
i: Cardinal;
p: PChar;
nStr: string[4];
const
posStart = 1;
binStart = 7;
ascStart = 57;
HexChars: PChar = '0123456789ABCDEF';
begin
p := @Data;
line := '';
for i := 0 to Count - 1 do
begin
if (i mod 16) = 0 then
begin
if Length(line) > 0 then
DispProc(line);
FillChar(line, SizeOf(line), ' ');
line[0] := Chr(72);
nStr := Format('%4.4X', );
Move(nStr[1], line[posStart], Length(nStr));
line[posStart + 4] := ':';
end;
if p >= ' ' then
line[i mod 16 + ascStart] := p
else
line[i mod 16 + ascStart] := '.';
line[binStart + 3 * (i mod 16)] := HexChars[(Ord(p) shr 4) and $F];
line[binStart + 3 * (i mod 16) + 1] := HexChars[Ord(p) and $F];
end;
DispProc(line);
end;


procedure TForm1.Display(const S: string);
begin
Memo1.Lines.Add(S);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
ms: TMemoryStream;
begin
if Opendialog1.Execute then
begin
ms := TMemoryStream.Create;
try
ms.LoadFromfile(OpenDialog1.FileName);
ShowBinary(ms.Memory^, ms.Size, Display);
finally
ms.Free
end;
end;
end;

function inttobin(value:longint):string;
var
i: integer;
begin
result:='';
for i:=8 downto 0 do begin
if value and (1 shl i)<>0 then begin
result:=result+'1';
end else begin
result:=result+'0';
end;
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
f:file of char;
c:char;
i:integer;
begin
assignfile(f,'c:/1.bmp');
reset(f);
for i:=1 to filesize(f) do
begin
read(f,c);
memo1.lines.add(inttobin(ord(c))+' ');
end;
closefile(f);
end;

用Base64转换后存在Memo中
然后从Memo中转换到Image

const
//BaseTable为BASE64码表
BaseTable:string='ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/=';

function FindInTable(CSource:char):integer;
begin
result:=Pos(string(CSource),BaseTable)-1;
end;

//编码函数
function EncodeBase64(Source:string):string;
var
Times,LenSrc,i:integer;
x1,x2,x3,x4:char;
xt:byte;
begin
result:='';
LenSrc:=length(Source);
if LenSrc mod 3 =0 then Times:=LenSrc div 3
else Times:=LenSrc div 3 + 1;
for i:=0 to times-1 do
begin
if LenSrc >= (3+i*3) then
begin
x1:=BaseTable[(ord(Source[1+i*3]) shr 2)+1];
xt:=(ord(Source[1+i*3]) shl 4) and 48;
xt:=xt or (ord(Source[2+i*3]) shr 4);
x2:=BaseTable[xt+1];
xt:=(Ord(Source[2+i*3]) shl 2) and 60;
xt:=xt or (ord(Source[3+i*3]) shr 6);
x3:=BaseTable[xt+1];
xt:=(ord(Source[3+i*3]) and 63);
x4:=BaseTable[xt+1];
end
else if LenSrc>=(2+i*3) then
begin
x1:=BaseTable[(ord(Source[1+i*3]) shr 2)+1];
xt:=(ord(Source[1+i*3]) shl 4) and 48;
xt:=xt or (ord(Source[2+i*3]) shr 4);
x2:=BaseTable[xt+1];
xt:=(ord(Source[2+i*3]) shl 2) and 60;
x3:=BaseTable[xt+1];
x4:='=';
end else
begin
x1:=BaseTable[(ord(Source[1+i*3]) shr 2)+1];
xt:=(ord(Source[1+i*3]) shl 4) and 48;
x2:=BaseTable[xt+1];
x3:='=';
x4:='=';
end;
result:=result+x1+x2+x3+x4;
end;
end;

//解码函数
function DecodeBase64(Source:string):string;
var
SrcLen,Times,i:integer;
x1,x2,x3,x4,xt:byte;
begin
result:='';
SrcLen:=Length(Source);
Times:=SrcLen div 4;
for i:=0 to Times-1 do
begin
x1:=FindInTable(Source[1+i*4]);
x2:=FindInTable(Source[2+i*4]);
x3:=FindInTable(Source[3+i*4]);
x4:=FindInTable(Source[4+i*4]);
x1:=x1 shl 2;
xt:=x2 shr 4;
x1:=x1 or xt;
x2:=x2 shl 4;
result:=result+chr(x1);
if x3= 64 then break;
xt:=x3 shr 2;
x2:=x2 or xt;
x3:=x3 shl 6;
result:=result+chr(x2);
if x4=64 then break;
x3:=x3 or x4;
result:=result+chr(x3);
end;
end;

找了个代码，原理类似，看有参考价值没有
unit Main;


interface

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

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

TForm1 = class(TForm)
RichEdit1: TRichEdit;
StatusBar1: TStatusBar;
OpenDlg: TOpenDialog;
SaveDlg: TSaveDialog;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
BitBtn3: TBitBtn;
procedure FormCreate(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure BitBtn3Click(Sender: TObject);
private
procedure Progress(Address: LongInt);
end;

var
Form1: TForm1;

implementation

{$R *.DFM}



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 Form1.Progress(Stream.Position);
end;

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

procedure TForm1.FormCreate(Sender: TObject);
begin
RichEdit1.RegisterConversionFormat('bin', THexConversion);
RichEdit1.RegisterConversionFormat('obj', THexConversion);
RichEdit1.RegisterConversionFormat('bmp', THexConversion);
end;

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

procedure TForm1.BitBtn2Click(Sender: TObject);
begin
SaveDlg.Filename := ChangeFileExt(OpenDlg.Filename, '.txt');
if SaveDlg.Execute then
RichEdit1.Lines.SaveToFile(SaveDlg.Filename);
end;

procedure TForm1.BitBtn3Click(Sender: TObject);
begin
Close;
end;

end.


object Form1: TForm1
Left = 190
Top = 107
Width = 521
Height = 398
BorderIcons = [biSystemMenu, biMinimize]
Caption = 'RichEdit读取二进制文件示例'
Color = clBtnFace
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = '宋体'
Font.Style = []
OldCreateOrder = False
Position = poScreenCenter
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 12
object RichEdit1: TRichEdit
Left = 4
Top = 8
Width = 497
Height = 301
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ImeName = '中文 (简体) - 拼音加加3.11'
ParentFont = False
ScrollBars = ssVertical
TabOrder = 0
end
object StatusBar1: TStatusBar
Left = 0
Top = 350
Width = 513
Height = 21
Panels = <>
SimplePanel = False
end
object BitBtn1: TBitBtn
Left = 252
Top = 316
Width = 75
Height = 25
Caption = '打开'
TabOrder = 2
OnClick = BitBtn1Click
end
object BitBtn2: TBitBtn
Left = 340
Top = 316
Width = 75
Height = 25
Caption = '保存'
TabOrder = 3
OnClick = BitBtn2Click
end
object BitBtn3: TBitBtn
Left = 428
Top = 316
Width = 75
Height = 25
Caption = '退出'
TabOrder = 4
OnClick = BitBtn3Click
end
object OpenDlg: TOpenDialog
Left = 544
Top = 76
end
object SaveDlg: TSaveDialog
Left = 556
Top = 144
end
end