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