RTFormwork/public10/design/U_PageBaseList.pas
“ddf” f2a94cb7b0 1
2024-11-15 17:18:34 +08:00

560 lines
16 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_PageBaseList;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls, Vcl.ToolWin, cxGraphics,
cxControls, cxLookAndFeels, cxLookAndFeelPainters, U_WindowFormdesign,
cxStyles, cxCustomData, cxFilter, cxData,
cxDataStorage, cxEdit, cxNavigator, dxDateRanges, dxScrollbarAnnotations,
Data.DB, cxDBData, cxGridLevel, cxGridCustomTableView, cxGridTableView,
cxGridDBTableView, cxClasses, cxGridCustomView, cxGrid, Data.Win.ADODB,math,
dxBarBuiltInMenu, cxGridCustomPopupMenu, cxGridPopupMenu, cxCheckBox,
cxContainer, dxCore, cxDateUtils, dxLayoutcxEditAdapters, dxLayoutContainer,
cxMaskEdit, cxDropDownEdit, cxCalendar, cxTextEdit, dxLayoutControl,
FrameDateSel, Datasnap.DBClient, cxMemo, Vcl.StdCtrls, Vcl.ExtCtrls,
cxGeometry, dxFramedControl, dxPanel, FrameDateSel10, cxPC, MovePanel;
type
TfrmPageBaseList = class(TForm)
ToolBar3: TToolBar;
Trefresh: TToolButton;
Tprint: TToolButton;
TprintGrid: TToolButton;
TsaveGrid: TToolButton;
Tclose: TToolButton;
DataSource1: TDataSource;
ADOQueryList1: TADOQuery;
cxGridPopupMenu1: TcxGridPopupMenu;
ADOQueryBaseCmd: TADOQuery;
ADOQueryBaseTemp: TADOQuery;
CDS_List1: TClientDataSet;
Panel_page: TPanel;
BTNP: TButton;
LBCPAP: TLabel;
BTLP: TButton;
TCBNOR: TcxComboBox;
Label31: TLabel;
frmFrameDateSel1: TfrmFrameDateSel10;
TgridSet: TToolButton;
Tadd: TToolButton;
Tooledit: TToolButton;
ToolDel: TToolButton;
Toolzdy4: TToolButton;
Toolzdy5: TToolButton;
Toolzdy1: TToolButton;
Toolzdy2: TToolButton;
Toolzdy3: TToolButton;
cxPageControl1: TcxPageControl;
cxTabSheet1: TcxTabSheet;
cxTabSheet2: TcxTabSheet;
dxLayoutControl2: TdxLayoutControl;
dxLayoutControl2Group_Root: TdxLayoutGroup;
dxLayoutControl1: TdxLayoutControl;
dxLayoutGroup1: TdxLayoutGroup;
cxGrid1: TcxGrid;
tv1: TcxGridDBTableView;
cxGrid1Level1: TcxGridLevel;
cxGrid2: TcxGrid;
tv2: TcxGridDBTableView;
cxGridLevel1: TcxGridLevel;
DataSource2: TDataSource;
ADOQueryList2: TADOQuery;
CDS_List2: TClientDataSet;
cxProgressBar1: TMovePanel;
Toolzdy6: TToolButton;
Toolzdy7: TToolButton;
Toolzdy8: TToolButton;
Toolzdy9: TToolButton;
Toolzdy10: TToolButton;
Toolzdy11: TToolButton;
Toolzdy12: TToolButton;
Toolzdy13: TToolButton;
Toolzdy14: TToolButton;
Toolzdy15: TToolButton;
Toolzdy16: TToolButton;
Toolzdy17: TToolButton;
Toolzdy18: TToolButton;
Toolzdy19: TToolButton;
Toolzdy20: TToolButton;
procedure TrefreshClick(Sender: TObject);
procedure TprintClick(Sender: TObject);
procedure TprintGridClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure TcloseClick(Sender: TObject);
procedure TsaveGridClick(Sender: TObject);
procedure BTLPClick(Sender: TObject);
procedure BTNPClick(Sender: TObject);
procedure TCBNORPropertiesChange(Sender: TObject);
procedure TgridSetClick(Sender: TObject);
procedure dxLayoutControl2DblClick(Sender: TObject);
private
fWindowDesign: TWindowFormdesign;
CurrentPage, RecordsNumber: Integer;
fDesignCode:string;
procedure doQuery1();
procedure doQuery1ByCriteria();
procedure doQuery2();
procedure doQuery2ByCriteria();
procedure initGrid();
protected
fParameters1: string;
fParameters2: string;
fParameters3: string;
fParameters4: string;
fParameters5: string;
fParameters10: string;
public
fFormId: integer;
fProcedureName1:string; //<2F><EFBFBD><E6B4A2><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>1
fProcedureName2:string; //<2F><EFBFBD><E6B4A2><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>2
FLMType:string; //<2F><><EFBFBD><EFBFBD><EFBFBD>ļ<EFBFBD><C4BC><EFBFBD><EFBFBD>ͱ<EFBFBD>־
ftimeType:string; //<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
fQueryType:String; //<2F><>ѯ<EFBFBD><D1AF><EFBFBD><EFBFBD>
FFiltration1:string; //<2F><>ӡ<EFBFBD><D3A1><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
fCriteria:string; //<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
constructor Create(AOwner: TComponent; ACaption: string=''; Parameters1: string=''; Parameters2: string=''; Parameters3: string=''; Parameters4: string=''; Parameters5: string=''; Parameters10: string='';FormID:Integer=0);
end;
var
frmPageBaseList: TfrmPageBaseList;
implementation
uses
U_RTFun, U_globalVar, U_dataLink,U_FormLayOutDesign, U_LabelPrint;
{$R *.dfm}
procedure TfrmPageBaseList.BTLPClick(Sender: TObject);
begin
if CurrentPage > 1 then
CurrentPage := CurrentPage - 1;
if cxPageControl1.ActivePageIndex=0 then
doQuery1()
else
doQuery2() ;
end;
procedure TfrmPageBaseList.BTNPClick(Sender: TObject);
begin
if cxPageControl1.ActivePageIndex=0 then
begin
if CurrentPage < cds_List1.FieldByName('TotalCount').AsInteger / RecordsNumber then
CurrentPage := CurrentPage + 1;
doQuery1();
end
else
begin
if CurrentPage < cds_List2.FieldByName('TotalCount').AsInteger / RecordsNumber then
CurrentPage := CurrentPage + 1;
doQuery2();
end;
end;
constructor TfrmPageBaseList.Create(AOwner: TComponent; ACaption: string=''; Parameters1: string=''; Parameters2: string=''; Parameters3: string=''; Parameters4: string=''; Parameters5: string=''; Parameters10: string='';FormID:Integer=0);
begin
inherited Create(AOwner);
if ACaption <> '' then
Caption := ACaption;
fParameters1 := Parameters1;
fParameters2 := Parameters2;
fParameters3 := Parameters3;
fParameters4 := Parameters4;
fParameters5 := Parameters5;
fParameters10 := Parameters10;
fFormId:= FormID ;
end;
procedure TfrmPageBaseList.TCBNORPropertiesChange(Sender: TObject);
begin
RecordsNumber := StrToInt(TCBNOR.Text);
CurrentPage := 1;
initGrid();
end;
procedure TfrmPageBaseList.TcloseClick(Sender: TObject);
begin
close;
end;
procedure TfrmPageBaseList.TgridSetClick(Sender: TObject);
begin
fWindowDesign.OpenGridDesignWin10(fDesignCode,'cxgrid1',tv1);
end;
procedure TfrmPageBaseList.TprintClick(Sender: TObject);
begin
if cds_List1.IsEmpty then
Exit;
TcxGridToExcel(self.Caption, cxgrid1);
end;
procedure TfrmPageBaseList.TprintGridClick(Sender: TObject);
begin
if cds_List1.IsEmpty then
Exit;
if trim(self.FLMType)='' then
begin
application.MessageBox(<><CEB4><EFBFBD>ô<EFBFBD>ӡ<EFBFBD><D3A1><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>,<2C><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>!','<27><>ʾ<EFBFBD><CABE>Ϣ',0);
exit;
end;
try
frmLabelPrint := TfrmLabelPrint.Create(Application);
with frmLabelPrint do
begin
FLMType := self.FLMType;
FFiltration1 := self.FFiltration1;
if ShowModal = 1 then
begin
// Self.InitGrid();
end;
end;
finally
frmLabelPrint.Free;
end;
end;
procedure TfrmPageBaseList.TrefreshClick(Sender: TObject);
begin
if frmFrameDateSel1.BegDate.Visible then
begin
frmFrameDateSel1.BegDate.SetFocus;
end;
CurrentPage := 1;
initGrid();
end;
procedure TfrmPageBaseList.TsaveGridClick(Sender: TObject);
begin
if cxPageControl1.ActivePageIndex=0 then
WriteCxGrid(trim(self.Caption) + 'Tv1', Tv1, gDllFileCaption)
else
WriteCxGrid(trim(self.Caption) + 'Tv2', Tv2, gDllFileCaption) ;
if gIsCanDesign then
begin
if cxPageControl1.ActivePageIndex=0 then
saveLayOut(application, dxLayoutControl1, ADOQueryBaseCmd,PWideChar( fDllFileName + '|' + Self.Name + '|' + dxLayoutControl1.Name + '.ini'))
else
saveLayOut(application, dxLayoutControl2, ADOQueryBaseCmd,PWideChar( fDllFileName + '|' + Self.Name + '|' + dxLayoutControl2.Name + '.ini'));
end;
end;
////////////////////////////////////
procedure TfrmPageBaseList.doQuery1();
var
strwhere: string;
begin
if fProcedureName1='' then
begin
application.MessageBox('<27><EFBFBD><E6B4A2><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ʋ<EFBFBD><C6B2><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ϊ<EFBFBD><CEAA>!','<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ϣ',0);
exit;
end;
strwhere := GetProcedureParam(dxLayoutControl1);
try
cxProgressBar1.Visible:=true;
cxProgressBar1.Refresh ;
Tv1.BeginUpdate();
CDS_List1.DisableControls;
with ADOQueryList1 do
begin
close;
Filtered := false;
sql.Clear;
sql.Add('exec '+fProcedureName1);
sql.Add('@timeType='+quotedstr(fTimeType));
sql.Add(',@begDate='+quotedstr(FormatDateTime('yyyy-MM-dd', frmFrameDateSel1.begdate.Date)));
sql.Add(',@endDate='+quotedstr(FormatDateTime('yyyy-MM-dd', frmFrameDateSel1.enddate.Date+1)));
if frmFrameDateSel1.jqModel.Checked then
sql.Add(',@jqModel=1')
else
sql.Add(',@jqModel=0');
if Panel_page.Visible then
begin
sql.Add(',@pageIndex=' + inttostr(CurrentPage));
sql.Add(',@pageSize=' + inttostr(RecordsNumber));
end;
sql.Add(',@criteria='+ quotedstr(fcriteria));
if strwhere<>'' then
sql.Add(','+strwhere);
// showMessage(sql.Text);
//cxMemo1.Text:= sql.Text ;
open;
end;
SCreateCDS(ADOQueryList1, CDS_List1);
SInitCDSData(ADOQueryList1, CDS_List1);
if Panel_page.Visible then
begin
LBCPAP.Caption := inttostr(CurrentPage) + '/' + inttostr(ceil(cds_list1.FieldByName('TotalCount').AsInteger / RecordsNumber));
end;
finally
CDS_List1.EnableControls;
Tv1.EndUpdate;
cxProgressBar1.Visible:=false;
end;
end;
////////////////////////////////////
procedure TfrmPageBaseList.doQuery2();
var
strwhere: string;
begin
if fProcedureName2='' then
begin
application.MessageBox('<27><EFBFBD><E6B4A2><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ʋ<EFBFBD><C6B2><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ϊ<EFBFBD><CEAA>!','<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ϣ',0);
exit;
end;
strwhere := GetProcedureParam(dxLayoutControl2);
try
cxProgressBar1.Visible:=true;
cxProgressBar1.Refresh ;
Tv2.BeginUpdate();
CDS_List2.DisableControls;
with ADOQueryList2 do
begin
close;
Filtered := false;
sql.Clear;
sql.Add('exec '+fProcedureName1);
sql.Add('@timeType='+quotedstr(fTimeType));
sql.Add(',@begDate='+quotedstr(FormatDateTime('yyyy-MM-dd', frmFrameDateSel1.begdate.Date)));
sql.Add(',@endDate='+quotedstr(FormatDateTime('yyyy-MM-dd', frmFrameDateSel1.enddate.Date+1)));
if frmFrameDateSel1.jqModel.Checked then
sql.Add(',@jqModel=1')
else
sql.Add(',@jqModel=0');
if Panel_page.Visible then
begin
sql.Add(',@pageIndex=' + inttostr(CurrentPage));
sql.Add(',@pageSize=' + inttostr(RecordsNumber));
end;
sql.Add(',@criteria='+ quotedstr(fcriteria));
if strwhere<>'' then
sql.Add(','+strwhere);
// showMessage(sql.Text);
//cxMemo1.Text:= sql.Text ;
open;
end;
SCreateCDS(ADOQueryList2, CDS_List2);
SInitCDSData(ADOQueryList2, CDS_List2);
if Panel_page.Visible then
begin
LBCPAP.Caption := inttostr(CurrentPage) + '/' + inttostr(ceil(cds_list2.FieldByName('TotalCount').AsInteger / RecordsNumber));
end;
finally
CDS_List2.EnableControls;
Tv2.EndUpdate;
cxProgressBar1.Visible:=false;
end;
end;
////////////////////////////////////
procedure TfrmPageBaseList.doQuery1ByCriteria();
var
mSqlWhere: string;
begin
if fProcedureName1='' then
begin
application.MessageBox('<27><EFBFBD><E6B4A2><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ʋ<EFBFBD><C6B2><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ϊ<EFBFBD><CEAA>!','<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ϣ',0);
exit;
end;
mSqlWhere := SLGetFilters(dxLayoutControl1, 1, 2);
if trim(mSqlWhere) <> '' then
begin
mSqlWhere := ' and ' + trim(mSqlWhere);
end;
mSqlWhere:=fCriteria + ' ' + mSqlWhere ;
try
cxProgressBar1.Visible:=true;
cxProgressBar1.Refresh ;
Tv1.BeginUpdate();
CDS_List1.DisableControls;
with ADOQueryList1 do
begin
close;
Filtered := false;
sql.Clear;
sql.Add('exec '+fProcedureName1);
sql.Add('@timeType='+quotedstr(fTimeType));
sql.Add(',@begDate='+quotedstr(FormatDateTime('yyyy-MM-dd', frmFrameDateSel1.begdate.Date)));
sql.Add(',@endDate='+quotedstr(FormatDateTime('yyyy-MM-dd', frmFrameDateSel1.enddate.Date+1)));
if Panel_page.Visible then
begin
sql.Add(',@pageIndex=' + inttostr(CurrentPage));
sql.Add(',@pageSize=' + inttostr(RecordsNumber));
end;
sql.Add(',@criteria='+ quotedstr(mSqlWhere));
//cxMemo1.Text:= sql.Text ;
open;
end;
SCreateCDS(ADOQueryList1, CDS_List1);
SInitCDSData(ADOQueryList1, CDS_List1);
if Panel_page.Visible then
begin
LBCPAP.Caption := inttostr(CurrentPage) + '/' + inttostr(ceil(cds_list1.FieldByName('TotalCount').AsInteger / RecordsNumber));
end;
finally
CDS_List1.EnableControls;
Tv1.EndUpdate;
cxProgressBar1.Visible:=false;
end;
end;
////////////////////////////////////
procedure TfrmPageBaseList.doQuery2ByCriteria();
var
mSqlWhere: string;
begin
if fProcedureName2='' then
begin
application.MessageBox('<27><EFBFBD><E6B4A2><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ʋ<EFBFBD><C6B2><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ϊ<EFBFBD><CEAA>!','<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ϣ',0);
exit;
end;
mSqlWhere := SLGetFilters(dxLayoutControl2, 1, 2);
if trim(mSqlWhere) <> '' then
begin
mSqlWhere := ' and ' + trim(mSqlWhere);
end;
mSqlWhere:=fCriteria + ' ' + mSqlWhere ;
try
cxProgressBar1.Visible:=true;
cxProgressBar1.Refresh ;
Tv2.BeginUpdate();
CDS_List2.DisableControls;
with ADOQueryList2 do
begin
close;
Filtered := false;
sql.Clear;
sql.Add('exec '+fProcedureName1);
sql.Add('@timeType='+quotedstr(fTimeType));
sql.Add(',@begDate='+quotedstr(FormatDateTime('yyyy-MM-dd', frmFrameDateSel1.begdate.Date)));
sql.Add(',@endDate='+quotedstr(FormatDateTime('yyyy-MM-dd', frmFrameDateSel1.enddate.Date+1)));
if Panel_page.Visible then
begin
sql.Add(',@pageIndex=' + inttostr(CurrentPage));
sql.Add(',@pageSize=' + inttostr(RecordsNumber));
end;
sql.Add(',@criteria='+ quotedstr(mSqlWhere));
//cxMemo1.Text:= sql.Text ;
open;
end;
SCreateCDS(ADOQueryList2, CDS_List2);
SInitCDSData(ADOQueryList2, CDS_List2);
if Panel_page.Visible then
begin
LBCPAP.Caption := inttostr(CurrentPage) + '/' + inttostr(ceil(cds_list2.FieldByName('TotalCount').AsInteger / RecordsNumber));
end;
finally
CDS_List2.EnableControls;
Tv2.EndUpdate;
cxProgressBar1.Visible:=false;
end;
end;
procedure TfrmPageBaseList.dxLayoutControl2DblClick(Sender: TObject);
begin
layoutDesign(TdxLayoutControl(Sender),ADOQueryBaseCmd,PWideChar(dcode));
end;
///
procedure TfrmPageBaseList.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Sendmessage(application.MainForm.Handle, WM_CloseForm, 4, 0);
Action:=cafree;
end;
procedure TfrmPageBaseList.FormCreate(Sender: TObject);
var
mFontSize:integer;
begin
getSystemIni();
if gFontSize<9 then
begin
mFontSize := 12;
end
else
begin
mFontSize:=gFontSize ;
end;
self.Font.Size := gFontSize;
if trim(gFontName)<>'' then
self.Font.Name:=gFontName;
cxPageControl1.Align:=alClient;
CurrentPage := 1;
RecordsNumber := 500;
fWindowDesign := TWindowFormdesign.Create();
frmFrameDateSel1.begdate.Date:=SGetServerDate(ADOQueryBaseTemp);
frmFrameDateSel1.enddate.Date:=frmFrameDateSel1.begdate.Date;
end;
procedure TfrmPageBaseList.FormDestroy(Sender: TObject);
begin
fWindowDesign.free;
end;
procedure TfrmPageBaseList.FormShow(Sender: TObject);
begin
fDesignCode := fDllFileName +'|'+self.name+ '|' + intTostr(fformId);
if DParameters8<>'1' then
begin
fWindowDesign.FormStyleInit10(self, fFormId, ADOQueryBaseTemp, ADOQueryBaseCmd, '', fParameters10);
end;
TgridSet.Visible:=gIsCanDesign;
//<2F><><EFBFBD>Ӷ<EFBFBD>̬<EFBFBD><CCAC><EFBFBD><EFBFBD>
addQryContionByLay(ADOQueryBaseTemp,fformId,'cxgrid1',dxLayoutControl1,7);
addQryContionByLay(ADOQueryBaseTemp,fformId,'cxgrid2',dxLayoutControl2,7);
ReadCxGrid(trim(self.Caption) + 'Tv1', Tv1, gDllFileCaption);
ReadCxGrid(trim(self.Caption) + 'Tv2', Tv2, gDllFileCaption);
initGrid();
end;
///////////////////////////////
///
procedure TfrmPageBaseList.initGrid();
begin
if fProcedureName1='' then exit;
if fProcedureName2='' then exit;
if cxPageControl1.ActivePageIndex=0 then
begin
if fQueryType='criteria' then
begin
doQuery1ByCriteria() ;
end
else
begin
frmFrameDateSel1.jqModel.Checked:=true;
doQuery1() ;
end;
end
else
begin
if fQueryType='criteria' then
begin
doQuery2ByCriteria() ;
end
else
begin
frmFrameDateSel1.jqModel.Checked:=true;
doQuery2() ;
end;
end;
end;
end.