mainfrm.pas

这个是一个完整的药房管理系统

unit MainFrm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,Printers, StdCtrls, Grids, DBGrids, DB, DBTables;

type
  TMainform = class(TForm)
    Q_print: TQuery;
    DS_print: TDataSource;
    DBGrid1: TDBGrid;
    btn_headerfont: TButton;
    StringGrid1: TStringGrid;
    FontDialog: TFontDialog;
    i_header: TEdit;
    Label1: TLabel;
    Btn_print: TButton;
    Label2: TLabel;
    procedure Btn_printClick(Sender: TObject);
    procedure PrintLine(Items:TStringList);
    procedure btn_headerfontClick(Sender: TObject);
    Procedure PrintColumnNames;
    Procedure PrintHeader;
  private
    { Private declarations }
    PixelsInInchx:integer;
    LineHeight:Integer;
    AmountPrinted:integer;
    TenthsOfInchPixelsY:integer;
  public
    { Public declarations }
  end;

var
  Mainform: TMainform;

implementation

uses AbortFrm;

{$R *.dfm}

procedure TMainform.Btn_printClick(Sender: TObject);
var
Items:TStringList;
i:integer;
begin
Items:=TStringList.Create;
try
PixelsInInchx:=GetDeviceCaps(Printer.Handle,LOGPIXELSX);
TenthsOfInchPixelsY:=GetDeviceCaps(Printer.Handle,LOGPIXELSY)div 10;
AmountPrinted:=0;
MainForm.Enabled:=false;
try
Printer.BeginDoc;
AbortForm.show;
Application.ProcessMessages;
LineHeight:=Printer.Canvas.TextHeight('X')+TenthsOfInchPixelsY;
if i_header.Text<>'' then
PrintHeader;
printColumnNames;
Q_print.First;
while (not Q_print.Eof) or Printer.Aborted do
begin
application.ProcessMessages;
with items do
begin
for i:=0 to Q_print.FieldCount-1 do
begin
AddObject(Q_print.Fields[i].AsString,
     pointer(StrToInt(StringGrid1.Cells[1,i])));
    end;
end;
PrintLine(Items);
if AmountPrinted+LineHeight>Printer.PageHeight then
begin
AmountPrinted :=0;
if not Printer.Aborted then
Printer.NewPage;
PrintHeader;
PrintColumnNames;
end;
Items.Clear;
Q_print.Next;
end;
AbortForm.hide;
if not Printer.Aborted then
Printer.EndDoc;
Finally
MainForm.Enabled:=true;
end;
finally
Items.Free;
end;
end;

procedure TMainForm.PrintLine(Items:TStringList);
var
OutRect:TRect;
Inches:double;
i:integer;
begin
OutRect.Left:=0;
OutRect.Top :=AmountPrinted;
OutRect.Bottom:=OutRect.Top+LineHeight;
With Printer.Canvas do
for i:=0 to Items.count-1 do
begin
Inches:=longint(Items.Objects[i])*0.1;
OutRect.Right:=OutRect.left + round(PixelsInInchx*Inches);
if not Printer.Aborted then
TextRect(OutRect,OutRect.Left,OutRect.Top,Items[i]);
OutRect.Left:=OutRect.Right;
end;
AmountPrinted:=AmountPrinted+TenthsOfInchPixelsY*2;
end;

Procedure TMainForm.PrintHeader;
var
SaveFont:TFont;
begin
SaveFont:=TFont.Create;
try
Savefont.Assign(Printer.Canvas.Font);
Printer.Canvas.Font.Assign(i_header.Font);
with Printer do
begin
if not Printer.Aborted then
Canvas.TextOut((PageWidth div 2)-(canvas.TextWidth(i_header.text)
         div 2),0,i_header.Text);
AmountPrinted:=AmountPrinted+LineHeight+TenthsOfInchPixelsY;
end;
Printer.Canvas.Font.Assign(SaveFont);
finally
SaveFont.Free;
end;
end;
Procedure TMainForm.PrintColumnNames;
var
ColNames:TStringList;
i:integer;
begin
ColNames:=TStringList.Create;
try
Printer.Canvas.Font.Style:=[fsBold,fsUnderline];
with ColNames do
begin
for i:=0 to Q_print.FieldCount-1 do
begin
AddObject(StringGrid1.cells[0,i],pointer(StrToInt(StringGrid1.cells[1,i])));
end;
end;
PrintLine(ColNames);
Printer.canvas.Font.style:=[];
finally
ColNames.free;
end;
end;

procedure TMainform.btn_headerfontClick(Sender: TObject);
begin
FontDialog.Font.Assign(i_header.Font);
if fontDialog.Execute then
i_header.Font.Assign(FontDialog.Font);
end;

end.