commonroutines.pas

《delphi数据库设计与实例开发》随书光盘

unit CommonRoutines;

interface

uses
  Windows, Messages, SysUtils, Classes,
  Controls, StdCtrls, ComCtrls,ExtCtrls, forms,// dialogs, 
  DB, DBTables, DBGrids;

//*****************************************************************************

   procedure EnterToTab(UserForm : TForm; var Key: Word; Shift: TShiftState);
      {在窗体中用回车键模拟Tab键来转移输入焦点,在DBGrid中用enter键切换单元格
       如果要在窗体中使用该函数,先将窗体的KeyPreview属性设为True,
       然后在FormKeyDown事件中加入以下代码:
                 EnterToTab(Self, Key, Shift);
       对于TButton按钮，回车键等于按下了按钮(触发OnClick事件)，不触发FormKeyDown事件
      }
   procedure DBGridKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
       //在DBGrid中用enter键切换单元格, 并可用空格键打开对应的下列列表或对话框
       //在DBGrid的KeyDown事件中调用此过程(如果使用了EnterToTab则不必再调用此过程)

//***************************************************************************

   function TheCompleteDateStr( UserDatabaseName:string ; inputStr:string=''; const UserDateFormat : string ='' ; const ShowErrorMessage : boolean=false ):string;
        //检验一个字符串是否合法日期并把不完整的日期补充完整的函数
        //userDatabaseName:指定一个可用的数据库名(即Tdatabase的databasename属性)
        //inputStr:要检验的字符串,如果为空则返回完整的服务器日期
        //UserDateFormat : 指定日期的格式,如:'yyyy-mm-dd',可以省略
        //ShowErrorMessage :指定如果出错是否报错
        //如果输入合法则返回完整的日期字符串,否则返回空串   

   procedure setDateFields( Dataset : Tdataset );
        //把一个数据集的时间日期类型字段的OnSetText指向DateFieldSetText以检验其有效性;
        //调用: 在对应的数据集的afterOpen事件中调用此过程
        //适用于以dbgrid为输入控件的数据集


//*****************************************************************************

type

  TMyClass = class(TObject)
      //不必直接使用这个类 
    class procedure DateFieldSetText( sender : TField; const text : string);
      //字段的OnSetText事件句柄, 用于检验一个字段是否合法
    class procedure SetDateFields( Dataset : Tdataset );
      //将datetime类型的字段的OnSetText事件句柄设为DateFieldSetText
  end;

//**************************************************************************

implementation

var
  tmpQuery: Tquery;

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


function ReportError( const UserMessage : string;
                      const UserCaption: string='错误报告';
                      const IsSerious : Boolean = false
                     ):boolean;
         //报告错误,使用用户定义的信息和标题, 当不用报告异常的具体信息时可使用此函数
var
  Utype : cardinal;
begin
  result:=false;
  try
    if IsSerious then
      Utype := MB_OK + MB_ICONERROR
    else
      Utype := MB_OK + MB_ICONINFORMATION;
      
    messagebox( GetActiveWindow,
                PAnsiChar( UserMessage ),
                PAnsiChar( UserCaption ),
                Utype );
  except
    exit; //如果触发了异常就退出(返回值为false)
  end;
  result:=true;
end;

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

function ReportException( const UserException : exception;
                                UserMessage : string='';
                                UserModuleName : string='';
                                UserFunctionName : string='';
                          const IsSerious : Boolean = false
                        ):boolean;
         //报告异常, 并附加用户定义信息
var
  ErrorMessage:string;
  Utype : cardinal;
begin
  result:=false;
  try
    if UserMessage<>'' then
    begin
      UserMessage:=UserMessage+#13#10;
      if UserModuleName<>'' then
        UserModuleName:='触发异常的模块: '+UserModuleName+#13#10
      else
        UserModuleName:='触发异常的模块: '+GetModuleName(0)+#13#10;
    end
    else begin
      if UserModuleName<>'' then
        UserMessage:='模块 '+UserModuleName+' 中的操作触发了异常,信息如下:'+#13#10
      else
        UserMessage:='模块 '+GetModuleName(0)+' 中的操作触发了异常,信息如下:'+#13#10;
      UserModuleName:='';
    end;

    if UserFunctionName<>'' then
       UserFunctionName:='触发异常的函数: '+UserFunctionName
    else
       UserFunctionName:='触发异常的函数: 无函数信息';

    ErrorMessage := UserMessage
                   +'异常类型: '+UserException.className+#13#10
                   +'详细信息: '+UserException.message+#13#10
                   +UserModuleName
                   +UserFunctionName;

    if IsSerious then
      Utype := MB_OK + MB_ICONERROR
    else
      Utype := MB_OK + MB_ICONINFORMATION;

    messagebox( GetActiveWindow,
                PAnsiChar( ErrorMessage ),
                '异常报告',
                Utype );
  except
    exit; //如果在本函数内部又触发了新的异常则释放异常并返回false
  end;

  result:=true;
