cgth.~pas

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

function Tf_cgth.GridIsNull: Boolean;
var
  c,r: Integer;
begin
  Result := False;
  For r := 1 to bg.RowCount-1 do
    For c := 0 to bg.ColCount-1 do
    if Trim(bg.Cells[c,r])='' then
    begin
      Result := True;
      Break;
    end;
end;

function Tf_cgth.GroupSum(ckmc,Spbh,bzq1: string): Integer;
var
  r: Integer;
begin
  Result := 0;
  For r := 1 to bg.RowCount-1 do
  begin
    if Trim(ckmc)=Trim(bg.Cells[kcmc,r]) then
      if (Trim(spbh)=Trim(bg.Cells[spdm,r]))then
        if (Trim(bzq1)= Trim(bg.Cells[bzq,r]))then
          Result := Result + StrToInt(bg.Cells[sl,r]);
  end;
end;

procedure Tf_cgth.bzqlbExit(Sender: TObject);
begin
  bzqlb.Visible := False;
  bg.SetFocus;
  bg.Col := je;
  bg.Col := bzq;
end;

procedure Tf_cgth.tjClick(Sender: TObject);
var
  s,m: String;
  i: integer;
begin
  s:= 'PH'+ FormatDateTime('yyyymmdd',sj.Date);
  With Data.Query1 do
  begin
    Close;
    SQL.Clear;
    SQL.Add('select max(thph) as ss From t_cgthph where sj>=:a and sj <:b');
    ParamByName('a').AsDate := Trunc(sj.Date);
    ParamByName('b').AsDate := Trunc(sj.Date)+1;
    Open;
  end;
  If Data.Query1.FieldByName('ss').Value = null then
    s := s + '001'
  else
  begin
    m:= Trim(Data.Query1.FieldByName('ss').Value) ;
    i:= StrToInt(Trim(Copy(m,11,8))) ;
    if i<9 then
      s:= s + '00'+ InttoStr(i +1)
    else if i<99 then
      s:= s + '0'+ InttoStr(i +1)
    else
      s:= s +InttoStr(i +1);
  end;
  cgph.Text := s;
  sj.Enabled := False;
  if cs.Enabled = True then
    cs.SetFocus;
end;

procedure Tf_cgth.bcClick(Sender: TObject);
var
  i,sum: Integer;
