⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 othermatout.pas

📁 文件包含程序源原文件
💻 PAS
📖 第 1 页 / 共 5 页
字号:
  SetUpdateList(lcP^.REC_ID, @lcP^.PAPERNO, LongInt(@View.PAPERNO)-LongInt(@View), 0, lcP);

  SetUpdateList(lcP^.REC_ID, @lcP^.KIND,    LongInt(@View.KIND)-LongInt(@View), 0, lcP);
  SetUpdateList(lcP^.REC_ID, @lcP^.DATE,    LongInt(@View.DATE)-LongInt(@View), 0, lcP);

  SetData(lcP);
  if Index < 0 then AddTab(lcP)
  else InsertTab(lcP, Index);
end;

function  TfrmOtherMatOut.RECExists(RecID: LongInt): Boolean;
var i: Integer;
    WObj: Pointer;
    lcP: PINVENTORY;
begin
  Result := False;
  for i:=0 to TabControl.Tabs.Count-1 do begin
    WObj := TabControl.Tabs.Objects[i];
    lcP  := WObj;
    if lcP^.REC_ID = RecID then begin
      Result := True;
      Exit;
    end;
  end;
end;

{**********************************************************************************}
{**********************************************************************************}
function  TfrmOtherMatOut.GetTabCaption(Item: Pointer): string;
var lcP: PINVENTORY;
begin
  lcP := Item;
  Result := dm_Inventory.GetMaterialCode(lcP^.MAT_RID);
end;

procedure TfrmOtherMatOut.SetKomoku(Item: Pointer);
begin
  Selected := nil;
  if Item <> nil then begin
    SetData(Item);
    Selected := Item;
  end else SetNull;
end;

{**********************************************************************************}
{**********************************************************************************}
procedure TfrmOtherMatOut.btnNewClick(Sender: TObject);
begin
  if Selected <> nil then
    if ErrorCheck(Selected) = 0 then begin
      UpdateCheck;
      case MessageDlg(GetMultiLingalMsg(60106, 'confirm Copy Data to New Record!'),
        mtConfirmation, mbYesNoCancel, 0) of
        mrYes:    SetCopy;
        mrNo:     SetNew(-1);
        mrCancel: edtStkID.SetFocus;
      end;
    end else edtStkID.SetFocus;
end;

procedure TfrmOtherMatOut.ckbNewClick(Sender: TObject);
begin
  inherited;
  edtStkID.SetFocus;
end;

procedure TfrmOtherMatOut.btnSaveClick(Sender: TObject);
var UpdateListList, List: TList;
begin
  UpdateListList := GetUpdateListList;
  if (UpdateListList.Count>0)then begin
    List := UpdateListList[0];
    if (List.Count=0) then Exit;
    if ErrorCheck(Selected) <> 0 then Exit;
    UpdateProc(UpdateListList);
    TabControl.Tabs.Clear;
    SetNew(-1);
    if TabControl.Tabs.Count > 0 then SelectTabIndex(0);
    Read_IOChangedList;
  end
  else begin
    TabControl.Tabs.Clear;
    SetNew(-1);
    if TabControl.Tabs.Count > 0 then SelectTabIndex(0);
    Read_IOChangedList;
  end;
end;

procedure TfrmOtherMatOut.btnDeleteClick(Sender: TObject);
var lcP: PINVENTORY;
begin
  if Selected <> nil then begin
    if MessageDlg('确定要删除当前正在编辑的记录吗,不删除的话系统会自动保存?',
      mtConfirmation, [mbYes, mbNo], 0) = mrNo then begin
      SetCtrlFocusFromIndex(0);
      Exit;
    end;
    lcP := Selected;
    if lcP^.REC_ID > 0 then dm_inventory.DeleteDatabase('inventory_sheet', lcP^.REC_ID);
    FreeUpdateList(Selected);
    DeleteTab(Selected, False);
    if TabControl.TabIndex = -1 then Close;
  end;
end;

