Ir al contenido


Foto

Mostrar un Form desde una dll


  • Por favor identifícate para responder
6 respuestas en este tema

#1 Dante

Dante

    Advanced Member

  • Miembros
  • PipPipPip
  • 89 mensajes

Escrito 02 diciembre 2016 - 07:17

Hola, quiero mostrar un from desde una dll pero al poner el from en la dll esta crese demasiado en tamaño, pense en otra via usando una variable de memoria compartida en la cual ubiera un parametro tipo boolean q la aplicacion estuvera chequeando constantemente y la dll la le asignara TRUE para mostrar el form  q lo pondria en exe. Aguien me puede ayudar por alguna de estas dos vias.


  • 0

#2 enecumene

enecumene

    Webmaster

  • Administrador
  • 7.409 mensajes
  • LocationRepública Dominicana

Escrito 02 diciembre 2016 - 07:43

Creas una dll con la siguiente función:


delphi
  1. uses
  2. SysUtils,Classes,Windows,Messages,Dialogs;
  3.  
  4. function Ventana: Boolean; stdcall;
  5. var Forma: TForm;
  6. begin
  7. Forma := TForm.Create(nil);
  8. try
  9. Forma.ShowModal;
  10. result := true;
  11. except
  12. showMessage('hubo un problema en mostrar la ventana');
  13. result := true;
  14. end;
  15. end;
  16.  
  17. exports Ventana;
  18.  
  19. end.

Y llamas a la función de esta manera:


delphi
  1. var
  2. Form1: TForm1;
  3. function Ventana: Boolean; external 'ventana.dll'; //La DLL que creaste
  4.  
  5. implementation
  6.  
  7. {$R *.dfm}
  8.  
  9. procedure TForm1.Button1Click(Sender: TObject);
  10. begin
  11. Ventana();
  12. end;

Saludos.


  • 0

#3 Dante

Dante

    Advanced Member

  • Miembros
  • PipPipPip
  • 89 mensajes

Escrito 02 diciembre 2016 - 08:14

Grasias pero no me sirver eso, pues me crearia el problema del tamaño de la dll, ademas la q tiene q invocar la from es la dll no la aplicación, q la dll de alguna forma haga saber a la aplicacion de tiene q mostrar el form, otra cosa q pudiera servir es crear la Form en la dll pero por API para no tener q cargar las librerias completas pero ahi estoy mas q frito.


  • 0

#4 escafandra

escafandra

    Advanced Member

  • Moderadores
  • PipPipPip
  • 4.014 mensajes
  • LocationMadrid - España

Escrito 02 diciembre 2016 - 12:34

Mira este ejemplo con API pura:


delphi
  1. program Project1;
  2.  
  3.  
  4. uses
  5. Windows,
  6. Messages,
  7. SysUtils;
  8.  
  9. function WindowProc(Wnd: HWND; uMsg: Cardinal; wParam, lParam: Integer): Integer; stdcall;
  10. var
  11. ps: PAINTSTRUCT;
  12. DC: HDC;
  13. Brush: HBRUSH;
  14. Rect: TRect;
  15. begin
  16. Result := 0;
  17. case uMsg of
  18. WM_PAINT:
  19. begin
  20. DC:= BeginPaint(Wnd, ps);
  21. GetWindowRect(Wnd, Rect);
  22. Brush:= CreateSolidBrush($FF2020); //brocha azul
  23. SelectObject(DC, Brush);
  24. Rectangle(DC, 0, 0, Rect.right, Rect.bottom); //Pintamos un rectángulo, podemos añadir texto o lo que queramos...
  25. DeleteObject(Brush); //Destruimos la brocha
  26. EndPaint(Wnd, ps);
  27. end;
  28. WM_DESTROY:
  29. PostQuitMessage(0); //Destruimos la ventana
  30. else
  31. // Función por defecto de tratamiento de mensajes.
  32. Result:= DefWindowProc(Wnd, uMsg, wParam, lParam);
  33. end;
  34. end;
  35.  
  36. var
  37. Msg: TMsg;
  38. WinClass: WNDCLASS;
  39. Wnd: HWND;
  40. WScreen, HScreen: integer;
  41. begin
  42. WScreen:= GetSystemMetrics(SM_CXSCREEN);
  43. HScreen:= GetSystemMetrics(SM_CYSCREEN);
  44. ZeroMemory(@WinClass, sizeof(WinClass));
  45. WinClass.lpfnWndProc:= @WindowProc;
  46. WinClass.lpszClassName:= 'BSOD';
  47.  
  48. Windows.RegisterClass(WinClass);
  49. Wnd:= CreateWindowEx(0, WinClass.lpszClassName, '', WS_VISIBLE + WS_POPUP,
  50. 0, 0, WScreen, HScreen, HWND_DESKTOP, 0, 0, nil);
  51.  
  52. repeat GetMessage(Msg, 0, 0, 0);
  53. TranslateMessage(Msg);
  54. DispatchMessage(Msg);
  55. until (Msg.Message = WM_QUIT);
  56. end.

