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

📄 invioid.pas

📁 文件包含程序源原文件
💻 PAS
字号:
unit InvIOID;

interface

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

type
  TfrmIOID = class(TForm)
    tabIOID: TTabControl;
    Panel1: TPanel;
    Panel2: TPanel;
    edtCode: TLabeledEdit;
    edtName: TLabeledEdit;
    edtNote: TLabeledEdit;
    Panel4: TPanel;
    btnNew: TSpeedButton;
    btnDel: TSpeedButton;
    btnUpdate: TSpeedButton;
    Panel3: TPanel;
    Memo1: TMemo;
    ListViewIO: TListView;
    stsBarCnt: TStatusBar;
    Panel5: TPanel;
    Panel6: TPanel;
    Panel7: TPanel;
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure tabIOIDChange(Sender: TObject);
    procedure ListViewIOChange(Sender: TObject; Item: TListItem; Change: TItemChange);
    procedure ListViewIOClick(Sender: TObject);
    procedure btnNewClick(Sender: TObject);
    procedure btnDelClick(Sender: TObject);
    procedure btnUpdateClick(Sender: TObject);
  private
    { Private declarations }

    Procedure ReadIOIDListView(groupcd: integer);
    function  SetListColumn: Integer;
    function  SetListView: Integer;
    procedure ClearListView;

    procedure MakeItemCaption(Item: TListItem);
    procedure Set_currItem(Item: TListItem);
    procedure SetNull;

    Procedure SetMultilingual;
  public
    { Public declarations }

    procedure Set_NewIOID(LstView: TListView);
    procedure Set_UpdateIOID(LstView: TListView);
    procedure Set_DeleteIOID(LstView: TListView);


  end;

var
  frmIOID: TfrmIOID;

  FIOIDList: TList;
  FSelectedItem: TListItem;
  FOnMakeItemCaption,
  FListViewClear,
  FOnCloseForm: Boolean;
  FColumnCount,
  FGroupCD: integer;



implementation

uses Main, InvDM;

{$R *.dfm}

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

  FIOIDList := TList.Create;
  FIOIDList.Clear;

  SetMultilingual;
end;

procedure TfrmIOID.FormShow(Sender: TObject);
begin
  Top    := frmMain.Height;
  Left   := 0;
  Width  := Screen.Width;
  Height := Screen.Height-(frmMain.Height+stsBarCnt.Height+8);
  
  FOnCloseForm := false;
  FGroupCd := tabIOID.TabIndex+1;
  ReadIOIDListView(FGroupCd);
end;

procedure TfrmIOID.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  dm_inventory.ListFreeMemory(FIOIDList)
end;

procedure TfrmIOID.tabIOIDChange(Sender: TObject);
begin
  FGroupCD := tabIOID.TabIndex+1;
  ReadIOIDListView(FGroupCD);
end;

procedure TfrmIOID.ListViewIOChange(Sender: TObject; Item: TListItem; Change: TItemChange);
begin
  if FOnCloseForm then exit;
  if Item.Data = nil then
  begin
    setNull;
    exit;
  end
  else Set_currItem(ListViewIO.Selected);
end;

procedure TfrmIOID.ListViewIOClick(Sender: TObject);
begin
///
end;

{********************************************************************************}
Procedure TfrmIOID.ReadIOIDListView(groupcd: integer);
var
  i: Integer;
  SaveCursor: TCursor;
begin
  for i := 0 to FIOIDList.Count - 1 do
    Dispose(FIOIDList.Items[i]);
  FIOIDList.Clear;

  SaveCursor := Screen.Cursor;
  Screen.Cursor := crSqlWait;

  try
    dm_Inventory.Read_IOIDInfo(FGroupCD,FIOIDList);

    FListViewClear:=True;

    FColumnCount := SetListColumn; //--

    ListViewIO.Selected := nil;

    if SetListView > 0 then
    begin
      ListViewIO.TopItem.Selected := True;
      ListViewIO.TopItem.Focused := True;
      ListViewIO.SetFocus;
      FSelectedItem := ListViewIO.TopItem;
      Set_currItem(FSelectedItem);
    end;

    FListViewClear := False;

  finally
    stsBarCnt.Panels[0].Text := '符合条件的记录有:'+ IntToStr(ListViewIO.Items.Count)+' 条';
    Screen.Cursor := SaveCursor;
  end;
