home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / kolekce / d56 / RMCTL.ZIP / rmOutlook.pas < prev    next >
Pascal/Delphi Source File  |  2001-06-22  |  25KB  |  938 lines

  1. {================================================================================
  2. Copyright (C) 1997-2001 Mills Enterprise
  3.  
  4. Unit     : rmOutlook
  5. Purpose  : A simple implementation of the M$ Outlook style control
  6. Date     : 03-06-01
  7. Author   : Ryan J. Mills
  8. Version  : 1.80
  9. Notes    : This unit was originally based upon the work of Patrick O'Keeffe.
  10.            It was at his request that I took the component over and rm'ified it.
  11. ================================================================================}
  12.  
  13. unit rmOutlook;
  14.  
  15. interface
  16.  
  17. {$I CompilerDefines.INC}
  18.  
  19. uses Windows, Messages, Forms, Classes, Controls, Graphics, ImgList;
  20.  
  21. type
  22.   TrmOutlookControl = class;
  23.   TrmOutlookPage = class;
  24.  
  25.   TrmOutlookPageEvent = procedure(ASheet : TrmOutlookPage) of object;
  26.   TrmOutlookQueryPageEvent = procedure(ASheet : TrmOutlookPage; var CanClose : Boolean) of object;
  27.  
  28.   TrmDrawingStyle = (ds3D, dsFlat, dsNone);
  29.  
  30.   TrmOutlookPage = class(TCustomControl)
  31.   private
  32.     FOutlookControl : TrmOutlookControl;
  33.     FImageIndex : Integer;
  34.  
  35.     FAlignment: TAlignment;
  36.  
  37.     FCloseButtonDown : Boolean;
  38.     FCloseMouseOver : Boolean;
  39.     FCloseButton: Boolean;
  40.  
  41.     fMouseOverBtn: boolean;
  42.  
  43.     FOnQueryClosePage: TrmOutlookQueryPageEvent;
  44.     FOnDestroy : TrmOutlookPageEvent;
  45.  
  46.     procedure SetImageIndex(Value : Integer);
  47.     function GetPageIndex : Integer;
  48.  
  49.     procedure SetOutlookControl(AOutlookControl : TrmOutlookControl);
  50.     procedure SetPageIndex(Value : Integer);
  51.     procedure SetAlignment(const Value: TAlignment);
  52.  
  53.     procedure SetCloseButton(const Value: Boolean);
  54.  
  55.     procedure UpdatePage;
  56.     function BtnRect:TRect;
  57.     function CloseBtnRect:TRect;
  58.   protected
  59.     function GetClientRect: TRect; override;
  60.  
  61.     procedure CreateParams(var Params : TCreateParams); override;
  62.     procedure ReadState(Reader : TReader); override;
  63.  
  64.     procedure WMSize(var Message : TMessage); message WM_SIZE;
  65.     procedure WMMove(var Message: TWMMove); message WM_MOVE;
  66.     procedure WMErase(var Message : TMessage); message WM_ERASEBKGND;
  67.  
  68.     procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
  69.     procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
  70.  
  71.     procedure CMVisibleChanged(var Message: TMessage); message CM_VISIBLECHANGED;
  72.     procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
  73.     procedure CMColorChanged(var Message: TMessage); message CM_COLORCHANGED;
  74.     procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
  75.     procedure CMParentColorChanged(var Message: TMessage); message CM_PARENTCOLORCHANGED;
  76.     procedure CMParentFontChanged(var Message: TMessage); message CM_PARENTFONTCHANGED;
  77.  
  78.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  79.     procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  80.     procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
  81.   public
  82.     constructor Create(AOwner : TComponent); override;
  83.     destructor Destroy; override;
  84.  
  85.     procedure PaintButton;
  86.     procedure Paint; override;
  87.  
  88.     property OutlookControl : TrmOutlookControl read FOutlookControl write SetOutlookControl;
  89.   published
  90.     property Color default clAppWorkSpace;
  91.     property Caption;
  92.     property Font;
  93.     property Enabled;
  94.     property Hint;
  95.     property ParentShowHint;
  96.     property PopupMenu;
  97.     property ShowHint;
  98.     property Visible;
  99.     property ParentFont;
  100.     property ParentColor;
  101.  
  102.     property Alignment : TAlignment read FAlignment write SetAlignment default taCenter;
  103.     property CloseButton : Boolean read FCloseButton write SetCloseButton;
  104.     property ImageIndex : Integer read FImageIndex write SetImageIndex;
  105.     property PageIndex : Integer read GetPageIndex write SetPageIndex stored False;
  106.  
  107.     property OnEnter;
  108.     property OnExit;
  109.     property OnResize;
  110.     property OnDestroy : TrmOutlookPageEvent read FOnDestroy write FOnDestroy;
  111.     property OnQueryClosePage : TrmOutlookQueryPageEvent read FOnQueryClosePage write FOnQueryClosePage;
  112.   end;
  113.  
  114.   TrmOutlookControl = class(TCustomControl)
  115.   private
  116.     FPages : TList;
  117.     FImages : TCustomImageList;
  118.     FActivePage : TrmOutlookPage;
  119.     FImageChangeLink : TChangeLink;
  120.  
  121.     FButtonHeight : Integer;
  122.     fDrawingStyle: TrmDrawingStyle;
  123.  
  124.     FPageChanged : TNotifyEvent;
  125.  
  126.     procedure AdjustPages;
  127.  
  128.     function GetPage(Index : Integer) : TrmOutlookPage;
  129.     function GetPageCount : Integer;
  130.  
  131.     procedure InsertPage(Page : TrmOutlookPage);
  132.     procedure RemovePage(Page : TrmOutlookPage);
  133.     procedure SetActivePage(Page : TrmOutlookPage);
  134.  
  135.     procedure SetImages(Value : TCustomImageList);
  136.     procedure ImageListChange(Sender : TObject);
  137.  
  138.     procedure SetButtonHeight(value : integer);
  139.     procedure SetDrawingStyle(const Value: TrmDrawingStyle);
  140.  
  141.     procedure CMDialogKey(var Message : TCMDialogKey); message CM_DIALOGKEY;
  142.     procedure CMColorChanged(var Message: TMessage); message CM_COLORCHANGED;
  143.     procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
  144.   protected
  145.     procedure GetChildren(Proc : TGetChildProc; Root : TComponent); override;
  146.     procedure SetChildOrder(Child : TComponent; Order : Integer); override;
  147.     procedure ShowControl(AControl : TControl); override;
  148.  
  149.     procedure Loaded; override;
  150.  
  151.     procedure WMSize(var Message : TMessage); message WM_SIZE;
  152.     procedure WMMove(var Message: TWMMove); message WM_MOVE;
  153.     procedure WMErase(var Message : TMessage); message WM_ERASEBKGND;
  154.  
  155.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  156.  
  157.     function GetBorderWidth:integer;
  158.     function GetClientRect: TRect; override;
  159.   public
  160.     constructor Create(AOwner : TComponent); override;
  161.     destructor Destroy; override;
  162.  
  163.     procedure Paint; override;
  164.  
  165.     function FindNextPage(CurPage : TrmOutlookPage; GoForward : Boolean) : TrmOutlookPage;
  166.     procedure SelectNextPage(GoForward : Boolean);
  167.  
  168.     property PageCount : Integer read GetPageCount;
  169.     property Pages[Index : Integer] : TrmOutlookPage read GetPage;
  170.   published
  171.     property Align;
  172.     property Color default clAppWorkspace;
  173.     property Font;
  174.     property Images : TCustomImageList read FImages write SetImages;
  175.     property ActivePage : TrmOutlookPage read FActivePage write SetActivePage;
  176.     property ButtonHeight : Integer read fButtonHeight write SetButtonHeight default 18;
  177.     property DrawingStyle : TrmDrawingStyle read fDrawingStyle write SetDrawingStyle default ds3D;
  178.     property OnPageChanged : TNotifyEvent read fPageChanged write fPageChanged;
  179.     property OnResize;
  180.   end;
  181.  
  182.  
  183. implementation
  184.  
  185. uses extCtrls;
  186.  
  187. const
  188.   SOutlookIndexError = 'Sheet index Error';
  189.  
  190. { TrmOutlookPage }
  191.  
  192. constructor TrmOutlookPage.Create(AOwner : TComponent);
  193. begin
  194.   inherited Create(AOwner);
  195.   ControlStyle := ControlStyle + [csClickEvents, csAcceptsControls] - [csDesignInteractive];
  196.  
  197.   Visible := True;
  198.   Caption := '';
  199.   FImageIndex := -1;
  200.   color := clAppWorkSpace;
  201.  
  202.   FAlignment := taCenter;
  203. end;
  204.  
  205. function TrmOutlookPage.GetClientRect : TRect;
  206. begin
  207.   Result := inherited GetClientRect;
  208.   if Assigned(FOutlookControl) then
  209.     Result.Top := Result.Top + FOutlookControl.FButtonHeight;
  210. end;
  211.  
  212. procedure TrmOutLookPage.UpdatePage;
  213. var
  214.   loop : Integer;
  215. begin
  216.   if Assigned(FOutlookControl) then
  217.   begin
  218.     for loop := 0 to ControlCount - 1 do
  219.         Controls[loop].Visible := (Self = FOutlookControl.FActivePage);
  220.   end;
  221.   Realign;
  222. end;
  223.  
  224. procedure TrmOutlookPage.SetImageIndex(Value : Integer);
  225. begin
  226.   FImageIndex := Value;
  227.   PaintButton;
  228. end;
  229.  
  230. destructor TrmOutlookPage.Destroy;
  231. begin
  232.   if Assigned(FOnDestroy) then
  233.     FOnDestroy(Self);
  234.  
  235.   inherited Destroy;
  236. end;
  237.  
  238. function TrmOutlookPage.GetPageIndex : Integer;
  239. begin
  240.   if FOutlookControl <> nil then
  241.     Result := FOutlookControl.FPages.IndexOf(Self)
  242.   else
  243.     Result := -1;
  244. end;
  245.  
  246. procedure TrmOutlookPage.CreateParams(var Params : TCreateParams);
  247. begin
  248.   inherited CreateParams(Params);
  249.  
  250.   with Params.WindowClass do
  251.     style := style and not (CS_HREDRAW or CS_VREDRAW);
  252. end;
  253.  
  254. procedure TrmOutlookPage.ReadState(Reader : TReader);
  255. begin
  256.   inherited ReadState(Reader);
  257.   if Reader.Parent is TrmOutlookControl then
  258.     OutlookControl := TrmOutlookControl(Reader.Parent);
  259. end;
  260.  
  261. procedure TrmOutlookPage.WMSize(var Message : TMessage);
  262. begin
  263.   inherited;
  264.   Invalidate;
  265. end;
  266.  
  267. procedure TrmOutlookPage.SetOutlookControl(AOutlookControl : TrmOutlookControl);
  268. begin
  269.   if FOutlookControl <> AOutlookControl then
  270.   begin
  271.     if FOutlookControl <> nil then
  272.        FOutlookControl.RemovePage(Self);
  273.  
  274.     Parent := AOutlookControl;
  275.     
  276.     if AOutlookControl <> nil then
  277.        AOutlookControl.InsertPage(Self);
  278.   end;
  279. end;
  280.  
  281. procedure TrmOutlookPage.SetPageIndex(Value : Integer);
  282. var
  283.   MaxPageIndex : Integer;
  284. begin
  285.   if FOutlookControl <> nil then
  286.   begin
  287.     MaxPageIndex := FOutlookControl.FPages.Count - 1;
  288.     if Value > MaxPageIndex then
  289.       raise EListError.CreateFmt(SOutlookIndexError, [Value, MaxPageIndex]);
  290.     FOutlookControl.FPages.Move(PageIndex, Value);
  291.   end;
  292. end;
  293.  
  294. procedure TrmOutlookPage.SetAlignment(const Value: TAlignment);
  295. begin
  296.   FAlignment := Value;
  297.   PaintButton;
  298. end;
  299.  
  300. procedure TrmOutlookPage.WMMove(var Message: TWMMove);
  301. begin
  302.   if csDesigning in ComponentState then
  303.   begin
  304.      if Assigned(FOutlookControl) then
  305.         FOutlookControl.Invalidate;
  306.   end;
  307.   inherited;
  308. end;
  309.  
  310. procedure TrmOutlookPage.Paint;
  311. var
  312.    loop : integer;
  313. begin
  314.    if not (csDestroying in ComponentState) and (Assigned(FOutlookControl)) then
  315.    begin
  316.       if ParentColor then
  317.          Canvas.Brush.Color := FOutlookControl.Color
  318.       else
  319.          Canvas.Brush.Color := Color;
  320.  
  321.       Canvas.Brush.Style := bsSolid;
  322.       Canvas.FillRect(Rect(0, FOutlookControl.ButtonHeight, Width, Height));
  323.       Canvas.Brush.Style := bsClear;
  324.  
  325.       PaintButton;
  326.  
  327.       loop := 0;
  328.       while loop < controlcount do
  329.       begin
  330.          Controls[loop].Refresh;
  331.          inc(loop);
  332.       end;
  333.    end;
  334. end;
  335.  
  336. procedure TrmOutlookPage.MouseDown(Button: TMouseButton; Shift: TShiftState;
  337.   X, Y: Integer);
  338. begin
  339.   inherited MouseDown(Button, Shift, X, Y);
  340.  
  341.   if PtInRect(BtnRect, Point(X,Y)) and (Button = mbLeft) then
  342.   begin
  343.      if (FCloseButton and PtInRect(CloseBtnRect, Point(X, Y))) then
  344.      begin
  345.         FCloseButtonDown := True;
  346.         SetCaptureControl(self);
  347.         PaintButton;  // Might have to be invalidate...?
  348.      end
  349.      else
  350.         FOutlookControl.SetActivePage(self);
  351.   end;
  352. end;
  353.  
  354. procedure TrmOutlookPage.WMErase(var Message: TMessage);
  355. begin
  356.   Message.Result := 1;
  357. end;
  358.  
  359. procedure TrmOutlookPage.MouseMove(Shift: TShiftState; X, Y: Integer);
  360. var
  361.    wLast1, wLast2 : boolean;
  362. begin
  363.   inherited MouseMove(Shift, X, Y);
  364.  
  365.   wLast1 := fMouseOverBtn;
  366.   fMouseOverBtn := PtInRect(BtnRect, Point(X, Y));
  367.  
  368.   wLast2 := fCloseMouseOver;
  369.   FCloseMouseOver := fMouseOverBtn and FCloseButton and PtInRect(CloseBtnRect, Point(X, Y));
  370.  
  371.   if (wLast1 <> fMouseOverBtn) or (wLast2 <> fCloseMouseOver) then
  372.      PaintButton;
  373. end;
  374.  
  375. procedure TrmOutlookPage.CMMouseEnter(var Message: TMessage);
  376. begin
  377.   FCloseMouseOver := false;
  378.   fMouseOverBtn := false;
  379.   PaintButton;
  380. end;
  381.  
  382. procedure TrmOutlookPage.CMMouseLeave(var Message: TMessage);
  383. begin
  384.   FCloseMouseOver := false;
  385.   fMouseOverBtn := false;
  386.   PaintButton;
  387. end;
  388.  
  389. procedure TrmOutlookPage.SetCloseButton(const Value: Boolean);
  390. begin
  391.   FCloseButton := Value;
  392.   PaintButton;
  393. end;
  394.  
  395. procedure TrmOutlookPage.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
  396.   Y: Integer);
  397. var
  398.   CanClose : Boolean;
  399.  
  400. begin
  401.   inherited MouseUp(Button, Shift, X, Y);
  402.  
  403.   SetCaptureControl(nil);
  404.  
  405.   if (FCloseButton and PtInRect(CloseBtnRect, Point(X, Y))) then
  406.   begin
  407.     if FCloseButtonDown then
  408.     begin
  409.       //close the page....
  410.       CanClose := True;
  411.  
  412.       if Assigned(FOnQueryClosePage) then
  413.         FOnQueryClosePage(Self, CanClose);
  414.  
  415.       if CanClose then
  416.         Self.Free;
  417.  
  418.       FCloseButtonDown := False;
  419.       PaintButton;
  420.     end;
  421.   end
  422.   else
  423.   begin
  424.      FCloseMouseOver := False;
  425.      PaintButton;
  426.   end;
  427. end;
  428.  
  429. procedure TrmOutlookPage.CMVisibleChanged(var Message: TMessage);
  430. begin
  431.   Inherited;
  432.   if Assigned(FOutlookControl) then
  433.   begin
  434. {    if Visible then
  435.        FOutlookControl.AdjustPages
  436.     else}
  437.     begin
  438.       if Self.PageIndex = (FOutlookControl.FPages.Count - 1) then
  439.         FOutlookControl.SelectNextPage(False)
  440.       else
  441.         FOutlookControl.SelectNextPage(True);
  442.     end;
  443.   end;
  444. end;
  445.  
  446. procedure TrmOutlookPage.CMFontChanged(var Message: TMessage);
  447. begin
  448.    Inherited;
  449.    PaintButton;
  450. end;
  451.  
  452. function TrmOutlookPage.BtnRect: TRect;
  453. begin
  454.     result := Rect(0, 0, Width, FOutlookControl.FButtonHeight);
  455. end;
  456.  
  457. function TrmOutlookPage.CloseBtnRect: TRect;
  458. var
  459.    wBtn : TRect;
  460. begin
  461.     wBtn := BtnRect;
  462.     result := Rect((wBtn.Right - FOutlookControl.FButtonHeight) + 4,
  463.                    wBtn.Top + 2,
  464.                    wBtn.Right - 3,
  465.                    wBtn.Bottom - 3);
  466. end;
  467.  
  468. procedure TrmOutlookPage.CMColorChanged(var Message: TMessage);
  469. begin
  470.    Inherited;
  471.    Invalidate;
  472. end;
  473.  
  474. procedure TrmOutlookPage.CMTextChanged(var Message: TMessage);
  475. begin
  476.    Inherited;
  477.    PaintButton;
  478. end;
  479.  
  480. procedure TrmOutlookPage.CMParentColorChanged(var Message: TMessage);
  481. begin
  482.    if ParentColor then
  483.       Invalidate;  
  484. end;
  485.  
  486. procedure TrmOutlookPage.CMParentFontChanged(var Message: TMessage);
  487. begin
  488.    Inherited;
  489.    if ParentFont then
  490.       Invalidate;
  491. end;
  492.  
  493. procedure TrmOutlookPage.PaintButton;
  494. var
  495.   PaintRect : TRect;
  496.   DrawFlags : Integer;
  497. begin
  498.    if not (csDestroying in ComponentState) and (Assigned(FOutlookControl)) then
  499.    begin
  500.       //paint the frame..
  501.       DrawFlags := DFCS_BUTTONPUSH;
  502.  
  503.       case FOutlookControl.DrawingStyle of
  504.          ds3D :; //Do nothing...
  505.          dsFlat: DrawFlags := DrawFlags or DFCS_FLAT;
  506.          dsNone: DrawFlags := DrawFlags or DFCS_Mono;
  507.       end;
  508.  
  509.       DrawFrameControl(Canvas.Handle, BtnRect, DFC_BUTTON, DrawFlags);
  510.  
  511.       if FCloseButton then
  512.       begin
  513.          Canvas.Brush.Color := clBlack;
  514.  
  515.          DrawFlags := DFCS_CAPTIONCLOSE;
  516.  
  517.          if FCloseButtonDown and FCloseMouseOver then
  518.            DrawFlags := Drawflags or DFCS_PUSHED
  519.          else
  520.            DrawFlags := Drawflags or DFCS_FLAT;
  521.  
  522.          DrawFrameControl(Canvas.Handle, CloseBtnRect, DFC_CAPTION, DrawFlags);
  523.  
  524.          Canvas.Brush.Style := bsClear;
  525.       end;
  526.  
  527.       PaintRect := BtnRect;
  528.  
  529.       //paint the bitmap if there is one...
  530.       if ImageIndex <> -1 then
  531.       begin
  532.          if Assigned(FOutlookControl.FImages) then
  533.          begin
  534.              FOutlookControl.FImages.Draw(Canvas, 2, (FOutlookControl.ButtonHeight div 2) - (FOutlookControl.FImages.Width div 2) , ImageIndex);
  535.              PaintRect.left := FOutlookControl.FImages.Width+4;
  536.          end;
  537.       end;
  538.  
  539.       //Adjust for closebtn...
  540.       PaintRect.right := ClosebtnRect.Left - 2;
  541.  
  542.       //paint the text...
  543.       DrawFlags := DT_SINGLELINE or DT_VCENTER or DT_END_ELLIPSIS;
  544.  
  545.       case FAlignment of
  546.         taLeftJustify : DrawFlags := DrawFlags or DT_LEFT;
  547.         taRightJustify : DrawFlags := DrawFlags or DT_RIGHT;
  548.         taCenter : DrawFlags := DrawFlags or DT_CENTER;
  549.       end;
  550.  
  551.       if ParentFont then
  552.          Canvas.Font.assign(fOutlookControl.Font)
  553.       else
  554.          Canvas.Font.assign(Font);
  555.  
  556.       if fMouseOverBtn then
  557.          canvas.font.color := clHighlight;
  558.  
  559.       DrawTextEx(Canvas.Handle, PChar(Caption), Length(Caption), PaintRect, DrawFlags, nil);
  560.    end;
  561. end;
  562.  
  563. { TrmOutlookControl }
  564.  
  565. constructor TrmOutlookControl.Create(AOwner : TComponent);
  566. begin
  567.   inherited Create(AOwner);
  568.  
  569.   width := 175;
  570.   height := 250;
  571.   fDrawingStyle := ds3D;
  572.   Caption := '';
  573.   FButtonHeight := 18;
  574.   color := clAppWorkspace;
  575.  
  576.   FPages := TList.Create;
  577.   FImageChangeLink := TChangeLink.Create;
  578.   FImageChangeLink.OnChange := ImageListChange;
  579. end;
  580.  
  581. destructor TrmOutlookControl.Destroy;
  582. var
  583.   I : Integer;
  584.  
  585. begin
  586.   for I := FPages.Count - 1 downto 0 do
  587.     TrmOutlookPage(FPages[I]).Free;
  588.   FPages.Free;
  589.   FImageChangeLink.Free;
  590.   inherited Destroy;
  591. end;
  592.  
  593. procedure TrmOutlookControl.ImageListChange(Sender : TObject);
  594. begin
  595.    Invalidate;
  596. end;
  597.  
  598. procedure TrmOutlookControl.AdjustPages;
  599. var
  600.   loop : Integer;
  601.   wVisibleCount : Integer;
  602.   ProcessFlag : Boolean;
  603.   wTop : integer;                         
  604.   wPage : TrmOutLookPage;
  605.  
  606. begin
  607.    if (csDestroying in ComponentState) then
  608.       exit;
  609.  
  610.    //how many are visible?
  611.    wVisibleCount := 0;
  612.    if (csDesigning in ComponentState) then
  613.    begin
  614.       wVisibleCount := FPages.Count;
  615.    end
  616.    else
  617.    begin
  618.       for loop := 0 to FPages.Count - 1 do
  619.       begin
  620.         if TrmOutLookPage(fPages[loop]).Visible then
  621.           inc(wVisibleCount);
  622.       end;
  623.    end;
  624.  
  625.    wTop := GetBorderWidth;
  626.    for loop := 0 to FPages.Count - 1 do
  627.    begin
  628.      if (csDesigning in ComponentState) then
  629.        ProcessFlag := True
  630.      else
  631.      begin
  632.        if TrmOutLookPage(FPages[loop]).Visible then
  633.          ProcessFlag := True
  634.        else
  635.          ProcessFlag := False;
  636.      end;
  637.  
  638.      if ProcessFlag then
  639.      begin
  640.         wPage := TrmOutLookPage(FPages[loop]);
  641.  
  642.         wPage.Left := GetBorderWidth;
  643.         wPage.Width := ClientWidth - GetBorderWidth;
  644.         wPage.Top := wTop;
  645.  
  646.         if loop = FActivePage.PageIndex then
  647.            wPage.Height := ((ClientHeight - GetBorderWidth) - ((wVisibleCount - 1) * FButtonHeight))
  648.         else
  649.            wPage.Height := FButtonHeight;
  650.  
  651.         wPage.UpdatePage;
  652.         wPage.Invalidate;
  653.  
  654.         inc(wTop, wPage.Height);
  655.      end;
  656.    end;
  657. end;
  658.  
  659.  
  660. function TrmOutlookControl.FindNextPage(CurPage : TrmOutlookPage; GoForward : Boolean) : TrmOutlookPage;
  661. var
  662.   I, StartIndex : Integer;
  663. begin
  664.   Result := nil;
  665.   if FPages.Count <> 0 then
  666.   begin
  667.     StartIndex := FPages.IndexOf(CurPage);
  668.     if StartIndex = -1 then
  669.     begin
  670.       if GoForward then
  671.       begin
  672.         StartIndex := FPages.Count - 1;
  673.         for I := StartIndex downto 0 do
  674.         begin
  675.           if TrmOutlookPage(FPages[I]).Visible then
  676.           begin
  677.             StartIndex := I;
  678.             Break;
  679.           end;
  680.         end;
  681.       end
  682.       else
  683.       begin
  684.         StartIndex := 0;
  685.         for I := 0 to FPages.Count - 1 do
  686.         begin
  687.           if TrmOutlookPage(FPages[I]).Visible then
  688.           begin
  689.             StartIndex := I;
  690.             Break;
  691.           end;
  692.         end;
  693.       end;
  694.     end;
  695.  
  696.     if GoForward then
  697.     begin
  698.       Inc(StartIndex);
  699.       if StartIndex = FPages.Count then
  700.         StartIndex := 0;
  701.       for I := StartIndex to FPages.Count - 1 do
  702.       begin
  703.         if TrmOutlookPage(FPages[I]).Visible then
  704.         begin
  705.           StartIndex := I;
  706.           Break;
  707.         end;
  708.       end;
  709.     end
  710.     else
  711.     begin
  712.       if StartIndex = 0 then
  713.         StartIndex := FPages.Count;
  714.       Dec(StartIndex);
  715.       for I := StartIndex downto 0 do
  716.       begin
  717.         if TrmOutlookPage(FPages[I]).Visible then
  718.         begin
  719.           StartIndex := I;
  720.           Break;
  721.         end;
  722.       end;
  723.     end;
  724.     Result := FPages[StartIndex];
  725.   end;
  726. end;
  727.  
  728. procedure TrmOutlookControl.GetChildren(Proc : TGetChildProc; Root : TComponent);
  729. var
  730.   I : Integer;
  731. begin
  732.   for I := 0 to FPages.Count - 1 do
  733.     Proc(TComponent(FPages[I]));
  734. end;
  735.  
  736. function TrmOutlookControl.GetPage(Index : Integer) : TrmOutlookPage;
  737. begin
  738.   Result := FPages[Index];
  739. end;
  740.  
  741. function TrmOutlookControl.GetPageCount : Integer;
  742. begin
  743.   Result := FPages.Count;
  744. end;
  745.  
  746. procedure TrmOutlookControl.InsertPage(Page : TrmOutlookPage);
  747. begin
  748.   FPages.Add(Page);
  749.   Page.FOutlookControl := Self;
  750.   Page.FreeNotification(self);
  751. end;
  752.  
  753. procedure TrmOutlookControl.RemovePage(Page : TrmOutlookPage);
  754. var
  755.    wPage : TrmOutlookPage;
  756. begin
  757.   if FActivePage = Page then
  758.   begin
  759.      wPage := FindNextPage(FActivePage, True);
  760.  
  761.      if wPage = Page then
  762.         FActivePage := nil
  763.      else
  764.         FActivePage := wPage;
  765.   end;
  766.  
  767.   FPages.Remove(Page);
  768.   Page.FOutlookControl := nil;
  769.  
  770.   if not (csDestroying in ComponentState) then
  771.      Invalidate;
  772. end;
  773.  
  774. procedure TrmOutlookControl.SelectNextPage(GoForward : Boolean);
  775. begin
  776.   SetActivePage(FindNextPage(ActivePage, GoForward));
  777. end;
  778.  
  779. procedure TrmOutlookControl.SetActivePage(Page : TrmOutlookPage);
  780. begin
  781.   if not (csDestroying in ComponentState) then
  782.   begin
  783.      if (assigned(Page) and (Page.OutlookControl = Self)) or (Page = nil) then
  784.      begin
  785.         fActivePage := Page;
  786.         AdjustPages;
  787.  
  788.         if Assigned(FPageChanged) and not (csDestroying in ComponentState) then
  789.            FPageChanged(self);
  790.      end;
  791.   end; 
  792. end;
  793.  
  794. procedure TrmOutlookControl.SetChildOrder(Child : TComponent; Order : Integer);
  795. begin
  796.   TrmOutlookPage(Child).PageIndex := Order;
  797. end;
  798.  
  799. procedure TrmOutlookControl.ShowControl(AControl : TControl);
  800. begin
  801.   if (AControl is TrmOutlookPage) and (TrmOutlookPage(AControl).OutlookControl = Self) then
  802.     SetActivePage(TrmOutlookPage(AControl));
  803.   inherited ShowControl(AControl);
  804. end;
  805.  
  806. procedure TrmOutlookControl.WMSize(var Message : TMessage);
  807. begin
  808.   inherited;
  809.   Invalidate;
  810. end;
  811.  
  812. procedure TrmOutlookControl.CMDialogKey(var Message : TCMDialogKey);
  813. begin
  814.   if (Message.CharCode = VK_TAB) and (GetKeyState(VK_CONTROL) < 0) then
  815.   begin
  816.     SelectNextPage(GetKeyState(VK_SHIFT) >= 0);
  817.     Message.Result := 1;
  818.   end
  819.   else
  820.     inherited;
  821. end;
  822.  
  823. procedure TrmOutlookControl.SetImages(Value : TCustomImageList);
  824. begin
  825.   if Images <> nil then
  826.      Images.UnRegisterChanges(FImageChangeLink);
  827.   FImages := Value;
  828.   if Images <> nil then
  829.   begin
  830.     Images.RegisterChanges(FImageChangeLink);
  831.     Images.FreeNotification(Self);
  832.   end;
  833.   Invalidate;
  834. end;
  835.  
  836. procedure TrmOutlookControl.SetButtonHeight(value : integer);
  837. begin
  838.   FButtonHeight := value;
  839.   Invalidate;
  840. end;
  841.  
  842. procedure TrmOutlookControl.WMMove(var Message: TWMMove);
  843. begin
  844.   inherited;
  845.   Invalidate;
  846. end;
  847.  
  848. procedure TrmOutlookControl.Paint;
  849. var
  850.    wRect : TRect;
  851. begin
  852.   wRect := ClientRect;
  853.   InflateRect(wRect, GetBorderWidth, GetBorderWidth);
  854.   Canvas.Brush.Color := clAppworkspace;
  855.   Canvas.Brush.Style := bsSolid;
  856.  
  857.   case fDrawingStyle of
  858.      ds3D:
  859.         begin
  860.            Frame3d(Canvas, wRect, clBtnShadow, clBtnHighlight, 1);
  861.            Frame3d(Canvas, wRect, cl3DDkShadow, cl3DLight, 1);
  862.         end;
  863.      dsFlat:
  864.         begin
  865.            Frame3d(Canvas, wRect, cl3DDkShadow, cl3DDkShadow, 1);
  866.         end;
  867.   else
  868.      //Do Nothing...
  869.   end;
  870.  
  871.   Canvas.FillRect(wRect);
  872.  
  873.   AdjustPages;
  874. {  if assigned(FActivePage) then
  875.      fActivePage.Invalidate;}
  876. end;
  877.  
  878. procedure TrmOutlookControl.WMErase(var Message: TMessage);
  879. begin
  880.   Message.Result := 1;
  881. end;
  882.  
  883. function TrmOutlookControl.GetClientRect: TRect;
  884. begin
  885.    result := inherited GetClientRect;
  886.    InflateRect(result, -GetBorderWidth, -GetBorderWidth);
  887. end;
  888.  
  889. procedure TrmOutlookControl.SetDrawingStyle(const Value: TrmDrawingStyle);
  890. begin
  891.   fDrawingStyle := Value;
  892.   invalidate;
  893. end;
  894.  
  895. function TrmOutlookControl.GetBorderWidth: integer;
  896. begin
  897.    case fDrawingStyle of
  898.      ds3D : result := 2;
  899.      dsFlat : result := 1;
  900.    else
  901.      result := 0; 
  902.    end;
  903. end;
  904.  
  905. procedure TrmOutlookControl.Notification(AComponent: TComponent;
  906.   Operation: TOperation);
  907. begin
  908.   inherited Notification(AComponent, Operation);
  909.   if Operation = opRemove then
  910.   begin
  911.     if AComponent = Images then
  912.       Images := nil;
  913.  
  914.     if (AComponent is TrmOutlookPage) and (TrmOutlookPage(AComponent).OutlookControl = self) then
  915.        RemovePage(TrmOutlookPage(AComponent));
  916.   end;
  917. end;
  918.  
  919. procedure TrmOutlookControl.Loaded;
  920. begin
  921.   inherited;
  922. end;
  923.  
  924. procedure TrmOutlookControl.CMColorChanged(var Message: TMessage);
  925. begin
  926.    Inherited;
  927.    Invalidate;  
  928. end;
  929.  
  930. procedure TrmOutlookControl.CMFontChanged(var Message: TMessage);
  931. begin
  932.    Inherited;
  933.    Invalidate;
  934. end;
  935.  
  936. end.
  937.  
  938.