umaterieldecompose.pas

进销存以及BOM管理,SQl Server数据库程序

unit uMaterielDecompose;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, MDIBase, ComCtrls, ToolWin, ActnList, ExtCtrls, DB,
  wwDialog,
  wwidlg, StdCtrls, Grids, Wwdbigrd, Wwdbgrid, fcTreeView, Buttons,
  wwdblook, ImgList, ADODB;

type
  TProduct = Record
    ParentID:Integer;   //父ID
    PartID:Integer;     //子ID
    Name:String;        //名称
    Qty:Double;         //使用数量
  end;

  TfrmMaterielDecompose = class(TfrmMDIBase)
    ALToolbar: TActionList;
    acOpen: TAction;
    acSave: TAction;
    acCancel: TAction;
    acPrint: TAction;
    acExit: TAction;
    acAddLine: TAction;
    acDelLine: TAction;
    acIsExists: TAction;
    acFullExpand: TAction;
    acFullCollapse: TAction;
    ToolBar: TToolBar;
    tbtOpen: TToolButton;
    tbtDivider1: TToolButton;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    tbtSave: TToolButton;
    tbtCancel: TToolButton;
    tbtDivider3: TToolButton;
    tbtExit: TToolButton;
    Panel1: TPanel;
    Panel2: TPanel;
    Splitter1: TSplitter;
    Panel3: TPanel;
    QProduceOrder: TADOQuery;
    dsProduceOrder: TDataSource;
    wwLookupDlgBomParent: TwwLookupDialog;
    QProduct: TADOQuery;
    Label1: TLabel;
    Label2: TLabel;
    Label23: TLabel;
    Label24: TLabel;
    edtProductCode: TEdit;
    edtProductName: TEdit;
    edtProductSpec: TEdit;
    edtProductColor: TEdit;
    Label3: TLabel;
    edtProductUnit: TEdit;
    Label4: TLabel;
    edtNO: TEdit;
    Label5: TLabel;
    edtDate: TEdit;
    Label6: TLabel;
    edtQty: TEdit;
    spBOM: TADOStoredProc;
    spBOMPID: TIntegerField;
    spBOMAID: TIntegerField;
    spBOMAQty: TBCDField;
    spBOMBID: TIntegerField;
    spBOMBQty: TBCDField;
    spBOMCID: TIntegerField;
    spBOMCQty: TBCDField;
    spBOMDID: TIntegerField;
    spBOMDQty: TBCDField;
    spBOMEID: TIntegerField;
    spBOMEQty: TBCDField;
    spBOMFID: TIntegerField;
    spBOMFQty: TBCDField;
    spBOMGID: TIntegerField;
    spBOMGQty: TBCDField;
    spBOMHID: TIntegerField;
    spBOMHQty: TBCDField;
    spBOMPName: TStringField;
    spBOMAName: TStringField;
    spBOMBName: TStringField;
    spBOMCName: TStringField;
    spBOMDName: TStringField;
    spBOMEName: TStringField;
    spBOMFName: TStringField;
    spBOMGName: TStringField;
    spBOMHName: TStringField;
    dsTV: TDataSource;
    QProducts: TADOQuery;
    tvBom: TfcTreeView;
    wwDBGrid1: TwwDBGrid;
    Panel4: TPanel;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    ToolButton5: TToolButton;
    acBatchInsert: TAction;
    dsMateriel: TDataSource;
    QMateriel: TADOQuery;
    lblSubmit: TLabel;
    ToolButtonImages: TImageList;
    QProduceOrderfid: TAutoIncField;
    QProduceOrderfcode: TWideStringField;
    QProduceOrderfname: TWideStringField;
    QProduceOrderfdesc: TWideStringField;
    QProduceOrderfdate_finish: TDateTimeField;
    QProduceOrderfitemid: TIntegerField;
    QProduceOrderfitemcode: TWideStringField;
    QProduceOrderfitemname: TWideStringField;
    QProduceOrderfitemdesc: TWideStringField;
    QProduceOrderfitemcolor: TWideStringField;
    QProduceOrderfitemunit: TWideStringField;
    QProduceOrderfqty: TBCDField;
    QProduceOrderfisbproduce: TBooleanField;
    QProduceOrderfisbdate: TDateTimeField;
    QProduceOrderfismcontrol: TWideStringField;
    QProduceOrderfisfinish: TBooleanField;
    QProduceOrderfisfdate: TDateTimeField;
    QProduceOrderfispcontrol: TWideStringField;
    QProduceOrderfbill_user: TWideStringField;
    QProduceOrderfbill_date: TDateTimeField;
    QProductfid: TAutoIncField;
    QProductfcode: TWideStringField;
    QProductfname: TWideStringField;
    QProductfdesc: TWideStringField;
    QProductftype: TWideStringField;
    QProductfcolor: TWideStringField;
    QProductflevel: TWideStringField;
    QProductfunit: TWideStringField;
    QMaterielfid: TAutoIncField;
    QMaterielfProductID: TIntegerField;
    QMaterielfQty: TBCDField;
    QMaterielfTakeQty: TBCDField;
    QMaterielccode: TStringField;
    QMaterielcname: TStringField;
    QMaterielcunit: TStringField;
    QMaterielcdesc: TStringField;
    wwDBLKProductCode: TwwDBLookupCombo;
    procedure acOpenExecute(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure acExitExecute(Sender: TObject);
    procedure tvBomToggleCheckbox(TreeView: TfcCustomTreeView;
      Node: TfcTreeNode);
    procedure acFullExpandExecute(Sender: TObject);
    procedure acFullCollapseExecute(Sender: TObject);
    procedure tvBomChange(TreeView: TfcCustomTreeView; Node: TfcTreeNode);
    procedure acBatchInsertExecute(Sender: TObject);
    procedure acSaveExecute(Sender: TObject);
    procedure acCancelExecute(Sender: TObject);
    procedure acDelLineExecute(Sender: TObject);
    procedure QMaterielBeforePost(DataSet: TDataSet);
    procedure dsMaterielStateChange(Sender: TObject);
    procedure QMaterielAfterInsert(DataSet: TDataSet);
    procedure acAddLineExecute(Sender: TObject);
  private
    OrderID:Integer;
    OrderQty:Double;
    bModify :Boolean;
    ProductArray: Array[1..8] of ^TProduct;
    //得到当前记录的产品数组
    function GetArray:Integer;
    //查找节点
    function  TreeFindItem(NodeItem: TfcTreeNode; Name: String): TfcTreeNode;
    //增加节点
    function  TreeAddItem(eCount: Integer; bCheck: Boolean): TfcTreeNode;
    procedure SetAction();
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmMaterielDecompose: TfrmMaterielDecompose;

implementation

uses Data, Global;

{$R *.dfm}

procedure TfrmMaterielDecompose.SetAction();
begin
With QProduceOrder do
begin
    acSave.Enabled :=bModify and (not FieldByName('fisfinish').AsBoolean);
    acCancel.Enabled :=acSave.Enabled;
    acAddLine.Enabled :=Not acSave.Enabled;
    acDelLine.Enabled :=Not acSave.Enabled;
    acBatchInsert.Enabled :=Not acSave.Enabled;

    wwDBGrid1.ReadOnly :=not acSave.Enabled;
end;
end;

function TfrmMaterielDecompose.GetArray:Integer;
var
iCount:Integer;
CharArray: Array[0..8] of char;
ParentQty:Double;
begin
 iCount:=0;
 CharArray:='PABCDEFGH';
 if Not VarisNull(spBOM.FieldValues['pID']) then
    begin
    iCount:=iCount+1;
    new(ProductArray[iCount]);
    ProductArray[iCount]^.ParentID := 0;
    ProductArray[iCount]^.PartID := spBOM.fieldbyname('pID').asInteger;
    ProductArray[iCount]^.Name := spBOM.fieldbyname('pName').asString;
    ProductArray[iCount]^.Qty := 1;

    ParentQty:=ProductArray[iCount]^.Qty;

    While Not VarisNull(spBOM.FieldValues[CharArray[iCount]+'ID']) do
          begin
          iCount:=iCount+1;
          new(ProductArray[iCount]);
          ProductArray[iCount]^.ParentID := spBOM.fieldbyname(CharArray[iCount-2]+'ID').asInteger;
          ProductArray[iCount]^.PartID := spBOM.fieldbyname(CharArray[iCount-1]+'ID').asInteger;
          ProductArray[iCount]^.Name := spBOM.fieldbyname(CharArray[iCount-1]+'Name').asString;
          ProductArray[iCount]^.Qty := spBOM.fieldbyname(CharArray[iCount-1]+'Qty').asFloat*ParentQty;
          ParentQty:=ProductArray[iCount]^.Qty;
          end;
    end;

  Result := iCount;
end;

function TfrmMaterielDecompose.TreeFindItem(NodeItem: TfcTreeNode; Name: String): TfcTreeNode;
begin
//得到子节点
if NodeItem = nil then
  NodeItem := tvBOM.Items.GetFirstNode
  else
  NodeItem := NodeItem.GetFirstChild;

//判断是否是要找的节点，否则继续找下一个同级节点，直到找到或找完为止
if (NodeItem <> nil) and (NodeItem.text <> Name) then
   repeat
   NodeItem := NodeItem.GetNextSibling;
   until (NodeItem = nil) or (NodeItem.text = Name);

Result := NodeItem;
end;

function TfrmMaterielDecompose.TreeAddItem(eCount: Integer; bCheck: Boolean): TfcTreeNode;
var
   ThisNode, Node: TfcTreeNode;
   I: Integer;
begin
     Node := nil;
     //历遍当前数组
     for I := 1 to eCount do
     begin
          ThisNode := TreeFindItem(node, ProductArray[i]^.Name);
          if ThisNode <> nil then
          Node := ThisNode  //如果找到，继续找下一个字符串的节点
          else
          begin
            if I = 1 then //根节点
            Node := tvBOM.items.AddObject(Node, ProductArray[i]^.Name, ProductArray[i])
            else          //子节点
            begin
            Node := tvBOM.items.AddChildObject(Node, ProductArray[i]^.Name, ProductArray[i]);
            if bCheck then Node.CheckboxType:=tvctCheckbox;
            if I=eCount then Node.Checked:=True;
            end;
          end;
     end;
     Result := Node;
end;

procedure TfrmMaterielDecompose.acOpenExecute(Sender: TObject);
begin
  inherited;
if wwLookupDlgBomParent.Execute then
   begin
   with QProduceOrder do
     begin
     edtNO.Text:=FieldbyName('fname').asString;
     edtDate.Text:=FieldbyName('fDate_finish').asString;
     edtQty.Text:=FieldbyName('fQty').asString;
     edtProductCode.Text:=FieldbyName('fitemcode').asString;
     edtProductName.Text:=FieldbyName('fitemname').asString;
     edtProductSpec.text:=FieldbyName('fitemdesc').asString;
     edtProductColor.text:=FieldbyName('fitemcolor').asString;
     edtProductUnit.text:=FieldbyName('fitemunit').asString;
     OrderID:=FieldByName('fID').asInteger;
     OrderQty:=FieldByName('fQty').asFloat;
   end;
   
   SetAction();

   With spBom do
      begin
      parameters.ParamValues['@intProdID']:=QProduceOrder.FieldByName('fitemID').asInteger;
      if Active then Requery else Open;
      //写树
      tvBom.items.BeginUpdate;
      tvBom.Items.Clear ;
      while not spBOM.eof do
      begin
          TreeAddItem(GetArray,True);
          spBOM.next;
      end;
      tvBom.Alphasort;
      tvBom.items.Endupdate;

      tvBom.FullExpand ;
      end;

   With QMateriel do
      begin
      parameters.ParamValues['fID']:=OrderID;
      if Active then Requery else Open;
      end;
   end;
end;

procedure TfrmMaterielDecompose.FormCreate(Sender: TObject);
begin
  inherited;
if Not QProduceOrder.Active then QProduceOrder.Open ;
end;

procedure TfrmMaterielDecompose.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  inherited;
frmMaterielDecompose:=nil;
end;

procedure TfrmMaterielDecompose.acExitExecute(Sender: TObject);
begin
  inherited;
Close;
end;

//如果父选择节点，则子节点被禁止Check
procedure TfrmMaterielDecompose.tvBomToggleCheckbox(
  TreeView: TfcCustomTreeView; Node: TfcTreeNode);
var
OldNode,ChildNode: TfcTreeNode;
begin
   ChildNode:=Node.GetFirstChild ;

   if ChildNode<>Nil then
      Repeat
      if Node.Checked then
         ChildNode.CheckboxType := tvctNone
         else
         ChildNode.CheckboxType := tvctCheckBox;
      //保存当前节点
      OldNode:=ChildNode;
      //取当前节点的子节点
      ChildNode:=ChildNode.GetFirstChild ;
      //如果无子节点，则去当前节点的下一个同级节点
      if ChildNode=Nil then
         begin
         ChildNode:=OldNode.GetNextSibling ;
         {如果也无同级节点，则返回上一级，取上一级的下一个节点，
         直到取到或到达顶端为止，否则一直往上一级递归}
         While (ChildNode=Nil)  and (OldNode.Level > Node.Level) do
              begin
              ChildNode:=OldNode.Parent.GetNextSibling;
              OldNode:=OldNode.Parent ;
              end
         end;
      Until (ChildNode=Nil) or (ChildNode.Level = Node.Level);
end;

procedure TfrmMaterielDecompose.acFullExpandExecute(Sender: TObject);
begin
  inherited;
tvBOM.FullExpand ;
end;

procedure TfrmMaterielDecompose.acFullCollapseExecute(Sender: TObject);
begin
  inherited;
tvBOM.FullCollapse ;
end;

procedure TfrmMaterielDecompose.tvBomChange(TreeView: TfcCustomTreeView;
  Node: TfcTreeNode);
var
  pProduct: ^TProduct;
begin
  inherited;
pProduct:=Node.Data;
QMateriel.Locate('fProductID',pProduct^.PartID,[]);
//ShowMessage(inttostr(pProduct^.ParentID)+','+inttostr(pProduct^.PartID)+','+pProduct^.Name+','+FloattoStr(pProduct^.Qty));
end;

procedure TfrmMaterielDecompose.acBatchInsertExecute(Sender: TObject);
var
  Node:TfcTreeNode;
  pProduct: ^TProduct;
begin
  inherited;
if tvBOM.Items.Count < 1 then Exit;

if QMateriel.RecordCount >0 then
   begin
   if Messagedlg('确定要重新生成物料表吗？这样将清除原先的数据！',mtWarning,[mbOK,mbCancel],0)=mrOk then
      begin
      QMateriel.First ;
      While Not QMateriel.Eof do QMateriel.delete;
      end
      else
      Exit;
   end;

Node:=tvBOM.Items.GetFirstNode;
Node:=Node.GetFirstChild ;
While Node<>Nil do
    begin
    if Node.Checked and (Node.CheckboxType = tvctCheckBox) then
       begin
       pProduct:=Node.Data ;
       if Not QMateriel.Locate('fProductID',pProduct^.PartID,[]) then
          begin
           QMateriel.Append ;
           //QMateriel.FieldByName('fID').asInteger:= OrderID;
           QMateriel.FieldByName('fProductID').AsInteger :=pProduct^.PartID ;
           QMateriel.FieldByName('fQty').AsFloat :=pProduct^.Qty * OrderQty;
          end
          else
          begin
          QMateriel.Edit ;
          QMateriel.FieldByName('fQty').AsFloat :=
                    QMateriel.FieldByName('fQty').AsFloat+pProduct^.Qty * OrderQty;
          end;
       end;
    Node:=Node.GetNext;
    end;
  if QMateriel.State in [dsInsert,dsEdit] then QMateriel.Post;
end;

procedure TfrmMaterielDecompose.acSaveExecute(Sender: TObject);
begin
  inherited;
try
QMateriel.UpdateBatch();
except
On E:exception do
   begin
   MessageDlg('存盘失败！'+#10#13+E.Message,mtError,[mbOk],0);
   exit;
   end;
end;
//MessageDlg('存盘成功！',mtInformation,[mbOk],0);

bModify:=False;
SetAction();
end;

procedure TfrmMaterielDecompose.acCancelExecute(Sender: TObject);
begin
  inherited;
if MessageDlg('你确定要取消所作的修改吗？',mtWarning,[mbOk,mbCancel],0)=mrOk then
   QMateriel.CancelBatch();
bModify:=False;
SetAction();
end;

procedure TfrmMaterielDecompose.acDelLineExecute(Sender: TObject);
begin
  inherited;
if QMateriel.RecordCount >0 then
   QMateriel.Delete ;
end;

procedure TfrmMaterielDecompose.QMaterielBeforePost(DataSet: TDataSet);
begin
  inherited;
if QMateriel.State = dsInsert then
   QMateriel.FieldByName('fID').asInteger:= OrderID;
end;

procedure TfrmMaterielDecompose.dsMaterielStateChange(Sender: TObject);
begin
  inherited;
//if QMateriel.State in [dsInsert,dsEdit] then

end;

procedure TfrmMaterielDecompose.QMaterielAfterInsert(DataSet: TDataSet);
begin
  inherited;
bModify :=True;
SetAction();
end;

procedure TfrmMaterielDecompose.acAddLineExecute(Sender: TObject);
begin
  inherited;
QMateriel.Append ;
end;

end.