xsth.pas

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

unit xsth;

interface

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

type
  Tf_xsth = class(TForm)
    Label11: TLabel;
    Shape1: TShape;
    Label2: TLabel;
    Label1: TLabel;
    Label6: TLabel;
    Label3: TLabel;
    thph: TEdit;
    kh: TEdit;
    thr: TEdit;
    sj: TDateTimePicker;
    bg: TStringGrid;
    Grid1: TDBGrid;
    lb: TListBox;
    Panel2: TPanel;
    Label7: TLabel;
    Label9: TLabel;
    thxj: TEdit;
    thzr: TEdit;
    DataSource1: TDataSource;
    Timer: TDateTimePicker;
    Label4: TLabel;
    czje: TEdit;
    tj: TSpeedButton;
    bc: TSpeedButton;
    qx: TSpeedButton;
    dy: TSpeedButton;
    tc: TBitBtn;
    Rprinter: TRvSystem;
    procedure khExit(Sender: TObject);
    procedure khKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure thrExit(Sender: TObject);
    procedure lbKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure lbExit(Sender: TObject);
    procedure lbDblClick(Sender: TObject);
    procedure bgSelectCell(Sender: TObject; ACol, ARow: Integer;
      var CanSelect: Boolean);
    procedure Grid1DblClick(Sender: TObject);
    procedure Grid1Exit(Sender: TObject);
    procedure Grid1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure bgKeyPress(Sender: TObject; var Key: Char);
    procedure bgKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure bgSetEditText(Sender: TObject; ACol, ARow: Integer;
      const Value: String);
    procedure TimerClick(Sender: TObject);
    procedure TimerExit(Sender: TObject);
    procedure TimerKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormShow(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure thzrChange(Sender: TObject);
    procedure thzrEnter(Sender: TObject);
    procedure thzrKeyPress(Sender: TObject; var Key: Char);
    procedure bgExit(Sender: TObject);
    procedure tcClick(Sender: TObject);
    procedure tjClick(Sender: TObject);
    procedure bcClick(Sender: TObject);
    procedure qxClick(Sender: TObject);
    procedure dyClick(Sender: TObject);
    procedure RprinterPrint(Sender: TObject);
    procedure bgDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect;
      State: TGridDrawState);
    procedure bgClick(Sender: TObject);
  private
    { Private declarations }
  public
    Procedure FindNext;
    Function CurrentIsNull: Boolean;
    Procedure ClearCurrentRow;
    Procedure ClearEndRow;
    Function EditIsNull: Boolean;
    Function Isgq: Boolean;//检查退货商品是否过期
    Function GroupPrice: real;//统计金额
    Function GroupSum(ckmc,spbh,bzq1:String): Integer;//统计表格中同商品同库存同保质期的商品数量,
    //在退货时防止该商品的数量大于库存数量
    Function GridIsNull: Boolean;//判断表格是否为空
    Function CalculateCB(spdm: String):Real;//计算成本
    Procedure SetListPos(WinControl: TWinControl);
    Function QueryBzsj(spdm: String): Real;
    Procedure SelectTable(TableName: String);overload;
    Procedure SelectTable(TableName,FieldName: String;FieldValue: Variant);Overload;//参数FieldName为查询条件
    { Public declarations }
  end;

var
  f_xsth: Tf_xsth;
  kc: Boolean= False;//在设置库存信息时,如果库存信息不存在会清空库存信息,使用该变量防止
  //清空库存信息时再次触发列表的OnSetEditText事件
  Row: integer = 1;
  Col: integer = 0;
  Sumzdkd: real=0.0;// 字段总宽度
  Rowzdkd: Real=0.0;//每行字段总宽度
  zbj: real=0.0; //正文左边距
  AZdmc: Array[0..10]of String=('商品代码','商品名称','基本单位','标准售价','成本价','数量','折扣','金额','保质期','仓库名称','仓库类别');
  AZdkd : Array[0..10]of Real=(1,1,1,1,1,1,1,1,1,1,1); //数组中的元素对应表格中相应字段的宽度
  zds : integer = 11;//表格字段数
  Cols: integer = 6;//每行列数
implementation
  uses DataModal;
{$R *.dfm}
Const
  spdm =0;
  spmc =1;
  jbdw =2;
  bzsj = 3;
  cbj = 4;
  sl =5;
  zk = 6;
  je = 7;
  bzq = 8;
  kcmc = 9;
  kclb = 10;
function Tf_xsth.CalculateCB(spdm: String): Real;
var
  sum: Integer;
  money: Real;
