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

Last change on this file was 672, checked in by Kevin Toppenberg, 9 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.