|
|
@@ -0,0 +1,263 @@
|
|
|
+{
|
|
|
+ $Id$
|
|
|
+
|
|
|
+ Timed dialogs for Free Vision
|
|
|
+
|
|
|
+ Copyright (c) 2004 by Free Pascal core team
|
|
|
+
|
|
|
+ This library is free software; you can redistribute it and/or
|
|
|
+ modify it under the terms of the GNU Library General Public
|
|
|
+ License as published by the Free Software Foundation; either
|
|
|
+ version 2 of the License, or (at your option) any later version.
|
|
|
+
|
|
|
+ This library is distributed in the hope that it will be useful,
|
|
|
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
|
+ Library General Public License for more details.
|
|
|
+
|
|
|
+ You should have received a copy of the GNU Library General Public
|
|
|
+ License along with this library; if not, write to the Free
|
|
|
+ Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
|
+
|
|
|
+ ****************************************************************************}
|
|
|
+UNIT timeddlg;
|
|
|
+
|
|
|
+{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
|
|
|
+ INTERFACE
|
|
|
+{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
|
|
|
+
|
|
|
+{====Include file to sort compiler platform out =====================}
|
|
|
+{$I Platform.inc}
|
|
|
+{====================================================================}
|
|
|
+
|
|
|
+{==== Compiler directives ===========================================}
|
|
|
+
|
|
|
+{$IFNDEF PPC_FPC}{ FPC doesn't support these switches }
|
|
|
+ {$F-} { Near calls are okay }
|
|
|
+ {$A+} { Word Align Data }
|
|
|
+ {$B-} { Allow short circuit boolean evaluations }
|
|
|
+ {$O+} { This unit may be overlaid }
|
|
|
+ {$G+} { 286 Code optimization - if you're on an 8088 get a real computer }
|
|
|
+ {$P-} { Normal string variables }
|
|
|
+ {$N-} { No 80x87 code generation }
|
|
|
+ {$E+} { Emulation is on }
|
|
|
+{$ENDIF}
|
|
|
+
|
|
|
+{$X+} { Extended syntax is ok }
|
|
|
+{$R-} { Disable range checking }
|
|
|
+{$S-} { Disable Stack Checking }
|
|
|
+{$I-} { Disable IO Checking }
|
|
|
+{$Q-} { Disable Overflow Checking }
|
|
|
+{$V-} { Turn off strict VAR strings }
|
|
|
+{====================================================================}
|
|
|
+
|
|
|
+USES objects, dialogs, fvconsts, drivers, views; { Standard GFV unit }
|
|
|
+
|
|
|
+type
|
|
|
+ TTimedDialog = object (TDialog)
|
|
|
+ Secs: longint;
|
|
|
+ constructor Init (var Bounds: TRect; ATitle: TTitleStr; ASecs: word);
|
|
|
+ constructor Load (var S: TStream);
|
|
|
+ procedure GetEvent (var Event: TEvent); virtual;
|
|
|
+ procedure Store (var S: TStream); virtual;
|
|
|
+ private
|
|
|
+ Secs0: longint;
|
|
|
+ Secs2: longint;
|
|
|
+ DayWrap: boolean;
|
|
|
+ end;
|
|
|
+ PTimedDialog = ^TTimedDialog;
|
|
|
+
|
|
|
+(* Must be always included in TTimeDialog! *)
|
|
|
+ TTimedDialogText = object (TStaticText)
|
|
|
+ constructor Init (var Bounds: TRect);
|
|
|
+ procedure GetText (var S: string); virtual;
|
|
|
+ end;
|
|
|
+ PTimedDialogText = ^TTimedDialogText;
|
|
|
+
|
|
|
+const
|
|
|
+ RTimedDialog: TStreamRec = (
|
|
|
+ ObjType: idTimedDialog;
|
|
|
+{$IFDEF BP_VMTLink} { BP style VMT link }
|
|
|
+ VmtLink: Ofs (TypeOf (TTimedDialog)^);
|
|
|
+{$ELSE} { Alt style VMT link }
|
|
|
+ VmtLink: TypeOf (TTimedDialog);
|
|
|
+{$ENDIF BP_VMTLink}
|
|
|
+ Load: @TTimedDialog.Load;
|
|
|
+ Store: @TTimedDialog.Store
|
|
|
+ );
|
|
|
+
|
|
|
+ RTimedDialogText: TStreamRec = (
|
|
|
+ ObjType: idTimedDialogText;
|
|
|
+{$IFDEF BP_VMTLink} { BP style VMT link }
|
|
|
+ VmtLink: Ofs (TypeOf (TTimedDialogText)^);
|
|
|
+{$ELSE} { Alt style VMT link }
|
|
|
+ VmtLink: TypeOf (TTimedDialogText);
|
|
|
+{$ENDIF BP_VMTLink}
|
|
|
+ Load: @TTimedDialogText.Load;
|
|
|
+ Store: @TTimedDialogText.Store
|
|
|
+ );
|
|
|
+
|
|
|
+procedure RegisterTimedDialog;
|
|
|
+
|
|
|
+FUNCTION TimedMessageBox (Const Msg: String; Params: Pointer;
|
|
|
+ AOptions: Word; ASecs: Word): Word;
|
|
|
+
|
|
|
+{-TimedMessageBoxRect------------------------------------------------
|
|
|
+TimedMessageBoxRect allows the specification of a TRect for the message box
|
|
|
+to occupy.
|
|
|
+---------------------------------------------------------------------}
|
|
|
+FUNCTION TimedMessageBoxRect (Var R: TRect; Const Msg: String; Params: Pointer;
|
|
|
+ AOptions: Word; ASecs: Word): Word;
|
|
|
+
|
|
|
+
|
|
|
+{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
|
|
|
+ IMPLEMENTATION
|
|
|
+{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
|
|
|
+
|
|
|
+USES
|
|
|
+ dos,
|
|
|
+ app, resource, msgbox; { Standard GFV units }
|
|
|
+
|
|
|
+
|
|
|
+{***************************************************************************}
|
|
|
+{ INTERFACE ROUTINES }
|
|
|
+{***************************************************************************}
|
|
|
+
|
|
|
+constructor TTimedDialogText.Init (var Bounds: TRect);
|
|
|
+begin
|
|
|
+ inherited Init (Bounds, '');
|
|
|
+end;
|
|
|
+
|
|
|
+
|
|
|
+procedure TTimedDialogText.GetText (var S: string);
|
|
|
+begin
|
|
|
+ if Owner <> nil
|
|
|
+(* and (TypeOf (Owner^) = TypeOf (TTimedDialog)) *)
|
|
|
+ then
|
|
|
+ begin
|
|
|
+ Str (PTimedDialog (Owner)^.Secs, S);
|
|
|
+ S := #3 + S;
|
|
|
+ end
|
|
|
+ else
|
|
|
+ S := '';
|
|
|
+end;
|
|
|
+
|
|
|
+
|
|
|
+
|
|
|
+constructor TTimedDialog.Init (var Bounds: TRect; ATitle: TTitleStr;
|
|
|
+ ASecs: word);
|
|
|
+var
|
|
|
+ H, M, S, S100: word;
|
|
|
+begin
|
|
|
+ inherited Init (Bounds, ATitle);
|
|
|
+ GetTime (H, M, S, S100);
|
|
|
+ Secs0 := H * 3600 + M * 60 + S;
|
|
|
+ Secs2 := Secs0 + ASecs;
|
|
|
+ Secs := ASecs;
|
|
|
+ DayWrap := Secs2 > 24 * 3600;
|
|
|
+end;
|
|
|
+
|
|
|
+
|
|
|
+procedure TTimedDialog.GetEvent (var Event: TEvent);
|
|
|
+var
|
|
|
+ H, M, S, S100: word;
|
|
|
+ Secs1: longint;
|
|
|
+begin
|
|
|
+ inherited GetEvent (Event);
|
|
|
+ GetTime (H, M, S, S100);
|
|
|
+ Secs1 := H * 3600 + M * 60 + S;
|
|
|
+ if DayWrap then Inc (Secs1, 24 * 3600);
|
|
|
+ if Secs2 - Secs1 <> Secs then
|
|
|
+ begin
|
|
|
+ Secs := Secs2 - Secs1;
|
|
|
+ if Secs < 0 then
|
|
|
+ Secs := 0;
|
|
|
+(* If remaining seconds are displayed in one of included views, update them. *)
|
|
|
+ Redraw;
|
|
|
+ end;
|
|
|
+ with Event do
|
|
|
+ if (Secs = 0) and (What = evNothing) then
|
|
|
+ begin
|
|
|
+ What := evCommand;
|
|
|
+ Command := cmCancel;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+
|
|
|
+constructor TTimedDialog.Load (var S: TStream);
|
|
|
+begin
|
|
|
+ inherited Load (S);
|
|
|
+ S.Read (Secs, SizeOf (Secs));
|
|
|
+ S.Read (Secs0, SizeOf (Secs0));
|
|
|
+ S.Read (Secs2, SizeOf (Secs2));
|
|
|
+ S.Read (DayWrap, SizeOf (DayWrap));
|
|
|
+end;
|
|
|
+
|
|
|
+
|
|
|
+procedure TTimedDialog.Store (var S: TStream);
|
|
|
+begin
|
|
|
+ inherited Store (S);
|
|
|
+ S.Write (Secs, SizeOf (Secs));
|
|
|
+ S.Write (Secs0, SizeOf (Secs0));
|
|
|
+ S.Write (Secs2, SizeOf (Secs2));
|
|
|
+ S.Write (DayWrap, SizeOf (DayWrap));
|
|
|
+end;
|
|
|
+
|
|
|
+
|
|
|
+
|
|
|
+function TimedMessageBox (const Msg: string; Params: pointer;
|
|
|
+ AOptions: word; ASecs: word): word;
|
|
|
+var
|
|
|
+ R: TRect;
|
|
|
+begin
|
|
|
+ R.Assign(0, 0, 40, 10); { Assign area }
|
|
|
+ if (AOptions AND mfInsertInApp = 0) then { Non app insert }
|
|
|
+ R.Move((Desktop^.Size.X - R.B.X) div 2,
|
|
|
+ (Desktop^.Size.Y - R.B.Y) div 2) { Calculate position }
|
|
|
+ else
|
|
|
+ R.Move((Application^.Size.X - R.B.X) div 2,
|
|
|
+ (Application^.Size.Y - R.B.Y) div 2); { Calculate position }
|
|
|
+ TimedMessageBox := TimedMessageBoxRect (R, Msg, Params,
|
|
|
+ AOptions, ASecs); { Create message box }
|
|
|
+end;
|
|
|
+
|
|
|
+
|
|
|
+function TimedMessageBoxRect (var R: TRect; const Msg: string; Params: pointer;
|
|
|
+ AOptions: word; ASecs: word): word;
|
|
|
+var
|
|
|
+ Dlg: PTimedDialog;
|
|
|
+ TimedText: PTimedDialogText;
|
|
|
+begin
|
|
|
+ Dlg := New (PTimedDialog, Init (R, MsgBoxTitles [AOptions
|
|
|
+ and $3], ASecs)); { Create dialog }
|
|
|
+ with Dlg^ do
|
|
|
+ begin
|
|
|
+ R.Assign (3, Size.Y - 5, Size.X - 2, Size.Y - 4);
|
|
|
+ New (TimedText, Init (R));
|
|
|
+ Insert (TimedText);
|
|
|
+ R.Assign (3, 2, Size.X - 2, Size.Y - 5); { Assign area for text }
|
|
|
+ end;
|
|
|
+ TimedMessageBoxRect := MessageBoxRectDlg (Dlg, R, Msg, Params, AOptions);
|
|
|
+ Dispose (Dlg, Done); { Dispose of dialog }
|
|
|
+end;
|
|
|
+
|
|
|
+
|
|
|
+
|
|
|
+procedure RegisterTimedDialog;
|
|
|
+begin
|
|
|
+ RegisterType (RTimedDialog);
|
|
|
+ RegisterType (RTimedDialogText);
|
|
|
+end;
|
|
|
+
|
|
|
+
|
|
|
+begin
|
|
|
+ RegisterTimedDialog;
|
|
|
+end.
|
|
|
+
|
|
|
+{
|
|
|
+ $Log$
|
|
|
+ Revision 1.1 2004-12-19 20:25:11 hajny
|
|
|
+ + TTimedDialog and TimedMessageBox added
|
|
|
+
|
|
|
+
|
|
|
+}
|
Tomas Hajny