home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 October / Chip_2001-10_cd1.bin / zkuste / delphi / nastroje / d23456 / SPLBASE.ZIP / Splbase / Activex / SplBaseImpl1.pas < prev    next >
Pascal/Delphi Source File  |  2001-07-12  |  10KB  |  368 lines

  1. unit SplBaseImpl1;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, ActiveX, Classes, Controls, Graphics, Menus, Forms, StdCtrls,
  7.   ComServ, StdVCL, AXCtrls, SplBaseXControl1_TLB, splx;
  8.  
  9. type
  10.   TSplBaseX = class(TActiveXControl, ISplBaseX)
  11.   private
  12.     { Private declarations }
  13.     FDelphiControl: tsplx;
  14.     FEvents: ISplBaseXEvents;
  15.     procedure CreateErrorEvent(Sender: TObject);
  16.     procedure OpenErrorEvent(Sender: TObject);
  17.     procedure ReadErrorEvent(Sender: TObject);
  18.     procedure WriteErrorEvent(Sender: TObject);
  19.   protected
  20.     { Protected declarations }
  21.     procedure DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage); override;
  22.     procedure EventSinkChanged(const EventSink: IUnknown); override;
  23.     procedure InitializeControl; override;
  24.     function activedb: WordBool; safecall;
  25.     function activerec: WordBool; safecall;
  26.     function addfield(const recdat: WideString; pos: Integer): WordBool;
  27.       safecall;
  28.     function addrec(const idx: WideString): WordBool; safecall;
  29.     function ClassNameIs(const Name: WideString): WordBool; safecall;
  30.     function createspl(const splname: WideString): WordBool; safecall;
  31.     function dbempty: WordBool; safecall;
  32.     function delrec: WordBool; safecall;
  33.     function DrawTextBiDiModeFlags(Flags: Integer): Integer; safecall;
  34.     function DrawTextBiDiModeFlagsReadingOnly: Integer; safecall;
  35.     function firstrec: WordBool; safecall;
  36.     function Get_BiDiMode: TxBiDiMode; safecall;
  37.     function Get_CurrentDB: WideString; safecall;
  38.     function Get_Cursor: Smallint; safecall;
  39.     function Get_DoubleBuffered: WordBool; safecall;
  40.     function Get_Enabled: WordBool; safecall;
  41.     function Get_ErrorNumber: Integer; safecall;
  42.     function Get_ErrorString: WideString; safecall;
  43.     function Get_FieldCount: Integer; safecall;
  44.     function Get_Reclimit: Integer; safecall;
  45.     function Get_Visible: WordBool; safecall;
  46.     function GetControlsAlignment: TxAlignment; safecall;
  47.     function getfield(pos: Integer): WideString; safecall;
  48.     function getrec(const idx: WideString): WordBool; safecall;
  49.     function initbase: WordBool; safecall;
  50.     function initspl: WordBool; safecall;
  51.     function IsRightToLeft: WordBool; safecall;
  52.     function lastrec: WordBool; safecall;
  53.     function modrec(const idx: WideString): WordBool; safecall;
  54.     function nextrec: WordBool; safecall;
  55.     function openspl(const splname: WideString): WordBool; safecall;
  56.     function prevrec: WordBool; safecall;
  57.     function reccount: Integer; safecall;
  58.     function releasespl: WordBool; safecall;
  59.     function setspl(const spldat: WideString): WordBool; safecall;
  60.     function UseRightToLeftAlignment: WordBool; safecall;
  61.     function UseRightToLeftReading: WordBool; safecall;
  62.     function UseRightToLeftScrollBar: WordBool; safecall;
  63.     procedure FlipChildren(AllLevels: WordBool); safecall;
  64.     procedure InitiateAction; safecall;
  65.     procedure Set_BiDiMode(Value: TxBiDiMode); safecall;
  66.     procedure Set_CurrentDB(const Value: WideString); safecall;
  67.     procedure Set_Cursor(Value: Smallint); safecall;
  68.     procedure Set_DoubleBuffered(Value: WordBool); safecall;
  69.     procedure Set_Enabled(Value: WordBool); safecall;
  70.     procedure Set_Reclimit(Value: Integer); safecall;
  71.     procedure Set_Visible(Value: WordBool); safecall;
  72.   end;
  73.  
  74. implementation
  75.  
  76. uses ComObj;
  77.  
  78. { TSplBaseX }
  79.  
  80. procedure TSplBaseX.DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage);
  81. begin
  82.   { Define property pages here.  Property pages are defined by calling
  83.     DefinePropertyPage with the class id of the page.  For example,
  84.       DefinePropertyPage(Class_SplBaseXPage); }
  85. end;
  86.  
  87. procedure TSplBaseX.EventSinkChanged(const EventSink: IUnknown);
  88. begin
  89.   FEvents := EventSink as ISplBaseXEvents;
  90. end;
  91.  
  92. procedure TSplBaseX.InitializeControl;
  93. begin
  94.   FDelphiControl := Control as tsplx;
  95.   FDelphiControl.OnCreateError := CreateErrorEvent;
  96.   FDelphiControl.OnOpenError := OpenErrorEvent;
  97.   FDelphiControl.OnReadError := ReadErrorEvent;
  98.   FDelphiControl.OnWriteError := WriteErrorEvent;
  99. end;
  100.  
  101. function TSplBaseX.activedb: WordBool;
  102. begin
  103.   Result := FDelphiControl.activedb;
  104. end;
  105.  
  106. function TSplBaseX.activerec: WordBool;
  107. begin
  108.   Result := FDelphiControl.activerec;
  109. end;
  110.  
  111. function TSplBaseX.addfield(const recdat: WideString;
  112.   pos: Integer): WordBool;
  113. begin
  114.   Result := FDelphiControl.addfield(recdat, pos);
  115. end;
  116.  
  117. function TSplBaseX.addrec(const idx: WideString): WordBool;
  118. begin
  119.   Result := FDelphiControl.addrec(idx);
  120. end;
  121.  
  122. function TSplBaseX.ClassNameIs(const Name: WideString): WordBool;
  123. begin
  124.   Result := FDelphiControl.ClassNameIs(Name);
  125. end;
  126.  
  127. function TSplBaseX.createspl(const splname: WideString): WordBool;
  128. begin
  129.   Result := FDelphiControl.createspl(splname);
  130. end;
  131.  
  132. function TSplBaseX.dbempty: WordBool;
  133. begin
  134.   Result := FDelphiControl.dbempty;
  135. end;
  136.  
  137. function TSplBaseX.delrec: WordBool;
  138. begin
  139.   Result := FDelphiControl.delrec;
  140. end;
  141.  
  142. function TSplBaseX.DrawTextBiDiModeFlags(Flags: Integer): Integer;
  143. begin
  144.   Result := FDelphiControl.DrawTextBiDiModeFlags(Flags);
  145. end;
  146.  
  147. function TSplBaseX.DrawTextBiDiModeFlagsReadingOnly: Integer;
  148. begin
  149.   Result := FDelphiControl.DrawTextBiDiModeFlagsReadingOnly;
  150. end;
  151.  
  152. function TSplBaseX.firstrec: WordBool;
  153. begin
  154.   Result := FDelphiControl.firstrec;
  155. end;
  156.  
  157. function TSplBaseX.Get_BiDiMode: TxBiDiMode;
  158. begin
  159.   Result := Ord(FDelphiControl.BiDiMode);
  160. end;
  161.  
  162. function TSplBaseX.Get_CurrentDB: WideString;
  163. begin
  164.   Result := WideString(FDelphiControl.CurrentDB);
  165. end;
  166.  
  167. function TSplBaseX.Get_Cursor: Smallint;
  168. begin
  169.   Result := Smallint(FDelphiControl.Cursor);
  170. end;
  171.  
  172. function TSplBaseX.Get_DoubleBuffered: WordBool;
  173. begin
  174.   Result := FDelphiControl.DoubleBuffered;
  175. end;
  176.  
  177. function TSplBaseX.Get_Enabled: WordBool;
  178. begin
  179.   Result := FDelphiControl.Enabled;
  180. end;
  181.  
  182. function TSplBaseX.Get_ErrorNumber: Integer;
  183. begin
  184.   Result := FDelphiControl.ErrorNumber;
  185. end;
  186.  
  187. function TSplBaseX.Get_ErrorString: WideString;
  188. begin
  189.   Result := WideString(FDelphiControl.ErrorString);
  190. end;
  191.  
  192. function TSplBaseX.Get_FieldCount: Integer;
  193. begin
  194.   Result := FDelphiControl.FieldCount;
  195. end;
  196.  
  197. function TSplBaseX.Get_Reclimit: Integer;
  198. begin
  199.   Result := FDelphiControl.Reclimit;
  200. end;
  201.  
  202. function TSplBaseX.Get_Visible: WordBool;
  203. begin
  204.   Result := FDelphiControl.Visible;
  205. end;
  206.  
  207. function TSplBaseX.GetControlsAlignment: TxAlignment;
  208. begin
  209.  Result := TxAlignment(FDelphiControl.GetControlsAlignment);
  210. end;
  211.  
  212. function TSplBaseX.getfield(pos: Integer): WideString;
  213. begin
  214.   Result := FDelphiControl.getfield(pos);
  215. end;
  216.  
  217. function TSplBaseX.getrec(const idx: WideString): WordBool;
  218. begin
  219.   Result := FDelphiControl.getrec(idx);
  220. end;
  221.  
  222. function TSplBaseX.initbase: WordBool;
  223. begin
  224.   Result := FDelphiControl.initbase;
  225. end;
  226.  
  227. function TSplBaseX.initspl: WordBool;
  228. begin
  229.   Result := FDelphiControl.initspl;
  230. end;
  231.  
  232. function TSplBaseX.IsRightToLeft: WordBool;
  233. begin
  234.   Result := FDelphiControl.IsRightToLeft;
  235. end;
  236.  
  237. function TSplBaseX.lastrec: WordBool;
  238. begin
  239.   Result := FDelphiControl.lastrec;
  240. end;
  241.  
  242. function TSplBaseX.modrec(const idx: WideString): WordBool;
  243. begin
  244.   Result := FDelphiControl.modrec(idx);
  245. end;
  246.  
  247. function TSplBaseX.nextrec: WordBool;
  248. begin
  249.   Result := FDelphiControl.nextrec;
  250. end;
  251.  
  252. function TSplBaseX.openspl(const splname: WideString): WordBool;
  253. begin
  254.   Result := FDelphiControl.openspl(splname);
  255. end;
  256.  
  257. function TSplBaseX.prevrec: WordBool;
  258. begin
  259.   Result := FDelphiControl.prevrec;
  260. end;
  261.  
  262. function TSplBaseX.reccount: Integer;
  263. begin
  264.   Result := FDelphiControl.reccount;
  265. end;
  266.  
  267. function TSplBaseX.releasespl: WordBool;
  268. begin
  269.   Result := FDelphiControl.releasespl;
  270. end;
  271.  
  272. function TSplBaseX.setspl(const spldat: WideString): WordBool;
  273. begin
  274.   Result := FDelphiControl.setspl(spldat);
  275. end;
  276.  
  277. function TSplBaseX.UseRightToLeftAlignment: WordBool;
  278. begin
  279.   Result := FDelphiControl.UseRightToLeftAlignment;
  280. end;
  281.  
  282. function TSplBaseX.UseRightToLeftReading: WordBool;
  283. begin
  284.   Result := FDelphiControl.UseRightToLeftReading;
  285. end;
  286.  
  287. function TSplBaseX.UseRightToLeftScrollBar: WordBool;
  288. begin
  289.   Result := FDelphiControl.UseRightToLeftScrollBar;
  290. end;
  291.  
  292. procedure TSplBaseX.FlipChildren(AllLevels: WordBool);
  293. begin
  294.   FDelphiControl.FlipChildren(AllLevels);
  295. end;
  296.  
  297. procedure TSplBaseX.InitiateAction;
  298. begin
  299.   FDelphiControl.InitiateAction;
  300. end;
  301.  
  302. procedure TSplBaseX.Set_BiDiMode(Value: TxBiDiMode);
  303. begin
  304.   FDelphiControl.BiDiMode := TBiDiMode(Value);
  305. end;
  306.  
  307. procedure TSplBaseX.Set_CurrentDB(const Value: WideString);
  308. begin
  309.   FDelphiControl.CurrentDB := String(Value);
  310. end;
  311.  
  312. procedure TSplBaseX.Set_Cursor(Value: Smallint);
  313. begin
  314.   FDelphiControl.Cursor := TCursor(Value);
  315. end;
  316.  
  317. procedure TSplBaseX.Set_DoubleBuffered(Value: WordBool);
  318. begin
  319.   FDelphiControl.DoubleBuffered := Value;
  320. end;
  321.  
  322. procedure TSplBaseX.Set_Enabled(Value: WordBool);
  323. begin
  324.   FDelphiControl.Enabled := Value;
  325. end;
  326.  
  327. procedure TSplBaseX.Set_Reclimit(Value: Integer);
  328. begin
  329.   FDelphiControl.Reclimit := Value;
  330. end;
  331.  
  332. procedure TSplBaseX.Set_Visible(Value: WordBool);
  333. begin
  334.   FDelphiControl.Visible := Value;
  335. end;
  336.  
  337. procedure TSplBaseX.CreateErrorEvent(Sender: TObject);
  338. begin
  339.   if FEvents <> nil then FEvents.OnCreateError;
  340. end;
  341.  
  342. procedure TSplBaseX.OpenErrorEvent(Sender: TObject);
  343. begin
  344.   if FEvents <> nil then FEvents.OnOpenError;
  345. end;
  346.  
  347. procedure TSplBaseX.ReadErrorEvent(Sender: TObject);
  348. begin
  349.   if FEvents <> nil then FEvents.OnReadError;
  350. end;
  351.  
  352. procedure TSplBaseX.WriteErrorEvent(Sender: TObject);
  353. begin
  354.   if FEvents <> nil then FEvents.OnWriteError;
  355. end;
  356.  
  357. initialization
  358.   TActiveXControlFactory.Create(
  359.     ComServer,
  360.     TSplBaseX,
  361.     tsplx,
  362.     Class_SplBaseX,
  363.     1,
  364.     '',
  365.     0,
  366.     tmSingle);
  367. end.
  368.