unit uPantallaPrincipal; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, XPMan, uGUIBase, uCustomEditor, JvNavigationPane, JvExExtCtrls, JvComponent, Menus, ImgList, PngImageList, ActnList, uHostManager, JvExControls, JvPageList, JvPanel, TBX, TB2Item, TB2Dock, TB2Toolbar, ComCtrls, TBXToolPals, TBXLists, TBXExtItems, TB2ExtItems, TBXMDI, TBXDkPanels, JvSplitter, JvSyncSplitter, JvXPBar, JvXPCore, JvXPContainer, JvLookOut, JvOutlookBar, Buttons, JvExButtons, JvBitBtn, JvSpeedButton, JvExStdCtrls, JvButton, JvCtrls, JvStartMenuButton, JvTransparentButton, JvExComCtrls, JvListView, JvAppStorage, JvAppRegistryStorage, JvFormPlacement, JvBaseDlg, JvJVCLAboutForm, AppEvnts, JvWaitingGradient, JvGradient, cxControls, JvComponentBase; type TfPantallaPrincipal = class(TForm, IHostForm) GeneralActionList: TActionList; ModulesSmallImageList: TPngImageList; XPManifest1: TXPManifest; actSalir: TAction; ModulesActionList: TActionList; ModulesLargeImageList: TPngImageList; HostMenu: TMainMenu; Archivo1: TMenuItem; Ayuda1: TMenuItem; pnlContenido: TTBXAlignmentPanel; JvNavigationPane: TJvNavigationPane; JvSyncSplitter1: TJvSyncSplitter; StatusBar: TStatusBar; HostManager: THostManager; Salir1: TMenuItem; pagInicio: TJvNavPanelPage; StyleManagerButtons: TJvNavPaneStyleManager; JvFormStorage: TJvFormStorage; JvAppRegistryStorage: TJvAppRegistryStorage; ApplicationEvents: TApplicationEvents; N1: TMenuItem; actConexion: TAction; Configurarconexin1: TMenuItem; actAcerca: TAction; Acercade1: TMenuItem; Ver1: TMenuItem; pnlBorde: TJvXPContainer; pnlMain: TTBXAlignmentPanel; lblBienvenido: TLabel; Label22: TLabel; procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure HostManagerAfterLoad(Sender: TObject; AModuleInfo: TModuleInfo); procedure Salir1Click(Sender: TObject); procedure actSalirExecute(Sender: TObject); procedure ApplicationEventsActionExecute(Action: TBasicAction; var Handled: Boolean); procedure actAcercaExecute(Sender: TObject); procedure actAdministracionExecute(Sender: TObject); procedure Button1Click(Sender: TObject); procedure actConexionExecute(Sender: TObject); private FContenido : TCustomEditor; // FStartDefaultAction : TBasicAction; FActivePanelSubMenuEditor : TPanel; procedure ShowEmbedded(AEditor : ICustomEditor); function FindNavPanePage(ACaption : String) : Integer; procedure InitializeUI; procedure OnThemeChange(Sender: TObject); procedure CopyImages(const SrcList: TPngImageList; var DstList: TPngImageList; out Index, Count: Integer); procedure RegisterModule(AModuleInfo : TModuleInfo); procedure ExecuteActionMenu(Sender : TObject); protected function GetWorkPanel : TWinControl; public function IsShortcut(var Message: TWMKey): Boolean; override; procedure OnWorkPanelChanged(AEditor : ICustomEditor); property WorkPanel : TWinControl read GetWorkPanel; constructor Create(AOwner: TComponent); override; end; var fPantallaPrincipal: TfPantallaPrincipal; implementation uses PNGImage, uModuleController, uDataModuleBase, Math, uMenuUtils, uSplash, uAcercaDe, uViewBase, uEditorUtils; {$R *.dfm} { ***************************** TfPantallaPrincipal ****************************** } procedure TfPantallaPrincipal.CopyImages(const SrcList: TPngImageList; var DstList: TPngImageList; out Index, Count: Integer); begin Index := -1; Count := 0; if not Assigned(SrcList) or not Assigned(DstList) then Exit; DstList.BeginUpdate; try Index := DstList.Count; DstList.AddImages(SrcList); Count := SrcList.Count; finally DstList.EndUpdate; end; end; procedure TfPantallaPrincipal.FormCreate(Sender: TObject); var ACursor : TCursor; begin ACursor := Screen.Cursor; Screen.Cursor := crHourGlass; try Caption := Application.Title + ' ' + dmBase.darVersion; SplashScreen := TSplashScreen.Create(Application) ; SplashScreen.Show; SplashScreen.Update; Application.ProcessMessages; JvNavigationPane.StyleManager := dmBase.StyleManager; dmBase.OnThemeChange := Self.OnThemeChange; Self.OnThemeChange(Self); // Forzar el refresco de los colores del tema activo SplashScreen.Update; with HostManager do begin BPLPath := ExtractFilePath(Application.ExeName) + '\'; MainForm := Self; Application.ProcessMessages; HostManager.LoadModule('Contactos.bpl'); HostManager.LoadModule('Obras.bpl'); HostManager.LoadModule('FacturasCliente.bpl'); HostManager.LoadModule('Recibos.bpl'); HostManager.LoadModule('ObrasFinal.bpl'); end; InitializeUI; Application.ProcessMessages; Visible := True; finally SplashScreen.Update; SplashScreen.Hide; SplashScreen.Free; Screen.Cursor := ACursor; end; end; procedure TfPantallaPrincipal.FormDestroy(Sender: TObject); begin HostManager.UnloadModules; end; procedure TfPantallaPrincipal.HostManagerAfterLoad(Sender: TObject; AModuleInfo: TModuleInfo); begin RegisterModule(AModuleInfo); end; procedure TfPantallaPrincipal.RegisterModule(AModuleInfo : TModuleInfo); var AModule: TModuleController; AModuleMenu : TMainMenu; AIndex: Integer; ACount: Integer; begin AModule := AModuleInfo.Module; SplashScreen.Texto := 'Cargando ''' + AModule.ModuleName + '''...'; CopyImages(TPngImageList(AModule.SmallImages), TPngImageList(ModulesSmallImageList), AIndex, ACount); CopyImages(TPngImageList(AModule.LargeImages), TPngImageList(ModulesLargeImageList), AIndex, ACount); if Assigned(AModule.ModuleMenu) then begin AModuleMenu := AModule.ModuleMenu; MergeMenus(AModuleMenu, Self.Menu, AIndex); end; end; procedure TfPantallaPrincipal.Salir1Click(Sender: TObject); begin Close; end; procedure TfPantallaPrincipal.actSalirExecute(Sender: TObject); begin Close; end; procedure TfPantallaPrincipal.OnThemeChange(Sender: TObject); begin LockWindowUpdate(Handle); try Color := dmBase.StyleManager.Colors.DividerColorTo; pnlBorde.Color := 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; finally LockWindowUpdate(0); Refresh; end; end; function TfPantallaPrincipal.GetWorkPanel: TWinControl; begin Result := pnlMain; end; procedure TfPantallaPrincipal.InitializeUI; function EsUnModulo(AMenuItem : TMenuItem) : Boolean; begin Result := (AMenuItem.Tag >= 0) and (AMenuItem.Tag < 9000) end; {var i : Integer; AMenuItem : TMenuItem; APageIndex : Integer; begin SortMenuByTag(Menu); for i := 0 to Menu.Items.Count - 1 do begin AMenuItem := Menu.Items[i]; if not EsUnModulo(AMenuItem) then Continue; APageIndex := 0; PopulateNavPagePane(JvNavigationPane.NavPages[APageIndex], AMenuItem, ModulesSmallImageList, StyleManagerButtons); // Elimino la imagen que tiene el menú porque queda feo. AMenuItem.ImageIndex := -1; end; JvNavigationPane.ActivePage := pagInicio; ApplicationEvents.OnActionExecute := ApplicationEventsActionExecute;} var i : Integer; AMenuItem : TMenuItem; APageIndex : Integer; AStringList : TStringList; APanel : TScrollBox; begin SortMenuByTag(Menu); AStringList := TStringList.Create; AStringList.Duplicates := dupIgnore; try for i := 0 to Menu.Items.Count - 1 do begin AMenuItem := Menu.Items[i]; if not EsUnModulo(AMenuItem) then Continue; AStringList.Add(StringReplace(AMenuItem.Caption, '&', '', [])) end; for i := 0 to AStringList.Count - 1 do begin with TJvNavPanelDivider.Create(Self) do begin Parent := pagInicio; Top := 100 * i; Align := alTop; Caption := AStringList[i]; ParentFont := True; if i = 0 then begin Enabled := false; Cursor := crDefault; end else Cursor := crSizeNS; end; APanel := TScrollBox.Create(Self); with APanel do begin Parent := pagInicio; Top := 101 * i; if i = AStringList.Count - 1 then Align := alClient else Align := alTop; BorderStyle := bsNone; end; AStringList.Objects[i] := APanel; end; for i := 0 to Menu.Items.Count - 1 do begin AMenuItem := Menu.Items[i]; if not EsUnModulo(AMenuItem) then Continue; {if not Assigned(FStartDefaultAction) then FStartDefaultAction := AMenuItem[0].Action;} APageIndex := AStringList.IndexOf(StringReplace(AMenuItem.Caption, '&', '', [])); PopulateNavPagePane(TScrollBox(AStringList.Objects[APageIndex]), AMenuItem, ModulesLargeImageList, StyleManagerButtons); // Elimino la imagen que tiene el menú porque queda feo. AMenuItem.ImageIndex := -1; end; finally AStringList.Free; end; ApplicationEvents.OnActionExecute := ApplicationEventsActionExecute; end; function TfPantallaPrincipal.FindNavPanePage(ACaption: String): Integer; var i : integer; begin Result := -1; for i := 0 to JvNavigationPane.PageCount - 1 do if JvNavigationPane.NavPages[i].Caption = ACaption then begin Result := i; break; end; 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.ApplicationEventsActionExecute( Action: TBasicAction; var Handled: Boolean); var APageIndex : Integer; begin if (Action is TAction) then begin APageIndex := FindNavPanePage((Action as TAction).Category); if APageIndex > 0 then JvNavigationPane.ActivePageIndex := APageIndex; end; end; procedure TfPantallaPrincipal.OnWorkPanelChanged(AEditor: ICustomEditor); var AEditorMenu : IEditorMenu; MenuEditor : TMainMenu; NombrePanel : String; // APageNew : TJvNavPanelPage; APanelAux: TPanel; APanelAux2: TPanel; i: Integer; begin //Liberamos el panel del submenu actual si existiese if Assigned(FActivePanelSubMenuEditor) then begin FActivePanelSubMenuEditor.Free; FActivePanelSubMenuEditor := Nil; getSubMenu(Menu, 'Ver').Clear; getSubMenu(Menu, 'Ver').Enabled := False; end; AEditor.QueryInterface(IEditorMenu, AEditorMenu); if Assigned(AEditorMenu) then begin MenuEditor := AEditorMenu.getEditorMenu; SortMenuByTag(MenuEditor); NombrePanel := 'pnl' + StringReplace(MenuEditor.Items[0].Caption,'&','',[]); //Creamos el panel para el submenu APanelAux := TPanel.Create(Self); with APanelAux do begin Parent := JvNavigationPane.NavPages[0];//APageNew; ParentColor := True; ParentFont := True; BevelOuter := bvNone; BevelInner := bvNone; Height := 200; AutoScroll := True; Align := alBottom; Name := NombrePanel; Caption := ''; end; with TJvNavPanelDivider.Create(Self) do begin Parent := APanelAux; Caption := 'Vistas disponibles'; StyleManager := JvNavigationPane.StyleManager; Align := alTop; end; APanelAux2 := TPanel.Create(Self); with APanelAux2 do begin Parent := APanelAux; Caption := ''; ParentColor := True; ParentFont := True; BevelOuter := bvNone; BevelInner := bvNone; AutoScroll := True; Align := alClient; BorderWidth := 10; end; //Cada uno de los items del submenu se corresponderá con un radiobutton with MenuEditor.Items[0] do begin for i := (Count - 1) downto 0 do begin with TRadioButton.Create(Self) do begin Parent := APanelAux2; Action := Items[i].Action; Align := alTop; Tag := Items[i].Tag; Caption := Items[i].Caption; end; end; end; //Rellenamos el menu Ver con todos y cada uno de los items posibles copiarItemsMenu(getSubMenu(Menu, 'Ver'), MenuEditor.Items[0]); getSubMenu(Menu, 'Ver').Enabled := True; FActivePanelSubMenuEditor := APanelAux; end; end; procedure TfPantallaPrincipal.ShowEmbedded(AEditor: ICustomEditor); var ACursor : TCursor; begin ACursor := Screen.Cursor; Screen.Cursor := crHourGlass; LockWindowUpdate(Handle); try if Assigned(FContenido) then FContenido.Release; FContenido := AEditor.GetInstance as TCustomEditor; with (FContenido) do begin Visible := False; BorderIcons := []; BorderStyle := bsNone; Parent := WorkPanel; FContenido.Show; Align := alClient; FContenido.SetFocus; end; finally Application.ProcessMessages; LockWindowUpdate(0); Screen.Cursor := ACursor; end; OnWorkPanelChanged(FContenido); end; constructor TfPantallaPrincipal.Create(AOwner: TComponent); begin inherited; FContenido := NIL; end; procedure TfPantallaPrincipal.actAcercaExecute(Sender: TObject); begin with TfAcercaDe.Create(NIL) do try HostManager := Self.HostManager; 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.actAdministracionExecute(Sender: TObject); begin // end; procedure TfPantallaPrincipal.Button1Click(Sender: TObject); //var // i : integer; // AModule : TModuleInfo; // AVista : IViewInicio; { lCLG: TdxLayoutGroup; lLI: TdxLayoutItem;} begin { for i := 0 to HostManager.ModulesCount -1 do begin AModule := HostManager.Modules[i]; if Supports(AModule.Module, IViewInicio, AVista) then begin Exit; lLI := dxLayoutControl1.CreateItemForControl(Button2); lLI.Caption := 'Hello World'; lCLG := dxLayoutControl1.CreateGroup; lCLG.Caption := 'Test this'; lCLG.Parent := dxLayoutControl1.Items; lLI.Parent := lCLG; dxLayoutControl1.Customization := True; end; end; } end; procedure TfPantallaPrincipal.actConexionExecute(Sender: TObject); begin dmBase.ConfigurarConexion; end; end.