?? unit1.pas

?? 用AVR單片機控制LCD點陣顯示屏的程序。
?? PAS
字號:
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
	 ComboBox1: TComboBox;
	 ComboBox2: TComboBox;
	 Label1: TLabel;
	 Label2: TLabel;
	 Image1: TImage;
	 MainMenu1: TMainMenu;
	 File1: TMenuItem;
	 Edit1: TMenuItem;
	 Label3: TLabel;
	 Image2: TImage;
	 Open1: TMenuItem;
	 Save1: TMenuItem;
	 Saveas1: TMenuItem;
	 OpenDialog1: TOpenDialog;
	 New1: TMenuItem;
	 SaveDialog1: TSaveDialog;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    LoadBMP1: TMenuItem;
    Button5: TButton;
	 procedure ComboBox1Change(Sender: TObject);
	 procedure ComboBox2Change(Sender: TObject);
	 procedure Form1Create(Sender: TObject);
	 procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
		Y: Integer);
	 procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
		Shift: TShiftState; X, Y: Integer);
	 procedure Open1Click(Sender: TObject);
	 procedure Save1Click(Sender: TObject);
	 procedure Saveas1Click(Sender: TObject);
	 procedure New1Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure LoadBMP1Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
  private
	 { Private 愰尵 }
  public
	 { Public 愰尵 }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

Const
	bit: array[0..31] of LongWord =
		( $1,$2,$4,$8,$10,$20,$40,$80,
		  $100,$200,$400,$800,$1000,$2000,$4000,$8000,
		  $10000,$20000,$40000,$80000,$100000,$200000,$400000,$800000,
		  $1000000,$2000000,$4000000,$8000000,$10000000,$20000000,$40000000,$80000000
		);
Var size_x, size_y: byte;
	 pat: array[ 0..31, 0..31 ] of boolean;
	 drag_f: boolean;
	 fn: string[ 100 ];
	 bdata:	record
					sz: LongWord;
					bitmap:	array [ 0..127 ] of LongWord;
				end;
procedure DispGrid( img1, img2: TImage );
	var i: byte;
	begin
		img1.Canvas.Brush.Color := clWhite;
		Img1.Canvas.FillRect( Rect( 0,0,320,320 ) );
		img1.Canvas.Pen.Color := clRed;

		{廲慄}
		for i := 0 to size_x do begin
			img1.Canvas.MoveTo( i * 10, 0 );
			img1.Canvas.Lineto( i * 10, size_y * 10 );

		end;

		{墶慄}
		for i := 0 to size_y do begin
			img1.Canvas.MoveTo( 0, i* 10 );
			img1.Canvas.Lineto( size_x * 10, i * 10 );

		end;

		img2.Canvas.Brush.Color := clWhite;
		Img2.Canvas.FillRect( Rect( 0,0,32,32 ) );
	end;

procedure DispPat;
	begin
	end;

{ 弶婜壔 }
procedure TForm1.Form1Create(Sender: TObject);
var i, j: byte;
begin
	for i := 0 to 31 do
		for j := 0 to 31 do
			pat[ i, j ] := False;
	ComboBox1.ItemIndex := 3;	{ 墶亖8dots }
	ComboBox2.ItemIndex := 3;	{ 廲亖8dots }
	size_x := StrToInt( ComboBox1.Items[ComboBox1.ItemIndex] );
	size_y := StrToInt( ComboBox2.Items[ComboBox2.ItemIndex] );
	DispGrid( Image1, Image2 );
	DispPat;
	drag_f := False;
	bdata.sz := size_x;
end;

{ 墶僪僢僩悢曄峏 }
procedure TForm1.ComboBox1Change(Sender: TObject);
begin
	size_x := StrToInt( ComboBox1.Items[ComboBox1.ItemIndex] );
	DispGrid( Image1, Image2 );
	DispPat;
	bdata.sz := size_x;
end;

