OutLook风格的实现？

Question

大把的outlook控件
1stclass lmt

Answer 1

纯属兴趣，写了个不可视的类，很多bug懒得改了
/////////////////////////
{*
 CopyRight(C)2002-8-1 Stanely.
*}
unit OutLookBar_San;interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Buttons, StdCtrls, ImgList;
const
SM_OLBPT_CLICK=wm_user+200;
SM_OLBPI_ClICK=wm_user+201;
type
  TOLBItem=class;
  TOLBPanel=class;
  TOutLookBar_San=class;
  TScrollPanel=class;
////////////////////////////////////////  TScrollPanel=class(TScrollBox)
  private
  protected
  public
  end;////////////////////////////////////////
  TOLBItem=class(Tpanel)
  private
  protected
    procedure SBtnClick(sender:tobject);
  public
    Button:TSpeedbutton;
    ////////////    ///////////////
    procedure SetImage(BMP: TBitMap);overload;
    procedure SetImage(Index:integer;ImageList:TImagelist=nil);overload;
    procedure SetItemSize(NewHeight:integer);
    procedure SetButtonPos(Left,Top:integer;ChangeSize:boolean=true);
    constructor Create(AOwner: TScrollPanel;ACaption:string='';ItemHeight:integer=50;BtnHeight:integer=48;btnwidth:integer=48);overload;
    destructor Destroy;override;  end;
/////////////////////////////////////////  TOLBPanel=class(TPanel)
  private
  protected
   // Expanded:boolean;    /////////
    procedure TitlePanelResize(Sender:Tobject);
    procedure scrollpanelmousewheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
    procedure ScrollPanelResize(Sender:TObject);
    procedure TitleClick(Sender:TObject);
    procedure TitleMDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
    procedure TitleMUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);  public
    TitlePanel:TPanel;
    ScrollPanel:TScrollPanel;
    Items:TList;
    TitleImage:TImage;
    ButtonHeight,ButtonWidth,ItemHeight :integer;
    ///////////////
    procedure SetImage(BMP: TBitMap);overload;
    procedure SetImage(Index:integer;ImageList:TImagelist=nil);overload;    procedure Expand;
    procedure SetButtonPos(Left,Top:integer;ChangeSize:boolean=true);
    procedure SetItemSize(NewHeight:integer);
    function IndexOfItem(AHandle:THandle):integer;
    function AddItem(ACaption:string=''):TOLBItem;
    function InsertItem(Index:integer;ACaption:string=''):TOLBItem;
    procedure DeleteItem(Index:integer);
    procedure Clear;
    ///////////////    Constructor Create(AOwner: TOutLookBar_San;ACaption:string='';TitHeight:integer=21;BtnHeight:integer=64;BtnWidth:integer=64;Itmheight:integer=72);
    Destructor Destroy;override;  end;/////////////////////////////////////////  TOutLookBar_San=class(Tpanel)
  private  protected
    PItemIndex:integer;
    ////////////////////
    procedure BarResize(Sender:TObject);
    procedure ItemButtonClick(var msg:tmessage);message SM_OLBPI_CLICK;
    procedure PanelTitleClick(var msg:tmessage);message SM_OLBPT_CLICK;
  public
    items:TList;
    ImageList,TitleImageList:TImageList;
    ButtonAutoSize:boolean;
   { TitleImageList,ButtonImageList:Timagelist;    ButtonHeight:integer;
    ButtonWidth:integer;}
    TitleHeight:integer;
    ///////////////////
    procedure ShowPanel(AOLBPanel:TOLBPanel);overload;virtual;
    procedure ShowPanel(index:integer);overload;virtual;
    procedure SetButtonPos(Left,Top:integer);
    procedure SetItemSize(NewHeight:integer);
    procedure SetTitleSize(NewHeight:integer);
    ///////////////
    function IndexOfItem(AHandle:Thandle):integer;
    procedure ButtonClick(Sender:TObject);virtual;
    ///////////////
    function ItemIndex:integer;
    function AddItem(ACaption:string=''):TOLBPanel;
    function InsertItem(Index:integer;ACaption:string=''):TOLBPanel;
    procedure Clear;
    procedure DeleteItem(Index:integer);
    ///////////////
    Constructor Create(AOwner:TComponent);override;
    destructor Destroy;override;  end;
