invoicelist.~pas

文件包含程序源原文件

unit InvoiceList;

interface

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

type
  TfrmInvoiceList = class(TForm)
    Panel1: TPanel;
    rdoGroup: TRadioGroup;
    btnExcel: TBitBtn;
    edtPaperNo: TLabeledEdit;
    edtInvoiceNo: TLabeledEdit;
    cbxSup: TComboBox;
    edtSuplier: TLabeledEdit;
    edtSupName: TEdit;
    Panel2: TPanel;
    TabsCtrlAccount: TTabControl;
    tabsUnAccount: TTabControl;
    pnlCheck: TPanel;
    Panel11: TPanel;
    PNLList: TPanel;
    btnAccount: TSpeedButton;
    UnAcc_ListView: TGradLineListView;
    ImageList: TImageList;
    edtMoldCode: TLabeledEdit;
    edtOrderCode: TLabeledEdit;
    edtFDate: TDateTimePicker;
    edtEDate: TDateTimePicker;
    lblFDate: TLabel;
    lblEDate: TLabel;
    Image1: TImage;
    Label1: TLabel;
    Bevel1: TBevel;
    GroupBox1: TGroupBox;
    btnExit: TSpeedButton;
    btnQuery: TSpeedButton;
    stsBarCnt: TStatusBar;
    lblTotalQty: TLabel;
    lblToalAmount: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure tabsUnAccountChange(Sender: TObject);
    procedure btnQueryClick(Sender: TObject);
    procedure btnExitClick(Sender: TObject);
    procedure btnExcelClick(Sender: TObject);
    procedure TabsCtrlAccountChange(Sender: TObject);
    procedure rdoGroupClick(Sender: TObject);
    procedure cbxSupDropDown(Sender: TObject);
    procedure cbxSupChange(Sender: TObject);
    procedure btnAccountClick(Sender: TObject);
    procedure UnAcc_ListViewColumnClick(Sender: TObject;
      Column: TListColumn);
    procedure edtSuplierChange(Sender: TObject);
  private
    { Private declarations }
    ////////////////////////////////////////////////////////////////
    Procedure SetListViewColumn(sListView: TGradLineListView);
    Procedure SetListView(sListView: TGradLineListView);
    procedure MakeItemCaption(sListView: TGradLineListView; Item: TListItem);

    Procedure ConfirmOrCancel_AccountProc(iAll_Sts: integer);

    Procedure SetMultilingual;
  public
    { Public declarations }
    ///////////////////////////////////////////////////////////////////////
    Function  Set_QueryedList(sList: TList; AccStatus: Integer): TList;
    Procedure CreateTabs_ByGroup(rdoIndex: integer; sList: TList; sTab: TTabControl);
    Procedure Set_QryList_FromTabs(iTab: integer);

    Function  CheckViewData(lcP: PINVENTORY; rdoTitleIndex,TabIndex: integer): boolean;

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

  end;

var
  frmInvoiceList: TfrmInvoiceList;
  //////////////////////////////////////////
  FAllRptList,
  FQueryList: TList;
  FColumnCnt, ListSortKey: Integer;

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

implementation

uses Main, InvDM;

{$R *.dfm}

function ListSortCompare(Item1, Item2: Pointer): Longint;
var DataType: Integer;
    Str1, Str2: string;
    Int1, Int2: Integer;
    Dbl1, Dbl2: Double;
