Ir al contenido



Foto

TMultiWindowMenuControl: Control de Ventanas no MDI


  • Por favor identifícate para responder
No hay respuestas en este tema

#1 escafandra

escafandra

    Advanced Member

  • Moderadores
  • PipPipPip
  • 3.852 mensajes
  • LocationMadrid - España

Escrito 20 septiembre 2019 - 01:03

En este enlace explicaba como un ejercicio práctico como automatizar el control de las ventanas secundarias creadas desde un Formulario principal mediante el manejo de un menú que se crea automáticamente así como sus respuestas. Indicaba también que se podría mejorar creando un componente visual y ese es el objeto de este tema.
 
Básicamente el código es el mismo, basado en SubClassing y adaptado para su comportamiento visual. Se trata de una primera versión de este componente que se puede ir modificando. Como las explicaciones de su razón y funcionamiento ya las expliqué en el hilo original, simplemente paso a mostrar y subir el código.
 


delphi
  1.  
  2. {*******************************************************************************
  3.   TMultiWindowMenuControl V 1.0
  4.   Componente visual para control de ventanas no MDI
  5.  
  6.   Objetivo   : control de ventanas no MDI mediente un componente para formulario
  7.   Autor      : escafandra 2019.
  8.   Plataforma : Windows
  9.   Compilador : Delphi 
  10.  
  11. *******************************************************************************}
  12. {$M+}
  13.  
  14. unit MultiWindowMenuControl;
  15.  
  16.  
  17. interface
  18.  
  19. uses
  20. SysUtils, Classes, Controls, Forms, Windows, Messages, Menus;
  21.  
  22. type
  23. TMForm = class(TForm);
  24.  
  25. TMMenuItem = class(TMenuItem)
  26. published
  27. end;
  28.  
  29. TSubclasWindow = class
  30. private
  31. Form: TMForm;
  32. procedure SubClassWndProc(var Message: TMessage);
  33. protected
  34. { Protected declarations }
  35. public
  36. MainForm: TForm;
  37. constructor Create(AForm: TMForm);
  38. destructor Destroy; override;
  39. published
  40. { Published declarations }
  41. end;
  42.  
  43.  
  44. TMultiWindowMenuControl = class(TComponent)
  45. private
  46. Form: TMForm;
  47. FMenuItem: TMenuItem;
  48. List: TList;
  49. FOnCloseChild: TNotifyEvent;
  50. FOnClick: TNotifyEvent;
  51. procedure SubClassWndProc(var Message: TMessage);
  52. function GetMenuItenPos(MenuID: Cardinal): Integer;
  53. protected
  54. { Protected declarations }
  55. public
  56. procedure Add(NewForm: TForm);
  57. procedure Delete(AForm: TForm);
  58. procedure Clear;
  59. procedure SetMenuItem(NewMenuItem: TMenuItem);
  60. constructor Create(AOwner: TComponent); override;
  61. destructor Destroy; override;
  62. published
  63. property MenuItem: TMenuItem read FMenuItem write SetMenuItem default nil;
  64. property OnClick: TNotifyEvent read FOnClick write FOnClick;
  65. property OnCloseChild: TNotifyEvent read FOnCloseChild write FOnCloseChild;
  66. end;
  67.  
  68. procedure Register;
  69.  
  70. const
  71. WM_MYCLOSE = WM_USER + 1; // WPARAM = MainForm, LPARAM = 0
  72.  
  73. implementation
  74. {$R *.res}
  75. //{$R MultiWindowMenuControl.res}
  76.  
  77. //-----------------------------------------------------------------------------
  78. // TSubclasWindow
  79. constructor TSubclasWindow.Create(AForm: TMForm);
  80. begin
  81. MainForm:= nil;
  82. Form:= TMForm(AForm);
  83. Form.WindowProc:= SubClassWndProc;
  84. end;
  85.  
  86. destructor TSubclasWindow.Destroy;
  87. begin
  88. Form.WindowProc:= Form.WndProc;
  89. inherited Destroy;
  90. end;
  91.  
  92. procedure TSubclasWindow.SubClassWndProc(var Message: TMessage);
  93. begin
  94. if Message.Msg = WM_CLOSE then
  95. begin
  96. if MainForm <> nil then
  97. PostMessage(MainForm.Handle, WM_MYCLOSE, WPARAM(Form), 0);
  98. end;
  99. Form.WndProc(Message);
  100. end;
  101.  
  102. //-----------------------------------------------------------------------------
  103. // TMultiWindowMenuControl
  104. constructor TMultiWindowMenuControl.Create(AOwner: TComponent);
  105. begin
  106. inherited Create(AOwner);
  107. if (AOwner = nil) or not (AOwner is TForm) then exit;
  108. Form:= TMForm(AOwner);
  109. FMenuItem:= nil;
  110. if not (csDesigning in ComponentState) then
  111. begin
  112. List:= TList.Create;
  113. Form.WindowProc:= SubClassWndProc;
  114. end;
  115. end;
  116.  
  117. destructor TMultiWindowMenuControl.Destroy;
  118. begin
  119. if not (csDesigning in ComponentState) then
  120. begin
  121. Form.WindowProc:= Form.WndProc;
  122. Clear;
  123. List.Free;
  124. end;
  125. inherited Destroy;
  126. end;
  127.  
  128. procedure TMultiWindowMenuControl.Clear;
  129. var
  130. Item: TMenuItem;
  131. begin
  132. While List.Count > 0 do
  133. begin
  134. TSubclasWindow(List.Items[0]).Free;
  135. List.Delete(0);
  136. Item:= FMenuItem.Items[0];
  137. FMenuItem.Delete(0);
  138. Item.Free;
  139. end;
  140. end;
  141.  
  142. procedure TMultiWindowMenuControl.SetMenuItem(NewMenuItem: TMenuItem);
  143. var
  144. Item: TMenuItem;
  145. begin
  146. if csDesigning in ComponentState then
  147. begin
  148. FMenuItem:= NewMenuItem;
  149. exit;
  150. end;
  151.  
  152. // Si FMenuItem tenía Items, los traspaso al nuevo MenuItem
  153. if FMenuItem = NewMenuItem then exit;
  154. if NewMenuItem <> nil then
  155. begin
  156. while (FMenuItem <> nil) and (FMenuItem.Count > 0) do
  157. begin
  158. Item:= FMenuItem.Items[0];
  159. FMenuItem.Delete(0);
  160. NewMenuItem.Add(Item);
  161. end;
  162. end
  163. else
  164. Clear;
  165. FMenuItem:= NewMenuItem;
  166. end;
  167.  
  168. procedure TMultiWindowMenuControl.Add(NewForm: TForm);
  169. var
  170. i: integer;
  171. SubClass: TSubclasWindow;
  172. Item: TMenuItem;
  173. begin
  174. if FMenuItem <> nil then
  175. begin
  176. // Comprobando si existe
  177. for i:=0 to List.Count-1 do
  178. if TSubclasWindow(List.Items[i]).Form = NewForm then break;
  179. if (i < List.Count) and (List.Count > 0) then exit;
  180.  
  181. SubClass:= TSubclasWindow.Create(TMForm(NewForm));
  182. SubClass.MainForm:= Form;
  183. List.Add(SubClass);
  184. Item:= TMenuItem.Create(FMenuItem);
  185. Item.Caption:= NewForm.Caption;
  186. FMenuItem.Add(Item);
  187. end;
  188. end;
  189.  
  190. procedure TMultiWindowMenuControl.Delete(AForm: TForm);
  191. var
  192. i: integer;
  193. Item: TMenuItem;
  194. begin
  195. //Buscando para borrar
  196. i:= 0;
  197. While (i < List.Count) and (TSubclasWindow(List.Items[i]).Form <> AForm) do inc(i);
  198. if i < List.Count then
  199. begin
  200. TSubclasWindow(List.Items[i]).Free;
  201. List.Delete(i);
  202. Item:= FMenuItem.Items[i];
  203. FMenuItem.Delete(i);
  204. Item.Free;
  205. end;
  206. end;
  207.  
  208. procedure TMultiWindowMenuControl.SubClassWndProc(var Message: TMessage);
  209. var
  210. Pos: Integer;
  211. begin
  212. if Message.Msg = WM_MYCLOSE then
  213. begin
  214. Delete(TForm(Message.WParam));
  215. if @FOnCloseChild <> nil then FOnCloseChild(TForm(Message.WParam));
  216. end
  217. else if Message.Msg = WM_COMMAND then
  218. begin
  219. Pos:= GetMenuItenPos(LOWORD(Message.WParam));
  220. if Pos <> -1 then
  221. begin
  222. if @FOnClick <> nil then FOnClick(TSubclasWindow(List.Items[Pos]).Form);
  223. TSubclasWindow(List.Items[Pos]).Form.BringToFront;
  224. end;
  225. end;
  226. Form.WndProc(Message);
  227. end;
  228.  
  229. // Encuentra la posición del Item mediante su MenuID
  230. // devuelve -1 si no aparece
  231. function TMultiWindowMenuControl.GetMenuItenPos(MenuID: Cardinal): Integer;
  232. begin
  233. Result:= -1;
  234. if FMenuItem <> nil then
  235. begin
  236. Result:= FMenuItem.Count -1;
  237. while (Result>=0) and (MenuID <> GetMenuItemID(FMenuItem.Handle, Result)) do dec(Result);
  238. end;
  239. end;
  240.  
  241.  
  242. procedure Register;
  243. begin
  244. RegisterComponents('Samples', [TMultiWindowMenuControl]);
  245. end;
  246.  
  247. end. 

 
