home *** CD-ROM | disk | FTP | other *** search
/ io Programmo 21 / IOPROG_21.ISO / SOFT / DFMTOOLS.ZIP / Delphi_DFM / Source / fMDIParent.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-11-09  |  7.6 KB  |  253 lines
  1. unit fMDIParent;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   Menus, ToolWin, ComCtrls, ExtCtrls, StdCtrls, ImgList,
  8.   StdActns, ActnList, MenuBar, cShape,  
  9.   fParent;
  10.  
  11. type
  12.   TMainForm = class(TParent)
  13.     ImageList: TImageList;
  14.     HotImageList: TImageList;
  15.     MMenu: TMainMenu;
  16.     MIWindows: TMenuItem;
  17.     MICascade: TMenuItem;
  18.     MITile: TMenuItem;
  19.     MIArrangeIcons: TMenuItem;
  20.     MIMinimizeAll: TMenuItem;
  21.     MIHelp: TMenuItem;
  22.     MIHelptext: TMenuItem;
  23.     N3: TMenuItem;
  24.     MIAuSujet: TMenuItem;
  25.     CoolBar: TCoolBar;
  26.     StatusBar: TStatusBar;
  27.     MenuBar1: TMenuBar;
  28.     Files1: TMenuItem;
  29.     Close1: TMenuItem;
  30.     MICpy: TMenuItem;
  31.     N1: TMenuItem;
  32.     ToolBar: TToolBar;
  33.     TBCpy: TToolButton;
  34.     TB1: TToolButton;
  35.     TBClose: TToolButton;
  36.     TBIBUsers: TToolButton;
  37.     DisabledImageList: TImageList;
  38.     MIViewDFM: TMenuItem;
  39.     procedure FormCreate(Sender: TObject);
  40.     procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  41.     procedure FormDestroy(Sender: TObject);
  42.     procedure FormDeactivate(Sender: TObject);
  43.     procedure FormHide(Sender: TObject);
  44.     procedure FormShow(Sender: TObject);
  45.     procedure MIViewDFMClick(Sender: TObject);
  46.     procedure MICpyClick(Sender: TObject);
  47.     procedure TBCloseClick(Sender: TObject);
  48.   private    { Private declarations }
  49.     FBitmap   : TBitmap;
  50.     //procedure SetUserLevel;override;
  51.     procedure OnIdleProc(Sender: TObject;Simulatiion:Boolean;var Done:Boolean);override;
  52.     procedure ClientWndProc(var Message: TMessage);
  53.   protected
  54.     FClientInstance,
  55.     FDefClientProc: TFarProc;
  56.     procedure OnHint(Sender: TObject);
  57.     function  OpenChild(CT:TClass):Boolean;
  58.     function  FindFirstChild(CT:TFormClass):TForm;
  59.   public     { Public declarations }
  60.     procedure SetBitmap(value:String);
  61.   end;
  62.  
  63. var
  64.   MainForm: TMainForm;
  65.  
  66. implementation
  67.  
  68. uses fTranslateDFM, fViewDFM;
  69.  
  70. {$R *.DFM}
  71.  
  72. //-----------------------------------------------------------------------------}
  73. procedure TMainForm.FormCreate(Sender: TObject);
  74. begin
  75.   inherited;
  76.   fSaveDFM:=False;
  77.  
  78.   //!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  79.   //The Master form of the program must set the Application properties
  80.   Application.OnIdle:=Idle;
  81.   Application.OnHint:=OnHint;
  82.   Application.ShowHint:=true;
  83.  
  84.   //Sent the CallWindowProc for the "Client" windows
  85.   FBitmap:= TBitmap.Create;
  86.   Assert(FDefClientProc=nil);
  87.   FClientInstance := MakeObjectInstance(ClientWndProc);
  88.  
  89.   SetBitmap('f:\Restomax\bmp\rmax2.bmp');
  90. end;
  91.  
  92. //-----------------------------------------------------------------------------}
  93. procedure TMainForm.FormShow(Sender: TObject);
  94. begin
  95.   inherited;
  96.   //Must come after the TCustomForm.CreateWnd  in the Forms Units
  97.   //Under NT can not be in the Create event !!!!!!!
  98.   if Not Assigned(FDefClientProc) then
  99.      FDefClientProc := Pointer(GetWindowLong(ClientHandle, GWL_WNDPROC));
  100.  
  101.   if (FClientInstance<>FDefClientProc)and(FClientInstance<>nil) then
  102.       SetWindowLong(ClientHandle, GWL_WNDPROC, Longint(FClientInstance));
  103. end;
  104.  
  105. //-----------------------------------------------------------------------------}
  106. procedure TMainForm.FormHide(Sender: TObject);
  107. begin
  108.   inherited;
  109.   Assert(Assigned(FDefClientProc));
  110.   //SetWindowLong(ClientHandle, GWL_WNDPROC, Longint(FDefClientProc));
  111. end;
  112.  
  113. //-----------------------------------------------------------------------------}
  114. procedure TMainForm.FormDeactivate(Sender: TObject);
  115. begin
  116.   inherited;
  117.   Assert(Assigned(FDefClientProc));
  118. end;
  119.  
  120. //-----------------------------------------------------------------------------}
  121. procedure TMainForm.FormCloseQuery(Sender: TObject;var CanClose: Boolean);
  122. var i:integer;
  123. begin
  124.   UserEventTime:=Now;
  125.   for I := MDIChildCount - 1 downto 0 do MDIChildren[I].Close;
  126.   CanClose:=(MessageDlg(CLOSEMSG, mtConfirmation, [mbYes,mbNo] , HelpContext)= mrYes);
  127.   if not CanClose then begin
  128.      end;
  129. end;
  130.  
  131. //-----------------------------------------------------------------------------}
  132. procedure TMainForm.FormDestroy(Sender: TObject);
  133. begin
  134.   FBitmap.free;
  135.   inherited;
  136. end;
  137.  
  138. //-----------------------------------------------------------------------------
  139. //Paint on the client BkGrnd
  140. procedure TMainForm.ClientWndProc(var Message: TMessage);
  141. var x,y:integer;
  142.     ThisCanvas : TCanvas;
  143. begin
  144.   with Message do
  145.     case Msg of
  146.       WM_ERASEBKGND:
  147.          begin
  148.          ThisCanvas := TCanvas.Create;
  149.          try ThisCanvas.Handle := TWMEraseBkGnd(Message).DC;
  150.              ThisCanvas.FillRect(ThisCanvas.ClipRect);
  151.              if not FBitmap.Empty then begin
  152.                 //Try to center the bitmap
  153.                 x:=(ClientWidth-fBitmap.Width) div 2;
  154.                 y:=(ClientHeight-CoolBar.Height-FBitmap.Height) div 2;
  155.                 ThisCanvas.Draw(x, y, FBitmap);
  156.                 end;
  157.              Message.Result := 1;
  158.          finally
  159.              ThisCanvas.Free;
  160.          end end;
  161.     else
  162.       Message.Result := CallWindowProc(FDefClientProc, ClientHandle, Msg, wParam, lParam);
  163.     end;
  164. end;
  165.  
  166. //-----------------------------------------------------------------------------}
  167. procedure TMainForm.SetBitmap(value:String);
  168. begin
  169. if value<>'' then
  170.   try FBitmap.ReleaseHandle;
  171.       FBitmap.LoadFromFile(value);
  172.   except
  173.       FBitmap.ReleaseHandle;
  174. end else
  175.   FBitmap.ReleaseHandle;
  176. end;
  177.  
  178. //-----------------------------------------------------------------------------}
  179. //If not redefined on Hint Display .............
  180. procedure TMainForm.OnHint(Sender: TObject);
  181. begin
  182. StatusBar.Panels[0].text:=Application.Hint;
  183. end;
  184.  
  185. //-----------------------------------------------------------------------------}
  186. //Mise α jour de l'horloge, du total, ... dans la StatusBar
  187. procedure TMainForm.OnIdleProc(Sender: TObject;Simulatiion:Boolean;var Done:Boolean);
  188. begin
  189. inherited OnIdleProc(Sender,Simulatiion,Done);
  190. StatusBar.Panels[StatusBar.Panels.Count-1].text:=TimeToStr(Time);
  191. end;
  192.  
  193. //-----------------------------------------------------------------------------}
  194. function TMainForm.OpenChild(CT:TClass):Boolean;
  195. var i:integer;
  196. begin
  197.   inherited;
  198.   result:=false;
  199.   UserEventTime:=Now;
  200.   for I := MDIChildCount - 1 downto 0 do
  201.     if MDIChildren[I] is CT then
  202.        begin
  203.        if MDIChildren[I].WindowState=wsMinimized then
  204.           MDIChildren[I].WindowState:=wsNormal;
  205.        MDIChildren[I].show;
  206.        result:=True;
  207.        exit
  208.     end;
  209. end;
  210.  
  211. //-----------------------------------------------------------------------------}
  212. function TMainForm.FindFirstChild(CT:TFormClass):TForm;
  213. var i:integer;
  214. begin
  215.   Screen.Cursor:=crHourGlass;
  216.   inherited;
  217.   UserEventTime:=Now;
  218.   for I := MDIChildCount - 1 downto 0 do
  219.     if (MDIChildren[I] is CT) then
  220.        begin
  221.        if MDIChildren[I].WindowState=wsMinimized then
  222.           MDIChildren[I].WindowState:=wsNormal;
  223.        MDIChildren[I].BringToFront;
  224.        result:=MDIChildren[I];
  225.        exit
  226.     end;
  227.   Result:=CreateFromRes(CT)
  228. end;
  229.  
  230. //-----------------------------------------------------------------------------}
  231. procedure TMainForm.TBCloseClick(Sender: TObject);
  232. begin
  233.   inherited;
  234.   Close;
  235. end;
  236.  
  237. //-----------------------------------------------------------------------------}
  238. procedure TMainForm.MIViewDFMClick(Sender: TObject);
  239. begin
  240.   inherited;
  241.   CreateFromRes(fViewDFM.TFormViewDFM)
  242. end;
  243.  
  244. //-----------------------------------------------------------------------------}
  245. procedure TMainForm.MICpyClick(Sender: TObject);
  246. begin
  247.   inherited;
  248.   CreateFromRes(fTranslateDFM.TFormTranslate)
  249.   //FindFirstChild(fTranslateDFM.TFormTranslate);
  250. end;
  251.  
  252. end.
  253.