⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 cgth.~pas

📁 这是用Delphi编写的中小企业管理系统
💻 ~PAS
📖 第 1 页 / 共 3 页
字号:
unit cgth;

interface

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

type
  Tf_cgth = class(TForm)
    Label11: TLabel;
    Shape1: TShape;
    Label2: TLabel;
    cgph: TEdit;
    Label1: TLabel;
    cs: TEdit;
    Label6: TLabel;
    cgy: TEdit;
    Label3: TLabel;
    sj: TDateTimePicker;
    bg: TStringGrid;
    Grid1: TDBGrid;
    lb: TListBox;
    DataSource1: TDataSource;
    Panel2: TPanel;
    Label7: TLabel;
    Label9: TLabel;
    thxj: TEdit;
    thzr: TEdit;
    bzqlb: TListBox;
    tj: TBitBtn;
    bc: TBitBtn;
    qx: TBitBtn;
    BitBtn4: TBitBtn;
    tc: TBitBtn;
    Rprinter: TRvSystem;
    procedure csKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure cgyExit(Sender: TObject);
    procedure lbKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure lbDblClick(Sender: TObject);
    procedure FormShow(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 Grid1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Grid1Exit(Sender: TObject);
    procedure bgKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure bzqlbDblClick(Sender: TObject);
    procedure bzqlbKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure csExit(Sender: TObject);
    procedure thzrChange(Sender: TObject);
    procedure thzrKeyPress(Sender: TObject; var Key: Char);
    procedure thzrEnter(Sender: TObject);
    procedure bzqlbExit(Sender: TObject);
    procedure tjClick(Sender: TObject);
    procedure bcClick(Sender: TObject);
    procedure qxClick(Sender: TObject);
    procedure tcClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure BitBtn4Click(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 GroupPrice: real;//统计金额
    Function GroupSum(ckmc,spbh,bzq1:String): Integer;//统计表格中同商品同库存同保质期的商品数量,
    //在退货时防止该商品的数量大于库存数量
    Function GridIsNull: Boolean;//判断表格是否为空
    Function CalculateCB(spdm: String):Real;//计算成本
    Procedure SetListPos(WinControl: TWinControl);
    Procedure SelectTable(TableName: String);overload;
    Procedure SelectTable(TableName,FieldName: String;FieldValue: Variant);Overload;//参数FieldName为查询条件
    { Public declarations }
  end;

var
  f_cgth: Tf_cgth;
  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..9]of String=('仓库名称','仓库类别','商品代码','商品名称','基本单位','成本价','数量','折扣','金额','保质期');
  AZdkd : Array[0..9]of Real=(1,1,1,1,1,1,1,1,1,1); //数组中的元素对应表格中相应字段的宽度
  zds : integer = 10;//表格字段数
  Cols: integer = 6;//每行列数
implementation
  uses DataModal;
{$R *.dfm}
Const
  kcmc = 0;
  kclb = 1;
  spdm =2;
  spmc =3;
  jbdw =4;
  cbj = 5;
  sl =6;
  zk = 7;
  je = 8;
  bzq = 9;
procedure Tf_cgth.csKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Trim(cgph.Text)='' then
  begin
    Application.MessageBox('请添加退货票号.','提示',64);
    Exit;
  end;
  if (Key = vk_Next)and(Sender is TEdit) then
  begin
    if TEdit(Sender).Name = 'cs' then
    begin
      SelectTable('t_cszl');
      lb.Tag := 1;
      SetListPos(cs);
      lb.SetFocus;
      lb.ItemIndex := 0;
    end
    else if TEdit(Sender).Name = 'cgy' then
    begin
      SelectTable('t_employee','bmmc','库存部');
      lb.Tag := 2;
      SetListPos(cgy);
      lb.SetFocus;
      lb.ItemIndex := 0;
    end;
  end
  else if Key = vk_Return  then
  begin
    if Sender is TEdit then
    begin
      if TEdit(Sender).Name = 'cs' then
      begin
        With Data.Query1 do
        begin
          Close;
          SQL.Clear;
          SQL.Add('select * from t_cszl where csdm = :a or csmc = :a');
          ParamByName('a').AsString := Trim(cs.Text);
          Open;
        end;
        if Data.Query1.RecordCount>0 then
          cs.Text := Data.Query1.Fields[1].AsString
        else
        begin
          Application.MessageBox('该厂商不存在.','提示',64);
          cs.Clear;
          cs.SetFocus;
          Exit;
        end;
      end
      else if TEdit(Sender).Name = 'cgy' 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(cgy.Text);
          ParamByName('b').AsString := '库存部';
          Open;
        end;
        if Data.Query1.RecordCount>0 then
          cgy.Text := Data.Query1.Fields[1].AsString
        else
        begin
          Application.MessageBox('该退货人不存在.','提示',64);
          cgy.Clear;
          cgy.SetFocus;
          Exit;
        end;
      end;
    end;
    FindNext;
  end;
end;

procedure Tf_cgth.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_cgth.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_cgth.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;

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

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

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

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

procedure Tf_cgth.FormShow(Sender: TObject);
begin
  sj.Date := Now;
  Row := 1;
  Col := 0;
end;

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

procedure Tf_cgth.bgKeyPress(Sender: TObject; var Key: Char);
var
  i: Boolean;
begin
  if Col = sl then  //防止在数量单元格输入非法字符
  begin
    i := (Key<#8)or(Key>#8)and(Key<#48)or(Key>#57);
    if i then
      Key := #0;
  end
  else if Col = zk then
  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;
end;
procedure Tf_cgth.bgSelectCell(Sender: TObject; ACol, ARow: Integer;
  var CanSelect: Boolean);
begin
  Row := ARow;
  Col:= ACol;
  if (Col = 0)and(Trim(bg.Cells[spdm,Row])='')or(Col = spdm)and
    (Trim(bg.Cells[spmc,Row])='')and(Trim(bg.Cells[kcmc,Row])<>'')
   or(Col=spmc)and(Trim(bg.Cells[spdm,Row])='')and(Trim(bg.Cells[kcmc,Row])<>'')
   or(Col = sl)and(Trim(bg.Cells[spdm,Row])<>'')or(Col=zk)and(Trim(bg.Cells[spdm,Row])<>'')then
     bg.Options := bg.Options +[goEditing]
  else
    bg.Options := bg.Options -[goEditing];
end;

procedure Tf_cgth.bgSetEditText(Sender: TObject; ACol, ARow: Integer;
  const Value: String);
var
  Column1: TColumn;
  cellRect: TRect; //得到当前单元格的区域,用于定位表格
  ColNum: Integer;
begin
  if (Trim(cs.Text)='')and(kc = False) then
  begin
    Application.MessageBox('请输入厂商信息.','提示',64);
    kc := True;
    cs.SetFocus;
    Exit;
  end;
  if (Trim(cgy.Text)='')and(kc = False) then
  begin
    Application.MessageBox('请输入退货人.','提示',64);
    kc := True;
    cgy.SetFocus;
    Exit;
  end;
  if Trim(bg.Cells[kcmc,row])<>'' then
  begin
    cs.Enabled := False;
  end;
  if Trim(bg.Cells[jbdw,Row])<>'' then //基本单位不为空即表示商品代码,商品名称不为空,
  begin
    if (Trim(bg.Cells[sl,Row])<>'')and(Trim(bg.Cells[cbj,Row])<>'')and(Trim(bg.Cells[zk,Row])<>'') then //数量,单价,折扣不为空
    begin
      if StrToFloat(bg.Cells[zk,Row])>1 then
      begin
        Application.MessageBox('折扣不能大于一.','提示',64);
        bg.Cells[zk,Row] := '1.0';
      end;
      bg.Cells[je,Row]:= Format('%8.4f',[StrToInt(bg.Cells[sl,Row])*StrToFloat(bg.Cells[cbj,row])*StrToFloat(bg.Cells[zk,Row])]);
      thxj.Text := Format('%8.4f',[GroupPrice-StrToFloat(thzr.Text)]);
    end
    else
    begin
      kc := True;
      bg.Cells[je,Row]:='';
      if (Trim(bg.Cells[sl,Row])='')then
        bg.Cells[je,Row]:= '';
    end;

  end
  else if (Col = 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,Row])+ '%';
      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 := '库存类别';
      DataSource1.DataSet := Data.Query1;
      if Grid1.Visible = False then
      begin
        CellRect := bg.CellRect(Col,Row);
        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
      DataSource1.DataSet := Nil;
      Grid1.Visible := False;
      Application.MessageBox('该库存信息不存在.','提示',64);
      kc := True;
      bg.Cells[kcmc,Row]:='';
      bg.Col := kcmc;
    end;
  end
  {todo: 按商品代码查询商品信息}
  else if (Col = spdm)and(kc= false)and(Trim(bg.Cells[spmc,Row])='') 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 like :a and kcmc = :b)');
      ParamByName('a').AsString := Trim(bg.Cells[spdm,Row])+'%';
      ParamByName('b').AsString := Trim(bg.Cells[kcmc,Row]);
      Open;
    end;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -