upublicvar.~pas

天涯進銷存系統

unit uPublicvar;

interface

uses
  Windows, Messages, Classes, SysUtils, Controls, Forms, Db, SimpleDS,
  FR_Rich, FR_Class, FR_View, DBClient, LBDBCtrls, ActnList, LBCtrls,
  uInitializeInPut;

type
  PList = ^TList;
  TList = record
    Code : String;
  end;

const
  Endinfo='试用期已过，请与软件供应商联系！';
  LinkServerErr='连接服务器错误，请确定服务器是否启动。';
  LinkServerinfo='连接用户数已超越您所购买的用户协议。请与供应商联系。';
  Info1='True';
  Info2='False';
  Info3='NO';

var
  DatabaseServerName, DatabaseName,computer :string;
  serveruser,serverpassword:string;
  AccDataName, AccbookName :string;
  strpath:string;
  ApplicationPath: string; //应用程序路径
  ReportPath :string; //报表路径

  CurrencyName :string;
  ComDepotCode :string;
  MaxAgiosum   :double;

  UserName :string;
  UserPass :string;
  UserCode :string;
  UserKey: string;

  isLogon: Boolean;

  APoint: TPoint;
  BPoint: TPoint;

  List: PList;
  sDate: TDate;

  Selectsysteminfotype: integer;

  WindowItem : TStringList;

  FindCds :TSimpleDataSet;
  FindCaption: string;
  FindValue: string;
  FindTable: string;

  SelectPartCds: TSimpleDataSet;
  BillIsEdit: Boolean;  //商品增加情况
  SavePartData: TClientDataSet;  //保存库存数据
  BillSum, PartSum: Extended;
  isReimburese: Boolean;
  isNewCheckBill: Boolean;
  isRedressal: Boolean;
  CheckDepotCode, CheckDepotName: string;

  SelectPartType: Integer;
  SelectBillType: Integer;
  SelectSql: string;
  IPartCode: string; //
  SelectBillCode: string;

  OpposingCode,  OpposingName: string; //对方单位编号

  ReimbureseTableName, ReimbureseBillNo: string;

  {以下是商品出库存用}
  PickUpGoodsNo : string;  //提货单号
  PickUpGoodsUnitCode,  PickUpGoodsUnit : string;//提货单位
  PickUpDepotCode, PickUpDepotName: string;   //仓库名称
  PickHandTableName, PickBodyTableName : string; //子表名称
  PickUpType : integer;

  ResPrice1, ResPrice2, ResPrice3, ResPrice4: Double;
  isCost, isSell: Boolean;
  RedressalType: Integer;

  PayMentType: integer;
  PayMentModel: string;
  isSelectPayMentModel: Boolean;
  
  procedure GetWindowsItem(s: string; Obj: TObject);
  procedure GetXoY(TCl: TControl);

  procedure OpenData(Sqltext:string; Cds : TSimpleDataSet);  //打开数据
  procedure DeleteData(Cds :TSimpleDataSet;  Del :Boolean);  //删除数据
  procedure DeleteBillBody(sql: string);
  procedure FindData(Cds :TSimpleDataSet; FindText, TableName : string;
                     const Value : string = '');  //查找数据

  procedure SetListData(Sqltext: string; TListEd:TLBCombobox);  //取得列表
  procedure SetIndexListData(Sqltext : string; TListEd:TLBDBCombobox; IndexDs, NameDs : string);

  procedure BillAddPart(Cds : TSimpleDataSet);
  procedure BillDeletePart(HandCds, BodyCds: TSimpleDataSet);

  procedure SelectDate;
  procedure SelectParts;
  procedure SelectProvider;
  procedure SelectClient;
  procedure SelectStockOrder;
  procedure SelectStockBill;
  procedure SelectSaleBill;
  procedure SelectReimbureseParts;
  procedure SelectSaleOrder;
  procedure SelectPaymentType;
  procedure SelectAccountinfo;
  procedure SelectBillinfo;

  procedure SetDataDelInfo(TableName, ID, UpValue : string); //数据是否可删除

  procedure BillKeyDown(Key :Word; DBase :TSimpleDataSet; Ron :Integer);

  procedure PartInPutDataSave(DepotCode, DepotName : string;
                               BillDate: TDate; inType: Integer); //保存入库数据
  procedure PartOutPutDataSave(DepotCode, DepotName : string;
                              BillDate: TDate; OutType: Integer); //保存入库数据
  procedure SetPaymentSum(Value: Integer; Code: string; Sum : Extended);
  procedure SetOrderBillExcInfo(OrderCode : string; Cds : TSimpleDataSet); //更新订货单已执行的数据
  procedure SetBillResInfo(OrderCode, BillTableName : string; Cds : TSimpleDataSet); //更新单据退货数量已执行的数据


  procedure PrintView(FileName :string; Report :TfrReport);//打印

  procedure UserLogonkey(Frm: TForm; FrmName: string);
  
  function isExist(TableName, KeyField, NewValue, OldValue, Value :string):Boolean;
  function GetBillID(Ts :string; TD: string):string;
  function GetCostprice(Code: string): Double;


