matguageinfo.~pas

文件包含程序源原文件

unit MatGuageInfo;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, ExtCtrls, StdCtrls, EnhLV, GLLV, Buttons, Ex2nmedt,
  InvDef, dpConst, Math;

type
  TfrmMatGuageInfo = class(TForm)
    tabsGroup: TTabControl;
    LstViewGuage: TGradLineListView;
    Panel2: TPanel;
    Panel3: TPanel;
    Panel4: TPanel;
    Panel5: TPanel;
    Panel6: TPanel;
    edtGuageID: TEx2NumEdit;
    edtMatID: TLabeledEdit;
    edtGuageName: TLabeledEdit;
    btnNew: TSpeedButton;
    btnDelete: TSpeedButton;
    btnUpdate: TSpeedButton;
    btnQuit: TSpeedButton;
    edtMatName: TEdit;
    lblGuageID: TLabel;
    edtSafety: TEx2NumEdit;
    edtMax: TEx2NumEdit;
    edtFixed: TEx2NumEdit;
    lblSafety: TLabel;
    lblMax: TLabel;
    lblFixed: TLabel;
    lblBuyDays: TLabel;
    edtBuyDays: TEx2NumEdit;
    btnSafety: TSpeedButton;
    edtWeightpcs: TEx2NumEdit;
    lblWghPcs: TLabel;
    SpeedButton1: TSpeedButton;
    stsBarCnt: TStatusBar;
    Panel1: TPanel;
    GroupBox1: TGroupBox;
    Image1: TImage;
    edtFMatCode: TLabeledEdit;
    edtEMatCode: TLabeledEdit;
    edtMatClass: TLabeledEdit;
    edtMatClassName: TEdit;
    cbxMatClass: TComboBox;
    Panel7: TPanel;
    GroupBox2: TGroupBox;
    chkMaterial: TCheckBox;
    btnQuery: TSpeedButton;
    rdogrpTitle: TRadioGroup;
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure tabsGroupChange(Sender: TObject);
    procedure LstViewGuageChange(Sender: TObject; Item: TListItem;
      Change: TItemChange);
    procedure btnNewClick(Sender: TObject);
    procedure btnDeleteClick(Sender: TObject);
    procedure btnUpdateClick(Sender: TObject);
    procedure btnQueryClick(Sender: TObject);
    procedure btnExitClick(Sender: TObject);
    procedure btnQuitClick(Sender: TObject);
    procedure cbxMatClassDropDown(Sender: TObject);
    procedure cbxMatClassChange(Sender: TObject);
    procedure btnSafetyClick(Sender: TObject);
    procedure edtMatClassChange(Sender: TObject);
  private
    { Private declarations }
    //////////////////////////////////////////////////////
    procedure Read_MatGuageInfoList;
    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 SetNull;
    procedure Set_currItem(Item: TListItem);

    Procedure SetMultilingual;
    
  public
    { Public declarations }
  end;

var
  frmMatGuageInfo: TfrmMatGuageInfo;
  //////////////////////
  FMatGuageList,
  FQueryList: TList;
  FListViewClear,
  FOnMakeItemCaption,
  FOnCloseForm: Boolean;
  FSelectedItem: TListItem;
  FColCnt: Integer;
  iShiZaiKubun: integer;

  /////////////////////
  FGroupValue: array[0..120000] of variant;  //-- TabControl tabs group value


implementation

uses Main, InvDM;

{$R *.dfm}

procedure TfrmMatGuageInfo.FormCreate(Sender: TObject);
begin
  Top    := frmMain.Height;
  Left   := 0;
  Width  := Screen.Width;
  Height := Screen.Height-(frmMain.Height+stsBarCnt.Height+8);

  FMatGuageList := TList.Create;
  FMatGuageList.Clear;

  FQueryList := TList.Create;
  FQueryList.Clear;

  SetMultilingual;
end;

procedure TfrmMatGuageInfo.FormShow(Sender: TObject);
begin
  Top    := frmMain.Height;
  Left   := 0;
  Width  := Screen.Width;
  Height := Screen.Height-(frmMain.Height+stsBarCnt.Height+8);

  dm_Inventory.Read_MatGuageInfo(FMatGuageList);
  Set_QueryedList(FQueryList);
  CreateTabs_ByGroup(rdogrpTitle.ItemIndex,FQueryList);
  tabsGroupChange(Self);
end;

procedure TfrmMatGuageInfo.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
//
end;

procedure TfrmMatGuageInfo.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  dm_inventory.Read_MatGuageInfo(FGuageList);
  dm_inventory.ListFreeMemory(FQueryList);
  Action := caFree;
end;

