pssqgl.~pas

一个比较实用的配送管理系统,Delphi+SQL开发

unit pssqgl;

interface

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

type
  TForm29 = class(TForm)
    Panel2: TPanel;
    StringGrid1: TStringGrid;
    Panel3: TPanel;
    BitBtn3: TBitBtn;
    BitBtn4: TBitBtn;
    BitBtn7: TBitBtn;
    BitBtn8: TBitBtn;
    Image1: TImage;
    Label4: TLabel;
    Label7: TLabel;
    Label2: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label1: TLabel;
    Shape2: TShape;
    Label8: TLabel;
    Shape1: TShape;
    Label3: TLabel;
    Edit4: TEdit;
    DBGrid1: TDBGrid;
    ListBox1: TListBox;
    Label9: TLabel;
    Shape3: TShape;
    Panel4: TPanel;
    Label10: TLabel;
    Label11: TLabel;
    Label12: TLabel;
    Label13: TLabel;
    Label16: TLabel;
    Label17: TLabel;
    Label18: TLabel;
    Edit8: TEdit;
    DataSource1: TDataSource;
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
    procedure StringGrid1KeyPress(Sender: TObject; var Key: Char);
    procedure StringGrid1SelectCell(Sender: TObject; ACol, ARow: Integer;
      var CanSelect: Boolean);
    Function  JCxmlb : Boolean;//检查项目列表是否有误
    procedure Clear;//窗体初始化
    Procedure SelectSPXX;
    Function IsNull: Boolean;
    Procedure ClearString;
    Function CurrentIsCF: Boolean;
    Procedure ClearStringEnd;
    Function SumPrice:Real;
    Function AfterIsNull: Boolean;
    Function EndIsNull: Boolean;
    Function FirstIsNull: Boolean;
    Function SumSL: Integer;
    Function Kinds: Integer;
    procedure BitBtn7Click(Sender: TObject);
    procedure BitBtn4Click(Sender: TObject);
    procedure StringGrid1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Edit8KeyPress(Sender: TObject; var Key: Char);
    procedure BitBtn3MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure BitBtn3MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Edit8Exit(Sender: TObject);
    procedure Edit8KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure StringGrid1SetEditText(Sender: TObject; ACol, ARow: Integer;
      const Value: String);
    procedure DBGrid1DblClick(Sender: TObject);
    procedure DBGrid1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure ComboBox2KeyPress(Sender: TObject; var Key: Char);
    procedure Edit4KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure ListBox1DblClick(Sender: TObject);
    procedure ListBox1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure CloseForm(  Key: Word);
    procedure BitBtn3KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form29: TForm29;
  x,y: Integer;
  Ss:Boolean = False ;//判断当焦点在StringGrid1上时是否按回车键
  s1: Boolean = False;//在StringGrid1的OnSetEditText事件中是否执行相关代码，其作用是防止连续出现对话框

implementation
  uses Data1, sppssq,khxx6;
{$R *.dfm}

procedure TForm29.FormCreate(Sender: TObject);
begin
  StringGrid1.Cells[0,0]:='      商品编号';
  StringGrid1.Cells[1,0]:='      商品名称';
  StringGrid1.Cells[2,0]:='     数量';
  StringGrid1.Cells[3,0]:='     金额';
  StringGrid1.Cells[4,0]:='   折扣';
  StringGrid1.Cells[5,0]:='       客户编号';
  StringGrid1.Cells[6,0]:='     客户全称';
  StringGrid1.Cells[7,0]:='       配送票号';
  StringGrid1.Cells[8,0]:='     配送日期';
end;

procedure TForm29.FormShow(Sender: TObject);
begin
  Clear;
  Label9.Caption := czymc;
  ListBox1.Clear;
  begin
    with DataModule1.ADOQuery1 do
    begin
      Close;
      SQL.Clear;
      SQL.Add('select distinct 客户全称 from 客户基础信息表');
      Open;
    end;
    while not DataModule1.ADOQuery1.Eof do
    begin
      ListBox1.Items.Add(DataModule1.ADOQuery1.FieldByName('客户全称').AsString);
      DataModule1.ADOQuery1.Next;
    end;
  end;
  BitBtn3.SetFocus;
end;

procedure TForm29.BitBtn3Click(Sender: TObject);
var
  s,m: String;
  i: Integer;
