Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > Синтаксис
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 14.05.2023, 14:04
infopol infopol вне форума
Прохожий
 
Регистрация: 03.06.2021
Сообщения: 35
Версия Delphi: Delphi 7
Репутация: 10
По умолчанию 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

Как решить эту проблему?
Изображения
Тип файла: png Error.png (39.7 Кбайт, 3 просмотров)
Ответить с цитированием
  #2  
Старый 16.05.2023, 14:17
infopol infopol вне форума
Прохожий
 
Регистрация: 03.06.2021
Сообщения: 35
Версия Delphi: Delphi 7
Репутация: 10
По умолчанию Переделал функцию,но как передать в новый объект процедуры первоначальной формы?

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

  ERes:EResNotFound;
//  Action:TCloseAction;
begin
   //    raise ERes.Create('Error!');
         result:=False;
         App:=Application.Create(nil);
       App.Initialize;

         try
                myFormPicter:=TFormPicter.CreateNew(nil,1);
myFormPicter.Image1:=TImage.Create(nil);
myFormPicter.Image1.Parent:= myFormPicter;
myFormPicter.Timer1:=TTimer.Create(nil);


               with  myFormPicter   do
               begin
Color:=clAppWorkSpace;
Height:=340;
Width:=420;


Image1.Height:=Height;
Image1.Width:=Width;
 //    myFormPicter.Image1.OnClick():=ImageClick();
        with Image1  do
                  begin


  end;
Timer1.Interval:=5000;
Timer1.Enabled:=bool;

BorderStyle:=bsToolWindow;
WindowState:=wsNormal;


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


Caption:='Ïðîñìîòð '+str;
Image1.Visible:=True;
Image1.Transparent:=True;
Image1.Picture.LoadFromFile(str);
Image1.Enabled:=true;
Image1.Refresh;
Image1.Align:=alClient
except
//FormPicter.Caption:='Îøèáêà çàãðóçêè èçîáðàæåíèÿ' ;
ShowMessage('Îøèáêà çàãðóçêè èçîáðàæåíèÿ' );
 result:=False;

  Exit;
end;
try
  result:=True;
Enabled:=True;
ShowModal;
Free;
//result:=True;
except
         result:=False;


  ShowMessage('Îøèáêà âûïîëíåíèÿ ôîðìû');
exit;
end;
                 end;

end;

//App.Free;
//DllApp.Destroy;
//btkDLLProc();
//btkDLLProc(1);
    except
                      Eres:=EResNotFound.Create('Error');
       //      raise EResNotFound.CreateFmt('ERes', 'Name');
    //    ShowMessage(Eres.Message);
//Eres:=EResNotFound.Create('Error');
 result:=False;

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

Последний раз редактировалось infopol, 16.05.2023 в 14:18. Причина: ddd
Ответить с цитированием
Ответ


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 23:25.


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2023

ВКонтакте   Facebook   Twitter