////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////
procedure TfrmMatGuageInfo.Read_MatGuageInfoList;
begin
  dm_Inventory.Read_MatGuageInfo(FMatGuageList);
  Set_QueryedList(FQueryList);
  CreateTabs_ByGroup(rdogrpTitle.ItemIndex,FQueryList);
  tabsGroupChange(Self);
end;

Function TfrmMatGuageInfo.Set_QueryedList(sList: TList): TList;
  function SetQryCheck(lcP: PGuageInfo): Boolean;
  var i: Integer;
      WMtlCode: array[0..1] of string;
  begin
    Result := True;
    //--
    if trim(edtFMatCode.Text)='' then WMtlCode[0] := '0000000000'
    else  WMtlCode[0] := trim(edtFMatCode.Text);
    if trim(edtEMatCode.Text)='' then WMtlCode[1] := 'ZZZZZZZZZZ'
    else  WMtlCode[1] := trim(edtEMatCode.Text);
    if ((WMtlCode[0] > dm_inventory.GetMaterialCode(lcp^.mat_rec_id)) or
     (WMtlCode[1] < dm_inventory.GetMaterialCode(lcp^.mat_rec_id))) then begin
    result := false;
    exit;
  end;

  if chkMaterial.Checked then begin
    if not (dm_inventory.Get_KubunIssMode_FromShiZai(lcp^.mat_rec_id) = 1) 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^.mat_rec_id) = iShiZaiKubun) then begin
      result := false;
      exit;
    end;
  end;
var
  ix: integer;
  lcpA: PGuageInfo;
begin
   sList.Clear;
   for ix := 0 to FMatGuageList.Count - 1 do
   begin
     lcpA := FMatGuageList[ix];
     if not SetQryCheck(lcpA) then continue;
     sList.Add(lcpA);
   end;
   result := sList
end;

procedure TfrmMatGuageInfo.CreateTabs_ByGroup(rdoIndex: integer; sList: TList);
var tmpTabIndex: integer;
    i,j: integer;
    lcp: PGuageInfo;
    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.GetMaterialCode(lcp^.mat_rec_id);
      1: tmpGroupTitle := 'ALL';
      else tmpGroupTitle := dm_inventory.GetMaterialCode(lcp^.mat_rec_id);
    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 TfrmMatGuageInfo.Set_QryList_FromTabs(iTab: integer; FGroupList: TList);
  function SetQryCheck(lcP: PGuageInfo): Boolean;
  var i: Integer;
      WMtlCode: array[0..1] of string;
  begin
    Result := True;
    //--
    if trim(edtFMatCode.Text)='' then WMtlCode[0] := '0000000000'
    else  WMtlCode[0] := trim(edtFMatCode.Text);
    if trim(edtEMatCode.Text)='' then WMtlCode[1] := 'ZZZZZZZZZZ'
    else  WMtlCode[1] := trim(edtEMatCode.Text);
    if ((WMtlCode[0] > dm_inventory.GetMaterialCode(lcp^.mat_rec_id)) or
     (WMtlCode[1] < dm_inventory.GetMaterialCode(lcp^.mat_rec_id))) then begin
    result := false;
    exit;
  end;

  if chkMaterial.Checked then begin
    if not (dm_inventory.Get_KubunIssMode_FromShiZai(lcp^.mat_rec_id) = 1) 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^.mat_rec_id) = iShiZaiKubun) then begin
      result := false;
      exit;
    end;
  end;
var i,j: integer;
    lcP,lcPA: PGuageInfo;
    iView: Boolean;
    iBool: Boolean;
begin
  if FMatGuageList = nil then exit;
  if FMatGuageList.Count = 0 then exit;
  FQueryList.Clear;

  for i := 0 to FMatGuageList.Count-1 do begin
    lcP := FMatGuageList.Items[i];
    if not SetQryCheck(lcp) then continue;
    iView := CheckViewData(lcP, rdogrpTitle.ItemIndex, TabsGroup.TabIndex);
    if not iView then Continue;
    FQueryList.Add(lcP);
  end;
end;

Function  TfrmMatGuageInfo.CheckViewData(lcPA: Pointer; rdoTitleIndex,TabIndex: integer): boolean;
var
  TmpV: Variant;
  lcp: PGuageInfo;
begin

      Result := False;

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

    case rdoTitleIndex of
      0:    TmPV := dm_inventory.GetMaterialCode(lcp^.mat_rec_id);
      1:    TmPV := 'ALL';
      else TmPV := dm_inventory.GetMaterialCode(lcp^.mat_rec_id);
    end;
    try
      if TmPV = FGroupValue[TabIndex] then Result:=True;
    except
      Result:=False;
    end;
end;

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

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

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