bscl.pas

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

        if Row1<>bg.RowCount-1 then
        begin
          For row := Row1+1to (bg.RowCount-1) do
            For col:=0 to bg.ColCount-1 do
              bg.Cells[col,row-1]:= bg.Cells[col,row];
        end;
        ClearEndRow;
        bg.RowCount := bg.RowCount-1;
      end;
      spzl.Caption:= IntToStr(GroupKinds);
      spsl.Caption := IntToStr(GroupSum);
      spje.Caption := Format('%8.4f',[GroupMoney]);
      bg.SetFocus;
      bg.Col := kcmc;
    end;
  end;
  if (Key= vk_insert)and(CurrentIsNull = False)and(Row1 = bg.RowCount-1) then  //添加新行
  begin
    bg.RowCount := bg.RowCount+1;
    bg.Row:= Bg.Row+1;
    bg.Col:=kcmc;
    exit;
  end;
  if Key = vk_Return then    //查询定位计算数据
  begin
    if Grid1.Visible = True then
      Grid1.Visible := False;
    if (Col1 = bzq)and(Trim(bg.Cells[spdm,Row1])<>'') then
    begin
      bzqlb.Clear;
      with Data.Query2 do
      begin
        Close;
        SQL.Clear;
        SQL.Add('select bzq from t_sprkjl where spdm = :a and kcmc = :b');
        ParamByName('a').AsString := Trim(bg.Cells[spdm,Row1]);
        ParamByName('b').AsString := Trim(bg.Cells[kcmc,Row1]);
        Open;
      end;
      while Not Data.Query2.Eof do
      begin
        bzqlb.Items.Add(DateTimeToStr(Data.Query2.FieldByName('bzq').AsDateTime));
        Data.Query2.Next;
      end;
      Rect1 := bg.CellRect(bzq,Row1);
      bzqlb.Left := Rect1.Left+bg.Left;
      bzqlb.Width :=Rect1.Right-Rect1.Left+bg.Left;
      bzqlb.Top := bg.Top+ Rect1.Top;
      bzqlb.Visible := True;
      bzqlb.SetFocus;
      bzqlb.ItemIndex := 0;
      Exit;
    end;
    if (Col1 = bzq)and(Trim(bg.Cells[spdm,Row1])<>'') then
    begin
      bzqlb.Clear;
      with Data.Query2 do
      begin
        Close;
        SQL.Clear;
        SQL.Add('select bzq from t_sprkjl where spdm = :a and kcmc = :b');
        ParamByName('a').AsString := Trim(bg.Cells[spdm,Row1]);
        ParamByName('b').AsString := Trim(bg.Cells[kcmc,Row1]);
        Open;
      end;
      while Not Data.Query2.Eof do
      begin
        bzqlb.Items.Add(DateTimeToStr(Data.Query2.FieldByName('bzq').AsDateTime));
        Data.Query2.Next;
      end;
      Rect1 := bg.CellRect(bzq,Row1);
      Rect1.Left := Rect1.Left+bg.Left;
      Rect1.Right :=Rect1.Right+bg.Left;
      Rect1.Top := bg.Top+ Rect1.Top;
      bzqlb.Left := Rect1.Left;
      bzqlb.Top := Rect1.Top+1;
      bzqlb.Visible := True;
      bzqlb.SetFocus;
      bzqlb.ItemIndex := 0;
      Exit;
    end;
    if Trim(bg.Cells[kcmc,Row1])='' then
      Exit;
    if (Col1 = Kcmc)and(Trim(bg.Cells[Kcmc,Row1])<>'') then //不在列表中选择,直接输入库存信息时,判断库存信息是否存在
    begin
      With Data.Query1 do
      begin
        Close;
        SQL.Clear;
        SQL.Add('select * from t_kcjcxx where kcdm = :a or kcmc = :a');
        ParamByName('a').AsString := Trim(bg.Cells[Kcmc,Row1]);
        Open;
      end;
      if Data.Query1.RecordCount>0 then
      begin
        bg.Cells[kcmc,Row1]:= Trim(Data.Query1.Fields[1].AsString);
        bg.Cells[kclb,Row1]:= Trim(Data.Query1.Fields[2].AsString);
        bg.SetFocus;
        bg.Col := bg.Col+1;
      end
      else
      begin
        kc := True;
        bg.Cells[kcmc,Row1]:='';
        bg.Cells[kclb,Row1]:='';
      end;          
    end
    else if (Col1 = spdm)and(Trim(bg.Cells[spdm,Row1])<>'')and(Trim(bg.Cells[kcmc,Row1])<>'') then
    begin
      With Data.Query1 do
      begin
        Close;
        SQL.Clear;
        SQL.Add('select * from t_spjcxx where spdm in(select distinct spdm from t_sprkjl where spdm =:a and kcmc = :b)');
        ParamByName('a').AsString := Trim(bg.Cells[spdm,Row1]);
        ParamByName('b').AsString := Trim(bg.Cells[kcmc,Row1]);
        Open;
      end;
      if Data.Query1.RecordCount>0 then
      begin
        bg.Cells[spdm,Row1]:= Trim(Data.Query1.Fields[0].AsString);
        bg.Cells[spmc,Row1]:= Trim(Data.Query1.Fields[1].AsString);
        bg.Cells[cbj,Row1]:=Format('%8.4f',[CalculateCB(Trim(Data.Query1.FieldByName('spdm').AsString))]);
        bg.SetFocus;
        bg.Col := bg.Col+1;
      end
      else
      begin
        kc := True;
        bg.Cells[spdm,Row1]:='';
        bg.Cells[spmc,Row1]:='';
        bg.Cells[cbj,Row1]:='';
      end;
    end
    else if (Col1 = spmc)and(Trim(bg.Cells[spmc,Row1])<>'')and(Trim(bg.Cells[spdm,Row1])='')and(Trim(bg.Cells[Kcmc,Row1])<>'') then
    begin
      With Data.Query1 do
      begin
        Close;
        SQL.Clear;
        SQL.Add('select * from t_spjcxx where spmc = :a and spdm in(select distinct spdm from t_sprkjl where kcmc = :b)');
        ParamByName('a').AsString := Trim(bg.Cells[spmc,Row1]);
        ParamByName('b').AsString := Trim(bg.Cells[kcmc,Row1]);
        Open;
      end;
      if Data.Query1.RecordCount>0 then
      begin
        bg.Cells[spdm,Row1]:= Trim(Data.Query1.Fields[0].AsString);
        bg.Cells[spmc,Row1]:= Trim(Data.Query1.Fields[1].AsString);
        bg.Cells[cbj,Row1]:= Format('%8.4f',[CalculateCB(Trim(Data.Query1.FieldByName('spdm').AsString))]);
        bg.SetFocus;
        bg.Col := bg.Col+1;
      end
      else
      begin
        kc := True;
        bg.Cells[spdm,Row1]:='';
        bg.Cells[spmc,Row1]:='';
        bg.Cells[cbj,Row1]:='';
      end;
    end
    else
    begin
      bg.SetFocus;
      if bg.Col<bg.ColCount-1 then
        bg.Col := bg.Col+1;
    end;
  end;
