goodsinoutfm.pas

来自「群星医药系统源码」· PAS 代码 · 共 647 行 · 第 1/2 页

  CdsRankStock.RemoteServer:=SvrStock;
  CdsTotalStock.RemoteServer:=SvrStock;
  SetGressHint('正在连接公用信息服务器...');
  SvrCommon:=iFmMain.GetConnection(Handle,'','CommonSvr.CommonRDM');
  CdsFieldProPerty.ProviderName:='DspTemp';
  CdsFieldProPerty.RemoteServer:=SvrCommon;
  SetGressHint('读取用户操作权限...');
  IFmMain.SetActionStatus(ActionList1, hInstance, self.ClassName);
  CdsGoodsIn.Open;
  CdsGoodsOut.Open;
  CdsDetailStock.Open;
  CdsRankStock.Open;
  CdsTotalStock.Open;
  dbgGoodsIn.SetAutoSort('');
  dbgGoodsOut.SetAutoSort('');
  dbgDetailStock.SetAutoSort('');
  dbgRankStock.SetAutoSort('');
  dbgTotalStock.SetAutoSort('');
end;

procedure TFmGoodsInOut.FormShow(Sender: TObject);
begin
  SetGressHint('初始化本地环境...');
  dtpEndDate.Date := Date;
  ptBkPanel.Color := TitlePanelColor;
  SetGridEhColor([dbgGoodsIn,dbgGoodsOut,dbgDetailStock,dbgRankStock ,dbgTotalStock]);
  SetGridEhColor([dbgGoodsIn,dbgGoodsOut,dbgDetailStock,dbgRankStock,dbgTotalStock]);
  LoadFieldsLayOut(LocSetting^.FieldLayoutCfgFile, Name,
                   [dbgGoodsIn,dbgGoodsOut,dbgDetailStock,dbgRankStock,dbgTotalStock]);
  SysFieldXml(CdsFieldProPerty,sFieldProPerty,'TFmGoodsInOut.Xml');

  SetFieldProperty(CdsFieldProPerty,CdsGoodsIn, 'GoodsInOut,Depots,Goodses');
  SetFieldProperty(CdsFieldProPerty,CdsGoodsOut, 'GoodsInOut,Depots,Goodses');
  SetFieldProperty(CdsFieldProPerty,CdsDetailStock, 'GoodsInOut,Depots,Goodses');
  SetFieldProperty(CdsFieldProPerty,CdsRankStock, 'BatchPartStock,GoodsInOut,Depots');
  SetFieldProperty(CdsFieldProPerty,CdsToTalStock, 'BatchPartStock,GoodsInOut,Depots');

  FreeGressForm;
end;

function TFmGoodsInOut.FilterStock: String;
Var
  SqlText:String;
begin
  SqlText:='';
  If cbCode.Checked Then
    If edGoodsId.Text<>'' Then
      SqlText:=' GoodsId='+edGoodsId.Text;
  If cbName.Checked Then
    If edGoodsName.Text<>'' Then
      If SqlText<>'' Then
        SqlText:=SqlText+' And Name Like '+''''+edGoodsName.Text+'%'+''''
      Else
        SqlText:=' Name Like '+''''+edGoodsName.Text+'%'+'''';
  Result:=SqlText;
end;

procedure TFmGoodsInOut.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
 Inherited;
 Action:=CaFree;
end;

procedure TFmGoodsInOut.ActFind1Execute(Sender: TObject);
Var
  SqlInText:String;
  B:Variant;
begin
  SqlInText:=FilterGoods;
  If edDepot1.Text<>'' Then
  Begin
    If SqlInText<>'' Then
      SqlInText:=SqlInText+' And DepotNo='+''''+edDepot1.Text+''''
    Else
      SqlInText:=' DepotNo= '+''''+edDepot1.Text+'''';
  End;
  CdsGoodsIn.Filtered:=False;
  CdsGoodsIn.Filter:=SqlInText;
  CdsGoodsIn.Filtered:=True;
  B:=SumValue(CdsGoodsIn);
  edNum1.Text:=FloatToStr(B[0]);
  edSum1.Text:=FloatToStr(B[1]);
end;


procedure TFmGoodsInOut.ActFind2Execute(Sender: TObject);
Var
  SqlInText:String;
  B:Variant;
