inv_undeliveryontime.pas

文件包含程序源原文件

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   //-- 没找到当前资料的抬头则新增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;