TFORM.Seek not implemented
Код:
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
Как решить эту проблему?
|