unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls;
type
TForm1 = class(TForm)
Image1: TImage;
FontDialog1: TFontDialog;
Edit1: TEdit;
Button1: TButton;
Memo1: TMemo;
Button2: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
procedure sendpicture(kuan, gao: byte);
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.sendpicture(kuan:byte;gao:byte);//发送一幅图片 取得点陣数据
var
x,y,i,j:integer;
b,b1:byte;
r:byte;
c:integer;
display:string;
DIS1:integer;
begin
for j:=1 to 1 do
for y:=0 to gao-1 do
for x:=1 to kuan do
begin
b1:=01;
b:=0;
//for i:=(x-1)*8 to (x-1)*8+7 do
for i:=(x-1)*8+7 downto (x-1)*8 do
begin
c:=getpixel(form1.image1.canvas.handle,i,y);//取点(颜色值)
r:=GetRvalue(c);//红色分量
// g:=Getgvalue(c);//绿色分量
if j=1 then
begin
if r>0 then b:=b or b1;
end else
if j=2 then
begin
// if g>0 then b:=b or b1;
end;
b1:=b1 shl 1;
end;
display:=inttohex(b,2);
display:='0x'+display+',';
memo1.Lines.Add(display);
//sentdata(chr(b));
end;
memo1.Lines.Add('};');
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
image1.Canvas.Font:=fontdialog1.Font;
image1.Canvas.Font.Color:=clred;
image1.Canvas.Brush.Color:=clblack;
image1.Canvas.Pen.Color:=clblack;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
form1.Image1.Canvas.Rectangle(form1.image1.clientrect);
form1.Image1.Canvas.TextOut(0,0,form1.Edit1.Text);
memo1.Lines.Clear;
memo1.Lines.Add('{ /*'+edit1.Text+'*/');
sendpicture(2,16)
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
if form1.FontDialog1.Execute then
begin
image1.Canvas.Font.Name:=fontdialog1.Font.Name;
image1.Canvas.Font.Color:=fontdialog1.Font.Color;
image1.Canvas.Font.Style:=fontdialog1.Font.Style;
image1.Canvas.Font.Size:=fontdialog1.Font.Size;
end;
end;
end.
这是一个16*16点阵提取的DELPHI源程序
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls;
type
TForm1 = class(TForm)
Image1: TImage;
FontDialog1: TFontDialog;
Edit1: TEdit;
Button1: TButton;
Memo1: TMemo;
Button2: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
procedure sendpicture(kuan, gao: byte);
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.sendpicture(kuan:byte;gao:byte);//发送一幅图片 取得点陣数据
var
x,y,i,j:integer;
b,b1:byte;
r:byte;
c:integer;
display:string;
DIS1:integer;
begin
for j:=1 to 1 do
for y:=0 to gao-1 do
for x:=1 to kuan do
begin
b1:=01;
b:=0;
//for i:=(x-1)*8 to (x-1)*8+7 do
for i:=(x-1)*8+7 downto (x-1)*8 do
begin
c:=getpixel(form1.image1.canvas.handle,i,y);//取点(颜色值)
r:=GetRvalue(c);//红色分量
// g:=Getgvalue(c);//绿色分量
if j=1 then
begin
if r>0 then b:=b or b1;
end else
if j=2 then
begin
// if g>0 then b:=b or b1;
end;
b1:=b1 shl 1;
end;
display:=inttohex(b,2);
display:='0x'+display+',';
memo1.Lines.Add(display);
//sentdata(chr(b));
end;
memo1.Lines.Add('};');
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
image1.Canvas.Font:=fontdialog1.Font;
image1.Canvas.Font.Color:=clred;
image1.Canvas.Brush.Color:=clblack;
image1.Canvas.Pen.Color:=clblack;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
form1.Image1.Canvas.Rectangle(form1.image1.clientrect);
form1.Image1.Canvas.TextOut(0,0,form1.Edit1.Text);
memo1.Lines.Clear;
memo1.Lines.Add('{ /*'+edit1.Text+'*/');
sendpicture(2,16)
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
if form1.FontDialog1.Execute then
begin
image1.Canvas.Font.Name:=fontdialog1.Font.Name;
image1.Canvas.Font.Color:=fontdialog1.Font.Color;
image1.Canvas.Font.Style:=fontdialog1.Font.Style;
image1.Canvas.Font.Size:=fontdialog1.Font.Size;
end;
end;
end.
这是一个16*16点阵提取的DELPHI源程序