[infopol]

Код:

unit ip2_form_pict;

interface

uses
  Windows, Classes, Controls, ExtCtrls, SysUtils, Variants, jpeg, Graphics,
   Forms,SysConst,
  Dialogs, StdCtrls;//, ExtCtrls;//ExtCtrls;
type
  EResNotFound = class(Exception);


type
  TFormPicter = class(TForm)
    Image1: TImage;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormDblClick(Sender: TObject);
    procedure FormKeyPress(Sender: TObject; var Key: Char);
    procedure FormClick(Sender: TObject);
    procedure Image1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
 //   FormPicter: TFormPicter;
    { Private declarations }
  public
  FormPicter: TFormPicter;
//   FormPicter.Image1: TImage;
  // Timer1: TTimer;
 App:TApplication;

    { Public declarations }
  end;
TFrameClass= class of TFrame;
TInitProc=procedure(Appl:TApplication;AScreen:TScreen) ;
var
App:TApplication;
FormPicter: TFormPicter;
 //  Image1: TImage;
   // Timer1: TTimer;
function AppExecName:string;

function CreateFormShowForm(str:String;bool:boolean;sz:Word):Boolean;

 implementation

//uses
  //Ip2Com_events;


{$R *.dfm}
//{$R Ip2_form_pict.res}
//{$R ip2com_events.res}


procedure TFormPicter.FormCreate(Sender: TObject);
begin
try
//Tframe11.Show;
 //ShowMessage('Start');
   //   App.Create(self);
     // Timer1.Create(self);
   //   Image1.Create(self);
   except

//   ip2_frame.TFrame1.CreateParented(0).Destroy;
   end

end;

function AppExecName:string;
begin
         App:=Application.Create(nil);
         App.Initialize;
         result:=App.ExeName;

end;

function CreateFormShowForm(str:String;bool:boolean;sz:Word):Boolean;
  var

 // ERes:EResNotFound;
   // hwd:HWND;
 // Obj:Interface;
    MyFormPicter: TFormPicter;
//var hLIB:THandle;
//InitDllProc:TInitProc;
begin

//EResNotFound.Create('Error);
         result:=False;
         App:=Application.Create(nil);
         App.Initialize;

  //hwd:= App.Handle  ;
// Obj:=TFormPicter.NewInstance;
 // ShowMessage(App.ExeName);

// Obj:= Obj.Create;

         try
    App.CreateForm(TFormPicter, FormPicter);

         //  App.CreateForm();
              //  MyFormPicter:=TFormPicter.Create(App);

        // FormPicter.Create(nil);
          //  FormPicter.FormCreate(nil);
       //  FormPicter:=TFormPicter.Create(nil)  ;



//FormPicter.SetSubComponent(true);
      //   FormPicter.Image1:=TImage.Create(app);
      //   FormPicter.Timer1:=TTimer.Create(App);


  {  // Form1:=TForm1.Create(DllApp);
        // TMainForm.ParentWindow;
//  TForm1.CreateNew(App);
TMainForm := TFormPicter.CreateNew(DllApp);
                  }

//MyFormPicter.Color:=clAppWorkSpace;
//FormPicter.Height:=255;
//FormPicter.Width:=335;
//FormPicter.Image1:=TImage.Create(Application);
//TMainForm.Image1.SetSubComponent(true);

           {
TMainForm.Timer1:=TTimer.Create(DllApp);
//TMainForm.Active:=true;
TMainForm.Timer1.Interval:=5000;
TMainForm.Timer1.Enabled:=bool;
          }
 //TMainForm.Image1.SetSubComponent(true);


            {
                TMainForm.Image1.IncrementalDisplay:=True;

TMainForm.Image1.Visible:=True;

//TForm1.Create(Application);
TMainForm.Image1.Height:=225  ;
TMainForm.Image1.Width:=335;   }

//FormPicter.BorderStyle:=bsToolWindow;
//FormPicter.WindowState:=wsNormal;


if FileExists(str)then
begin
try
//  FormPicter.Enabled:=True;
  FormPicter.Image1.Proportional:=true;
FormPicter.Image1.AutoSize:=True;
FormPicter.Image1.Center:=True;


FormPicter.Caption:='аﲬﳰ '+str;
//TMainForm.Image1.Enabled:=true;
//TMainForm.Image1.Picture.
//TMainForm.Image1.Show;
FormPicter.Image1.Visible:=True;
FormPicter.Image1.Transparent:=True;

//TmainForm.Timer1.Enabled:=bool;
FormPicter.Image1.Picture.LoadFromFile(str);
FormPicter.Image1.Enabled:=true;
FormPicter.Image1.Refresh;
   FormPicter.Image1.Stretch := True ;
//TMainForm.Image1.Show;

