高分，，，，，在dll中写类，能不能在delphi主程序中引用，如何用，

1、建立基类unit PackageBase;{***************************************************
        由于是要用自定义的对象作为返回值
        因此必须包含这个文件!
***************************************************}
interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls,Registry,Jpeg;type
  TProFileA = class
  protected
        function IsValidDir
                 (SearchRec:TSearchRec):Boolean;
                 virtual; abstract;
        function IsValidFile
                 (SearchRec:TSearchRec):Boolean;
                 virtual; abstract;
  private
         {the private member}
  public
        function SearchFile
                 (mainpath:string;filename:string;var fresult:TStrings):Boolean;
                 virtual; abstract;
        function GetCurrentDir : String;virtual; abstract;
        function UserLog
                 (str_Content :String) : Boolean;
                 virtual; abstract;
        function IsFileInUse
                 (fName : string) : boolean;
                 virtual; abstract;end;type
  TGraphA = class
  private
         {the private member}
  public
        function Jpeg2Bitmap
                 (JPEGFile : String):String;
                 virtual; abstract;end;
type
  TSystemA = class
  private
         {the private member}
  public
        function ChangeWallPager
                 (str_PicFile :String):boolean;
                 virtual; abstract;end;
type
  TSetConfigA = class
  private
         {the private member}
  public
    function SaveIniFile
              (str_SaveType:String; str_SaveContent:String) :boolean;
              virtual; abstract;
    function LoadIniFile
              (str_LoadType :String):String;virtual; abstract;
    function SaveReg
              (str_SaveType:String; str_SaveContent:String):boolean;
              virtual; abstract;
    function LoadReg
              (str_LoadType :String):String;virtual; abstract;
end;
implementationend.2、继承基类
unit MyAppPackage;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls,Registry,Jpeg,PackageBase;type
  TProFile = class(TProFileA)
  private
         {the private member}
        function IsValidDir(SearchRec:TSearchRec):Boolean;override;
        function IsValidFile(SearchRec:TSearchRec):Boolean;override;
  protected
         {the protectec member}
  public
        constructor Create;
        function SearchFile(mainpath:string;filename:string;var fresult:TStrings):Boolean;override;
        function GetCurrentDir : String;override;
        function UserLog(str_Content :String) : Boolean;override;
        function IsFileInUse(fName : string) : boolean;override;end;type
  TGraph = class(TGraphA)
  private
         {the private member}
  public
        constructor Create;
        function Jpeg2Bitmap(JPEGFile : String):String;override;
end;
type
  TSystem = class(TSystemA)
  private
         {the private member}
  public
        constructor Create;
        function ChangeWallPager(str_PicFile :String):boolean;override;end;
type
  TSetConfig = class(TSetConfigA)
  private
         {the private member}
  public
        constructor Create;
        function SaveIniFile(str_SaveType:String; str_SaveContent:String):boolean;override;
        function LoadIniFile(str_LoadType :String):String;override;
        function SaveReg(str_SaveType:String; str_SaveContent:String):boolean;override;
        function LoadReg(str_LoadType :String):String;override;
end;
{*************************************************************
        全局函数注册区
**************************************************************}
function UserLog(str_Content :String) : Boolean;
{*************************************************************
        类输出函数注册区
**************************************************************}
function NewProFile: TProfile; stdcall;
function NewProGraph: TGraph; stdcall;
function NewProSetConfig: TSetConfig; stdcall;
function NewProSystem: TSystem; stdcall;implementation{*************************************************************
        构造函数实现区
**************************************************************}
constructor TGraph.Create;
begin
  inherited Create;
end;constructor TProFile.Create;
begin
  inherited Create;
end;
constructor TSetConfig.Create;
begin
  inherited Create;
end;
constructor TSystem.Create;
begin
  inherited Create;
end;
{*************************************************************
        全局函数实现区
**************************************************************}
function UserLog(str_Content :String) :Boolean;
var
   F : TextFile;
   str_LogFile : String;