begin
  Result := 0;
  with Data.Query2 do
  begin
    Close;
    SQL.Clear;
    SQL.Add('select Sum(sl)as num,Sum(je)as Je from t_sprkjl where spdm = :a');
    ParamByName('a').AsString := Trim(spdm);
    Open;
  end;
  if Data.Query2.Fields[0].Value<>Null then
  begin
    Sum := Data.Query2.Fields[0].AsInteger;
    money := Data.Query2.Fields[1].AsFloat;
    Result := Money/sum;
  end;
end;

procedure Tf_xsth.ClearCurrentRow;
var
  i: Integer;
begin
  For i:=0 to bg.ColCount-1 do
    bg.Cells[i,Row]:= '';
end;


procedure Tf_xsth.ClearEndRow;
var
  i: Integer;
begin
  For i:=0 to bg.ColCount-1 do
    bg.Cells[i,bg.RowCount-1]:= '';
end;

function Tf_xsth.CurrentIsNull: Boolean;
var
  a: Integer;
begin
  Result := False;
  For a:= 0 to bg.ColCount -1 do
  begin
    if Trim(bg.Cells[a,Row])='' then
    begin
      Result := True;
      Break;
    end;
  end;
end;

function Tf_xsth.EditIsNull: Boolean;
var
  i: Integer;
begin
  Result := False;
  For i := 0 to ControlCount-1 do
  begin
    if Controls[i] is TEdit then
    begin
      if Trim(TEdit(Controls[i]).Text)='' then
      begin
        Result := True;
        Exit;
      end;
    end;
  end;
  For i :=0 to Panel2.ControlCount-1 do
  begin
    if Controls[i] is TEdit then
      if Trim(TEdit(Controls[i]).Text)='' then
      begin
        Result := True;
        Break;
      end;
  end;
end;

procedure Tf_xsth.FindNext;
begin
  if FindNextControl(ActiveControl,True,False,True)is TEdit then
    TEdit(FindNextControl(ActiveControl,True,False,True)).SetFocus
  else if FindNextControl(ActiveControl,True,False,True)is TDateTimePicker then
    TDateTimePicker(FindNextControl(ActiveControl,True,False,True)).SetFocus
  else if FindNextControl(ActiveControl,True,False,True)is TStringGrid then
  begin
    TStringGrid(FindNextControl(ActiveControl,True,False,True)).SetFocus;
    bg.Col := 0;
    bg.Cells[zk,1]:= '1.0';
  end;
end;

function Tf_xsth.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_xsth.GroupPrice: real;
var
  r: Integer;
  Sum: Real;
begin
  Sum := 0.0;
  For r:=1 to bg.RowCount-1 do
    if Trim(bg.Cells[je,r])<>'' then
      Sum := Sum + StrToFloat(bg.Cells[je,r]);
  Result := Sum;
end;

function Tf_xsth.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_xsth.SelectTable(TableName: String);
begin
  With Data.Query1 do
  begin
    Close;
    SQL.Clear;
    SQL.Add('select * from '+ TableName);
    Open;
  end;
  lb.Clear;
  if Data.Query1.RecordCount>0 then
    while Not Data.Query1.Eof do
    begin
      lb.Items.Add(Data.Query1.Fields[1].AsString);
      Data.Query1.Next;
    end;
end;

procedure Tf_xsth.SelectTable(TableName, FieldName: String;
  FieldValue: Variant);
begin
  With Data.Query1 do
  begin
    Close;
    SQL.Clear;
    SQL.Add('select * from '+ TableName + ' where '+ FieldName + ' =:a');
    Params[0].Value :=  FieldValue;
    Open;
  end;
  lb.Clear;
  if Data.Query1.RecordCount>0 then
    while Not Data.Query1.Eof do
    begin
      lb.Items.Add(Data.Query1.Fields[1].AsString);
      Data.Query1.Next;
    end;
end;

procedure Tf_xsth.SetListPos(WinControl: TWinControl);
begin
  lb.Top := WinControl.Top;
  lb.Left := WinControl.Left+(WinControl.Width-lb.Width);
  lb.Visible := True;
  lb.SetFocus;
end;

procedure Tf_xsth.khExit(Sender: TObject);
begin
  if Trim(kh.Text)<>'' then
  begin
    with Data.Query2 do
    begin
      Close;
      SQL.Clear;
      SQL.Add('select * from t_khzl where khmc = :a');
      ParamByName('a').AsString := Trim(kh.Text);
      Open;
    end;
    if  Data.Query2.RecordCount <1 then
      kh.Clear;
  end;
end;

