source: cprs/branches/tmg-cprs/CPRS-Chart/TMG_Extra/HTMLEdit/EmbeddedED/UEditHost.~pas@ 834

Last change on this file since 834 was 541, checked in by Kevin Toppenberg, 15 years ago

TMG Ver 1.1 Added HTML Support, better demographics editing

File size: 7.0 KB
RevLine 
[541]1{ ******************************************** }
2{ UEditHost ver 1.0 (Oct. 10, 2003) }
3{ }
4{ For Delphi 4, 5 and 6 }
5{ }
6{ Copyright (C) 1999-2003, Kurt Senfer. }
7{ All Rights Reserved. }
8{ }
9{ Support@ks.helpware.net }
10{ }
11{ Documentation and updated versions: }
12{ }
13{ http://KS.helpware.net }
14{ }
15{ ******************************************** }
16{
17 This library is free software; you can redistribute it and/or
18 modify it under the terms of the GNU Lesser General Public
19 License as published by the Free Software Foundation; either
20 version 2.1 of the License, or (at your option) any later version.
21
22 This library is distributed in the hope that it will be useful,
23 but WITHOUT ANY WARRANTY; without even the implied warranty of
24 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
25 Lesser General Public License for more details.
26
27 You should have received a copy of the GNU Lesser General Public
28 License along with this library; if not, write to the Free Software
29 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
30}
31
32
33unit UEditHost;
34
35//this unit implements a combined IHTMLEditHost & IHTMLEditHost2 interface.
36
37interface
38
39uses
40 windows, Classes, mshtml_tlb, EmbeddedED;
41
42type
43
44 //this is only declared if IE 6 is imported to mshtml_tlb
45 IHTMLEditHost2 = interface(IHTMLEditHost)
46 ['{3050F848-98B5-11CF-BB82-00AA00BDCE0D}']
47 function PreDrag: HResult; stdcall;
48 end;
49
50 TEditHost = class(TInterfacedObject, IHTMLEditHost, IHTMLEditHost2)
51 private
52 function SnapRect(const pIElement: IHTMLElement; var prcNew: tagRECT; eHandle: _ELEMENT_CORNER): HResult; stdcall;
53 function PreDrag: HResult; stdcall;
54
55 public
56 FSnapEnabled: Boolean;
57 FGridX: Integer;
58 FGridY: Integer;
59 FExtSnapRect: TSnapRect;
60 FOnPreDrag: TNotifyEventEx;
61 constructor Create(Ovner: TEmbeddedED);
62 procedure BeforeDestruction; override;
63 function QueryService(const rsid, iid: TGuid; out Obj): HResult;
64 end;
65
66implementation
67 uses ActiveX, ComObj, IeConst;
68
69const
70 SID_SHTMLEditHost: TGUID = '{3050F6A0-98B5-11CF-BB82-00AA00BDCE0B}';
71
72//------------------------------------------------------------------------------
73function TEditHost.QueryService(const rsid, iid: TGuid; out Obj): HResult;
74const
75 IID_IHTMLEditHost2: TGUID = '{3050F848-98B5-11CF-BB82-00AA00BDCE0D}';
76begin
77 //asm int 3 end; //trap
78 //we only come heir if TEmbeddedED is queryed for SID_SHTMLEDitHost
79
80 //MSHTML asks either for a IHTMLEditHost or a IHTMLEditHost2
81 if IsEqualGUID(iid, IID_IHTMLEditHost2)
82 then IUnknown(obj) := self as IHTMLEditHost2 //new in IE 6
83 else IUnknown(obj) := self as IHTMLEditHost;
84
85 Result := S_OK;
86end;
87//------------------------------------------------------------------------------
88function TEditHost.PreDrag: HResult; stdcall;
89var
90 Cancel: Boolean;
91begin
92 //asm int 3 end; //trap
93
94 result := S_OK;
95
96 if assigned(FOnPreDrag)
97 then begin
98 FOnPreDrag(Self, Cancel);
99 if not Cancel
100 then result := S_FALSE;
101 end;
102end;
103//------------------------------------------------------------------------------
104function TEditHost.SnapRect(const pIElement: IHTMLElement; var prcNew: tagRECT; eHandle: _ELEMENT_CORNER): HResult; stdcall;
105
106 //-------------------------------------------------------------
107 function GetNextAviablePoint(aPoint, GridSpacing, Offset: integer): Integer;
108 begin
109 result := ((aPoint + (GridSpacing div 2)) div GridSpacing) * GridSpacing + Offset;
110 end;
111 //-------------------------------------------------------------
112var
113 Width : Integer;
114 Height: Integer;
115 aElement: IHTMLElement2;
116
117 P: tagPOINT;
118 Pr: tagRECT;
119 aDisplays: IDisplayServices;
120 aevent: IHTMLEventObj;
121begin
122 //asm int 3 end; //trap
123
124 If assigned(FExtSnapRect)
125 then begin
126 FExtSnapRect(Self, pIElement, prcNew, eHandle, Result);
127 exit;
128 end;
129
130
131 //dont snap if not enabled or the Control key is down
132 if (not FSnapEnabled) or (GetAsyncKeyState(VK_CONTROL) < 0)
133 then begin
134 result := S_FALSE; //do default handling
135 exit;
136 end;
137
138 result := S_OK;
139
140 case eHandle of
141 ELEMENT_CORNER_NONE: // Code for moving the element
142 begin
143 Width := prcNew.right - prcNew.left;
144 Height := prcNew.bottom - prcNew.top;
145
146 prcNew.top := GetNextAviablePoint(prcNew.top, FGridY, -2);
147 prcNew.left := GetNextAviablePoint(prcNew.left, FGridX, -2);
148 prcNew.bottom := prcNew.top + Height;
149 prcNew.right := prcNew.left + Width;
150 end;
151
152 ELEMENT_CORNER_TOP: // Code for resizing the element
153 prcNew.top := GetNextAviablePoint(prcNew.top, FGridY, -2);
154
155 ELEMENT_CORNER_LEFT: // Code for resizing the element
156 prcNew.left := GetNextAviablePoint(prcNew.left, FGridX, -2);
157
158 ELEMENT_CORNER_BOTTOM: // Code for resizing the element
159 prcNew.bottom := GetNextAviablePoint(prcNew.bottom, FGridY, 1);
160
161 ELEMENT_CORNER_RIGHT: // Code for resizing the element
162 prcNew.right := GetNextAviablePoint(prcNew.right, FGridX, 1);
163
164 ELEMENT_CORNER_TOPLEFT: // Code for resizing the element
165 begin
166 prcNew.top := GetNextAviablePoint(prcNew.top, FGridY, -2);
167 prcNew.left := GetNextAviablePoint(prcNew.left, FGridX, -2);
168 end;
169
170 ELEMENT_CORNER_TOPRIGHT: // Code for resizing the element
171 begin
172 prcNew.top := GetNextAviablePoint(prcNew.top, FGridY, -2);
173 prcNew.right := GetNextAviablePoint(prcNew.right, FGridX, 1);
174 end;
175
176 ELEMENT_CORNER_BOTTOMLEFT: // Code for resizing the element
177 begin
178 prcNew.left := GetNextAviablePoint(prcNew.left, FGridX, -2);
179 prcNew.bottom := GetNextAviablePoint(prcNew.bottom, FGridY, 1);
180 end;
181
182 ELEMENT_CORNER_BOTTOMRIGHT: // Code for resizing the element
183 begin
184 prcNew.bottom := GetNextAviablePoint(prcNew.bottom, FGridY, 1);
185 prcNew.right := GetNextAviablePoint(prcNew.right, FGridX, 1);
186 end;
187 end;
188end;
189//------------------------------------------------------------------------------
190constructor TEditHost.Create(Ovner: TEmbeddedED);
191begin
192 Inherited Create;
193 _AddRef; //dont die automatically
194end;
195//------------------------------------------------------------------------------
196procedure TEditHost.BeforeDestruction;
197begin
198 FRefCount := 0;
199end;
200//------------------------------------------------------------------------------
201end.
202
Note: See TracBrowser for help on using the repository browser.