fmbaseu.pas

小型库存管理,希望有帮助,小型库存管理,希望有帮助

{基础窗口}

unit FMBaseU;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,DBGrids,DBCtrls,DB,StdCtrls, ADODB,ComCtrls,MsgU,
  RXDBCtrl,dxDBGrid,dxdbtrel;

type
  TFMBase = class(TForm)
    QrySQL: TADOQuery;
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
    function GetNextDBColumn(Colindex:integer;ConDBGrid:TDbgrid):integer ;
    procedure AppException(Sender: TObject; E: Exception);
  public
    { Public declarations }
    function UFormatDate(strDate:string):string ;
    function GetNextId(strTable,strField:string):string ;//取回下一个流水号
    procedure SetEnable(tl_Enable : boolean) ; //
    procedure SetMainMsg(strFormStats:string); {与主窗体通讯}
  end;

var
  FMBase: TFMBase;

implementation

{$R *.dfm}
uses FMDBU ;


{格式化日期}
function TFMBase.UFormatDate(strDate:string):string ;
 var
  strSep :string ;
  strYear,strMonth,strDay,strLast :string ;
 begin
  strSep :=DateSeparator ;
  strYear :=copy(strDate,0,4);
  strDate :=copy(strDate,6,length(strDate)-1);
  strMonth :=copy(strDate,0,pos(strSep,strDate)-1);
  strDate :=copy(strDate,pos(strSep,strDate)+1,length(strDate)-1);
  strDay :=strDate ;
  if length(strMonth)<2 then strMonth :='0' + strMonth ;
  if length(strDay)<2 then strDay :='0' + strDay ;
  strLast :=strYear +strSep  +strMonth+strSep+ strDay;
  Result:=strLast;
 end;

function TFMBase.GetNextId(strTable,strField:string):string ;//取回下一个流水号
var
  strNextNo :string ;
begin
  QrySQL.Active :=false ;
  QrySQL.SQL.Text :='select count(*),max('+strField+') from '+strTable ;
  QrySQL.Active :=true ;
  if QrySQL.Fields[0].AsInteger=0 then
     strNextNo :='1'
  else
     strNextNo :=IntToStr(QrySQL.Fields[1].asInteger+1);
  QrySQL.Active :=false ; 
  result :=strNextNo ;
end ;

procedure TFMBase.AppException(Sender: TObject; E: Exception);
begin
  Application.ShowException(E);
end;

{状态控制}
procedure TFMBase.SetEnable(tl_Enable : boolean) ;
var
  intI : integer ;
  t_com : TComponent ;
begin
  for intI := ComponentCount - 1 downto 0 do
  begin
    t_com := Components[intI] ;
    if t_com is TDBEDIT then
      TDBEDIT(t_com).ReadOnly  := not tl_Enable ;
    if t_com is TCheckBox then
      TCheckBox(t_com).Enabled :=  tl_Enable ;
    if t_com is TDateTimePicker then
      TDateTimePicker(t_com).Enabled :=tl_Enable ;
    if t_com is TCustomListBox then
      TCustomListBox(t_com).Enabled  := tl_Enable ;
    if t_com is TCustomComboBox then
      TCustomComboBox(t_com).Enabled := tl_Enable ;
    if (t_com is TButtonControl) and (t_com.Tag<>9) then
      TButtonControl(t_com).Enabled := tl_Enable ;
    if t_com is TCustomGroupBox then
      TCustomGroupBox(t_com).Enabled := True ;
    if t_com is TDBRadioGroup then
      TDBRadioGroup(t_com).Enabled :=tl_Enable ;
    if t_com is TRxDBComboEdit then
     TRxDBComboEdit(t_com).Enabled :=tl_Enable ;
    if t_com is TDBLookupComboBox then
      TDBLookupComboBox(t_com).ReadOnly := not tl_Enable ;
    if t_com is TdxDBLookupTreeView then
      TdxDBLookupTreeView(t_com).Enabled := tl_Enable ;

    if t_com is TDBGrid then
      if TDBGrid(t_com).Tag =1 then
       begin
          TDBGrid(t_com).ReadOnly := True  ;
          TDBGrid(t_com).Enabled :=not tl_Enable ;
       end
      else
          TDBGrid(t_com).ReadOnly :=not tl_Enable ;
   end ;
end ;

procedure TFMBase.FormCreate(Sender: TObject);
begin
  SetEnable(false);
  Application.OnException := AppException;
end;

procedure TFMBase.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (Key = VK_RETURN) or (Key = VK_TAB) then
  begin
    //需要用回车键代替TAB键下移一个控件时，
    //把KeyPress设为True，加入下列代码拦截击键：
    if not (ActiveControl is TDbgrid)  Then Begin
      perform(WM_NEXTDLGCTL,0,0);
    end else begin
      if (ActiveControl is TDbgrid) Then
      begin
        With TDbgrid(ActiveControl) Do
        begin
          try
            if (Selectedindex<(FieldCount-1)) and (GetNextDBColumn(Selectedindex+1,TDbgrid(ActiveControl))>=0) then
              Selectedindex:=GetNextDBColumn(Selectedindex+1,TDbgrid(ActiveControl))
            else
            begin
              //如果是新增状态，则不允许移动到下一条
              if DataSource.DataSet.State = dsInsert then
              begin
                DataSource.DataSet.Post ;
              end ;

              if DataSource.DataSet.State <> dsInsert then
              begin
                DataSource.DataSet.Next ;
                //如果已经到最后以条，则新增一条记录
                if DataSource.DataSet.Eof and not ReadOnly then
                  DataSource.DataSet.Append ;
              end ;
              Selectedindex:=GetNextDBColumn(0,TDbgrid(ActiveControl));
            end ;
          except
          end ;  
        end ;
      end;
    end ;
  end ;
end;

{取DBGrid下一个栏位}
function TFMBase.GetNextDBColumn(Colindex:integer;ConDBGrid:TDbgrid):integer ;
var
  i,ColCount :integer ;
begin
  result :=-1 ;
  ColCount :=ConDBGrid.Columns.Count -1 ;
  for i :=ColIndex to ColCount do
   begin
     if not ConDBGrid.Columns[i].ReadOnly then
      begin
       result := i ;
       break  ;
      end ;
   end ;
end ;


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

{与主调通信:当窗体显示和关闭的时候}
procedure TFMBase.SetMainMsg(strFormStats:string);
var
  sTellUser: string;
  szTellUser: array[0..254] of char;
begin
  sTellUser := strFormStats ;
  StrPCopy(szTellUser, sTellUser);
  SendMessage(Application.MainForm.Handle,
     wm_ChildTellMain, _PassAString, longint(@szTellUser));
end ;

end.