主程序调用DLL窗体cannot assign a class to a class问题的彻底解决方案

转自http://topic.csdn.net/u/20091216/14/0906d982-c004-417a-becb-07efdbea81ae.html

 经验共享：
  主程序调用DLL窗体 cannot assign a TFont to a TFont 问题的彻底解决方案

在网上搜索N久，总结并实战出来的经验和大家分享
  1、中国的网站链接大多建议的方案是 project->options选项的packages标签页面勾选 'Buidl with runtime packages'
我个人在D7中测试确实能够解决问题。但是程序发布的时候需要带很多bpl包。
  2、在国外网站搜索到另一种解决方案，就是通过修改系统的controls.pas和graphics.pas两个文件来彻底解决上述问题。
  具体链接地址为：http://tengco.spaces.live.com/Blog/cns!689EE398F7BFBE58!150.entry
  http://www.delphi3000.com/articles/article_4957.asp?SK=

  下面是我的程序做法：
  首先、把系统的controls.pas和graphics.pas拷贝到自己的工程目录，并做如下修改
  第一步、在controls.pas 的声明部分加入
  function GetControlAtom : pointer;
  第二步、在controls.pas 的实现部分加入
  function GetControlAtom : pointer;
  begin
  result := @ControlAtom;
  end;
  第三步、修改graphics.pas的TCanvas.SetFont函数
procedure TCanvas.SetFont(Value: TFont); 
begin 
  FFont.Assign(Value); 
end; 

给上面的代码加上 try..except保护，编程如下：

procedure TCanvas.SetFont(Value: TFont); 
begin 
  try 
  FFont.Assign(Value); 
  except 
  on Exception do; 
  end; 
end; 

  第四步、在DLL工程中引入我们修改好的两个文件；
  第五步、DLL工程的初始化
procedure myDllProc(dWseason: DWORD);
var
  p:^word;
begin
  case dWseason of
  DLL_PROCESS_ATTACH: begin
  oldApp := Application; //保存DLL的Application
  oldScr := Screen; //保存DLL的Screen
  p := Controls.GetControlAtom;
  OldControlAtom := p^;
  CoInitialize(nil); //使用了ADO控件所以需要调用此方法
  end;
  DLL_PROCESS_DETACH: begin
  p := Controls.GetControlAtom;
  p^ := OldControlAtom;
  application := oldApp; //恢复Dll的Application
  Screen := oldScr; //恢复Dll的Screen
  CoUninitialize(); //使用了ADO控件所以需要调用此方法
  end;
  end;
end;

procedure InitDll(var app:tapplication; var scr:Tscreen; RealControlAtom:integer);
var
  p:^word;
begin
  p := controls.GetControlAtom;
  if scr <> nil then screen := scr;
  application := app;
  p^ := RealControlAtom;
end;


library testdll;

{ Important note about DLL memory management: ShareMem must be the
  first unit in your library's USES clause AND your project's (select
  Project-View Source) USES clause if your DLL exports any procedures or
  functions that pass strings as parameters or function results. This
  applies to all strings passed to and from your DLL--even those that
  are nested in records and classes. ShareMem is the interface unit to
  the BORLNDMM.DLL shared memory manager, which must be deployed along
  with your DLL. To avoid using BORLNDMM.DLL, pass string information
  using PChar or ShortString parameters. }

uses
  ShareMem,
  SysUtils,
  Classes,
  windows,
  Controls in 'Controls.pas',
  Graphics in 'Graphics.pas';  

exports
  InitDll;

begin
  DllProc := @myDllProc;
  myDllProc(DLL_PROCESS_ATTACH); //DLL入口初始化
end.

主程序调用示例：
  ...
  p := controls.GetControlAtom;
  InitDll(application,screen,p^);
  ...