6 respuestas en este tema

[Dante]

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.

[enecumene]

Creas una dll con la siguiente función:

delphi

uses
 SysUtils,Classes,Windows,Messages,Dialogs;
 
function Ventana: Boolean; stdcall;
var Forma: TForm;
begin
 Forma := TForm.Create(nil);
 try
  Forma.ShowModal;
  result := true;
 except
  showMessage('hubo un problema en mostrar la ventana');
  result := true;
 end;
end;
 
exports Ventana;
 
end.

Y llamas a la función de esta manera:

delphi

var
 Form1: TForm1;
 function Ventana: Boolean; external 'ventana.dll'; //La DLL que creaste
 
implementation
 
{$R *.dfm}
 
procedure TForm1.Button1Click(Sender: TObject);
begin
 Ventana();
end;

Saludos.

[Dante]

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.

[escafandra]

Mira este ejemplo con API pura:

delphi

program Project1;
 
 
uses
  Windows,
  Messages,
  SysUtils;
 
function WindowProc(Wnd: HWND; uMsg: Cardinal; wParam, lParam: Integer): Integer; stdcall;
var
  ps: PAINTSTRUCT;
  DC: HDC;
  Brush: HBRUSH;
  Rect: TRect;
begin
  Result := 0;
  case uMsg of
    WM_PAINT:
    begin
      DC:= BeginPaint(Wnd, ps);          
      GetWindowRect(Wnd, Rect);
      Brush:= CreateSolidBrush($FF2020); //brocha azul
      SelectObject(DC, Brush);
      Rectangle(DC, 0, 0, Rect.right, Rect.bottom); //Pintamos un rectángulo, podemos añadir texto o lo que queramos...
      DeleteObject(Brush);              //Destruimos la brocha
      EndPaint(Wnd, ps);
    end;
    WM_DESTROY:
      PostQuitMessage(0);                //Destruimos la ventana
    else
      // Función por defecto de tratamiento de mensajes.
      Result:= DefWindowProc(Wnd, uMsg, wParam, lParam);
  end;
end;
 
var
  Msg: TMsg;
  WinClass: WNDCLASS;
  Wnd: HWND;
  WScreen, HScreen: integer;
begin
  WScreen:= GetSystemMetrics(SM_CXSCREEN);
  HScreen:= GetSystemMetrics(SM_CYSCREEN);
  ZeroMemory(@WinClass, sizeof(WinClass));
  WinClass.lpfnWndProc:= @WindowProc;
  WinClass.lpszClassName:= 'BSOD';
 
  Windows.RegisterClass(WinClass);
  Wnd:= CreateWindowEx(0, WinClass.lpszClassName, '', WS_VISIBLE + WS_POPUP,
                        0, 0, WScreen, HScreen, HWND_DESKTOP, 0, 0, nil);
 
  repeat GetMessage(Msg, 0, 0, 0);
    TranslateMessage(Msg);
    DispatchMessage(Msg);
  until (Msg.Message = WM_QUIT);
end.

Saludos.

[Dante]

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

[escafandra]

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.

[escafandra]

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

delphi

program Project1;
 
 
uses
  Windows,
  Messages,
  SysUtils;
 
var
  WScreen, HScreen: integer;
  Text: String;
  TextRect: TRect;
  TextSize: TSize;
  Font1, Font2: HFONT;
 
// Encuentra el tamaño de la caja que envuelve un texto multilínea
procedure GetTextExtentML(DC: HDC; Msg: PCHAR; Len: integer; var Size: TSize);
var
  Ancho, Alto, nLines: integer;
  C, Ini: PCHAR;
