home *** CD-ROM | disk | FTP | other *** search
- {================================================================================
- Copyright (C) 1997-2001 Mills Enterprise
-
- Unit : rmOutlookExtras
- Purpose : A simple implementation of the M$ Outlook style buttons components
- Date : 03-07-01
- Author : Ryan J. Mills
- Version : 1.80
- Notes : This unit was originally based upon the work of Patrick O'Keeffe.
- It was at his request that I took the component over and rm'ified it.
-
- 06-03-01: The TrmOutlookActionLink component was originally written
- by Piotr Jurago of Poland. He sent the code back to me and I've
- included it here.
- ================================================================================}
-
- unit rmOutLookExtras;
-
- interface
-
- {$I CompilerDefines.INC}
-
- uses windows, messages, ActnList, controls, classes, rmSpeedBtns, rmOutlook, imglist;
-
- type
- TrmOutLookButtonList = class;
- TrmOutlookListButton = class;
-
- TOLButtonStyle = (olbsLarge, olbsSmall);
- TOLViewStyle = (vsSmallIcons, vsLargeIcons);
- TOLButtonClickEvent = procedure(Sender : TObject; Button : TrmOutlookListButton) of Object;
-
- TrmOutlookListBaseButton = class(TrmSpeedButton)
- private
- FOutLookButtonList : TrmOutlookButtonList;
- FMouseInControl : Boolean;
- FCaption: String;
- FButtonStyle: TOLButtonStyle;
- FImageIndex: Integer;
- procedure CMMouseEnter(var Message : TMessage); message CM_MOUSEENTER;
- procedure CMMouseLeave(var Message : TMessage); message CM_MOUSELEAVE;
- procedure SetrmOutlookButtons(Value : TrmOutlookButtonList);
- procedure SetCaption(const Value: String);
- procedure SetButtonStyle(const Value: TOLButtonStyle);
- procedure SetImageIndex(const Value: Integer);
- protected
- { Protected Declarations }
- procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
- procedure EraseBK(var Message : TMessage); message WM_ERASEBKGND;
- procedure Paint; override;
- public
- { Public Declarations }
- constructor create(AOwner:TComponent); override;
- property ImageIndex : Integer read FImageIndex write SetImageIndex;
- property OutLookButtonList : TrmOutlookButtonList read FOutLookButtonList write SeTrmOutlookButtons;
- property ButtonStyle : TOLButtonStyle read FButtonStyle write SetButtonStyle;
- property ButtonCaption : String read FCaption write SetCaption;
- end;
-
- TrmOutlookListButton = class(TCollectionItem)
- private
- FButton : TrmOutlookListBaseButton;
- FData: Pointer;
- procedure ClickButton(Sender : TObject);
- function GetImageIndex: Integer;
- function GetCaption: String;
- function GetAction: TBasicAction;
- procedure SetImageIndex(const Value: Integer);
- procedure SetCaption(const Value: String);
- procedure SetAction(const Value: TBasicAction);
- function GetEnabled: boolean;
- procedure SetEnabled(const Value: boolean);
- function GetHint: string;
- procedure SetHint(const Value: string);
- function GetShowHint: boolean;
- procedure SetShowHint(const Value: boolean);
- public
- constructor Create(Collection : TCollection); override;
- destructor Destroy; override;
- property Data : Pointer read FData write FData;
- published
- property Action: TBasicAction read GetAction write SetAction;
- property ImageIndex : Integer read GetImageIndex write SetImageIndex;
- property Enabled : boolean read GetEnabled write SetEnabled;
- property Hint:string read GetHint write SetHint;
- property Caption : String read GetCaption write SetCaption;
- property ShowHint : boolean read GetShowHint write SetShowHint;
- end;
-
- TrmOutlookButtons = class(TCollection)
- private
- FOLBtnList: TrmOutlookButtonList;
- function GetItem(Index: Integer): TrmOutlookListButton;
- procedure SetItem(Index: Integer; Value: TrmOutlookListButton);
- public
- function Add: TrmOutlookListButton;
- constructor Create(AOwner: TrmOutlookButtonList);
- property Items[Index: Integer]: TrmOutlookListButton read GetItem write SetItem; default;
- property OLBtnList: TrmOutlookButtonList read FOLBtnList;
- end;
-
- TrmOutlookButtonListPanel = class(TCustomControl)
- protected
- procedure Paint; override;
- procedure EraseBK(var Message : TMessage); message WM_ERASEBKGND;
- public
- constructor create(AOwner:TComponent); override;
- end;
-
- TrmOutlookButtonList = class(TCustomControl)
- private
- FButtons : TrmOutlookButtons;
- FUpButton : TrmTimerSpeedButton;
- FDownButton : TrmTimerSpeedButton;
-
- FBasePanel : TrmOutlookButtonListPanel;
-
- FLargeImages : TImageList;
- FSmallImages: TImageList;
- FImageChangeLink : TChangeLink;
-
- FViewStyle: TOLViewStyle;
-
- FTopButton: Integer;
-
- FOnClickButton: TOLButtonClickEvent;
- procedure GoUp(Sender : TObject);
- procedure GoDown(Sender : TObject);
- procedure CMDialogKey(var Message : TCMDialogKey); message CM_DIALOGKEY;
- procedure SetLargeImages(Value : TImageList);
- procedure ImageListChange(Sender : TObject);
- procedure SetViewStyle(const Value: TOLViewStyle);
- procedure SetTopButton(const Value: Integer);
- procedure SetSmallImages(const Value: TImageList);
- protected
- procedure Loaded; override;
- procedure WMSize(var Message : TMessage); message WM_SIZE;
- procedure RefreshButtons;
- procedure Notification(AComponent: TComponent; Operation: TOperation); override;
- public
- constructor Create(AOwner : TComponent); override;
- destructor Destroy; override;
- published
- property Align;
- property PopUpMenu;
- property Buttons : TrmOutlookButtons read FButtons write FButtons;
- property LargeImages : TImageList read FLargeImages write SetLargeImages;
- property SmallImages : TImageList read FSmallImages write SetSmallImages;
- property ShowHint;
- property ViewStyle : TOLViewStyle read FViewStyle write SetViewStyle;
- property TopButton : Integer read FTopButton write SetTopButton;
- property OnClickButton : TOLButtonClickEvent read FOnClickButton write FOnClickButton;
- end;
-
- TrmOutlookActionLink = class(TComponent)
- private
- { Private declarations }
- FViewStyle: TOLViewStyle;
- FActionList: TActionList;
- FOutlookControl: TrmOutlookControl;
- function BothAssigned: Boolean;
- procedure SetActionList(const Value: TActionList) ;
- procedure SetOutlookControl(const Value: TrmOutlookControl) ;
- procedure SetViewStyle(const Value: TOLViewStyle) ;
- protected
- { Protected }
- procedure Notification(AComponent: TComponent; Operation: TOperation); override;
- public
- { Public declarations }
- procedure AddPagesFromActionCategorys;
- procedure AddButtonsFromActionsInCategory(Category: String) ;
- published
- { Published declarations }
- property ViewStyle: TOLViewStyle read FViewStyle write SetViewStyle;
- property ActionList: TActionList read FActionList write SetActionList;
- property OutlookControl: TrmOutlookControl read FOutlookControl write SetOutlookControl;
- end;
-
- implementation
-
- uses graphics, ExtCtrls, Dialogs, rmLibrary;
-
- { TrmOutlookButtonList }
-
- constructor TrmOutlookButtonList.Create(AOwner : TComponent);
- begin
- inherited Create(AOwner);
- Caption := '';
- Color := clGray;
- ControlStyle := [csDoubleClicks];
- FBasePanel := TrmOutlookButtonListPanel.Create(Self);
- FBasePanel.Parent := Self;
-
- FUpButton := TrmTimerSpeedButton.Create(Self);
- FUpButton.Parent := Self;
- FUpButton.Width := 17;
- FUpButton.Height := 17;
- FUpButton.OnClick := GoUp;
- FUpButton.Font.Name := 'Marlett';
- FUpButton.Font.size := 10;
- FUpButton.Caption := '5';
- FUpButton.TimeBtnState := [tbAllowTimer];
-
- FDownButton := TrmTimerSpeedButton.Create(Self);
- FDownButton.Parent := Self;
- FDownButton.Width := 17;
- FDownButton.Height := 17;
- FDownButton.OnClick := GoDown;
- FDownButton.Font.Name := 'Marlett';
- FDownButton.Font.size := 10;
- FDownButton.Caption := '6';
- FDownButton.TimeBtnState := [tbAllowTimer];
-
- FButtons := TrmOutlookButtons.Create(Self);
- FImageChangeLink := TChangeLink.Create;
- FImageChangeLink.OnChange := ImageListChange;
- Height := 200;
- Width := 150;
- end;
-
- destructor TrmOutlookButtonList.Destroy;
- begin
- FButtons.Free;
- FImageChangeLink.Free;
- FUpButton.Free;
- FDownButton.Free;
- inherited Destroy;
- end;
-
- procedure TrmOutlookButtonList.ImageListChange(Sender : TObject);
- begin
- Invalidate;
- end;
-
- procedure TrmOutlookButtonList.Loaded;
- begin
- inherited;
- RefreshButtons;
- end;
-
- procedure TrmOutlookButtonList.WMSize(var Message : TMessage);
- begin
- inherited;
- RefreshButtons;
- end;
-
- procedure TrmOutlookButtonList.CMDialogKey(var Message : TCMDialogKey);
- begin
- if (Message.CharCode = VK_TAB) and (GetKeyState(VK_CONTROL) < 0) then
- begin
- Message.Result := 1;
- end
- else
- inherited;
- end;
-
- procedure TrmOutlookButtonList.SetLargeImages(Value : TImageList);
- begin
- if FLargeImages <> nil then
- FLargeImages.UnRegisterChanges(FImageChangeLink);
- FLargeImages := Value;
- if FLargeImages <> nil then
- begin
- FLargeImages.RegisterChanges(FImageChangeLink);
- FLargeImages.FreeNotification(Self);
- end;
- Invalidate;
- end;
-
- procedure TrmOutlookButtonList.SetSmallImages(const Value: TImageList);
- begin
- if FSmallImages <> nil then
- FSmallImages.UnRegisterChanges(FImageChangeLink);
- FSmallImages := Value;
- if FSmallImages <> nil then
- begin
- FSmallImages.RegisterChanges(FImageChangeLink);
- FSmallImages.FreeNotification(Self);
- end;
- Invalidate;
- end;
-
- procedure TrmOutlookButtonList.RefreshButtons;
- var
- loop : Integer;
- TotalHeight : Integer;
- wBtnHeight : integer;
- wTop : integer;
- wBtnStyle : TOLButtonStyle;
-
- begin
- if csLoading in ComponentState then
- Exit;
-
- FUpButton.Visible := False;
- FUpButton.Top := 5;
- FUpButton.Left := Width - 16 - 5;
-
- FDownButton.Visible := False;
- FDownButton.Top := Height - 16 - 5;
- FDownButton.Left := Width - 16 - 5;
-
- FBasePanel.Left := 10;
- FBasePanel.Top := 10;
- FBasePanel.Width := ClientWidth - 36;
- FBasePanel.Height := ClientHeight - 20;
-
- if FViewStyle = vsSmallIcons then
- begin
- wBtnHeight := 25;
- wBtnStyle := olbsSmall;
- end
- else
- begin
- wBtnHeight := 65;
- wBtnStyle := olbsLarge;
- end;
-
- TotalHeight := FButtons.Count * wBtnHeight;
- if TotalHeight > FBasePanel.Height then
- wTop := -(FTopButton * wBtnHeight)
- else
- wTop := 0;
-
- for loop := 0 to FButtons.Count - 1 do
- begin
- FButtons.Items[loop].FButton.ButtonStyle := wBtnStyle;
-
- FButtons.Items[loop].FButton.Width := FBasePanel.ClientWidth;
- FButtons.Items[loop].FButton.Height := wBtnHeight;
- FButtons.Items[loop].FButton.Top := wTop;
- FButtons.Items[loop].FButton.Left := 0;
-
- inc(wTop, wBtnHeight);
- end;
-
- FUpButton.Visible := (FTopButton > 0);
- FDownButton.Visible := (((FButtons.Count - FTopButton) * wBtnHeight) > FBasePanel.ClientHeight);
-
- Repaint;
- end;
-
- procedure TrmOutlookButtonList.SetViewStyle(const Value: TOLViewStyle);
- begin
- FViewStyle := Value;
- RefreshButtons;
- end;
-
- procedure TrmOutlookButtonList.SetTopButton(const Value: Integer);
- begin
- FTopButton := Value;
- RefreshButtons;
- end;
-
- procedure TrmOutlookButtonList.GoDown(Sender : TObject);
- begin
- if FDownButton.visible then
- begin
- FTopButton := FTopButton + 1;
- RefreshButtons;
- end;
- end;
-
- procedure TrmOutlookButtonList.GoUp(Sender : TObject);
- begin
- if FUpButton.visible then
- begin
- FTopButton := FTopButton - 1;
- RefreshButtons;
- end;
- end;
-
- procedure TrmOutlookButtonList.Notification(AComponent: TComponent;
- Operation: TOperation);
- begin
- inherited Notification(AComponent, Operation);
- if Operation = opRemove then
- begin
- if AComponent = FLargeImages then
- fLargeImages := nil;
-
- if AComponent = FSmallImages then
- FSmallImages := nil;
- end;
- end;
-
- { TrmOutlookListBaseButton }
-
- procedure TrmOutlookListBaseButton.SeTrmOutlookButtons(Value : TrmOutlookButtonList);
- begin
- if FOutLookButtonList <> value then
- FOutLookButtonList := Value;
- end;
-
- procedure TrmOutlookListBaseButton.CMMouseEnter(var Message : TMessage);
- begin
- inherited;
- if not FMouseInControl and Enabled then
- begin
- FMouseInControl := True;
- Invalidate;
- end;
- end;
-
-
- procedure TrmOutLookListBaseButton.CMMouseLeave(var Message : TMessage);
- begin
- inherited;
- if FMouseInControl and Enabled then
- begin
- FMouseInControl := False;
- Invalidate;
- end;
- end;
-
-
- procedure TrmOutLookListBaseButton.Paint;
- var
- wButtonRect : TRect;
- wTextRect : TRect;
- wDrawFlags : integer;
- wTopColor, wBottomColor : TColor;
- wImageList : TImageList;
- begin
- //paint the frame..
- if FOutLookButtonList <> nil then
- Canvas.Brush.Color := FOutLookButtonList.Color
- else
- Canvas.Brush.Color := clAppWorkspace;
- Canvas.FillRect(Rect(0, 0, Width, Height));
-
- wImageList := nil;
-
- wDrawFlags := DT_SINGLELINE or DT_END_ELLIPSIS;
-
- case FButtonStyle of
- olbsLarge :
- begin
- wImageList := FOutLookButtonList.FLargeImages;
- wButtonRect := Rect((Width div 2) - 18, 0, (Width div 2) + 18, 36);
- wTextRect := Rect(0, wButtonRect.Bottom + 3, Width, Height);
- wDrawFlags := wDrawFlags or DT_CENTER;
- end;
- olbsSmall :
- begin
- wImageList := FOutLookButtonList.FSmallImages;
- wButtonRect := Rect(0, 0, 20, 20);
- wTextRect := Rect(wButtonRect.Right + 4, 0, Width, wButtonRect.Bottom);
- wDrawFlags := wDrawFlags or DT_VCENTER;
- end;
- end;
-
- if FMouseInControl then
- begin
- if FState in [bsDown] then
- begin
- //the button is pushed...
- wTopColor := cl3dDkShadow;
- wBottomColor := cl3DLight;
- end
- else
- begin
- wTopColor := cl3DLight;
- wBottomColor := cl3dDkShadow;
- end;
-
- Frame3d(Canvas, wButtonRect, wTopColor, wBottomColor, 1);
-
- if (FState in [bsDown]) then
- OffsetRect(wButtonRect, 1, 1);
- end
- else
- InflateRect(wButtonRect, -1, -1);
-
- if (wImageList <> nil) and (FImageIndex > -1) then
- begin
- if assigned(parent) and (csdesigning in Parent.ComponentState) then
- wImageList.Draw(Canvas, wButtonRect.Left + 1, wButtonRect.Top + 1, FImageIndex)
- else
- wImageList.Draw(Canvas, wButtonRect.Left + 1, wButtonRect.Top + 1, FImageIndex, self.enabled)
- end;
-
- Canvas.Font.Color := clCaptionText;
- Canvas.Brush.Color := clAppWorkspace;
- DrawTextEx(Canvas.Handle, PCHar(FCaption), Length(FCaption), wTextRect, wDrawFlags, nil);
- end;
-
-
-
- procedure TrmOutLookListBaseButton.EraseBK(var Message: TMessage);
- begin
- Message.Result := 1;
- end;
-
- procedure TrmOutLookListBaseButton.SetCaption(const Value: String);
- begin
- FCaption := Value;
- Invalidate;
- end;
-
- procedure TrmOutLookListBaseButton.SetButtonStyle(
- const Value: TOLButtonStyle);
- begin
- FButtonStyle := Value;
- Invalidate;
- end;
-
- constructor TrmOutlookListBaseButton.create(AOwner: TComponent);
- begin
- inherited;
- ControlStyle := ControlStyle - [csDesignInteractive];
- end;
-
- procedure TrmOutlookListBaseButton.SetImageIndex(const Value: Integer);
- begin
- FImageIndex := Value;
- invalidate;
- end;
-
- procedure TrmOutlookListBaseButton.ActionChange(Sender: TObject;
- CheckDefaults: Boolean);
- begin
- if Sender is TCustomAction then
- with TCustomAction(Sender) do
- begin
- if not CheckDefaults or (Self.ButtonCaption = '') or (Self.ButtonCaption = Self.Name) then
- Self.ButtonCaption := Caption;
- if not CheckDefaults or (Self.Enabled = True) then
- Self.Enabled := Enabled;
- if not CheckDefaults or (Self.Hint = '') then
- Self.Hint := Hint;
- if not CheckDefaults or (Self.Visible = True) then
- Self.Visible := Visible;
- if not CheckDefaults or not Assigned(Self.OnClick) then
- Self.OnClick := OnExecute;
- Self.ImageIndex := ImageIndex;
- end;
- end;
-
- { TrmOutLookButtons }
-
- function TrmOutLookButtons.Add: TrmOutlookListButton;
- begin
- Result := TrmOutlookListButton(inherited Add);
- end;
-
- constructor TrmOutLookButtons.Create(AOwner: TrmOutlookButtonList);
- begin
- inherited Create(TrmOutlookListButton);
- FOLBtnList := AOwner;
- end;
-
- function TrmOutLookButtons.GetItem(Index: Integer): TrmOutlookListButton;
- begin
- Result := TrmOutlookListButton(inherited GetItem(Index));
- end;
-
- procedure TrmOutLookButtons.SetItem(Index: Integer;
- Value: TrmOutlookListButton);
- begin
- inherited SetItem(Index, Value);
- end;
-
- { TrmOutlookListButton }
-
- procedure TrmOutLookListButton.ClickButton(Sender: TObject);
- begin
- if Assigned(TrmOutlookButtons(Collection).OLBtnList.FOnClickButton) then
- TrmOutlookButtons(Collection).OLBtnList.FOnClickButton(TrmOutlookButtons(Collection).OLBtnList, Self)
- else
- begin
- if assigned(Action) and assigned(Action.OnExecute) then
- Action.OnExecute(Sender);
- end;
- end;
-
- constructor TrmOutLookListButton.Create(Collection: TCollection);
- begin
- inherited Create(Collection);
-
- FButton := TrmOutlookListBaseButton.Create(nil);
- FButton.OutLookButtonList := TrmOutlookButtons(Collection).OLBtnList;
- FButton.Parent := TrmOutlookButtons(Collection).OLBtnList.FBasePanel;
- FButton.OnClick := ClickButton;
- TrmOutlookButtons(Collection).OLBtnList.RefreshButtons;
- end;
-
- destructor TrmOutLookListButton.Destroy;
- begin
- FButton.Free;
- inherited Destroy;
- end;
-
- function TrmOutlookListButton.GetAction: TBasicAction;
- begin
- result := FButton.Action;
- end;
-
- function TrmOutlookListButton.GetCaption: String;
- begin
- result := FButton.ButtonCaption;
- end;
-
- function TrmOutlookListButton.GetEnabled: boolean;
- begin
- result := fButton.Enabled;
- end;
-
- function TrmOutlookListButton.GetHint: string;
- begin
- result := FButton.Hint;
- end;
-
- function TrmOutlookListButton.GetImageIndex: Integer;
- begin
- result := FButton.ImageIndex;
- end;
-
- function TrmOutlookListButton.GetShowHint: boolean;
- begin
- result := FButton.ShowHint;
- end;
-
- procedure TrmOutlookListButton.SetAction(const Value: TBasicAction);
- begin
- FButton.Action := Value;
- end;
-
- procedure TrmOutLookListButton.SetCaption(const Value: String);
- begin
- FButton.ButtonCaption := Value;
- end;
-
- procedure TrmOutlookListButton.SetEnabled(const Value: boolean);
- begin
- fbutton.enabled := value;
- end;
-
- procedure TrmOutlookListButton.SetHint(const Value: string);
- begin
- fButton.Hint := value;
- end;
-
- procedure TrmOutLookListButton.SetImageIndex(const Value: Integer);
- begin
- FButton.ImageIndex := Value;
- end;
-
- procedure TrmOutlookListButton.SetShowHint(const Value: boolean);
- begin
- FButton.ShowHint := value;
- end;
-
- { TrmOutlookButtonListPanel }
-
- constructor TrmOutlookButtonListPanel.create(AOwner: TComponent);
- begin
- inherited;
- ControlStyle := ControlStyle - [csDesignInteractive];
- end;
-
- procedure TrmOutLookButtonListPanel.EraseBK(var Message: TMessage);
- begin
- Message.Result := 1;
- end;
-
- procedure TrmOutLookButtonListPanel.Paint;
- begin
- with Canvas do
- begin
- Brush.Color := Color;
- Brush.Style := bsSolid;
- FillRect(ClientRect);
- end;
- inherited;
- end;
-
- { TrmOutlookActionLink }
-
- procedure TrmOutlookActionLink.AddButtonsFromActionsInCategory(Category: String) ;
- var
- i: integer;
- InCategory: integer;
- AOutLookButtonList: TrmOutLookButtonList;
- AOutLookListButton: TrmOutLookListButton;
- begin
- if not BothAssigned then
- exit;
-
- InCategory := -1;
-
- for i := 0 to FOutlookControl.PageCount - 1 do
- begin
- if FOutlookControl.Pages[i].Caption = Category then
- InCategory := i;
- end;
-
- if Incategory <> -1 then
- begin
- AOutLookButtonList := TrmOutLookButtonList.Create(Owner) ;
- AOutLookButtonList.Parent := FOutlookControl.Pages[inCategory];
- AOutLookButtonList.Align := AlClient;
- AOutLookButtonList.ViewStyle := FViewStyle;
-
- if FViewStyle = vsSmallIcons then
- AOutLookButtonList.SmallImages := TImageList(FActionList.Images)
- else
- AOutLookButtonList.LargeImages := TImageList(FActionList.Images) ;
-
- for i := 0 to FActionList.ActionCount - 1 do
- begin
- if FActionList.Actions[i].Category = Category then
- begin
- AOutLookListButton := TrmOutLookListButton.Create(AOutLookButtonList.Buttons) ;
- AOutLookListButton.Action := TAction(FActionList.Actions[i]) ;
- end;
- end;
- end;
- end;
-
- procedure TrmOutlookActionLink.AddPagesFromActionCategorys;
- var
- i: integer;
- UniqeCategorys: TStringList;
- Page: TrmOutlookPage;
- begin
- if not BothAssigned then
- exit;
-
- Page := nil;
-
- UniqeCategorys := TStringList.Create;
- try
- UniqeCategorys.Sorted := true;
- UniqeCategorys.Duplicates := dupIgnore;
-
- for i := 0 to ActionList.ActionCount - 1 do
- UniqeCategorys.add(ActionList.Actions[i].Category) ;
-
- For i := 0 to UniqeCategorys.Count - 1 do
- begin
- Page := TrmOutlookPage.Create(Owner) ;
- Page.Caption := UniqeCategorys.Strings[i];
- Page.OutlookControl := FOutlookControl;
- AddButtonsFromActionsInCategory(UniqeCategorys.Strings[i]) ;
- end;
-
- if assigned(page) then
- FOutlookControl.ActivePage := Page;
-
- FOutlookControl.Repaint;
- finally
- UniqeCategorys.Free;
- end;
- end;
-
- function TrmOutlookActionLink.BothAssigned: Boolean;
- begin
- result := ((FActionList <> nil) and (FOutlookControl <> nil));
- if not result then
- begin
- if FActionList = nil then
- MessageDlg('An ActionList must be assigned', mtInformation, [mbok], 0);
-
- if FOutlookControl = nil then
- MessageDlg('An rmOutlookControl must be assigned', mtInformation, [mbok], 0);
- end;
- end;
-
- procedure TrmOutlookActionLink.Notification(AComponent: TComponent;
- Operation: TOperation);
- begin
- inherited;
- if Operation = opRemove then
- begin
- if (AComponent is TrmOutlookControl) and (AComponent = FOutlookControl) then
- FOutlookControl := nil;
-
- if (AComponent is TActionList) and (AComponent = FActionList) then
- FActionList := nil;
- end;
- end;
-
- procedure TrmOutlookActionLink.SetActionList(const Value: TActionList) ;
- begin
- FActionList := Value;
- if FActionList <> nil then
- FActionList.FreeNotification(self);
- end;
-
- procedure TrmOutlookActionLink.SetOutlookControl(const Value: TrmOutlookControl) ;
- begin
- FOutlookControl := Value;
- if FOutLookControl <> nil then
- FOutlookControl.FreeNotification(self);
- end;
-
- procedure TrmOutlookActionLink.SetViewStyle(const Value: TOLViewStyle) ;
- begin
- FViewStyle := Value;
- end;
-
- end.
-
-
-
-