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

📄 base_common.pas

📁 一个MRPII系统源代码版本
💻 PAS
📖 第 1 页 / 共 4 页
字号:
unit Base_Common;

Interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Base, stdCtrls, grids, DBGridEh, ExtCtrls, Db, AdODB, ExtEdit, Mask,
  comCtrls, dbCtrls, linkedit;

Type
  TFrm_Base_Common = Class(TFrm_Base)

    AdoQry_Tmp: TAdoQuery;
    //本类专用
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormKeyPress(Sender: TObject; var Key: ChAr);
    procedure FormCreate(Sender: TObject);
    //普通
    procedure DateCheck(Sender: TObject);
    procedure MonthCheck(Sender: TObject);
    procedure FloatCheck(Sender: TObject);
    procedure IntegerCheck(Sender: TObject);
    procedure ConditionFloatCheck(Sender: TObject);
    procedure ConditionIntegerCheck(Sender: TObject);
    procedure TextCheck(Sender: TObject);
    //人员
    procedure EmployeeCodeCheck(Sender: TObject);
    procedure GeTEmployeeName(Sender: TObject);
    procedure FindEmployeeCode(Sender: TObject);
    procedure FindWhEmployeeCode(Sender: TObject);
    procedure WhEmployeeCodeCheck(Sender: TObject);
    procedure GetWhEmployeeName(Sender: TObject);
    procedure WhEmployeeHint(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure WhEmployeeHint1(Sender: TObject);
    procedure EmployeeHint(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure EmployeeHint1(Sender: TObject);
    procedure EmployeeNameCheck(Sender: TObject);
    //使用者
    procedure Vw_OperatorCodeCheck(Sender: TObject);
    procedure GetVw_OperatorName(Sender: TObject);
    procedure FindVw_OperatorCode(Sender: TObject);
    procedure Vw_OperatorHint(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Vw_OperatorHint1(Sender: TObject);

    //部门
    procedure DeptCodeCheck(Sender: TObject);
    procedure GetDeptName(Sender: TObject);
    procedure FindDeptCode(Sender: TObject);
    procedure DeptHint(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure DeptHint1(Sender: TObject);
    procedure DeptNameCheck(Sender: TObject);
    //计量单位
    procedure UomCodeCheck(Sender: TObject);
    procedure GetUomName(Sender: TObject);
    procedure FindUomCode(Sender: TObject);
    procedure UomHint(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure UomHint1(Sender: TObject);

    //供应商
    procedure VendorCodeCheck(Sender: TObject);
    procedure GetVendorName(Sender: TObject);
    procedure FindVendorCode(Sender: TObject);
    procedure VendorHint(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure VendorHint1(Sender: TObject);
    procedure UsableVendorCodeCheck(Sender: TObject);
    procedure UsableVendorHint(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure UsableVendorHint1(Sender: TObject);

    //客户
    procedure CustomerCodeCheck(Sender: TObject);
    procedure GetCustomerName(Sender: TObject);
    procedure FindCustomerCode(Sender: TObject);
    procedure CustomerHint(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure CustomerHint1(Sender: TObject);

    procedure UsableCustomerCodeCheck(Sender: TObject);
    procedure UsableCustomerHint(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure UsableCustomerHint1(Sender: TObject);

    //物料
    procedure ItemCodeCheck(Sender: TObject);
    procedure GetItemName(Sender: TObject);
    procedure FindItemCode(Sender: TObject);
    procedure ItemHint(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure ItemHint1(Sender: TObject);

    procedure InOutItemCodeCheck(Sender: TObject);
    procedure InOutItemHint(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure InOutItemHint1(Sender: TObject);
    procedure InvItemCodeCheck(Sender: TObject);
    procedure InvItemHint(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure InvItemHint1(Sender: TObject);

    procedure FindInvItemCode(Sender: TObject);
    procedure SaleItemCodeCheck(Sender: TObject);
    procedure SaleItemHint(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure SaleItemHint1(Sender: TObject);

    //仓库
    procedure WarehouseCodeCheck(Sender: TObject);
    procedure GetWarehouseName(Sender: TObject);
    procedure FindWarehouseCode(Sender: TObject);
    procedure WarehouseHint(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure WarehouseHint1(Sender: TObject);

    //外币
    procedure CurrencyCodeCheck(Sender: TObject);
    procedure GetCurrencyName(Sender: TObject);
    procedure FindCurrencyCode(Sender: TObject);
    procedure CurrencyHint(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure CurrencyHint1(Sender: TObject);

    //计划员
    procedure Vw_PlannerCodeCheck(Sender: TObject);
    procedure GetVw_PlannerName(Sender: TObject);
    procedure FindVw_PlannerCode(Sender: TObject);
    procedure Vw_PlannerHint(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Vw_PlannerHint1(Sender: TObject);

    //采购员
    procedure Vw_BuyerCodeCheck(Sender: TObject);
    procedure GetVw_BuyerCodeName(Sender: TObject);
    procedure FindVw_BuyerCodeCode(Sender: TObject);
    procedure Vw_BuyerHint(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Vw_BuyerHint1(Sender: TObject);

    //模具代码
    procedure MouldCodeCheck(Sender: TObject);
    procedure GetMouldName(Sender: TObject);
    procedure FindMouldCode(Sender: TObject);
    procedure MouldHint(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure MouldHint1(Sender: TObject);

    //生产订单号
    procedure MoNoHint(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure MoNoHint1(Sender: TObject);
    procedure MoNoCheck(Sender: TObject);
    //订单条款集
    procedure PoTermSetCodeCheck(Sender: TObject);
    procedure GetPoTermSetName(Sender: TObject);
    procedure FindPoTermSetCode(Sender: TObject);
    procedure PoTermSetHint(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure PoTermSetHint1(Sender: TObject);

    //采购订单号
    procedure PoCodeCheck(Sender: TObject);
    procedure PoHint(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure PoHint1(Sender: TObject);

    //采购合同号
    procedure PcCodeCheck(Sender: TObject);
    procedure PcHint(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure PcHint1(Sender: TObject);
    procedure QcProblemHint(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure QcProblemHint1(Sender: TObject);
    procedure GetQcProblem(Sender: TObject);
    procedure QcProblemCheck(Sender: TObject);

    //会计科目
    procedure AccountSubjectHint(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure AccountSubjectCheck(Sender: TObject);

    //区域
    procedure AreaCodeCheck(Sender: TObject);
    procedure AreaHint(Sender: TObject; var Key: Word;
      Shift: TShiftState);

  private
    { Private declarations }
    procedure GroupEnter(sender:tobject);
  protected
    { protected declarations }
    UpKey:Boolean;
    DBConnect:TAdOConnection;
    Param1,Param2,Param3,Param4,Param5,Param6:String;
    UserCode,ModuleCode,MenuId,LoginDate:String;
    procedure ExecOnExit(Control:TControl);//执行Control.OnExit事件处理过程
    //如果Control.OnChange=nil则Control.OnChange:=NotifyEvent
    procedure SetOnChangeEvent(Control:TControl;NotifyEvent:TNotifyEvent);
    //如果Control.OnEnter:=nil,则Control.OnEnter:=NotifyEvent
    procedure SetOnEnterEvent(Control:TControl;NotifyEvent:TNotifyEvent);
    //Control.OnExit:=NotifyEvent
    procedure SetOnExitEvent(Control:TControl;NotifyEvent:TNotifyEvent);
    function  GetOnExitEvent(Control:TControl;//NotifyEvent:=Control.OnExit
      var NotifyEvent:TNotifyEvent):Boolean;
  public
    { Public declarations }
    function  GetMenuId:String;//返回 MenuId
    procedure SetDBConnect(AdOConnection:TAdOConnection); virtual;//设置数据库连接
    procedure SetUserParam(Param1,Param2,Param3,Param4,Param5,//设置入口参数
      Param6:String);virtual;
    procedure SetFormParam(FrmParam1,FrmParam2,FrmParam3,FrmParam4,//虚拟接口
      FrmParam5,FrmParam6:String);virtual;
    //设置系统参数
    procedure SetSysParam(UserCode,ModuleCode,MenuId,LoginDate:String);virtual;
  end;
  TAdoQryExpress=Class(TAdoQuery)
  Public
    Property CommandTimeOut;
  end;

var
  Frm_Base_Common: TFrm_Base_Common;

implementation

uses Sys_Global;

{$R *.DFM}

procedure TFrm_Base_Common.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  inherited;
  Case Key of
    VK_RETURN:
    begin
      if(ActiveControl is TDBGridEh)then
      begin
        if Assigned(TDBGridEh(ActiveControl).OnDblClick) then
        begin//DBGridEh中回车,相当于鼠标双击
          TDBGridEh(ActiveControl).OnDblClick(ActiveControl);
          Key:=0;
        end
        else
          Key:=9;//DBGridEh中回车,下一格
      end
      else if(ActiveControl is TMemo)then
        Exit
      else
      begin
        UpKey:=False;
        SelectNext(ActiveControl,True,True);
        Key:=0;
      end;
    end;
    VK_DOWN,VK_UP:
    begin//光标上下按钮处理
      if(ActiveControl is TMemo)then
        Exit;
      if(ActiveControl is TTreeview)then
        Exit;
      if((ActiveControl is TCombobox)and((sSalt in Shift)or
        TCombobox(ActiveControl).DroppedDown))then
        Exit;
      if(ActiveControl is TDBGridEh)and(TDBGridEh(ActiveControl).DataSource<>nil)
        and(TDBGridEh(ActiveControl).DataSource.DataSet<>nil)then
        if not(((Key=VK_UP)and(TDBGridEh(ActiveControl).DataSource.DataSet.Bof))or
          ((Key=VK_DOWN)and(TDBGridEh(ActiveControl).DataSource.DataSet.Eof))) then
          Exit;
      if(ActiveControl is TStringGrid)then
        if((Key=VK_UP)and(TStringGrid(ActiveControl).Row<>1))or
          ((Key=VK_DOWN)and(TStringGrid(ActiveControl).RowCount-1<>
          TStringGrid(ActiveControl).Row))then
          Exit;
      if(ActiveControl is TListbox) then
        if((Key=VK_UP)and(TListbox(ActiveControl).ItemIndex>0))or
          ((Key=VK_DOWN)and(TListbox(ActiveControl).Items.Count-1<>
          TListbox(ActiveControl).ItemIndex)) then
          Exit;
      UpKey:=(Key=VK_UP);
      SelectNext(ActiveControl,Key=VK_DOWN,True);
      Key:=0;
    end;
  end;
end;

procedure TFrm_Base_Common.FormKeyPress(Sender: TObject; var Key: ChAr);
begin//消除响声
  inherited;
  if Key in [#13,#27] then
    Key:=#0;
end;

procedure TFrm_Base_Common.FormCreate(Sender: TObject);
var
  i:integer;
begin
  inherited;
  TAdoQryExpress(AdoQry_Tmp).CommandTimeout:=0;
  for i:=0 to ControlCount-1 do
  begin
    if (Controls[i] is TGroupBox) then
      TGroupBox(Controls[i]).OnEnter:=GroupEnter
    else if (Controls[i] is TPanel) then
      TPanel(Controls[i]).OnEnter:=GroupEnter
    else if (Controls[i] is TRadioGroup) then
      TRadioGroup(Controls[i]).OnEnter:=GroupEnter;
  end;
end;

procedure TFrm_Base_Common.GroupEnter(Sender:TObject);
var
  ControlList:TList;
  i:integer;
begin//
  ControlList:=TList.Create;
  TWinControl(Sender).GetTabOrderList(ControlList);
  if ControlList.Count=0 then
  begin
    SelectNext(ActiveControl,True,True);
    ControlList.free;
    Exit;
  end;
  for i:=ControlList.Count-1 downto 0 do
  begin
    if ActiveControl.Name=TWinControl(ControlList[i]).Name then
    begin
      Exit;
    end;
  end;
  if UpKey then
    for i:=ControlList.Count-1 downto 0 do
    begin
      if TWinControl(ControlList[i]).CanFocus then
      begin
        TWinControl(ControlList[i]).SetFocus;
        Exit;
      end;
    end
  else
    for i:=0 to ControlList.Count-1 do
    begin
      if TWinControl(ControlList[i]).CanFocus then
      begin
        TWinControl(ControlList[i]).SetFocus;
        Exit;
      end;
    end;
  ControlList.Free;
end;

procedure TFrm_Base_Common.DateCheck(Sender: TObject);
begin
  inherited;
  if(ActiveControl.Name='btn_Cancel')then
    Abort;
  try
    DateSeparator:='.';
    Shortdateformat:='yyyy.mm.dd';
    StrToDateTime(TEdit(Sender).Text);
  except
    DispInfo('   日期非法!  ',1);
    TWinControl(Sender).SetFocus;
    Abort;
  end;
end;

procedure TFrm_Base_Common.MonthCheck(Sender: TObject);
begin
  inherited;
  if(ActiveControl.Name='btn_Cancel')then
    Abort;
  try
    DateSeparator:='.';
    Shortdateformat:='yyyy.mm.dd';
    StrToDateTime(TCustomEdit(Sender).Text+'.01');
  except
    DispInfo('   月份非法!  ',1);
    TWinControl(Sender).SetFocus;
    Abort;
  end;
end;

procedure TFrm_Base_Common.SetDBConnect(AdOConnection:TAdOConnection);
begin
  DBConnect:=AdOConnection;
  AdoQry_Tmp.Connection:=AdOConnection;
end;

procedure TFrm_Base_Common.EmployeeCodeCheck(Sender: TObject);
begin
  if(ActiveControl.Name='btn_Cancel')then
    Abort;

⌨️ 快捷键说明

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