Al instalarlo se coloca en la paleta de Samples pero nada impide en cambiarla y recompliar.
 
 
Otro detalle que quiero mencionar es que al seleccionar una opción del menú trae a primer plano la ventana en cuestión y luego lanza un evento. Se podría eliminar el hecho de traer el formulario a primer plano y dejar al usuario esa acción o la que desee implementar
 


delphi
  1. else if Message.Msg = WM_COMMAND then
  2. begin
  3. Pos:= GetMenuItenPos(LOWORD(Message.WParam));
  4. if Pos <> -1 then
  5. begin
  6. if @FOnClick <> nil then FOnClick(TSubclasWindow(List.Items[Pos]).Form);
  7. TSubclasWindow(List.Items[Pos]).Form.BringToFront; // <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  8. end;
  9. end;

Comentando la línea marcada ya no traerá a primer plano el formulario, otra opción es que lo haga siempre que no esté definido el evento:


delphi
  1. else if Message.Msg = WM_COMMAND then
  2. begin
  3. Pos:= GetMenuItenPos(LOWORD(Message.WParam));
  4. if Pos <> -1 then
  5. begin
  6. if @FOnClick <> nil then FOnClick(TSubclasWindow(List.Items[Pos]).Form)
  7. else TSubclasWindow(List.Items[Pos]).Form.BringToFront; // <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  8. end;
  9. end;

Bueno, que cada uno lo adapte como quiera.

 

Está probado en delphi 7 y Berlin

 

 

 

Saludos.

 

 

 

 

.

Archivos adjuntos


  • 1