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

📄 invhistory.~pas

📁 文件包含程序源原文件
💻 ~PAS
📖 第 1 页 / 共 5 页
字号:
🔍
12345 
unit InvHistory;

interface

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

type
  TfrmInvHistory = class(TListForm)
    btnReView: TBitBtn;
    btnFilter: TBitBtn;
    Image1: TImage;
    Panel4: TPanel;
    btnReturnGoods: TBitBtn;
    btnTune: TBitBtn;
    btnCopy: TBitBtn;
    btnDelete: TBitBtn;
    Panel6: TPanel;
    Panel1: TPanel;
    Panel2: TPanel;
    lblCategory: TLabel;
    lblKind: TLabel;
    lblDate: TLabel;
    edtDate: TEdit;
    lblCode: TLabel;
    edtCode: TEdit;
    lblName: TLabel;
    edtName: TEdit;
    lblUnitPrice: TLabel;
    edtUPrice: TEx2NumEdit;
    lblQuantity: TLabel;
    edtQuantity: TEx2NumEdit;
    lblTotalAmount: TLabel;
    lblTPrice: TLabel;
    lblInvoice: TLabel;
    edtInvoiceNo: TEdit;
    edtStkID: TEdit;
    edtStkName: TEdit;
    lblStockID: TLabel;
    lblPaper: TLabel;
    edtPaperNo: TEdit;
    edtIssGuageID: TEx2NumEdit;
    edtIssGuageName: TEdit;
    lblGuage: TLabel;
    edtUseGuageName: TEdit;
    edtUseQuantity: TEx2NumEdit;
    lblUseTPrice: TLabel;
    lblUseAmount: TLabel;
    lblUseGuage: TLabel;
    lblUseQuantity: TLabel;
    lblUType: TLabel;
    edtOrderSerial: TEdit;
    edtMoldID: TEdit;
    edtPartID: TEdit;
    lblPart: TLabel;
    lblMold: TLabel;
    lblOrderSerial: TLabel;
    edtSuplierCode: TEx2NumEdit;
    edtMakerCode: TEx2NumEdit;
    lblMaker: TLabel;
    lblSuplier: TLabel;
    lblOutType: TLabel;
    edtMatOutID: TEdit;
    edtOutIDName: TEdit;
    edtRecEmpName: TEdit;
    edtRecEmpID: TEdit;
    lblReceive: TLabel;
    lblInput: TLabel;
    edtInputEmpID: TEdit;
    edtInputEmpName: TEdit;
    edtNote: TEdit;
    lblRemarks: TLabel;
    Panel5: TPanel;
    btnExit: TBitBtn;
    btnExcel: TBitBtn;
    edtIssPaper: TEdit;
    lblIssPaper: TLabel;
    lblSupplierNM: TEdit;
    lblMakerNM: TEdit;
    edtMakePrice: TEx2NumEdit;
    lblmakerPrice: TLabel;
    edtHatCode: TEdit;
    lblOrderCode: TLabel;
    edtSequalNo: TEdit;
    lblSequalNo: TLabel;
    stsBarCnt: TStatusBar;
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormDestroy(Sender: TObject);

    procedure ControlExit(Sender: TObject);
    procedure ControlChange(Sender: TObject);
    procedure edtDateKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure edtOrderSerialKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure btnFilterClick(Sender: TObject);
    procedure btnReViewClick(Sender: TObject);
    procedure btnExitClick(Sender: TObject);
    procedure ListViewColumnClick(Sender: TObject; Column: TListColumn);
    procedure btnReturnGoodsClick(Sender: TObject);
    procedure btnTuneClick(Sender: TObject);
    procedure btnCopyClick(Sender: TObject);
    procedure btnDeleteClick(Sender: TObject);
    procedure btnExcelClick(Sender: TObject);


  private
    { Private declarations }
    function  ReturnValueToVariable(Target: Pointer; CtrlList: PCONTROL_LIST): Boolean;
    procedure SetData(Item: Pointer);
    procedure SetNull;
    function  MakeNewRecord: Pointer;
    function  UpdateProc: Boolean;

    //////////////////////////////////////
    function  SetListColumn: Integer;
    function  SetListView(StartIX: Integer; SelRecID: LongInt): Integer;

    function  ListSelCheck: Boolean;
    function  RECExists(RecID: LongInt): Boolean;
    procedure DrawExplanatoryNotes;
    procedure SetInvValue(Data: PINVENTORY; var InvValue: TINVENTORY_VALUE);

    Procedure Set_EditReadOnly(iBool: Boolean; iKind: Integer; is_account,is_close: Integer);
    Procedure ReturnProc(Cnt: Integer; DBL: Double; rtnEmpid,rtncause,rtnTid: string);
    procedure DeleteProc;
    procedure CopyProc(Cnt: Integer; DBL: Double; rtnEmpid,rtncause: string);

    Procedure PrintProc;
    function  CopyToClipBoard(var RecCnt, ColCnt: Integer): string;

    procedure SetMultilingual;
  public
    { Public declarations }
    procedure ReViewProc;
    procedure ReReadProc(ReViewFlg: Boolean);
    procedure ListDelProc(RecID: LongInt);
    function  SetInventoryCnt(RID, CD,GUAGE_ID: LongInt; STK_ID: string; DT: TDateTime; var Cnt: Double): Double;
    procedure SetBalanceList(RID: LongInt; List: TList; DT: TDateTime);

  protected
    { Protected declarations }
    procedure MakeItemCaption(Item: TListItem); override;
    procedure SetNew; override;
    procedure SetKomoku(Item:TListItem); override;
    function  NewErrorCheck:Boolean; override;

  end;

