xsth.pas

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

    if StrToFloat(thzr.Text)>StrToFloat(thxj.Text) then
    begin
      Application.MessageBox('退货折让不能大于退货小计.','提示',64);
      thzr.Text := '0.0';
    end
    else
    begin
      thxj.Text := Format('%8.4f',[Groupprice]);
      czje.Text := Format('%8.4f',[StrToFloat(thxj.Text)-StrToFloat(thzr.Text)]);
    end;
  end
  else
    thzr.Text := '0.0';
end;

procedure Tf_xsth.thzrEnter(Sender: TObject);
begin
  thzr.SelectAll;
end;

procedure Tf_xsth.thzrKeyPress(Sender: TObject; var Key: Char);
var
  i: Boolean;
begin
  i := (Key<#8)or(Key>#8)and(Key<#46)or(Key>#46)and(Key<#48)or(Key>#57);
  if i then
    Key := #0;
end;

procedure Tf_xsth.bgExit(Sender: TObject);
begin
  if (Grid1.Visible = true)and(Grid1.Focused = False)then
  begin
    Grid1.Visible := False;
    kc := True;
  end;
end;

function Tf_xsth.QueryBzsj(spdm: String): Real;
begin
  with Data.Query3 do
  begin
    Close;
    SQL.Clear;
    SQL.Add('select bzsj from t_spsj where spdm = :a');
    ParamByName('a').AsString := Trim(spdm);
    Open;
  end;
  if Data.Query3.RecordCount>0 then
    Result := Data.Query3.Fields[0].AsFloat
  else
    Result := -1;
end;

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

procedure Tf_xsth.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_xsthph 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;
  thph.Text := s;
  sj.Enabled := False;
  if kh.Enabled = True then
    kh.SetFocus;
end;

procedure Tf_xsth.bcClick(Sender: TObject);
var
  i: Integer;
begin
  if EditIsNull = False then
    if GridIsNull = False then
    begin
      if IsGq = True then
      begin
        Application.MessageBox('列表中有过期商品,不能完成退货.','提示',64);
        Exit;
      end;
      Try
        Data.Database.StartTransaction;
        with Data.Query1 do
        begin
          Close;
          SQL.Clear;
          SQL.Add('insert t_xsthph values(:a,:b,:c,:d,:e,:f)');
          ParamByName('a').AsString := Trim(thph.Text);
          ParamByName('b').AsFloat := StrToFloat(thxj.Text);
          ParamByName('c').AsFloat := StrToFloat(thzr.Text);
          ParamByName('d').AsFloat := StrToFloat(czje.Text);
          ParamByName('e').AsString := Trim(thr.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_xsthmx values(:a,:b,:c,:d,:e,:f,:g,:h)');
            ParamByName('a').AsString := Trim(thph.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('select * from t_sprkjl where spdm = :a and kcmc = :b and (bzq>= :c and bzq<= :d)');
            ParamByName('a').AsString := Trim(bg.Cells[spdm,i]);
            ParamByName('b').AsString := Trim(bg.Cells[kcmc,i]);
            ParamByName('c').AsDate := Trunc(StrToDateTime(bg.Cells[bzq,i]));
            ParamByName('d').AsDate := Trunc(StrToDateTime(bg.Cells[bzq,i]))+1;
            Open;
          end;
          if Data.Query1.RecordCount>0 then
          begin
            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;
          end
          else
          begin
            with Data.Query1 do
            begin
              Close;
              SQL.Clear;
              SQL.Add('insert t_sprkjl values(:a,:b,:c,:d,:e,:f)');
              ParamByName('a').AsString := Trim(bg.Cells[kcmc,i]);
              //库存金额按成本价格增加,在销售退货时库存成本不变
              ParamByName('b').AsString := Trim(bg.Cells[spdm,i]);
              ParamByName('c').AsDate := StrToDateTime(bg.Cells[bzq,i]);
              ParamByName('d').Asinteger := StrToint(bg.Cells[sl,i]);
              ParamByName('e').AsFloat := StrToint(bg.Cells[sl,i])*StrToFloat(bg.Cells[cbj,i]);
              ParamByName('f').AsDate := Trunc(StrToDateTime(bg.Cells[bzq,i]));
              ExecSQL;
            end;
          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_khjk set ysje = ysje - :a where khmc = :b');
          ParamByName('a').AsFloat := StrToFloat(czje.Text);//+StrToFloat(thzr.Text);
          ParamByName('b').AsString := Trim(kh.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_xsth.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;
  kh.Enabled := True;
  sj.Enabled := True;
  lb.Visible := False;
  thph.Clear;
  thzr.Text := '0.0';
  thxj.Text:='0.0';
  czje.Text := '0.0';
  Col := 0;
  Row := 1;
  thr.Clear;
  kh.Clear;
  kh.SetFocus;
end;

procedure Tf_xsth.dyClick(Sender: TObject);
begin
  Rprinter.Execute;
end;
                
procedure Tf_xsth.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(thph.Text),zbj);
    printRight('时    间：'+FormatDateTime('yyyy-mm-dd',sj.DateTime),zbj+Rowzdkd);
    printCenter('客    户:  '+Trim(kh.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(thxj.Text),zbj);
    printcenter('退货折让:  '+Trim(thzr.Text),(pageWidth)/2);
    printright('冲账金额:  '+Trim(czje.Text),zbj+Rowzdkd);
  end;
end;

procedure Tf_xsth.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
        spdm: zdmc := '商品代码';
        spmc: zdmc := '商品名称';
        jbdw: zdmc := '基本单位';
        bzsj: zdmc := '标准售价';
        cbj: zdmc := '成本价';
        sl: zdmc := '数量';
        zk: zdmc := '折扣';
        je: zdmc := '金额';
        bzq: zdmc := '保质期';
        kcmc: zdmc := '仓库名称';
        kclb: 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_xsth.bgClick(Sender: TObject);
begin
  bg.Repaint;
end;

end.