unit uPantallaPrincipal; interface uses Windows, Forms, SysUtils, Messages, JvMenus, Menus, Graphics, AppEvnts, JvAppStorage, JvAppRegistryStorage, JvFormPlacement, JvComponentBase, JvNavigationPane, ImgList, Controls, PngImageList, Classes, ActnList, XPMan, TBXStatusBars, JvXPCore, JvXPContainer, pngimage, ExtCtrls, StdCtrls, JvPageList, JvExControls, JvExExtCtrls, JvSplitter, JvSyncSplitter, TBXDkPanels, uCustomEditor, uHostManager, uGUIBase; type IMainForm = interface(IHostForm) ['{7F6F5574-5E5C-486C-AA24-D3AEAA52D243}'] procedure ReleaseEmbedded; end; TfPantallaPrincipal = class(TForm, IHostForm, IMainForm) GeneralActionList: TActionList; ModulesSmallImageList: TPngImageList; XPManifest1: TXPManifest; actSalir: TAction; ModulesLargeImageList: TPngImageList; pnlContenido: TTBXAlignmentPanel; JvNavigationPane: TJvNavigationPane; pnlMain: TTBXAlignmentPanel; JvSyncSplitter1: TJvSyncSplitter; actLogin: TAction; StyleManagerButtons: TJvNavPaneStyleManager; JvFormStorage: TJvFormStorage; JvAppRegistryStorage: TJvAppRegistryStorage; actAdministracion: TAction; ApplicationEvents: TApplicationEvents; actCambiarPass: TAction; actConexion: TAction; actAcerca: TAction; pnlBorde: TJvXPContainer; HostMenu: TJvMainMenu; JvXPMenuItemPainter1: TJvXPMenuItemPainter; Archivo2_OLD: TMenuItem; Ayuda2_OLD: TMenuItem; Cambiarmicontrasea2_OLD: TMenuItem; Configurarconexin2_OLD: TMenuItem; Salir2_OLD: TMenuItem; Acercade2_OLD: TMenuItem; lblBienvenido: TLabel; Label22: TLabel; TBXStatusBar1: TTBXStatusBar; StatusBarImages: TPngImageList; Opciones1_OLD: TMenuItem; Edicin1_OLD: TMenuItem; N1: TMenuItem; actVentasMenu: TAction; pagInicio: TJvNavPanelPage; Panel1: TPanel; Label1: TLabel; Image1: TImage; actActualizaciones: TAction; actVerPanel: TAction; actVerBarraEstado: TAction; Paneldeexploracin1: TMenuItem; Paneldeexploracin2: TMenuItem; Administracin1: TMenuItem; N2: TMenuItem; Usuarios1: TMenuItem; Perfiles1: TMenuItem; procedure FormCreate(Sender: TObject); procedure Salir1Click(Sender: TObject); procedure actSalirExecute(Sender: TObject); procedure actCambiarPassExecute(Sender: TObject); procedure actAcercaExecute(Sender: TObject); procedure actConexionExecute(Sender: TObject); procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); procedure ApplicationEventsException(Sender: TObject; E: Exception); procedure actVentasMenuExecute(Sender: TObject); procedure actActualizacionesExecute(Sender: TObject); procedure actVerPanelUpdate(Sender: TObject); procedure actVerPanelExecute(Sender: TObject); procedure actVerBarraEstadoUpdate(Sender: TObject); procedure actVerBarraEstadoExecute(Sender: TObject); procedure Acercade1Click(Sender: TObject); procedure Usuarios1Click(Sender: TObject); procedure Perfiles1Click(Sender: TObject); procedure FormShow(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); private FContenido : TCustomEditor; procedure ShowEmbedded(AEditor : ICustomEditor); procedure ReleaseEmbedded; procedure AplicarPerfil; procedure RefrescarUI; procedure InicializarUI; procedure OnThemeChange(Sender: TObject); procedure ExecuteActionMenu(Sender : TObject); //procedure WMSysCommand(var Msg: TWMSysCommand); message WM_SYSCOMMAND; protected function GetWorkPanel : TWinControl; procedure CreateParams(var Params: TCreateParams); override; public function IsShortcut(var Message: TWMKey): Boolean; override; procedure OnWorkPanelChanged(AEditor : ICustomEditor); constructor Create(AOwner: TComponent); override; property WorkPanel : TWinControl read GetWorkPanel; end; var fPantallaPrincipal: TfPantallaPrincipal; implementation uses uSplash, uAcercaDe, UxTheme, Themes, uMenuUtils, uAdminPV_App, uDMBase, uModuleController, uMainMenuController, uNavPaneController, uDialogUtils, cxControls, uClienteUtils; {$R *.dfm} { ***************************** TfPantallaPrincipal ****************************** } procedure TfPantallaPrincipal.FormClose(Sender: TObject; var Action: TCloseAction); begin //Tiene que ser en este método porque salta antes que liberar la aplicación, si lo dejamos //en el evento onDestroy no le da tiempo a liberar el contenido y se pone a liberar la aplicación //provocando un error de memoria ReleaseEmbedded; ApplicationEvents.CancelDispatch; end; procedure TfPantallaPrincipal.FormCloseQuery(Sender: TObject; var CanClose: Boolean); begin CanClose := True; if Assigned(FContenido) then CanClose := FContenido.CloseQuery; end; procedure TfPantallaPrincipal.FormCreate(Sender: TObject); begin ApplicationEvents.Activate; Application.Title := AppAdminPV.AppName + ' ' + AppAdminPV.AppVersion; Caption := Application.Title; JvNavigationPane.StyleManager := dmBase.StyleManager; dmBase.OnThemeChange := Self.OnThemeChange; Self.OnThemeChange(Self); // Forzar el refresco de los colores del tema activo actLogin.Execute; end; procedure TfPantallaPrincipal.FormShow(Sender: TObject); begin InicializarUI; end; procedure TfPantallaPrincipal.RefrescarUI; var ATitulo : String; begin ATitulo := AppAdminPV.AppName + ' ' + AppAdminPV.AppVersion; Application.Title := ATitulo; Caption := Application.Title; if dmBase.HayConexion then TBXStatusBar1.Panels[0].Caption := 'Conectado a: ' + dmBase.ROChannel.TargetURL else TBXStatusBar1.Panels[0].Caption := 'Desconectado'; if Assigned(AppAdminPV.UsuarioActivo) then TBXStatusBar1.Panels[1].Caption := AppAdminPV.UsuarioActivo.UserName else TBXStatusBar1.Panels[1].Caption := ''; AplicarPerfil; end; procedure TfPantallaPrincipal.ReleaseEmbedded; begin if Assigned(FContenido) then FContenido.Release; FContenido := Nil; Application.ProcessMessages; end; procedure TfPantallaPrincipal.Salir1Click(Sender: TObject); begin Close; end; procedure TfPantallaPrincipal.actSalirExecute(Sender: TObject); begin Close; end; procedure TfPantallaPrincipal.actVentasMenuExecute(Sender: TObject); begin // end; procedure TfPantallaPrincipal.actVerBarraEstadoExecute(Sender: TObject); begin TBXStatusBar1.Visible := not TBXStatusBar1.Visible; end; procedure TfPantallaPrincipal.actVerBarraEstadoUpdate(Sender: TObject); begin (Sender as TAction).Checked := TBXStatusBar1.Visible; end; procedure TfPantallaPrincipal.actVerPanelExecute(Sender: TObject); begin JvNavigationPane.Visible := not JvNavigationPane.Visible; if (JvNavigationPane.Visible) and (JvNavigationPane.Width = 0) then JvNavigationPane.Width := 210; end; procedure TfPantallaPrincipal.actVerPanelUpdate(Sender: TObject); begin (Sender as TAction).Checked := JvNavigationPane.Visible and (JvNavigationPane.Width > 0); end; procedure TfPantallaPrincipal.OnThemeChange(Sender: TObject); begin LockWindowUpdate(Handle); try Color := dmBase.StyleManager.Colors.DividerColorTo; //pnlBorde.Color := dmBase.StyleManager.Colors.FrameColor; pnlBorde.BoundColor := dmBase.StyleManager.Colors.FrameColor; with StyleManagerButtons do begin Colors.ButtonColorFrom := clWindow; Colors.ButtonColorTo := clWindow; Colors.ButtonSeparatorColor := clWindow; Colors.SplitterColorFrom := clWindow; Colors.SplitterColorTo := clWindow; Colors.DividerColorFrom := clWindow; Colors.DividerColorTo := clWindow; Colors.HeaderColorFrom := clWindow; Colors.HeaderColorTo := clWindow; Colors.FrameColor := clWindow; Colors.ToolPanelHeaderColorFrom := clWindow; Colors.ToolPanelHeaderColorTo := clWindow; Colors.ButtonHotColorFrom := dmBase.StyleManager.Colors.ButtonHotColorFrom; Colors.ButtonHotColorTo := dmBase.StyleManager.Colors.ButtonHotColorTo; Colors.ButtonSelectedColorFrom := dmBase.StyleManager.Colors.ButtonSelectedColorFrom; Colors.ButtonSelectedColorTo := dmBase.StyleManager.Colors.ButtonSelectedColorTo; end; lblBienvenido.Font.Color := JvNavigationPane.Colors.ButtonColorTo; { JvGradient1.StartColor := JvNavigationPane.Colors.ButtonColorFrom; JvGradient1.EndColor := JvNavigationPane.Colors.ButtonColorTo;} finally LockWindowUpdate(0); Refresh; end; end; function TfPantallaPrincipal.GetWorkPanel: TWinControl; begin Result := pnlMain; end; procedure TfPantallaPrincipal.InicializarUI; var i : Integer; begin for i := 0 to AppAdminPV.ModuleManager.ModulesCount - 1 do MainMenuController.RegisterModule(AppAdminPV.ModuleManager.Modules[i]); MainMenuController.SortMenuByTag; MainMenuController.InitMainMenu; for i := 0 to AppAdminPV.ModuleManager.ModulesCount - 1 do NavPaneController.RegisterModule(AppAdminPV.ModuleManager.Modules[i]); NavPaneController.InitNavPane; // Oculto la página de inicio para que no parezca // que se pueden manejar varias empresas. JvNavigationPane.ActivePageIndex := 1; pagInicio.PageList := NIL; pagInicio.Visible := False; RefrescarUI; end; procedure TfPantallaPrincipal.ExecuteActionMenu(Sender: TObject); var i : integer; begin for i := 0 to JvNavigationPane.PageCount - 1 do begin if JvNavigationPane.NavPages[i].Caption = (Sender as TAction).Caption then begin JvNavigationPane.ActivePageIndex := i; Break; end; end; end; procedure TfPantallaPrincipal.AplicarPerfil; var AMenuItem : TMenuItem; ASeccionCount : Integer; AItemIndex : Integer; ACaption : String; begin // Si el usuario es administrador puede acceder a la parte de administración. if not AppAdminPV.UsuariosController.EsAdministrador(AppAdminPV.UsuarioActivo) then begin Administracin1.Enabled := False; Administracin1.Visible := False; end; // Guardar la lista de secciones (Ventas, Compras, etc...) for ASeccionCount := 0 to Menu.Items.Count - 1 do begin AMenuItem := Menu.Items[ASeccionCount]; if not EsUnModulo(AMenuItem) then Continue; for AItemIndex := 0 to (AMenuItem.Count - 1) do begin if ((not AMenuItem[AItemIndex].IsLine) // que no sea una línea separadora and (AMenuItem[AItemIndex].Count = 0)) // y que no sea el padre de un submenú then if Assigned(AMenuItem[AItemIndex].Action) then with AppAdminPV.UsuariosController do begin ACaption := TAction(AMenuItem[AItemIndex].Action).Caption; ACaption := StringReplace(ACaption, '&', '', []); TAction(AMenuItem[AItemIndex].Action).Enabled := HayAccesoPermitido(ACaption); end; end; end; end; procedure TfPantallaPrincipal.ApplicationEventsException(Sender: TObject; E: Exception); begin { if E is EROSessionNotFound then begin // OJOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO if not dmUsuarios.Login then ShowMessage(E.Message); end else} Application.ShowException(E); //ShowErrorMessage('Se ha producido un error', '', E); end; procedure TfPantallaPrincipal.OnWorkPanelChanged(AEditor: ICustomEditor); begin // end; procedure TfPantallaPrincipal.Perfiles1Click(Sender: TObject); begin AppAdminPV.UsuariosController.VerPerfiles; end; procedure TfPantallaPrincipal.ShowEmbedded(AEditor: ICustomEditor); begin if Assigned(FContenido) and not FContenido.CloseQuery then begin AEditor.Release; AEditor := NIL; Exit; end; ShowHourglassCursor; LockWindowUpdate(Handle); ReleaseEmbedded; try FContenido := TCustomEditor(AEditor.GetInstance); with (FContenido) do begin Visible := False; BorderIcons := []; BorderStyle := bsNone; Parent := WorkPanel; FContenido.Show; Align := alClient; FContenido.SetFocus; end; finally Application.ProcessMessages; LockWindowUpdate(0); HideHourglassCursor; end; OnWorkPanelChanged(FContenido); end; procedure TfPantallaPrincipal.Usuarios1Click(Sender: TObject); begin AppAdminPV.UsuariosController.VerUsuarios; end; {procedure TfPantallaPrincipal.WMSysCommand(var Msg: TWMSysCommand); message WM_SYSCOMMAND; begin // Sirve para recuperar el foco el formulario principal cuando // tenemos varios formularios hijos abiertos a la vez. case (Msg.cmdtype and $FFF0) of SC_MINIMIZE: begin ShowWindow(handle, SW_MINIMIZE); Msg.result := 0; end; SC_RESTORE: begin ShowWindow(handle, SW_RESTORE); Msg.result := 0; end; else DefaultHandler(Msg); end; end;} constructor TfPantallaPrincipal.Create(AOwner: TComponent); begin inherited; FContenido := NIL; with AppAdminPV.ModuleManager do begin MainMenu := Self.Menu; MainForm := Self; end; with NavPaneController do begin SmallImages := ModulesSmallImageList; LargeImages := ModulesLargeImageList; NavigationPane := JvNavigationPane; MainForm := Self; end; with MainMenuController do begin SmallImages := ModulesSmallImageList; LargeImages := ModulesLargeImageList; MainMenu := HostMenu; MainForm := Self; end; end; procedure TfPantallaPrincipal.CreateParams(var Params: TCreateParams); begin { ¡¡¡No quitar este procedimiento aunque no haga nada!!!!! Si se quita, esta pantalla principal se queda en el fondo después de desaparecer la pantalla de login. } inherited CreateParams(Params); end; procedure TfPantallaPrincipal.actActualizacionesExecute(Sender: TObject); begin { fActualizacion := TfActualizacion.Create(Self); try fActualizacion.ShowModal; finally FreeAndNil(fActualizacion); end;} end; procedure TfPantallaPrincipal.actCambiarPassExecute(Sender: TObject); begin AppAdminPV.UsuariosController._ShowChangePassword; RefrescarUI; end; procedure TfPantallaPrincipal.Acercade1Click(Sender: TObject); begin AppAdminPV.UsuariosController.StartLogin; end; procedure TfPantallaPrincipal.actAcercaExecute(Sender: TObject); begin with TfAcercaDe.Create(NIL) do try ShowModal; finally Free; end; end; function TfPantallaPrincipal.IsShortcut(var Message: TWMKey): Boolean; Var ctrl: TWinControl; comp: TComponent; i: Integer; Begin ctrl := ActiveControl; If ctrl <> Nil Then Begin Repeat ctrl := ctrl.Parent Until (ctrl = nil) or (ctrl Is TCustomForm); // Note: replace TCustomFrame with TForm, check if the found form is // self, if not, execute the following block of code. If ctrl <> nil Then Begin For i:= 0 To ctrl.componentcount-1 Do Begin comp:= ctrl.Components[i]; If comp Is TCustomActionList Then Begin result := TCustomActionList(comp).IsShortcut( message ); If result Then Exit; End; End; End; End; //Result := inherited IsShortCut(Message); end; procedure TfPantallaPrincipal.actConexionExecute(Sender: TObject); begin dmBase.ConfigurarConexion; RefrescarUI; end; end.