begin
   try
     str_LogFile := GetCurrentDir+'user_log.txt';
     if not FileExists(str_LogFile) then
       CreateFile(pchar(str_LogFile),GENERIC_WRITE or GENERIC_READ,0,nil,
                  CREATE_ALWAYS,FILE_ATTRIBUTE_NORMAL or FILE_FLAG_SEQUENTIAL_SCAN or FILE_FLAG_OVERLAPPED,0);
     AssignFile(F,str_LogFile);
     Append(F);
     Writeln(F,pchar(str_Content));
     Flush(F);
     CloseFile(F);
     result := TRUE;
   except
     result := false;
   end;
end;
{*************************************************************
        类输出函实现行区
**************************************************************}
function NewProFile: TProfile; stdcall;
begin
        result := TProfile.Create ;
end;function NewProGraph: TGraph; stdcall;
begin
        result := TGraph.Create ;
end;function NewProSetConfig: TSetConfig; stdcall;
begin
        result := TSetConfig.Create ;
end;function NewProSystem: TSystem; stdcall;
begin
        result := TSystem.Create ;
end;{*************************************************************
*                类成员函数实现区                            *
**************************************************************}
function TSystem.ChangeWallPager(str_PicFile :String):boolean;
var
   str_FileName :String;
   ProFile : TProFile;
   tgraph_1 : TGraph;
   Reg:Tregistry;{Tregistry 对象在Registry 单元中声明，需用Uses令引用Registry单元}
begin
     str_FileName := str_PicFile;
     ProFile := TProFile.Create;
     if uppercase(ExtractFileExt(str_FileName)) ='.JPG' then begin
        tgraph_1 := TGraph.Create;
        str_FileName :=tgraph_1.Jpeg2Bitmap(str_FileName);
     end;
     Reg:=Tregistry.Create;
     Reg.Rootkey:= Hkey_Current_User;
     Reg.OpenKey('Control Panel\Desktop',False);
     Reg.WriteString('TileWallPaper','0');
     Reg.WriteString('Wallpaper',str_FileName);
     Reg.CloseKey;
     Reg.Free;
     result :=Systemparametersinfo(SPI_SETDESKWALLPAPER,0,pchar(str_FileName),(SPIF_SENDCHANGE OR SPIF_UPDATEINIFILE));
     ProFile.UserLog('TSystem.ChangeWallPager is completed!'+datetimetostr(now));
     ProFile.Free;
end;function TSetConfig.SaveIniFile(str_SaveType :String;str_SaveContent:String) :boolean;
const
str_IniFileName : String = 'myini.ini';
var
str_CurntDir : String;
ProFile : TProFile;
begin
  try
  ProFile := TProFile.Create ;
  str_CurntDir := ProFile.GetCurrentDir();
  str_IniFileName := 'myini.ini';
  WritePrivateProfileString(
                          'MyApp', // []中标题的名字
                          'PicDir', // 要写入“=”号前的字符串
                          pchar(str_SaveContent), //要写入的数据
                          pchar(str_CurntDir + str_IniFileName) // 调用的文件名
  );
  ProFile.Free ;
  result := TRUE;
  except
        result := FALSE;
  end;
end;function TSetConfig.LoadIniFile(str_LoadType :String):String;
const
        str_IniFileName : String = 'myini.ini';
        str_DefualtDir : String = 'E:\Picture';
var
        str_CurntDir : String;
        ProFile : TProFile;
        str_LoadContent :String;
begin
        ProFile := TProFile.Create;
        str_CurntDir := ProFile.GetCurrentDir();
        str_IniFileName := 'myini.ini';
        setLength(str_LoadContent,255);
        GetPrivateProfileString(
                        'MyApp', // []中标题的名字
                        'PicDir', // =号前的名字
                        nil,//pchar(str_DefualtDir), // 如果没有找到字符串时，返回的默认值
                        pchar(str_LoadContent), //存放取得字符
                        255, //取得字符的允许最大长度
                        pchar(str_CurntDir + str_IniFileName) // 调用的文件名
        );
        ProFile.Free;
        result := str_LoadContent;