{ 廲僪僢僩悢曄峏 }
procedure TForm1.ComboBox2Change(Sender: TObject);
begin
	size_y := StrToInt( ComboBox2.Items[ComboBox2.ItemIndex] );
	DispGrid( Image1, Image2 );
	DispPat;
end;


{ 儅僂僗偑堏摦偟偨帪 }
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
	x := x div 10;
	y := y div 10;
	if ( x < size_x ) and ( y < size_y ) then begin
		Label3.Caption := format( '%2d  %2d', [ x, y ] );
		{
		if ssLeft in Shift then begin
			if pat[ x, y ] then begin
				pat[ x, y ] := False;
				Image1.Canvas.Brush.Color := clWhite;
				Image2.Canvas.Brush.Color := clWhite;
			end else begin
				pat[ x, y ] := True;
				Image1.Canvas.Brush.Color := clBlue;
				Image2.Canvas.Brush.Color := clBlue;
			end;
			Image1.Canvas.FillRect( Rect( x * 10 + 1, y * 10 + 1, x * 10 + 10, y * 10 + 10) );
			Image2.Canvas.FillRect( Rect( x, y, x + 1, y + 1) );
		end;
		}
	end;
end;

{ 儅僂僗傪僋儕僢僋偟偨帪 }
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
	x := x div 10;
	y := y div 10;
	if ( x < size_x ) and ( y < size_y ) then begin
		if pat[ x, y ] then begin
			pat[ x, y ] := False;
			Image1.Canvas.Brush.Color := clWhite;
			Image2.Canvas.Brush.Color := clWhite;
		end else begin
			pat[ x, y ] := True;
			Image1.Canvas.Brush.Color := clBlue;
			Image2.Canvas.Brush.Color := clBlue;
		end;
		Image1.Canvas.FillRect( Rect( x * 10 + 1, y * 10 + 1, x * 10 + 10, y * 10 + 10) );
		Image2.Canvas.FillRect( Rect( x, y, x + 1, y + 1) );
	end;
end;

procedure WriteFile;

	function hex2( n: byte ): string;

		function hex1( n: byte ): char;
			begin
				if n in [ 0..9 ] then
					hex1 := chr( n + ord( '0' ) )
				else if n in [ 10..15 ] then
					hex1 := chr( n - 10 + ord( 'A' ) )
				else
					hex1 := '?';
			end;

		begin
			hex2 := hex1( n shr 4 ) + hex1( n and $F );
		end;

var f: file of LongWord;
	 ft: text;
	 i, j, k: integer;
	 name: string[ 100 ];
begin
	for i := 0 to size_x - 1 do begin
		bdata.bitmap[ i ] := 0;
		for j := 0 to size_y - 1 do
			if pat[ i, j ] then
				bdata.bitmap[ i ] := bdata.bitmap[ i ] or bit[ j ];
	end;
	AssignFile( f, fn );
	Rewrite( f );
	Write( f, bdata.sz );
	for i := 0 to bdata.sz - 1 do begin
		Write( f, bdata.bitmap[ i ] );
	end;
	CloseFile( f );

	name := ChangeFileExt( ExtractFileName( fn ), '' );
	AssignFile( ft, ChangeFileExt( fn, '.asm' ) );
	Rewrite( ft );
	Writeln( ft, 'FONT_' + name + ':');
	for k := 0 to ( size_y -1 ) div 8 do begin
		Write( ft, '.DB	' );
		for i := 0 to bdata.sz - 1 do begin
			Write( ft, '$'+hex2( bdata.bitmap[ i ] and $FF ) );
			if i <> bdata.sz - 1 then
				Write( ft, ', ' );
			bdata.bitmap[ i ] := bdata.bitmap[ i ] shr 8;
		end;
		Writeln( ft );
	end;
	CloseFile( ft );

end;

{ "Load" }
procedure TForm1.Open1Click(Sender: TObject);
var f: file of LongWord;
	 i, j: integer;
