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

📄 uoffice2007.pas

📁 Delphi的Office 2007风格界面控件
💻 PAS
字号:
unit UOffice2007;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, AdvToolBar, AdvToolBarStylers, AdvGlowButton, Menus, AdvMenus,
  ImgList, AdvOfficeHint, AdvMenuStylers, StdCtrls, ExtCtrls,
  AdvShapeButton, AdvPreviewMenu, AdvPreviewMenuStylers, ShellAPI
  {$IFDEF VER150}
  ,XPMan
  {$ENDIF}
  {$IFDEF VER160}
  ,XPMan
  {$ENDIF}
  {$IFDEF VER170}
  ,XPMan
  {$ENDIF}
  {$IFDEF VER180}
  ,XPMan
  {$ENDIF}
  ;

type
  Ts = class(TForm)
    AdvToolBarOfficeStyler1: TAdvToolBarOfficeStyler;
    AdvToolBarPager1: TAdvToolBarPager;
    AdvPage1: TAdvPage;
    AdvToolBar2: TAdvToolBar;
    AdvGlowButton7: TAdvGlowButton;
    AdvToolBar3: TAdvToolBar;
    AdvGlowButton9: TAdvGlowButton;
    AdvToolBar5: TAdvToolBar;
    AdvToolBar6: TAdvToolBar;
    AdvPage2: TAdvPage;
    AdvToolBar1: TAdvToolBar;
    AdvGlowButton1: TAdvGlowButton;
    AdvToolBar4: TAdvToolBar;
    AdvPage3: TAdvPage;
    AdvPage4: TAdvPage;
    AdvPopupMenu1: TAdvPopupMenu;
    file1: TMenuItem;
    open1: TMenuItem;
    save1: TMenuItem;
    AdvGlowMenuButton1: TAdvGlowMenuButton;
    AdvGlowButton10: TAdvGlowButton;
    Olive1: TMenuItem;
    Silver1: TMenuItem;
    XP1: TMenuItem;
    ImageList1: TImageList;
    AdvGlowButton11: TAdvGlowButton;
    AdvGlowButton16: TAdvGlowButton;
    AdvGlowButton17: TAdvGlowButton;
    AdvGlowButton8: TAdvGlowButton;
    AdvGlowButton15: TAdvGlowButton;
    AdvGlowButton18: TAdvGlowButton;
    AdvGlowButton19: TAdvGlowButton;
    AdvGlowButton20: TAdvGlowButton;
    AdvGlowButton21: TAdvGlowButton;
    AdvGlowButton22: TAdvGlowButton;
    AdvGlowButton23: TAdvGlowButton;
    AdvGlowButton24: TAdvGlowButton;
    AdvGlowButton25: TAdvGlowButton;
    AdvGlowButton2: TAdvGlowButton;
    AdvGlowButton26: TAdvGlowButton;
    AdvGlowButton27: TAdvGlowButton;
    AdvToolBar7: TAdvToolBar;
    AdvGlowButton3: TAdvGlowButton;
    AdvGlowButton4: TAdvGlowButton;
    AdvGlowButton5: TAdvGlowButton;
    AdvGlowButton6: TAdvGlowButton;
    AdvGlowButton28: TAdvGlowButton;
    AdvGlowButton29: TAdvGlowButton;
    AdvGlowButton30: TAdvGlowButton;
    AdvGlowButton31: TAdvGlowButton;
    AdvGlowButton32: TAdvGlowButton;
    AdvGlowButton33: TAdvGlowButton;
    AdvGlowButton34: TAdvGlowButton;
    AdvToolBar8: TAdvToolBar;
    AdvGlowButton35: TAdvGlowButton;
    AdvGlowButton36: TAdvGlowButton;
    AdvGlowButton37: TAdvGlowButton;
    AdvGlowButton38: TAdvGlowButton;
    AdvGlowButton39: TAdvGlowButton;
    AdvToolBar9: TAdvToolBar;
    AdvGlowButton40: TAdvGlowButton;
    AdvGlowButton41: TAdvGlowButton;
    AdvGlowButton42: TAdvGlowButton;
    AdvGlowButton43: TAdvGlowButton;
    AdvToolBar10: TAdvToolBar;
    AdvGlowButton44: TAdvGlowButton;
    AdvGlowButton45: TAdvGlowButton;
    AdvGlowButton46: TAdvGlowButton;
    AdvGlowButton47: TAdvGlowButton;
    AdvGlowButton48: TAdvGlowButton;
    AdvToolBar11: TAdvToolBar;
    AdvGlowButton49: TAdvGlowButton;
    AdvGlowButton50: TAdvGlowButton;
    AdvGlowButton51: TAdvGlowButton;
    AdvOfficeHint1: TAdvOfficeHint;
    AdvMenuOfficeStyler1: TAdvMenuOfficeStyler;
    GlowBtn: TAdvGlowButton;
    Panel1: TPanel;
    Label3: TLabel;
    Label1: TLabel;
    Label4: TLabel;
    Label2: TLabel;
    Edit1: TEdit;
    Label5: TLabel;
    Office2007Silver1: TMenuItem;
    AdvShapeButton2: TAdvShapeButton;
    AdvPreviewMenu1: TAdvPreviewMenu;
    AdvPreviewMenuOfficeStyler1: TAdvPreviewMenuOfficeStyler;
    ImageList2: TImageList;
    ImageList3: TImageList;
    Label6: TLabel;
    Label7: TLabel;
    procedure AdvToolBar2OptionClick(Sender: TObject; ClientPoint,
      ScreenPoint: TPoint);
    procedure file1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure AdvGlowButton24Click(Sender: TObject);
    procedure GlowBtnClick(Sender: TObject);
    procedure CreateParams(var Params: TCreateParams); override;
    procedure AdvPreviewMenu1ButtonClick(Sender: TObject; ButtonIndex: Integer);
    procedure Label7Click(Sender: TObject);
  private
    { Private declarations }
    procedure WMGetMinMaxInfo(var Msg: TMessage); message WM_GETMINMAXINFO;
  public
    { Public declarations }
  end;