implementation{ TOutLookBar_San }function TOutLookBar_San.AddItem(ACaption:string=''): TOLBPanel;
var
i:integer;
pl:tolbpanel;
begin
  pl:=tolbpanel.Create(self,acaption,self.TitleHeight);
  if items.Count>0 then
  begin
    for i:=0 to items.Count-1 do
    begin
      if tolbpanel(items.Items[i]).Align=alclient then continue;
      tolbpanel(items.Items[i]).Align:=alnone;
    end; 
    pl.Align:=albottom;
    for i:=items.Count-1 downto 0 do
    begin
      if tolbpanel(items.Items[i]).Align=alclient then continue;
      tolbpanel(items.Items[i]).Align:=albottom;
    end;
  end
  else
  begin
    pl.Align:=alclient;
    pitemindex:=0;
  end;  
  items.Add(pl);  result:=pl;
end;procedure TOutLookBar_San.BarResize(Sender: TObject);
var
i:integer;
begin
  //pitemindex
end;procedure TOutLookBar_San.ButtonClick(Sender: TObject);
begin
  //showmessage(tspeedbutton(sender).Caption);
end;

Answer 2

procedure TOutLookBar_San.Clear;
var
i:integer;
begin
  for i:=0 to items.Count-1 do
  begin
    tolbpanel(items.Items[i]).Free;
  end;
  items.Clear;
end;constructor TOutLookBar_San.Create(AOwner:TComponent);
begin
  inherited create(aowner);
  //imagelist:=timagelist.Create(self);
  //width:=150;
  Parent:=twincontrol(aowner);
  Caption:='';
  BevelInner:=bvlowered;
  BevelOuter:=bvnone;
  self.Align:=alleft;
  self.OnResize:=barresize;
  ///////////////////
  items:=tlist.Create;
  titleheight:=20;
 { buttonheight:=32;
  buttonwidth:=32; }
  pitemindex:=-1;
  buttonautosize:=true;
  width:=96;
end;procedure TOutLookBar_San.DeleteItem(Index: integer);
begin    tolbpanel(items.Items[index]).Free;
    items.Delete(index);end;destructor TOutLookBar_San.Destroy;
var
i:integer;
begin
  for i:=0 to items.Count-1 do
  begin
    tolbpanel(items.Items[i]).free;
  end;  items.Free;
  //imagelist.Free;
  inherited;
end;
function TOutLookBar_San.IndexOfItem(AHandle:THandle): integer;
var
i:integer;
begin
result:=-1;
  for i:=0 to items.Count-1 do
  begin
    if tolbpanel(items.Items[i]).Handle=ahandle then
    begin
      result:=i;
      exit;
    end;
  end;
end;function TOutLookBar_San.InsertItem(Index: integer;
  ACaption: string): TOLBPanel;
var
i:integer;
pl:tolbpanel;
begin
  result:=nil;
 { if (index<0)or(index>items.Count-1)or(items.Count<=0) then
  begin
    result:=additem(acaption);
    exit;
  end;
  /////////////////
  for i:=index to items.Count-1 do
  begin
    if tolbpanel(items.Items[i]).Align=alclient then continue;
    tolbpanel(items.Items[i]).Align:=alnone;
  end;
  for i:=items.Count-1 downto index do
  begin
    if tolbpanel(items.Items[i]).Align=alclient then continue;
    tolbpanel(items.Items[i]).Align:=albottom;
  end;
  pl:=tolbpanel.Create(self,acaption,titleheight);
  pl.Align:=albottom;  
  items.Insert(index,pl);  
  result:=pl;  }
end;procedure TOutLookBar_San.ItemButtonClick(var msg: tmessage);
var
i,j:integer;
begin  i:=indexofitem(msg.WParam);
  if i<0 then exit;  j:=tolbpanel(items.Items[i]).IndexOfItem(msg.LParam);
  if j<0 then exit;
  
  buttonclick(tolbitem(tolbpanel(items.Items[i]).Items.Items[j]).Button);
  
end;function TOutLookBar_San.ItemIndex: integer;
begin
  result:=pitemindex;
