outlook.pas

请使用Mobile FBUS——用来创建与NOKIA手机连接的软件的理想解决方案！功能包括：发送SMS

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;