begin
  label3.Caption := FormatDateTime('yyyy-mm-dd',Now());
  s:= 'PH'+ FormatDateTime('yyyymmdd',Now());
  With DataModule1.ADOQuery1 do
  begin
    Close;
    SQL.Clear;
    SQL.Add('select max(配送票号) as ss From 配送票号表 ');
    Open;
  end;
  If DataModule1.ADOQuery1.FieldByName('ss').Value = null then
    s := s + '001'
  else
  begin
    m:= Trim(DataModule1.ADOQuery1.FieldByName('ss').Value) ;
    i:= StrToInt(Trim(Copy(m,11,5))) ;
    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;
  Label8.Caption := s;
  Edit4.SetFocus;
end;

procedure TForm29.StringGrid1KeyPress(Sender: TObject; var Key: Char);
var
  mm: Boolean;
begin
  if y = 2 then
  begin
    mm := (Key <#8)or(Key >#8)and(Key<#48)or(Key>#57);
    if mm then
      Key := #0;
  end; 
end;
procedure TForm29.StringGrid1SelectCell(Sender: TObject; ACol,
  ARow: Integer; var CanSelect: Boolean);
begin
  y := ACol;
  x := ARow;
  if (ACol = 1)and( Trim(StringGrid1.Cells[0,x])='')or(ACol = 2)and(Trim(StringGrid1.Cells[0,x])<>'') then
    StringGrid1.Options := StringGrid1.Options +[goEditing]
  else
    StringGrid1.Options := StringGrid1.Options -[goEditing];
end;

function TForm29.JCxmlb: Boolean;
var
  a,b: integer;
begin
  JCxmlb := True;
  for a := 1 to StringGrid1.RowCount-1 do
    For b := 0 to StringGrid1.ColCount-1 do
      if StringGrid1.Cells[b,a]='' then
      begin
         Jcxmlb := False;
         break;
      end;
end;

procedure TForm29.Clear;
var
  r,c: integer;
begin
  Label8.Caption := '';
  Label3.Caption := '';
  Edit8.Text := '1.0';
  Label16.Caption := '0';
  Label17.Caption := '0';
  Label18.Caption := '0.0';
  Edit4.Clear;
  For r := 1 to StringGrid1.RowCount-1 do
    For c := 0 to StringGrid1.ColCount-1 do
      StringGrid1.Cells[c,r]:='';
  StringGrid1.RowCount  :=2;

end;

procedure TForm29.BitBtn7Click(Sender: TObject);
begin
  Clear;
  BitBtn3.SetFocus;
end;

procedure TForm29.BitBtn4Click(Sender: TObject);
var
  i: Integer;
begin
  if Jcxmlb = False then
  begin
    Application.MessageBox('项目列表有误。','提示',0+64);
    Exit;
  end;
  DataModule1.ADOConnection1.BeginTrans;
  try
  with DataModule1.ADOQuery1 do
  begin
    Close;
    SQL.Clear;
    SQL.Add('Insert 配送票号表 values (:a,:aa,:b,:c,Default,:d,'''',Default,Default,'''')');
    Parameters.ParamByName('a').Value := Trim(StringGrid1.Cells[7,1]);
    Parameters.ParamByName('aa').Value := StrToInt(Label16.Caption);
    Parameters.ParamByName('b').Value := StrToInt(Label17.Caption);
    Parameters.ParamByName('c').Value := StrToFloat(Label18.Caption);
    Parameters.ParamByName('d').Value := Trim(Label9.Caption);
    ExecSQL;
  end;
  For i := 1 to StringGrid1.RowCount-1 do
  begin
    with DataModule1.ADOQuery1 do
    begin
      Close;
      SQL.Clear;
      SQL.Add('Insert 配送申请表 Values(:a,:b,:c,:d,:e,:f,:g,:h)');
      Parameters.ParamByName('a').Value := Trim(StringGrid1.Cells[0,i]);
      Parameters.ParamByName('b').Value := Trim(StringGrid1.Cells[1,i]);
      Parameters.ParamByName('c').Value := Trim(StringGrid1.Cells[5,i]);
      Parameters.ParamByName('d').Value := Trim(StringGrid1.Cells[6,i]);
      Parameters.ParamByName('e').Value := StrToInt(StringGrid1.Cells[2,i]);
      Parameters.ParamByName('f').Value := StrToFloat(StringGrid1.Cells[3,i]);
      Parameters.ParamByName('g').Value := StrToFloat(StringGrid1.Cells[4,i]);
      Parameters.ParamByName('h').Value := Trim(StringGrid1.Cells[7,1]);
      ExecSQL;
    end;
  end;
  DataModule1.ADOConnection1.CommitTrans;
  Application.MessageBox('保存成功。','提示',0+64);
  Clear;
  BitBtn3.SetFocus;
  Except
    DataModule1.ADOConnection1.RollbackTrans;
    Application.MessageBox('系统出错。','提示',0+64);
    Close;
  end;
end;

procedure TForm29.StringGrid1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);

var
  R,L: Integer;
  cp: String;// 记录当前行的价格
  cl: String;// 记录当前行的数量
begin
  CloseForm(Key);
  S1 := False;
  ss := False;
  cp := '';
  cl:= '';
  if key = VK_Delete then
  begin
    if StringGrid1.RowCount>2 then
    begin
      If Application.MessageBox('确实要删除该条记录吗？','提示',MB_YESNO )= ID_Yes then
      begin
        if IsNull = False then
        begin
          cl := StringGrid1.Cells[2,x];
          cp := StringGrid1.Cells[3,x];
          if CurrentIsCf = False then
            Label16.Caption := IntToStr(StrToInt(Label16.Caption)-1);
        end;
        ClearString;
        if x <> StringGrid1.RowCount-1 then
        begin
          For r := x+1 to StringGrid1.RowCount-1 do
            For l := 0 to StringGrid1.ColCount-1 do
              StringGrid1.Cells[l,r-1]:= StringGrid1.Cells[l,r];
        end;
        ClearStringEnd;
        StringGrid1.RowCount := StringGrid1.RowCount-1;
        if Trim(cl)<>'' then
          Label17.Caption := IntToStr(StrToInt(Label17.Caption)- StrToInt(cl));
        if Trim(cp)<>'' then
          Label18.Caption := FloatToStr(StrToFloat(Label18.Caption)-StrToFloat(cp));
        StringGrid1.SetFocus;
        StringGrid1.Col := 2;
        StringGrid1.Col := 1;
        Exit;
      end;
    end
    else if  StringGrid1.RowCount = 2 then
    begin
      If Application.MessageBox('确实要删除该条记录吗？','提示',MB_YESNO )= ID_Yes then
      begin
        ClearString;
        Label16.Caption := '0';
        Label17.Caption :='0';
        Label18.Caption := '0.0';
        StringGrid1.SetFocus;
        StringGrid1.Col := 2;
        StringGrid1.Col := 1;
      end;
    end;
  end;
  if (key = Vk_Next)and(DBGrid1.Visible = True)then
  begin
    DBGrid1.SetFocus;
    Exit;
  end;
  if (Key = VK_Down)and(IsNull = False)and(x = StringGrid1.RowCount-1) then
  begin
    StringGrid1.RowCount := StringGrid1.RowCount+1;
    StringGrid1.Cells[5,StringGrid1.RowCount-1]:= StringGrid1.Cells[5,StringGrid1.RowCount-2];
    StringGrid1.Cells[6,StringGrid1.RowCount-1]:= StringGrid1.Cells[6,StringGrid1.RowCount-2];
    StringGrid1.Cells[4,StringGrid1.RowCount-1]:= '1.0';
    StringGrid1.Cells[7,StringGrid1.RowCount-1]:= StringGrid1.Cells[7,StringGrid1.RowCount-2];
    StringGrid1.Cells[8,StringGrid1.RowCount-1]:= StringGrid1.Cells[8,StringGrid1.RowCount-2];
    StringGrid1.Col := 1;
    Exit;
  end;
  if key = vk_ReTurn then
    if (Trim(StringGrid1.Cells[0,x])='')and(Trim(StringGrid1.Cells[1,x])<>'') then
    begin
      Ss := True;
      DataSource1.DataSet := nil;
      DBGrid1.Visible := False;
      SelectSPXX;
      if DataModule1.ADOQuery1.RecordCount>1 then
      begin
        DataSource1.DataSet := DataModule1.ADOQuery1;
        DBGrid1.Visible := True;
        DBGrid1.SetFocus;
      end
      else if DataModule1.ADOQuery1.RecordCount = 1  then
      begin
        StringGrid1.Cells[0,x]:= DataModule1.ADOQuery1.FieldByName('商品编号').Value;
        StringGrid1.Cells[1,x]:= DataModule1.ADOQuery1.FieldByName('商品名称').Value;
        StringGrid1.SetFocus;
        StringGrid1.Col := 2;
      end
      else
      begin
        Application.MessageBox('该商品不存在。','提示',64);
        ClearString;
        if StringGrid1.RowCount>2 then
          StringGrid1.RowCount := StringGrid1.RowCount-1;
      end;
    end;
    if (Key = VK_Shift)and(JCxmlb = True) then
      BitBtn4.SetFocus;
end;


procedure TForm29.Edit8KeyPress(Sender: TObject; var Key: Char);
var
  a: Boolean;
begin
  a := (Key <#8)or(Key >#8)and(Key<#46)or(Key>#46)and(Key<#48)or(Key>#57);
  if a then