end;procedure TOutLookBar_San.PanelTitleClick(var msg: tmessage);begin
  showpanel(indexofitem(msg.WParam));  //showmessage(inttostr(indexofitem(msg.WParam)))
end;procedure TOutLookBar_San.SetButtonPos(Left, Top: integer);
var
i:integer;
begin
  for i:=0 to items.Count-1 do
  begin
    tolbpanel(items.Items[i]).SetButtonPos(left,top,self.ButtonAutoSize);
  end;
end;procedure TOutLookBar_San.SetItemSize(NewHeight: integer);
var
i:integer;
begin
  for i:=0 to items.Count-1 do
  begin
    tolbpanel(items.Items[i]).SetItemSize(newheight);
  end;
end;procedure TOutLookBar_San.SetTitleSize(NewHeight: integer);
var
i:integer;
begin
  titleheight:=newheight;
  for i:=0 to items.Count-1 do
  begin
    tolbpanel(items.Items[i]).TitlePanel.Height:=newheight;
    tolbpanel(items.Items[i]).Height:=newheight;
    tolbpanel(items.Items[i]).ScrollPanel.top:=newheight;
  end;
end;procedure TOutLookBar_San.ShowPanel(index: integer);
var
i:integer;
begin
  if (items.Count<=0)or(index<0)or(index>items.Count-1) then exit;
  pitemindex:=index;
  if items.Count=1 then
  begin
    tolbpanel(items.Items[0]).align:=alclient;    //tolbpanel(items.Items[0]).expanded:=true;
    exit;
  end;
  /////////////////  for i:=0 to index-1 do
  begin
   // tolbpanel(items.Items[i]).Visible:=false;
    tolbpanel(items.Items[i]).Align:=altop;
    tolbpanel(items.Items[i]).Height:=self.TitleHeight;   // tolbpanel(items.Items[i]).Expanded:=false;
  end;
  tolbpanel(items.Items[index]).Align:=alclient;
  //tolbpanel(items.Items[index]).Expanded:=true;  
  for i:=items.Count-1 downto index+1 do
  begin
    tolbpanel(items.Items[i]).Align:=albottom;
    tolbpanel(items.Items[i]).Height:=self.TitleHeight;
   // tolbpanel(items.Items[i]).Visible:=true;
  //  tolbpanel(items.Items[i]).Expanded:=false;
  end;end;procedure TOutLookBar_San.ShowPanel(AOLBPanel: TOLBPanel);
begin
  showpanel(indexofitem(aolbpanel.Handle));
end;{ TOLBPanel }procedure TOLBPanel.TitleClick(Sender: TObject);
begin  if self.Align<>alclient then
   postmessage(parent.Handle,SM_OLBPT_CLICK,self.Handle,0);
end;constructor TOLBPanel.Create(AOwner: TOutlookbar_san;ACaption:string='';TitHeight:integer=21;BtnHeight:integer=64;BtnWidth:integer=64;Itmheight:integer=72);
begin
  inherited create(aowner);
  Items:=tlist.Create;  self.ButtonHeight:=btnheight;
  buttonwidth:=btnwidth;
  itemheight:=itmheight;
  ////////////////////////
  //self.Align:=albottom;
  self.Caption:='';
  bevelinner:=bvnone;
  bevelouter:=bvnone;
  self.Height:=titheight;
  self.Parent:=aowner;
  ////////////////////////
  TitlePanel:=tpanel.Create(self);
  titlepanel.caption:=acaption;
  titlepanel.BevelInner:=bvnone;
  titlepanel.BevelOuter:=bvraised;
  titlepanel.Align:=altop;
  titlepanel.Height:=titheight;
  titlepanel.Parent:=self;
  titlepanel.OnClick:=titleclick;
  titlepanel.OnMouseDown:=self.TitleMDown;
  titlepanel.OnMouseUp:=self.TitleMUp;
  titlepanel.OnResize:=titlepanelresize;
  titlepanel.Hint:=titlepanel.Caption;
  ///////////////////
  titleimage:=timage.Create(self);
  titleimage.Parent:=titlepanel;
  titleimage.Width:=titlepanel.Height;
  titleimage.height:=titlepanel.Height;
  titleimage.Left:=0;
  titleimage.Top:=0;
  titleimage.AutoSize:=false;
  titleimage.Center:=true;
  titleimage.Transparent:=true;
  titleimage.OnClick:=titlepanel.OnClick;
  titleimage.OnMouseDown:=titlepanel.OnMouseDown;
  titleimage.OnMouseUp:=titlepanel.OnMouseUp;
  titleimage.Hint:=titlepanel.Hint;
  ////////////////////
  scrollpanel:=tscrollpanel.Create(self);
  scrollpanel.Align:=alnone;
  scrollpanel.Top:=titlepanel.Height;
  scrollpanel.Align:=alclient;
  scrollpanel.BorderStyle:=bsnone;
  scrollpanel.OnResize:=scrollpanelresize;
  scrollpanel.VertScrollBar.Style:=sshottrack;
  scrollpanel.HorzScrollBar.Style:=ssHotTrack;
  scrollpanel.OnMouseWheel:=scrollpanelmousewheel;
  self.OnMouseWheel:=scrollpanel.OnMouseWheel;
  //self.titlepanel.OnMouseWheel:=scrollpanelmousewheel;
