📄 ckglfrm.pas
字号:
unit CkglFrm;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, Tabnotbk, Grids, DBGrids, Db, ADODB, StdCtrls,
DBCtrls, Buttons, ExtCtrls, Spin;
type
TfrmCkgl = class(TForm)
tblRk: TADOTable;
tblCk: TADOTable;
tblTk: TADOTable;
tblDk: TADOTable;
tblJc: TADOTable;
tblGh: TADOTable;
tblPd: TADOTable;
dtpRkrq: TDateTimePicker;
dtpCkrq: TDateTimePicker;
dtpTkrq: TDateTimePicker;
dtpDkrq: TDateTimePicker;
dtpJcRq: TDateTimePicker;
dtpGhrq: TDateTimePicker;
dtpBeginDate: TDateTimePicker;
pgcMain: TPageControl;
shtRk: TTabSheet;
shtCk: TTabSheet;
shtTk: TTabSheet;
shtDk: TTabSheet;
shtJc: TTabSheet;
shtGh: TTabSheet;
shtPd: TTabSheet;
grdRk: TDBGrid;
grdCk: TDBGrid;
grdTk: TDBGrid;
grdDk: TDBGrid;
grdJc: TDBGrid;
grdGh: TDBGrid;
grdPd: TDBGrid;
pnlRkTop: TPanel;
pnlCkTop: TPanel;
pnlTkTop: TPanel;
pnlDcTop: TPanel;
pnlJcTop: TPanel;
pnlGhTop: TPanel;
pnlPdTop: TPanel;
dsRk: TDataSource;
dsCk: TDataSource;
dsTk: TDataSource;
dsDk: TDataSource;
dsGh: TDataSource;
dsJc: TDataSource;
dsPd: TDataSource;
mmoRk: TDBMemo;
pnlCkBottom: TPanel;
dbngCk: TDBNavigator;
pnlTkBottom: TPanel;
dbngTk: TDBNavigator;
pnlDcBottom: TPanel;
dbnaDk: TDBNavigator;
pnlGhBottom: TPanel;
dbngGh: TDBNavigator;
pnlJcBottom: TPanel;
dbngJc: TDBNavigator;
pnlRkBottom: TPanel;
dbngRk: TDBNavigator;
lblRkrq: TLabel;
lblCkrq: TLabel;
lblRhrq: TLabel;
lblPdrq: TLabel;
lblJcrq: TLabel;
lblRkPzh: TLabel;
lblCkPzh: TLabel;
lblTkPzh: TLabel;
lblDkPzh: TLabel;
lblJcPzh: TLabel;
lblGhPzh: TLabel;
mmoCk: TDBMemo;
mmoTk: TDBMemo;
mmoDk: TDBMemo;
mmoGh: TDBMemo;
mmoPd: TDBMemo;
mmoJc: TDBMemo;
btnPd: TButton;
Label1: TLabel;
dtpEndDate: TDateTimePicker;
Button1: TButton;
procedure FormShow(Sender: TObject);
procedure tblRkAfterInsert(DataSet: TDataSet);
procedure grdRkCellClick(Column: TColumn);
procedure dtpRkrqChange(Sender: TObject);
procedure tblRkAfterPost(DataSet: TDataSet);
procedure tblRkAfterEdit(DataSet: TDataSet);
procedure tblRkAfterDelete(DataSet: TDataSet);
procedure tblRkBeforePost(DataSet: TDataSet);
procedure btnPdClick(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure grdPdDrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState);
private
{ Private declarations }
public
{ Public declarations }
end;
implementation
{$R *.DFM}
uses
ConstUnt;
procedure TfrmCkgl.FormShow(Sender: TObject);
var
PtblTemp: ^TADOTable;
PdptTemp: ^TDateTimePicker;
PgrdTemp: ^TDBGrid;
I: Byte;
vHwlbLst: TStringList;
vPpcdLst: TStringList;
vHwggLst: TStringList;
vShrmLst: TStringList;
vKhmcLst: TStringList;
vYsfsLst: TStringList;
vGhsLst: TStringList;
vCklbLst: TStringList;
vJldwLst: TStringList;
vShdzLst: TStringList;
vJhrmLst: TStringList;
{$IFDEF __DEBUG}
BeTime: Real;
{$ENDIF}
begin
{$IFDEF __DEBUG}
BeTime := GetTickCount;
{$ENDIF}
//设置初始页面为“入库管理”页面
pgcMain.ActivePageIndex := 0;
with LogonInf do
begin
//将当前记录各个字段的值赋予相应的临时变量
vHwlbLst := HwlbLst;
vPpcdLst := PpcdLst;
vHwggLst := HwggLst;
vShrmLst := ShrmLst;
vKhmcLst := KhmcLst;
vYsfsLst := YsfsLst;
vGhsLst := GhsLst;
vCklbLst := CklbLst;
vJldwLst := JldwLst;
vShdzLst := ShdzLst;
vJhrmLst := JhrmLst;
end;
//将对应于入库表的adotable组件赋予相应的临时变量
PtblTemp := @tblRk;
PdptTemp := @dtpRkrq;
PgrdTemp := @grdRk;
//依次设置与入库表、出库表、退库表和借出表等相对应的TAdotable组件的connection属性,
//连接数据库ckgl,并使其返回ckgl数据库中相应表中的所有记录
for I := 0 to 5 do
begin
//设置PtblTemp的Connection属性,使其连接到ckgl数据库
PtblTemp^.Connection := LogonInf.dbCkgl;
//打开数据库ckgl
PtblTemp^.Open;
PdptTemp^.DateTime := Date;
with PgrdTemp^, LogonInf do
begin
//{
Columns[1].PickList := vHwlbLst;
Columns[2].PickList := vPpcdLst;
Columns[3].PickList := vHwggLst;
case I of
0:
begin
Columns[6].PickList := vShrmLst;
Columns[4].PickList := vGhsLst;
end;
1:
begin
Columns[4].PickList := vKhmcLst;
Columns[6].PickList := vShdzLst;
Columns[8].PickList := vYsfsLst;
end;
2: Columns[4].PickList := vGhsLst;
3: Columns[4].PickList := vCklbLst;
4, 5: Columns[4].PickList := vJhrmLst;
end;
Columns[5].PickList := vCklbLst;
Columns[7].PickList := vJldwLst;
//}
with pgcMain.Pages[I], FunctionLst do
TabVisible := Strings[I + 6] = 'True';
end;
Inc(PtblTemp);
Inc(PdptTemp);
Inc(PgrdTemp);
end;
dtpBeginDate.DateTime := Date - 1;
dtpEndDate.DateTime := Date;
//设置与盘点库对应的TAdotable组件的connection属性
tblPd.Connection := LogonInf.dbCkgl;
//连接数据库ckgl,并使其返回ckgl数据库中pd表中的所有记录
tblPd.Open;
with pgcMain.Pages[6], LogonInf.FunctionLst do
TabVisible := Strings[12] = 'True';
{$IFDEF __DEBUG}
BeTime := GetTickCount - BeTime;
BeTime := (Round((BeTime / 1000) * 100)) / 100;
ShowMessage(Format('%f 秒', [BeTime]));
{$ENDIF}
end;
procedure TfrmCkgl.tblRkAfterInsert(DataSet: TDataSet);
var
PdtpTemp: ^TDateTimePicker;
PgrdTemp: ^TDBGrid;
CurrIndex: Byte;
TableName: ShortString;
begin
//获得当前表的名称
TableName := Copy(DataSet.Name, 4, Length(DataSet.Name));
//获得当前活动页面的索引
CurrIndex := pgcMain.Pages[pgcMain.ActivePageIndex].TabIndex;
//设置新添加记录编号(bh)字段的值
DataSet.FieldByName('bh').AsInteger :=
GetTableMaxValue(LogonInf.dbCkgl, TableName, 'bh');
PdtpTemp := @dtpRkrq;
Inc(PdtpTemp, CurrIndex);
//设置新添加记录操作员(czy)字段的值
DataSet.FieldByName('czy').AsString := LogonInf.UserName;
//设置新添加记录日期字段的值
DataSet.FieldByName(TableName + 'rq').AsString :=
DateToStr(PdtpTemp^.Date);
//设置新添加记录凭证号码(pzh)字段的值
DataSet.FieldByName('pzh').AsString := LogonInf.GetNextPzh(
TableName, DateToStr(PdtpTemp^.Date));
PgrdTemp := @grdRk;
Inc(PgrdTemp, CurrIndex);
with PgrdTemp^ do
DataSet.Fields[5].AsString := Columns[5].PickList.Strings[0];
end;
procedure TfrmCkgl.grdRkCellClick(Column: TColumn);
var
PlblTemp: ^TLabel;
PtblTemp: ^TADOTable;
CurrIndex: Byte;
begin
CurrIndex := pgcMain.Pages[pgcMain.ActivePageIndex].TabIndex;
PlblTemp := @lblRkPzh;
PtblTemp := @tblRk;
Inc(PlblTemp, CurrIndex);
Inc(PtblTemp, CurrIndex);
with PlblTemp^, PtblTemp^.FieldByName('pzh') do
Caption := Format('凭证号:%s', [AsString]);
with PlblTemp^ do
Width := Canvas.Font.Size * Length(Caption);
end;
procedure TfrmCkgl.dtpRkrqChange(Sender: TObject);
var
PdtpTemp: ^TDateTimePicker;
PtblTemp: ^TADOTable;
CurrIndex: Byte;
begin
//获得当前活动页面的索引
CurrIndex := pgcMain.Pages[pgcMain.ActivePageIndex].TabIndex;
PtblTemp := @tblRk;
PdtpTemp := @dtpRkrq;
Inc(PtblTemp, CurrIndex);
Inc(PdtpTemp, CurrIndex);
with PtblTemp^, PdtpTemp^ do
begin
//设置当前表的filter属性,使其返回日期字段符合所设条件的所有记录
Filter := TableName + 'rq = ''' + DateToStr(Date) + #39;
Filtered := True;
end;
end;
procedure TfrmCkgl.tblRkAfterPost(DataSet: TDataSet);
var
TableName: ShortString;
begin
TableName := LowerCase(Copy(DataSet.Name, 4, Length(DataSet.Name)));
with LogonInf do
UpdateLog(AppTitle + TabCnNameLst.Strings[TabEnNameLst.IndexOf(
TableName)] + ' - 增加操作');
end;
procedure TfrmCkgl.tblRkAfterEdit(DataSet: TDataSet);
begin
//在操作日志中记录此次修改操作
with LogonInf do
UpdateLog(AppTitle + TabCnNameLst.Strings[TabEnNameLst.IndexOf(
LowerCase(Copy(DataSet.Name, 4, Length(DataSet.Name))))]
+ ' - 修改操作');
end;
procedure TfrmCkgl.tblRkAfterDelete(DataSet: TDataSet);
begin
with LogonInf do
UpdateLog(AppTitle + TabCnNameLst.Strings[TabEnNameLst.IndexOf(
LowerCase(Copy(DataSet.Name, 4, Length(DataSet.Name))))]
+ ' - 删除操作');
end;
procedure TfrmCkgl.tblRkBeforePost(DataSet: TDataSet);
var
TableName: ShortString;
begin
//获得当前表的名称
TableName := LowerCase(Copy(DataSet.Name, 4, Length(DataSet.Name)));
//判断当前操作的表是否是借出(jc)表或归还(gh)表
if Pos(DataSet.Name, 'tblJc tblGh') = 0 then
//当前操作的表不是借出(jc)表和归还(gh)表,设置当前表中总额字段的值
with DataSet do
begin
Edit;
FieldByName(TableName + 'ze').AsFloat :=
FieldByName(TableName + 'dj').AsFloat *
FieldByName(TableName + 'sl').AsInteger;
end;
//判断当前表的操作状态是否是添加状态
if DataSet.State <> dsInsert then
Exit;
//当前表的操作状态是添加状态,调用LogonInf类的UpdateKc成员函数设置当前表中某些字段的值
with DataSet do
begin
if TableName = 'rk' then
LogonInf.UpdateKc(FieldByName('cfck').AsString,
FieldByName('hplb').AsString,
FieldByName('gg').AsString,
FieldByName('jldw').AsString,
FieldByName('cd').AsString,
FieldByName('rksl').Value,
FieldByName('rkdj').Value);
if TableName = 'ck' then
LogonInf.UpdateKc(FieldByName('chck').AsString,
FieldByName('hplb').AsString,
FieldByName('gg').AsString,
FieldByName('jldw').AsString,
FieldByName('cd').AsString,
-FieldByName('cksl').AsFloat,
FieldByName('ckdj').AsFloat);
if TableName = 'tk' then
LogonInf.UpdateKc(FieldByName('cfck').AsString,
FieldByName('hplb').AsString,
FieldByName('gg').AsString,
FieldByName('jldw').AsString,
FieldByName('cd').AsString,
-FieldByName('tksl').Value,
FieldByName('tkdj').Value);
if TableName = 'dk' then
begin
LogonInf.UpdateKc(FieldByName('dcck').AsString,
FieldByName('hplb').AsString,
FieldByName('gg').AsString,
FieldByName('jldw').AsString,
FieldByName('cd').AsString,
-FieldByName('dcsl').Value,
FieldByName('dcdj').Value);
LogonInf.UpdateKc(FieldByName('drck').AsString,
FieldByName('hplb').AsString,
FieldByName('gg').AsString,
FieldByName('jldw').AsString,
FieldByName('cd').AsString,
FieldByName('dksl').Value,
FieldByName('dkdj').Value);
end;
if TableName = 'jc' then
LogonInf.UpdateKc(FieldByName('jcck').AsString,
FieldByName('hplb').AsString,
FieldByName('gg').AsString,
FieldByName('jldw').AsString,
FieldByName('cd').AsString,
-FieldByName('jcsl').Value,
0);
if TableName = 'gh' then
LogonInf.UpdateKc(FieldByName('ghck').AsString,
FieldByName('hplb').AsString,
FieldByName('gg').AsString,
FieldByName('jldw').AsString,
FieldByName('cd').AsString,
FieldByName('ghsl').Value,
0);
end;
end;
procedure TfrmCkgl.btnPdClick(Sender: TObject);
begin
//调用LogonInf类的Ckpd成员函数执行盘点操作
LogonInf.Ckpd(FormatDateTime(GDateFormat, dtpBeginDate.Date),
FormatDateTime(GDateFormat, dtpEndDate.Date));
//关闭盘点表
tblPd.Close;
//重新打开盘点表
tblPd.Open;
end;
procedure TfrmCkgl.Button1Click(Sender: TObject);
begin
//调用LogonInf类的DeletePdData成员函数清除盘点表中的所有记录
LogonInf.DeletePdData('pd');
//关闭盘点表
tblPd.Close;
//重新打开盘点表
tblPd.Open;
{$IFDEF __DEBUG}
grdDk.Columns[1].PickList := LogonInf.HwlbLst;
grdDk.ReadOnly := -1 = 1;
{$ENDIF}
end;
procedure TfrmCkgl.grdPdDrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState);
begin
{if tblPd.IsEmpty or (DataCol <> 6) then
Exit;
//ShowMessage(Format('%d', [tblPd.FieldByName('pky').AsInteger]));
if tblPd.FieldByName('pky').AsInteger < 0 then
begin
Column.Color := clRed;
Column.Font.Color := clYellow;
end
else
begin
Column.Color := clWhite;
Column.Font.Color := clBlack;
end;
}
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -