请教各位大侠，Delphi怎样做成Outlook试的界面？？最后详细！！！！(100分)

请教各位大侠，Delphi怎样做成Outlook试的界面？？最后详细！！！！

用vcl控件，如ABC。自己写要时间和功力。

可以使用1stclass得控件。

是分割窗体,email?我发个例子给你！

给我一个我给你一个控件吧

用dx系列酷比.

1stcalss控件 全套DEMO

给我发个例子好吗？ ysg@Uplife-it.com，可以的话我把100分给他（她）！！！

哪里可以下载到 1stcalss控件？

To chshanghai，给我发一个控件好吗？？我把分给你~！ ysg@uplife-it.com

1stcalss ip3000 d5,d6我都有，我可是真金白银注册过的，好用。

下面是一个OutLook式样的分类按钮控件的代码，Component-->Install Component安装控件

unit Outlook;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Buttons,ExtCtrls,FlatImage,StdCtrls,Spin,CommCtrl,Consts,DsgnIntf,
OLITemsProp;

type
TCntButton = TSpeedButton;
TEventProc= Procedure (Sender: TObject; Item: string) of Object;

TOutlook = class;
TOutlookItems = class (TPersistent)
private
FHeaders : TStringList;
FItems : TList;
FImages : TList;
AllImages : TImageList;
Owner: TOutlook;
function GetImage(HeaderIndex, ItemIndex: integer): TPicture;
function GetItem(HeaderIndex, ItemIndex: integer): String;
procedure SetImage(HeaderIndex, ItemIndex: integer;
const Value: TPicture);
procedure SetItem(HeaderIndex, ItemIndex: integer;
const Value: String);
function GetHeader(HeaderIndex: integer): string;
procedure SetHeader(HeaderIndex: integer; const Value: string);
function GetCounts(idx: integer): integer;
Procedure SaveToImageList(IList: TImageList);
Procedure LoadFromImageList(IList: TImageList);
Procedure DefineProperties(Filer:TFiler);override;
Procedure WriteHeaders(Writer:TWriter);
Procedure ReadHeaders(Reader:TReader);
Procedure WriteItems(Writer:TWriter);
Procedure ReadItems(Reader:TReader);
Procedure ReadImages(Stream: TStream);
Procedure WriteImages(Stream:TStream);
public
Constructor Create(AOwner: TOutlook);
Destructor Destroy;
Procedure AssignContent(value : TOutlookItems);
Procedure DeleteHeader(HeaderIndex: integer);
Procedure DeleteItem(HeaderIndex,ItemIndex: integer);
Procedure ExchangeHeader(idx1,idx2: integer);
Procedure ExchangeItem(HeaderIdx,idx1,idx2: integer);
Property Headers[HeaderIndex: integer]:string read GetHeader write SetHeader;
Property Items[HeaderIndex,ItemIndex:integer]: String read GetItem write SetItem;
Property Images[HeaderIndex,ItemIndex:integer]: TPicture read GetImage write SetImage;
Property Counts[idx: integer]: integer read GetCounts;
end;

TOutlook = class(TScrollBox)
private
FItems : TOutlookItems;
FItemCab : TScrollBox;
CNTButs : TList;
Panels : TList;
TempImages: TList;
TempLabels: TList;
FActiveTab: integer;
SpinButton : TSpinButton;
ScrollPanel: TPanel;
FOnTabChange : TEventProc;
FOnItemClick : TEventProc;
procedure setActiveTab(const Value: integer);
procedure WhenClick(Sender: TObject);
Procedure ScrollDown(Sender: TObject);
Procedure ScrollUp(Sender: TObject);
function GetItems: TOutlookItems;
procedure SetItems(const Value: TOutlookItems);
procedure WMSize(var Message: TWMSize); message WM_SIZE;
{ Private declarations }
protected
{ Protected declarations }

public
{ Public declarations }
Procedure RefreshDisplay;
Procedure RefreshItems;
published
{ Published declarations }
Constructor Create(AOwner : TComponent);override;
Property Items: TOutlookItems read GetItems write SetItems;
Property ActiveTab: integer read FActiveTab write setActiveTab;
Property OnTabChange:TEventProc read FOnTabChange write FOnTabChange;
Property OnItemClick:TEventProc read FOnItemClick write FOnItemClick;
end;