end;

procedure EnterToTab(UserForm : TForm; var Key: Word; Shift: TShiftState);
      {?ú′°ì??Dó???3μ?ü?￡?aTab?üà′×aò?ê?è??1μ?,?úDBGrid?Dó?enter?ü?D??μ￥?a??
       è?1?òa?ú′°ì??Dê1ó???oˉêy,?è??′°ì?μ?KeyPreviewê?D?éè?aTrue,
       è?oó?úFormKeyDownê??t?D?óè?ò???′ú??:
                 EnterToTab(Self, Key, Shift);
       ??óúTButton°′?￥￡???3μ?üμèóú°′??á?°′?￥(′￥·￠OnClickê??t)￡?2?′￥·￠FormKeyPressê??t }
begin
  if UserForm.ActiveControl = nil then exit;
  with UserForm do
  if (ActiveControl is TDBGrid) then  { óédbgrid′|àí }
    DBGridKeyDown(ActiveControl, key, shift)
  else //if ActiveControl.Tag = 0 then
  case key of
  VK_RETURN:     { è?1?°′??á???3μ?ü }
      if ( shift <= [ssShift] ) and
         ( (ActiveControl is TCustomEdit  ) or
           (ActiveControl is TCustomCombo ) or
           (ActiveControl is TDateTimePicker )
         ) and not (ActiveControl is TCustomMemo ) then
      begin
        Key := 0; { 3?μ???3μ?ü }
        if ssShift in Shift then  {°′??á?shift?ü}
          Perform(WM_NEXTDLGCTL, 1, 0) { ê?è??1μ?ò??ˉμ?é?ò??????t }
        else
          Perform(WM_NEXTDLGCTL, 0, 0); { ê?è??1μ?ò??ˉμ???ò??????t }
        //UserForm.SelectNext(UserForm.ActiveControl,TRUE,TRUE);
      end;
  VK_SPACE:
      if (shift = [])and(activeControl is TCustomCombo) then
      begin
        key := 0;
        (ActiveControl as TCustomCombo).DroppedDown:=true;
      end;
  end;
end;

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

procedure DBGridKeyDown(Sender: TObject;
  var Key: Word; Shift: TShiftState);
    //?úDBGrid?Dó?enter?ü?D??μ￥?a??,ó??????ü′ò?a??ó|μ???à-áD±í?ò?ò???°?ò
    //?úDBGridμ?KeyDownê??t?Dμ÷ó?′?1y3ì
begin
  if not(Sender is TDBGrid) then exit;

  with (Sender as TDBGrid) do
  case Key of
  VK_SPACE:   {è?1?°′??á??????ü}
      if shift = [] then
      begin
        key := 0;
        if columns[selectedIndex].ButtonStyle = cbsEllipsis	 then
          OnEditButtonClick(Sender) //′ò?a???°?ò
        else if (columns[selectedIndex].PickList.Count>0)or
                (columns[selectedIndex].Field.FieldKind = fkLookUp) then
        begin  //′ò?a??à-áD±í
          keybd_event(vk_menu,mapvirtualkey(vk_menu,0),KEYEVENTF_EXTENDEDKEY,0);
          keybd_event(vk_down,mapvirtualkey(vk_down,0),KEYEVENTF_EXTENDEDKEY,0);
          keybd_event(vk_down,mapvirtualkey(vk_down,0),KEYEVENTF_EXTENDEDKEY+KEYEVENTF_KEYUP,0);
          keybd_event(vk_menu,mapvirtualkey(vk_menu,0),KEYEVENTF_EXTENDEDKEY+KEYEVENTF_KEYUP,0);
        end;
      end;
  VK_RETURN: { è?1?°′??á???3μ?ü }
      if shift <= [ssShift] then
      begin
        key:=0;
        if ssShift in Shift then  {°′??á?shift?ü}
            if selectedIndex > 0 then