source: cprs/branches/tmg-cprs/TMG_Extra/tntUniCode/Source/TntAxCtrls.pas@ 1474

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

Adding source to tntControls for compilation

File size: 5.0 KB
Line 
1
2{*****************************************************************************}
3{ }
4{ Tnt Delphi Unicode Controls }
5{ http://www.tntware.com/delphicontrols/unicode/ }
6{ Version: 2.3.0 }
7{ }
8{ Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com) }
9{ }
10{*****************************************************************************}
11
12unit TntAxCtrls;
13
14{$INCLUDE TntCompilers.inc}
15
16interface
17
18uses
19 ComObj, StdVcl,
20 {$IFNDEF COMPILER_10_UP}
21 TntWideStrings,
22 {$ELSE}
23 WideStrings,
24 {$ENDIF}
25 TntClasses;
26
27type
28 TWideStringsAdapter = class(TAutoIntfObject, IStrings, IWideStringsAdapter)
29 private
30 FStrings: TWideStrings;
31 protected
32 { IWideStringsAdapter }
33 procedure ReferenceStrings(S: TWideStrings);
34 procedure ReleaseStrings;
35 { IStrings }
36 function Get_ControlDefault(Index: Integer): OleVariant; safecall;
37 procedure Set_ControlDefault(Index: Integer; Value: OleVariant); safecall;
38 function Count: Integer; safecall;
39 function Get_Item(Index: Integer): OleVariant; safecall;
40 procedure Set_Item(Index: Integer; Value: OleVariant); safecall;
41 procedure Remove(Index: Integer); safecall;
42 procedure Clear; safecall;
43 function Add(Item: OleVariant): Integer; safecall;
44 function _NewEnum: IUnknown; safecall;
45 public
46 constructor Create(Strings: TTntStrings);
47 end;
48
49implementation
50
51uses
52 Classes, ActiveX, Variants;
53
54{ TStringsEnumerator }
55
56type
57 TStringsEnumerator = class(TContainedObject, IEnumString)
58 private
59 FIndex: Integer; // index of next unread string
60 FStrings: IStrings;
61 public
62 constructor Create(const Strings: IStrings);
63 function Next(celt: Longint; out elt;
64 pceltFetched: PLongint): HResult; stdcall;
65 function Skip(celt: Longint): HResult; stdcall;
66 function Reset: HResult; stdcall;
67 function Clone(out enm: IEnumString): HResult; stdcall;
68 end;
69
70constructor TStringsEnumerator.Create(const Strings: IStrings);
71begin
72 inherited Create(Strings);
73 FStrings := Strings;
74end;
75
76function TStringsEnumerator.Next(celt: Longint; out elt; pceltFetched: PLongint): HResult;
77var
78 I: Integer;
79begin
80 I := 0;
81 while (I < celt) and (FIndex < FStrings.Count) do
82 begin
83 TPointerList(elt)[I] := PWideChar(WideString(FStrings.Item[FIndex]));
84 Inc(I);
85 Inc(FIndex);
86 end;
87 if pceltFetched <> nil then pceltFetched^ := I;
88 if I = celt then Result := S_OK else Result := S_FALSE;
89end;
90
91function TStringsEnumerator.Skip(celt: Longint): HResult;
92begin
93 if (FIndex + celt) <= FStrings.Count then
94 begin
95 Inc(FIndex, celt);
96 Result := S_OK;
97 end
98 else
99 begin
100 FIndex := FStrings.Count;
101 Result := S_FALSE;
102 end;
103end;
104
105function TStringsEnumerator.Reset: HResult;
106begin
107 FIndex := 0;
108 Result := S_OK;
109end;
110
111function TStringsEnumerator.Clone(out enm: IEnumString): HResult;
112begin
113 try
114 enm := TStringsEnumerator.Create(FStrings);
115 TStringsEnumerator(enm).FIndex := FIndex;
116 Result := S_OK;
117 except
118 Result := E_UNEXPECTED;
119 end;
120end;
121
122{ TWideStringsAdapter }
123
124constructor TWideStringsAdapter.Create(Strings: TTntStrings);
125var
126 StdVcl: ITypeLib;
127begin
128 OleCheck(LoadRegTypeLib(LIBID_STDVCL, 4, 0, 0, StdVcl));
129 inherited Create(StdVcl, IStrings);
130 FStrings := Strings;
131end;
132
133procedure TWideStringsAdapter.ReferenceStrings(S: TWideStrings);
134begin
135 FStrings := S;
136end;
137
138procedure TWideStringsAdapter.ReleaseStrings;
139begin
140 FStrings := nil;
141end;
142
143function TWideStringsAdapter.Get_ControlDefault(Index: Integer): OleVariant;
144begin
145 Result := Get_Item(Index);
146end;
147
148procedure TWideStringsAdapter.Set_ControlDefault(Index: Integer; Value: OleVariant);
149begin
150 Set_Item(Index, Value);
151end;
152
153function TWideStringsAdapter.Count: Integer;
154begin
155 Result := 0;
156 if FStrings <> nil then Result := FStrings.Count;
157end;
158
159function TWideStringsAdapter.Get_Item(Index: Integer): OleVariant;
160begin
161 Result := NULL;
162 if (FStrings <> nil) then Result := WideString(FStrings[Index]);
163end;
164
165procedure TWideStringsAdapter.Set_Item(Index: Integer; Value: OleVariant);
166begin
167 if (FStrings <> nil) then FStrings[Index] := Value;
168end;
169
170procedure TWideStringsAdapter.Remove(Index: Integer);
171begin
172 if FStrings <> nil then FStrings.Delete(Index);
173end;
174
175procedure TWideStringsAdapter.Clear;
176begin
177 if FStrings <> nil then FStrings.Clear;
178end;
179
180function TWideStringsAdapter.Add(Item: OleVariant): Integer;
181begin
182 Result := -1;
183 if FStrings <> nil then Result := FStrings.Add(Item);
184end;
185
186function TWideStringsAdapter._NewEnum: IUnknown;
187begin
188 Result := TStringsEnumerator.Create(Self);
189end;
190
191end.
Note: See TracBrowser for help on using the repository browser.