⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 jvqnavigationpane.pas

📁 East make Tray Icon in delphi
💻 PAS
📖 第 1 页 / 共 5 页
字号:
    destructor Destroy; override;
    procedure Change; dynamic;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property Sender: TObject read FSender write FSender;
  end;

  TJvNavPanelTheme = (nptStandard, nptXPBlue, nptXPSilver, nptXPOlive, nptCustom);
  TJvNavPaneStyleManager = class(TJvComponent)
  private
    FColors: TJvNavPanelColors;
    FTheme: TJvNavPanelTheme;
    FClients: TList;
    FFonts: TJvNavPanelFonts;
    FOnThemeChange: TNotifyEvent;
    procedure SetColors(const Value: TJvNavPanelColors);
    procedure SetTheme(const Value: TJvNavPanelTheme);
    procedure DoThemeChange(Sender: TObject);
    procedure SetFonts(const Value: TJvNavPanelFonts);
    function IsColorsStored: Boolean;
    function IsFontsStored: Boolean;
  protected
    procedure Change; virtual;
    procedure AssignTo(Dest: TPersistent); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    procedure RegisterChanges(Value: TJvNavStyleLink);
    procedure UnregisterChanges(Value: TJvNavStyleLink);
  published
    property Colors: TJvNavPanelColors read FColors write SetColors stored IsColorsStored;
    property Fonts: TJvNavPanelFonts read FFonts write SetFonts stored IsFontsStored;
    property Theme: TJvNavPanelTheme read FTheme write SetTheme nodefault;
    property OnThemeChange: TNotifyEvent read FOnThemeChange write FOnThemeChange;
  end;

type 
  TCustomImageListEx = TCustomImageList; 

implementation

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  Math, 
  QForms, QActnList,
  JvQJVCLUtils, JvQJCLUtils, JvQResources;

const
  cNavPanelButtonGroupIndex = 113;
  cToolButtonHeight = 18;
  cToolButtonOffset = 14;
  cToolButtonWidth = 18;

procedure InternalStyleManagerChanged(AControl: TWinControl; AStyleManager: TJvNavPaneStyleManager);
var
  Msg: TMsgStyleManagerChange; 
  I: Integer; 
begin
  Msg.Msg := CM_PARENTSTYLEMANAGERCHANGED;
  Msg.Sender := AControl;
  Msg.StyleManager := AStyleManager;
  Msg.Result := 0;  
  with Msg do
    for I := 0 to AControl.ControlCount - 1 do
      if QWindows.Perform(AControl.Controls[I], Msg, Integer(Sender), Integer(StyleManager)) <> 0 then
        Exit; 
end;

//=== { TCustomImageListEx } =================================================




//=== { TJvIconPanel } =======================================================

constructor TJvIconPanel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle - [csAcceptsControls];
  FStyleLink := TJvNavStyleLink.Create;
  FStyleLink.OnChange := DoStyleChange;
  ControlStyle := ControlStyle + [csOpaque, csAcceptsControls];
  Height := 28;
  FDropButton := TJvNavIconButton.Create(Self);
  FDropButton.Visible := False;
  FDropButton.ButtonType := nibDropDown;
  FDropButton.GroupIndex := 0;
  FDropButton.Width := 22;
  FDropButton.Left := Width + 10;
  FDropButton.Align := alRight;
  FDropButton.Parent := Self;
  FDropButton.OnDropDownMenu := DoDropDownMenu;
  FColors := TJvNavPanelColors.Create;
  FColors.OnChange := DoColorsChange;
  FParentStyleManager := True; 
  ParentFont := False;
  ParentColor := False; 
end;

destructor TJvIconPanel.Destroy;
begin
  FStyleLink.Free;
  FColors.Free;
  // Don't free FDropButton: it is freed automatically
  inherited Destroy;
end;

procedure TJvIconPanel.DoColorsChange(Sender: TObject);
begin
  Invalidate;
end;

procedure TJvIconPanel.DoStyleChange(Sender: TObject);
begin
  Colors := (Sender as TJvNavPaneStyleManager).Colors;
  Font := (Sender as TJvNavPaneStyleManager).Fonts.NavPanelFont;
end;

function TJvIconPanel.GetDropDownMenu: TPopupMenu;
begin
  Result := FDropButton.DropDownMenu
end;

procedure TJvIconPanel.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if Operation = opRemove then
  begin
    if AComponent = StyleManager then
      StyleManager := nil;
  end;
end;

procedure TJvIconPanel.Paint;
begin
  GradientFillRect(Canvas, ClientRect, Colors.ButtonColorFrom, Colors.ButtonColorTo, fdTopToBottom, 32);
  Canvas.Pen.Color := Colors.FrameColor;
  if Align = alBottom then
  begin
    Canvas.MoveTo(0, 0);
    Canvas.LineTo(Width + 1, 0);
  end
  else
  begin
    Canvas.MoveTo(0, ClientHeight - 1);
    Canvas.LineTo(Width + 1, ClientHeight - 1);
  end;
end;

procedure TJvIconPanel.SetColors(const Value: TJvNavPanelColors);
begin
  FColors.Assign(Value);
  FDropButton.Colors := Value;
end;

procedure TJvIconPanel.SetStyleManager(const Value: TJvNavPaneStyleManager);
//var
//  I: Integer;
begin
  if FStyleManager <> Value then
  begin
    ParentStyleManager := False;
    if FStyleManager <> nil then
      FStyleManager.UnregisterChanges(FStyleLink);
    FStyleManager := Value;
    if FStyleManager <> nil then
    begin
      FStyleManager.RegisterChanges(FStyleLink);
      FStyleManager.FreeNotification(Self);
      Colors := FStyleManager.Colors;
    end;
  end;
  //  FDropButton.StyleManager := Value;
  InternalStyleManagerChanged(Self, Value);
  // TODO: should this be removed?