begin
  SqlInText:=FilterGoods;
  If edDepot2.Text<>'' Then
  Begin
    If SqlInText<>'' Then
      SqlInText:=SqlInText+' And DepotNo='+''''+edDepot2.Text+''''
    Else
      SqlInText:=' DepotNo= '+''''+edDepot2.Text+'''';
  End;
  CdsGoodsOut.Filtered:=False;
  CdsGoodsOut.Filter:=SqlInText;
  CdsGoodsOut.Filtered:=True;
  B:=SumValue(CdsGoodsOut);
  edNum2.Text:=FloatToStr(B[0]);
  edSum2.Text:=FloatToStr(B[1]); 
end;

procedure TFmGoodsInOut.ActFind3Execute(Sender: TObject);
Var
  SqlInText:String;
  B:Variant;
begin
  SqlInText:=FilterGoods;
  If edDepot3.Text<>'' Then
  Begin
    If SqlInText<>'' Then
      SqlInText:=SqlInText+' And DepotNo='+''''+edDepot3.Text+''''
    Else
      SqlInText:=' DepotNo= '+''''+edDepot3.Text+'''';
  End;
  If edBerth3.Text<>'' Then
  Begin
    If SqlInText<>'' Then
      SqlInText:=SqlInText+' And BerthNo='+''''+edBerth3.Text+''''
    Else
      SqlInText:=' BerthNo= '+''''+edBerth3.Text+'''';
  End;
  If edBatch3.Text<>'' Then
  Begin
    If SqlInText<>'' Then
      SqlInText:=SqlInText+' And GroupNo='+''''+edBatch3.Text+''''
    Else
      SqlInText:=' GroupNo= '+''''+edBatch3.Text+'''';
  End;
  CdsDetailStock.Filtered:=False;
  CdsDetailStock.Filter:=SqlInText;
  CdsDetailStock.Filtered:=True;
  B:=SumValue(CdsDetailStock);
  edNum3.Text:=FloatToStr(B[0]);
  edSum3.Text:=FloatToStr(B[1]);
End;

procedure TFmGoodsInOut.ActFind4Execute(Sender: TObject);
Var
  SqlInText:String;
  B:Variant;
begin
  SqlInText:=FilterStock;
  If edDepot4.Text<>'' Then
  Begin
    If SqlInText<>'' Then
      SqlInText:=SqlInText+' And DepotNo='+''''+edDepot4.Text+''''
    Else
      SqlInText:=' DepotNo= '+''''+edDepot4.Text+'''';
  End;
  If edBerth4.Text<>'' Then
  Begin
    If SqlInText<>'' Then
      SqlInText:=SqlInText+' And BerthNo='+''''+edBerth4.Text+''''
    Else
      SqlInText:=' BerthNo= '+''''+edBerth4.Text+'''';
  End;
  CdsRankStock.Filtered:=False;
  CdsRankStock.Filter:=SqlInText;
  CdsRankStock.Filtered:=True;
  B:=SumValue(CdsRankStock);
  edNum4.Text:=FloatToStr(B[0]);
  edSum4.Text:=FloatToStr(B[1]);
End;

procedure TFmGoodsInOut.ActFind5Execute(Sender: TObject);
Var
  SqlInText:String;
  B:Variant;
begin
  SqlInText:=FilterStock;
  CdsTotalStock.Filtered:=False;
  CdsTotalStock.Filter:=SqlInText;
  CdsTotalStock.Filtered:=True;
  B:=SumValue(CdsTotalStock);
  edNum5.Text:=FloatToStr(B[0]);
  edSum5.Text:=FloatToStr(B[1]);
End;

procedure TFmGoodsInOut.ActFieldsLayoutExecute(Sender: TObject);
begin
  SetFieldsLayOut(LocSetting^.FieldLayoutCfgFile, Name,
                  [dbgGoodsIn,dbgGoodsOut,dbgDetailStock,dbgRankStock,dbgTotalStock],
                  '入库明细;出库明细;库存明细;分仓库存;总库存量');
end;

procedure TFmGoodsInOut.ActDataExportExecute(Sender: TObject);
begin
	ExportData([CdsGoodsIn, cdsGoodsOut, CdsDetailStock, CdsRankStock,CdsTotalStock],
             '入库明细;出库明细;库存明细;分仓库存;总库存量', '');
end;

procedure TFmGoodsInOut.BtnPopMenuClick(Sender: TObject);
var tp:TPoint;
begin
	tp.x:=BtnPopMenu.left;
	tp.y:=BtnPopMenu.Top+BtnPopMenu.Height+1;
	tp:=ClientToScreen(tp);
	TopPopmenu.Popup(tp.x,tp.Y);