var
  frmInvHistory: TfrmInvHistory;
  ListSortKey: Integer;
  tmpIniData: TIniFileData;
  tmpWdate: array[0..1] of TDatetime;
  FQryIOHistoryList: TList;

implementation

uses Main, InvDM, MatIN, MatOUT, IOQryFrm, InvDiaEd, TuneInvQty, OtherMatOut;

{$R *.dfm}

//-- TListSortCompare --
function ListSortCompare(Item1, Item2: Pointer): Longint;
var DataType: Integer;
    Str1, Str2: string;
    Int1, Int2: Integer;
    Dbl1, Dbl2: Double;
    Dat1, Dat2: TDateTime;
begin
  Result := 0;
  Str1 := ''; Str2 := '';
  Int1 := 0;  Int2 := 0;
  Dbl1 := 0;  Dbl2 := 0;
  Dat1 := 0;  Dat2 := 0;
  case Abs(ListSortKey) of
    1: begin //--
        Int1 := TINVENTORY(Item1^).KIND;
        Int2 := TINVENTORY(Item2^).KIND;
        DataType := 1;
       end;
    2: begin //--
        Str1 := TINVENTORY(Item1^).STK_ID;
        Str2 := TINVENTORY(Item2^).STK_ID;
        DataType := 0;
       end;
    3: begin //--
        Dat1 := TINVENTORY(Item1^).DATE;
        Dat2 := TINVENTORY(Item2^).DATE;
        DataType := 3;
       end;
    4: begin //--
        Int1 := TINVENTORY(Item1^).ODR_RID;
        Int2 := TINVENTORY(Item2^).ODR_RID;
        DataType := 1;
       end;
    5..7: begin //--
        Str1 := dm_inventory.GetMaterialCode(TINVENTORY(Item1^).MAT_RID)+RightStr(('0000000'+InttoStr(TINVENTORY(Item1^).GUAGE_ID)),6);
        Str2 := dm_inventory.GetMaterialCode(TINVENTORY(Item2^).MAT_RID)+RightStr(('0000000'+InttoStr(TINVENTORY(Item2^).GUAGE_ID)),6);
        DataType := 0;
       end;

    9: begin //--
        Dbl1 := TINVENTORY(Item1^).UNT_PRICE;
        Dbl2 := TINVENTORY(Item2^).UNT_PRICE;
        DataType := 2;
       end;
    10: begin //--
        Dbl1 := Abs(TINVENTORY(Item1^).QUANTITY);
        Dbl2 := Abs(TINVENTORY(Item2^).QUANTITY);
        DataType := 2;
       end;
    11: begin //--
        Dbl1 := Abs(TINVENTORY(Item1^).MAK_PRICE);
        Dbl2 := Abs(TINVENTORY(Item2^).MAK_PRICE);
        DataType := 2;
       end;
    12: begin //--
        Dbl1 := Abs(TINVENTORY(Item1^).TTL_PRICE);
        Dbl2 := Abs(TINVENTORY(Item2^).TTL_PRICE);
        DataType := 2;
       end;
    16: begin //--
        Int1 := TINVENTORY(Item1^).HAT_RID;
        Int2 := TINVENTORY(Item2^).HAT_RID;
        DataType := 1;
       end;

    20: begin //--
        Int1 := TINVENTORY(Item1^).SUP_CD;
        Int2 := TINVENTORY(Item2^).SUP_CD;
        DataType := 1;
       end;
    21: begin //--
        Int1 := TINVENTORY(Item1^).MAK_CD;
        Int2 := TINVENTORY(Item2^).MAK_CD;
        DataType := 1;
       end;
    22: begin //--
        Str1 := TINVENTORY(Item1^).PaperNo;
        Str2 := TINVENTORY(Item2^).PaperNo;
        DataType := 0;
       end;

    24: begin //--
        Str1 := TINVENTORY(Item1^).recieve_EmpID;
        Str2 := TINVENTORY(Item2^).recieve_EmpID;
        DataType := 0;
       end;
    25: begin //--
        Str1 := TINVENTORY(Item1^).input_empid;
        Str2 := TINVENTORY(Item2^).input_empid;
        DataType := 0;
        end;
    26: begin //--
        Str1 := TINVENTORY(Item1^).invoice_no;
        Str2 := TINVENTORY(Item2^).invoice_no;
        DataType := 0;
        end;
    27: begin //--
        Str1 := TINVENTORY(Item1^).iss_paperno;
        Str2 := TINVENTORY(Item2^).iss_paperno;
        DataType := 0;
        end;
  else Exit;
  end;
  case DataType of
    0: if Str1 < Str2 then  Result := -1
       else if Str1 > Str2 then Result := 1
       else Result := 0;
    1: if Int1 < Int2 then  Result := -1
       else if Int1 > Int2 then Result := 1
       else Result := 0;
    2: if Dbl1 < Dbl2 then  Result := -1
       else if Dbl1 > Dbl2 then Result := 1
       else Result := 0;
    3: if Dat1 < Dat2 then  Result := -1
       else if Dat1 > Dat2 then Result := 1
       else Result := 0;
  else Result := 0;
  end;
  if ListSortKey < 0 then Result := Result * -1;