except
//FormPicter.Caption:='ϸ颪ힺ�ᤰ�� 騮Ⱡ禭齧 ;
ShowMessage('ϸ颪ힺ�ᤰ�� 騮Ⱡ禭齧 );
 result:=False;

  Exit;
end;

//ip2_form_pict.TMainFrame.
try
  result:=True;
  FormPicter.Enabled:=True;
FormPicter.ShowModal;
FormPicter.Free;
//result:=True;
except
         result:=False;


  ShowMessage('ϸ颪ힺ�𐯫齠��');
exit;
end;
end;

//DllApp.Free;
//DllApp.Destroy;
//btkDLLProc();
//btkDLLProc(1);
    except
//Eres:=EResNotFound.Create('Error');
 result:=False;

// ShowMessage(ERes.);
        Exit;
      end;
    end;


procedure TFormPicter.FormDblClick(Sender: TObject);
begin
try
Image1.Enabled:=true;
   except

//   ip2_frame.TFrame1.CreateParented(0).Destroy;
   end

end;


procedure TFormPicter.FormKeyPress(Sender: TObject; var Key: Char);
begin

    Close;
end;


procedure TFormPicter.FormClick(Sender: TObject);
begin
Close;
end;

//itialization

procedure TFormPicter.Image1Click(Sender: TObject);
begin
FormPicter.Close;
        App.Free;
end;

procedure TFormPicter.FormClose(Sender: TObject; var Action: TCloseAction);
begin
App.Free
end;
end.

Если использую function CreateFormShowForm(str:String;bool:boolean;sz:Word ):Boolean в отдельном проекте (exe) все нормально.
А вот когда использую в DLL

Код:

library Ip2Com_events;

{%File 'IP2ComServ.asp'}

uses
  ComServ,SysUtils,
  Windows,
  Forms,
    Classes,
//  Graphics,
  Controls,

  Ip2Com_events_TLB in 'Ip2Com_events_TLB.pas',
  Ip2Comp in 'Ip2Comp.pas',
  ibase_lib in 'ibase_lib.pas',
  Hashlib in 'Hashlib.pas',
  CryptoUtils in 'CryptoUtils.pas',
  MD in 'MD.pas',
  SHA in 'SHA.pas',
  CRC in 'CRC.pas',
  Tiger in 'Tiger.pas',
  Adler in 'Adler.pas',
  Haval in 'Haval.pas',
  Gost in 'Gost.pas',
  RIPEMD in 'RIPEMD.pas',
  CryptoAPI in 'CryptoAPI.pas',
  HashTests in 'HashTests.pas',
  Certif in 'Certif.pas',
  ckDllLoader in 'ckDllLoader.pas',
  XmlDSig in 'XmlDSig.pas',
  XmlDSigGen in 'XmlDSigGen.pas',
  Crypt_RSA in 'Crypt_RSA.pas',
  DataMatrix in 'DataMatrix.pas',
  SIRCrypt_TLB in 'SIRCrypt_TLB.pas',
  mscorlib_TLB in 'mscorlib_TLB.pas',
  ip2_form_pict in 'ip2_form_pict.pas' {FormPicter};

// ibaselib in 'ibaselib.pas';

{Ip2Com: CoClass}

exports
  DllGetClassObject,
  DllCanUnloadNow,
  DllRegisterServer,
  DllUnregisterServer;

{$R *.TLB}
{$R *.RES}

begin
end.

и создаю у объекта функцию

Код:

unit Ip2Comp;

{$WARN SYMBOL_PLATFORM OFF}
{$WARN UNIT_PLATFORM OFF}
interface

uses
  ComObj,SysUtils,Windows,StrUtils,Classes,Forms,Controls,SysConst,OleConst,OleCtl,
  Variants,ExtCtrls,StdCtrls,StdFuncs,idHTTP,SIRCrypt_TLB, xmldom, XMLIntf, msxmldom, XMLDoc,
  idSSLOpenSSL, IdIOHandler, IdIOHandlerSocket,DataMatrix,Base64Unit,jpeg,
   ActiveX,Messages,Dialogs,Clipbrd,Ip2Com_events_TLB,ibase_lib, StdVcl,Graphics,ip2_form_pict,
   Hashlib,Certif,uBalloon,WinSock,Crypt_RSA,WCrypt2;
var
   //Timer1:TTimer;
 //  Image1: TImage;
// TMainForm :TFormPicter;
// Image1: TImage;
// Timer1:TTimer;

    Clipboard:TClipboard;
    HTTP:TidHTTP ;
    SSLIO:TIdSSLIOHandlerSocket;
    XmlObj:TXMLDocument;
  arrayData: array of Variant;
   DllApp:TApplication;
Type
 TBuildVersionNumber = record
    CurrentMajorVersion :DWORD;
    CurrentMinorVersion :DWORD;
  end;
type
  TIp2Com = class(TAutoObject, IIp2Com)
  protected


   function F_PICTER_SHOW(const aPar: WideString; aTime: WordBool; aSize: SYSINT): WordBool; safecall;
  end;

implementation

uses ComServ;

 function TIP2COM.F_PICTER_SHOW(const aPar: WideString; aTime: WordBool; aSize: SYSINT): WordBool; safecall;
 begin
       result:= CreateFormShowForm(String(aPar),aTime,aSize) ;
 end;

initialization
// ComServer.ServerKey ;
 // TComObjectFactory.Create(ComServer, TIp2Com, Class_Ip2Com,'IP2COM','IP2.0 IPCOM',ciMultiInstance);//, tmNeutral);
  TAutoObjectFactory.Create(ComServer, TIp2Com, Class_Ip2Com,ciMultiInstance, tmNeutral);
end

То в приложении используя

Код:

procedure TForm1.Button3Click(Sender: TObject);
var
  str:String;
  bool:Boolean;
ip2:OleVariant;
begin
  Bool:=true;
str:= 'C:\S1.jpg';
 ip2:=CreateOleObject('Ip2Com_events.Ip2Com');
if not ip2.F_PICTER_SHOW(str,bool,1) then

ShowMessage('Ошибка');

end;

Выдается сообщение https://delphisources.ru/forum/attac...d=168406220 5

Как решить эту проблему?