end;

function  TfrmIOID.SetListColumn: Integer;
var
  Column: TListColumn;
  Count: Integer;
begin
  ListViewIO.Columns.Clear;
  ListViewIO.Items.BeginUpdate;               //--
  ListViewIO.RowSelect := False;
  Count := 0;
  try
    Column := ListViewIO.Columns.Add;
      Column.Caption := GetMultiLingalMsg(90197, 'Code');
      Column.Width   := ListViewIO.Font.Size * 6;
      Inc(Count);

      Column := ListViewIO.Columns.Add;
      Column.Caption := GetMultiLingalMsg(90198, 'Name');
      Column.Width   := ListViewIO.Font.Size * 16;
      Inc(Count);

      Column := ListViewIO.Columns.Add;
      Column.Caption := GetMultiLingalMsg(90065, 'Remarks');
      Column.Width   := ListViewIO.Font.Size * 18;
      Column.Alignment := taLeftJustify;
      Inc(Count);
  finally
    ListViewIO.RowSelect := True;
    ListViewIO.Items.EndUpdate;               //--
  end;
  Result := Count;
end;

function  TfrmIOID.SetListView: Integer;
var
  i, j, ItemCount: Integer;
  lcP: PClassInfo;
  Item: TListItem;
begin
  ItemCount := 0;
  FListViewClear := True;

  ClearListView;

  FListViewClear := False;
  LockWindowUpdate(ListViewIO.Handle);
  try
    for i := 0 to FIOIDList.Count - 1 do begin
      lcP := FIOIDList[i];

      Item := ListViewIO.Items.Add;
      for j := 0 to FColumnCount - 2 do
        Item.Subitems.Add('');

      lcP^.FCurrItem := Item;
      Item.Data := lcP;

      MakeItemCaption(Item);
      Inc(ItemCount);
   end;
  finally
    LockWindowUpdate(0);
  end;
  Result := ItemCount;
end;

procedure TfrmIOID.ClearListView;
begin
  ListViewIO.Items.BeginUpdate;
  try
    ListViewIO.Items.Clear;
  finally
    ListViewIO.Items.EndUpdate;
  end;
end;

procedure TfrmIOID.MakeItemCaption(Item: TListItem);
var
  lcP: PClassInfo;
begin
  if Item = nil then Exit;

  lcP := Item.Data;
  if lcP = nil then Exit;

  FOnMakeItemCaption := True; //--
  Item.Caption     := lcP^.scode;
  Item.SubItems[0] := lcP^.sname;
  Item.SubItems[1] := lcp^.sMemo;
  FOnMakeItemCaption := False;
end;

procedure TfrmIOID.Set_currItem(Item: TListItem);
var
  lcp: PClassInfo;
begin 
  if (Item = nil) or ((item = nil) and (Item.Data <> nil)) then
  begin
    SetNull;
    exit;
  end    
  else begin
    FSelectedItem := nil;
    FSelectedItem := Item;
    lcp := Item.Data;

    edtCode.Text             := lcp^.sCode;
    edtName.Text             := lcp^.sName;
    edtNote.Text             := lcp^.sMemo;
  end;
end;

procedure TfrmIOID.SetNull;
begin
  FSelectedItem := nil;
  edtCode.Text             := '';
  edtName.Text             := '';
  edtNote.Text             := '';
end;

{*******************************************************************}
procedure TfrmIOID.Set_NewIOID(LstView: TListView);
var
  lcpNew: PClassInfo;
  j: integer;
  Item: TListItem;
