Browse Source

* Implemented OnBeep to install custom beep handler

git-svn-id: trunk@14254 -
michael 15 years ago
parent
commit
01ed4a6745

+ 2 - 1
rtl/go32v2/sysutils.pp

@@ -635,7 +635,7 @@ end ;
                               Misc Functions
 ****************************************************************************}
 
-procedure Beep;
+procedure sysBeep;
 begin
 end;
 
@@ -844,6 +844,7 @@ end;
 Initialization
   InitExceptions;       { Initialize exceptions. OS independent }
   InitInternational;    { Initialize internationalization settings }
+  OnBeep:=@SysBeep;
 Finalization
   DoneExceptions;
 end.

+ 1 - 0
rtl/objpas/rtlconst.inc

@@ -152,6 +152,7 @@ ResourceString
   SInvalidDateMonthWeek         = '(%d, %d, %d, %d) is not a valid DateMonthWeek quad';
   SInvalidDateWeek              = '(%d, %d, %d) is not a valid DateWeek triplet';
   SInvalidDayOfWeekInMonth      = '(%d, %d, %d, %d) is not a valid DayOfWeekInMonth quad';
+  SErrIllegalDateFormatString   = '"%s" is not a valid date format string';
   SInvalidFileName              = '"%s" is not a valid file name.';
   SInvalidIcon                  = 'Invalid Icon';
   SInvalidImage                 = 'Invalid stream format';

+ 11 - 2
rtl/objpas/sysutils/sysutilh.inc

@@ -173,15 +173,24 @@ type
    procedure ShowException(ExceptObject: TObject; ExceptAddr: Pointer);
    procedure Abort;
    procedure OutOfMemoryError;
+
+
+Type
+   TBeepHandler = Procedure;
+
+Var
+   OnBeep : TBeephandler = Nil;
+
    procedure Beep;
    function SysErrorMessage(ErrorCode: Integer): String;
 
+
+
 Type
    TCreateGUIDFunc = Function(Out GUID : TGUID) : Integer;
-
+   
 Var
    OnCreateGUID : TCreateGUIDFunc = Nil;
-
    Function CreateGUID(out GUID : TGUID) : Integer;
 
 type

+ 8 - 0
rtl/objpas/sysutils/sysutils.inc

@@ -683,3 +683,11 @@ begin
   Result:='';
 {$ENDIF}
 end;
+
+{ Beep support }
+
+procedure Beep;
+begin
+  If Assigned(OnBeep) then
+    OnBeep;
+end;

+ 4 - 2
rtl/os2/sysutils.pp

@@ -836,11 +836,12 @@ end;
 {****************************************************************************
                               Misc Functions
 ****************************************************************************}
+procedure sysbeep;
 
-procedure Beep;
 begin
-end;
+  // Maybe implement later on ?
 
+end;
 
 {****************************************************************************
                               Locale Functions
@@ -1075,6 +1076,7 @@ end;
 Initialization
   InitExceptions;       { Initialize exceptions. OS independent }
   InitInternational;    { Initialize internationalization settings }
+  OnBeep:=@SysBeep;
 Finalization
   DoneExceptions;
 end.

+ 8 - 3
rtl/unix/sysutils.pp

@@ -991,9 +991,6 @@ end;
                               Misc Functions
 ****************************************************************************}
 
-procedure Beep;
-begin
-end;
 
 
 {****************************************************************************
@@ -1356,6 +1353,12 @@ begin
   Result:=TheUserDir;    
 end;
 
+Procedure SysBeep;
+
+begin
+  Write(#7);
+  Flush(Output);
+end;
 
 {****************************************************************************
                               Initialization code
@@ -1365,6 +1368,8 @@ Initialization
   InitExceptions;       { Initialize exceptions. OS independent }
   InitInternational;    { Initialize internationalization settings }
   SysConfigDir:='/etc'; { Initialize system config dir }
+  OnBeep:=@SysBeep;
+  
 Finalization
   FreeDriveStr;
   DoneExceptions;

+ 2 - 1
rtl/win/sysutils.pp

@@ -604,7 +604,7 @@ end;
                               Misc Functions
 ****************************************************************************}
 
-procedure Beep;
+procedure sysbeep;
 begin
   MessageBeep(0);
 end;
@@ -1221,6 +1221,7 @@ Initialization
   InitInternational;    { Initialize internationalization settings }
   LoadVersionInfo;
   InitSysConfigDir;
+  OnBeep:=@SysBeep;
 Finalization
   DoneExceptions;
   if kernel32dll<>0 then