procedure Tf_xsth.khKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Trim(thph.Text)='' then
  begin
    Application.MessageBox('请添加退货票号.','提示',64);
    Exit;
  end;
  if (Key = vk_Next)and(Sender is TEdit) then
  begin
    if TEdit(Sender).Name = 'kh' then
    begin
      SelectTable('t_khzl');
      lb.Tag := 1;
      SetListPos(kh);
      lb.SetFocus;
      lb.ItemIndex := 0;
    end
    else if TEdit(Sender).Name = 'thr' then
    begin
      SelectTable('t_employee','bmmc','销售部');
      lb.Tag := 2;
      SetListPos(thr);
      lb.SetFocus;
      lb.ItemIndex := 0;
    end;
  end
  else if Key = vk_Return  then
  begin
    if Sender is TEdit then
    begin
      if TEdit(Sender).Name = 'kh' then
      begin
        With Data.Query1 do
        begin
          Close;
          SQL.Clear;
          SQL.Add('select * from t_khzl where khdm = :a or khmc = :a');
          ParamByName('a').AsString := Trim(kh.Text);
          Open;
        end;
        if Data.Query1.RecordCount>0 then
          kh.Text := Data.Query1.Fields[1].AsString
        else
        begin
          Application.MessageBox('该客户不存在.','提示',64);
          kh.Clear;
          kh.SetFocus;
          Exit;
        end;
      end
      else if TEdit(Sender).Name = 'thr' then
      begin
        With Data.Query1 do
        begin
          Close;
          SQL.Clear;
          SQL.Add('select * from t_employee where (ygdm = :a or ygmc = :a) and bmmc = :b');
          ParamByName('a').AsString := Trim(thr.Text);
          ParamByName('b').AsString := '销售部';
          Open;
        end;
        if Data.Query1.RecordCount>0 then
          thr.Text := Data.Query1.Fields[1].AsString
        else
        begin
          Application.MessageBox('该退货人不存在.','提示',64);
          thr.Clear;
          thr.SetFocus;
          Exit;
        end;
      end;
    end;
    FindNext;
  end;
end;

procedure Tf_xsth.thrExit(Sender: TObject);
var
  key: Word;
begin
  if Trim(thr.Text)<>'' then
  begin
    Key := vk_ReTurn;
    thr.OnKeyDown(Sender,Key,[ssctrl]);
  end;
end;

procedure Tf_xsth.lbKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = vk_Return then
  begin
    case lb.Tag of
      1: begin
           kh.Text := lb.Items[lb.ItemIndex];
           kh.OnKeyDown(kh,Key,shift);
           kh.SetFocus;
         end;
      2: begin
           thr.Text := lb.Items[lb.ItemIndex];
           thr.SetFocus;
         end;
    end;
    lb.Visible := False;
  end;
end;

procedure Tf_xsth.lbExit(Sender: TObject);
begin
  lb.Visible := False;
end;

procedure Tf_xsth.lbDblClick(Sender: TObject);
var
  Key: Word;
begin
  inherited;
  Key:= vk_ReTurn;
  lb.OnKeyDown(nil,Key,[ssLeft]);
end;

procedure Tf_xsth.bgSelectCell(Sender: TObject; ACol, ARow: Integer;
  var CanSelect: Boolean);
begin
  Row := ARow;
  Col:= ACol;
  if (Col = spdm)and(Trim(bg.Cells[spmc,Row])='')or(Col=spmc)and(Trim(bg.Cells[spdm,Row])='')
   or(Col = sl)and(Trim(bg.Cells[spdm,Row])<>'')or(Col=zk)and(Trim(bg.Cells[spdm,Row])<>'')
   or(Col = kcmc)and(Trim(bg.Cells[jbdw,Row])<>'') and(Trim(bg.Cells[kclb,Row])='')then
     bg.Options := bg.Options +[goEditing]
  else
    bg.Options := bg.Options -[goEditing];
end;

procedure Tf_xsth.Grid1DblClick(Sender: TObject);
begin
  Case Grid1.Tag of
    1: begin
         bg.Cells[kcmc,Row]:= Trim(Data.Query1.FieldByName('kcmc').AsString);
         bg.Cells[kclb,Row]:= Trim(Data.Query1.FieldByName('kclb').AsString);
         bg.SetFocus;
         bg.Col := bg.Col+1;
       end;
    2: begin
         bg.Cells[spdm,Row]:= Trim(Data.Query1.FieldByName('spdm').AsString);
         bg.Cells[spmc,Row]:= Trim(Data.Query1.FieldByName('spmc').AsString);
         bg.Cells[jbdw,Row]:= Trim(Data.Query1.FieldByName('jbdw').AsString);