procedure Register;

implementation

var startitem: integer;
itemcount : integer;
visibles : integer;

procedure Register;
begin
RegisterComponents('Samples', [TOutlook]);
RegisterPropertyEditor (TypeInfo(TOutlookItems),
TOutlook, 'Items', TOLITemsProperty);

end;

{ TOutlook }

constructor TOutlook.Create(AOwner: TComponent);
var BotPanel: TPanel;
begin
inherited create(AOwner);
Align := alLeft;
Width := 110;
CNTButs := TList.create;
PAnels := TList.create;
TempImages := TList.create;
TempLabels := TList.create;
Color := clGray;
FActiveTAb := 0;
StartItem := 1;
FItemCab := TScrollBox.Create(self);
FItemcab.parent := self;
FItemCab.BorderStyle := bsNone;
FItemCab.align := alClient;
HorzScrollBar.Visible := false;
VertScrollBar.Visible := false;
FItemCab.HorzScrollBar.Visible := false;
FItemCab.VertScrollBar.Visible := false;
ScrollPanel := TPanel.create(self);
ScrollPanel.align := alRight;
ScrollPanel.Width := 14;
ScrollPanel.bevelInner := bvNone;
ScrollPanel.bevelOuter := bvNone;
ScrollPanel.color := FitemCab.Color;
BotPanel := TPanel.Create(self);
BotPanel.Parent := ScrollPanel;
BotPanel.Align := alBottom;
BotPanel.Height := 45;
BotPanel.BevelInner := bvNone;
BotPanel.BevelOuter := bvNone;
BotPanel.color := FitemCab.Color;
SpinButton := TSpinButton.create(self);
SpinButton.align := alClient;
SpinButton.Parent := BotPanel;
SpinButton.OnDownClick := ScrollDown;
SpinButton.OnupClick := ScrollUp;

FItems := TOutlookItems.Create(self);;

end;


function TOutlook.GetItems: TOutlookItems;
begin
Result := FItems;
end;

procedure TOutlook.RefreshDisplay;
var a,b: integer;
CNTButton : TCNtButton;
Panel : TPanel;
Image : TFlatImage;
Labelx: TLabel;
begin

try
For a := 0 to CNTButs.Count -1 do
begin
TCNtButton(CNTButs[a]).Free;
End;
For a := 0 to Panels.Count -1 do
begin
TPanel(Panels[a]).Free;
End;
except
end;

TempImages.Clear;
TempLabels.Clear;
Panels.Clear;
CNTButs.Clear;

For a := 1 to Items.Counts[0] do
begin
CntButton := TCNtButton.create(self);
CntButton.parent := self;
CntButton.Font.Name := 'Tahoma';
CntButton.Caption := Items.Headers[a];
CNtButton.Align := alBottom;
CNTButton.Visible := true;
CNTButton.Tag := a;
CNTButton.Height := 22;
CNTButton.OnClick := WhenClick;
CNTButs.add(CNTButton);
For b := 1 to Items.Counts[a] do
begin
Panel := TPanel.Create(self);
Panel.Tag := a;
Panel.Height := 60;
Panel.Width := FItemCab.width;
Panel.Left := 0;
Panel.Color := ClGray;
Panel.BevelOuter := bvNone;
Panel.BevelInner := bvNone;
Panels.add(Panel);

Image := TFlatImage.Create(self);
Image.Parent := panel;
Image.SetBounds((width-40) div 2,5,40,40);
Image.StrValue := Items.Items[a,b];
Image.OnClick := WhenClick;
Image.Picture := Items.Images[a,b];
TempImages.Add(Image);

Labelx := TLabel.create(self);
Labelx.Parent := Panel;
Labelx.Top := 45;
Labelx.Font.Name := 'Tahoma';
Labelx.Font.Color := clWhite;
LabelX.Caption := Items.Items[a,b];
Labelx.Left := (width - labelx.width) div 2;
TempLabels.Add(LabelX);
end;
end;
// FActiveTab := 0;
// startitem := 1;
RefreshItems;
end;