begin
  if EditIsNull = False then
    if GridIsNull = False then
    begin
      For i:= 1 to bg.RowCount-1 do
      begin
        with Data.Query1 do
        begin
          Close;
          SQL.Clear;
          SQL.Add('select sl from t_sprkjl where kcmc = :a and spdm = :b and (bzq>=:c and bzq<=:d)');
          ParamByName('a').AsString := Trim(bg.Cells[kcmc,i]);
          ParamByName('b').AsString := Trim(bg.Cells[spdm,i]);
          ParamByName('c').AsDate := Trunc(StrToDateTime(bg.Cells[bzq,i]));
          ParamByName('d').AsDate := Trunc(StrToDateTime(bg.Cells[bzq,i]))+1;
          Open;
        end;
        Sum := Data.Query1.FieldByName('sl').AsInteger;
        if Groupsum(Trim(bg.Cells[kcmc,i]),Trim(bg.Cells[spdm,i]),Trim(bg.Cells[bzq,i]))>sum then
        begin
          Application.MessageBox(Pchar('商品编号为'+Trim(bg.Cells[spdm,i])+'的商品在'+bg.Cells[kcmc,i]+'库中没有数量,不能完成退货'),'提示',64);
          Exit;
        end;
      end;
      Try
        Data.Database.StartTransaction;
        with Data.Query1 do
        begin
          Close;
          SQL.Clear;
          SQL.Add('insert t_cgthph values(:a,:b,:c,:d,:e,:f)');
          ParamByName('a').AsString := Trim(cgph.Text);
          ParamByName('b').AsFloat := StrToFloat(thxj.Text);
          ParamByName('c').AsFloat := StrToFloat(thzr.Text);
          ParamByName('d').AsFloat := StrToFloat(thzr.Text)+StrToFloat(thxj.Text);
          ParamByName('e').AsString := Trim(cgy.Text);
          ParamByName('f').AsDate := sj.Date;
          ExecSQL;
        end;
        For i := 1 to bg.RowCount-1 do
        begin
          with Data.Query1 do
          begin
            Close;
            SQL.Clear;
            SQL.Add('insert t_cgthmx values(:a,:b,:c,:d,:e,:f,:g,:h)');
            ParamByName('a').AsString := Trim(cgph.Text);
            ParamByName('b').AsString := Trim(bg.Cells[kcmc,i]);
            ParamByName('c').AsString := Trim(bg.Cells[spdm,i]);
            ParamByName('d').AsString := Trim(bg.Cells[jbdw,i]);
            ParamByName('e').AsInteger := StrToInt(bg.Cells[sl,i]);
            ParamByName('f').AsFloat := StrToFloat(bg.Cells[zk,i]);
            ParamByName('g').AsFloat := StrToFloat(bg.Cells[je,i]);
            ParamByName('h').AsDate := StrToDateTime(bg.Cells[bzq,i]);
            ExecSQL;
          end;
          with Data.Query1 do
          begin
            Close;
            SQL.Clear;
            SQL.Add('update t_sprkjl set sl = sl- :a ,je = je-:b where kcmc = :c and spdm = :d and (bzq >= :e and bzq<=:f)');
            ParamByName('a').AsInteger := StrToInt(bg.Cells[sl,i]);
            //库存金额按成本价格递减,在采购退货时库存成本不变
            ParamByName('b').AsFloat := StrToInt(bg.Cells[sl,i])*StrToFloat(bg.Cells[cbj,i]);
            ParamByName('c').AsString := Trim(bg.Cells[kcmc,i]);
            ParamByName('d').AsString := Trim(bg.Cells[spdm,i]);
            ParamByName('e').AsDate := Trunc(StrToDateTime(bg.Cells[bzq,i]));
            ParamByName('f').AsDate := Trunc(StrToDateTime(bg.Cells[bzq,i]))+1;
            ExecSQL;
          end;
          with Data.Query1 do
          begin
            Close;
            SQL.Clear;
            SQL.Add('update t_kc set kcsl = kcsl- :a where spdm = :b');
            ParamByName('a').AsInteger := StrToInt(bg.Cells[sl,i]);
            ParamByName('b').AsString := Trim(bg.Cells[spdm,i]);
            ExecSQL;
          end;
        end;
        with Data.Query1 do
        begin
          Close;
          SQL.Clear;
          SQL.Add('update t_csjk set yfje = yfje - :a where csmc = :b');
          ParamByName('a').AsFloat := StrToFloat(thxj.Text)+ StrToFloat(thzr.Text);
          ParamByName('b').AsString := Trim(cs.Text);
          ExecSQL;
        end;
        Data.Database.Commit;
        Application.MessageBox('退货成功.','提示',64);
        qx.OnClick(Sender);
      Except
        Data.Database.Rollback;
        Application.MessageBox('系统出错.','提示',64);
      end;
    end
    else
      Application.MessageBox('表格数据不能为空.','提示',64)
  else
    Application.MessageBox('数据项不能为空.','提示',64);
end;

procedure Tf_cgth.qxClick(Sender: TObject);
var
  c,r: Integer;
begin
  kc := True;
  For r:=1 to bg.RowCount-1 do
    For c:=0 to bg.ColCount-1 do
      bg.Cells[c,r]:='';
  bg.RowCount:=2;
  Grid1.Visible := False;
  cs.Enabled := True;
  sj.Enabled := True;
  lb.Visible := False;
  cgph.Clear;
  thzr.Text := '0.0';
  thxj.Text:='0.0';
  Col := 0;
  Row := 1;
  cgy.Clear;
  cs.Clear;
  cs.SetFocus;
