csyfkbb.~pas

这是用Delphi编写的中小企业管理系统

unit csyfkbb;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DB, RpDefine, RpBase, RpSystem, ComCtrls, StdCtrls, Grids,
  DBGrids, Buttons, ExtCtrls,main;

type
  Tf_csyfkbb = class(TForm)
    Label1: TLabel;
    Panel2: TPanel;
    dy: TBitBtn;
    yl: TBitBtn;
    BitBtn2: TBitBtn;
    cx: TBitBtn;
    Grid1: TDBGrid;
    Panel1: TPanel;
    Label3: TLabel;
    Check1: TCheckBox;
    zd: TComboBox;
    Check2: TCheckBox;
    qssj: TDateTimePicker;
    zzsj: TDateTimePicker;
    Rprinter: TRvSystem;
    DataSource1: TDataSource;
    procedure FormCreate(Sender: TObject);
    procedure cxClick(Sender: TObject);
    procedure RprinterPrint(Sender: TObject);
    procedure dyClick(Sender: TObject);
    procedure ylClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
  RFont = Record   //设置字体
    RFontName: String;
    RFontSize: Integer;
    RFontColor: Integer;
    RFontStyle: TFontStyles;
  End;
  RContent = ReCord //设置正文
    TitleHeight: Real; //标题高度
    BtHeight: Real;//表头与标题的间距
    Bgjj: Real;//表格与表头的间距
    Czyjj: real;//操作员与其标签的水平距离
    sjjj: real;//时间与其标签的水平距离
    Bgdqfs: integer;//表格内容的对齐方式 0居左,1居右,2居中
  end;
var
  f_csyfkbb: Tf_csyfkbb;
  TempField: String ='';
  Sumzdkd: real=0.0;// 字段总宽度
  Rowzdkd: Real=0.0;//每行字段总宽度
  zbj: real=0.0; //正文左边距
  Content: RContent;
  AZdmc: Array[0..5]of String=('付款票号','厂商名称','付款形态','付款金额','付款人','时间');
  AZdkd : Array[0..5]of Real=(1,1,1,1,1,1); //数组中的元素对应表格中相应字段的宽度
  TitleFont,BtFont,BgtitleFont,BgFont: RFont;//读取或设置标题,表头,表格字体,表格标题字体
  zds : integer = 6;//表格字段数
  Cols: integer = 6;//每行列数
  bbtitle: String = '';//报表标题
implementation
  uses DataModal,csyfkdysz;
{$R *.dfm}

procedure Tf_csyfkbb.FormCreate(Sender: TObject);
var
  i: Integer;
begin
  zd.Clear;
  with Data.Query1 do
  begin
    Close;
    SQL.Clear;
    SQL.Add('select csmc from t_cszl');
    Open;
  end;
  while Not Data.Query1.Eof do
  begin
    zd.Items.Add(Trim(Data.Query1.Fields[0].AsString));
    Data.Query1.Next;
  end;
  qssj.DateTime := Now;
  zzsj.DateTime := Now;
  bbtitle := '厂商预付款报表';
  zds := 6;
  cols := 6;
  Sumzdkd := 0;
  For i := 0 to zds-1 do
  begin
    Azdkd[i]:= 1;
    sumzdkd := Sumzdkd+ Azdkd[i];
  end;
  Rowzdkd := Cols*(Sumzdkd/zds);
  with TitleFont do
  begin
    RFontName := '宋体';
    RFontSize := 18;
    RFontColor := clRed;
    RFontStyle := [];
  end;
  with BtFont do
  begin
    RFontName := '宋体';
    RFontSize := 10;
    RFontColor := clBlue;
    RFontStyle := [];
  end;
  with BgFont do
  begin
    RFontName := '宋体';
    RFontSize := 10;
    RFontColor := clBlue;
    RFontStyle := [];
  end;
  with BgtitleFont do
  begin
    RFontName := '宋体';
    RFontSize := 12;
    RFontColor := clBlue;
    RFontStyle := [fsBold];
  end;
  with Content do
  begin
    TitleHeight := 0.8;
    BtHeight := 0.4;
    Bgjj := 0.4;
    Czyjj := 0.8;
    sjjj := 0.8;
    Bgdqfs := 0;//表格居左对齐
  end;
end;

procedure Tf_csyfkbb.cxClick(Sender: TObject);
begin
  if check1.Checked = True then
  begin
    if Trim(zd.Text)<>'' then
    begin
      if check2.Checked = False then
      begin
        with Data.Query2 do
        begin
          Close;
          SQL.Clear;
          SQL.Add('select * from t_csyfkjl where csmc = :a');
          ParamByName('a').AsString := Trim(zd.Text);
          Open;
        end;
        if Data.Query2.RecordCount>0 then
        begin
          DataSource1.DataSet := Data.Query2;
          dy.Enabled := True;
        end
        else
        begin
          DataSource1.DataSet := Nil;
          dy.Enabled := False;
          Application.MessageBox('没有符合条件的记录.','提示',64);
        end;
      end
      else
      begin
        if zzsj.DateTime<qssj.DateTime then
        begin
          Application.MessageBox('起始时间不能大于终止时间.','提示',64);
          Exit;
        end;
        with Data.Query2 do
        begin
          Close;
          SQL.Clear;
          SQL.Add('select * from t_csyfkjl where csmc = :aa and (sj >= :bb and sj <:cc)');
          ParamByName('aa').AsString := Trim(zd.Text);
          ParamByName('bb').AsDate := Trunc(qssj.DateTime);
          ParamByName('cc').AsDate := Trunc(zzsj.DateTime)+1;
          Open;
        end;
        if Data.Query2.RecordCount>0 then
        begin
          DataSource1.DataSet := Data.Query2;
          dy.Enabled := True;
        end
        else
        begin
          DataSource1.DataSet := Nil;
          dy.Enabled := False;
          Application.MessageBox('没有符合条件的记录.','提示',64);
        end;
      end;
    end;
  end
  else if check2.Checked = True then
  begin
    if zzsj.DateTime<qssj.DateTime then
    begin
      Application.MessageBox('起始时间不能大于终止时间.','提示',64);
      Exit;
    end;
    with Data.Query2 do
    begin
      Close;
      SQL.Clear;
      SQL.Add('select * from t_csyfkjl where sj>= :b and sj <:c');
      ParamByName('b').AsDate := Trunc(qssj.DateTime);
      ParamByName('c').AsDate := Trunc(zzsj.DateTime)+1;
      Open;
    end;
    if Data.Query2.RecordCount>0 then
    begin
      DataSource1.DataSet := Data.Query2;
      dy.Enabled := True;
    end
    else
    begin
      DataSource1.DataSet := Nil;
      dy.Enabled := False;
      Application.MessageBox('没有符合条件的记录.','提示',64);
    end;
  end
  else
    Application.MessageBox('请设置查询条件.','提示',64);
end;
             
procedure Tf_csyfkbb.RprinterPrint(Sender: TObject);
var
 justify: TPrintJustify;
 i,m,n,l: integer;