begin
	OpenDialog1.FileName := '*.FNT';
	OpenDialog1.InitialDir := 'C:\FONT';
	if not OpenDialog1.execute then
		exit;
	fn := OpenDialog1.FileName;
	AssignFile( f, fn );
	Reset( f );
	Read( f, bdata.sz );
	size_x := bdata.sz;
	DispGrid( Image1, Image2 );
	DispPat;
	for i := 0 to bdata.sz - 1 do
		Read( f, bdata.bitmap[ i ] );
	CloseFile( f );
	Save1.Enabled := True;
	for i := 0 to size_x - 1 do
		for j := 0 to size_y - 1 do begin
			if bdata.bitmap[ i ] and bit[ j ] > 0 then begin
				pat[ i, j ] := True;
				Image1.Canvas.Brush.Color := clBlue;
				Image2.Canvas.Brush.Color := clBlue;
			end else begin
				pat[ i, j ] := False;
				Image1.Canvas.Brush.Color := clWhite;
				Image2.Canvas.Brush.Color := clWhite;
			end;
			Image1.Canvas.FillRect( Rect( i * 10 + 1, j * 10 + 1, i * 10 + 10, j * 10 + 10) );
			Image2.Canvas.FillRect( Rect( i, j, i + 1, j + 1) );
		end;
end;

{ "Save" }
procedure TForm1.Save1Click(Sender: TObject);
begin
	WriteFile;
end;

{ "Save as" }
procedure TForm1.Saveas1Click(Sender: TObject);
var f: file of byte;
	 i: integer;
begin
	SaveDialog1.FileName := '*.FNT';
	SaveDialog1.InitialDir := 'C:\FONT';
	if not SaveDialog1.execute then
		exit;
	fn := SaveDialog1.FileName;
	WriteFile;
	Save1.Enabled := True;
end;

procedure TForm1.New1Click(Sender: TObject);
var i, j: integer;
begin
	Save1.Enabled := False;
	for i := 0 to size_x - 1 do begin
		bdata.bitmap[ i ] := 0;
		for j := 0 to size_y - 1 do begin
			pat[ i, j ] := False;
			Image1.Canvas.Brush.Color := clWhite;
			Image2.Canvas.Brush.Color := clWhite;
			Image1.Canvas.FillRect( Rect( i * 10 + 1, j * 10 + 1, i * 10 + 10, j * 10 + 10) );
			Image2.Canvas.FillRect( Rect( i, j, i + 1, j + 1) );
		end;
	end;
end;

procedure Disp;
	var x, y: integer;
	begin
		with Form1 do begin
		for x := 0 to size_x - 1 do
			for y := 0 to size_y - 1 do begin
				if pat[ x, y ] then begin
					Image1.Canvas.Brush.Color := clBlue;
					Image2.Canvas.Brush.Color := clBlue;
				end else begin
					Image1.Canvas.Brush.Color := clWhite;
					Image2.Canvas.Brush.Color := clWhite;
				end;
				Image1.Canvas.FillRect( Rect( x * 10 + 1, y * 10 + 1, x * 10 + 10, y * 10 + 10) );
				Image2.Canvas.FillRect( Rect( x, y, x + 1, y + 1) );
		end;
		end;
	end;

{ 忋僔僼僩 }
procedure TForm1.Button1Click(Sender: TObject);
var x, y: integer;
begin
	for y := 0 to 30 do
		for x := 0 to 31 do
			pat[ x, y ] := pat[ x, y + 1 ];
	for x := 0 to 31 do
		pat[ x, size_y - 1 ] := False;

	Disp;
end;

{ 壓僔僼僩 }
procedure TForm1.Button2Click(Sender: TObject);
var x, y: integer;
begin
	for y := 31 downto 1 do
		for x := 0 to 31 do
			pat[ x, y ] := pat[ x, y - 1 ];
	for x := 0 to 31 do
		pat[ x, 0 ] := False;

	Disp;
end;