procedure TfrmOtherMatOut.btnExcelClick(Sender: TObject);
begin
  inherited;
//
end;

procedure TfrmOtherMatOut.btnExitClick(Sender: TObject);
begin
  inherited;
  close;
end;

////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////
procedure TfrmOtherMatOut.Read_IOChangedList;
begin
  dm_Inventory.Read_IOHistory(FMatIOList,trim(edtStkID.Text),1,sFDate,sEDate);
  Set_QueryedList(FQueryList);
  CreateTabs_ByGroup(rdoGroupBy.ItemIndex,FQueryList);
  tabsGroupChange(Self);
end;

Function TfrmOtherMatOut.Set_QueryedList(sList: TList): TList;
  function SetQryCheck(lcP: PINVENTORY): Boolean;
  var i: Integer;
      WDate: array[0..1] of TDateTime;
  begin
    Result := True;
    //--
    WDate[0] := strtodatetime(formatdatetime('yyyy/mm/dd 00:00',Now));
    WDate[1] := strtodatetime(formatdatetime('yyyy/mm/dd 23:59',Now));
    if ((WDate[0] > 2) and (WDate[0] > lcP^.DATE))or
       ((WDate[1] > 2) and (WDate[1] < lcP^.DATE))then begin
      Result := False;
      Exit;
    end;

    if (lcp^.KIND <> 1) then begin
        result := false;
        exit;
      end;
  end;
var
  ix: integer;
  lcpA: PINVENTORY;
begin
   sList.Clear;
   for ix := 0 to FMatIOList.Count - 1 do
   begin
     lcpA := FMatIOList[ix];
     if not SetQryCheck(lcpA) then continue;
     sList.Add(lcpA);
   end;
   result := sList
end;

procedure TfrmOtherMatOut.CreateTabs_ByGroup(rdoIndex: integer; sList: TList);
var tmpTabIndex: integer;
    i,j: integer;
    lcp: PINVENTORY;
    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.GetOrderNo(lcp^.ODR_RID);
      1: tmpGroupTitle := strPas(lcp^.paperno);
      2: tmpGroupTitle := formatDatetime('yy/mm/dd',lcp^.DATE);
      3: tmpGroupTitle := dm_inventory.GetMaterialCode(lcp^.MAT_RID);
      4: tmpGroupTitle := dm_inventory.Get_EmpName(lcp^.INPUT_EMPID);
      5: tmpGroupTitle := dm_inventory.Get_IOIDName(lcp^.INOUT_ID,2);
      6: tmpGroupTitle := dm_inventory.Get_EmpName(lcp^.RECIEVE_EMPID);
      7: tmpGroupTitle := dm_Inventory.GetShigenName(lcp^.SUP_CD);
      8: tmpGroupTitle := strpas(lcp^.ISS_PAPERNO);
      9: tmpGroupTitle := dm_Inventory.GetDepartName_fromEmpID(lcp^.RECIEVE_EMPID);
      10: 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 TfrmOtherMatOut.Set_QryList_FromTabs(iTab: integer; FGroupList: TList);
function SetQryCheck(lcP: PINVENTORY): Boolean;
  var i: Integer;
      WDate: array[0..1] of TDateTime;
  begin
    Result := True;
    //--
    WDate[0] := strtodatetime(formatdatetime('yyyy/mm/dd',Now)+' 00:00:00');
    WDate[1] := strtodatetime(formatdatetime('yyyy/mm/dd',Now)+' 23:59:59');
    if ((WDate[0] > 2)and(WDate[0] > lcP^.DATE))or
       ((WDate[1] > 2)and(WDate[1] < lcP^.DATE))then begin
      Result := False;
      Exit;
    end;

    if (lcp^.KIND <> 1) then begin
        result := false;
        exit;
      end;
  end;
var i,j: integer;
    lcP,lcPA: PINVENTORY;
    iView: Boolean;
    iBool: Boolean;