end;function TSetConfig.SaveReg(str_SaveType :String;str_SaveContent:String) :boolean;
var
reg : TRegistry;
begin
     reg := TRegistry.Create;
     reg.RootKey := HKEY_CURRENT_USER;
     reg.OpenKey('software',FALSE);
     reg.CreateKey('MyApp');
     reg.OpenKey('MyApp',FALSE);
     reg.CreateKey('PicDir');
     reg.OpenKey('PicDir',True);
     reg.WriteString('Dir',str_SaveContent);
     reg.CloseKey;
     reg.Free;
     result := TRUE;end;function TSetConfig.LoadReg(str_LoadType :String):String;
var
reg : TRegistry;
ok1,ok2,ok3  : Boolean;
str_LoadContent : String;
begin
     reg := TRegistry.Create;
     reg.RootKey := HKEY_CURRENT_USER;
     ok1 := reg.OpenKey('software',FALSE);
     ok2 := reg.OpenKey('MyApp',FALSE);
     ok3 := reg.OpenKey('PicDir',True);
     if not (ok1 and ok2 and ok3) then begin
        ShowMessage('Open error');
        result :='';
        exit;
     end;
     result := reg.ReadString('Dir');
     str_LoadContent := reg.ReadString('Dir');//此句去掉就会报错
     reg.CloseKey;
     reg.Free;end;
function TProFile.IsFileInUse(fName : string) : boolean;
{**********************************************
       判断文件是否正被使用
**********************************************}
var
   HFileRes : HFILE;