procedure TOutlook.RefreshItems;
var a,ItemHeight: integer;
begin
If CNTButs.Count = 0 then exit;
If FActiveTab > Items.Counts[0] then FActiveTab := 0;
If FActiveTab = 0 then
begin
For a := 0 to CNTButs.count -1 do
begin
TCNTButton(CNTButs[a]).align := alBottom;
end;
exit;
end;
For a := 0 to FActiveTAb -1 do
begin
TCNTButton(CNTButs[a]).align := alTop;
end;
For a := 1 to CNTButs.count - FactiveTab do
begin
TCNTButton(CNTButs[CNTButs.count-a]).align := alBottom;
end;

itemcount := 0;
visibles := 0;

ItemHeight := Height - (CNTButs.count*TCNTButton(CNTButs[0]).Height);

For a := 0 to Panels.count -1 do
begin
if TPanel(Panels[a]).tag = FActiveTab then
begin
inc(itemcount);
if ((itemcount-startitem+1)*60 < ItemHeight) and
(itemcount >= startitem) then
begin
inc(visibles);
TPanel(Panels[a]).parent := FItemCab;
TPanel(Panels[a]).top := (visibles-1)*60;
end
else
TPanel(Panels[a]).parent := nil;
end
else
begin
TPanel(Panels[a]).parent := nil;
end;
end;
if (itemcount*60 > ItemHeight)
then
ScrollPanel.Parent := Self
else
ScrollPanel.parent := nil;
end;


procedure TOutlook.ScrollDown(Sender: TObject);
begin
If StartItem > 1 then
begin
StartItem := StartItem-1;
RefreshItems;
end;
end;

procedure TOutlook.ScrollUp(Sender: TObject);
begin
If StartItem <= (ItemCount-visibles) then
begin
StartItem := StartItem+1;
RefreshItems;
end;
end;

procedure TOutlook.setActiveTab(const Value: integer);
begin
if (value > CNTButs.count) then exit;
FActiveTab := Value;
StartItem := 1;
RefreshItems;
end;

procedure TOutlook.SetItems(const Value: TOutlookItems);
begin
FItems.AssignContent(Value);
end;

procedure TOutlook.WhenClick(Sender: TObject);
begin
If Sender is TCNTButton then
begin
ActiveTab := (Sender as TCNTButton).Tag;
if assigned(FOnTabChange) then FOnTabChange(Self,(Sender as TCNTButton).caption);
end
else if Sender is TFlatImage then
begin
if assigned(FOnItemClick) then FOnItemClick(Self,(Sender as TFlatImage).StrValue);
end;
end;

procedure TOutlook.WMSize(var Message: TWMSize);
var a: integer;
begin
For a := 0 to Panels.count -1 do
TPanel(Panels[a]).Width := FItemCab.width;
For a := 0 to TempImages.count -1 do
TImage(TempImages[a]).Left := (width-40) div 2;
For a := 0 to TempLabels.count -1 do
TLabel(TempLabels[a]).Left :=
(width - TLabel(TempLabels[a]).width) div 2;
RefreshItems;
end;

{ TOutlookItems }

constructor TOutlookItems.create(AOwner: TOutLook);
var a,b : integer;
begin
Inherited Create;
Owner := AOwner;
FHeaders := TStringList.Create;
FItems := TList.Create;
FImages:= TList.Create;
AllImages := TImageList.Create(nil);
AllImages.Height := 32;
AllImages.Width := 32;
end;

procedure TOutlookItems.DefineProperties(Filer: TFiler);
begin
Filer.DefineProperty('Headers',ReadHeaders,WriteHeaders,True);
Filer.DefineProperty('Contents',ReadItems,WriteItems,True);
Filer.DefineBinaryProperty('Images', ReadImages, WriteImages,True);
end;

destructor TOutlookItems.destroy;
var a,b : integer;
begin
FHeaders.Free;
FItems.Free;
FImages.Free;
AllImages.Free;
Inherited Destroy;
end;

function TOutlookItems.GetCounts(idx: integer): integer;
begin
result := 0;
if idx = 0 then
result := FHeaders.Count
else
begin
if Idx > FHeaders.Count then
result := 0
else
result := TstringList(FItems[idx-1]).count;
end;
end;

function TOutlookItems.GetHeader(HeaderIndex: integer): string;
begin
If (HeaderIndex > FHeaders.Count) or (HeaderIndex = 0) then
result := ''
else
result := FHeaders[HeaderIndex-1];
end;

function TOutlookItems.GetImage(HeaderIndex, ItemIndex: integer): TPicture;
var List : TList;
Pict : TPicture;
begin
If (HeaderIndex > FHeaders.Count) or (HeaderIndex = 0) then
begin
result := nil;
end
else
begin
List := TList(FImages[HeaderIndex-1]);
if (ItemIndex > List.Count) or (ItemIndex =0) then
result := nil
else
Result := TPicture(List[ItemIndex-1]);
end;
end;

function TOutlookItems.GetItem(HeaderIndex, ItemIndex: integer): String;
var List : TStringlIst;
begin
If (HeaderIndex > FHeaders.Count) or (HeaderIndex = 0) then
begin
result := '';
end
else
begin
List := TStringList(FItems[HeaderIndex-1]);
if (ItemIndex > List.Count) or (ItemIndex =0) then
result := ''
else
Result := List[ItemIndex-1];
end;

end;

procedure TOutlookItems.LoadFromImageList(IList: TImageList);
var a,b,x: integer;
Picture : TPicture;
begin
x := 0;
For a := 1 to Counts[0] do
begin
TList(FImages[a-1]).Clear;
For b:= 1 to Counts[a] do
begin
Picture := TPicture.Create;
IList.GetIcon(x,Picture.Icon);
TList(FImages[a-1]).Add(Picture);
inc(x);
end;
end;

end;

procedure TOutlookItems.AssignContent(value: TOutlookItems);
begin
FHeaders := Value.FHeaders;
FItems := Value.FItems;
FImages := Value.FImages;
end;

procedure TOutlookItems.ReadHeaders(Reader: TReader);
var a: integer;
begin
FHeaders.Text := Reader.ReadString;
For a := 0 to FHeaders.Count -1 do
begin
FItems.Add(TStringList.Create);
FImages.Add(TList.Create);
end;
end;

procedure TOutlookItems.ReadItems(Reader: TReader);
var TotalItems,list: TStringList;
a,x: integer;
begin
TotalItems := TstringList.Create;
TotalItems.Text := Reader.ReadString;
x := 0;
List := Nil;
For a := 0 to TotalItems.Count- 1 do
begin
if inttostr(x) = TotalItems[a] then
begin
List := TstringList(FItems[x]);
x := x+1;
end
else
begin
If List <> nil then List.Add(TotalItems[a]);
end;
end;
end;

procedure TOutlookItems.ReadImages(Stream: TStream);
var
SA: TStreamAdapter;
begin
SA := TStreamAdapter.Create(Stream);
try
AllImages.Handle := ImageList_Read(SA);
if AllImages.Handle = 0 then
raise EReadError.Create(SImageReadFail);
LoadFromImageList(AllImages);
finally
SA.Free;
end;
If owner <> nil then Owner.RefreshDisplay;
end;


procedure TOutlookItems.SaveToImageList(IList: TImageList);
Var
a,b: integer;
Picture: TPicture;
Begin
For a := 1 to Counts[0] do
begin
For b:= 1 to Counts[a] do
begin
Picture := Images[a,b];
IList.AddIcon(Picture.Icon)
end;
end;
end;

procedure TOutlookItems.SetHeader(HeaderIndex: integer;
const Value: string);
var a,dif : integer;
begin
If HeaderIndex = 0 then exit;
Dif := HeaderIndex-FHeaders.Count;
If (HeaderIndex > FHeaders.Count) then
begin
for a := 1 to dif do
begin
FHeaders.Add('');
FItems.Add(TStringList.Create());
FImages.Add(TList.Create());
end;
end;
FHeaders[HeaderIndex -1] := value;
end;

procedure TOutlookItems.SetImage(HeaderIndex, ItemIndex: integer;
const Value: TPicture);
var List : TlIst;
begin
If (HeaderIndex > FHeaders.Count) or (HeaderIndex = 0) then
exit
else
begin
List := TList(FImages[HeaderIndex-1]);
if (ItemIndex > List.Count) or (ItemIndex =0) then
exit
else
List[ItemIndex-1] := Value;
end;
end;

