invquery.~pas

文件包含程序源原文件

unit InvQuery;

interface

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

type
  TfrmBalance = class(TForm)
    Panel1: TPanel;
    Panel3: TPanel;
    btnReView: TSpeedButton;
    btnFilterQuery: TSpeedButton;
    ListView: TGradLineListView;
    lblCompute: TLabel;
    Image1: TImage;
    ImageList: TImageList;
    Panel5: TPanel;
    Panel6: TPanel;
    btnExcel: TBitBtn;
    chkboxchkQty: TCheckBox;
    Panel7: TPanel;
    btnClose: TBitBtn;
    chkPCS: TCheckBox;
    chkStkLess0: TCheckBox;
    stsBarCnt: TStatusBar;
    pnlBalance: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure btnFilterQueryClick(Sender: TObject);
    procedure btnReViewClick(Sender: TObject);
    procedure btnCloseClick(Sender: TObject);
    procedure btnExcelClick(Sender: TObject);
    procedure ListViewColumnClick(Sender: TObject; Column: TListColumn);

  private
    { Private declarations }
    procedure SetListColumn;
    procedure SetListView;
    procedure MakeItemCaption(Item: TListItem);
    Procedure DrawSafeStockImage;
    
    procedure SetBalanceList(RID: LongInt; List: TList; DT: TDateTime);

    Procedure SetMultilingual;
  public
    { Public declarations }
    procedure ReViewProc;
    Procedure PrintProc;
    function  CopyToClipBoard(var RecCnt, ColCnt: Integer): string;

  end;

var
  frmBalance: TfrmBalance;
  BalanceList, FList: TList;
  FColumnCount: Integer;
  ListSortKey: Integer;

implementation

uses Main, InvDM, InvCondQry;