begin
  New(lcpNew);
  SetNull;

  lcpNew^.sClassIndex          := FGroupCD;
  lcpNew^.scode              := 'New';
  if not dm_Inventory.isExists_IOID(lcpNew) then
  begin
    lcpNew^.sMainKey  := dm_Inventory.Get_AutoPaperNo('IO Code Information');
    lcpNew^.sname     := '';
    lcpNew^.smemo     := '';


    dm_Inventory.Insert_IOIDInfo(lcpNew);
    with lstView do
    begin
      Item := LstView.Items.Add;
      for j := 0 to FColumnCount - 2 do
        Item.Subitems.Add('');
        lcPNew^.FCurrItem := Item;
        Item.Data := lcPNew;
    end;
    MakeItemCaption(Item);
    Set_currItem(Item);
    Item.Selected := true;
    edtCode.SetFocus;
    edtCode.SelectAll;
  end
  else begin
    MessageDlg('I/O Code is Repeat!',mtError,[mbOK],0);
    Item := LstView.TopItem;
    FSelectedItem := Item;
    Set_currItem(Item);
    Item.Selected := true;    
    Exit;
  end;
end;

procedure TfrmIOID.Set_UpdateIOID(LstView: TListView);
var
  lcpUpd: PClassInfo;
  Item: TListItem;
  stsname: string;
begin
  if FSelectedItem = nil then exit;
  if FSelectedItem.Selected then lcpUpd := FSelectedItem.Data;

  lcpUpd^.scode            := trim(edtCode.Text);
  lcpUpd^.sname            := trim(edtName.Text);
  lcpUpd^.smemo           := trim(edtnote.Text);

  dm_Inventory.Update_IOIDInfo(lcpUpd);

  with lstView do
  begin
    lstView.Selected.Data := lcpUpd;
    Item := lstView.Selected;
    MakeItemCaption(Item);
    Set_currItem(Item);
    Item.Selected := true;
  end;
end;

procedure TfrmIOID.Set_DeleteIOID(LstView: TListView);
var
  lcpDel: PClassInfo;
  Item: TListItem;
begin
  if FSelectedItem = nil then exit;
  if FSelectedItem.Selected then lcpDel := FSelectedItem.Data;

  dm_Inventory.Delete_IOIDInfo(lcpDel);
  
  with lstView do
  begin
    lstView.Selected.Delete;
    IF LstView.Items.Count >0 then
    Item := lstView.TopItem
    else Item := Nil;
    if Item = Nil then exit;
    Item.Selected := true;
    MakeItemCaption(Item);
    Set_currItem(Item);
  end;
end;




procedure TfrmIOID.btnNewClick(Sender: TObject);
begin
  Set_NewIOID(ListViewIO);
end;

procedure TfrmIOID.btnDelClick(Sender: TObject);
begin
  Set_DeleteIOID(ListViewIO);
end;

procedure TfrmIOID.btnUpdateClick(Sender: TObject);
begin
  Set_UpdateIOID(ListViewIO);
end;

procedure TfrmIOID.SetMultilingual;
begin
  self.Caption              := GetMultiLingalMsg(90195, 'I/O Type Define');
  tabIOID.Tabs[0]           := GetMultiLingalMsg(90059, 'In Type');
  tabIOID.Tabs[1]           := GetMultiLingalMsg(90087, 'Out Type');
  tabIOID.Tabs[2]           := GetMultiLingalMsg(90109, 'Return Type');
  tabIOID.Tabs[3]           := GetMultiLingalMsg(90196, 'Tune Type');

  edtCode.EditLabel.Caption := GetMultiLingalMsg(90197, 'Code');
  edtName.EditLabel.Caption := GetMultiLingalMsg(90198, 'Name');
  edtNote.EditLabel.Caption := GetMultiLingalMsg(90065, 'Remarks');

  btnNew.Caption            := GetMultiLingalMsg(90066, 'New');
  btnDel.Caption            := GetMultiLingalMsg(90068, 'Delete');
  btnUpdate.Caption         := GetMultiLingalMsg(90173, 'Update');
end;

end.

⌨️ 快捷键说明

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