home *** CD-ROM | disk | FTP | other *** search
/ io Programmo 21 / IOPROG_21.ISO / SOFT / DFMTOOLS.ZIP / Delphi_DFM / Source / fParent.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-11-02  |  8.5 KB  |  252 lines
  1. unit fParent;
  2.                                                
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics,
  7.   Controls, Forms, Dialogs,
  8.   DBCtrls,
  9.   DBGrids, ExtCtrls, StdCtrls,
  10.   cShape, cdcLibrary;
  11.                                                                
  12. type
  13.   TParent = Class;
  14.   TMyIdleEvent = procedure (Sender: TObject;Simulation:Boolean;var Done: Boolean) of object;
  15.   TSaveDFM = procedure(Const Value:TParent);
  16.   TReadDFM = function(Const value:TFormClass):TParent;
  17.  
  18.   TParent = class(TForm)
  19.     FormSize: TFormSize;
  20.     procedure FormCreate(Sender: TObject);
  21.     procedure FormDestroy(Sender: TObject);
  22.     procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
  23.     procedure FormKeyPress(Sender: TObject; var Key: Char);
  24.     procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  25.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  26.     procedure FormShow(Sender: TObject);
  27.   private   { Private declarations }
  28.     FMinWidth,
  29.     FMinHeight: Integer;
  30.     FOnIdle   : TMyIdleEvent;
  31.     fOnExportData : TNotifyEvent;
  32.     FInactivity : Integer;
  33.     Function  GetUserEventTime:TDateTime;
  34.     Procedure SetUserEventTime(value:TDateTime);
  35.     procedure WMGetMinMaxInfo(var Message:TWMGetMinMaxInfo);message WM_GetMINMAXINFO;
  36.     //procedure Loaded;override;
  37.   protected
  38.     fSaveDFM : Boolean;
  39.     Function  CloseMsg:String;dynamic;
  40.     procedure Idle(Sender: TObject; var Done: Boolean);
  41.     procedure OnIdleProc(Sender: TObject;Simulatiion:Boolean;var Done:Boolean);dynamic;
  42.     procedure SetOnIdle(Const Value:TMyIdleEvent);
  43.     //procedure SetUserLevel;dynamic;abstract;
  44.   public    { Public declarations  }
  45.     property  OnIdle : TMyIdleEvent read FOnIdle write SetOnIdle;
  46.     property  OnExportData :  TNotifyEvent read fOnExportData write fOnExportData;
  47.     Function  Inactivity : Boolean;
  48.     property  Attende : Integer read FInactivity write FInactivity default 30;
  49.     property  UserEventTime: TDateTime read GetUserEventTime write SetUserEventTime;
  50.     property  MinWidth : Integer read FMinWidth write FMinWidth  default 300;
  51.     property  MinHeight: Integer read FMinHeight write FMinHeight  default 300;
  52.   end;
  53.  
  54. Function CreateFromRes(Const CT:TFormClass):TForm;
  55.  
  56. Var
  57.   SaveDFM : TSaveDFM = nil;
  58.   ReadDFM : TReadDFM = nil;
  59.  
  60. ResourceString
  61.   Standart_CLOSE_MSG = 'Quit Program ? ';
  62.   DeleteRecordQuery  = 'Confirm deletion of active record ?'+#10#13+'%s';
  63.  
  64. implementation
  65.  
  66. {$R *.DFM}
  67.  
  68. var FLastUserEventTime : TDateTime;
  69.     //FStructuredStorage : TStructuredStorage;
  70.  
  71. {------------------------------------------------------------------------------}
  72. Function CreateFromRes(Const CT:TFormClass):TForm;
  73. Begin
  74. if Assigned(ReadDFM) Then Begin
  75.    Result:=ReadDFM(CT);
  76.    if Assigned(Result) Then Begin
  77.       if (Result.FormStyle=fsMDIChild)and(Result is TParent) then Begin
  78.          Result.SetBounds(TParent(Result).FormSize.Left,TParent(Result).FormSize.Top,TParent(Result).FormSize.Width,TParent(Result).FormSize.Height);
  79.          end;
  80.       if Assigned(Result.OnCreate) then Result.OnCreate(Result);
  81.       if Assigned(Result.OnActivate) then Result.OnActivate(Result);
  82.    end else
  83.       Result:=CT.Create(Application);
  84. end else
  85.    Result:=CT.Create(Application);
  86. end;
  87.  
  88. {------------------------------------------------------------------------------}
  89. procedure TParent.FormCreate(Sender: TObject);
  90. begin
  91.   inherited;
  92.   Screen.Cursor:=crHourGlass;
  93.   fSaveDFM:=True;
  94.   FMinWidth :=300;
  95.   FMinHeight:=300;
  96.   FInactivity:=30;
  97.   FOnIdle:=OnIdleProc;
  98.   fOnExportData:=Nil;
  99.   FLastUserEventTime:=Now;
  100. end;
  101.  
  102. //-----------------------------------------------------------------------------}
  103. procedure TParent.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  104. begin
  105.   CanClose:=(MessageDlg(CLOSEMSG, mtConfirmation, [mbYes,mbNo] , HelpContext)= mrYes);
  106. end;
  107.  
  108. //-----------------------------------------------------------------------------}
  109. procedure TParent.FormClose(Sender: TObject; var Action: TCloseAction);
  110. begin
  111. ///First Write the DFM to a Memory Stream
  112. self.FormSize.SaveBounds(Self.BoundsRect);
  113. Screen.Cursor:=crHourGlass;
  114. if (Assigned(fParent.SaveDFM))and(Self.fSaveDFM) then
  115.    fParent.SaveDFM(Self);
  116. End;
  117.  
  118. {------------------------------------------------------------------------------}
  119. procedure TParent.FormDestroy(Sender: TObject);
  120. begin
  121. FOnIdle:=nil;
  122. inherited;
  123. end;
  124.  
  125. //-----------------------------------------------------------------------------}
  126. procedure TParent.WMGetMinMaxInfo(var Message:TWMGetMinMaxInfo);
  127. begin
  128.   with Message .MinMaxInfo^ do
  129.     begin
  130.     ptMinTrackSize:=Point(FMinWidth,FMinHeight);
  131.     end;
  132. end;
  133.  
  134. {------------------------------------------------------------------------------}
  135. Function  TParent.CloseMsg:String;
  136. begin
  137. Result:=Standart_CLOSE_MSG;
  138. end;
  139.  
  140. {------------------------------------------------------------------------------}
  141. function  TParent.Inactivity:Boolean;
  142. begin
  143. result:=((Now-FLastUserEventTime)*24*60)>(FInactivity);
  144. if result then
  145.    FLastUserEventTime:=Now
  146. end;
  147.  
  148. {------------------------------------------------------------------------------}
  149. function  TParent.GetUserEventTime:TDateTime;
  150. begin
  151. result:=FLastUserEventTime;
  152. end;
  153.  
  154. {------------------------------------------------------------------------------}
  155. procedure TParent.SetUserEventTime(value:TDateTime);
  156. begin
  157. FLastUserEventTime:=value;
  158. end;
  159.  
  160. {------------------------------------------------------------------------------}
  161. procedure TParent.FormKeyUp(Sender: TObject; var Key: Word;Shift: TShiftState);
  162. begin
  163. FLastUserEventTime:=Now;
  164. case key of
  165.    vk_F1    :begin Application.HelpContext(Screen.ActiveControl.HelpContext);key:=0 end;
  166.    Ord('Y') :If (Shift=[ssCtrl,ssALT]) then print;
  167. end end;
  168.  
  169. {------------------------------------------------------------------------------}
  170. procedure TParent.FormKeyPress(Sender: TObject; var Key: Char);
  171. begin
  172. FLastUserEventTime:=Now;
  173. case key of
  174.   #13  :if (ActiveControl is TDBGrid) then
  175.              with TDBGrid(ActiveControl) do begin{ if it is a TDBGrid }
  176.              if selectedindex < (fieldcount -1) then
  177.                 selectedindex := selectedindex +1
  178.              else selectedindex := 0;
  179.         end Else Begin
  180.              if (ActiveControl is TDBMemo)or(ActiveControl is TMemo)or(ActiveControl is TDBRichEdit) then            { if it is a TDBMemo1 }
  181.                 begin
  182.                 inherited
  183.              end else begin                                 { if not on a TDBGrid not a TDBMemo }
  184.                 Key := #0;                                  { eat enter key }
  185.                 Perform(WM_NEXTDLGCTL, 0, 0);               { move to next control }
  186.              end end;
  187.   else   inherited
  188. end end;
  189.  
  190. {------------------------------------------------------------------------------}
  191. procedure TParent.FormShow(Sender: TObject);
  192. begin
  193. FLastUserEventTime:=Now;
  194. end;
  195.  
  196. //-----------------------------------------------------------------------------}
  197. procedure TParent.SetOnIdle(Const Value:TMyIdleEvent);
  198. Begin
  199. FOnIdle:=Value;
  200. End;
  201.  
  202. //-----------------------------------------------------------------------------}
  203. procedure TParent.OnIdleProc(Sender: TObject;Simulatiion:Boolean;var Done:Boolean);
  204. begin
  205. if Self.Inactivity  then
  206.    Close
  207. end;
  208.  
  209. {------------------------------------------------------------------------------}
  210. //Dispatch on Idle to the Active Form.................
  211. procedure TParent.Idle(Sender: TObject; var Done: Boolean);
  212. var Act:TForm;
  213. begin
  214. //If inativity reached the done = false -> go back in program
  215. //else stay in the Idle mode till user action
  216. done:=not (((Now-FLastUserEventTime)*24*60)>(FInactivity));
  217. //For normal and child windows
  218. if (assigned(Screen.ActiveForm)and Screen.ActiveForm.Visible) then begin
  219.    Act:=Screen.ActiveForm;
  220.    If (Act is TParent)and(Assigned(TParent(Act).OnIdle)) then begin
  221.       (Act as TParent).OnIdle(Sender,false,done);
  222.        end;
  223.    if (Act.ActiveControl<>nil) then
  224.      Screen.Cursor:=Act.ActiveControl.Cursor
  225.    else
  226.      Screen.Cursor:=Act.Cursor;
  227.    end
  228. else
  229. //Try to find MDI parent
  230. if (assigned(Application.MainForm)and Application.MainForm.Visible) then begin
  231.    Act:=Application.MainForm;
  232.    If (Act is TParent)and(Assigned(TParent(Act).OnIdle)) then begin
  233.       (Act as TParent).OnIdle(Sender,false,done);
  234.        end;
  235.    Screen.Cursor:=Act.Cursor;
  236.    end
  237. else
  238.    begin
  239.    end
  240. end;
  241.  
  242. {
  243. Initialization
  244.   FStructuredStorage:=TStructuredStorage.Create(nil);
  245.  
  246. Finalization
  247.   if Assigned(FStructuredStorage) then
  248.   FStructuredStorage.Free;
  249. }
  250.  
  251. end.
  252.