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, JvMenus; type TfPantallaPrincipal = class(TForm, IHostForm) GeneralActionList: TActionList; ModulesSmallImageList: TPngImageList; XPManifest1: TXPManifest; actSalir: TAction; ModulesActionList: TActionList; ModulesLargeImageList: TPngImageList; pnlContenido: TTBXAlignmentPanel; JvNavigationPane: TJvNavigationPane; pnlMain: TTBXAlignmentPanel; JvSyncSplitter1: TJvSyncSplitter; StatusBar: TStatusBar; HostManager: THostManager; actLogin: TAction; pagInicio: TJvNavPanelPage; StyleManagerButtons: TJvNavPaneStyleManager; JvFormStorage: TJvFormStorage; JvAppRegistryStorage: TJvAppRegistryStorage; actAdministracion: TAction; ApplicationEvents: TApplicationEvents; actCambiarPass: TAction; actConexion: TAction; actAcerca: TAction; pnlBorde: TJvXPContainer; HostMenu: TJvMainMenu; JvXPMenuItemPainter1: TJvXPMenuItemPainter; Archivo2: TMenuItem; Ayuda2: TMenuItem; Cambiarmicontrasea2: TMenuItem; N3: TMenuItem; Configurarconexin2: TMenuItem; Paneldeadministracin2: TMenuItem; N4: TMenuItem; Salir2: TMenuItem; Acercade2: TMenuItem; 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 actLoginExecute(Sender: TObject); procedure ApplicationEventsActionExecute(Action: TBasicAction; var Handled: Boolean); procedure actCambiarPassExecute(Sender: TObject); procedure actAcercaExecute(Sender: TObject); procedure Button1Click(Sender: TObject); procedure actConexionExecute(Sender: TObject); private FContenido : TCustomEditor; FStartDefaultAction : TBasicAction; procedure ShowEmbedded(AEditor : ICustomEditor); procedure AplicarPerfil; 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, uPanelControl, uDataModuleUsuarios, uSplash, uAcercaDe, uViewBase,UxTheme, Themes; {$R *.dfm} function OpenThemeData(hwnd: HWND; pszClassList: LPCWSTR): THandle; stdcall; external 'uxtheme.dll'; function CloseThemeData(hTheme: THandle): HRESULT; stdcall; external 'uxtheme.dll'; function DrawThemeBackground(hTheme: THandle; hdc: HDC; iPartId, iStateId: Integer; const pRect: TRect; pClipRect: PRECT): HRESULT; stdcall; external 'uxtheme.dll'; { ***************************** 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); begin Caption := Application.Title + ' - ' + dmBase.DarVersion; SplashScreen := TSplashScreen.Create(Application) ; SplashScreen.Show; JvNavigationPane.StyleManager := dmBase.StyleManager; dmBase.OnThemeChange := Self.OnThemeChange; Self.OnThemeChange(Self); // Forzar el refresco de los colores del tema activo with HostManager do begin BPLPath := ExtractFilePath(Application.ExeName) + '\'; MainForm := Self; end; actLogin.Execute; 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; 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.InitializeUI; function EsUnModulo(AMenuItem : TMenuItem) : Boolean; begin Result := (AMenuItem.Tag >= 0) and (AMenuItem.Tag < 9000) end; 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; { 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; if Pos('Ficheros', AMenuItem.Caption) > 0 then PopulateNavPagePane(pnlEDI, AMenuItem, ModulesLargeImageList, StyleManagerButtons); if Pos('Inventario', AMenuItem.Caption) > 0 then PopulateNavPagePane(pnlInventario, AMenuItem, ModulesLargeImageList, StyleManagerButtons); if Pos('Ventas', AMenuItem.Caption) > 0 then PopulateNavPagePane(pnlVentas, AMenuItem, ModulesLargeImageList, StyleManagerButtons); if Pos('Stock', AMenuItem.Caption) > 0 then PopulateNavPagePane(pnlStock, AMenuItem, ModulesLargeImageList, StyleManagerButtons); // Elimino la imagen que tiene el menú porque queda feo. AMenuItem.ImageIndex := -1; end; JvNavigationPane.ActivePage := pagInicio; ApplicationEvents.OnActionExecute := ApplicationEventsActionExecute; end;} procedure TfPantallaPrincipal.actLoginExecute(Sender: TObject); begin HostManager.UnloadModules; if dmUsuarios.Login then begin ShowHourglassCursor; SplashScreen.Update; Application.ProcessMessages; try HostManager.LoadModule('FicherosEDI.bpl'); HostManager.LoadModule('VentasTerminadas.bpl'); HostManager.LoadModule('VentasProceso.bpl'); HostManager.LoadModule('ReferenciaGenerica.bpl'); HostManager.LoadModule('Recepciones.bpl'); HostManager.LoadModule('Devoluciones.bpl'); HostManager.LoadModule('Traspasos.bpl'); HostManager.LoadModule('Stock.bpl'); InitializeUI; Application.ProcessMessages; Visible := True; AplicarPerfil; finally SplashScreen.Update; SplashScreen.Hide; SplashScreen.Free; HideHourglassCursor; end; end else Application.Terminate; 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.AplicarPerfil; begin actAdministracion.Visible := dmUsuarios.EsAdmin; 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); begin // end; procedure TfPantallaPrincipal.ShowEmbedded(AEditor: ICustomEditor); begin ShowHourglassCursor; 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); HideHourglassCursor; end; OnWorkPanelChanged(FContenido); end; constructor TfPantallaPrincipal.Create(AOwner: TComponent); begin inherited; FContenido := NIL; end; procedure TfPantallaPrincipal.actCambiarPassExecute(Sender: TObject); begin dmUsuarios.CambiarPassword; 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.Button1Click(Sender: TObject); var i : integer; AModule : TModuleInfo; { 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.JvPanel1Paint(Sender: TObject); var PS: PAINTSTRUCT; begin BeginPaint(JvPanel1.Canvas.Handle, PS); ThemeServices.DrawElement(JvPanel1.Canvas.Handle, ThemeServices.GetElementDetails(tebExplorerBarDontCare), JvPanel1.BoundsRect); // ThemeServices.DrawText(JvPanel1.Canvas.Handle, ThemeServices.GetElementDetails(tspUserPane), 'Hola', JvPanel1.Canvas.ClipRect, 0, 0); EndPaint(JvPanel1.Canvas.Handle, PS); end; procedure TfPantallaPrincipal.JvPanel2Paint(Sender: TObject); var PS: PAINTSTRUCT; begin BeginPaint(JvPanel2.Canvas.Handle, PS); ThemeServices.DrawElement(JvPanel2.Canvas.Handle, ThemeServices.GetElementDetails(tebExplorerBarDontCare), JvPanel2.BoundsRect); EndPaint(JvPanel2.Canvas.Handle, PS); end;} procedure TfPantallaPrincipal.actConexionExecute(Sender: TObject); begin dmBase.ConfigurarConexion; end; end.