procedure TOutlookItems.SetItem(HeaderIndex, ItemIndex: integer;
const Value: String);
var List : TStringlIst;
a,dif : integer;
begin
If (HeaderIndex > FHeaders.Count) or (HeaderIndex = 0) then
begin
exit;
end
else
begin
List := TStringList(FItems[HeaderIndex-1]);
if ItemIndex = 0 then exit;
Dif := ItemIndex - List.Count;
if (ItemIndex > List.Count)then
begin
for a := 1 to dif do
begin
List.Add('');
TList(FImages[HeaderIndex-1]).Add(TPicture.Create);
end;
end;
List[ItemIndex-1] := Value;
end;
end;

procedure TOutlookItems.WriteHeaders(Writer: TWriter);
begin
Writer.WriteString(FHeaders.Text);
end;

procedure TOutlookItems.WriteImages(Stream: TStream);
var
SA: TStreamAdapter;
begin
SA := TStreamAdapter.Create(Stream);
AllImages.Clear;
SaveToImageList(AllImages);
try
if not ImageList_Write(AllImages.Handle, SA) then
raise EWriteError.Create(SImageWriteFail);
finally
SA.Free;
end;
end;

procedure TOutlookItems.WriteItems(Writer: TWriter);
var TotalItems,List: TstringList;
a,b : integer;
begin
TotalItems := TstringList.Create;
For a := 0 to FHeaders.Count -1 do
begin
TotalItems.Add(inttostr(a));
List := TStringList(FItems[a]);
For b := 0 to List.Count -1 do
TotalItems.Add(List);
end;
Writer.WriteString(TotalItems.Text);
TotalItems.Free;
end;


procedure TOutlookItems.DeleteHeader(HeaderIndex: integer);
begin
If (HeaderIndex > FHeaders.Count) or (HeaderIndex = 0) then exit;
FHeaders.Delete(HeaderIndex-1);
TStringList(FItems[HeaderIndex-1]).Destroy;
FItems.Delete(HeaderIndex-1);
TList(FImages[HeaderIndex-1]).Destroy;
FImages.Delete(HeaderIndex-1);
end;

procedure TOutlookItems.DeleteItem(HeaderIndex, ItemIndex: integer);
begin
If (HeaderIndex > FHeaders.Count) or (HeaderIndex = 0) then exit;
TStringList(FItems[HeaderIndex-1]).Delete(ItemIndex-1);
TList(FImages[HeaderIndex-1]).Delete(ItemIndex-1);
end;

procedure TOutlookItems.ExchangeHeader(idx1, idx2: integer);
begin
If (idx1 = 0) or (idx2 = 0) then exit;
if (idx1 > Fheaders.Count) or (idx2 > Fheaders.Count) then exit;
FHeaders.Exchange(idx1-1,idx2-1);
FItems.Exchange(idx1-1,idx2-1);
FImages.Exchange(idx1-1,idx2-1);
end;

procedure TOutlookItems.ExchangeItem(HeaderIdx, idx1, idx2: integer);
begin
if (HeaderIdx = 0) or (idx1=0) or (idx2=0) then exit;
if HeaderIdx > counts[0] then exit;
if (idx1 > Counts[HeaderIdx]) or
(idx2 > Counts[HeaderIdx]) then exit;
TstringList(FItems[HeaderIdx-1]).Exchange(idx1-1,idx2-1);
TList(FImages[HeaderIdx-1]).Exchange(idx1-1,idx2-1);
end;

end.

to shuizi2000
已发
注意查收

To:watter
上面的类单元在delphi5中无法编译
是不是delphi6中的
提示无flatimages,OLITemsProp

[8D]

楼上的兄弟，能给我发一份吗？谢谢
xieguozheng@163.com

To：星之瀚海:
在Uses里去掉这两个单元，我搞错了

有很多控可以选择如楼上各位所说之ABC、1stclass
但我觉得ABC太庞杂，1stclass安装时要什么注册码，
最麻烦的是ABC压缩后有28M，1stclass也有5M多。
还是MxOutLookBar最简单易用，安装完毕后
将一个*.dcu和一个*.res文件拷贝到Delphi
安装目录下的Lib文件夹中就ok，而且它只有
400k！有需要MxOutLookBar的朋友请发邮件到如下
地址：z_qb@msn.com。

to:cooler168
你真的很不像话

To: chshanghai，我收到了但是不能加图片呀！怎么在某一Page内加入Items呀？？？