begin
  Result := 0;
  Str1 := ''; Str2 := '';
  Int1 := 0;  Int2 := 0;
  Dbl1 := 0;  Dbl2 := 0;
  case Abs(ListSortKey) of
    1: begin //-- in/out date
        Str1 := TINVENTORY(Item1^).invoice_no;
        Str2 := TINVENTORY(Item2^).invoice_no;
        DataType := 0;
       end;
    2: begin //-- serialnum
        Dbl1 := TINVENTORY(Item1^).HAT_RID;
        Dbl2 := TINVENTORY(Item2^).HAT_RID;
        DataType := 2;
       end;
    3: begin //-- order code
        Str1 := TINVENTORY(Item1^).HAT_CODE;
        Str2 := TINVENTORY(Item2^).HAT_CODE;
        DataType := 0;
       end;
    4: begin //
        Str1 := TINVENTORY(Item1^).ISS_PAPERNO;
        Str2 := TINVENTORY(Item2^).ISS_PAPERNO;
        DataType := 0;
       end;
    5: begin //
        Str1 := TINVENTORY(Item1^).PaperNo;
        Str2 := TINVENTORY(Item2^).PaperNo;
        DataType := 0;
       end;
    6: begin //--
        Str1 := formatdatetime('yy/mm/dd hh:mm',TINVENTORY(Item1^).DATE);
        Str2 := formatdatetime('yy/mm/dd hh:mm',TINVENTORY(Item2^).DATE);
        DataType := 0;
       end;
    7: begin //-- material rec_id
        Str1 := dm_inventory.GetMaterialCode(TINVENTORY(Item1^).MAT_RID);
        Str2 := dm_inventory.GetMaterialCode(TINVENTORY(Item2^).MAT_RID);
        DataType := 0;
       end;
    8..10: begin //
        Str1 := TINVENTORY(Item1^).MAT_NM;
        Str2 := TINVENTORY(Item2^).MAT_NM;
        DataType := 0;
       end;
    11: begin //
        Dbl1 := TINVENTORY(Item1^).QUANTITY;
        Dbl2 := TINVENTORY(Item2^).QUANTITY;
        DataType := 2;
       end;
    12: begin //
        Dbl1 := TINVENTORY(Item1^).UNT_PRICE;
        Dbl2 := TINVENTORY(Item2^).UNT_PRICE;
        DataType := 2;
       end;
    13: begin //
        Dbl1 := TINVENTORY(Item1^).MAK_PRICE;
        Dbl2 := TINVENTORY(Item2^).MAK_PRICE;
        DataType := 2;
       end;
    14: begin //
        Dbl1 := TINVENTORY(Item1^).TTL_PRICE;
        Dbl2 := TINVENTORY(Item2^).TTL_PRICE;
        DataType := 2;
       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;
  else Result := 0;
  end;
  if ListSortKey < 0 then Result := Result * -1;
end;

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

  FAllRptList := TList.Create;
  FAllRptList.Clear;
  FQueryList := TList.Create;
  FQueryList.Clear;

  SetMultilingual;
end;

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

  rdoGroup.ItemIndex := 8;
  //-- Initlize Edit Value
  edtFDate.Date     := strToDate(FormatDatetime('yy/mm/dd',Now-3));
  edtEDate.Date     := strToDate(FormatDatetime('yy/mm/dd',Now+1));
  edtSuplier.Text   := '';
  edtSupName.Text   := '';
  edtPaperNo.Text   := '';
  edtInvoiceNo.Text := '';

  TabsCtrlAccount.TabIndex := 0;
  dm_inventory.Read_InventoryRpt(FALSE, FAllRptList,0,edtFDate.Date,edtEDate.Date);
  Set_QueryedList(FQueryList,TabsCtrlAccount.TabIndex);
  CreateTabs_ByGroup(rdoGroup.ItemIndex,FQueryList,tabsUnAccount);
  tabsUnAccountChange(self);
end;

procedure TfrmInvoiceList.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action := CaFree;
end;

/////////////////////////////////////////////////////

procedure TfrmInvoiceList.btnQueryClick(Sender: TObject);
begin
  dm_inventory.Read_InventoryRpt(false, FAllRptList,0,edtFDate.Date,edtEDate.Date);
  Set_QueryedList(FQueryList,TabsCtrlAccount.TabIndex);
  CreateTabs_ByGroup(rdoGroup.ItemIndex,FQueryList,tabsUnAccount);
  tabsUnAccountChange(self);
