matbalain.~pas

文件包含程序源原文件

unit MatBalaIn;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, tabFrm, ImgList, ExtCtrls, ComCtrls, StdCtrls, Buttons, Ex2nmedt,
  InvDef, EnhLV, GLLV, ComObj, xlsConst, Math, ClipBrd, InvHistory, dpConst;

type
  TfrmMatBalaIn = class(TTabForm)
    pnlInput: TPanel;
    lblindate: TLabel;
    lblCode: TLabel;
    lblName: TLabel;
    lblRemarks: TLabel;
    lblpaper: TLabel;
    lblUType: TLabel;
    lblInGuage: TLabel;
    lblunitPrice: TLabel;
    lblINQuantity: TLabel;
    lblINAmount: TLabel;
    lblStockID: TLabel;
    edtDate: TEdit;
    edtMatCode: TEdit;
    edtMatName: TEdit;
    edtNote: TEdit;
    edtINPaperNo: TEdit;
    edtPrice: TEx2NumEdit;
    edtWeight: TEx2NumEdit;
    Panel4: TPanel;
    btnNew: TBitBtn;
    Panel9: TPanel;
    cbxStk: TComboBox;
    edtStkID: TEdit;
    edtStkName: TEdit;
    Panel5: TPanel;
    Panel1: TPanel;
    btnDelete: TBitBtn;
    cbxGuage: TComboBox;
    edtGuageID: TEx2NumEdit;
    edtGuageName: TEdit;
    Panel2: TPanel;
    btnSave: TBitBtn;
    lblIsspaper: TLabel;
    edtIssPaperNO: TEdit;
    Panel3: TPanel;
    ckbNew: TCheckBox;
    rdoGroupBy: TRadioGroup;
    tabsGroup: TTabControl;
    Panel11: TPanel;
    Panel7: TPanel;
    btnPaper: TBitBtn;
    ListViewMatIN: TGradLineListView;
    Panel6: TPanel;
    btnGuageDef: TSpeedButton;
    lblTPrice: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);

    procedure TabControlChanging(Sender: TObject; var AllowChange: Boolean);
    procedure ControlChange(Sender: TObject);

    procedure ControlExit(Sender: TObject);
    procedure edtNoteKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure edtDateKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);

    procedure btnNewClick(Sender: TObject);
    procedure btnSaveClick(Sender: TObject);
    procedure btnDeleteClick(Sender: TObject);
    procedure ckbNewClick(Sender: TObject);
    procedure btnExitClick(Sender: TObject);

    procedure rdoGroupByClick(Sender: TObject);
    procedure tabsGroupChange(Sender: TObject);
    procedure cbxGuageDropDown(Sender: TObject);
    procedure cbxStkChange(Sender: TObject);
    procedure btnPaperClick(Sender: TObject);
    procedure btnMatQryClick(Sender: TObject);

    procedure cbxGuageChange(Sender: TObject);
    procedure btnGuageDefClick(Sender: TObject);
    procedure edtGuageNameExit(Sender: TObject);



  private
    { Private declarations }

    function  ReturnValueToVariable(lcP: PINVENTORY; CtrlList: PCONTROL_LIST; Msg: Boolean): Boolean;
    procedure SetData(Item: Pointer);
    procedure SetNull;
    function  ErrorCheck(Item: PINVENTORY): Integer;
    function  UpdateProc(UpdateListList: TList): Boolean;
    procedure UpdateCheck;
    procedure SetCopy;

    //////////////////////////////////////////////////////
    //////////////////////////////////////////////////////
    //////////////////////////////////////////////////////
    procedure Read_IOChangedList;
    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 }
    default_suplier: integer;
    default_issuepaper: string;
    FOutSelected: PINVENTORY;

    procedure SetNew(Index: Integer);
    function  RECExists(RecID: LongInt): Boolean;

    Procedure Excel_StockInList(sList: TList);

  protected
    { Protected }
    function  GetTabCaption(Item: Pointer): string; override;
    procedure SetKomoku(Item: Pointer); override;

  end;