{$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 //--
        Str1 := TBALANCE(Item1^).STK_ID;
        Str2 := TBALANCE(Item2^).STK_ID;
        DataType := 0;
       end;
    2: begin //--
        Str1 := dm_inventory.GetMaterialCode(TBALANCE(Item1^).CODE)+RightStr(('0000000'+InttoStr(TBALANCE(Item1^).GUAGE_ID)),6);
        Str2 := dm_inventory.GetMaterialCode(TBALANCE(Item2^).CODE)+RightStr(('0000000'+InttoStr(TBALANCE(Item2^).GUAGE_ID)),6);
        DataType := 0;
       end;
    3: begin //--
        Str1 := TBALANCE(Item1^).NAME;
        Str2 := TBALANCE(Item2^).NAME;
        DataType := 0;
       end;
    4: begin //--
        Str1 := dm_inventory.GetMaterialCode(TBALANCE(Item1^).CODE)+RightStr(('0000000'+InttoStr(TBALANCE(Item1^).GUAGE_ID)),6);
        Str2 := dm_inventory.GetMaterialCode(TBALANCE(Item2^).CODE)+RightStr(('0000000'+InttoStr(TBALANCE(Item2^).GUAGE_ID)),6);
        DataType := 0;
       end;
    6: begin //--
        Str1 := dm_inventory.GetUnitTypeName(TBALANCE(Item1^).CODE);
        Str2 := dm_inventory.GetUnitTypeName(TBALANCE(Item2^).CODE);
        DataType := 0;
       end;
    7: begin //--
        Dbl1 := TBALANCE(Item1^).U_PRICE;
        Dbl2 := TBALANCE(Item2^).U_PRICE;
        DataType := 2;
       end;
    8: begin //--
        Dbl1 := TBALANCE(Item1^).QUANTITY;
        Dbl2 := TBALANCE(Item2^).QUANTITY;
        DataType := 2;
       end;
    9: begin //--
        Dbl1 := TBALANCE(Item1^).T_PRICE;
        Dbl2 := TBALANCE(Item2^).T_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;
    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 TfrmBalance.FormCreate(Sender: TObject);
begin
  Top    := frmMain.Height;
  Left   := 0;
  Width  := Screen.Width;
  Height := Screen.Height-(frmMain.Height+stsBarCnt.Height+8);

  FList := TList.Create;
  FList.Clear;

  BalanceList := TList.Create;
  BalanceList.Clear;

  SetMultilingual;
  SetListColumn;
  ReViewProc;
end;

procedure TfrmBalance.FormActivate(Sender: TObject);
begin
  if frmMain.IniData.isCheckQty then begin
    chkboxchkQty.Visible := true;
    chkboxchkQty.Checked := true;
  end else begin
    chkboxchkQty.Visible := false;
    chkboxchkQty.Checked := false;
  end;
end;


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

  chkStkLess0.Checked := false;
  DrawSafeStockImage;
end;

procedure TfrmBalance.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  dm_Inventory.Delete_NullMaterial;
  Action := caFree;
end;

procedure TfrmBalance.SetListColumn;
var Column: TListColumn;
begin
  FColumnCount := 0;
  ListView.Columns.Clear;

  Column := ListView.Columns.Add;
  Column.Width   := ListView.Font.Size * 6;
  Column.Caption := GetMultiLingalMsg(90027, 'Stock ID');
  Inc(FColumnCount);
  Column := ListView.Columns.Add;
  Column.Width   := ListView.Font.Size * 14;
  Column.Caption := GetMultiLingalMsg(90028, 'Material Code');
  Inc(FColumnCount);
  Column := ListView.Columns.Add;
  Column.Width   := ListView.Font.Size * 14;
  Column.Caption := GetMultiLingalMsg(90029, 'Material Name');
  Inc(FColumnCount);
  Column := ListView.Columns.Add;
  Column.Width   := ListView.Font.Size * 7;
  Column.Caption := GetMultiLingalMsg(90030, 'Guage ID');
  Inc(FColumnCount);
  Column := ListView.Columns.Add;
  Column.Width   := ListView.Font.Size * 18;
  Column.Caption := GetMultiLingalMsg(90031, 'Guage Name');
  Inc(FColumnCount);
  Column := ListView.Columns.Add;
  Column.Width   := ListView.Font.Size * 6;
  Column.Caption := GetMultiLingalMsg(90032, 'Unit Name');
  Inc(FColumnCount);
  Column := ListView.Columns.Add;
  Column.Width     := ListView.Font.Size * 8;
  Column.Alignment := taRightJustify;
  Column.Caption   := GetMultiLingalMsg(90033, 'Unit Price');
  Inc(FColumnCount);
  Column := ListView.Columns.Add;
  Column.Width     := ListView.Font.Size * 10;
  Column.Alignment := taRightJustify;
  Column.Caption   := GetMultiLingalMsg(90034, 'Inventory Quantity');
  Inc(FColumnCount);
  Column := ListView.Columns.Add;
  Column.Width     := ListView.Font.Size * 11;
  Column.Alignment := taRightJustify;
  Column.Caption   := GetMultiLingalMsg(90035, 'Inventory Amount');
  Inc(FColumnCount);
  //--
  Column := ListView.Columns.Add;
  Column.Width     := ListView.Font.Size * 8;
  Column.Alignment := taRightJustify;
  Column.Caption   := '';
  Inc(FColumnCount);
end;

procedure TfrmBalance.SetListView;
var IX_1, IX_2: Integer;
    lcP: PBALANCE;
    Item: TListItem;
    Tmp: string;
begin
  Screen.Cursor  := crHourGlass;
  Tmp := GetMultiLingalMsg(90036, 'Caculate Mode of Inventory Material');

  case StrToIntDef(frmMain.IniData.OutPrice, 0) of
    0: lblCompute.Caption := Tmp + ': ' + GetMultiLingalMsg(90037, 'Avg Price');
    1: lblCompute.Caption := Tmp + ': ' + GetMultiLingalMsg(90038, 'FILO');
    2: lblCompute.Caption := Tmp + ': ' + GetMultiLingalMsg(90039, 'FIFO');
    3: lblCompute.Caption := Tmp + ': ' + GetMultiLingalMsg(90040, 'Standard Price');
  else lblCompute.Caption := '';
  end;
  with ListView.Items do begin
    BeginUpdate;
    Clear;
    EndUpdate;
  end;

  //////////////////////////////////
  ListView.Items.BeginUpdate;
  try
    for IX_1:=0 to BalanceList.Count-1 do begin
      lcP  := BalanceList.Items[IX_1];

      if chkStkLess0.Checked then
      begin
        if (RoundTo(lcp^.QUANTITY,-2)<=0.00) then continue;
      end;

      Item := ListView.Items.Add;
      for IX_2:=0 to FColumnCount-2 do Item.Subitems.Add('');
      Item.Data := lcP;
      MakeItemCaption(Item);
    end;
  finally
    ListView.Items.EndUpdate;
    ListView.Items.EndUpdate;
    if ListView.Items.Count > 0 then
    begin
      ListView.TopItem.Selected := True;
      ListView.Selected.Selected := true;
    end;
    stsBarCnt.Panels[0].Text := '符合条件的记录有：'+ IntToStr(ListView.Items.Count)+' 条';
    Screen.Cursor := crDefault;
  end;
end;

procedure TfrmBalance.MakeItemCaption(Item: TListItem);
var lcP: PBALANCE;
begin
  if Item = nil then Exit;
  if Item.Data = nil then Exit;
  lcP := Item.Data;

  Item.ImageIndex   := lcP^.IS_SAFETY;
  Item.Caption      := lcp^.STK_ID;
  Item.SubItems[00] := dm_inventory.GetMaterialCode(lcP^.CODE);
  Item.SubItems[01] := lcP^.NAME;
  Item.SubItems[02] := IntToStr(lcp^.GUAGE_ID);
  Item.SubItems[03] := lcp^.GUAGE_NAME;
  Item.SubItems[04] := dm_inventory.GetUnitTypeName(lcP^.CODE);
  Item.SubItems[05] := FormatFloat('#,##0.00', lcP^.U_PRICE);
  Item.SubItems[06] := FormatFloat('#,##0.00', lcP^.QUANTITY);
  Item.SubItems[07] := FormatFloat('#,##0.00', lcP^.T_PRICE);
  if chkPCS.Checked then begin
    ListView.Column[9].Caption := GetMultiLingalMsg(90275, '->PCS');
    Item.SubItems[08] := FormatFloat('#,##0.00', Ceil(lcp^.QUANTITY/dm_inventory.Get_MatGuageWgtPcs(lcp^.CODE,lcp^.GUAGE_ID)));
  end
  else begin
    ListView.Column[9].Caption := '';
    Item.SubItems[08] := '';
  end;
end;

Procedure TfrmBalance.DrawSafeStockImage;
var
  SExplains: array[0..1] of string;
  i, x, y, TextW: Integer;
begin
  SExplains[0] := GetMultiLingalMsg(90041, '< Safety Inventory');
  SExplains[1] := GetMultiLingalMsg(90042, '>=Safety Inventory');

  with Image1.Canvas do begin
    TextW := TextWidth(SExplains[0]);
    if TextW < TextWidth(SExplains[1]) then
      TextW := TextWidth(SExplains[1]);

    Pen.Color := clBlack;
    Brush.Color := clBtnFace;
    FillRect(ClientRect);
    y := 5;
    for i:= 0 to 1 do begin
      x := i * (ImageList.Width+4 + TextW);
      ImageList.Draw(Image1.Canvas, x, y, i);
      TextOut(x+17, y+2, SExplains[i]);
    end;
  end;
end;

procedure TfrmBalance.ReViewProc;
begin
  dm_inventory.ReadInventory(True, FList);

  SetBalanceList(-1, BalanceList, StrToDateTime('2999/12/31'));
  Screen.Cursor  := crHourGlass;
  try
    SetListView;
  finally
    Screen.Cursor := crDefault;