end;

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

procedure TfrmInvoiceList.btnExcelClick(Sender: TObject);
begin
  if UnAcc_ListView.Items.Count > 0 then  PrintProc;
end;

procedure TfrmInvoiceList.tabsUnAccountChange(Sender: TObject);
begin
  dm_inventory.Read_InventoryRpt(false, FAllRptList,0,edtFDate.Date,edtEDate.Date);
  Set_QueryedList(FQueryList,0);
  Set_QryList_FromTabs(tabsUnAccount.TabIndex);
  SetListView(UnAcc_ListView);

  if UnAcc_ListView.Items.Count>0 then begin
    UnAcc_ListView.ToPItem.Selected := False;
    UnAcc_ListView.ToPItem.Selected := True;
  end;
end;

procedure TfrmInvoiceList.rdoGroupClick(Sender: TObject);
begin
  btnQueryClick(self);
end;

procedure TfrmInvoiceList.TabsCtrlAccountChange(Sender: TObject);
begin
  btnQueryClick(self);
end;

/////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////
procedure TfrmInvoiceList.MakeItemCaption(sListView: TGradLineListView; Item: TListItem);
  //-- Init int value and '' to 0 value
  function IntToStrNull(INum: Integer): string;
  begin
    if INum = 0 then Result := ''
    else Result := IntToStr(INum);
  end;
var lcP: PINVENTORY;
begin
  if Item = nil then Exit;
  if Item.Data = nil then Exit;
  lcP := Item.Data;
  Item.ImageIndex := lcP^.IS_ACCOUNT;

  Item.Caption      := lcp^.invoice_no;
  Item.SubItems[00] := inttostr(lcp^.HAT_RID);
  Item.SubItems[01] := strpas(lcp^.HAT_CODE);
  Item.SubItems[02] := strpas(lcp^.ISS_PAPERNO);
  Item.SubItems[03] := strpas(lcp^.PaperNo);
  Item.SubItems[04] := formatdatetime('yy/mm/dd',lcP^.DATE);
  Item.SubItems[05] := dm_inventory.GetOrderNo(lcp^.ODR_RID);
  Item.SubItems[06] := dm_inventory.GetPartCode(lcp^.ODR_RID,lcp^.PAT_RID);
  Item.SubItems[07] := dm_inventory.GetMaterialCode(lcP^.MAT_RID);;
  Item.SubItems[08] := lcP^.MAT_NM;;
  Item.SubItems[09] := dm_inventory.Get_GuageName(lcP^.MAT_RID, lcp^.GUAGE_ID);
  Item.SubItems[10] := dm_inventory.GetUnitTypeName(lcP^.MAT_RID);
  Item.SubItems[11] := FormatFloat('#,##0.00',abs(lcP^.QUANTITY));
  Item.SubItems[12] := FormatFloat('#,##0.00',abs(lcP^.UNT_PRICE));
  Item.SubItems[13] := FormatFloat('#,##0.00',abs(lcP^.MAK_PRICE));
  Item.SubItems[14] := FormatFloat('#,##0.00',abs(UserDecimalDefine(lcP^.TTL_PRICE,-2)));
  Item.SubItems[15] := dm_inventory.GetShigenName(lcp^.SUP_CD);
  Item.SubItems[16] := dm_inventory.GetShigenName(lcp^.MAK_CD);
  Item.SubItems[17] := lcp^.NOTE;
  Item.SubItems[18] := lcp^.STK_ID;
end;

procedure TfrmInvoiceList.SetListView(sListView: TGradLineListView);
var i,j: Integer;
    lcP: PINVENTORY;
    Item: TListItem;
    sqty,samt: Double;
begin
  Screen.Cursor  := crHourGlass;
  with sListView.Items do begin
    BeginUpdate;
    Clear;
    EndUpdate;
  end;
  SetListViewColumn(sListView);