end;

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

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


function Tf_bscl.CurrentIsNull: Boolean;
var
  a: Integer;
begin
  Result := False;
  For a:= 0 to bg.ColCount -1 do
  begin
    if Trim(bg.Cells[a,Row1])='' then
    begin
      Result := True;
      Break;
    end;
  end;
end;
procedure Tf_bscl.bzqlbDblClick(Sender: TObject);
begin
  bg.Cells[bzq,Row1]:= bzqlb.Items[bzqlb.itemIndex];
  bzqlb.Visible := False;
  bg.SetFocus;
end;

procedure Tf_bscl.bzqlbKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = Vk_Return then
    bzqlb.OnDblClick(Sender);
end;

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

function Tf_bscl.GroupKinds: Integer; //该函数的注释部分是统计商品种类的另一种方法
var
  i,m: integer;
begin
  Result := 0;
  if Bg.RowCount<3 then //只有一行数据
  begin
    if Trim(bg.Cells[spdm,1])<>'' then
      Result := 1;
    Exit;
  end;
  For i :=1 to bg.RowCount-2 do
  begin
    For m := i+1 to bg.RowCount-1 do
    begin
      if (Trim(bg.Cells[spdm,i])<>'')and(Trim(bg.Cells[spdm,m])<>'')then
        if (Trim(bg.Cells[spdm,i]))=(Trim(bg.Cells[spdm,m])) then
        begin
          Break;
        end;
      if m = bg.RowCount-1 then
        Inc(Result);
    end;
  end;
  Result := Result+1;
end;


function Tf_bscl.GroupSum: integer;
var
  i: integer;
begin
  Result := 0;
  For i:=1 to bg.RowCount-1 do
  begin
    if Trim(bg.Cells[sl,i])<>'' then
      Result := Result +StrToInt(bg.Cells[sl,i]);
  end;
end;

function Tf_bscl.GroupMoney: Real;
var
  i: integer;
begin
  Result := 0.0;
  For i:=1 to bg.RowCount-1 do
  begin
    if Trim(bg.Cells[je,i])<>'' then
      Result := Result +StrToFloat(bg.Cells[je,i]);
  end;
end;

procedure Tf_bscl.bcClick(Sender: TObject);
var
  i: integer;