implementation

uses uMain, uDataMo, uFind, uConst, uPrintview, uSelectPart, uSelectProvider,
     uDate, uSelectStockOrder, Tools, uSelectStockBill, uReimbureseParts,
     uSelectClient, uSelectSaleOrder, uSelectSaleBill, uSelectPaymentType,
     uSelectAccountinfo, uSelectBillinfo;

procedure GetWindowsItem(s: string; Obj: TObject);
begin
  if WindowItem.Count>0 then
  WindowItem.Delete(0);
  WindowItem.AddObject(s, Obj);
  frmMain.WindowCaption.Caption:='天涯进销存管理系统 - ['+s+']';
end;

procedure GetXoY(TCl: TControl);
begin
  APoint:=TCl.ClientToScreen(Point(0, TCl.ClientHeight));
  BPoint:=Point(TCl.Width, TCl.Height); 
end;

procedure OpenData(SqlText:string; Cds : TSimpleDataSet);
begin
  try
    Cds.Close;
    Cds.DataSet.CommandText:=SqlText;
    Cds.Open;
  except
    Application.MessageBox('打开数据错误。',Errorinfo,$10);
    Abort;
  end;
end;

procedure DeleteData(Cds :TSimpleDataSet;  Del :Boolean);
begin
  if Cds.IsEmpty then
  begin
    Application.MessageBox('没有可删除的数据。',Hintinfo,$30);
    Exit;
  end;
  if Del then
  begin
    if Cds.FieldByName('Del').Asstring='1'  then
    begin
      Application.MessageBox('已发生业务，不可删除。',Hintinfo,$30);
      Exit;
    end;
  end;
  if Application.MessageBox('真的要删除当前记录吗？',Hintinfo,$24)=idYes then
  begin
    Cds.Delete;
    Cds.ApplyUpdates(-1);
  end;
end;

procedure DeleteBillBody(sql: string);
begin
  dmData.SQLQuery.Close;
  dmData.SQLQuery.Sql.Text:=sql;
  dmData.SQLQuery.ExecSQL;
end;

procedure FindData(Cds :TSimpleDataSet; FindText, TableName: string;
                   const Value : string ='');
begin
  FindCds :=Cds;
  FindValue := Value;
  FindCaption:=FindText;
  FindTable:=TableName;
  frmFind:=TFrmFind.Create(Application);
  frmFind.ShowModal;
  frmFind.Free;
end;

procedure SetListData(Sqltext: string; TListEd:TLBCombobox);
begin
  OpenData(Sqltext, dmData.sdsPublic);
  with dmData.sdsPublic do
  begin
    TListEd.Items.Clear;
    while not Eof do
    begin
      TListEd.Items.Add(dmData.sdsPublic.Fields[0].asstring);
      Next;
    end;
    Close;
  end;
end;

procedure SetIndexListData(Sqltext : string; TListEd:TLBDBCombobox; IndexDs, NameDs : string);
begin
  OpenData(Sqltext, dmData.sdsPublic);
  TListEd.Items.Clear;
  while not dmData.sdsPublic.Eof do
  begin
    New(List);
    List.Code:=dmData.sdsPublic.Fieldbyname(IndexDs).asstring;
    TListEd.Items.AddObject(dmData.sdsPublic.Fieldbyname(NameDs).asstring, TObject(List));
    dmData.sdsPublic.Next;
  end;
end;

procedure BillAddPart(Cds : TSimpleDataSet);
begin
  Cds.Last;
  if Cds.Fieldbyname('PartCode').asstring<>'' then
  begin
    Cds.Append;
    Cds.Fieldbyname('BillCode').asstring:='新单据';
    Cds.Fieldbyname('ID').asinteger:=Cds.RecordCount+1;
    Cds.Post;
  end;
end;