Saludos.


  • 1

#5 Dante

Dante

    Advanced Member

  • Miembros
  • PipPipPip
  • 89 mensajes

Escrito 02 diciembre 2016 - 03:26

ya me sirvio ahora voy a ver como le pongo un label


  • 0

#6 escafandra

escafandra

    Advanced Member

  • Moderadores
  • PipPipPip
  • 4.014 mensajes
  • LocationMadrid - España

Escrito 02 diciembre 2016 - 03:36

ya me sirvio ahora voy a ver como le pongo un label

 
No puedes poner un Label estilo VCL, pero si escribir texto con TextOut o quizás mejor con DrawText


Saludos.


  • 1

#7 escafandra

escafandra

    Advanced Member

  • Moderadores
  • PipPipPip
  • 4.014 mensajes
  • LocationMadrid - España

Escrito 02 diciembre 2016 - 06:50

El siguiente ejemplo te muestra como escribir un texto en la ventana creada:


delphi
  1. program Project1;
  2.  
  3.  
  4. uses
  5.   Windows,
  6.   Messages,
  7.   SysUtils;
  8.  
  9. var
  10.   WScreen, HScreen: integer;
  11.   Text: String;
  12.   TextRect: TRect;
  13.   TextSize: TSize;
  14.   Font1, Font2: HFONT;
  15.  
  16. // Encuentra el tamaño de la caja que envuelve un texto multilínea
  17. procedure GetTextExtentML(DC: HDC; Msg: PCHAR; Len: integer; var Size: TSize);
  18. var
  19.   Ancho, Alto, nLines: integer;
  20.   C, Ini: PCHAR;
  21. begin
  22.   Ancho:= 0; Alto:= 0; nLines:= 0;
  23.   C:= Msg; Ini:= Msg;
  24.   repeat
  25.     if ((C+1)^ = #13) or ((C+1)^ = #0) then
  26.     begin
  27.       GetTextExtentPoint32(DC, Ini, DWORD(C)-DWORD(Ini)+1, Size);
  28.       if Ancho < Size.cx then Ancho:= Size.cx;
  29.       if Alto  < Size.cy then Alto:=  Size.cy;
  30.       Ini:= C;
  31.       inc(nLines);
  32.     end;
  33.     inc(C);
  34.   until C^ = #0;
  35.   Size.cx:= Ancho;
  36.   Size.cy:= Alto*nLines;
  37. end;
  38.  
  39. // La función de tratamiento de mensajes
  40. function WindowProc(Wnd: HWND; uMsg: Cardinal; wParam, lParam: Integer): Integer; stdcall;
  41. var
  42.   ps: PAINTSTRUCT;
  43.   DC: HDC;
  44.   Brush: HBRUSH;
  45.   Rect: TRect;
  46. begin
  47.   Result := 0;
  48.   case uMsg of
  49.     WM_PAINT:
  50.     begin
  51.       DC:= BeginPaint(Wnd, ps);          //Comenzamos
  52.       GetWindowRect(Wnd, Rect);
  53.       Brush:= CreateSolidBrush($FF2525); //brocha azul
  54.       SelectObject(DC, Brush);
  55.       Rectangle(DC, 0, 0, Rect.right, Rect.bottom); //Pintamos un rectángulo
  56.       SetTextColor(DC, $FFFFFF);        // Escribimos un Texto
  57.       SetBkMode(DC, TRANSPARENT);
  58.       SelectObject(DC, Font2);
  59.       GetTextExtentPoint32(DC, 'HH', 2, TextSize);
  60.       TextOut(DC, TextSize.cx+(WScreen-TextSize.cx) div 2, TextSize.cy div 2, '}:(', 3);
  61.       SelectObject(DC, Font1);
  62.       DrawText(DC, PCHAR(Text), Length(Text), TextRect, DT_CENTER);
  63.       DeleteObject(Brush);              //Destruimos la brocha
  64.       EndPaint(Wnd, ps);
  65.     end;
  66.     WM_CLOSE:
  67.       DestroyWindow(Wnd);
  68.     WM_DESTROY:
  69.       PostQuitMessage(0);               //Destruimos la ventana
  70.     else
  71.       // Función por defecto de tratamiento de mensajes.
  72.       Result:= DefWindowProc(Wnd, uMsg, wParam, lParam);
  73.   end;
  74. end;
  75.  
  76. // El programa principal
  77. var
  78.   Msg: TMsg;
  79.   WinClass: WNDCLASS;
  80.   DC: HDC;
  81. begin
  82.   WScreen:= GetSystemMetrics(SM_CXSCREEN);
  83.   HScreen:= GetSystemMetrics(SM_CYSCREEN);
  84.  
  85.   // Preparando fuentes y mensaje de texto
  86.   DC:= GetDC(0);
  87.   Font1:= CreateFont(48,0,0,0,FW_BOLD,0,0,0,DEFAULT_CHARSET,OUT_OUTLINE_PRECIS,
  88.                     CLIP_DEFAULT_PRECIS,DEFAULT_QUALITY, VARIABLE_PITCH, 'Arial Rounded MT Bold');
  89.   Font2:= CreateFont(300,0,-900,0,FW_BOLD,0,0,0,DEFAULT_CHARSET,OUT_OUTLINE_PRECIS,
  90.                     CLIP_DEFAULT_PRECIS,DEFAULT_QUALITY, VARIABLE_PITCH, 'Arial Rounded MT Bold');
  91.   Text:= 'HAS SIDO INTERCEPTADO COMO UN SER MALIGNO'+#13+'VAS A SER BLOQUEADO COMO UN VULGAR TERRORISTA'+#13+'TUS ENSERES SERÁN CONFISCADOS';
  92.   SelectObject(DC, Font1);
  93.   GetTextExtentML(DC, PCHAR(Text), Length(Text), TextSize);
  94.   ReleaseDC(0, DC);
  95.   TextRect.Left:= (WScreen - TextSize.cx) div 2;
  96.   TextRect.Right:= TextRect.Left + TextSize.cx;
  97.   TextRect.Top:= (HScreen - TextSize.cy) div 2;
  98.   TextRect.Bottom:= TextRect.Top + TextSize.cy;
  99.  
  100.   // Preparando la ventana
  101.   ZeroMemory(@WinClass, sizeof(WinClass));
  102.   WinClass.lpfnWndProc:= @WindowProc;
  103.   WinClass.lpszClassName:= 'BSOD';
  104.  
  105.   Windows.RegisterClass(WinClass);
  106.   CreateWindowEx(0, WinClass.lpszClassName, '', WS_VISIBLE + WS_POPUP,
  107.                  0, 0, WScreen, HScreen, HWND_DESKTOP, 0, 0, nil);
  108.  
  109.   // El bucle de mensajes
  110.   repeat GetMessage(Msg, 0, 0, 0);
  111.     TranslateMessage(Msg);
  112.     DispatchMessage(Msg);
  113.   until (Msg.Message = WM_QUIT);
  114.  
  115.   // Lipiando
  116.   DeleteObject(Font1);
  117.   DeleteObject(Font2);
  118. end.

Saludos.

Archivos adjuntos

  • Archivo adjunto  BSOD.rar   21,48KB   4 descargas

  • 1