begin
    with Sender as TBaseRePort do
    begin
      justify := pjleft;
      zbj := (PageWidth-Rowzdkd)/2;
      SetFont(TitleFont.RFontName,TitleFont.RFontSize);
      FontColor := TitleFont.RFontColor;
      if (fsBold in TitleFont.RFontStyle) then
        Bold := True
      else
        Bold := False;
      if (fsUnderline	 in TitleFont.RFontStyle) then
        underline := True
      else
        underline := False;
      if (fsItalic	 in TitleFont.RFontStyle) then
        Italic := True
      else
        Italic := False;
      if (fsStrikeOut	in TitleFont.RFontStyle) then
        Strikeout := True
      else
        Strikeout := False;
      ypos := Content.TitleHeight;
      PrintCenter(bbtitle,PageWidth/2);
      setFont(BtFont.RFontName,BtFont.RFontSize);
      FontColor := BtFont.RFontColor;
      if (fsBold in BtFont.RFontStyle) then
        Bold := True
      else
        Bold := False;
      if (fsUnderline	 in BtFont.RFontStyle) then
        underline := True
      else
        underline := False;
      if (fsItalic	 in BtFont.RFontStyle) then
        Italic := True
      else
        Italic := False;
      if (fsStrikeOut	in BtFont.RFontStyle) then
        Strikeout := True
      else
        Strikeout := False;
      ypos := ypos+Content.BtHeight ;
      printLeft('操作员姓名:',zbj);
      printleft(Trim(czyxx.czymc),Content.Czyjj+zbj);
      PrintRight(FormatDateTime('yyyy-mm-dd',Now),zbj+Rowzdkd);
      printRight('时间:',zbj+Rowzdkd-Content.sjjj);
      ypos := ypos+Content.Bgjj;
      m:= zds mod Cols;
      n:= zds div Cols;
      if m<>0 then
        n:=n+1;//n记录需要折几行
      For i:=0 to n-1 do
      begin
        Cleartabs;
        setFont(BgtitleFont.RFontName,BgtitleFont.RFontSize);
        FontColor := BgtitleFont.RFontColor;
        if (fsBold in BgTitleFont.RFontStyle) then
          Bold := True
        else
          Bold := False;
        if (fsUnderline	 in BgTitleFont.RFontStyle) then
          underline := True
        else
          underline := False;
        if (fsItalic in BgTitleFont.RFontStyle) then
          Italic := True
        else
          Italic := False;
        if (fsStrikeOut	in BgTitleFont.RFontStyle) then
          Strikeout := True
        else
          Strikeout := False;
        setpen(clblack,pssolid,1,pmcopy);
        settab(zbj,pjcenter,Azdkd[Cols*i],0,boxlineall,0);//在折行时,第一个字段的宽度等于每行的列数*行号(第一行行号为0)
        if i <>n-1 then //不是最后一行
          if Cols = 1 then
            tab(-2,-2,-2,-2,10)
          else
            tab(-2,Na,-2,-2,10)
        else
        begin
          if m<>0 then
          begin
            if (Cols = 1) then  //每行只有一列
              tab(-2,-2,-2,-2,10)
            else if m=1 then
              tab(-2,-2,-2,-2,10)
            else
              tab(-2,na,-2,-2,10);
          end
          else
          begin
            if Cols = 1 then
              tab(-2,-2,-2,-2,10)
            else
              tab(-2,Na,-2,-2,10)
          end;
        end;
        Print(Azdmc[Cols*i]);
        if Cols<>1 then
          if m=0 then //折行时最后一行字段数等于指定的字段数
          begin
            For l:=1 to Cols-1 do
            begin
              settab(na,pjcenter,Azdkd[Cols*i+l],0,boxlineall,0);
                if l=Cols-1 then
                  tab(na,-2,-2,-2,10)
                else
                  tab(na,Na,-2,-2,10);
              Print(Azdmc[Cols*i+l]);
            end;
          end
          else //折行时最后一行字段数不等于指定的字段数
          begin
            if i= n-1 then //最后一行
              For l :=1 to m-1 do
              begin
                if m>0 then
                begin
                  settab(na,pjcenter,Azdkd[Cols*i+l],0,boxlineall,0);
                    if l=m-1 then
                      tab(na,-2,-2,-2,10)
                    else
                      tab(na,Na,-2,-2,10);
                  Print(Azdmc[Cols*i+l]);
                end;
              end
            else
            begin
              For l := 1 to Cols-1 do
              begin
                settab(na,pjcenter,Azdkd[Cols*i+l],0,boxlineall,0);
                  if l=cols-1 then
                    tab(na,-2,-2,-2,10)
                  else
                    tab(na,na,-2,-2,10);
                Print(Azdmc[Cols*i+l]);
              end;
            end;
          end;
        ClearTabs;
        setFont(BgFont.RFontName,BgFont.RFontSize);
        FontColor := BgFont.RFontColor;
        if (fsBold in BgFont.RFontStyle) then
          Bold := True
        else
          Bold := False;
        if (fsUnderline	 in BgFont.RFontStyle) then
          underline := True
        else
          underline := False;
        if (fsItalic	 in BgFont.RFontStyle) then
          Italic := True
        else
          Italic := False;
        if (fsStrikeOut	in BgFont.RFontStyle) then
          Strikeout := True
        else
          Strikeout := False;
        Case Content.Bgdqfs of
          0: Justify := pjLeft;
          1: Justify := pjRight;
          2: Justify := pjCenter;
        end;
        settab(zbj,Justify,Azdkd[Cols*i],0,boxlineall,0);
        if Cols<>1 then
          if m=0 then //折行时最后一行字段数等于指定的字段数
          begin
            For l:=1 to Cols-1 do
            begin
              settab(na,Justify,Azdkd[Cols*i+l],0,boxlineall,0);
            end;
          end
          else //折行时最后一行字段数不等于指定的字段数
          begin
            if i= n-1 then //最后一行
            begin
              if m>1 then
                For l :=1 to m-1 do
                  settab(na,Justify,Azdkd[Cols*i+l],0,boxlineall,0);
            end
            else
            begin
              For l := 1 to Cols-1 do
                settab(na,Justify,Azdkd[Cols*i+l],0,boxlineall,0);
            end;
          end;
        Data.Query2.First;
        println('');
        while Not Data.Query2.Eof do
        begin
          if m = 0 then
          begin
            For l:=0 to Cols-1 do
            begin
              if l=0 then//第一列
                if Cols<>1 then
                  Tab(-2,na,na,na,0)
                else
                  Tab(-2,-2,na,na,0)
              else if l=Cols-1 then //最后一列
                Tab(na,-2,na,na,0)
              else
                Tab(na,na,na,na,0);
              Print(Data.Query2.Fields[i*Cols+l].AsString);
            end;
          end
          else
          begin
            if i = n-1 then
            begin
              For l :=0 to m-1 do
              begin
                if l=0 then //第一列
                  if m>1 then
                    Tab(-2,na,na,na,0)
                  else
                    Tab(-2,-2,na,na,0)
                else if l=m-1 then //最后一列
                  Tab(na,-2,na,na,0)
                else
                  Tab(na,na,na,na,0);
                Print(Data.Query2.Fields[i*Cols+l].AsString);
              end;
            end
            else
            begin
              For l :=0 to Cols-1 do
              begin
                if l=0 then //第一列
                  Tab(-2,na,na,na,0)
                else if l=Cols-1 then //最后一列
                  Tab(na,-2,na,na,0)
                else
                  Tab(na,na,na,na,0);
                Print(Data.Query2.Fields[i*Cols+l].AsString);
              end;
            end;
          end;
          Println('');
          Data.Query2.Next;
        end;
      end;
    end;
end;

procedure Tf_csyfkbb.dyClick(Sender: TObject);
begin
  Rprinter.Execute;
end;

procedure Tf_csyfkbb.ylClick(Sender: TObject);
begin
  Application.CreateForm(Tf_csyfkdysz,f_csyfkdysz);
  f_csyfkdysz.ShowModal;
  f_csyfkdysz.Free;
end;

end.