{ 嵍僔僼僩 }
procedure TForm1.Button3Click(Sender: TObject);
var x, y: integer;
begin
	for y := 0 to 31 do
		for x := 0 to 30 do
			pat[ x, y ] := pat[ x + 1, y ];
	for y := 0 to 31 do
		pat[ size_x - 1, y ] := False;

	Disp;
end;

{ 塃僔僼僩 }
procedure TForm1.Button4Click(Sender: TObject);
var x, y: integer;
begin
	for y := 0 to 31 do
		for x := 31 downto 1 do
			pat[ x, y ] := pat[ x - 1, y ];
	for y := 0 to 31 do
		pat[ 0, y ] := False;

	Disp;
end;

{ Load BMP }
procedure TForm1.LoadBMP1Click(Sender: TObject);
var
  Bitmap: TBitmap;
  x, y: integer;
begin
	OpenDialog1.FileName := '*.BMP';
	OpenDialog1.InitialDir := 'C:\FONT';
	if not OpenDialog1.execute then
		exit;

	Bitmap := TBitmap.Create;
	try
		Bitmap.LoadFromFile(OpenDialog1.FileName);
		Image2.Canvas.Brush.Bitmap := Bitmap;
		Image2.Canvas.FillRect(Rect(0,0,31,31));
		for x := 0 to 31 do
			for y := 0 to 31 do
				if Image2.Canvas.Pixels[ x, y ] = 0 then
					pat[ x, y ] := True
				else
					pat[ x, y ] := False;
		Disp;
  finally
	 Image1.Canvas.Brush.Bitmap := nil;
	 Bitmap.Free;
  end;

end;

{ CLEAR }
procedure TForm1.Button5Click(Sender: TObject);
var x, y: integer;
begin
	for x := 0 to 31 do
		for y := 0 to 31 do
			pat[ x, y ] := False;
	Disp;
end;

procedure TForm1.Button6Click(Sender: TObject);
var f: file of byte;
	 b: byte;
	 i, j: integer;
begin
	OpenDialog1.FileName := '*.FNT';
	OpenDialog1.InitialDir := 'C:\FONT';
	if not OpenDialog1.execute then
		exit;
	fn := OpenDialog1.FileName;
	AssignFile( f, fn );
	Reset( f );
	Read( f, b );
	bdata.sz := b;
	size_x := bdata.sz;
	DispGrid( Image1, Image2 );
	DispPat;
	for i := 0 to bdata.sz - 1 do begin
		Read( f, b );
		bdata.bitmap[ i ] := b;
	end;
	CloseFile( f );
	Save1.Enabled := True;
	for i := 0 to size_x - 1 do
		for j := 0 to size_y - 1 do begin
			if bdata.bitmap[ i ] and bit[ j ] > 0 then begin
				pat[ i, j ] := True;
				Image1.Canvas.Brush.Color := clBlue;
				Image2.Canvas.Brush.Color := clBlue;
			end else begin
				pat[ i, j ] := False;
				Image1.Canvas.Brush.Color := clWhite;
				Image2.Canvas.Brush.Color := clWhite;
			end;
			Image1.Canvas.FillRect( Rect( i * 10 + 1, j * 10 + 1, i * 10 + 10, j * 10 + 10) );
			Image2.Canvas.FillRect( Rect( i, j, i + 1, j + 1) );
		end;
end;

end.
?? 文件大小 821 K
?? 上傳用戶 zyhunicom
?? 所屬分類單片機開發(fā)
??? 相關標簽

#AVR #LCD #單片機控制 #點陣顯示屏
?? 快捷鍵說明

復制代碼 Ctrl + C
搜索代碼 Ctrl + F
全屏模式 F11
切換主題 Ctrl + Shift + D
顯示快捷鍵 ?
增大字號 Ctrl + =
減小字號 Ctrl + -
亚洲欧美第一页_禁久久精品乱码_粉嫩av一区二区三区免费野_久草精品视频

?? unit1.pas

?? 快捷鍵說明
