提供自己写的一个简单画表格的过程,有兴趣的朋友可以看看,同时想知道如何设置字体的居中等功能,难道就只有自己计算坐标的位置??? ( 积分: 0 )

  • 主题发起人 龙之天涯
  • 开始时间

龙之天涯

Unregistered / Unconfirmed
GUEST, unregistred user!
unit Unit1;

interface

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

type
TForm1 = class(TForm)
MainMenu1: TMainMenu;
N1: TMenuItem;
N2: TMenuItem;
procedure N2Click(Sender: TObject);
procedure FormPaint(Sender: TObject);
private
{ Private declarations }
public
procedure DrawDcdb(nLeft, nTop, nWidth, nHeight, nRow, nColumn, nCount: Integer);
procedure Textout1(nRow, nColumn:Integer; Text : String);
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}
procedure TForm1.Textout1(nRow, nColumn: Integer ; Text : String);
var
nLeft, nTop, nWidth, nHeight, FRow, FColumn, nCount: Integer ;
FLeft, FTop: Integer;
begin
nHeight := 40;
FColumn := 30;
nLeft := 10;
nTop := 50;
with Canvas do
begin
FTop := nTop + nHeight * nRow +10 ;
FLeft := nLeft + 30 * nColumn + 10;
Textout(FLeft, FTop ,Text);
end;

end;

procedure TForm1.DrawDcdb(nLeft, nTop, nWidth, nHeight, nRow, nColumn, nCount: Integer);
var
i ,j,k: Integer;
FemBmp : TBitmap;
CLeft : Integer;
begin
FemBmp := TBitmap.Create;
with Canvas do
begin
TextOut1(0,0,'作业表');
TextOut1(1,0,'1');
TextOut1(2,0,'2');
TextOut1(3,0,'3');
TextOut1(1,1,'测试');
TextOut1(1,2,'AAA');
TextOut1(1,3,'BBB');
TextOut1(1,4,'1');
TextOut1(1,5,'2');
TextOut1(1,6,'3');
for j := 0 to nCount do
begin
for i := 0 to nRow do
begin
MoveTo(nLeft + 10 ,i * nHeight + nTop );
LineTo(nLeft + nWidth ,i * nHeight + nTop );
end;
CLeft := nLeft;
for k := 0 to nColumn do
begin
if k = 0 then
begin
MoveTo(CLeft + 10, nTop );
LineTo(CLeft + 10, nRow * nHeight + nTop );
end else
begin
MoveTo(CLeft + 10, nTop + nHeight);
LineTo(CLeft + 10, nRow * nHeight + nTop );
CLeft := CLeft + 30;
end;
if k= nColumn then
begin
MoveTo(nLeft + nWidth, nTop );
LineTo(nLeft + nWidth, nRow * nHeight + nTop );
end;
end;
nLeft :=(nLeft + nWidth) ;
end;
end;

end;
procedure TForm1.N2Click(Sender: TObject);
begin
DrawDcdb(10,50,300,40,12,6,2);
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
DrawDcdb(10,50,300,40,12,6,2);
end;

end.
要是还想能够自动在文字显示不下能够自动换行有什么办法啊??
 
unit Unit1;

interface

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

type
TForm1 = class(TForm)
MainMenu1: TMainMenu;
N1: TMenuItem;
N2: TMenuItem;
procedure N2Click(Sender: TObject);
procedure FormPaint(Sender: TObject);
private
{ Private declarations }
public
procedure DrawDcdb(nLeft, nTop, nWidth, nHeight, nRow, nColumn, nCount: Integer);
procedure Textout1(nRow, nColumn:Integer; Text : String);
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}
procedure TForm1.Textout1(nRow, nColumn: Integer ; Text : String);
var
nLeft, nTop, nWidth, nHeight, FRow, FColumn, nCount: Integer ;
FLeft, FTop: Integer;
begin
nHeight := 40;
FColumn := 30;
nLeft := 10;
nTop := 50;
with Canvas do
begin
FTop := nTop + nHeight * nRow +10 ;
FLeft := nLeft + 30 * nColumn + 10;
Textout(FLeft, FTop ,Text);
end;

end;

procedure TForm1.DrawDcdb(nLeft, nTop, nWidth, nHeight, nRow, nColumn, nCount: Integer);
var
i ,j,k: Integer;
FemBmp : TBitmap;
CLeft : Integer;
begin
FemBmp := TBitmap.Create;
with Canvas do
begin
TextOut1(0,0,'作业表');
TextOut1(1,0,'1');
TextOut1(2,0,'2');
TextOut1(3,0,'3');
TextOut1(1,1,'测试');
TextOut1(1,2,'AAA');
TextOut1(1,3,'BBB');
TextOut1(1,4,'1');
TextOut1(1,5,'2');
TextOut1(1,6,'3');
for j := 0 to nCount do
begin
for i := 0 to nRow do
begin
MoveTo(nLeft + 10 ,i * nHeight + nTop );
LineTo(nLeft + nWidth ,i * nHeight + nTop );
end;
CLeft := nLeft;
for k := 0 to nColumn do
begin
if k = 0 then
begin
MoveTo(CLeft + 10, nTop );
LineTo(CLeft + 10, nRow * nHeight + nTop );
end else
begin
MoveTo(CLeft + 10, nTop + nHeight);
LineTo(CLeft + 10, nRow * nHeight + nTop );
CLeft := CLeft + 30;
end;
if k= nColumn then
begin
MoveTo(nLeft + nWidth, nTop );
LineTo(nLeft + nWidth, nRow * nHeight + nTop );
end;
end;
nLeft :=(nLeft + nWidth) ;
end;
end;

end;
procedure TForm1.N2Click(Sender: TObject);
begin
DrawDcdb(10,50,300,40,12,6,2);
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
DrawDcdb(10,50,300,40,12,6,2);
end;

end.
要是还想能够自动在文字显示不下能够自动换行有什么办法啊??
 
顶部