• 博客园logo
  • 会员
  • 众包
  • 新闻
  • 博问
  • 闪存
  • 赞助商
  • HarmonyOS
  • Chat2DB
    • 搜索
      所有博客
    • 搜索
      当前博客
  • 写随笔 我的博客 短消息 简洁模式
    用户头像
    我的博客 我的园子 账号设置 会员中心 简洁模式 ... 退出登录
    注册 登录
工作日志
工作日志
博客园    首页    新随笔    联系   管理    订阅  订阅
一个16*16点阵提取的DELPHI源程序
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源程序
posted on 2009-05-26 16:25  滴水藏海映太阳  阅读(438)  评论(0)    收藏  举报
刷新页面返回顶部
博客园  ©  2004-2025
浙公网安备 33010602011771号 浙ICP备2021040463号-3