end;

procedure Tf_cgth.tcClick(Sender: TObject);
begin
  Close;
end;

procedure Tf_cgth.FormCreate(Sender: TObject);
var
  i: Integer;
begin
  SetWindowLong(tc.Handle,gwl_style,getwindowlong(tc.Handle,gwl_style)or bs_multiline);
  tc.Caption := '退'+ #13 +'出';
  Sumzdkd := 0;
  For i := 0 to zds-1 do
  begin
    sumzdkd := Sumzdkd+ Azdkd[i];
  end;
  Rowzdkd := Cols*(Sumzdkd/zds);
end;

procedure Tf_cgth.BitBtn4Click(Sender: TObject);
begin
  Rprinter.Execute;
end;

procedure Tf_cgth.RprinterPrint(Sender: TObject);
var
 i,m,n,l,r: integer;
begin
  with Sender as TBaseRePort do
  begin
    zbj := (PageWidth-Rowzdkd)/2;
    SetFont('宋体',18);
    FontColor :=clred;
    ypos := 0.8;
    PrintCenter('采购退货单',PageWidth/2);
    setFont('宋体',10);
    FontColor := clblue;
    ypos := ypos+0.5 ;
    printLeft('退货票号:  '+Trim(cgph.Text),zbj);
    printRight('时    间：'+FormatDateTime('yyyy-mm-dd',sj.DateTime),zbj+Rowzdkd);
    printCenter('厂    商:  '+Trim(cs.Text),PageWidth/2);
    ypos := ypos+0.4;
    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('宋体',12);
      FontColor := clBlue;
      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('宋体',10);
      settab(zbj,pjLeft,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,pjLeft,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,pjLeft,Azdkd[Cols*i+l],0,boxlineall,0);
          end
          else
          begin
            For l := 1 to Cols-1 do
              settab(na,pjLeft,Azdkd[Cols*i+l],0,boxlineall,0);
          end;
        end;
      println('');
      For r:=1 to bg.RowCount-1 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(bg.Cells[i*Cols+l,r]);
          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(bg.Cells[i*Cols+l,r]);
            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(bg.Cells[i*Cols+l,r]);
            end;
          end;
        end;
        Println('');
      end;
    end;
    Println('');
    printLeft('退货折让:  '+Trim(thzr.Text),zbj);
    printcenter('退货小计:  '+Trim(thxj.Text),(pageWidth)/2);
  end;
end;

procedure Tf_cgth.bgDrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var
  CellRect: TRect;
  zdmc: String;
  zdwidth,zdheight,i: integer;
begin
  if Arow = 0 then
  begin
   zdheight:= 12;
   For i := 0 to bg.ColCount-1 do
    begin
      CellRect := bg.CellRect(i,0);
      Case i of
        kcmc: zdmc := '仓库名称';
        kclb: zdmc := '仓库类别';
        spdm: zdmc := '商品代码';
        spmc: zdmc := '商品名称';
        cbj: zdmc := '成本价';
        jbdw: zdmc := '基本单位';
        sl: zdmc := '数量';
        zk: zdmc := '折扣';
        je: zdmc := '金额';
        bzq: zdmc := '保质期';
      end;
      zdwidth := length(Trim(zdmc));
      bg.Canvas.Font.Color := clRed;
      bg.Canvas.Brush.Color := bg.FixedColor;
      if CellRect.Right <>0 then
      begin
        bg.Canvas.FillRect(CellRect);
        bg.Canvas.TextOut(CellRect.Left+Trunc((bg.ColWidths[i]-zdwidth*6)/2),CellRect.Top+Trunc((bg.RowHeights[0] -zdheight)/2),zdmc );
      end;
    end;
  end;
end;

procedure Tf_cgth.bgClick(Sender: TObject);
begin
  bg.Repaint;
end;

end.