[541] | 1 | //*************************************************************
|
---|
| 2 | // EwbActns *
|
---|
| 3 | // *
|
---|
| 4 | // Freeware unit *
|
---|
| 5 | // For Delphi *
|
---|
| 6 | // by *
|
---|
| 7 | // Serge Voloshenyuk *
|
---|
| 8 | // Developing Team: *
|
---|
| 9 | // Serge Voloshenyuk (SergeV@bsalsa.com) *
|
---|
| 10 | // Eran Bodankin (bsalsa) -(bsalsa@gmail.com) *
|
---|
| 11 | // *
|
---|
| 12 | // Documentation and updated versions: *
|
---|
| 13 | // *
|
---|
| 14 | // http://www.bsalsa.com *
|
---|
| 15 | //*************************************************************
|
---|
| 16 | {LICENSE:
|
---|
| 17 | THIS SOFTWARE IS PROVIDED TO YOU "AS IS" WITHOUT WARRANTY OF ANY KIND,
|
---|
| 18 | EITHER EXPRESSED OR IMPLIED INCLUDING BUT NOT LIMITED TO THE APPLIED
|
---|
| 19 | WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
|
---|
| 20 | YOU ASSUME THE ENTIRE RISK AS TO THE ACCURACY AND THE USE OF THE SOFTWARE
|
---|
| 21 | AND ALL OTHER RISK ARISING OUT OF THE USE OR PERFORMANCE OF THIS SOFTWARE
|
---|
| 22 | AND DOCUMENTATION. BSALSA PRODUCTIONS DOES NOT WARRANT THAT THE SOFTWARE IS ERROR-FREE
|
---|
| 23 | OR WILL OPERATE WITHOUT INTERRUPTION. THE SOFTWARE IS NOT DESIGNED, INTENDED
|
---|
| 24 | OR LICENSED FOR USE IN HAZARDOUS ENVIRONMENTS REQUIRING FAIL-SAFE CONTROLS,
|
---|
| 25 | INCLUDING WITHOUT LIMITATION, THE DESIGN, CONSTRUCTION, MAINTENANCE OR
|
---|
| 26 | OPERATION OF NUCLEAR FACILITIES, AIRCRAFT NAVIGATION OR COMMUNICATION SYSTEMS,
|
---|
| 27 | AIR TRAFFIC CONTROL, AND LIFE SUPPORT OR WEAPONS SYSTEMS. BSALSA PRODUCTIONS SPECIFICALLY
|
---|
| 28 | DISCLAIMS ANY EXPRESS OR IMPLIED WARRANTY OF FITNESS FOR SUCH PURPOSE.
|
---|
| 29 |
|
---|
| 30 | You may use/ change/ modify the component under 3 conditions:
|
---|
| 31 | 1. In your website, add a link to "http://www.bsalsa.com"
|
---|
| 32 | 2. In your application, add credits to "Embedded Web Browser"
|
---|
| 33 | 3. Mail me (bsalsa@gmail.com) any code change in the unit for the benefit
|
---|
| 34 | of the other users.
|
---|
| 35 | 4. Please, consider donation in our web site!
|
---|
| 36 | {*******************************************************************************}
|
---|
| 37 | //$Id: EwbActns.pas,v 1.1.2.1 2006/11/29 22:13:00 sergev Exp $
|
---|
| 38 |
|
---|
| 39 | unit EwbActns;
|
---|
| 40 |
|
---|
| 41 | {$I EWB.inc}
|
---|
| 42 |
|
---|
| 43 | interface
|
---|
| 44 |
|
---|
| 45 | uses
|
---|
| 46 | Classes, ActnList, EwbCore;
|
---|
| 47 |
|
---|
| 48 | type
|
---|
| 49 | TEwbAction = class(TCustomAction)
|
---|
| 50 | private
|
---|
| 51 | FControl: TEwbCore;
|
---|
| 52 | procedure SetControl(Value: TEwbCore);
|
---|
| 53 | protected
|
---|
| 54 | function GetControl(Target: TObject): TEwbCore; virtual;
|
---|
| 55 | procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
---|
| 56 | public
|
---|
| 57 | destructor Destroy; override;
|
---|
| 58 | function HandlesTarget(Target: TObject): Boolean; override;
|
---|
| 59 | property Control: TEwbCore read FControl write SetControl;
|
---|
| 60 | end;
|
---|
| 61 |
|
---|
| 62 | TEwbLinkAction = class(TEwbAction)
|
---|
| 63 | private
|
---|
| 64 | FURL: WideString;
|
---|
| 65 | procedure setURL(const Value: WideString);
|
---|
| 66 | public
|
---|
| 67 | procedure ExecuteTarget(Target: TObject); override;
|
---|
| 68 | constructor Create(AOwner: TComponent); override;
|
---|
| 69 | published
|
---|
| 70 | property URL: WideString read FURL write setURL;
|
---|
| 71 | property Caption;
|
---|
| 72 | property HelpContext;
|
---|
| 73 | {$IFDEF DELPHI6_UP}
|
---|
| 74 | property HelpKeyword;
|
---|
| 75 | property HelpType;
|
---|
| 76 | property SecondaryShortCuts;
|
---|
| 77 | {$ENDIF}
|
---|
| 78 | property Hint;
|
---|
| 79 | property ImageIndex;
|
---|
| 80 | property ShortCut;
|
---|
| 81 | property Visible;
|
---|
| 82 | property OnExecute;
|
---|
| 83 | property OnHint;
|
---|
| 84 | property OnUpdate;
|
---|
| 85 | end;
|
---|
| 86 |
|
---|
| 87 | implementation
|
---|
| 88 |
|
---|
| 89 | { TEwbAction }
|
---|
| 90 |
|
---|
| 91 | destructor TEwbAction.Destroy;
|
---|
| 92 | begin
|
---|
| 93 | if FControl <> nil then
|
---|
| 94 | FControl.RemoveFreeNotification(Self);
|
---|
| 95 | inherited;
|
---|
| 96 | end;
|
---|
| 97 |
|
---|
| 98 | function TEwbAction.GetControl(Target: TObject): TEwbCore;
|
---|
| 99 | begin
|
---|
| 100 | Result := Target as TEwbCore;
|
---|
| 101 | end;
|
---|
| 102 |
|
---|
| 103 | function TEwbAction.HandlesTarget(Target: TObject): Boolean;
|
---|
| 104 | begin
|
---|
| 105 | Result := ((Control <> nil) and (Target = Control) or
|
---|
| 106 | (Control = nil) and (Target is TEwbCore))
|
---|
| 107 | { and TEwbCore(Target).Focused}; //FIXME
|
---|
| 108 | end;
|
---|
| 109 |
|
---|
| 110 | procedure TEwbAction.Notification(AComponent: TComponent;
|
---|
| 111 | Operation: TOperation);
|
---|
| 112 | begin
|
---|
| 113 | inherited Notification(AComponent, Operation);
|
---|
| 114 | if (Operation = opRemove) and (AComponent = Control) then Control := nil;
|
---|
| 115 | end;
|
---|
| 116 |
|
---|
| 117 | procedure TEwbAction.SetControl(Value: TEwbCore);
|
---|
| 118 | begin
|
---|
| 119 | if Value <> FControl then
|
---|
| 120 | begin
|
---|
| 121 | FControl := Value;
|
---|
| 122 | if Value <> nil then Value.FreeNotification(Self);
|
---|
| 123 | end;
|
---|
| 124 | end;
|
---|
| 125 |
|
---|
| 126 | { TEwbLinkAction }
|
---|
| 127 |
|
---|
| 128 | constructor TEwbLinkAction.Create(AOwner: TComponent);
|
---|
| 129 | begin
|
---|
| 130 | inherited;
|
---|
| 131 | Enabled := False;
|
---|
| 132 | end;
|
---|
| 133 |
|
---|
| 134 | procedure TEwbLinkAction.ExecuteTarget(Target: TObject);
|
---|
| 135 | begin
|
---|
| 136 | GetControl(Target).Navigate(Self.URL);
|
---|
| 137 | end;
|
---|
| 138 |
|
---|
| 139 | procedure TEwbLinkAction.setURL(const Value: WideString);
|
---|
| 140 | begin
|
---|
| 141 | FURL := Value;
|
---|
| 142 | Enabled := FURL <> '';
|
---|
| 143 | end;
|
---|
| 144 |
|
---|
| 145 | end.
|
---|