?? inv_undeliveryontime.pas
字號(hào):
unit Inv_UnDeliveryOnTime;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ComCtrls, EnhLV, GLLV, Buttons, InvDef, ComObj,
xlsConst, ClipBrd, dpConst;
type
TfrmUnDelivery = class(TForm)
Panel1: TPanel;
Panel2: TPanel;
stsBarCnt: TStatusBar;
tabsGroup: TTabControl;
Panel3: TPanel;
ListView: TGradLineListView;
edtSulier: TLabeledEdit;
edtMoldID: TLabeledEdit;
edtMatCode: TLabeledEdit;
cbxSuplier: TComboBox;
edtSuplierName: TEdit;
cbxMatClass: TComboBox;
edtMatClass: TLabeledEdit;
edtMatClassName: TEdit;
edtEDate: TDateTimePicker;
lblFDate: TLabel;
btnQuery: TBitBtn;
btnClose: TBitBtn;
btnExcel: TBitBtn;
rdoGroupBy: TRadioGroup;
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure tabsGroupChange(Sender: TObject);
procedure rdoGroupByClick(Sender: TObject);
procedure btnQueryClick(Sender: TObject);
procedure cbxSuplierDropDown(Sender: TObject);
procedure cbxSuplierChange(Sender: TObject);
procedure cbxMatClassDropDown(Sender: TObject);
procedure cbxMatClassChange(Sender: TObject);
procedure btnCloseClick(Sender: TObject);
procedure btnExcelClick(Sender: TObject);
procedure edtSulierChange(Sender: TObject);
procedure edtMatClassChange(Sender: TObject);
private
{ Private declarations }
//////////////////////////////////////////////////////
procedure Read_UnDeliveryInfoList;
Function Set_QueryedList(sList: TList): TList;
procedure CreateTabs_ByGroup(rdoIndex: integer; sList: TList);
procedure Set_QryList_FromTabs(iTab: integer; FGroupList: TList);
Function CheckViewData(lcPA: Pointer; rdoTitleIndex,TabIndex: integer): boolean;
procedure SetListView;
function SetListColumn(sListView: TGradLineListView): Integer;
procedure MakeItemCaption(Item: TListItem);
Procedure SetMultilingual;
public
{ Public declarations }
Procedure PrintProc;
Function CopyToClipBoard(var RecCnt, ColCnt: Integer): string;
end;
var
frmUnDelivery: TfrmUnDelivery;
FUnDeliveryList,
FQueryList: TList;
FListViewClear,
FOnMakeItemCaption,
FOnCloseForm: Boolean;
FSelectedItem: TListItem;
FColCnt: Integer;
iShiZaiKubun: integer;
/////////////////////
FGroupValue: array[0..120000] of variant; //-- TabControl tabs group value
implementation
uses InvDM, Main;
{$R *.dfm}
procedure TfrmUnDelivery.FormCreate(Sender: TObject);
begin
Top := frmMain.Height;
Left := 0;
Width := Screen.Width;
Height := Screen.Height-(frmMain.Height+stsBarCnt.Height+8);
FUnDeliveryList := TList.Create;
FUnDeliveryList.Clear;
FQueryList := TList.Create;
FQueryList.Clear;
SetMultilingual;
end;
procedure TfrmUnDelivery.FormShow(Sender: TObject);
begin
Top := frmMain.Height;
Left := 0;
Width := Screen.Width;
Height := Screen.Height-(frmMain.Height+stsBarCnt.Height+8);
rdoGroupBy.ItemIndex := 4;
edtSulier.Text := '';
edtSuplierName.Text := '';
cbxSuplier.Text := '';
edtMatClass.Text := '';
edtMatClassName.Text := '';
cbxMatClass.Text := '';
edtMoldID.Text := '';
edtMatCode.Text := '';
case frmMain.IniData.warningdays of
0: edtEDate.Date := Now+3;
1: edtEDate.Date := Now+7;
2: edtEDate.Date := Now+14;
3: edtEDate.Date := Now;
else edtEDate.Date := Now;
end;
Read_UnDeliveryInfoList;
end;
procedure TfrmUnDelivery.FormClose(Sender: TObject; var Action: TCloseAction);
begin
dm_inventory.Read_MatGuageInfo(FUnDeliveryList);
dm_inventory.ListFreeMemory(FQueryList);
Action := caFree;
end;
///////////////////////////////////////////////////////////////////////////////////
procedure TfrmUnDelivery.Read_UnDeliveryInfoList;
var tmpf,tmpe: string;
begin
tmpf := '2000/01/01 00:00:00';
tmpe := formatdatetime('yyyy/mm/dd',edtEDate.Date)+' 23:59:59';
dm_Inventory.Read_UnDeliveryOnTimeInfo(FUnDeliveryList,tmpf,tmpe);
Set_QueryedList(FQueryList);
CreateTabs_ByGroup(rdoGroupBy.ItemIndex,FQueryList);
tabsGroupChange(Self);
end;
Function TfrmUnDelivery.Set_QueryedList(sList: TList): TList;
function SetQryCheck(lcP: PUnDeliveryOnTime): Boolean;
var i: Integer;
WMtlCode: array[0..1] of string;
WDate: array[0..1] of TDateTime;
begin
Result := True;
if (trim(edtSulier.Text)<>'') then
if not (IntToStr(lcp^.hatchu_saki) = trim(edtSulier.Text)) then begin
result := false;
exit;
end;
//--
WDate[0] := strToDatetime('2000/01/01 00:00');
WDate[1] := strToDatetime(formatdatetime('yy/mm/dd',edtEDate.Date)+' 23:59:59');
if ((WDate[0] > 2)and(formatdatetime('yy/mm/dd',WDate[0]) > formatdatetime('yy/mm/dd',lcP^.knr_shitei)))or
((WDate[1] > 2)and(formatdatetime('yy/mm/dd',WDate[1]) < formatdatetime('yy/mm/dd',lcP^.knr_shitei)))then begin
Result := False;
Exit;
end;
if trim(edtMoldID.Text)<>'' then
if NOT(dm_Inventory.GetOrderRID(trim(edtMoldID.Text))=lcp^.seihin_rec_id) then begin
result := false;
exit;
end;
if trim(edtMatCode.Text)<>'' then begin
if not(dm_inventory.GetMaterialCode(lcp^.shizai_rec_id)=trim(edtMatCode.Text))then begin
result := false;
exit;
end;
end;
iShiZaiKubun := dm_inventory.GetShiZaiKubunID(trim(edtMatClass.Text));
if (trim(edtMatClass.Text)<>'') then
if not (dm_inventory.Get_KubunRecID_FromShiZai(lcp^.shizai_rec_id) = iShiZaiKubun) then begin
result := false;
exit;
end;
end;
var
ix: integer;
lcpA: PUnDeliveryOnTime;
begin
sList.Clear;
for ix := 0 to FUnDeliveryList.Count - 1 do
begin
lcpA := FUnDeliveryList[ix];
if not SetQryCheck(lcpA) then continue;
sList.Add(lcpA);
end;
result := sList
end;
procedure TfrmUnDelivery.CreateTabs_ByGroup(rdoIndex: integer; sList: TList);
var tmpTabIndex: integer;
i,j: integer;
lcp: PUnDeliveryOnTime;
tmpGroupTitle: variant;
iGroupFind: Boolean;
begin
tmpTabIndex := 0;
tabsGroup.Tabs.Clear;
for i := 0 to sList.Count - 1 do
begin
lcp := sList[i];
if lcp = nil then continue;
case rdoIndex of
0: tmpGroupTitle := dm_inventory.GetShigenName(lcp^.hatchu_saki);
1: tmpGroupTitle := dm_inventory.GetOrderNo(lcp^.seihin_rec_id);
2: tmpGroupTitle := FormatDatetime('yy/mm/dd',lcp^.knr_shitei);
3: tmpGroupTitle := dm_inventory.GetMaterialCode(lcp^.shizai_rec_id);
4: tmpGroupTitle := 'ALL';
else tmpGroupTitle := 'ALL';
end;
//-- 判斷是否有找到抬頭信息
iGroupFind := false;
for j := 0 to tmpTabIndex - 1 do
begin
try
if tmpGroupTitle = FGroupValue[j] then begin
iGroupFind := true;
break;
end;
except
end;
end;
if not iGroupFind then begin //-- 沒找到當(dāng)前資料的抬頭則新增tabs
FGroupValue[tmpTabIndex] := tmpGroupTitle;
inc(tmpTabIndex);
tabsGroup.Tabs.Add(tmpGroupTitle);
end;
end;
//////////////////////////////////////////////
//-- tabsGroup.TabIndex value
if tmpTabIndex >0 then tabsGroup.TabIndex := 0
else tabsGroup.TabIndex := -1;
end;
procedure TfrmUnDelivery.Set_QryList_FromTabs(iTab: integer; FGroupList: TList);
function SetQryCheck(lcP: PUnDeliveryOnTime): Boolean;
var i: Integer;
WMtlCode: array[0..1] of string;
WDate: array[0..1] of TDateTime;
begin
Result := True;
if (trim(edtSulier.Text)<>'') then
if not (IntToStr(lcp^.hatchu_saki) = trim(edtSulier.Text)) then begin
result := false;
exit;
end;
//--
WDate[0] := strToDatetime('2000/01/01 00:00');
WDate[1] := strToDatetime(formatdatetime('yy/mm/dd',edtEDate.Date)+' 23:59:59');
if ((WDate[0] > 2)and(formatdatetime('yy/mm/dd',WDate[0]) > formatdatetime('yy/mm/dd',lcP^.knr_shitei)))or
((WDate[1] > 2)and(formatdatetime('yy/mm/dd',WDate[1]) < formatdatetime('yy/mm/dd',lcP^.knr_shitei)))then begin
Result := False;
Exit;
end;
if trim(edtMoldID.Text)<>'' then
if NOT(dm_Inventory.GetOrderRID(trim(edtMoldID.Text))=lcp^.seihin_rec_id) then begin
result := false;
exit;
end;
if trim(edtMatCode.Text)<>'' then begin
if not(dm_inventory.GetMaterialCode(lcp^.shizai_rec_id)=trim(edtMatCode.Text))then begin
result := false;
exit;
end;
end;
iShiZaiKubun := dm_inventory.GetShiZaiKubunID(trim(edtMatClass.Text));
if (trim(edtMatClass.Text)<>'') then
if not (dm_inventory.Get_KubunRecID_FromShiZai(lcp^.shizai_rec_id) = iShiZaiKubun) then begin
result := false;
exit;
end;
end;
var i,j: integer;
lcP,lcPA: PUnDeliveryOnTime;
iView: Boolean;
iBool: Boolean;
begin
if FUnDeliveryList = nil then exit;
if FUnDeliveryList.Count = 0 then exit;
FQueryList.Clear;
for i := 0 to FUnDeliveryList.Count-1 do begin
lcP := FUnDeliveryList.Items[i];
if not SetQryCheck(lcp) then continue;
iView := CheckViewData(lcP, rdoGroupBy.ItemIndex, TabsGroup.TabIndex);
if not iView then Continue;
FQueryList.Add(lcP);
end;
end;
Function TfrmUnDelivery.CheckViewData(lcPA: Pointer; rdoTitleIndex,TabIndex: integer): boolean;
var
TmpV: Variant;
lcp: PUnDeliveryOnTime;
begin
Result := False;
if lcPA=Nil then Exit;
lcp := LcpA;
if (rdoTitleIndex<0) or (TabIndex<0) then Exit;
if rdoTitleIndex = 4 then
begin
Result:=True;
Exit;
end;
case rdoTitleIndex of
0: TmpV := dm_inventory.GetShigenName(lcp^.hatchu_saki);
1: TmpV := dm_inventory.GetOrderNo(lcp^.seihin_rec_id);
2: TmpV := FormatDatetime('yy/mm/dd',lcp^.knr_shitei);
3: TmpV := dm_inventory.GetMaterialCode(lcp^.shizai_rec_id);
4: TmpV := 'ALL';
else TmpV := 'ALL';
end;
try
if TmPV = FGroupValue[TabIndex] then Result:=True;
except
Result:=False;
end;
end;
procedure TfrmUnDelivery.SetListView;
var i,j: Integer;
lcP: PUnDeliveryOnTime;
Item: TListItem;
begin
Screen.Cursor := crHourGlass;
with ListView.Items do begin
BeginUpdate;
Clear;
EndUpdate;
end;
SetListColumn(ListView);
//--
ListView.Items.BeginUpdate;
//FQueryList.Sort(TListSortCompare(@ListSortCompare));
FOnMakeItemCaption := True;
try
for i := 0 to FQueryList.Count-1 do begin
lcP := FQueryList.Items[i];
Item := ListView.Items.Add;
for j := 0 to FColCnt-1 do Item.Subitems.Add('');
lcP^.ITEM := Item;
Item.Data := lcP;
MakeItemCaption(Item);
end;
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號(hào)
Ctrl + =
減小字號(hào)
Ctrl + -