var
  s: Ts;

implementation

{$R *.dfm}

procedure TS.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  Params.Style := Params.Style and not WS_CAPTION or WS_POPUP;
end;

procedure Ts.WMGetMinMaxInfo(var Msg: TMessage);
var
  info: ^TMinMaxInfo;
  rc: TRect;
begin
  SystemParametersInfo(SPI_GETWORKAREA, 0, @rc, 0);
  info := pointer(Msg.LParam);
  info^.ptMaxPosition.X := rc.Left;
  info^.ptMaxPosition.Y := rc.Top;
  info^.ptMaxSize.x := GetSystemMetrics(SM_CXMAXIMIZED);
  info^.ptMaxSize.y := GetSystemMetrics(SM_CYMAXIMIZED);
end;



procedure Ts.FormCreate(Sender: TObject);
begin
  // force style to Luna at startup whatever setting applied at design time
  AdvToolBarOfficeStyler1.Style := bsOffice2007Obsidian;
  AdvToolBarOfficeStyler1.Style := bsOffice2007Luna;
  AdvPreviewMenuOfficeStyler1.Style := psOffice2007Luna;  
  AdvToolBar6.CompactPicture.Assign(AdvGlowButton10.Picture);
end;

procedure Ts.GlowBtnClick(Sender: TObject);
begin
  if GlowBtn.Caption = 'Glow off' then
  begin
    AdvToolBarPager1.SetGlowSpeed(1);
    GlowBtn.Caption := 'Glow on';
  end
  else
  begin
    AdvToolBarPager1.SetGlowSpeed(50);
    GlowBtn.Caption := 'Glow off';
  end;
end;

procedure Ts.Label7Click(Sender: TObject);
begin
  ShellExecute(0,'open',pchar(label7.Caption),nil,nil, SW_NORMAL);
end;


procedure Ts.AdvGlowButton24Click(Sender: TObject);
begin
  ShowMessage('Search GoTo function');
end;

procedure Ts.AdvPreviewMenu1ButtonClick(Sender: TObject; ButtonIndex: Integer);
begin
  case ButtonIndex of
  0: Close;
  1: begin
       AdvPreviewMenu1.HideMenu;
       ShowMessage('Handle options here');
     end;
  end;
end;

procedure Ts.AdvToolBar2OptionClick(Sender: TObject; ClientPoint,
  ScreenPoint: TPoint);
begin
  ShowMessage('Toolbar options can be made available here');
end;

procedure Ts.file1Click(Sender: TObject);
begin
  case (Sender as TMenuItem).Tag of
  0:begin
      AdvGlowMenuButton1.Caption := 'Office 2007 Luna';
      AdvToolBarOfficeStyler1.Style := bsOffice2007Luna;
      AdvMenuOfficeStyler1.Style := osOffice2007Luna;
      AdvPreviewMenuOfficeStyler1.Style := psOffice2007Luna;
    end;
  1:begin
      AdvGlowMenuButton1.Caption := 'Office 2007 Obsidian';
      AdvToolBarOfficeStyler1.Style := bsOffice2007Obsidian;
      AdvMenuOfficeStyler1.Style := osOffice2007Obsidian;
      AdvPreviewMenuOfficeStyler1.Style := psOffice2007Obsidian;
    end;
  2:begin
      AdvGlowMenuButton1.Caption := 'Office 2003 Blue';
      AdvToolBarOfficeStyler1.Style := bsOffice2003Blue;
      AdvMenuOfficeStyler1.Style := osOffice2003Blue;
      AdvPreviewMenuOfficeStyler1.Style := psOffice2003Blue;
    end;
  3:begin
      AdvGlowMenuButton1.Caption := 'Office 2003 Olive';
      AdvToolBarOfficeStyler1.Style := bsOffice2003Olive;
      AdvMenuOfficeStyler1.Style := osOffice2003Olive;
      AdvPreviewMenuOfficeStyler1.Style := psOffice2003Olive;
    end;
  4:begin
      AdvGlowMenuButton1.Caption := 'Office 2003 Silver';
      AdvToolBarOfficeStyler1.Style := bsOffice2003Silver;
      AdvMenuOfficeStyler1.Style := osOffice2003Silver;
      AdvPreviewMenuOfficeStyler1.Style := psOffice2003Silver;
    end;
  5:begin
      AdvGlowMenuButton1.Caption := 'Office XP';
      AdvToolBarOfficeStyler1.Style := bsWindowsXP;
      AdvMenuOfficeStyler1.Style := osOfficeXP;
      AdvPreviewMenuOfficeStyler1.Style := psOfficeXP;
    end;
  6:begin
      AdvGlowMenuButton1.Caption := 'Office 2007 Silver';
      AdvToolBarOfficeStyler1.Style := bsOffice2007Silver;
      AdvMenuOfficeStyler1.Style := osOffice2007Silver;
      AdvPreviewMenuOfficeStyler1.Style := psOffice2007Silver;
    end;
  end;
end;

end.

⌨️ 快捷键说明

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