end;

procedure TFmGoodsInOut.ActPrint1Execute(Sender: TObject);
begin
  If Not CdsGoodsIn.Active Then CdsGoodsIn.Open;
  SelRepPrint(Name,[CdsGoodsIn],'药品入库明细',ActDesignReport.Enabled);
end;

procedure TFmGoodsInOut.ActPrint2Execute(Sender: TObject);
begin
  If Not CdsGoodsOut.Active Then CdsGoodsIn.Open;
  SelRepPrint(Name,[CdsGoodsOut],'药品出库明细',ActDesignReport.Enabled);
end;

procedure TFmGoodsInOut.ActPrint5Execute(Sender: TObject);
begin
  If Not CdsTotalStock.Active Then CdsTotalStock.Open;
  SelRepPrint(Name,[CdsTotalStock],'总仓库量',ActDesignReport.Enabled);
end;

procedure TFmGoodsInOut.ActPrint4Execute(Sender: TObject);
begin
  If Not CdsRankStock.Active Then CdsRankStock.Open;
  SelRepPrint(Name,[CdsRankStock],'分仓库存',ActDesignReport.Enabled);
end;

procedure TFmGoodsInOut.ActPrint3Execute(Sender: TObject);
begin
  If Not CdsDetailStock.Active Then CdsDetailStock.Open;
  SelRepPrint(Name,[CdsDetailStock],'库存明细',ActDesignReport.Enabled);
end;

procedure TFmGoodsInOut.edGoodsIDButtonClick(Sender: TObject);
Var sGoodsID:String;
begin
  If SelectGoodsID(sGoodsID,False) Then
    edGoodsID.Text := sGoodsID;
end;

procedure TFmGoodsInOut.edDepotName4ButtonClick(Sender: TObject);
var DepotNo,DepotName: string;
    iDepotID4 : Integer;
begin
  If SelectDepot(iDepotID4,DepotNo,DepotName) Then Begin
    edDepot4.Text := DepotNo;
    edDepotName4.Text := DepotName;
  End;
end;

procedure TFmGoodsInOut.edDepotName1ButtonClick(Sender: TObject);
var DepotNo,DepotName: string;
    iDepotID1 : Integer;
begin
  If SelectDepot(iDepotID1,DepotNo,DepotName) Then Begin
    edDepot1.Text := DepotNo;
    edDepotName1.Text := DepotName;
  End;
end;

procedure TFmGoodsInOut.edDepotName2ButtonClick(Sender: TObject);
var DepotNo,DepotName: string;
    iDepotID2 : Integer;
begin
  If SelectDepot(iDepotID2,DepotNo,DepotName) Then Begin
    edDepot2.Text := DepotNo;
    edDepotName2.Text := DepotName;
  End;
end;

procedure TFmGoodsInOut.edDepotName3ButtonClick(Sender: TObject);
var DepotNo,DepotName: string;
    iDepotID3 : Integer;
begin
  If SelectDepot(iDepotID3,DepotNo,DepotName) Then Begin
    edDepot3.Text := DepotNo;
    edDepotName3.Text := DepotName;
  End;
end;

procedure TFmGoodsInOut.edBerth2ButtonClick(Sender: TObject);
begin
  edBerth2.Text := SelectBerths(edDepot2.Text);
end;

function TFmGoodsInOut.SelectBerths(DepotID: string): string;
var iDepotID: integer;
    sBerthNo: string;
begin
  if DepotID = '' then
    Application.MessageBox('请先选择仓库！','提示',MB_OK+MB_ICONINFORMATION)
  else
  begin
    iDepotID := StrToInt(DepotID);
    if SelectBerth(iDepotID, sBerthNo) then
      result := sBerthNo;
  end;
end;

procedure TFmGoodsInOut.edBerth1ButtonClick(Sender: TObject);
begin
  edBerth1.Text := SelectBerths(edDepot1.Text);
end;

procedure TFmGoodsInOut.edBerth3ButtonClick(Sender: TObject);
begin
  edBerth3.Text := SelectBerths(edDepot3.Text);
end;

procedure TFmGoodsInOut.edBerth4ButtonClick(Sender: TObject);
begin
  edBerth4.Text := SelectBerths(edDepot4.Text);
end;

initialization
 RegisterClass(TFmGoodsInOut);
finalization
 UnRegisterClass(TFmGoodsInOut);
end.