procedure BillDeletePart(HandCds, BodyCds: TSimpleDataSet);
begin
  if BodyCds.FieldByName('PartCode').asstring='' then
  begin
    Application.MessageBox('没有可删除的商品。',Hintinfo, $30);
    Abort;
  end;
  if Application.MessageBox('确定要删除本商品吗？',Hintinfo, $24)=idYes then
  begin
    HandCds.Edit;
    HandCds.FieldByName('TOTALSUM').Asfloat:=
    HandCds.FieldByName('TOTALSUM').Asfloat-
    BodyCds.FieldByName('TOTALSUM').Asfloat;
    HandCds.FieldByName('BigSum').asstring:=
    SumSmallTOBig(HandCds.FieldByName('TOTALSUM').Asfloat);
    BodyCds.Delete;
  end;
end;


procedure SelectDate;
begin
  frmDate:=TfrmDate.Create(Application);
  frmDate.ShowModal;
  frmDate.Free;
end;

procedure SelectParts;
begin
  FrmSelectPart:=TFrmSelectPart.Create(Application);
  FrmSelectPart.ShowModal;
  FrmSelectPart.Free; 
end;

procedure SelectProvider;
begin
  OpposingCode:='';
  frmSelectProvider:=TfrmSelectProvider.Create(Application);
  frmSelectProvider.ShowModal;
  frmSelectProvider.Free;
end;

procedure SelectClient;
begin
  OpposingCode:='';
  frmSelectClient:=TfrmSelectClient.Create(Application);
  frmSelectClient.ShowModal;
  frmSelectClient.Free;
end;

procedure SelectStockOrder;
begin
  frmSelectStockOrder:=TfrmSelectStockOrder.Create(Application);
  frmSelectStockOrder.ShowModal;
  frmSelectStockOrder.Free;
end;

procedure SelectStockBill;
begin
  frmSelectStockBill:=TfrmSelectStockBill.Create(Application);
  frmSelectStockBill.ShowModal;
  frmSelectStockBill.Free;
end;

procedure SelectSaleBill;
begin
  frmSelectSaleBill:=TfrmSelectSaleBill.Create(Application);
  frmSelectSaleBill.ShowModal;
  frmSelectSaleBill.Free; 
end;

procedure SelectReimbureseParts;
begin
  frmReimbureseParts:=TfrmReimbureseParts.Create(Application);
  frmReimbureseParts.ShowModal;
  frmReimbureseParts.Free;
end;

procedure SelectSaleOrder;
begin
  frmSelectSaleOrder:=TfrmSelectSaleOrder.Create(Application);
  frmSelectSaleOrder.ShowModal;
  frmSelectSaleOrder.Free;
end;

procedure SelectPaymentType;
begin
  frmSelectPaymentType:=TfrmSelectPaymentType.Create(Application);
  frmSelectPaymentType.ShowModal;
  frmSelectPaymentType.Free; 
end;

procedure SelectAccountinfo;
begin
  SelectSql:='';
  frmSelectAccountinfo:=TfrmSelectAccountinfo.Create(Application);
  frmSelectAccountinfo.ShowModal;
  frmSelectAccountinfo.Free;
end;

procedure SelectBillinfo;
begin
  SelectSql:='';
  frmSelectBillinfo:=TfrmSelectBillinfo.Create(Application);
  frmSelectBillinfo.ShowModal;
  frmSelectBillinfo.Free;  
end;

procedure SetDataDelInfo(TableName, ID, UpValue : string);
var
  sqltext: string;
begin
  sqltext:='Update '+TableName+' set Del=''1'' where '+ID+'='+#39+UPValue+#39;
  with dmData.SQLQuery do
  begin
    Close;
    Sql.Clear;
    Sql.Text:=Sqltext;
    ExecSQL;
  end;
end;

procedure BillKeyDown(Key :Word; DBase :TSimpleDataSet; Ron :Integer);
begin
  if key=vk_Up then DBase.Prior;
  if key=VK_DOWN then DBase.Next;
  if key=VK_Next then DBase.MoveBy(Ron);
  if key=vk_Prior then DBase.MoveBy(-Ron);
end;

procedure PartInPutDataSave(DepotCode, DepotName : string;
                            BillDate: TDate; inType: Integer);
var
  COSTSum: Double;
begin
  with SavePartData, dmData do
  begin
    try
    if IsEmpty then
    begin
      Application.MessageBox('没有可入库的数据。',Hintinfo,$30);
      Abort;
    end;