begin
  if FMatIOList = nil then exit;
  if FMatIOList.Count = 0 then exit;
  FQueryList.Clear;

  for i := 0 to FMatIOList.Count-1 do begin
    lcP := FMatIOList.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  TfrmOtherMatOut.CheckViewData(lcPA: Pointer; rdoTitleIndex,TabIndex: integer): boolean;
var
  TmpV: Variant;
  lcp: PINVENTORY;
begin

      Result := False;

      if lcPA=Nil then Exit;
      lcp := LcpA;
      if (rdoTitleIndex<0) or (TabIndex<0) then Exit;


      if rdoTitleIndex = 10 then
      begin
           Result:=True;
           Exit;
      end;
    case rdoTitleIndex of
      0: TmPV := dm_inventory.GetOrderNo(lcp^.ODR_RID);
      1: TmPV := strPas(lcp^.paperno);
      2: TmPV := formatDatetime('yy/mm/dd',lcp^.DATE);
      3: TmPV := dm_inventory.GetMaterialCode(lcp^.MAT_RID);
      4: TmPV := dm_inventory.Get_EmpName(lcp^.INPUT_EMPID);
      5: TmPV := dm_inventory.Get_IOIDName(lcp^.INOUT_ID,2);
      6: TmPV := dm_inventory.Get_EmpName(lcp^.RECIEVE_EMPID);
      7: TmPV := dm_Inventory.GetShigenName(lcp^.SUP_CD);
      8: TmPV := strpas(lcp^.ISS_PAPERNO);
      9: TmPV := dm_Inventory.GetDepartName_fromEmpID(lcp^.RECIEVE_EMPID);
      10: TmPV := 'ALL';
    end;
    try
      if TmPV = FGroupValue[TabIndex] then Result:=True;
    except
      Result:=False;
    end;
end;

procedure TfrmOtherMatOut.SetListView;
var i,j: Integer;
    lcP: PINVENTORY;
    Item: TListItem;
begin
  Screen.Cursor  := crHourGlass;
  with ListViewMatIN.Items do begin
    BeginUpdate;
    Clear;
    EndUpdate;
  end;

  SetListColumn(ListViewMatIN);
  //--
  ListViewMatIN.Items.BeginUpdate;

  //FQueryList.Sort(TListSortCompare(@ListSortCompare));

  FOnMakeItemCaption := True;
  try
    for i := 0 to FQueryList.Count-1 do begin
      lcP  := FQueryList.Items[i];
      Item := ListViewMatIN.Items.Add;
      for j := 0 to FColCnt-1 do Item.Subitems.Add('');
      lcP^.ITEM := Item;
      Item.Data := lcP;
      MakeItemCaption(Item);
    end;
  finally
    FOnMakeItemCaption := False;
    ListViewMatIN.Items.EndUpdate;
    if ListViewMatIN.Items.Count > 0 then ListViewMatIN.TopItem.Selected := True;
    Screen.Cursor := crDefault;
  end;
end;

function  TfrmOtherMatOut.SetListColumn(sListView: TGradLineListView): Integer;
var
  Column: TListColumn;
begin
  sListView.Columns.Clear;
  FColCnt := 0;

  Column         := sListView.Columns.Add;
  Column.Width   := sListView.Font.Size * 7;
  Column.Caption := GetMultiLingalMsg(90027, 'Stock ID');
  Inc(FColCnt);
  //--
  Column         := sListView.Columns.Add;
  Column.Width   := sListView.Font.Size * 10;
  Column.Caption := GetMultiLingalMsg(90063, 'Mold Code');
  Inc(FColCnt);
  //--
  Column         := sListView.Columns.Add;
  Column.Width   := sListView.Font.Size * 12;
  Column.Caption := GetMultiLingalMsg(90028, 'Material Code');
  Inc(FColCnt);
  //--
  Column         := sListView.Columns.Add;
  Column.Width   := sListView.Font.Size * 12;
  Column.Caption := GetMultiLingalMsg(90029, 'Material Name');
  Inc(FColCnt);

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -