ExamAppImpl1.pas
上传用户:psxgmh
上传日期:2013-04-08
资源大小:15112k
文件大小:9k
源码类别:

Delphi/CppBuilder

开发平台:

Delphi

  1. unit ExamAppImpl1;
  2. {$WARN SYMBOL_PLATFORM OFF}
  3. interface
  4. uses
  5.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  6.   ActiveX, AxCtrls, ExamAppProj1_TLB, StdVcl, ExtCtrls, DBCtrls, DB,
  7.   DBClient, MConnect, Grids, DBGrids;
  8. type
  9.   TExamApp = class(TActiveForm, IExamApp)
  10.     DBGrid1: TDBGrid;
  11.     DCOMConnection1: TDCOMConnection;
  12.     ClientDataSet1: TClientDataSet;
  13.     DataSource1: TDataSource;
  14.     DBNavigator1: TDBNavigator;
  15.   private
  16.     { Private declarations }
  17.     FEvents: IExamAppEvents;
  18.     procedure ActivateEvent(Sender: TObject);
  19.     procedure ClickEvent(Sender: TObject);
  20.     procedure CreateEvent(Sender: TObject);
  21.     procedure DblClickEvent(Sender: TObject);
  22.     procedure DeactivateEvent(Sender: TObject);
  23.     procedure DestroyEvent(Sender: TObject);
  24.     procedure KeyPressEvent(Sender: TObject; var Key: Char);
  25.     procedure PaintEvent(Sender: TObject);
  26.   protected
  27.     { Protected declarations }
  28.     procedure DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage); override;
  29.     procedure EventSinkChanged(const EventSink: IUnknown); override;
  30.     function Get_Active: WordBool; safecall;
  31.     function Get_AlignDisabled: WordBool; safecall;
  32.     function Get_AutoScroll: WordBool; safecall;
  33.     function Get_AutoSize: WordBool; safecall;
  34.     function Get_AxBorderStyle: TxActiveFormBorderStyle; safecall;
  35.     function Get_Caption: WideString; safecall;
  36.     function Get_Color: OLE_COLOR; safecall;
  37.     function Get_Cursor: Smallint; safecall;
  38.     function Get_DoubleBuffered: WordBool; safecall;
  39.     function Get_DropTarget: WordBool; safecall;
  40.     function Get_Enabled: WordBool; safecall;
  41.     function Get_Font: IFontDisp; safecall;
  42.     function Get_HelpFile: WideString; safecall;
  43.     function Get_HelpKeyword: WideString; safecall;
  44.     function Get_HelpType: TxHelpType; safecall;
  45.     function Get_KeyPreview: WordBool; safecall;
  46.     function Get_PixelsPerInch: Integer; safecall;
  47.     function Get_PrintScale: TxPrintScale; safecall;
  48.     function Get_Scaled: WordBool; safecall;
  49.     function Get_Visible: WordBool; safecall;
  50.     function Get_VisibleDockClientCount: Integer; safecall;
  51.     procedure _Set_Font(var Value: IFontDisp); safecall;
  52.     procedure AboutBox; safecall;
  53.     procedure Set_AutoScroll(Value: WordBool); safecall;
  54.     procedure Set_AutoSize(Value: WordBool); safecall;
  55.     procedure Set_AxBorderStyle(Value: TxActiveFormBorderStyle); safecall;
  56.     procedure Set_Caption(const Value: WideString); safecall;
  57.     procedure Set_Color(Value: OLE_COLOR); safecall;
  58.     procedure Set_Cursor(Value: Smallint); safecall;
  59.     procedure Set_DoubleBuffered(Value: WordBool); safecall;
  60.     procedure Set_DropTarget(Value: WordBool); safecall;
  61.     procedure Set_Enabled(Value: WordBool); safecall;
  62.     procedure Set_Font(const Value: IFontDisp); safecall;
  63.     procedure Set_HelpFile(const Value: WideString); safecall;
  64.     procedure Set_HelpKeyword(const Value: WideString); safecall;
  65.     procedure Set_HelpType(Value: TxHelpType); safecall;
  66.     procedure Set_KeyPreview(Value: WordBool); safecall;
  67.     procedure Set_PixelsPerInch(Value: Integer); safecall;
  68.     procedure Set_PrintScale(Value: TxPrintScale); safecall;
  69.     procedure Set_Scaled(Value: WordBool); safecall;
  70.     procedure Set_Visible(Value: WordBool); safecall;
  71.   public
  72.     { Public declarations }
  73.     procedure Initialize; override;
  74.   end;
  75. implementation
  76. uses ComObj, ComServ, About1;
  77. {$R *.DFM}
  78. { TExamApp }
  79. procedure TExamApp.DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage);
  80. begin
  81.   { Define property pages here.  Property pages are defined by calling
  82.     DefinePropertyPage with the class id of the page.  For example,
  83.       DefinePropertyPage(Class_ExamAppPage); }
  84. end;
  85. procedure TExamApp.EventSinkChanged(const EventSink: IUnknown);
  86. begin
  87.   FEvents := EventSink as IExamAppEvents;
  88.   inherited EventSinkChanged(EventSink);
  89. end;
  90. procedure TExamApp.Initialize;
  91. begin
  92.   inherited Initialize;
  93.   OnActivate := ActivateEvent;
  94.   OnClick := ClickEvent;
  95.   OnCreate := CreateEvent;
  96.   OnDblClick := DblClickEvent;
  97.   OnDeactivate := DeactivateEvent;
  98.   OnDestroy := DestroyEvent;
  99.   OnKeyPress := KeyPressEvent;
  100.   OnPaint := PaintEvent;
  101. end;
  102. function TExamApp.Get_Active: WordBool;
  103. begin
  104.   Result := Active;
  105. end;
  106. function TExamApp.Get_AlignDisabled: WordBool;
  107. begin
  108.   Result := AlignDisabled;
  109. end;
  110. function TExamApp.Get_AutoScroll: WordBool;
  111. begin
  112.   Result := AutoScroll;
  113. end;
  114. function TExamApp.Get_AutoSize: WordBool;
  115. begin
  116.   Result := AutoSize;
  117. end;
  118. function TExamApp.Get_AxBorderStyle: TxActiveFormBorderStyle;
  119. begin
  120.   Result := Ord(AxBorderStyle);
  121. end;
  122. function TExamApp.Get_Caption: WideString;
  123. begin
  124.   Result := WideString(Caption);
  125. end;
  126. function TExamApp.Get_Color: OLE_COLOR;
  127. begin
  128.   Result := OLE_COLOR(Color);
  129. end;
  130. function TExamApp.Get_Cursor: Smallint;
  131. begin
  132.   Result := Smallint(Cursor);
  133. end;
  134. function TExamApp.Get_DoubleBuffered: WordBool;
  135. begin
  136.   Result := DoubleBuffered;
  137. end;
  138. function TExamApp.Get_DropTarget: WordBool;
  139. begin
  140.   Result := DropTarget;
  141. end;
  142. function TExamApp.Get_Enabled: WordBool;
  143. begin
  144.   Result := Enabled;
  145. end;
  146. function TExamApp.Get_Font: IFontDisp;
  147. begin
  148.   GetOleFont(Font, Result);
  149. end;
  150. function TExamApp.Get_HelpFile: WideString;
  151. begin
  152.   Result := WideString(HelpFile);
  153. end;
  154. function TExamApp.Get_HelpKeyword: WideString;
  155. begin
  156.   Result := WideString(HelpKeyword);
  157. end;
  158. function TExamApp.Get_HelpType: TxHelpType;
  159. begin
  160.   Result := Ord(HelpType);
  161. end;
  162. function TExamApp.Get_KeyPreview: WordBool;
  163. begin
  164.   Result := KeyPreview;
  165. end;
  166. function TExamApp.Get_PixelsPerInch: Integer;
  167. begin
  168.   Result := PixelsPerInch;
  169. end;
  170. function TExamApp.Get_PrintScale: TxPrintScale;
  171. begin
  172.   Result := Ord(PrintScale);
  173. end;
  174. function TExamApp.Get_Scaled: WordBool;
  175. begin
  176.   Result := Scaled;
  177. end;
  178. function TExamApp.Get_Visible: WordBool;
  179. begin
  180.   Result := Visible;
  181. end;
  182. function TExamApp.Get_VisibleDockClientCount: Integer;
  183. begin
  184.   Result := VisibleDockClientCount;
  185. end;
  186. procedure TExamApp._Set_Font(var Value: IFontDisp);
  187. begin
  188.   SetOleFont(Font, Value);
  189. end;
  190. procedure TExamApp.AboutBox;
  191. begin
  192.   ShowExamAppAbout;
  193. end;
  194. procedure TExamApp.ActivateEvent(Sender: TObject);
  195. begin
  196.   if FEvents <> nil then FEvents.OnActivate;
  197. end;
  198. procedure TExamApp.ClickEvent(Sender: TObject);
  199. begin
  200.   if FEvents <> nil then FEvents.OnClick;
  201. end;
  202. procedure TExamApp.CreateEvent(Sender: TObject);
  203. begin
  204.   if FEvents <> nil then FEvents.OnCreate;
  205. end;
  206. procedure TExamApp.DblClickEvent(Sender: TObject);
  207. begin
  208.   if FEvents <> nil then FEvents.OnDblClick;
  209. end;
  210. procedure TExamApp.DeactivateEvent(Sender: TObject);
  211. begin
  212.   if FEvents <> nil then FEvents.OnDeactivate;
  213. end;
  214. procedure TExamApp.DestroyEvent(Sender: TObject);
  215. begin
  216.   if FEvents <> nil then FEvents.OnDestroy;
  217. end;
  218. procedure TExamApp.KeyPressEvent(Sender: TObject; var Key: Char);
  219. var
  220.   TempKey: Smallint;
  221. begin
  222.   TempKey := Smallint(Key);
  223.   if FEvents <> nil then FEvents.OnKeyPress(TempKey);
  224.   Key := Char(TempKey);
  225. end;
  226. procedure TExamApp.PaintEvent(Sender: TObject);
  227. begin
  228.   if FEvents <> nil then FEvents.OnPaint;
  229. end;
  230. procedure TExamApp.Set_AutoScroll(Value: WordBool);
  231. begin
  232.   AutoScroll := Value;
  233. end;
  234. procedure TExamApp.Set_AutoSize(Value: WordBool);
  235. begin
  236.   AutoSize := Value;
  237. end;
  238. procedure TExamApp.Set_AxBorderStyle(Value: TxActiveFormBorderStyle);
  239. begin
  240.   AxBorderStyle := TActiveFormBorderStyle(Value);
  241. end;
  242. procedure TExamApp.Set_Caption(const Value: WideString);
  243. begin
  244.   Caption := TCaption(Value);
  245. end;
  246. procedure TExamApp.Set_Color(Value: OLE_COLOR);
  247. begin
  248.   Color := TColor(Value);
  249. end;
  250. procedure TExamApp.Set_Cursor(Value: Smallint);
  251. begin
  252.   Cursor := TCursor(Value);
  253. end;
  254. procedure TExamApp.Set_DoubleBuffered(Value: WordBool);
  255. begin
  256.   DoubleBuffered := Value;
  257. end;
  258. procedure TExamApp.Set_DropTarget(Value: WordBool);
  259. begin
  260.   DropTarget := Value;
  261. end;
  262. procedure TExamApp.Set_Enabled(Value: WordBool);
  263. begin
  264.   Enabled := Value;
  265. end;
  266. procedure TExamApp.Set_Font(const Value: IFontDisp);
  267. begin
  268.   SetOleFont(Font, Value);
  269. end;
  270. procedure TExamApp.Set_HelpFile(const Value: WideString);
  271. begin
  272.   HelpFile := String(Value);
  273. end;
  274. procedure TExamApp.Set_HelpKeyword(const Value: WideString);
  275. begin
  276.   HelpKeyword := String(Value);
  277. end;
  278. procedure TExamApp.Set_HelpType(Value: TxHelpType);
  279. begin
  280.   HelpType := THelpType(Value);
  281. end;
  282. procedure TExamApp.Set_KeyPreview(Value: WordBool);
  283. begin
  284.   KeyPreview := Value;
  285. end;
  286. procedure TExamApp.Set_PixelsPerInch(Value: Integer);
  287. begin
  288.   PixelsPerInch := Value;
  289. end;
  290. procedure TExamApp.Set_PrintScale(Value: TxPrintScale);
  291. begin
  292.   PrintScale := TPrintScale(Value);
  293. end;
  294. procedure TExamApp.Set_Scaled(Value: WordBool);
  295. begin
  296.   Scaled := Value;
  297. end;
  298. procedure TExamApp.Set_Visible(Value: WordBool);
  299. begin
  300.   Visible := Value;
  301. end;
  302. initialization
  303.   TActiveFormFactory.Create(
  304.     ComServer,
  305.     TActiveFormControl,
  306.     TExamApp,
  307.     Class_ExamApp,
  308.     1,
  309.     '',
  310.     OLEMISC_SIMPLEFRAME or OLEMISC_ACTSLIKELABEL,
  311.     tmApartment);
  312. end.