No replies to this topic

[escafandra]

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

 
{*******************************************************************************
  TMultiWindowMenuControl V 1.0
  Componente visual para control de ventanas no MDI
 
  Objetivo   : control de ventanas no MDI mediente un componente para formulario
  Autor      : escafandra 2019.
  Plataforma : Windows
  Compilador : Delphi 
 
*******************************************************************************}
{$M+}
 
unit MultiWindowMenuControl;
 
 
interface
 
uses
  SysUtils, Classes, Controls, Forms, Windows, Messages, Menus;
 
type
  TMForm = class(TForm);
 
  TMMenuItem = class(TMenuItem)
  published
  end;
 
  TSubclasWindow = class
  private
    Form: TMForm;
    procedure SubClassWndProc(var Message: TMessage);
  protected
    { Protected declarations }
  public
    MainForm: TForm;
    constructor Create(AForm: TMForm);
    destructor Destroy; override;
  published
    { Published declarations }
  end;
 
 
  TMultiWindowMenuControl = class(TComponent)
  private
    Form: TMForm;
    FMenuItem: TMenuItem;
    List: TList;
    FOnCloseChild: TNotifyEvent;
    FOnClick: TNotifyEvent;
    procedure SubClassWndProc(var Message: TMessage);
    function  GetMenuItenPos(MenuID: Cardinal): Integer;
  protected
    { Protected declarations }
  public
    procedure Add(NewForm: TForm);
    procedure Delete(AForm: TForm);
    procedure Clear;
    procedure SetMenuItem(NewMenuItem: TMenuItem);
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property MenuItem: TMenuItem read FMenuItem write SetMenuItem default nil;
    property OnClick: TNotifyEvent read FOnClick write FOnClick;
    property OnCloseChild: TNotifyEvent read FOnCloseChild write FOnCloseChild;
  end;
 
procedure Register;
 
const
  WM_MYCLOSE = WM_USER + 1;  // WPARAM = MainForm, LPARAM = 0
 
implementation
{$R *.res}
//{$R MultiWindowMenuControl.res}
 
//-----------------------------------------------------------------------------
// TSubclasWindow
constructor TSubclasWindow.Create(AForm: TMForm);
begin
  MainForm:= nil;
  Form:= TMForm(AForm);
  Form.WindowProc:= SubClassWndProc;
end;
 
destructor TSubclasWindow.Destroy;
begin
  Form.WindowProc:= Form.WndProc;
  inherited Destroy;
end;
 
procedure TSubclasWindow.SubClassWndProc(var Message: TMessage);
begin
  if Message.Msg = WM_CLOSE then
  begin
    if MainForm <> nil then
      PostMessage(MainForm.Handle, WM_MYCLOSE, WPARAM(Form), 0);
  end;
    Form.WndProc(Message);
end;
 
//-----------------------------------------------------------------------------
// TMultiWindowMenuControl
constructor TMultiWindowMenuControl.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  if (AOwner = nil) or not (AOwner is TForm) then exit;
  Form:= TMForm(AOwner);
  FMenuItem:= nil;
  if not (csDesigning in ComponentState) then
  begin
    List:= TList.Create;
    Form.WindowProc:= SubClassWndProc;
  end;
end;
 
destructor TMultiWindowMenuControl.Destroy;
begin
  if not (csDesigning in ComponentState) then
  begin
    Form.WindowProc:= Form.WndProc;
    Clear;
    List.Free;
  end;
  inherited Destroy;
end;
 
procedure TMultiWindowMenuControl.Clear;
var
  Item: TMenuItem;
begin
  While List.Count > 0 do
  begin
    TSubclasWindow(List.Items[0]).Free;
    List.Delete(0);
    Item:= FMenuItem.Items[0];
    FMenuItem.Delete(0);
    Item.Free;
  end;
end;
 
procedure TMultiWindowMenuControl.SetMenuItem(NewMenuItem: TMenuItem);
var
  Item: TMenuItem;