begin
  Ancho:= 0; Alto:= 0; nLines:= 0;
  C:= Msg; Ini:= Msg;
  repeat
    if ((C+1)^ = #13) or ((C+1)^ = #0) then
    begin
      GetTextExtentPoint32(DC, Ini, DWORD(C)-DWORD(Ini)+1, Size);
      if Ancho < Size.cx then Ancho:= Size.cx;
      if Alto  < Size.cy then Alto:=  Size.cy;
      Ini:= C;
      inc(nLines);
    end;
    inc(C);
  until C^ = #0;
  Size.cx:= Ancho;
  Size.cy:= Alto*nLines;
end;
 
// La función de tratamiento de mensajes
function WindowProc(Wnd: HWND; uMsg: Cardinal; wParam, lParam: Integer): Integer; stdcall;
var
  ps: PAINTSTRUCT;
  DC: HDC;
  Brush: HBRUSH;
  Rect: TRect;
begin
  Result := 0;
  case uMsg of
    WM_PAINT:
    begin
      DC:= BeginPaint(Wnd, ps);          //Comenzamos
      GetWindowRect(Wnd, Rect);
      Brush:= CreateSolidBrush($FF2525); //brocha azul
      SelectObject(DC, Brush);
      Rectangle(DC, 0, 0, Rect.right, Rect.bottom); //Pintamos un rectángulo
      SetTextColor(DC, $FFFFFF);        // Escribimos un Texto
      SetBkMode(DC, TRANSPARENT);
      SelectObject(DC, Font2);
      GetTextExtentPoint32(DC, 'HH', 2, TextSize);
      TextOut(DC, TextSize.cx+(WScreen-TextSize.cx) div 2, TextSize.cy div 2, '}:(', 3);
      SelectObject(DC, Font1);
      DrawText(DC, PCHAR(Text), Length(Text), TextRect, DT_CENTER);
      DeleteObject(Brush);              //Destruimos la brocha
      EndPaint(Wnd, ps);
    end;
    WM_CLOSE:
      DestroyWindow(Wnd);
    WM_DESTROY:
      PostQuitMessage(0);               //Destruimos la ventana
    else
      // Función por defecto de tratamiento de mensajes.
      Result:= DefWindowProc(Wnd, uMsg, wParam, lParam);
  end;
end;
 
// El programa principal
var
  Msg: TMsg;
  WinClass: WNDCLASS;
  DC: HDC;
begin
  WScreen:= GetSystemMetrics(SM_CXSCREEN);
  HScreen:= GetSystemMetrics(SM_CYSCREEN);
 
  // Preparando fuentes y mensaje de texto
  DC:= GetDC(0);
  Font1:= CreateFont(48,0,0,0,FW_BOLD,0,0,0,DEFAULT_CHARSET,OUT_OUTLINE_PRECIS,
                    CLIP_DEFAULT_PRECIS,DEFAULT_QUALITY, VARIABLE_PITCH, 'Arial Rounded MT Bold');
  Font2:= CreateFont(300,0,-900,0,FW_BOLD,0,0,0,DEFAULT_CHARSET,OUT_OUTLINE_PRECIS,
                    CLIP_DEFAULT_PRECIS,DEFAULT_QUALITY, VARIABLE_PITCH, 'Arial Rounded MT Bold');
  Text:= 'HAS SIDO INTERCEPTADO COMO UN SER MALIGNO'+#13+'VAS A SER BLOQUEADO COMO UN VULGAR TERRORISTA'+#13+'TUS ENSERES SERÁN CONFISCADOS';
  SelectObject(DC, Font1);
  GetTextExtentML(DC, PCHAR(Text), Length(Text), TextSize);
  ReleaseDC(0, DC);
  TextRect.Left:= (WScreen - TextSize.cx) div 2;
  TextRect.Right:= TextRect.Left + TextSize.cx;
  TextRect.Top:= (HScreen - TextSize.cy) div 2;
  TextRect.Bottom:= TextRect.Top + TextSize.cy;
 
  // Preparando la ventana
  ZeroMemory(@WinClass, sizeof(WinClass));
  WinClass.lpfnWndProc:= @WindowProc;
  WinClass.lpszClassName:= 'BSOD';
 
  Windows.RegisterClass(WinClass);
  CreateWindowEx(0, WinClass.lpszClassName, '', WS_VISIBLE + WS_POPUP,
                 0, 0, WScreen, HScreen, HWND_DESKTOP, 0, 0, nil);
 
  // El bucle de mensajes
  repeat GetMessage(Msg, 0, 0, 0);
    TranslateMessage(Msg);
    DispatchMessage(Msg);
  until (Msg.Message = WM_QUIT);
 
  // Lipiando
  DeleteObject(Font1);
  DeleteObject(Font2);
end.

Saludos.

Archivos adjuntos

•  BSOD.rar   21,48KB   4 descargas