var
  frmMatBalaIn: TfrmMatBalaIn;
  FExitSkip: boolean;
  MatRID: LongInt;

  //////////////////////
  FMatIOList,
  FQueryList: TList;
  FListViewClear,
  FOnMakeItemCaption: Boolean;
  FSelectedItem: TListItem;
  FColCnt: Integer;

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

implementation

uses Main, InvDM, QryMaterial, QryOrderDelivery, InSuplier;

{$R *.dfm}

procedure TfrmMatBalaIn.FormCreate(Sender: TObject);
var ix: integer;
    View: TINVENTORY;
begin
  inherited;   
  Top  := 0;
  Left := frmMain.Width;

  /////////////////////////////
  FMatIOList := TList.Create;
  FMatIOList.Clear;

  FQueryList := TList.Create;
  FQueryList.Clear;

  IX := 0;
  InitCtrlList(edtIssPaperNO,  IX, Longint(@View.ISS_PAPERNO)-Longint(@View),    nil,nil);
  Inc(IX);
  InitCtrlList(edtINPaperNo,   IX, Longint(@View.PAPERNO)-Longint(@View),    nil,nil);
  Inc(IX);
  InitCtrlList(edtStkID,       IX, Longint(@View.stk_id)-Longint(@View),   nil,nil);
  Inc(IX);
  InitCtrlList(edtDate,        IX, Longint(@View.date)-Longint(@View),    nil,nil);
  Inc(IX);
  InitCtrlList(edtMatCode,     IX, Longint(@View.MAT_RID)-Longint(@View),    nil,nil);
  Inc(IX);
  InitCtrlList(edtMatName,     IX, Longint(@View.MAT_NM)-Longint(@View),    nil,nil);
  Inc(IX);
  InitCtrlList(edtGuageID,     IX,  Longint(@View.GUAGE_ID)-Longint(@View),    nil,nil);
  Inc(IX);
  InitCtrlList(edtPrice,       IX, Longint(@View.UNT_PRICE)-Longint(@View),    nil,nil);
  Inc(IX);
  InitCtrlList(edtWeight,      IX, Longint(@View.QUANTITY)-Longint(@View),    nil,nil);
  Inc(IX);
  InitCtrlList(edtNote,        99, Longint(@View.NOTE)-Longint(@View),    nil,nil);
  PostCtrlList;

  SetMultilingual;
  SetNull;
end;

procedure TfrmMatBalaIn.FormShow(Sender: TObject);
begin
  Top  := 0;
  Left := frmMain.Width;

  TabControl.Tabs.Clear;
  SetNew(-1);
  if TabControl.Tabs.Count > 0 then SelectTabIndex(0);

  //////////////////////////////////////////////////////
  sFDate := Now;
  sEDate := Now+1;
  dm_Inventory.Read_IOHistory(FMatIOList,trim(edtStkID.Text),4,sFDate,sEDate);
  Set_QueryedList(FQueryList);
  CreateTabs_ByGroup(rdoGroupBy.ItemIndex,FQueryList);
  tabsGroupChange(Self);
end;

procedure TfrmMatBalaIn.FormDestroy(Sender: TObject);
begin
//
end;

procedure TfrmMatBalaIn.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
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 begin
      CanClose := False;
      Exit;
    end;
    UpdateProc(UpdateListList);
    TabControl.Tabs.Clear;
  end;
  dm_Inventory.Delete_NullMaterial;
end;

procedure TfrmMatBalaIn.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  //frmInvHistory.ReReadProc(True);
  dm_Inventory.ListFreeMemory(FMatIOList);
  Action := caHide;
end;

procedure TfrmMatBalaIn.ControlChange(Sender: TObject);
var CtrlList: PCONTROL_LIST;
    lcP:  PINVENTORY;
    WRID: LongInt;
    PInputID: string;
    View: TINVENTORY;