begin
  if Trim(bsph.Caption)='' then
  begin
    Application.MessageBox('请添加报损票号.','提示',64);
    Exit;
  end;
  if Trim(kgy.Text)='' then
  begin
    Application.MessageBox('请输入库管员.','提示',64);
    Exit;
  end
  else
  begin
    with Data.Query1 do
    begin
      Close;
      SQL.Clear;
      SQL.Add('select * from t_employee where ygmc = :a and bmmc = ''库存部''');
      ParamByName('a').AsString := Trim(kgy.Text);
      Open;
    end;
    if Data.Query1.RecordCount<1 then
    begin
      Application.MessageBox('该库管员不存在或没有权限.','提示',64);
      Exit;
    end;
  end;
  if GridIsNull = False then
  begin
    Try
      Data.Database.StartTransaction;
      with Data.Query1 do
      begin
        Close;
        SQL.Clear;
        SQL.Add('insert t_bsph values (:a,:b,:c,:d,:e,:f)');
        ParamByName('a').AsString := Trim(bsph.Caption);
        ParamByName('b').AsString := Trim(kgy.Text);
        ParamByName('c').AsInteger := StrToInt(spzl.Caption);
        ParamByName('d').AsInteger := StrToInt(spsl.Caption);
        ParamByName('e').AsFloat := StrToFloat(spje.Caption);
        ParamByName('f').AsDate := StrToDateTime(sj.Caption);
        ExecSQL;
      end;
      For i := 1 to bg.RowCount-1 do
      begin
        with Data.Query1 do
        begin
          Close;
          SQL.Clear;
          SQL.Add('insert t_bsmx Values(:a,:b,:c,:d,:e,:f,:g)');
          ParamByName('a').AsString := Trim(bsph.Caption);
          ParamByName('b').AsString := Trim(bg.Cells[kcmc,i]);
          ParamByName('c').AsString := Trim(bg.Cells[spdm,i]);
          ParamByName('d').AsInteger := StrToInt(bg.Cells[sl,i]);
          ParamByName('e').AsFloat := StrToFloat(bg.Cells[cbj,i]);
          ParamByName('f').AsFloat := StrToFloat(bg.Cells[je,i]);
          ParamByName('g').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 - :aa where kcmc =:b and spdm =:c and (bzq>=:d and bzq<:e)');
          ParamByName('a').AsInteger := StrToInt(bg.Cells[sl,i]);
          ParamByName('aa').AsFloat := StrToFloat(bg.Cells[je,i]);
          ParamByName('b').AsString := Trim(bg.Cells[kcmc,i]);
          ParamByName('c').AsString := Trim(bg.Cells[spdm,i]);
          ParamByName('d').AsDate := Trunc(StrToDateTime(bg.Cells[bzq,i]));
          ParamByName('e').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 = :c and kcmc = :b');
          ParamByName('a').AsInteger :=  StrToInt(bg.Cells[sl,i]);
          ParamByName('b').AsString := Trim(bg.Cells[kcmc,i]);
          ParamByName('c').AsString := Trim(bg.Cells[spdm,i]);
          ExecSQL;
        end;
      end;
    Data.Database.Commit;
    Application.MessageBox('操作成功.','提示',64);
    qx.OnClick(Sender);
    Except
      Data.Database.Rollback;
      Application.MessageBox('系统出错.','提示',64);
    End;
  end
  else
    Application.MessageBox('表格不能为空.','提示',64);
end;

function Tf_bscl.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,1])='' then
    begin
      Result := True;
      Break;
    end;
end;

procedure Tf_bscl.qxClick(Sender: TObject);
var
  i,m: Integer;
begin
  kgy.Clear;
  bsph.Caption := '';
  spzl.Caption := '0';
  spsl.Caption := '0';
  spje.Caption := '0.0000';
  lb.Visible := False;
  Row1 := 1;
  Col1 := 0;
  bzqlb.Visible := False;
  Grid1.Visible := False;
  for i:=1 to bg.RowCount-1 do
    For m :=0 to bg.ColCount-1 do
      bg.Cells[m,i]:='';
  bg.RowCount := 2;
end;

procedure Tf_bscl.tjClick(Sender: TObject);
var
  s,m: String;
  i: integer;
begin
  s:= 'BS'+ FormatDateTime('yyyymmdd',Now);
  With Data.Query1 do
  begin
    Close;
    SQL.Clear;
    SQL.Add('select max(bsph) as ss From t_bsph where sj>=:a and sj <:b');
    ParamByName('a').AsDate := Trunc(Now);
    ParamByName('b').AsDate := Trunc(Now)+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;
  bsph.Caption := s;
  kgy.SetFocus;
end;

procedure Tf_bscl.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 := '成本价';
        sl: 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_bscl.bgClick(Sender: TObject);
begin
  bg.Repaint;
end;

end.