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

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

TMG Ver 1.1 Added HTML Support, better demographics editing

File size: 7.1 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,
41 //kt mshtml_tlb,
42 MSHTML_EWB,
43 EmbeddedED;
44
45type
46 tagRECT = TRect; //kt
47
48 //this is only declared if IE 6 is imported to mshtml_tlb
49 IHTMLEditHost2 = interface(IHTMLEditHost)
50 ['{3050F848-98B5-11CF-BB82-00AA00BDCE0D}']
51 function PreDrag: HResult; stdcall;
52 end;
53
54 TEditHost = class(TInterfacedObject, IHTMLEditHost, IHTMLEditHost2)
55 private
56 function SnapRect(const pIElement: IHTMLElement; var prcNew: tagRECT; eHandle: _ELEMENT_CORNER): HResult; stdcall;
57 function PreDrag: HResult; stdcall;
58
59 public
60 FSnapEnabled: Boolean;
61 FGridX: Integer;
62 FGridY: Integer;
63 //kt FExtSnapRect: TSnapRect;
64 FOnPreDrag: TNotifyEventEx;
65 constructor Create(Ovner: TEmbeddedED);
66 procedure BeforeDestruction; override;
67 function QueryService(const rsid, iid: TGuid; out Obj): HResult;
68 end;
69
70implementation
71 uses ActiveX, ComObj, IeConst;
72
73const
74 SID_SHTMLEditHost: TGUID = '{3050F6A0-98B5-11CF-BB82-00AA00BDCE0B}';
75
76//------------------------------------------------------------------------------
77function TEditHost.QueryService(const rsid, iid: TGuid; out Obj): HResult;
78const
79 IID_IHTMLEditHost2: TGUID = '{3050F848-98B5-11CF-BB82-00AA00BDCE0D}';
80begin
81 //asm int 3 end; //trap
82 //we only come heir if TEmbeddedED is queryed for SID_SHTMLEDitHost
83
84 //MSHTML asks either for a IHTMLEditHost or a IHTMLEditHost2
85 if IsEqualGUID(iid, IID_IHTMLEditHost2)
86 then IUnknown(obj) := self as IHTMLEditHost2 //new in IE 6
87 else IUnknown(obj) := self as IHTMLEditHost;
88
89 Result := S_OK;
90end;
91//------------------------------------------------------------------------------
92function TEditHost.PreDrag: HResult; stdcall;
93var
94 Cancel: Boolean;
95begin
96 //asm int 3 end; //trap
97
98 result := S_OK;
99
100 if assigned(FOnPreDrag)
101 then begin
102 FOnPreDrag(Self, Cancel);
103 if not Cancel
104 then result := S_FALSE;
105 end;
106end;
107
108//------------------------------------------------------------------------------
109function TEditHost.SnapRect(const pIElement: IHTMLElement; var prcNew: tagRECT; eHandle: _ELEMENT_CORNER): HResult; stdcall;
110
111 //-------------------------------------------------------------
112 function GetNextAviablePoint(aPoint, GridSpacing, Offset: integer): Integer;
113 begin
114 result := ((aPoint + (GridSpacing div 2)) div GridSpacing) * GridSpacing + Offset;
115 end;
116 //-------------------------------------------------------------
117var
118 Width : Integer;
119 Height: Integer;
120 aElement: IHTMLElement2;
121
122 P: tagPOINT;
123 Pr: tagRECT;
124 aDisplays: IDisplayServices;
125 aevent: IHTMLEventObj;
126begin
127 //asm int 3 end; //trap
128
129 { //kt
130 If assigned(FExtSnapRect)
131 then begin
132 FExtSnapRect(Self, pIElement, prcNew, eHandle, Result);
133 exit;
134 end;
135 }
136
137 //dont snap if not enabled or the Control key is down
138 if (not FSnapEnabled) or (GetAsyncKeyState(VK_CONTROL) < 0)
139 then begin
140 result := S_FALSE; //do default handling
141 exit;
142 end;
143
144 result := S_OK;
145
146 case eHandle of
147 ELEMENT_CORNER_NONE: // Code for moving the element
148 begin
149 Width := prcNew.right - prcNew.left;
150 Height := prcNew.bottom - prcNew.top;
151
152 prcNew.top := GetNextAviablePoint(prcNew.top, FGridY, -2);
153 prcNew.left := GetNextAviablePoint(prcNew.left, FGridX, -2);
154 prcNew.bottom := prcNew.top + Height;
155 prcNew.right := prcNew.left + Width;
156 end;
157
158 ELEMENT_CORNER_TOP: // Code for resizing the element
159 prcNew.top := GetNextAviablePoint(prcNew.top, FGridY, -2);
160
161 ELEMENT_CORNER_LEFT: // Code for resizing the element
162 prcNew.left := GetNextAviablePoint(prcNew.left, FGridX, -2);
163
164 ELEMENT_CORNER_BOTTOM: // Code for resizing the element
165 prcNew.bottom := GetNextAviablePoint(prcNew.bottom, FGridY, 1);
166
167 ELEMENT_CORNER_RIGHT: // Code for resizing the element
168 prcNew.right := GetNextAviablePoint(prcNew.right, FGridX, 1);
169
170 ELEMENT_CORNER_TOPLEFT: // Code for resizing the element
171 begin
172 prcNew.top := GetNextAviablePoint(prcNew.top, FGridY, -2);
173 prcNew.left := GetNextAviablePoint(prcNew.left, FGridX, -2);
174 end;
175
176 ELEMENT_CORNER_TOPRIGHT: // Code for resizing the element
177 begin
178 prcNew.top := GetNextAviablePoint(prcNew.top, FGridY, -2);
179 prcNew.right := GetNextAviablePoint(prcNew.right, FGridX, 1);
180 end;
181
182 ELEMENT_CORNER_BOTTOMLEFT: // Code for resizing the element
183 begin
184 prcNew.left := GetNextAviablePoint(prcNew.left, FGridX, -2);
185 prcNew.bottom := GetNextAviablePoint(prcNew.bottom, FGridY, 1);
186 end;
187
188 ELEMENT_CORNER_BOTTOMRIGHT: // Code for resizing the element
189 begin
190 prcNew.bottom := GetNextAviablePoint(prcNew.bottom, FGridY, 1);
191 prcNew.right := GetNextAviablePoint(prcNew.right, FGridX, 1);
192 end;
193 end;
194end;
195
196
197//------------------------------------------------------------------------------
198constructor TEditHost.Create(Ovner: TEmbeddedED);
199begin
200 Inherited Create;
201 _AddRef; //dont die automatically
202end;
203//------------------------------------------------------------------------------
204procedure TEditHost.BeforeDestruction;
205begin
206 FRefCount := 0;
207end;
208//------------------------------------------------------------------------------
209end.
210
Note: See TracBrowser for help on using the repository browser.