begin
     Result := false;
     if not FileExists(fName) then
        exit;
     HFileRes := CreateFile(pchar(fName), GENERIC_READ or GENERIC_WRITE,
                 0 {this is the trick!}, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
                 Result := (HFileRes = INVALID_HANDLE_VALUE);
     if not Result then
             CloseHandle(HFileRes);
     UserLog('TProFile.IsFileInUse completed!');
end;function TProFile.UserLog(str_Content :String) :Boolean;
var
   F : TextFile;
   str_LogFile : String;
begin
   try
     str_LogFile := GetCurrentDir+'user_log.txt';
     if not FileExists(str_LogFile) then
       CreateFile(pchar(str_LogFile),GENERIC_WRITE or GENERIC_READ,0,nil,
                  CREATE_ALWAYS,FILE_ATTRIBUTE_NORMAL or FILE_FLAG_SEQUENTIAL_SCAN or FILE_FLAG_OVERLAPPED,0);
     AssignFile(F,str_LogFile);
     Append(F);
     Writeln(F,pchar(str_Content));
     Flush(F);
     CloseFile(F);
     result := TRUE;
   except
     result := false;
   end;
end;function TProFile.GetCurrentDir : String;
var
   str_CurntDir :String;
   i_Pos: integer;
   i_Count :integer;
begin
   i_Pos := -1;
   str_CurntDir := Application.ExeName;
   for i_Count:=0 to length(str_CurntDir)-1 do begin
    if str_CurntDir[i_Count] = '\' then begin
       i_Pos := i_Count;
    end;
   end;
   if i_Pos>0 then
      str_CurntDir := copy(str_CurntDir,1,i_pos-1)+'\'
   else
       str_CurntDir := 'E:\Picture\';
   //UserLog('TProFile.GetCurrentDir completed!');
   result := str_CurntDir;
end;
function TProFile.IsValidDir(SearchRec:TSearchRec):Boolean;
{**********************************************
*         从搜索记录中判断是否是子目录。
                                               *
***********************************************}
begin
     if (SearchRec.Attr=faDirectory) and
        (SearchRec.Name<>'.') and
        (SearchRec.Name<>'..') then
        result:=true
     else
         result := false;
end;function TProFile.IsValidFile(SearchRec:TSearchRec):Boolean;
{**********************************************
*         从搜索记录中判断是否是子目录。
                                               *
***********************************************}
begin
     if (SearchRec.Attr<>faDirectory) and
        (SearchRec.Name<>'.') and
        (SearchRec.Name<>'..') then
        result:=true
     else
         result := false;
end;function TProFile.SearchFile(
         mainpath:string;
         filename:string;
         var fresult:TStrings):Boolean;
{
         查询主体函数         Mainpath：指定的查询目录。
         Filename：欲查询的文件。
         Foundresult：返回的含完整路径的匹配文件（可能有多个）。         如果有匹配文件，函数返回True，否则，返回False;}
var
   i:integer;
   Found:Boolean;
   searchRec:TsearchRec;
   subdir1:TStrings;
begin
     found:=false;
     subdir1:=TStringList.Create;//字符串列表必须动态生成
     //找出所有下级子目录。
     if (FindFirst(mainpath+'*.*', faDirectory, SearchRec)=0) then begin
           if IsValidDir(SearchRec) then
                      subdir1.Add(SearchRec.Name);
           if trim(filename)='' then begin
              if IsValidFile(SearchRec) then begin
                 fresult.Add(mainpath+SearchRec.Name);
                 found := true;
              end;
           end;
           while (FindNext(SearchRec) = 0) do begin
                 if IsValidDir(SearchRec) then
                    subdir1.Add(SearchRec.Name);
                 if trim(filename)='' then begin
                   if IsValidFile(SearchRec) then begin
                      fresult.Add(mainpath+SearchRec.Name);
                      found := true;
                      UserLog(mainpath+SearchRec.Name);
                   end;
                 end;
           end;
     UserLog(mainpath+'the count is : '+inttostr(fresult.count));
     end;
     FindClose(SearchRec);
     //查找当前目录。
     if Trim(filename)<>'' then begin
           if FileExists(mainpath+filename) then begin
              found:=true;
              fresult.Add(mainpath+filename);
           end
     end;
     //这是递归部分，查找各子目录。
     for i:=0 to subdir1.Count-1 do
            found:=SearchFile(mainpath+subdir1.Strings[i]+'\',Filename,fresult)or found;
     subdir1.Free;//资源释放并返回结果。
     result := found;
end;
function TGraph.Jpeg2Bitmap(JPEGFile : String) :String;
var
   oJPEG : TJPEGImage;
   oBmp : TBitMap;
   ProFile : TProFile;
begin
  ProFile := TProFile.Create;
  try
   oJPEG := TJPEGImage.Create;
   oJPEG.LoadFromFile(JPEGFile);
   oBmp := TBitmap.Create;
   oBmp.Assign(oJPEG);
   oBmp.SaveToFile(ProFile.GetCurrentDir+'wallpaper.bmp');
   result:= ProFile.GetCurrentDir+'wallpaper.bmp';
   oJPEG.Free;
   oBmp.Free;
  except
   on E:Exception do
        ProFile.UserLog(
                        datetimetostr(now)
                        +' TGraph.Jpeg2Bitmap '
                        +'The Jpeg file is '+
                        JPEGFile);
  end;
  ProFile.Free ;end;
end.3、生成dll
library MyAppDll;uses
  MyAppPackage in 'MyAppPackage.pas',
  PackageBase in 'PackageBase.pas';
exports
  NewProFile,NewProSystem,NewProGraph,NewProSetConfig;
end.
可不可以把Form定义在dll中,然后从dll中返回Form,而在delphi中可以象一般的form一样使用?
(可另起贴子加分,谢谢!)
to: matata()　
几年Delphi历史，很多地方可以借鉴。

调试易

高分，，，，，在dll中写类，能不能在delphi主程序中引用，如何用，

解决方案 »