retailfrm.pas

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

PAS
1,103
字号
unit RetailFrm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DB, DBClient, ckDBClient, MConnect, Grids, DBGridEh, DbUtilsEh, EhLibCDS, xEhLibCtl,
  AAFont, AACtrls, RzBtnEdt, RzRadChk, RzButton, RzStatus, RzBorder, Mask,
  RzDBEdit, StdCtrls, RzEdit, RzPanel, ExtCtrls, xBaseFrm, ActnList,
  ModuleAction, Buttons, IMainFrm, DBCtrls, RzDBBnEd, RzGroupBar, ImgList,
  uDataTypes, LEDScreen, MicroPrnt,IniFiles,SelectGoodsFrm,SelectEmpFrm,
  uGlobal, uRtlUnit;

type
  TFmRetail = class(TxBaseForm)
    Panel1: TPanel;
    plTitle: TRzPanel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label9: TLabel;
    edBranchID: TRzDBEdit;
    edMachNo: TRzDBEdit;
    edBillNo: TRzDBEdit;
    edTeamNo: TRzDBEdit;
    plCtrl: TRzPanel;
    capTotal: TAALabel;
    capPayMoney: TAALabel;
    capChange: TAALabel;
    lbTotal: TRzLEDDisplay;
    lbChange: TRzLEDDisplay;
    lbPayMoney: TRzLEDDisplay;
    plInputBk: TRzPanel;
    lbOptHint: TRzMarqueeStatus;
    plInput: TPanel;
    edInput: TRzEdit;
    plGoodsInfo: TRzPanel;
    Label11: TLabel;
    lbGoodsName: TLabel;
    lbGoodsSpecs: TLabel;
    Label15: TLabel;
    lbUnit1: TLabel;
    Label17: TLabel;
    lbUnit2: TLabel;
    Label19: TLabel;
    lbConv: TLabel;
    Label14: TLabel;
    lbGoodsMaker: TLabel;
    plDataGrid: TRzPanel;
    dbEditGoodsID: TRzDBEdit;
    dbgRetailDtl: TxDBGridEh;
    DCOMConn: TDCOMConnection;
    cdsRetail: TckClientDataSet;
    dsRetail: TDataSource;
    cdsRetailDtl: TckClientDataSet;
    dsRetailDtl: TDataSource;
    cdsRetailFDate: TDateTimeField;
    cdsRetailBranchID: TIntegerField;
    cdsRetailMachNo: TIntegerField;
    cdsRetailTeamNo: TSmallintField;
    cdsRetailBillNo: TStringField;
    cdsRetailDepotID: TIntegerField;
    cdsRetailPayeeNo: TStringField;
    cdsRetailEmpNo: TStringField;
    cdsRetailVIPNo: TStringField;
    cdsRetailGoodsSum: TBCDField;
    cdsRetailExpense: TBCDField;
    cdsRetailBornSum: TBCDField;
    cdsRetailAmount: TBCDField;
    cdsRetailPayMoney: TBCDField;
    cdsRetailAudit: TStringField;
    cdsRetailTransfer: TBooleanField;
    cdsRetailCreater: TStringField;
    cdsRetailCreatTime: TDateTimeField;
    cdsRetailMender: TStringField;
    cdsRetailUpdateTime: TDateTimeField;
    cdsRetailGrup: TIntegerField;
    cdsRetailadsRetailDtl: TDataSetField;
    cdsRetailDtlBillNo: TStringField;
    cdsRetailDtlItemNo: TIntegerField;
    cdsRetailDtlGoodsID: TStringField;
    cdsRetailDtlUnit: TStringField;
    cdsRetailDtlQty: TBCDField;
    cdsRetailDtlOPrice: TFloatField;
    cdsRetailDtlRebate: TBCDField;
    cdsRetailDtlPrice: TFloatField;
    cdsRetailDtlAmount: TBCDField;
    cdsRetailDtlOldPrice: TFloatField;
    cdsRetailDtlBatchNo: TStringField;
    cdsRetailDtlName: TStringField;
    cdsRetailDtlSpecs: TStringField;
    cdsRetailDtlPdcAddr: TStringField;
    ActionList1: TActionList;
    ActNewBill: TModlAction;
    BtnViewRPanel: TSpeedButton;
    BtnHideRPanel: TSpeedButton;
    dbgHScrollBar: TScrollBar;
    Timer1: TTimer;
    cdsTemp: TckClientDataSet;
    cdsRetailPayMode: TStringField;
    cdsRetailPayInfo: TStringField;
    Label6: TLabel;
    edVipCustNo: TRzDBEdit;
    Label7: TLabel;
    edEmpNo: TRzDBButtonEdit;
    Label1: TLabel;
    edPayeeNo: TRzDBEdit;
    Label5: TLabel;
    edDepotID: TRzDBEdit;
    plRight: TRzGroupBar;
    RzGroup2: TRzGroup;
    RzGroup3: TRzGroup;
    RzGroup1: TRzGroup;
    AAText3: TAAText;
    ckNotPrint: TRzCheckBox;
    RzBitBtn2: TRzBitBtn;
    RzBitBtn3: TRzBitBtn;
    RzBitBtn4: TRzBitBtn;
    Label8: TLabel;
    lbPdcAddr: TLabel;
    ckCanSplit: TRzCheckBox;
    ckSpecial: TRzCheckBox;
    Label10: TLabel;
    Label12: TLabel;
    ckViewScrollbar: TRzCheckBox;
    ImageList1: TImageList;
    ActFieldLayout: TAction;
    ActExit: TAction;
    cdsRetailDtlBornSum: TBCDField;
    ActPrintPreBill: TModlAction;
    ActOpenMoneyBox: TModlAction;
    CdsTemp1: TClientDataSet;
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure ActNewBillExecute(Sender: TObject);
    procedure edInputKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormShow(Sender: TObject);
    procedure plTitleResize(Sender: TObject);
    procedure BtnHideRPanelClick(Sender: TObject);
    procedure BtnViewRPanelClick(Sender: TObject);
    procedure edInputKeyPress(Sender: TObject; var Key: Char);
    procedure cdsRetailDtlOPriceChange(Sender: TField);
    procedure cdsRetailDtlQtyChange(Sender: TField);
    procedure cdsRetailDtlNewRecord(DataSet: TDataSet);
    procedure plInputBkResize(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure edInputExit(Sender: TObject);
    procedure cdsRetailNewRecord(DataSet: TDataSet);
    procedure cdsRetailDtlBeforeCancel(DataSet: TDataSet);
    procedure cdsRetailBillNoChange(Sender: TField);
    procedure cdsRetailDtlAfterPost(DataSet: TDataSet);
    procedure cdsRetailAmountChange(Sender: TField);
    procedure plRightDblClick(Sender: TObject);
    procedure ckViewScrollbarClick(Sender: TObject);
    procedure ActFieldLayoutExecute(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure edEmpNoButtonClick(Sender: TObject);
    procedure ActExitExecute(Sender: TObject);
    procedure ActOpenMoneyBoxExecute(Sender: TObject);
    procedure ActPrintPreBillExecute(Sender: TObject);
  private
    LEDScreen: TLEDScreen;
    BillPrinter: TMicroPrinter;
    PosIniFile : TIniFile;
    dBornSum,dAmount, dPayMoney, dChange: Double;
    iClose : Boolean;
    iRecord,iFirstPrint : Integer;  //iFirstPrint 用来表示第一次窗体创建时打前单的标识字,1:表示是创建时打印,其它表示不是
    NewBillNo, PreBillNo : String;
    procedure NewBill;
    Function  SaveBill : Boolean;
  	Procedure SetOptHint(sHint: String);
    procedure EmptyDataSet(DataSet: TDataSet);
    procedure DeleteCurrBill;
    Function  SetVipNo(sVipNo: string): Boolean;
    Function  SetEmpNo(sEmpNo: string): Boolean;
    Function  DoInputGoods(sGoodsID: String): Boolean;
    procedure DoWholeRebate(dRebate: Double);
    procedure DoHangBill;
    procedure CalcAmount;
    procedure PrintRetailBill(sBillNo: String);
  protected
    IFmMain: IMainForm;
    LocSetting: PLocSetting;
    iClientID: Integer;
    iBranchNo, iMachineNo, iTeamNo: Integer;
    iLastItemNo: Integer;
    BillHang: Boolean;//是否已有挂单
    WholeRebate: double;
    AppSvrCommon, AppSvrRetail: Variant;
    SvrCommon, SvrRetail: TDispatchConnection;
  public
    { Public declarations }
  end;

var
  FmRetail: TFmRetail;

implementation

uses ceGlobal, ShowProGress, DBPopupForm, SltPayModeFrm, FieldsLayoutFrm,RepSelectFrm;

{$R *.dfm}

procedure TFmRetail.FormCreate(Sender: TObject);
Var
  lList : TStringList;
  sTeamNo : String;
  i,iCountTeamNo : Integer;
begin
  Inherited;
  BillPrinter := TMicroPrinter.Create(Self);
  IFmMain := Application.MainForm as IMainForm;
  LocSetting := IFmMain.IFmMainEx.GetLocSetting;
  iBranchNo := LocSetting.BranchNo;
  iMachineNo := LocSetting.MachineNo;
  PosIniFile := TIniFile.Create(IFmMain.AppPath+'PosSetting.Ini');
  with PosIniFile do Begin
    PreBillNo := ReadString('Other','LastBillNo','');
  End;
  iFirstPrint := 1;
  lList := TStringList.Create;
  iClose := False;
  iCountTeamNo := BaseSetting.ClassCount;
  If iCountTeamNo>0 Then Begin
    For I := 1 To iCountTeamNo do
      lList.Add(IntToStr(i));
  End Else Begin
    Messagebox(Handle,Pchar('请先设置好零售班次...'),'提示',64);
    iClose := True;
    Exit;
  End;
  If Not iClose Then Begin
    if lList.Count=1 Then
      iTeamNo := StrToInt(lList[0])
    Else Begin
      sTeamNo := xInputComboBox('选择班次','请选择所需的班次:',lList,'',2);
      If sTeamNo<>'' Then
        iTeamNo := StrToInt(sTeamNo)
      Else Begin
        iClose := True;
        Exit;
      End;
    End;
  End;
  LEDScreen := TLEDScreenPDLED8.Create(self);//TLEDScreen.Create(self);
  with FixingSetting do
  begin
    LEDScreen.LEDScreenPort := BuyerDispPort;
    LEDScreen.BaudRate := BaudRate;
    LEDScreen.LineDelay := DispOutDelay;
    //LEDScreen. := BuyerDispLineChars;
    if LEDScreen.LEDScreenPort<>'' Then
      LEDScreen.Open;
  end;
  BillPrinter := TMicroPrinter.Create(self);
  with FixingSetting do
  begin
    BillPrinter.PrinterPort := PrintPort;
    BillPrinter.PrintDelay  := PrintDelay;
    BillPrinter.BillHeader  := BillHeader;
    BillPrinter.BillFooter1 := BillFooter1;
    BillPrinter.BillFooter2 := BillFooter2;
    BillPrinter.HeaderColor := HeaderColor;
    BillPrinter.DetailColor := DetailColor;
    BillPrinter.FooterColor := FooterColor;
  end;
  LocSetting := IFmMain.IFmMainEx.GetLocSetting;
  iClientID := IFmMain.IFmMainEx.ClientID;
  SetGressHint('正在连接到公用信息服务器...');
  SvrCommon := IFmMain.GetConnection(Handle, '', 'CommonSvr.CommonRDM');
  SetGressHint('正在连接到零售管理服务器...');
  SvrRetail := IFmMain.GetConnection(Handle, '', 'RetailSvr.Retails');
  cdsRetail.RemoteServer := SvrRetail;
  cdsRetail.Open;
  ActNewBill.Execute;
end;

procedure TFmRetail.FormShow(Sender: TObject);
begin
  Inherited;
  If iClose Then Begin Close; Exit; End;
  FreeGressForm;
  edInput.SetFocus;
  lbTotal.Caption := '';
  lbPayMoney.Caption := '';
  lbChange.Caption := '';
  plRight.Color := Color;
  RzGroup1.Color := Color;
  RzGroup2.Color := Color;
  RzGroup3.Color := Color;
  dbgHScrollbar.Visible := ckViewScrollbar.Checked;
  if Screen.Width=640 then
    plRight.ExclusiveMode := true;
  SetGridEhColor([dbgRetailDtl]);
  LoadFieldsLayOut(LocSetting^.FieldLayoutCfgFile, Name, [dbgRetailDtl]);
  SetOptHint('欢迎使用本系统,在操作过程中请留意这里显示的提示信息!');
end;

procedure TFmRetail.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  if not cdsRetailDtl.IsEmpty then
    CanClose := Application.MessageBox('你要放弃当前正在编辑的销售单吗?', '消息', MB_YESNO+MB_ICONQUESTION)=IDYES;
  if BillHang then begin
    CanClose := Application.MessageBox('当前还有单据被挂起,如果现在退出将会丢失该单据!'#13'要保留该单据请按[是]按钮,将[否]放弃该单据。',
                '警告', MB_YESNO+MB_ICONWARNING)=IDNO;
  end;
  PosIniFile.WriteString('Other','LastBillNo',PreBillNo); 
  PosIniFile.Free;
end;

procedure TFmRetail.FormDestroy(Sender: TObject);
begin
  LEDScreen.Free;
  BillPrinter.Free;
  inherited;
end;

procedure TFmRetail.NewBill;
begin
  cdsRetail.Append;
  lbTotal.Caption := '';
  LEDScreen.InitState;
end;

Function TFmRetail.SaveBill : Boolean;
var sPayMode, sPayInfo, sChange,sBillNo: string;
begin
  Result := False;
  if cdsRetailDtl.State in dsEditModes then begin
    SetOptHint('因为还有未决销售记录,此时不能进行"收款"操作。');
    Exit;
  end;
  try
    dPayMoney := StrToFloat(edInput.Text);
  Except
    SetOptHint('请输入正确的数字(客户付款金额)!');
    Exit;
  end;
  dAmount := cdsRetailAmount.Value;      //合计
  dChange := dPayMoney-dAmount;          //付款-合计
  if dChange<0 then begin
    SetOptHint('客户付款不足,不能进行"收款"操作!');
    Exit;
  end;
  sChange := FormatFloat('0.00', dChange);
  while Length(sChange)<6 do
    sChange := ' '+sChange;
  lbPayMoney.Caption := FormatFloat('0.00', dPayMoney);
  lbChange.Caption := sChange; 
  SelectRtlPayMode(sPayMode, sPayInfo, lbChange.Caption);
  if sPayMode='' then
    Exit;
  cdsRetail.Edit;
  cdsRetailPayMode.Value := sPayMode; 
  cdsRetailPayInfo.value := sPayInfo;
  cdsRetailPayMoney.Value := dPayMoney;
  cdsRetail.Post;
  LEDScreen.Display([#127'3'+lbPayMoney.Caption, #127'4'+lbChange.Caption], 0);
  if cdsRetail.ApplyUpdates(0)=0 then begin
    If not CkNotPrint.Checked then begin //如果打小票
        if FixingSetting.LinePrintMode then
  		  	BillPrinter.PrintFooter(dBornSum, dAmount, dPayMoney, dChange)
        Else
          PrintRetailBill(NewBillNo);
    End;

⌨️ 快捷键说明

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