posfrm.pas
来自「群星医药系统源码」· PAS 代码 · 共 1,216 行 · 第 1/3 页
PAS
1,216 行
unit POSFrm;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, RzPanel, Grids, DBGridEh, DbUtilsEh, EhLibCDS, xEhLibCtl, StdCtrls, Mask, RzEdit,
ComCtrls, RzDTP, RzLabel, RzLstBox, RxGrdCpt, RzButton, RzBorder, ADODB,
Db, DBCtrls, Variants, RzCmboBx, ActnList, RzRadChk, RzStatus, RzDBEdit,
RzListVw, RzDBLbl, RzBtnEdt, AAFont, AACtrls, ModuleAction, xBaseFrm;
type
TSaleGoodsInfo = Record
GoodsID:String;
GUnit: String;
Number: Double;
BornSum:Double;
Price: Double;
Rebate: Double;
Amount: Double;
end;
TFmPOS = class(TxBaseForm)
Panel1: TPanel;
Panel3: TPanel;
Panel2: TRzPanel;
plCtrl: TRzPanel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
edBranchID: TRzEdit;
edMachNo: TRzEdit;
RzEdit3: TRzDBEdit;
RzPanel1: TRzPanel;
Label9: TLabel;
ActionList1: TActionList;
ActSave: TAction;
ActPrintPreBill: TAction;
ActExit: TAction;
ActQuery: TModlAction;
Panel6: TPanel;
ActOpenMoneyBox: TAction;
DS_Retail: TDataSource;
DS_RetailList: TDataSource;
dbEditGoodsID: TRzDBEdit;
RzPanel3: TRzPanel;
RzBitBtn2: TRzBitBtn;
RzBitBtn3: TRzBitBtn;
RzBitBtn4: TRzBitBtn;
CkNoPrint: TRzCheckBox;
ActGoodsSplit: TAction;
ActNewBill: TAction;
ActDel: TAction;
lvSaleGoodses: TListView;
plInputBk: TRzPanel;
plInput: TPanel;
edInput: TRzEdit;
lbOptHint: TRzMarqueeStatus;
HeaderCtrl: THeaderControl;
Qr_GoodsCalc: TADOQuery;
Timer1: TTimer;
edTeamNo: TRzEdit;
plGoodsInfo: TRzPanel;
Label11: TLabel;
lbGoodsName: TLabel;
lbGoodsSpecs: TLabel;
Label15: TLabel;
lbUnit: TLabel;
lbSplit: TLabel;
Label17: TLabel;
lbUnit2: TLabel;
Label19: TLabel;
lbConv: TLabel;
Label14: TLabel;
lbGoodsMaker: TLabel;
lbSpecial: TLabel;
ActHangSaleBill: TAction;
Timer2: TTimer;
edEmpID: TRzButtonEdit;
Label1: TLabel;
RzPanel2: TRzPanel;
AAText2: TAAText;
Label5: TLabel;
edCustNo: TRzButtonEdit;
capTotal: TAALabel;
capPayMoney: TAALabel;
capChange: TAALabel;
lbTotal: TRzLEDDisplay;
lbChange: TRzLEDDisplay;
Qr_Retail: TADOQuery;
Qr_RetailBranchID: TIntegerField;
Qr_RetailMachNo: TIntegerField;
Qr_RetailBillNo: TWideStringField;
Qr_RetailDepot: TWideStringField;
Qr_RetailFDate: TDateTimeField;
Qr_RetailTeamNo: TWordField;
Qr_RetailOperator: TWideStringField;
Qr_RetailAmount: TFloatField;
Qr_RetailPayMoney: TFloatField;
Qr_RetailChange: TFloatField;
Qr_RetailSended: TBooleanField;
Qr_RetailBornSum: TFloatField;
Qr_RetailEmpID: TWideStringField;
Qr_RetailCustNo: TWideStringField;
Qr_RetailAudit: TStringField;
Qr_RetailPosTrans: TBooleanField;
Qr_RetailList: TADOQuery;
Qr_RetailListBranchID: TIntegerField;
Qr_RetailListMachNo: TIntegerField;
Qr_RetailListBillNo: TWideStringField;
Qr_RetailListItemNo: TIntegerField;
Qr_RetailListGoodsID: TWideStringField;
Qr_RetailListGoodsName: TStringField;
Qr_RetailListGoodsSpecs: TStringField;
Qr_RetailListUnit: TWideStringField;
Qr_RetailListNumber: TFloatField;
Qr_RetailListPrice: TFloatField;
Qr_RetailListRebate: TFloatField;
Qr_RetailListAmount: TFloatField;
Qr_RetailListPriceModified: TBooleanField;
Qr_Temp: TADOQuery;
Qr_PosInfo: TADOQuery;
Qr_PosInfoServer: TWideStringField;
Qr_PosInfoDatabase: TWideStringField;
Qr_PosInfoBranchID: TIntegerField;
Qr_PosInfoDepot: TWideStringField;
Qr_PosInfoDepotName: TStringField;
Qr_PosInfoMachNo: TIntegerField;
Qr_PosInfoTeamCount: TSmallintField;
Qr_PosInfoBillPrefix: TWideStringField;
Qr_PosInfoBillSUFFIX: TWordField;
Qr_PosInfoPriceModus: TWordField;
Qr_PosInfoPriceModulus: TFloatField;
Qr_PosInfoSoonCalcSum: TBooleanField;
Qr_PosInfoBaleFilePath: TWideStringField;
Qr_PosInfoBaleFileName: TWideStringField;
Qr_PosInfoEmailAddr: TWideStringField;
Qr_PosInfoDBLastDate: TIntegerField;
Qr_PosInfoStartDate: TDateTimeField;
lbPayMoney: TRzLEDDisplay;
procedure FormCreate(Sender: TObject);
procedure ActPrintPreBillExecute(Sender: TObject);
procedure ActQueryExecute(Sender: TObject);
procedure ActExitExecute(Sender: TObject);
procedure ActOpenMoneyBoxExecute(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure FormShow(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure ActNewBillExecute(Sender: TObject);
procedure ActDelExecute(Sender: TObject);
procedure edInputKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure HeaderCtrlSectionResize(HeaderControl: THeaderControl;
Section: THeaderSection);
procedure plInputBkResize(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure lvSaleGoodsesKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure edInputKeyPress(Sender: TObject; var Key: Char);
procedure CkNoPrintEnter(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure ActHangSaleBillExecute(Sender: TObject);
procedure lvSaleGoodsesSelectItem(Sender: TObject; Item: TListItem;
Selected: Boolean);
procedure Timer2Timer(Sender: TObject);
procedure edEmpIDButtonClick(Sender: TObject);
procedure edEmpIDKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure edCustNoButtonClick(Sender: TObject);
procedure edCustNoKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure lvSaleGoodsesClick(Sender: TObject);
procedure lvSaleGoodsesDblClick(Sender: TObject);
private
dBornSum, dTotal, dPrice, dPayMoney, dChange, dWholeRebate: Double;
AppPath: String;
sPreBillNo: String;//前一张单的单号，以方便马上补打
LargessWriting: Boolean;//正在写赠品记录
SaleGoods: TSaleGoodsInfo;
SaleGoodses, SaleGoodses2: Array of TSaleGoodsInfo;
Procedure SetOptHint(sHint: String);
Function AddEmptyLine: TListItem;
procedure AppendSaleGoods(SaleInfo: TSaleGoodsInfo);
Function SaveBill: Boolean;
procedure NewBill;
Function ParseSaleInfo(var SaleInfo: TSaleGoodsInfo): Boolean;
Procedure WholeRebate;
Procedure DispPriceTotal;
protected
AdoConn: TAdoConnection;
public
{ Public declarations }
end;
const
ScrollNum = 3;
var
FmPOS: TFmPOS;
implementation
uses {xCmmAdo, }xCmmMath, xWinUnit, xCmmDlgs, winspool, IniFiles;
{$R *.DFM}
procedure TFmPOS.FormCreate(Sender: TObject);
begin
AppPath := ExtractFilePath(Application.ExeName);
//使窗口适应屏幕分辨率
if Screen.Width=640 then begin
// plCtrl.Height := 200;
plGoodsInfo.Height := 50;
capChange.Top := 50;
capChange.Left:= 278;
lbChange.Top := 44;
lbChange.Left := lbPayMoney.Left;
lbChange.Width:= lbPayMoney.Width;
WindowState := wsMaximized;
end;
{ if not Qr_Retail.Active then
Qr_Retail.Open;
if not Qr_RetailList.Active then
Qr_RetailList.Open;
}
{ edBranchID.Text := Qr_PosInfo.FieldByName('BranchID').AsString;
edMachNo.Text := Qr_PosInfo.FieldByName('MachNo').AsString;
edTeamNo.Text := IntToStr(TeamNo);}
end;
procedure TFmPOS.FormShow(Sender: TObject);
var IniFile: TIniFile;
n, k: Integer;
begin
IniFile := TIniFile.Create(AppPath+'POS.INI');
with HeaderCtrl.Sections do begin
k := Count;
for n:=0 to k-1 do begin
Items[n].Width := IniFile.ReadInteger('PosForm', 'Width_Col'+IntToStr(n), Items[n].Width);
lvSaleGoodses.Columns[n].Width := Items[n].Width;
end;
end;
IniFile.Free;
{ lvSaleGoodses.Color := GridColor1;
plCtrl.Color := BackGrndColor1;
CapTotal.Font.Color := FontColor1;
capPayMoney.Font.Color:= FontColor1;
capChange.Font.Color := FontColor1;
k := plGoodsInfo.ControlCount;
for n:=0 to k-1 do begin
(plGoodsInfo.Controls[n] as TLabel).Font.Color := FontColor1;
end;
if BuyerDispType in [0,1,4,5] then
BuyerDispOut(' Welcome!', '');}
SetOptHint('欢迎使用本系统，在这里显示的是一些即时提示信息！');
{ if Qr_Retail.State<>dsInsert then begin
Qr_Retail.Requery;//重新查询以保证不出现"无法定位行集"错误
Qr_RetailList.Requery;
end;
}
lbTotal.Caption := '';
lbPayMoney.Caption := '';
lbChange.Caption := '';
lbGoodsName.Caption := '';
lbGoodsSpecs.Caption:= '';
lbUnit.Caption := '';
lbUnit2.Caption := '';
lbConv.Caption := '';
lbSplit.Caption := '允许拆零:';
lbGoodsMaker.Caption:= '';
SetLength(SaleGoodses, 0);
lvSaleGoodses.Items.Clear;
NewBill;
edInput.SetFocus;
end;
procedure TFmPOS.ActPrintPreBillExecute(Sender: TObject);
begin
// PrintRetailBill(sPreBillNo);
edInput.SetFocus;
end;
procedure TFmPOS.ActOpenMoneyBoxExecute(Sender: TObject);
var str: String;
begin
{ str := xInputBox('打开钱箱', '请输入您的口令：', '', '*');
if str='' then Exit;
xRunQuery(Qr_Temp, 'SELECT PASSWORD FROM PosOperators WHERE ID='''+xCurrUser+'''');
if Qr_Temp.Fields[0].AsString=str then
OpenMoneyBox
else
Application.MessageBox('你是否忘记了你的口令，请仔细想想吧！', '口令错误', MB_OK+MB_ICONERROR);
}
end;
procedure TFmPOS.ActQueryExecute(Sender: TObject);
begin
edInput.SetFocus;
// FmMain.RActRetailQuery.Execute;
end;
procedure TFmPOS.ActExitExecute(Sender: TObject);
begin
if Application.MessageBox('真的下班了吗？别忘了退出本系统，以防止未授权用户使用收款系统！', '下班了？', MB_YESNO+MB_ICONQUESTION)=IDYES then
Close;
end;
procedure TFmPOS.SetOptHint(sHint: String);
begin
lbOptHint.Caption := sHint;
// lbOptHint.ScrollType := stNone;
lbOptHint.Scrolling := false;
Timer1.Enabled := false;
if sHint<>'' then begin
lbOptHint.Blinking := true;
Timer1.Interval := 5*(lbOptHint.BlinkIntervalOff+lbOptHint.BlinkIntervalOn);
Timer1.Enabled := true;
end;
end;
procedure TFmPOS.Timer1Timer(Sender: TObject);
begin
Timer1.Enabled := false;
lbOptHint.Blinking := false;
lbOptHint.Caption := '';
end;
procedure TFmPOS.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
var str: String;
begin
if Key=VK_F2 then begin
ActPrintPreBill.Execute;
end else if Key=VK_F3 then begin
ActOpenMoneyBox.Execute;
end else if Key=VK_F4 then begin
ActDel.Execute;
end else if Key=VK_F6 then begin
ActHangSaleBill.Execute;
end else if Key=VK_F8 then begin
{ if (not CkNoPrint.Checked) and LinePrintMode then
EndPrint;
ActNewBill.Execute;
if BuyerDispType in [0,1,4,5] then
BuyerDispOut(' Welcome!', '');
} end else if Key=VK_F9 then begin
str := edInput.Text;
// str := BrowGoods(str);
if str<>'' then begin
edInput.Text := str;
edInput.SetFocus;
end;
end;
end;
procedure TFmPOS.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
CanClose := Length(SaleGoodses)=0;
if not CanClose then begin
CanClose := Application.MessageBox('系统正处于开单状态，你确信退出吗？', '#正在编辑#', MB_YESNO+MB_ICONQUESTION)=IDYES;
end;
end;
procedure TFmPOS.ActNewBillExecute(Sender: TObject);
begin
Qr_Retail.Cancel;
Qr_RetailList.Cancel;
Qr_Retail.CancelBatch;
Qr_RetailList.CancelBatch;
NewBill;
end;
procedure TFmPOS.ActDelExecute(Sender: TObject);
const sqGoods = 'SELECT NAME, Remark FROM GOODSES ';
var n, i, k: Integer;
SaleInfo: TSaleGoodsInfo;
sGName: String;
begin
k := Length(SaleGoodses);
if lvSaleGoodses.Selected=nil then
n := lvSaleGoodses.Items.Count-1
else
n := lvSaleGoodses.Selected.Index;
if (n>=k) then begin
SaleGoods.Number := 1;
SaleGoods.Price := 0;
SaleGoods.Amount := 0;
SaleGoods.BornSum:= 0;
SaleGoods.Rebate := 0;
for i:=0 to lvSaleGoodses.Items[n].SubItems.Count-1 do
lvSaleGoodses.Items[n].SubItems[i] := '';
Exit;
end;
if k=0 then Exit;
SaleInfo := SaleGoodses[n];
for i:=n to k-2 do begin
SaleGoodses[i] := SaleGoodses[i+1];
end;
SetLength(SaleGoodses, k-1);
lvSaleGoodses.Items.Delete(n);
lvSaleGoodses.Selected := lvSaleGoodses.Items[n-1];
with SaleInfo do begin
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?