我用dbgrid显示了表格的内容,请问如何实现该表格的打印与预览?以及如何将表格内容储存为excel文件?最好是有原码(50分)

  • 主题发起人 主题发起人 gzygf
  • 开始时间 开始时间
G

gzygf

Unregistered / Unconfirmed
GUEST, unregistred user!
我用dbgrid显示了表格的内容,请问如何实现该表格的打印与预览?以及如何将表格内容另存为excel文件?最好是有原码
 
用dbgrideh或者dxdbgrid来显示数据就可以非常轻松的
实现你说的要求.
可以到delphi.mychangshu.com下载dbgrideh(ehlib)
 
请问:dxdbgrid哪可下载?
 
DEV Express 不错,可直接将dxdbgrid 存成excel,html或xml!很方便!
如果不用第三方就稍麻烦一点!我有dev组件,可不知如何才能给你!email
不方便。dev太大了!
 
我写了一段代码,若有兴趣留下你的E-MAIL。
 
to:gzygf
dxdbgrid哪可下载
www.51delphi.com
 
打印StringGrid内容

Procedure TACDListerMain.PrintTable;
Var
margins: TRect;
spacing: Integer;
Cols: TList;
Dlg: TPrintProgressDlg;

Procedure SetColumnWidth;
Var
i, k, w: Integer;
Begin
Printer.Canvas.Font.Style := [ fsBold ];
For i := 0 To Pred( Grid.ColCount ) Do

Cols.Add( Pointer( Printer.Canvas.TextWidth( Grid.Cells[ i,0 ] )));

Printer.Canvas.Font.Style := [];
For i := 1 To Pred( Grid.RowCount ) Do
For k := 0 To Pred( Grid.ColCount ) Do Begin
w:= Printer.Canvas.TextWidth( Grid.Cells[ k, i ] );
If w > Integer( Cols[ k ] ) Then
Cols[ k ] := Pointer( w );
End; { For }

w := 2 * Printer.Canvas.Font.PixelsPerInch div 3;
margins :=
Rect( w, w, Printer.PageWidth-w, Printer.PageHeight - w );
spacing := Printer.Canvas.Font.PixelsPerInch div 10;

w := 0;
For i := 0 To Pred(cols.Count) Do
w := w + Integer( cols[ i ] ) + spacing;
w := w - spacing;
If w > (margins.right-margins.left ) Then Begin
w := w - (margins.right-margins.left );
cols[ cols.Count-2 ] :=
Pointer( Integer( cols[ cols.Count-2 ] ) - w );
End; { If }

w:= 0;
For i := 0 To Pred(cols.Count) Do
w := w + Integer( cols[ i ] ) + spacing;
margins.right := w - spacing + margins.left;
End; { SetColumnWidth }

Procedure DoPrint;
Var
i: Integer;
y: Integer;
Procedure DoLine(lineno: Integer);
Var
x, n: Integer;
r: TRect;
th: Integer;
Begin
If Length(Grid.Cells[0,lineno]) = 0 Then Exit;

x:= margins.left;
With Printer.Canvas Do Begin
th := TextHeight( '膟' );
For n := 0 To Pred( Cols.Count ) Do Begin
r := Rect( 0, 0, Integer(Cols[ n ]), th);
OffsetRect( r, x, y );
TextRect( r, x, y, Grid.Cells[ n, lineno ] );
x := r.right + spacing;
End; { For }
End; { With }
y := y + th;
End; { DoLine }
Procedure DoHeader;
Begin
y:= margins.top;
With Printer.Canvas Do Begin
Font.Style := [ fsBold ];
DoLine( 0 );
Pen.Width := Font.PixelsPerInch div 72;
Pen.Color := clBlack;
MoveTo( margins.left, y );
LineTo( margins.right, y );
Inc( y, 2 * Pen.Width );
Font.Style := [ ];
End; { With }
End; { DoHeader }
Begin
y:= 0;
For i := 1 To Pred( Grid.RowCount ) Do Begin
Dlg.Progress( i );
Application.ProcessMessages;
If FPrintAborted Then Exit;

If y = 0 Then
DoHeader;
DoLine( i );
If y >= margins.bottom Then Begin
Printer.NewPage;
y:= 0;
End; { If }
End; { For }
End; { DoPrint }

Begin
FPrintAborted := False;
Dlg := TPrintProgressDlg.Create( Application );
With Dlg Do
try
OnAbort := PrintAborted;
Display( cPrintPreparation );
SetProgressRange( 0, Grid.RowCount );
Show;
Application.ProcessMessages;
Printer.Orientation := poLandscape;