end;


procedure TfrmInvHistory.FormCreate(Sender: TObject);
var View: TINVENTORY;
    IX:   Integer;
begin
  inherited;
  Top    := frmMain.Height;
  Left   := 0;
  Width  := Screen.Width;
  Height := Screen.Height-(frmMain.Height+stsBarCnt.Height+8);

  FQryIOHistoryList := TList.Create;
  FQryIOHistoryList.Clear;

  IX := 0;
  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(edtPaperNo,  IX,Longint(@View.PAPERNO)-     Longint(@View),nil,nil);
  Inc(IX);
  InitCtrlList(edtCode,    IX,Longint(@View.MAT_RID)-  Longint(@View),nil,nil);
  Inc(IX);
  InitCtrlList(edtName,    IX,Longint(@View.MAT_NM)-   Longint(@View),nil,nil);
  Inc(IX);
  InitCtrlList(edtIssGuageID,    IX,Longint(@View.GUAGE_ID)-   Longint(@View),nil,nil);
  Inc(IX);
  InitCtrlList(edtUPrice,  IX,Longint(@View.UNT_PRICE)-Longint(@View),nil,nil);
  Inc(IX);
  InitCtrlList(edtQuantity,IX,Longint(@View.QUANTITY)- Longint(@View),nil,nil);
  Inc(IX);
  InitCtrlList(edtMakePrice,IX,Longint(@View.MAK_PRICE)- Longint(@View),nil,nil);
  Inc(IX);
  InitCtrlList(edtUseGuageName,    IX,Longint(@View.USE_GUAGE)-   Longint(@View),nil,nil);
  Inc(IX);
  InitCtrlList(edtUseQuantity,IX,Longint(@View.USE_QUANTITY)- Longint(@View),nil,nil);
  Inc(IX);
  InitCtrlList(edtOrderSerial, IX,Longint(@View.HAT_RID)-  Longint(@View),nil,nil);
  Inc(IX);
  InitCtrlList(edtHatCode,     IX,Longint(@View.HAT_CODE)-  Longint(@View),nil,nil);
  Inc(IX);
  InitCtrlList(edtMoldID, IX,Longint(@View.ODR_RID)-  Longint(@View),nil,nil);
  Inc(IX);
  InitCtrlList(edtPartID, IX,Longint(@View.PAT_RID)-  Longint(@View),nil,nil);
  Inc(IX);
  InitCtrlList(edtSuplierCode, IX,Longint(@View.SUP_CD)-  Longint(@View),nil,nil);
  Inc(IX);
  InitCtrlList(edtMakerCode, IX,Longint(@View.MAK_CD)-  Longint(@View),nil,nil);
  Inc(IX);
  InitCtrlList(edtMatOutID, IX,Longint(@View.INOUT_ID)-  Longint(@View),nil,nil);
  Inc(IX);
  InitCtrlList(edtRecEmpID, IX,Longint(@View.recieve_EmpID)-  Longint(@View),nil,nil);
  Inc(IX);
  InitCtrlList(edtInputEmpID, IX,Longint(@View.input_empid)-  Longint(@View),nil,nil);
  Inc(IX);
  InitCtrlList(edtInvoiceNo, IX,Longint(@View.invoice_no)-  Longint(@View),nil,nil);
  Inc(IX);
  InitCtrlList(edtIssPaper, IX,Longint(@View.ISS_PAPERNO)-  Longint(@View),nil,nil);
  Inc(IX);
  InitCtrlList(edtSequalNo, IX,Longint(@View.SEQUAL_NO)-  Longint(@View),nil,nil);
  Inc(IX);
  InitCtrlList(edtNote, 99,Longint(@View.NOTE)-  Longint(@View),nil,nil);
  PostCtrlList;
  
  SetMultilingual;
  FColumnCount := SetListColumn;
end;

procedure TfrmInvHistory.FormShow(Sender: TObject);
begin
  inherited;
  Top    := frmMain.Height;
  Left   := 0;
  Width  := Screen.Width;
  Height := Screen.Height-(frmMain.Height+stsBarCnt.Height+8);
  
  //////////////////////////////////////////////////
  DrawExplanatoryNotes;
  //////////////////////////////////////////////////
  tmpIniData := frmMain.IniData;
  if tmpIniData.listdate[0]='' then tmpWdate[0] := 2
  else tmpWdate[0] := strtodatetime(tmpIniData.listdate[0]+' 00:00:00');

  if tmpIniData.listdate[1]='' then tmpWdate[1] := strtodatetime(formatdatetime('yyyy/mm/dd', Now)+ ' 23:59:59')
  else tmpWdate[1] := strtodatetime(tmpIniData.listdate[1]+' 23:59:59');
12345

⌨️ 快捷键说明

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