//  scrollpanel.BevelInner:=bvnone;
//  scrollpanel.BevelOuter:=bvnone;
  scrollpanel.Parent:=self;
  //////////
end;

Answer 3

destructor TOLBPanel.Destroy;
var
i:integer;
begin
  for i:=0 to items.Count-1 do
  begin
    tolbitem(items.Items[i]).free;
  end;
  items.Free;
  scrollpanel.Free;
  titlepanel.free;
  inherited;
end;procedure TOLBPanel.TitleMDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if button=mbright then exit;
  titlepanel.BevelInner:=bvlowered;
  titlepanel.BevelOuter:=bvnone;
end;procedure TOLBPanel.TitleMUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if button=mbright then exit;
  titlepanel.BevelInner:=bvnone;
  titlepanel.BevelOuter:=bvraised;
end;function TOLBPanel.AddItem(ACaption:string=''): TOLBItem;
var
item:tolbitem;
i:integer;
begin
  result:=nil;
  for i:=0 to items.Count-1 do
  begin
    tolbitem(items.Items[i]).Align:=alnone;
  end;
  item:=tolbitem.Create(self.ScrollPanel,acaption,ItemHeight,buttonheight,buttonwidth);
  //item.Align:=altop;
  items.Add(item);
  item.OnMouseWheel:=onmousewheel;
  result:=item;
  for i:=items.Count-1 downto 0 do
  begin
    tolbitem(items.Items[i]).Align:=altop;
  end;
end;function TOLBPanel.InsertItem(Index: integer;ACaption:string=''): TOLBItem;
var
i:integer;
item:tolbitem;
begin
  result:=nil;
 { if index<0 then exit;
  if items.Count<=0 then
  begin
    additem(acaption);
    exit;
  end;
  if index>items.Count-1 then
  begin
    result:=additem(Acaption);
    exit;
  end;
//////////////////
  item:=tolbitem.Create(self.ScrollPanel,acaption,ItemHeight,buttonheight,buttonwidth);
  for i:=index to items.Count-1 do
  begin
    tolbitem(items.Items[i]).Align:=alnone;
  end;
  //item.Align:=altop;
  items.Insert(index,item);
  for i:=index to items.Count-1 do
  begin
    tolbitem(items.Items[i]).Align:=altop;
  end; }
end;procedure TOLBPanel.Clear;
begin
  while items.Count>0 do
    deleteitem(0);
end;procedure TOLBPanel.DeleteItem(Index: integer);
begin
  tolbitem(items.Items[index]).Free;
  items.Delete(index);
end;
function TOLBPanel.IndexOfItem(AHandle: THandle): integer;
var
i:integer;
begin
result:=-1;
for i:=0 to items.Count-1 do
begin
  if tolbitem(items.Items[i]).Handle=ahandle then
  begin
     result:=i;
     exit;
  end;
end;
end;procedure TOLBPanel.Expand;
begin
  self.TitleClick(titlepanel);
end;procedure TOLBPanel.ScrollPanelResize(Sender: TObject);
var
i:integer;
begin
  setbuttonpos(-1,-1);
