bscl.pas

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

unit bscl;

interface

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

type
  Tf_bscl = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    kgy: TEdit;
    Label3: TLabel;
    Label4: TLabel;
    Shape1: TShape;
    Shape2: TShape;
    bg: TStringGrid;
    Panel1: TPanel;
    Panel2: TPanel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    spzl: TLabel;
    spsl: TLabel;
    spje: TLabel;
    sj: TLabel;
    bsph: TLabel;
    lb: TListBox;
    Grid1: TDBGrid;
    DataSource2: TDataSource;
    bzqlb: TListBox;
    tj: TBitBtn;
    bc: TBitBtn;
    qx: TBitBtn;
    tc: TBitBtn;
    Bevel1: TBevel;
    procedure FormCreate(Sender: TObject);
    procedure kgyKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure lbKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure lbDblClick(Sender: TObject);
    procedure lbExit(Sender: TObject);
    procedure bgKeyPress(Sender: TObject; var Key: Char);
    procedure bgSelectCell(Sender: TObject; ACol, ARow: Integer;
      var CanSelect: Boolean);
    procedure bgSetEditText(Sender: TObject; ACol, ARow: Integer;
      const Value: String);
    procedure Grid1DblClick(Sender: TObject);
    procedure Grid1Exit(Sender: TObject);
    procedure Grid1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure bgKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure bzqlbDblClick(Sender: TObject);
    procedure bzqlbKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure bzqlbExit(Sender: TObject);
    procedure bcClick(Sender: TObject);
    procedure qxClick(Sender: TObject);
    procedure tjClick(Sender: TObject);
    procedure bgDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect;
      State: TGridDrawState);
    procedure bgClick(Sender: TObject);
  private
    { Private declarations }
  public
    Procedure SelectTable;
    Procedure ClearCurrentRow;
    Procedure ClearEndRow;
    Function GroupSum: integer;
    Function GroupMoney: Real;
    Function GroupKinds: Integer;
    Function GridIsNull: Boolean;//判断表格是否为空
    Function CurrentIsNull: Boolean;
    Function CalculateCB(spdm: String):Real;//计算成本
    Procedure SetListPos(WinControl: TWinControl);
    { Public declarations }
  end;

var
  f_bscl: Tf_bscl;
  Row1: integer=1;
  Col1: integer =0;
  kc: Boolean= False;//在设置库存信息时,如果库存信息不存在会清空库存信息,使用该变量防止
  //清空库存信息时再次触发列表的OnSetEditText事件
implementation
  Uses DataModal;
{$R *.dfm}
Const
  kcmc = 0;
  kclb = 1;
  spdm =2;
  spmc = 3;
  cbj = 4;
  sl = 5;
  je = 6;
  bzq = 7;

procedure Tf_bscl.FormCreate(Sender: TObject);
begin
  sj.Caption := FormatDateTime('yyyy-mm-dd',Now);
  Row1 := 1;
  Col1 := 0;
end;

procedure Tf_bscl.SetListPos(WinControl: TWinControl);
begin
  lb.Top := WinControl.Top;
  lb.Left := WinControl.Left;
  lb.Visible := True;
  lb.SetFocus;
end;

procedure Tf_bscl.kgyKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Trim(bsph.Caption)='' then
  begin
    Application.MessageBox('请添加报损票号.','提示',64);
    Exit;
  end;
  if Key = vk_Next then
  begin
    SelectTable;
    SetListPos(kgy);
    lb.Visible := True;
    lb.SetFocus;
  end
  else if key = vk_Return then
  begin
    if Trim(kgy.Text)<>'' then
    begin
      with Data.Query1 do
      begin
        Close;
        SQL.Clear;
        SQL.Add('select ygmc from t_employee where (ygmc = :a or ygdm = :a)and bmmc = :b');
        ParamByName('a').AsString := Trim(kgy.Text);
        ParamByName('b').AsString := '库存部';
        Open;
      end;
      if Data.Query1.RecordCount>0 then
      begin
        kgy.Text := Trim(Data.Query1.Fields[0].AsString);
      end
      else
      begin
        Application.MessageBox('该员工不存在或没有职权.','提示',64);
        kgy.Clear;
        kgy.SetFocus;
      end;
    end;
    bg.SetFocus;
    bg.Col := kcmc;
  end;
end;

procedure Tf_bscl.SelecTTable;
begin
  with Data.Query1 do
  begin
    Close;
    SQL.Clear;
    SQL.Add('select ygmc from t_employee where bmmc = ''库存部''');
    Open;
  end;
  lb.Clear;
  while Not Data.Query1.Eof do
  begin
    lb.Items.Add(Data.Query1.Fields[0].Asstring);
    Data.Query1.Next;
  end;
  if lb.Items.Count>0 then
    lb.ItemIndex := 0;
