home *** CD-ROM | disk | FTP | other *** search
- unit Plotaction;
-
- interface
-
- uses
- Comctrls, Classes, Dialogs, ExtDlgs, ActnList, Plot, Misc;
-
- type
- { Generic TPlot action }
- TPlotAction = class(TAction)
- private
- FPlot: TPlot;
- procedure SetPlot(Value: TPlot);
- protected
- function GetPlot(Target: TObject): TPlot; virtual;
- procedure Notification(AComponent: TComponent; Operation: TOperation); override;
- public
- function HandlesTarget(Target: TObject):Boolean; override;
- published
- property Plot: TPlot read FPlot write SetPlot;
- end;
-
- TPlotActionList = class(TActionList)
- private
- FPlot: TPlot;
- function ActionExists(ATag: Integer; ACaption: String): Boolean;
- procedure SetPlot(Value: TPlot);
- protected
- function GetPlot(Target: TObject): TPlot; virtual;
- procedure Notification(AComponent: TComponent; Operation: TOperation); override;
- procedure CreateActions;
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- published
- property Plot: TPlot read FPlot write SetPlot;
- end;
-
- implementation
-
- { Check target object is a Plot }
- function TPlotAction.GetPlot(Target: TObject): TPlot;
- begin
- Result := Target as TPlot;
- end;
-
- { Set the Plot component to affect }
- procedure TPlotAction.SetPlot(Value: TPlot);
- begin
- if Value <> FPlot then
- begin
- FPlot := Value;
- if Value <> nil then
- Value.FreeNotification(Self);
- end;
- end;
-
- { Determine whether we can act on this target }
- function TPlotAction.HandlesTarget(Target: TObject): Boolean;
- begin
- Result := ((Plot <> nil) and (Target = Plot)) or
- ((Plot = nil) and (Target is TPlot));
- end;
-
- { Note deletion of attached Plot component }
- procedure TPlotAction.Notification(AComponent: TComponent;
- Operation: TOperation);
- begin
- inherited Notification(AComponent, Operation);
- if (Operation = opRemove) and (AComponent = Plot) then
- Plot := nil;
- end;
-
- {******************************************************************************}
- constructor TPlotActionList.Create(AOwner: TComponent);
- begin
- inherited Create(AOwner);
- FPlot := nil;
- end;
-
- destructor TPlotActionList.Destroy;
- begin
- inherited Destroy;
- end;
-
- { Check target object is a Plot }
- function TPlotActionList.GetPlot(Target: TObject): TPlot;
- begin
- Result := Target as TPlot;
- end;
-
- { Set the Plot component to affect }
- procedure TPlotActionList.SetPlot(Value: TPlot);
- begin
- if Value <> FPlot then
- begin
- if (Value = nil) then
- begin
- //FPlot.SetPlotActionList(TActionList(nil));
- FPlot := Value;
- end
- else
- begin
- FPlot := Value;
- Value.FreeNotification(Self);
- CreateActions;
- {SetUpOnClicks;}
- //FPlot.SetPlotActionList(TActionList(Self));
- end;
- end;
- end;
-
- { Note deletion of attached Plot component }
- procedure TPlotActionList.Notification(AComponent: TComponent;
- Operation: TOperation);
- begin
- inherited Notification(AComponent, Operation);
- if (Operation = opRemove) and (AComponent = Plot) then
- Plot := nil;
- end;
-
- {------------------------------------------------------------------------------
- Procedure: TPlotActionList.CreateActions
- Description: creates popup menus that are accessible by right-click
- Author: Mat Ballard
- Date created: 12/1/1999
- Date modified: 04/20/2000 by Mat Ballard
- Purpose: modularize user-interface code
- Known Issues: this was a bitch to get right !
- ------------------------------------------------------------------------------}
- procedure TPlotActionList.CreateActions;
- var
- i, j: Word;
- TempAction: TPlotAction;
- TheName: String;
- begin
- {don't create actions when the Plot property is streamed in:}
- if (csLoading in ComponentState) then exit;
-
- {who needs more than 32 menus ?!}
- if (FPlot.PlotPopupMenu.Items.Count > 32) then raise
- EComponentError.CreateFmt('TPlotActionList.CreateActions: I cannot handle more than %d Sub-menus !',
- [FPlot.PlotPopupMenu.Items.Count]);
-
- {create the main actions:}
- for i := 0 to FPlot.PlotPopupMenu.Items.Count-1 do
- begin
- {don't re-create a menu if it already exists:}
- if (not ActionExists(
- FPlot.PlotPopupMenu.Items[i].Tag,
- FPlot.PlotPopupMenu.Items[i].Caption)) then
- begin
- TempAction := TPlotAction.Create(Self);
- TempAction.Caption := FPlot.PlotPopupMenu.Items[i].Caption;
- TempAction.Name := Copy(TempAction.Caption, 2, 99) + 'Action';
- TempAction.Tag := FPlot.PlotPopupMenu.Items[i].Tag;
- TempAction.Category := Copy(TempAction.Caption, 2, 99);
- TempAction.ActionList := Self;
- end;
- end;
-
- {create the menus in each sub-menu:}
- for i := 0 to FPlot.PlotPopupMenu.Items.Count-1 do
- begin
- for j := 0 to FPlot.PlotPopupMenu.Items[i].Count-1 do
- begin
- if (FPlot.PlotPopupMenu.Items[i].Items[j].Caption <> '-') and
- (not ActionExists(
- FPlot.PlotPopupMenu.Items[i].Items[j].Tag,
- FPlot.PlotPopupMenu.Items[i].Items[j].Caption)) then
- begin
- TempAction := TPlotAction.Create(Self);
- TempAction.Caption := FPlot.PlotPopupMenu.Items[i].Items[j].Caption;
- TheName := CleanString(TempAction.Caption, '&');
- TheName := CleanString(TheName, ' ');
- TheName := CleanString(TheName, '.');
- TheName := CleanString(TheName, '!');
- TempAction.Name := TheName + 'Action';
- TempAction.Tag := FPlot.PlotPopupMenu.Items[i].Items[j].Tag;
- TempAction.Hint := FPlot.PlotPopupMenu.Items[i].Items[j].Hint;
- TempAction.ImageIndex := FPlot.PlotPopupMenu.Items[i].Items[j].ImageIndex;
- {add the TempAction:}
- TempAction.ActionList := Self;
- TempAction.Category := Self.Actions[i].Category;
- end;
- end; {j over menu items}
- end; {i over submenus}
- end;
-
- {------------------------------------------------------------------------------
- Function: TPlotAction.ActionExists
- Description: Does this Action exist ? Based on Tag and Caption
- Author: Mat Ballard
- Date created: 04/25/2000
- Date modified: 04/25/2000 by Mat Ballard
- Purpose: do we need to add a Action item ?
- Return Value: Boolean;
- Known Issues:
- ------------------------------------------------------------------------------}
- function TPlotActionList.ActionExists(ATag: Integer; ACaption: String): Boolean;
- var
- i: Integer;
- begin
- for i := 0 to Self.ActionCount-1 do
- begin
- if ((Self.Actions[i].Tag = ATag) and
- (TAction(Self.Actions[i]).Caption = ACaption)) then
- begin
- ActionExists := TRUE;
- exit;
- end;
- end;
- ActionExists := FALSE;
- end;
-
-
- end.
-