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.
|
---|