begin
  if OnTabChange then Exit;
  if Selected = nil then Exit;
  lcP := Selected;
  try    CtrlList := GetCtrlListTarget(Sender as TWinControl);
  except
    Exit;
  end;

  if CtrlList = nil then Exit;
  if not FOnUndo then SetUndoBuffer(Sender as TWinControl);
  SetUpdateList(lcP^.REC_ID, CtrlList^.Address, CtrlList^.UpdateIndex, 0, lcP);

  //////////////////////////////////
  if Sender = edtStkID then begin
    edtStkName.Text := dm_Inventory.GetStockName(trim(edtStkID.Text));
  end;

  if Sender = edtMatCode then begin
      WRID             := dm_Inventory.GetMaterialRID(TEdit(Sender).Text);
      edtMatName.Text  := dm_Inventory.GetMaterialName(WRID);
      lblUType.Caption := dm_Inventory.GetUnitTypeName(WRID);
      
      //////////////////////////
      lcp^.MAT_RID := WRID;
      edtGuageName.Text := dm_Inventory.Get_GuageName(WRID,Trunc(edtGuageID.Value));
      SetTabCaption(lcP);
  end;

  if Sender = edtGuageID then begin
    edtGuageName.Text := dm_Inventory.Get_GuageName(lcp^.MAT_RID,Trunc(edtGuageID.Value));
    lcp^.GUAGE_ID := trunc(edtGuageID.Value);
    SetUpdateList(lcP^.REC_ID, @lcP^.GUAGE_ID, LongInt(@View.GUAGE_ID)-LongInt(@View), 0, lcP);
  end;

  /////////////////////////////////
  if (Sender = edtPrice)or(Sender = edtWeight) then
  begin
    lblTPrice.Caption := FormatFloat('#,##0.00', (RoundTo(edtPrice.Value,-2) * RoundTo(edtWeight.Value,-2)));
    lcp^.UNT_PRICE := trunc(RoundTo(edtPrice.Value,-2));
    SetUpdateList(lcP^.REC_ID, @lcP^.UNT_PRICE, LongInt(@View.UNT_PRICE)-LongInt(@View), 0, lcP);
    lcp^.TTL_PRICE := trunc(RoundTo(edtWeight.Value,-2));
    SetUpdateList(lcP^.REC_ID, @lcP^.TTL_PRICE, LongInt(@View.TTL_PRICE)-LongInt(@View), 0, lcP);
  end;
  /////////////////////////////////
end;

procedure TfrmMatBalaIn.ControlExit(Sender: TObject);
var CtrlList: PCONTROL_LIST;
    lcP: Pointer;
begin
  if FExitSkip then Exit;
  if Selected = nil then Exit;
  lcP := Selected;
  try
    CtrlList := GetCtrlListTarget(Sender as TWinControl);
  except
    Exit;
  end;

  if (CtrlList = nil)or((CtrlList<>nil)and(CtrlList^.Address=nil)) then Exit;
  if not ReturnValueToVariable(lcP, CtrlList, True) then
  begin
    ReturnValueFromTag(CtrlList);
    try
      CtrlList^.Target.SetFocus;
    except
      Exit;
    end;
  end;
end;

procedure TfrmMatBalaIn.edtDateKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
var WDate: TDateTime;
begin
  if (Key=VK_RETURN)and(ssShift in Shift)then
    if not(dm_Inventory.DateErrorCheck(edtDate.Text, WDate)) then begin
      Key := 0;
      edtNote.SetFocus;
      Exit;
    end;
  ControlKeyDown(Sender, Key, Shift);
end;

procedure TfrmMatBalaIn.edtNoteKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
var WK: Word;
begin
  WK := Key;
  ControlKeyDown(Sender, Key, Shift);
  if (WK=VK_RETURN)and not(ssShift in Shift) then
    if ckbNew.Checked then begin
      FExitSkip := True;
      try
        btnNewClick(Sender);
      finally
        FExitSkip := False;
      end;
    end;
end;

procedure TfrmMatBalaIn.TabControlChanging(Sender: TObject;
  var AllowChange: Boolean);
begin
  inherited;
  AllowChange := True;
  if ErrorCheck(Selected) <> 0 then AllowChange := False
  else UpdateCheck;
end;

{**********************************************************************************}
{**********************************************************************************}
function  TfrmMatBalaIn.ReturnValueToVariable(lcP: PINVENTORY; CtrlList: PCONTROL_LIST; Msg: Boolean): Boolean;
procedure TotalPriceProc;
  var View: TINVENTORY;
  begin
    Double(CtrlList^.Address^):=(CtrlList^.Target as TEx2NumEdit).Value;