begin
  if csDesigning in ComponentState then
  begin
    FMenuItem:= NewMenuItem;
    exit;
  end;
 
  // Si FMenuItem tenía Items, los traspaso al nuevo MenuItem
  if FMenuItem = NewMenuItem then exit;
  if NewMenuItem <> nil then
  begin
    while (FMenuItem <> nil) and (FMenuItem.Count > 0) do
    begin
      Item:= FMenuItem.Items[0];
      FMenuItem.Delete(0);
      NewMenuItem.Add(Item);
    end;
  end
  else
    Clear;
  FMenuItem:= NewMenuItem;
end;
 
procedure TMultiWindowMenuControl.Add(NewForm: TForm);
var
  i: integer;
  SubClass: TSubclasWindow;
  Item: TMenuItem;
begin
  if FMenuItem <> nil then
  begin
    // Comprobando si existe
    for i:=0 to List.Count-1 do
      if TSubclasWindow(List.Items[i]).Form = NewForm then break;
    if (i < List.Count) and (List.Count > 0) then exit;
 
    SubClass:= TSubclasWindow.Create(TMForm(NewForm));
    SubClass.MainForm:= Form;
    List.Add(SubClass);
    Item:= TMenuItem.Create(FMenuItem);
    Item.Caption:= NewForm.Caption;
    FMenuItem.Add(Item);
  end;
end;
 
procedure TMultiWindowMenuControl.Delete(AForm: TForm);
var
  i: integer;
  Item: TMenuItem;
begin
  //Buscando para borrar
  i:= 0;
  While (i < List.Count) and (TSubclasWindow(List.Items[i]).Form <> AForm) do inc(i);
  if i < List.Count then
  begin
    TSubclasWindow(List.Items[i]).Free;
    List.Delete(i);
    Item:= FMenuItem.Items[i];
    FMenuItem.Delete(i);
    Item.Free;
  end;
end;
 
procedure TMultiWindowMenuControl.SubClassWndProc(var Message: TMessage);
var
  Pos: Integer;
begin
  if Message.Msg = WM_MYCLOSE then
  begin
    Delete(TForm(Message.WParam));
    if @FOnCloseChild <> nil then FOnCloseChild(TForm(Message.WParam));
  end
  else if Message.Msg = WM_COMMAND then
  begin
    Pos:= GetMenuItenPos(LOWORD(Message.WParam));
    if Pos <> -1 then
    begin
      if @FOnClick <> nil then FOnClick(TSubclasWindow(List.Items[Pos]).Form);
      TSubclasWindow(List.Items[Pos]).Form.BringToFront;
    end;
  end;
  Form.WndProc(Message);
end;
 
// Encuentra la posición del Item mediante su MenuID
// devuelve -1 si no aparece
function TMultiWindowMenuControl.GetMenuItenPos(MenuID: Cardinal): Integer;
begin
  Result:= -1;
  if FMenuItem <> nil then
  begin
    Result:= FMenuItem.Count -1;
    while (Result>=0) and  (MenuID <> GetMenuItemID(FMenuItem.Handle, Result)) do dec(Result);
  end;
end;
 
 
procedure Register;
begin
  RegisterComponents('Samples', [TMultiWindowMenuControl]);
end;
 
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

else if Message.Msg = WM_COMMAND then
  begin
    Pos:= GetMenuItenPos(LOWORD(Message.WParam));
    if Pos <> -1 then
    begin
      if @FOnClick <> nil then FOnClick(TSubclasWindow(List.Items[Pos]).Form);
      TSubclasWindow(List.Items[Pos]).Form.BringToFront;    // <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
    end;
  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

else if Message.Msg = WM_COMMAND then
  begin
    Pos:= GetMenuItenPos(LOWORD(Message.WParam));
    if Pos <> -1 then
    begin
      if @FOnClick <> nil then FOnClick(TSubclasWindow(List.Items[Pos]).Form)
      else TSubclasWindow(List.Items[Pos]).Form.BringToFront;    // <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
    end;
  end;

Bueno, que cada uno lo adapte como quiera.

 

Está probado en delphi 7 y Berlin

 

 

 

Saludos.

 

 

 

 

.

Attached Files

•  MultiWindowMenuControl.zip   23.33KB   6 downloads
•  Ejemplo.zip   197.44KB   6 downloads