Printer.BeginDoc;
Cols:= Nil;
try
Cols:= TLIst.Create;
Printer.Canvas.Font.Assign( Grid.Font );
SetColumnWidth;
Display( cPrintProceeding );
Application.ProcessMessages;
DoPrint;
finally
Cols.Free;
If FPrintAborted Then
Printer.Abort
Else
Printer.EndDoc;
end;
finally
Close;
End; { With }
End; { TACDListerMain.PrintTable }
 
我的email: ygfnet@netease.com
 
兄弟用enlib您查一下这里有贴中有下载地址还有源码,我在跑了很多弯路.
 
我写了段代码,你要是要例子我可以给你

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Grids, DBGrids, Db, DBTables, Excel97, OleServer, Word97;

type
TForm1 = class(TForm)
ExcelApplication1: TExcelApplication;
ExcelWorkbook1: TExcelWorkbook;
ExcelWorksheet1: TExcelWorksheet;
Table1: TTable;
DataSource1: TDataSource;
DBGrid1: TDBGrid;
Button1: TButton;
Button4: TButton;
WordApplication1: TWordApplication;
WordDocument1: TWordDocument;
procedure Button1Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
var
i,row,column:integer;
begin
Try
ExcelApplication1.Connect;
Except
MessageDlg('Excel may not be installed',
mtError, [mbOk], 0);
Abort;
End;
ExcelApplication1.Visible[0]:=True;
ExcelApplication1.Caption:='Excel Application';
ExcelApplication1.Workbooks.Add(Null,0);
ExcelWorkbook1.ConnectTo(ExcelApplication1.Workbooks[1]);
ExcelWorksheet1.ConnectTo(ExcelWorkbook1.Worksheets[1] as _Worksheet);
Table1.Open;
row:=1;
While Not(Table1.Eof) do
begin
column:=1;
for i:=1 to Table1.FieldCount do
begin
ExcelWorksheet1.Cells.Item[row,column]:=Table1.fields[i-1].AsString;
column:=column+1;
end;
Table1.Next;
row:=row+1;
end;
end;
 
procedure TForm1.EXCEL3Click(Sender: TObject);
var
eclApp,WorkBook:Variant;//声明为OLE Automation 对象
xlsFileName:string;
i,j,n:integer;
begin
if SaveDialog1.Execute then
begin
xlsFileName:=SaveDialog1.FileName;
if fileexists(SaveDialog1.FileName) then DeleteFile(SaveDialog1.FileName);
try
//创建OLE对象Excel Application与 WorkBook
eclApp:=CreateOleObject('Excel.Application');
WorkBook:=CreateOleobject('Excel.Sheet');
except
ShowMessage('您的机器里未安装Microsoft Excel。');
Exit;
end;
try
Screen.Cursor:=crHourGlass;
workBook:=eclApp.workBooks.Add;
i:=1; //EXECL表行号
n:=0;//query字段N序号
Query1.First;
j:=1;
for n:=0 to Query1.FieldCount -1 do
begin
eclApp.Cells(i,j):=Query1.fields[n].DisplayLabel;
j:=j+1;
end;
i:=2; //EXECL表行号
n:=0;//query字段N序号
while not Query1.Eof do begin
j:=1;//EXECL表列号
for n:=0 to Query1.FieldCount -1 do
begin
eclApp.Cells(i,j):=Query1.fields[n].AsString;
j:=j+1;
end;
Query1.Next;
i:=i+1;
end;
{eclApp.Cells(1 , 1):='字符型';
eclApp.Cells(2 , 1):='Excel文件';
eclApp.Cells(1 , 2):='Money型';
eclApp.Cells(2 , 2):=10.01;
eclApp.Cells(1 , 3):='日期型';
eclApp.Cells(2 , 3):=Date; }
WorkBook.SaveAs(xlsFileName);
Application.MessageBox('操作在没有警告的情况下正常结束!','完成',mb_ok+mb_iconinformation);
WorkBook.close;
eclApp.Quit;//退出Excel Application
eclApp:=Unassigned;//释放VARIANT变量
Screen.Cursor:=crdefault;
except
ShowMessage('不能正确操作Excel文件。可能是该文件已被其他程序打开,或系统错误。');
WorkBook.close;
eclApp.Quit;
//释放VARIANT变量
eclApp:=Unassigned;
end;
END;
END;
 

Similar threads

D
回复
0
查看
2K
DelphiTeacher的专栏
D
D
回复
0
查看
1K
DelphiTeacher的专栏
D
D
回复
0
查看
1K
DelphiTeacher的专栏
D
S
回复
0
查看
1K
SUNSTONE的Delphi笔记
S
S
回复
0
查看
911
SUNSTONE的Delphi笔记
S
后退
顶部