end;

procedure Tf_bscl.lbKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = vk_Return then
  begin
    kgy.Text := lb.Items[lb.ItemIndex];
    kgy.SetFocus;
  end;
end;

procedure Tf_bscl.lbDblClick(Sender: TObject);
var
  Key: Word;
begin
  Key := vk_Return ;
  lb.OnKeyDown(sender,key,[ssleft]);
end;

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


procedure Tf_bscl.bgKeyPress(Sender: TObject; var Key: Char);
var
  i: Boolean;
begin
  if Col1 = sl then  //防止在数量单元格输入非法字符
  begin
    i := (Key<#8)or(Key>#8)and(Key<#48)or(Key>#57);
    if i then
      Key := #0;
  end;
end;

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

procedure Tf_bscl.bgSetEditText(Sender: TObject; ACol, ARow: Integer;
  const Value: String);
var
  Column1: TColumn;
  cellRect: TRect; //得到当前单元格的区域,用于定位表格
  ColNum: Integer;
begin
  if (Trim(kgy.Text)='')and(kc= False) then
  begin
    Application.MessageBox('请输入仓库管理员.','提示',64);
    kc := True;
    kgy.SetFocus;
    Exit;
  end;
  if (Trim(bg.Cells[cbj,row1])<>'')and(Trim(bg.Cells[sl,row1])<>'') then
    bg.Cells[je,Row1]:= Format('%8.4f',[StrToInt(bg.Cells[sl,Row1])*StrToFloat(bg.Cells[cbj,Row1])])
  else
    bg.Cells[je,Row1] := '';
  spzl.Caption := IntToStr(GroupKinds);
  spsl.Caption := IntToStr(GroupSum);
  spje.Caption := FloatToStr(GroupMoney);
  if (Col1 = kcmc)and(kc= False) then
  begin
    With Data.Query1 do
    begin
      Close;
      SQL.Clear;
      SQL.Add('select * from t_kcjcxx where kcdm like :a or kcmc like :a');
      ParamByName('a').AsString := Trim(bg.Cells[kcmc,Row1])+ '%';
      Open;
    end;
    if Data.Query1.RecordCount>0 then
    begin
      Grid1.Columns.Clear;
      Column1 := Grid1.Columns.Add;
      Column1.FieldName := 'kcdm';
      Column1.Title.Caption := '库存代码';
      Column1.Title.Alignment := taCenter;
      Column1.Title.Font.Color := clRed;
      Column1 := Grid1.Columns.Add;
      Column1.FieldName := 'kcmc';
      Column1.Title.Alignment := taCenter;
      Column1.Title.Font.Color := clRed;
      Column1.Title.Caption := '库存名称';
      Column1 := Grid1.Columns.Add;
      Column1.FieldName := 'kclb';
      Column1.Title.Alignment := taCenter;
      Column1.Title.Font.Color := clRed;
      Column1.Title.Caption := '库存类别';
      DataSource2.DataSet := Data.Query1;
      if Grid1.Visible = False then
      begin
        CellRect := bg.CellRect(Col1,Row1);
        CellRect.Left := CellRect.Left+bg.Left;
        CellRect.Right := CellRect.Right+ bg.Left;
        CellRect.Top := bg.Top+ CellRect.Top;
        Grid1.Left := CellRect.Right+1;
        Grid1.Top := CellRect.Top;
        Grid1.Visible := True;
      end;
      Grid1.Tag := 1;
    end
    else
    begin
      DataSource2.DataSet := Nil;
      Grid1.Visible := False;
      Application.MessageBox('该库存信息不存在.','提示',64);
      kc := True;
      bg.Cells[kcmc,Row1]:='';
      bg.Cells[kclb,Row1]:='';
      bg.Col := kcmc;
    end;
  end
  {todo 按商品代码查询商品信息}
  else if (Col1 = spdm)and(kc= false)and(Trim(bg.Cells[spmc,Row1])='') then
  begin
    With Data.Query1 do
    begin
      Close;
      SQL.Clear;
      SQL.Add('select distinct aa.* from t_spjcxx aa inner join t_sprkjl bb on aa.spdm = bb.spdm and (aa.spdm Like :a or aa.spmc like :a)and aa.spzl = :b');
      ParamByName('a').AsString := Trim(bg.Cells[spdm,Row1])+ '%';
      paramByName('b').AsString := Trim(bg.Cells[kclb,Row1]);
      Open;
    end;
    if Data.Query1.RecordCount>0 then
    begin
      Grid1.Columns.Clear;
      //在数据表格中需要显示2个字段
      For ColNum := 0 to 1 do
      begin
        Column1 := Grid1.Columns.Add;
        Column1.Title.Alignment := taCenter;
        Column1.Title.Font.Color := clRed;
        Case ColNum of
          0: begin
               Column1.FieldName := 'spdm';
               Column1.Title.Caption := '商品代码';
             end;
          1: begin
               Column1.FieldName := 'spmc';
               Column1.Title.Caption := '商品名称';
             end;
        end;
      end;
      DataSource2.DataSet := Data.Query1;
      if Grid1.Visible = False then
      begin
        CellRect := bg.CellRect(Col1,Row1);
        CellRect.Left := CellRect.Left+bg.Left;
        CellRect.Right := CellRect.Right+ bg.Left;
        CellRect.Top := bg.Top+ CellRect.Top;
        Grid1.Left := CellRect.Right+1;
        Grid1.Top := CellRect.Top;
        Grid1.Visible := True;
      end;
    end
    else
    begin
      Application.MessageBox('该商品不存在.','提示',64);
      kc := True;
      bg.Cells[spmc,Row1]:='';
      bg.Cells[spdm,Row1]:='';
      bg.Cells[cbj,Row1]:='';
    end;
    Grid1.Tag := 2;
  end
  { DONE : 按商品名称查找商品信息 }
  else if (Col1 = spmc)and(kc= false)and(Trim(bg.Cells[spdm,Row1])='') then
  begin
    With Data.Query1 do
    begin
      Close;
      SQL.Clear;
      SQL.Add('select distinct aa.* from t_spjcxx aa inner join t_sprkjl bb on aa.spdm = bb.spdm and (aa.spdm Like :a or aa.spmc like :a)and aa.spzl = :b');
      ParamByName('a').AsString := Trim(bg.Cells[spmc,Row1])+ '%';
      ParamByName('b').AsString := Trim(bg.Cells[kclb,Row1]);
      Open;
    end;
    if Data.Query1.RecordCount>0 then
    begin
      Grid1.Columns.Clear;
      //在数据表格中需要显示2个字段
      For ColNum := 0 to 1 do
      begin
        Column1 := Grid1.Columns.Add;
        Column1.Title.Alignment := taCenter;
        Column1.Title.Font.Color := clRed;
        Case ColNum of
          0: begin
               Column1.FieldName := 'spdm';
               Column1.Title.Caption := '商品代码';
             end;
          1: begin
               Column1.FieldName := 'spmc';
               Column1.Title.Caption := '商品名称';
             end;
        end;
      end;
      DataSource2.DataSet := Data.Query1;
      if Grid1.Visible = False then
      begin
        CellRect := bg.CellRect(Col1,Row1);
        CellRect.Left := CellRect.Left+bg.Left;
        CellRect.Right := CellRect.Right+ bg.Left;
        CellRect.Top := bg.Top+ CellRect.Top;
        Grid1.Left := CellRect.Right+1;
        Grid1.Top := CellRect.Top;
        Grid1.Visible := True;
      end;
    end
    else
    begin
      Application.MessageBox('该商品不存在.','提示',64);
      kc := True;
      bg.Cells[spmc,Row1]:='';
      bg.Cells[spdm,Row1]:='';
      bg.Cells[cbj,Row1]:='';
    end;
    Grid1.Tag := 2;
  end;
end;

function Tf_bscl.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_bscl.Grid1DblClick(Sender: TObject);
begin
 Case Grid1.Tag of
    1: begin
         bg.Cells[kcmc,Row1]:= Trim(Data.Query1.FieldByName('kcmc').AsString);
         bg.Cells[kclb,Row1]:= Trim(Data.Query1.FieldByName('kclb').AsString);
         bg.SetFocus;
         bg.Col := bg.Col+1;
       end;
    2: begin
         bg.Cells[spdm,Row1]:= Trim(Data.Query1.FieldByName('spdm').AsString);
         bg.Cells[spmc,Row1]:= Trim(Data.Query1.FieldByName('spmc').AsString);
         bg.Cells[cbj,Row1]:= Format('%8.4f',[CalculateCB(bg.Cells[spdm,Row1])]);
         bg.SetFocus;
         bg.Col := bg.Col+1;
       end;
  end;
  Grid1.Visible := False;
end;

procedure Tf_bscl.Grid1Exit(Sender: TObject);
begin
  Grid1.Visible := False;
end;

procedure Tf_bscl.Grid1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = vk_Return then
    Grid1.OnDblClick(Sender);
end;

procedure Tf_bscl.bgKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
  Rect1: TRect;
  col,row: integer;
begin
  kc:= False;
  if (Key = vk_shift)and(Grid1.Visible = True) then //显示网格
  begin
    Grid1.SetFocus;
    Exit;
  end;
  if Key = vk_Delete then //删除当前记录
  begin
    if Application.MessageBox('确实要删除当前记录吗?','提示',mb_YesNo)=ID_Yes then
    begin
      ClearCurrentRow;
      if bg.RowCount>2 then
      begin