home *** CD-ROM | disk | FTP | other *** search
/ PC Format Collection 48 / SENT14D.ISO / tech / delphi / disk15 / experts.pak / EXPTDEMO.DPR < prev    next >
Encoding:
Text File  |  1995-08-24  |  4.0 KB  |  207 lines
  1. library Exptdemo;
  2.  
  3. uses Forms,
  4.   WinTypes,
  5.   ExptIntf,
  6.   ToolIntf,
  7.   VirtIntf,
  8.   SysUtils,
  9.   WinProcs,
  10.   Dlg in 'DLG.PAS' {DlgExpert},
  11.   Exconst in 'EXCONST.PAS',
  12.   App in 'APP.PAS' {AppExpert};
  13.  
  14. {$R EXPTBMPS.RES}
  15. {$R STRINGS.RES}
  16.  
  17. type
  18.   TDialogExpert = class(TIExpert)
  19.     function GetName: string; override;
  20.     function GetComment: string; override;
  21.     function GetGlyph: HBITMAP; override;
  22.     function GetStyle: TExpertStyle; override;
  23.     function GetState: TExpertState; override;
  24.     function GetIDString: string; override;
  25.     procedure Execute; override;
  26.   end;
  27.  
  28.   TApplicationExpert = class(TIExpert)
  29.     function GetName: string; override;
  30.     function GetComment: string; override;
  31.     function GetGlyph: HBITMAP; override;
  32.     function GetStyle: TExpertStyle; override;
  33.     function GetState: TExpertState; override;
  34.     function GetIDString: string; override;
  35.     procedure Execute; override;
  36.   end;
  37.  
  38. procedure HandleException;
  39. begin
  40.   ToolServices.RaiseException(ReleaseException);
  41. end;
  42.  
  43. { TDialogExpert }
  44. function TDialogExpert.GetName: string;
  45. begin
  46.   try
  47.     Result := LoadStr(sDlgExpertName);
  48.   except
  49.     HandleException;
  50.   end;
  51. end;
  52.  
  53. function TDialogExpert.GetComment: string;
  54. begin
  55.   try
  56.     Result := LoadStr(sDlgExpertDesc);
  57.   except
  58.     HandleException;
  59.   end;
  60. end;
  61.  
  62. function TDialogExpert.GetGlyph: HBITMAP;
  63. begin
  64.   try
  65.     Result := LoadBitmap(HInstance, 'DIALOGEXPT');
  66.   except
  67.     HandleException;
  68.   end;
  69. end;
  70.  
  71. function TDialogExpert.GetStyle: TExpertStyle;
  72. begin
  73.   try
  74.     Result := esForm;
  75.   except
  76.     HandleException;
  77.   end;
  78. end;
  79.  
  80. function TDialogExpert.GetState: TExpertState;
  81. begin
  82.   try
  83.     Result := [esEnabled];
  84.   except
  85.     HandleException;
  86.   end;
  87. end;
  88.  
  89. function TDialogExpert.GetIDString: string;
  90. begin
  91.   try
  92.     Result := 'Borland.DlgExpertDemo';
  93.   except
  94.     HandleException;
  95.   end;
  96. end;
  97.  
  98. procedure TDialogExpert.Execute;
  99. begin
  100.   try
  101.     DialogExpert(ToolServices);
  102.   except
  103.     HandleException;
  104.   end;
  105. end;
  106.  
  107. { TApplicationExpert }
  108. function TApplicationExpert.GetName: string;
  109. begin
  110.   try
  111.     Result := LoadStr(sAppExpertName);
  112.   except
  113.     HandleException;
  114.   end;
  115. end;
  116.  
  117. function TApplicationExpert.GetComment: string;
  118. begin
  119.   try
  120.     Result := LoadStr(sAppExpertDesc);
  121.   except
  122.     HandleException;
  123.   end;
  124. end;
  125.  
  126. function TApplicationExpert.GetGlyph: HBITMAP;
  127. begin
  128.   try
  129.     Result := LoadBitmap(HInstance, 'APPEXPT');
  130.   except
  131.     HandleException;
  132.   end;
  133. end;
  134.  
  135. function TApplicationExpert.GetStyle: TExpertStyle;
  136. begin
  137.   try
  138.     Result := esProject;
  139.   except
  140.     HandleException;
  141.   end;
  142. end;
  143.  
  144. function TApplicationExpert.GetState: TExpertState;
  145. begin
  146.   try
  147.     Result := [esEnabled];
  148.   except
  149.     HandleException;
  150.   end;
  151. end;
  152.  
  153. function TApplicationExpert.GetIDString: string;
  154. begin
  155.   try
  156.     Result := 'Borland.AppExpertDemo';
  157.   except
  158.     HandleException;
  159.   end;
  160. end;
  161.  
  162. procedure TApplicationExpert.Execute;
  163. begin
  164.   try
  165.     ApplicationExpert(ToolServices);
  166.   except
  167.     HandleException;
  168.   end;
  169. end;
  170.  
  171. procedure DoneExpert; export;
  172. begin
  173.   { Put any general destruction code here.  Note that the Delphi IDE
  174.     will destroy any experts which have been registered. }
  175. end;
  176.  
  177. function InitExpert(ToolServices: TIToolServices;
  178.   RegisterProc: TExpertRegisterProc;
  179.   var Terminate: TExpertTerminateProc): Boolean; export;
  180. begin
  181.   { make sure we're the first and only instance }
  182.   Result := ExptIntf.ToolServices = nil;
  183.   if not Result then Exit;
  184.  
  185.   ExptIntf.ToolServices := ToolServices;
  186.   if ToolServices <> nil then
  187.     Application.Handle := ToolServices.GetParentHandle;
  188.  
  189.   Terminate := DoneExpert;
  190.  
  191.   { register the experts }
  192.   RegisterProc(TDialogExpert.Create);
  193.   RegisterProc(TApplicationExpert.Create);
  194. end;
  195.  
  196. function FaultHandler(FaultID: Word; faultAddr: Pointer): TFaultResponse; export;
  197. begin
  198.   DefaultExceptHandler(FaultId, faultAddr);
  199. end;
  200.  
  201. exports
  202.   InitExpert name ExpertEntryPoint resident,
  203.   FaultHandler name FaultHandlerSignature resident;
  204.  
  205. begin
  206. end.
  207.