dayfeeview.pas

某大型医院护士站

unit DayFeeView;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, OleCtrls, vcf1, StdCtrls, Buttons, Db, DBTables, Wwquery,
  AxCtrls;

type
  TDayFeeParam = Record
    Inid :integer;
    Times :integer;
    Sqid :integer;
    PntDate :TDate;
  end;
  TDayFeeRec = array [0..200] of TDayFeeParam;

  TfrmDayFeeView = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    bbtPnt: TBitBtn;
    QryPatDayFees: TwwQuery;
    Label1: TLabel;
    bbtClear: TBitBtn;
    f1RepSrc: TF1Book;
    f1DayFeeRep: TF1Book;
    procedure bbtPntClick(Sender: TObject);
    procedure bbtClearClick(Sender: TObject);
  private
    procedure DisplayDayFee(fInid, fTimes, fSqid:integer;fDate :TDate;var fRow :integer);
    { Private declarations }
  public
    DayFeeRec :TDayFeeRec;
    procedure Display (DispCount :integer);
    { Public declarations }
  end;

var
  frmDayFeeView: TfrmDayFeeView;

implementation

uses DataModule, PRNDataModule;

{$R *.DFM}
procedure TfrmDayFeeView.Display(DispCount :integer);
var
  i :integer;
  StRow :integer;
begin
  StRow := 1;
  bbtClearClick(Nil);
  for i := 0 to DispCount - 1 do
  begin
    DisplayDayFee (DayFeeRec[i].Inid, DayFeeRec[i].Times,
                   DayFeeRec[i].Sqid, DayFeeRec[i].PntDate,
                   StRow);
  end;
end;

procedure TfrmDayFeeView.DisplayDayFee(fInid, fTimes, fSqid:integer;
                         fDate :TDate; var fRow :integer);
const
  csRow = 1; csCol = 1; ceRow = 9; ceCol = 8;
  rRow = 2; //报表左上角单元格位置与项目明细表格左上角单元格的行矩，列相同。
  RepHeight = 10;
  cstCol = 1;//报表开始的单元格位置
  ctlRow = 1; //病人信息栏与报表开始的单元格位置的相对行矩
  ctPNCol = 1; ctDNCol = 3; ctBCol = 5;ctDCol = 4;
  caRow = 8; //上日结余与押金总额与表格开始行的相对行矩
  ctPrep = 5; ctRemain = 3;//上日结余与押金总额与表格开始列的相对列矩
  RepGap = 8;//两个清单相隔行数
var
  Id :string;
  CurRow :integer;
  FeeTimes :TDate;
  X, Y :Integer;
begin
  Id := '';
  CurRow := fRow;
  DateSeparator := '/';

  with QryPatDayFees do
  begin
    Close;
    Parambyname ('PINID').asInteger := fInid;
    Parambyname ('PTIMES').asInteger := fTimes;
    Parambyname ('PSQID').asInteger := fSqid;
    Parambyname ('PPNTBLDATE').asDate := fDate;
    Open;

    if IsEmpty then Exit;

    First;
    with f1DayFeeRep do
    begin
      CopyRange (CurRow, csCol, CurRow + ceRow - 1, ceCol,
      f1RepSrc.SS, csRow, csCol, ceRow, ceCol);
      FeeTimes := fDate;
      EntryRc[CurRow + ctlRow, cstCol + ctPNCol] :=
                       Fieldbyname ('PATNAME').AsString;

      EntryRc[CurRow + ctlRow, cstCol + ctDNCol] :=
                       Fieldbyname ('WARDNAME').AsString;

      EntryRc[CurRow + ctlRow, cstCol + ctBCol] :=
                       Fieldbyname ('BEDID').AsString;

      EntryRc[CurRow, cstCol + ctDCol] :=
                       DateToStr(FeeTimes - 1) + '-12:00 —— ' +
                       DateToStr(FeeTimes) + '-12:00';

      EntryRc[CurRow + caRow,cstCol + ctRemain] :=
                       FloatToStr(Fieldbyname ('LASTREMAIN').asFloat);

      EntryRc[CurRow + caRow,cstCol + ctPrep] :=
                       FloatToStr(Fieldbyname ('PREPAYTOTAL').asFloat);
    end;

    while not Eof do
    begin
      with f1DayFeeRep do
      begin
        X :=  Fieldbyname ('REPX').asInteger;
        Y :=  Fieldbyname ('REPY').asInteger;
        NumberRc[(CurRow + X + rRow), cstCol + Y] :=
                        Fieldbyname ('AMT').asFloat;
      end;

      Next;
    end;//end of while not eof

    fRow := CurRow + RepHeight + RepGap ;
  end;
end;

procedure TfrmDayFeeView.bbtPntClick(Sender: TObject);
begin
  f1DayFeeRep.FilePrint (true);
end;

procedure TfrmDayFeeView.bbtClearClick(Sender: TObject);
var
  f1MaxRow, f1MaxCol :integer;
begin
  f1MaxRow := f1DayFeeRep.MaxRow;
  f1MaxCol := f1DayFeeRep.MaxCol;
  f1DayFeeRep.ClearRange (-1, -1, f1MaxRow - 1, f1MaxCol - 1,F1ClearAll );
end;

end.