end;procedure TOLBPanel.SetButtonPos(Left, Top: integer;ChangeSize:boolean=true);
var
i:integer;
begin
  for i:=0 to items.Count-1 do
  begin
    tolbitem(items.Items[i]).SetButtonPos(left,top,changesize);
  end;
end;procedure TOLBPanel.SetItemSize(NewHeight: integer);
var
i:integer;
begin
  for i:=0 to items.Count-1 do
  begin
    tolbitem(items.Items[i]).SetItemSize(newheight);
  end;
end;procedure TOLBPanel.scrollpanelmousewheel(Sender: TObject;
  Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint;
  var Handled: Boolean);
beginend;procedure TOLBPanel.SetImage(BMP: TBitMap);
begin
  if bmp=nil then exit;
  titleimage.Picture.Bitmap:=bmp;
end;procedure TOLBPanel.SetImage(Index: integer; ImageList: TImagelist);
var
bmp:tbitmap;
begin
bmp:=tbitmap.Create;try
  if imagelist=nil then
    imagelist:=toutlookbar_san(parent).titleImageList;  if imagelist=nil then exit;  if imagelist.GetBitmap(index,bmp) then
     titleimage.Picture.Bitmap:=bmp;
finally
bmp.Free;
end;
end;procedure TOLBPanel.TitlePanelResize(Sender: Tobject);
begin
  titleimage.Height:=titlepanel.Height;end;{ TOLBItem }constructor TOLBItem.Create(AOwner: TScrollPanel;ACaption:string='';ItemHeight:integer=50;BtnHeight:integer=48;btnwidth:integer=48);
begin
  inherited create(aowner);
 // Align:=altop;
  Height:=itemheight;
  bevelinner:=bvnone;
  bevelouter:=bvnone;
  Parent:=aowner;
  /////////////////
  button:=tspeedbutton.Create(self);
  button.Height:=btnheight;
  button.Width:=btnheight;
  button.Left:=(self.ClientWidth-button.Width) div 2;
  button.top:=(self.Clientheight-button.height) div 2;
  button.Flat:=true;
  button.Layout:=blGlyphTop;
  button.Caption:=acaption;
  button.Parent:=self;
  button.Hint:=button.Caption;
  button.OnClick:=self.SBtnClick;
 // setbuttonpos(5,5);
end;destructor TOLBItem.Destroy;
begin
  button.Free;
  inherited;
end;procedure TOLBItem.SBtnClick(sender: tobject);
begin                
  postmessage(parent.Parent.parent.Handle,SM_OLBPI_ClICK,parent.parent.Handle,Handle);
end;
procedure TOLBItem.SetButtonPos(Left, Top: integer;ChangeSize:boolean=true);
beginif left<0 then left:=button.Left;
if top<0 then top:=button.top;
/////////////////////////////
if changesize then
begin
  button.Left:=left;
  button.top:=top;
  button.Width:=-2*left+clientwidth;
  button.Height:=-2*top+clientheight;
end
else
begin
  //showmessage('');
  button.Left:=(clientwidth-button.Width)div 2;
  button.top:=(clientheight-button.height)div 2;
end;
end;procedure TOLBItem.SetImage(BMP: TBitMap);
begin
if bmp=nil then exit;
  button.Glyph:=bmp;
  
end;procedure TOLBItem.SetImage(Index: integer;ImageList:TImagelist);
var
bmp:tbitmap;
begin
bmp:=tbitmap.Create;
try
if imagelist=nil then
  imagelist:=toutlookbar_san(self.parent.parent.parent).imagelist;
if imagelist=nil then exit;  if imagelist.GetBitmap(index,bmp) then
    button.Glyph:=bmp;finally
bmp.Free;
end;
end;procedure TOLBItem.SetItemSize(NewHeight: integer);
begin
  self.Height:=newheight;
  setbuttonpos(button.Left,button.Top);
end;end.
////////////////////////////////写的很潦草，还往高手指教！

Answer 4

to :zmfromsz(过客) 
thanks [email protected]

Answer 5

to :zmfromsz(过客) 
我也想要？！ 能给我一份吗？谢了！

Answer 6

[email protected]给我也发一份，谢谢！

Answer 7

[email protected] 
我也要!

Answer 8

麻烦给我发一份：
[email protected]