D7myzhenyong/应收应付/U_BP_ProblemList.pas
DESKTOP-E401PHE\Administrator 237de1c308 0
2025-08-26 15:25:51 +08:00

537 lines
14 KiB
ObjectPascal
Raw Permalink Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

unit U_BP_ProblemList;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxGraphics, cxCustomData, cxStyles, cxTL, cxMaskEdit, DB, ADODB,
cxInplaceContainer, cxDBTL, cxControls, cxTLData, ComCtrls, ToolWin, StdCtrls,
cxFilter, cxData, cxDataStorage, cxEdit, cxDBData, DBClient,
cxGridCustomTableView, cxGridTableView, cxGridDBTableView, ExtCtrls,
cxSplitter, cxGridLevel, cxClasses, cxGridCustomView, cxGrid,
cxGridCustomPopupMenu, cxGridPopupMenu, RM_Dataset, RM_System, RM_Common,
RM_Class, RM_GridReport, IdBaseComponent, IdComponent, IdTCPConnection,
IdTCPClient, IdFTP, ShellAPI, IniFiles, cxCheckBox, cxCalendar, cxButtonEdit,
cxTextEdit, cxPC, cxLookAndFeels, cxLookAndFeelPainters, cxNavigator,
dxBarBuiltInMenu;
type
TfrmBP_ProblemList = class(TForm)
ToolBar1: TToolBar;
TBRafresh: TToolButton;
TBDel: TToolButton;
TBClose: TToolButton;
ADOQueryTemp: TADOQuery;
ADOQueryCmd: TADOQuery;
Panel1: TPanel;
TBfind: TToolButton;
ADOQueryMain: TADOQuery;
TBexcel: TToolButton;
RM1: TRMGridReport;
RMDB_MD: TRMDBDataSet;
Label3: TLabel;
cxGrid2: TcxGrid;
Tv2: TcxGridDBTableView;
v2Column4: TcxGridDBColumn;
cxGridLevel1: TcxGridLevel;
Label2: TLabel;
Label6: TLabel;
begdate: TDateTimePicker;
Enddate: TDateTimePicker;
cxGridPopupMenu2: TcxGridPopupMenu;
DS_HZ: TDataSource;
CDS_HZ: TClientDataSet;
TBAdd: TToolButton;
TBEdit: TToolButton;
C_CodeName: TEdit;
ywy: TEdit;
v2Column3: TcxGridDBColumn;
v2Column7: TcxGridDBColumn;
v2Column8: TcxGridDBColumn;
v2Column10: TcxGridDBColumn;
v2Column11: TcxGridDBColumn;
v2Column12: TcxGridDBColumn;
v2Column13: TcxGridDBColumn;
v2Column14: TcxGridDBColumn;
v2Column15: TcxGridDBColumn;
Label5: TLabel;
v2Column16: TcxGridDBColumn;
ToolButton1: TToolButton;
cxTabControl1: TcxTabControl;
TBChk: TToolButton;
TBNochk: TToolButton;
v2Column17: TcxGridDBColumn;
TBPrint: TToolButton;
AdoPrint: TADOQuery;
Tv2Column1: TcxGridDBColumn;
Label1: TLabel;
SDNO: TEdit;
Label4: TLabel;
SCOrderNo: TEdit;
Tv2Column2: TcxGridDBColumn;
procedure FormDestroy(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure TBCloseClick(Sender: TObject);
procedure TBDelClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure TBRafreshClick(Sender: TObject);
procedure TBfindClick(Sender: TObject);
procedure TBexcelClick(Sender: TObject);
procedure TBAddClick(Sender: TObject);
procedure FeeTypeChange(Sender: TObject);
procedure TBEditClick(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure TBChkClick(Sender: TObject);
procedure TBNochkClick(Sender: TObject);
procedure cxTabControl1Change(Sender: TObject);
procedure TBPrintClick(Sender: TObject);
private
{ Private declarations }
procedure InitGrid();
procedure SetStatus();
function YSData(): Boolean;
public
fSYRName: string;
fflag: integer;
canshu1: string;
{ Public declarations }
end;
var
frmBP_ProblemList: TfrmBP_ProblemList;
implementation
uses
U_DataLink, U_Fun, U_ZDYHelp, U_BP_ProblemEdit, U_FjList10;
{$R *.dfm}
function TfrmBP_ProblemList.YSData(): Boolean;
var
CRID, YFID, Price, PriceUnit, OrderUnit, FComTaiTou: string;
begin
Result := False;
with ADOQueryTemp do
begin
Close;
SQL.Clear;
sql.Add('select * from YF_Money_KC where FactoryName=''' + Trim(CDS_HZ.fieldbyname('factoryname').asstring) + '''');
sql.Add(' and YFDefFlag1=0 ');
Open;
end;
if not ADOQueryTemp.IsEmpty then
begin
CRID := ADOQueryTemp.fieldbyname('CRID').AsString;
end
else
begin
with ADOQueryCmd do
begin
Close;
sql.Clear;
sql.Add('Update YF_Money_CRID set CRID=CRID+1');
sql.Add('select * from YF_Money_CRID ');
Open;
end;
CRID := ADOQueryCmd.fieldbyname('CRID').AsString;
with ADOQueryCmd do
begin
Close;
SQL.Clear;
sql.Add('select * from YF_Money_KC where 1<>1');
Open;
end;
with ADOQueryCmd do
begin
Append;
FieldByName('CRID').Value := StrToInt(CRID);
FieldByName('FactoryName').Value := Trim(CDS_HZ.fieldbyname('factoryname').asstring);
FieldByName('ZdyStr1').Value := <><D3A6><EFBFBD><EFBFBD>';
Post;
end;
end;
with ADOQueryCmd do
begin
Close;
sql.Clear;
sql.Add('delete from YF_Money_CR where MainID=''' + Trim(CDS_HZ.fieldbyname('CRNO').asstring) + ''' and YFName=''<27><><EFBFBD><EFBFBD>'' and isnull(mainID,'''')<>'''' ');
execsql;
end;
if GetLSNo(ADOQueryCmd, YFID, 'CS', 'YF_Money_CR', 3, 1) = False then
begin
Application.MessageBox('ȡӦ<C8A1><D3A6><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ʧ<EFBFBD><CAA7>!', '<27><>ʾ', 0);
Exit;
end;
with ADOQueryCmd do
begin
Close;
sql.Clear;
sql.Add('select * from YF_Money_CR where 1=2');
Open;
end;
with ADOQueryCmd do
begin
Append;
FieldByName('YFID').Value := Trim(YFID);
FieldByName('YFTypeId').Value := Trim(CDS_HZ.fieldbyname('CRNO').asstring);
FieldByName('CRID').Value := StrToInt(CRID);
FieldByName('Filler').Value := Trim(DName);
FieldByName('CRType').Value := <>տ<EFBFBD><D5BF>Ǽ<EFBFBD>';
FieldByName('CRFlag').Value := <><D3A6><EFBFBD><EFBFBD>';
FieldByName('QtyFlag').Value := 1;
FieldByName('FactoryName').Value := Trim(CDS_HZ.fieldbyname('factoryName').asstring);
FieldByName('CRTime').Value := Trim(FormatDateTime('yyyy-MM-dd', CDS_HZ.fieldbyname('CRTime').AsDateTime));
FieldByName('YFType').Value := '<27>Զ<EFBFBD><D4B6><EFBFBD><EFBFBD><EFBFBD>';
FieldByName('Price').Value := 0;
FieldByName('PS').Value := -1 * 1;
FieldByName('Qty').Value := -1 * CDS_HZ.fieldbyname('Qty').AsFloat;
FieldByName('Price').Value := CDS_HZ.fieldbyname('Price').AsFloat;
FieldByName('money').Value := CDS_HZ.fieldbyname('money').AsFloat;
FieldByName('BBmoney').Value := CDS_HZ.fieldbyname('money').AsFloat;
FieldByName('P_CodeName').Value := CDS_HZ.fieldbyname('C_CodeName').AsString;
FieldByName('P_Color').Value := CDS_HZ.fieldbyname('C_Color').AsString;
FieldByName('HuiLv').Value := 1;
FieldByName('BZType').Value := '<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>';
FieldByName('QtyUnit').Value := CDS_HZ.fieldbyname('QtyUnit').AsString;
FieldByName('ComTaiTou').Value := Trim(CDS_HZ.fieldbyname('factoryName').asstring);
FieldByName('YFName').Value := '<27><><EFBFBD><EFBFBD>';
FieldByName('MainId').Value := Trim(CDS_HZ.fieldbyname('CRNO').asstring);
FieldByName('subID').Value := '';
FieldByName('SYRName').Value := '<27><>ǿ<EFBFBD>ֻ<EFBFBD>';
FieldByName('note').Value := CDS_HZ.fieldbyname('Note').AsString;
FieldByName('status').Value := '0';
Post;
end;
Result := True;
end;
procedure TfrmBP_ProblemList.SetStatus();
begin
TBedit.Visible := false;
TBdel.Visible := false;
TBchk.Visible := false;
TBnochk.Visible := false;
if canshu1 = <><D2B5>Ա<EFBFBD>Ǽ<EFBFBD>' then
begin
case cxTabControl1.TabIndex of
0:
begin
TBedit.Visible := true;
TBdel.Visible := true;
end;
1:
begin
end;
2:
begin
end;
end;
end
else
begin
case cxTabControl1.TabIndex of
0:
begin
TBedit.Visible := true;
TBdel.Visible := true;
TBchk.Visible := true;
end;
1:
begin
TBnochk.Visible := true;
end;
2:
begin
end;
end;
end;
end;
procedure TfrmBP_ProblemList.InitGrid();
begin
try
ADOQueryMain.DisableControls;
with ADOQueryMain do
begin
Close;
Filtered := False;
SQL.Clear;
sql.Add(' select A.* from BP_Problem A ');
sql.Add('where CRTime>=''' + FormatDateTime('yyyy-MM-dd', BegDate.DateTime) + ''' ');
sql.Add('and CRTime<''' + FormatDateTime('yyyy-MM-dd', enddate.DateTime + 1) + ''' ');
sql.Add('and CRFlag=''<27><><EFBFBD><EFBFBD><EFBFBD>Ǽ<EFBFBD>''');
if cxTabControl1.TabIndex < 2 then
begin
sql.Add('and status=''' + inttostr(cxTabControl1.TabIndex) + ''' ');
end;
Open;
end;
SCreateCDS20(ADOQueryMain, CDS_HZ);
SInitCDSData20(ADOQueryMain, CDS_HZ);
finally
ADOQueryMain.EnableControls;
TBfind.Click;
end;
end;
procedure TfrmBP_ProblemList.FormDestroy(Sender: TObject);
begin
frmBP_ProblemList := nil;
end;
procedure TfrmBP_ProblemList.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action := caFree;
end;
procedure TfrmBP_ProblemList.TBCloseClick(Sender: TObject);
begin
WriteCxGrid(Self.Caption + Tv2.Name, Tv2);
Close;
end;
procedure TfrmBP_ProblemList.TBDelClick(Sender: TObject);
begin
if CDS_HZ.IsEmpty then
Exit;
if Application.MessageBox(<><C8B7>Ҫɾ<D2AA><C9BE><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>', '<27><>ʾ', 32 + 4) <> IDYES then
Exit;
try
ADOQueryCmd.Connection.BeginTrans;
with ADOQueryCmd do
begin
close;
sql.Clear;
sql.Add(' delete BP_Problem where CRNO=''' + Trim(CDS_HZ.fieldbyname('CRNO').AsString) + ''' ');
execsql;
end;
ADOQueryCmd.Connection.CommitTrans;
InitGrid();
except
ADOQueryCmd.Connection.RollbackTrans;
application.MessageBox('<27><><EFBFBD><EFBFBD>ʧ<EFBFBD>ܣ<EFBFBD>', '<27><>ʾ<EFBFBD><CABE>Ϣ', 0);
end;
end;
procedure TfrmBP_ProblemList.FormShow(Sender: TObject);
begin
ReadCxGrid(Self.Caption + Tv2.Name, Tv2);
Enddate.DateTime := SGetServerDate(ADOQueryTemp);
begdate.DateTime := Enddate.DateTime;
if canshu1 = <><D2B5>Ա<EFBFBD>Ǽ<EFBFBD>' then
begin
ywy.text := trim(DName);
ywy.Enabled := false;
end;
SetStatus();
initGrid();
end;
procedure TfrmBP_ProblemList.TBRafreshClick(Sender: TObject);
begin
InitGrid();
end;
procedure TfrmBP_ProblemList.TBfindClick(Sender: TObject);
begin
if ADOQueryMain.Active = False then
Exit;
SDofilter(ADOQueryMain, SGetFilters(Panel1, 1, 2));
SCreateCDS20(ADOQueryMain, CDS_HZ);
SInitCDSData20(ADOQueryMain, CDS_HZ);
end;
procedure TfrmBP_ProblemList.TBexcelClick(Sender: TObject);
begin
if ADOQueryMain.IsEmpty then
Exit;
TcxGridToExcel(self.Caption, cxgrid2);
end;
procedure TfrmBP_ProblemList.TBAddClick(Sender: TObject);
begin
try
frmBP_ProblemEdit := TfrmBP_ProblemEdit.Create(Application);
with frmBP_ProblemEdit do
begin
fkeyNo := '';
fflag := self.fflag;
fSyrname := self.fSYRName;
canshu1 := self.canshu1;
if ShowModal = 1 then
begin
Self.InitGrid();
end;
end;
finally
frmBP_ProblemEdit.Free;
end;
end;
procedure TfrmBP_ProblemList.FeeTypeChange(Sender: TObject);
begin
TBfind.Click;
end;
procedure TfrmBP_ProblemList.TBEditClick(Sender: TObject);
begin
if CDS_HZ.IsEmpty then
exit;
try
frmBP_ProblemEdit := TfrmBP_ProblemEdit.Create(Application);
with frmBP_ProblemEdit do
begin
fkeyNo := Trim(Self.CDS_HZ.FieldByName('CRNO').AsString);
fflag := self.fflag;
fSyrname := self.fSYRName;
canshu1 := self.canshu1;
if ShowModal = 1 then
begin
Self.InitGrid();
end;
end;
finally
frmBP_ProblemEdit.Free;
end;
end;
procedure TfrmBP_ProblemList.ToolButton1Click(Sender: TObject);
begin
if CDS_HZ.IsEmpty then
Exit;
try
frmFjList10 := TfrmFjList10.Create(Application);
with frmFjList10 do
begin
// PState:=1;
// if Trim(canshu1)<>'<27><>Ȩ<EFBFBD><C8A8>' then cxButton1.Visible:=false;
fkeyNO := Trim(Self.CDS_HZ.fieldbyname('CRNO').AsString);
fType := '<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ϣ';
if ShowModal = 1 then
begin
end;
end;
finally
frmFjList10.Free;
end;
end;
procedure TfrmBP_ProblemList.TBChkClick(Sender: TObject);
begin
if CDS_HZ.IsEmpty then
Exit;
ADOQueryCmd.Connection.BeginTrans;
try
with ADOQueryCmd do
begin
close;
sql.Clear;
sql.Add('update BP_Problem SET status=''1'' ');
sql.Add('where CRNo=' + quotedstr(trim(CDS_HZ.fieldbyname('CRNo').AsString)));
execsql;
end;
// IF not YSData() then
// begin
// ADOQueryCmd.Connection.RollbackTrans;
// application.MessageBox('<27><><EFBFBD><EFBFBD>Ӧ<EFBFBD>տ<EFBFBD>ʧ<EFBFBD>ܣ<EFBFBD>','<27><>ʾ<EFBFBD><CABE>Ϣ',0);
// exit;
// end;
ADOQueryCmd.Connection.CommitTrans;
// application.MessageBox('<27><><EFBFBD>˳<EFBFBD><CBB3><EFBFBD><EFBFBD>ɹ<EFBFBD><C9B9><EFBFBD>','<27><>ʾ<EFBFBD><CABE>Ϣ');
TBRafresh.Click;
except
ADOQueryCmd.Connection.RollbackTrans;
application.MessageBox('<27><><EFBFBD><EFBFBD>ʧ<EFBFBD>ܣ<EFBFBD>', '<27><>ʾ<EFBFBD><CABE>Ϣ', 0);
end;
end;
procedure TfrmBP_ProblemList.TBNochkClick(Sender: TObject);
begin
if CDS_HZ.IsEmpty then
Exit;
try
with ADOQueryCmd do
begin
close;
sql.Clear;
sql.Add('update BP_Problem SET status=''0'' where CRNo=' + quotedstr(trim(CDS_HZ.fieldbyname('CRNo').AsString)));
// sql.Add('delete from YF_Money_CR where MainID='''+Trim(CDS_HZ.fieldbyname('CRNO').asstring)+''' and YFName=''<27><><EFBFBD><EFBFBD>'' and isnull(mainID,'''')<>'''' ');
execsql;
end;
// application.MessageBox('<27><><EFBFBD>˳<EFBFBD><CBB3><EFBFBD><EFBFBD>ɹ<EFBFBD><C9B9><EFBFBD>','<27><>ʾ<EFBFBD><CABE>Ϣ');
TBRafresh.Click;
except
application.MessageBox('<27><><EFBFBD>˳<EFBFBD><CBB3><EFBFBD>ʧ<EFBFBD>ܣ<EFBFBD>', '<27><>ʾ<EFBFBD><CABE>Ϣ', 0);
end;
end;
procedure TfrmBP_ProblemList.cxTabControl1Change(Sender: TObject);
begin
SetStatus();
initGrid();
end;
procedure TfrmBP_ProblemList.TBPrintClick(Sender: TObject);
var
filepath: string;
i: integer;
Txt, fImagePath: string;
Moudle: THandle;
Makebar: TMakebar;
Mixtext: TMixtext;
begin
if CDS_HZ.IsEmpty then
exit;
filepath := ExtractFilePath(Application.ExeName) + 'report\<5C><>Ʒ<EFBFBD><C6B7><EFBFBD><EFBFBD><EFBFBD><EFBFBD>.rmf';
if not FileExists(Pchar(filepath)) then
begin
application.MessageBox(pchar('<27>ļ<EFBFBD>[' + filepath + ']<5D><><EFBFBD><EFBFBD><EFBFBD>ڣ<EFBFBD>'), '<27><>ʾ<EFBFBD><CABE>Ϣ', MB_IConError);
exit;
end;
with AdoPrint do
begin
close;
sql.Clear;
sql.Add('select * from BP_Problem');
sql.Add('where CRNo=' + quotedstr(trim(CDS_HZ.fieldbyname('CRNo').AsString)));
open;
end;
try
Moudle := LoadLibrary('MakeQRBarcode.dll');
@Makebar := GetProcAddress(Moudle, 'Make');
@Mixtext := GetProcAddress(Moudle, 'MixText');
Txt := Trim(AdoPrint.fieldbyname('CRNO').AsString);
fImagePath := ExtractFilePath(Application.ExeName) + 'image\temp.bmp';
if not DirectoryExists(pchar(ExtractFilePath(Application.ExeName) + 'image')) then
CreateDirectory(pchar(ExtractFilePath(Application.ExeName) + 'image'), nil);
if FileExists(fImagePath) then
DeleteFile(fImagePath);
Makebar(pchar(Txt), Length(Txt), 3, 3, 0, PChar(fImagePath), 3);
except
application.MessageBox('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ʧ<EFBFBD>ܣ<EFBFBD>', '<27><>ʾ<EFBFBD><CABE>Ϣ', MB_ICONERROR);
exit;
end;
RMVariables['QRBARCODE'] := fImagePath;
RMVariables['dtxz'] := FormatDateTime('yyyy-mm-dd', date());
RMVariables['zdr'] := trim(DName);
RM1.LoadFromFile(filepath);
RM1.ShowReport;
end;
end.