//  for I := 0 to ControlCount - 1 do
//    if Controls[I] is TJvNavIconButton then
//      TJvNavIconButton(Controls[I]).StyleManager := Value;
end;

procedure TJvIconPanel.SetDropDownMenu(const Value: TPopupMenu);
begin
  FDropButton.DropDownMenu := Value;
  FDropButton.Visible := Value <> nil;
end;

procedure TJvIconPanel.DoDropDownMenu(Sender: TObject; MousePos: TPoint;
  var Handled: Boolean);
begin
  if Assigned(FOnDropDownMenu) then
    FOnDropDownMenu(Self, MousePos, Handled);
end;

procedure TJvIconPanel.ParentStyleManagerChanged(var Msg: TMsgStyleManagerChange);
begin
  if (Msg.Sender <> Self) and ParentStyleManager then
  begin
    StyleManager := Msg.StyleManager;
    ParentStyleManager := True;
    InternalStyleManagerChanged(Self, Msg.StyleManager);
  end;
end;

procedure TJvIconPanel.SetParentStyleManager(const Value: Boolean);
begin
  if FParentStyleManager <> Value then
  begin
    FParentStyleManager := Value;
    if FParentStyleManager and (Parent <> nil) then  
      QWindows.Perform(Parent, CM_PARENTSTYLEMANAGERCHANGE, 0, 0); 
  end;
end;





procedure TJvIconPanel.ControlsListChanged(Control: TControl; Inserting: Boolean);
begin
  inherited ControlsListChanged(Control, Inserting);
  InternalStyleManagerChanged(Self, StyleManager);
end;

function TJvIconPanel.WidgetFlags: Integer;
begin
  Result := inherited WidgetFlags or Integer(WidgetFlags_WRepaintNoErase);
end;



procedure TJvIconPanel.ParentStyleManagerChange(var Msg: TMessage);
begin
  InternalStyleManagerChanged(Self, StyleManager);
end;

//=== { TJvCustomNavigationPane } ============================================

var
  GlobalNavPanelPageRegistered: Boolean = False;

constructor TJvCustomNavigationPane.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  if not GlobalNavPanelPageRegistered then
  begin
    GlobalNavPanelPageRegistered := True;
    RegisterClasses([TJvNavPanelPage]);
  end;

  FBackground := TJvNavPaneBackgroundImage.Create;
  FBackground.OnChange := DoColorsChange;
  ControlStyle := ControlStyle - [csAcceptsControls];
  FStyleLink := TJvNavStyleLink.Create;
  FStyleLink.OnChange := DoStyleChange;
  FButtonHeight := 28;
  FButtonWidth := 22; 
  ParentColor := False;
  Color := clWindow;
  ControlStyle := ControlStyle + [csOpaque];
  FResizable := True;
  FColors := TJvNavPanelColors.Create;
  FColors.OnChange := DoColorsChange;
  FIconPanel := TJvIconPanel.Create(Self);
  FIconPanel.Parent := Self;
  FIconPanel.Align := alBottom;
  FIconPanel.OnDropDownMenu := DoDropDownMenu;

  FNavPanelFont := TFont.Create;
  FNavPanelHotTrackFont := TFont.Create;  
  FNavPanelFont.Assign(Application.Font); 
  FNavPanelFont.Style := [fsBold];
  FNavPanelFont.OnChange := DoNavPanelFontChange;
  FNavPanelHotTrackFont.Assign(FNavPanelFont);
  FNavPanelHotTrackFont.OnChange := DoNavPanelFontChange;
  FNavPanelHotTrackFontOptions := DefaultTrackFontOptions;
  FSplitter := TJvOutlookSplitter.Create(Self);
  with FSplitter do
  begin
    ResizeStyle := rsNone;
    MinSize := 1;
    OnCanResize := DoSplitterCanResize;
    Parent := Self;
  end;
  FParentStyleManager := True; 
  FIconPanel.SetSubComponent(True);
  FSplitter.SetSubComponent(True); 
end;

destructor TJvCustomNavigationPane.Destroy;
begin
  FStyleLink.Free;
  FColors.Free;
  FNavPanelFont.Free;
  FNavPanelHotTrackFont.Free;
  FBackground.Free;
  inherited Destroy;
end;

procedure TJvCustomNavigationPane.DoSplitterCanResize(Sender: TObject;
  var NewSize: Integer; var Accept: Boolean);
var
  ACount: Integer;
begin
  ACount := MaximizedCount;
  if NewSize < ButtonHeight div 2 then
    MaximizedCount := ACount - 1
  else
  if NewSize > ButtonHeight + ButtonHeight div 2 then
    MaximizedCount := ACount + 1;
  NewSize := 0;
  Accept := False;
end;

function TJvCustomNavigationPane.GetDropDownMenu: TPopupMenu;
begin
  if FIconPanel <> nil then
    Result := FIconPanel.DropDownMenu
  else
    Result := nil;
end;

function TJvCustomNavigationPane.GetSmallImages: TCustomImageList;
begin
  Result := FSmallImages;
end;

function TJvCustomNavigationPane.GetMaximizedCount: Integer;
var
  I: Integer;
begin
  Result := 0;
  for I := 0 to PageCount - 1 do
    if not NavPages[I].Iconic then
      Inc(Result);
end;

function TJvCustomNavigationPane.HidePage(Page: TJvCustomPage): TJvCustomPage;
begin
  Result := inherited HidePage(Page);
  if Result <> nil then
    UpdatePositions;
end;

function TJvCustomNavigationPane.ShowPage(Page: TJvCustomPage; PageIndex: Integer): TJvCustomPage;
begin

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -