9 respuestas en este tema

[escafandra]

Este tutorial lo voy a enfocar a la programación Windows a bajo nivel con API pura. Es un tema un tanto árido pero pienso que si se entiende puede llegar a ser estimulante entender y ser capaz de adentrarnos en esta parte un tanto desconocida para muchos.

Con el fin de amenizar este, ya de por si, árido tema voy a escribir con vosotros una aplicación salvapantallas en delphi que será totalmente funcional y útil.

El bucle de mensajes:
En primer lugar ya sabemos que Windows se maneja a base de mensajes y que lo hace a través de un bucle de mensajes. Esos mensajes son tratados en una función especial de tratamiento de mensajes. Cuando creamos una ventana tenemos de definir una de las clases preexistentes o una nueva definida por usuario.

Todo bucle de mensajes en Windows tiene mas o menos este aspecto:

delphi

while(GetMessage(Msg, 0, 0, 0)) do
begin
  TranslateMessage(Msg);
  DispatchMessage(Msg);
end;

GetMessage: Espera hasta recibir un mensaje entrante.
TranslateMessage: Traduce los mensajes del teclado de Virtual-Key a caracteres produciendo un mensaje tipo WM_CHAR o WM_DEADCHAR.
DispatchMessage: envía el mensaje a la función de tratamiento de mensajes de la ventana destinataria.

En nuestro primer proyecto vamos a crear una ventana que ocupe toda la pantalla y la vamos a pintar de un solo color tratando el mensaje WM_PAINT  y la vamos a destruir con WM_DESTROY.

Algunos habréis visto algo de código de ejemplo en las páginas de ayuda de Microsoft y os resultará familiar una función principal como esta:

delphi

function WinMain(hInstance, hPrevInstance: THISTANCE; lpCmdLine: LPSTR; nCmdShow: integer): cardinal; stdcall;

En Delphi esta función no está predefinida en ningún proyecto, así que para poder acercar nuestro código de ejemplo a lo que podáis ver en la web, nos la vamos a currar. El siguiente código va a ser común en todos los ejemplos y constituye el inicio de nuestro programa:

delphi

program BanScr_1;
 
uses
  Windows,
  Unit1 in 'Unit1.pas';
 
var
  info: STARTUPINFO;
  CmdLine: PCHAR;
  n: integer;
 
begin
  GetStartupInfo(info);
  CmdLine:= GetCommandLine();
  n:=0;
  //Navegamos por CmdLine a través de comillas y espacios
  //para aislar solo los parámetros pasados a nuestra App.
  if CmdLine^ = #34 then
    repeat inc(n);
    until(CmdLine[n] = #34);
  while(CmdLine[n]<>#32) do inc(n);
  inc(n);
  if n = lstrlen(CmdLine) then CmdLine:= nil
  else CmdLine:= CmdLine+n;
  ExitProcess(WinMain(GetModuleHandle(nil), 0, CmdLine, info.wShowWindow));
end.

El código anterior se encarga de crear los parámetros para la función main, hInstance de la aplicación, la línea de comandos que se le pasa (eliminando el nombre del ejecutable y la ruta) y la visibilidad de la misma. Vemos el uso exclusivo de la API incluso para el tratamiento de cadenas de texto. Este proyecto base puede servir para cualquier aplicación Windows a bajo nivel que posteriormente queramos escribir.

La función WinMain y el resto del programa la escribiremos en un módulo aparte: Unit1.pas

delphi

function WinMain(hInstance, hPrevInstance: THISTANCE; lpCmdLine: LPSTR; nCmdShow: integer): cardinal; stdcall;
var
  Wnd: HWND;
  WScreen, HScreen: integer;
  WinClass: WNDCLASS;
  Msg: TMsg;
begin
  WScreen:= GetSystemMetrics(SM_CXSCREEN);
  HScreen:= GetSystemMetrics(SM_CYSCREEN);
  ZeroMemory(@WinClass, sizeof(WinClass));
  WinClass.lpfnWndProc:= @WindowProc;
  WinClass.lpszClassName:= 'WindowsScreenSaverClass';
  // Registramos nuestra clase de ventana
  RegisterClass(WinClass);
  //Creamos la ventana
  Wnd:= CreateWindowEx(0, WinClass.lpszClassName, 'SCR', WS_VISIBLE + WS_OVERLAPPEDWINDOW,
                        0, 0, WScreen, HScreen, HWND_DESKTOP, 0, 0, nil);
  // El bucle de mensajes
  while(GetMessage(Msg, 0, 0, 0)) do
  begin
    TranslateMessage(Msg);
    DispatchMessage(Msg);
  end;
 
  Result:= 0;
end;

En este caso estamos creando una nueva clase de ventana que llamamos SCR y a la que asociamos una función de tratamiento de mensajes WindowProc. En principio creamos una ventana de esa clase que va a ocupar toda la pantalla y va a tener caption y botones de sistema. Esa ventana va a responder a dos mensajes: WM_PAINT y WM_DESTROY. En ella sólo vamos a dibujar un rectángulo blanco que ocupa toda su área cliente.

Función de tratamiento de mensajes:
Esta función tendrá la siguiente forma para ir respondiendo a los diferentes mensajes que le correspondan. Cada ventana estará diseñada para responder a los que nos parezcan.

delphi

function WindowProc(Wnd: HWND; uMsg: Cardinal; wParam, lParam: Integer): Integer; stdcall;
begin
  case uMsg of
    WM_PAINT:
      .…
    WM_CHAR:
      .….
      .....
    WM_DESTROY:
      PostQuitMessage(0);                //Destruimos la ventana
 
    else
      // Función por defecto de tratamiento de mensajes.
      Result:= DefWindowProc(Wnd, uMsg, wParam, lParam);  end;
  end; 
end;

Para asociar la función con la ventana tenemos la API RegisterClass Esta API usa como parámetro una estructura WNDCLASS que, entre otros valores, porta un puntero a la función de tratamiento de mensajes.

Este es el código completo:

delphi

unit Unit1;
 
interface
 
uses
  Windows,
  Messages;
 
type THISTANCE = HMODULE;
 
function  WinMain(hInstance, hPrevInstance: HMODULE; lpCmdLine: LPSTR; nCmdShow: integer): cardinal; stdcall;
 
implementation
 
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($FFFFFF); //brocha blanca
      SelectObject(DC, Brush);
      Rectangle(DC, 0, 0, Rect.right, Rect.bottom); //Pintamos un rectángulo
      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;
 
function WinMain(hInstance, hPrevInstance: THISTANCE; lpCmdLine: LPSTR; nCmdShow: integer): cardinal; stdcall;
var
  Wnd: HWND;
  WScreen, HScreen: integer;
  WinClass: WNDCLASS;
  Msg: TMsg;
begin
  WScreen:= GetSystemMetrics(SM_CXSCREEN);
  HScreen:= GetSystemMetrics(SM_CYSCREEN);
  ZeroMemory(@WinClass, sizeof(WinClass));
  WinClass.lpfnWndProc:= @WindowProc;
  WinClass.lpszClassName:= 'WindowsScreenSaverClass';
  // Registramos nuestra clase de ventana
  RegisterClass(WinClass);
  //Creamos la ventana
  Wnd:= CreateWindowEx(0, WinClass.lpszClassName, 'SCR', WS_VISIBLE + WS_OVERLAPPEDWINDOW,
                        0, 0, WScreen, HScreen, HWND_DESKTOP, 0, 0, nil);
  // El bucle de mensajes
  while(GetMessage(Msg, 0, 0, 0)) do
  begin
    TranslateMessage(Msg);
    DispatchMessage(Msg);
  end;
 
  Result:= 0;
end;
 
end.

Para no agobiar mas esta parte paramos en este punto. En la siguiente añadiremos mas funcionalidades a nuestro embrión de salvapantallas.



Saludos.


Edito para resubir el archivo de código

Archivos adjuntos

•  Parte1.rar   10,23KB   10 descargas

[Wilson]

Gracias maestro, como siempre, código de gran calidad. 

Un abrazo.

[escafandra]

Parte 2

En esta entrega seguimos trabajando sobre el proyecto anterior. Añadimos lo siguiente:

- Quitamos el borde y botones de la ventana
- La pintamos de negro
- Añadimos respuesta a los mensajes de teclado y ratón.
- Añadimos respuesta retardada al movimiento del ratón.
- Escondemos el cursor del sistema.
- Implementamos el modo preview
- Forzar a nuestra ventana a permanecer en primer plano (no necesario).

Un aviso con este código, dado que esconde el cursor y fuerza la ventana el primer plano podemos llevarlos la desagradable sorpresa de perder el control si tratamos de debuguear el programa, por lo tanto estas opciones deben instalarse en la versión final ya depurada de esta fase. En este ejercicio podemos experimentar con el primer plano si no lo ejecutamos desde la configuración de pantalla->salvapantallas sino como una aplicación corriente.

La mecánica de pintar de negro la pantalla ya la conocemos. La respuesta a los mensajes de teclado y ratón será terminar el programa inmediatamente pero de forma controlada, como todo buen salvapantallas que se precie.

La ventana estará en primer plano si usamos el estilo WS_EX_TOPMOST al crearla, pero en las pruebas no conviene dejar activa esta opción.

Nuestra función de tratamiento de mensajes, hasta ahora el corazón del programa, queda así:

delphi

function WindowProc(Wnd: HWND; uMsg: Cardinal; wParam, lParam: Integer): Integer; stdcall;
const
{$J+}
  i: integer = 0;
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(0);    //brocha negra
      SelectObject(DC, Brush);
      Rectangle(DC, 0, 0, Rect.right, Rect.bottom); //Pintamos un rectángulo
      DeleteObject(Brush);            //Destruimos la brocha
      EndPaint(Wnd, ps);
    end;
    WM_KEYDOWN,
    WM_LBUTTONDOWN,
    WM_MBUTTONDOWN,
    WM_RBUTTONDOWN,
    WM_MOUSEWHEEL:
      if ScrMode = Full then PostQuitMessage(0); //Destruimos la ventana
    WM_MOUSEMOVE:
      if (i>15) and (ScrMode = Full) then PostQuitMessage(0) //Para dilatar un poco el movimiento del mouse
      else inc(i);
    WM_DESTROY,
    WM_SYSCOMMAND:
    begin
      PostQuitMessage(0);
    end
    else
    // Función por defecto de tratamiento de mensajes.
    Result:= DefWindowProc(Wnd, uMsg, wParam, lParam);
  end;
{$J-}
end;

La directiva {$J+}  es para conseguir modificar las constantes consiguiendo variables static, {$J-} anula lo anterior,

En el modo preview  la aplicación no terminará con teclado y ratón pero si con un WM_DESTROY y WM_ SYSCOMMAND. El truco para que se vea el preview en la ventanita del visor del salvapantallas está en darle estilo WS_CHILD y a su parent asignarle la ventanita en cuestión. Cuanto el visor del salvapantallas hace un preview arranca el salvapantallas con los parámetros /p y el valor numérico del Handle de la ventanita: /p handle. Sabiendo esto prepararemos el tamaño y parent de nuestro salvapantallas para ajustarlo al visor.

Nuestro prototipo ya es un salvapantallas pero de momento no hace nada mas que poner en negro la pantalla y no es configurable, aunque si hace un preview. Ya podemos dar la extensión “scr” en Projects Opcions ->Application->Target File Extensión = scr. Ahora ya podemos instalarlo y probarlo.

Esta será la función WinMain:

delphi

function WinMain(hInstance, hPrevInstance: THISTANCE; lpCmdLine: LPSTR; nCmdShow: integer): cardinal; stdcall;
var
  WScreen, HScreen: integer;
  WinClass: WNDCLASS;
  Msg: TMsg;
  ParentWnd: HWND;
  PreviewRect: TRect;
  Style: DWORD;
begin
//  ScrMode:= None;
  ScrMode:= Full;
  Style:= 0;
  ParentWnd:= HWND_DESKTOP;
 
  if lpCmdLine <> nil then
  case (lpCmdLine+1)^ of
    's', 'S': ScrMode:= Full;
    'p', 'P': ScrMode:= Preview;
  end;
 
  if (ScrMode = Full) or (ScrMode = None) then
  begin
    // Indicamos a windows que comienza el salvapantallas...
    SystemParametersInfo(SPI_SCREENSAVERRUNNING, 1, nil, 0);
    ShowCursor(false);
 
    WScreen:= GetSystemMetrics(SM_CXSCREEN);
    HScreen:= GetSystemMetrics(SM_CYSCREEN);
    Style:= WS_VISIBLE + WS_POPUP;
  end
  else if  ScrMode = Preview then
  begin
    ParentWnd:= StrToIntA(GetParam(lpCmdLine, 1));
    GetWindowRect(ParentWnd, PreviewRect);
    WScreen:= PreviewRect.right-PreviewRect.left;
    HScreen:= PreviewRect.bottom-PreviewRect.top;
    Style:= WS_VISIBLE + WS_CHILD;
  end;
 
  ZeroMemory(@WinClass, sizeof(WinClass));
  WinClass.lpfnWndProc:= @WindowProc;
  WinClass.lpszClassName:= 'WindowsScreenSaverClass';
  // Registramos nuestra clase de ventana
  RegisterClass(WinClass);
  //Creamos la ventana en primer plano
  //Wnd:= CreateWindowEx(WS_EX_TOPMOST, WinClass.lpszClassName, 'SCR', Style,
  Wnd:= CreateWindowEx(0, WinClass.lpszClassName, '', Style,
                        0, 0, WScreen, HScreen, ParentWnd, 0, 0, nil);
 
  // El bucle de mensajes
  while(GetMessage(Msg, 0, 0, 0)) do
  begin
    TranslateMessage(Msg);
    DispatchMessage(Msg);
  end;
 
  // Indicamos a windows que terminó el salvapantallas...
  if (ScrMode = Full) or (ScrMode = None) then
    SystemParametersInfo(SPI_SCREENSAVERRUNNING, 0, nil, 0);
  Result:= 0;
end;

Señalar que debemos indicar a Windows cuando arranca y cuando termina el salvapantallas con SystemParametersInfo.

El siguiente paso será dotarle de la funcionalidad para representar las fotografías de la carpeta donde se encuentre y en varios formatos de archivo pero eso lo vamos a implementar en la siguiente entrega.

Repito el peligro de hacer un debug desde delphi con esta versión forzada de primer plano y sin cursor de ratón. El ide de delphi no será controlable con nuestra ventana en primer plano y su código parado por delphi. Para experimentar cambiar WS_EX_TOPMOST por 0.



Saludos.

Edito para resubir el archivo adjunto de código

[poliburro]

Increible¡¡¡¡¡¡¡¡¡¡. Amigo escafandra muchas gracias por compartirnos tu conocimiento.  Esto va directo al face.

[Wilson]

Maestro Escafandra, una línea de código vale más que mil palabras..., infinitas gracias por compartirnos una parte de tu enorme conocimiento. 

[off-topic]

Esto va directo al face.

Poli, no crees que estamos ya muy viejitos para andar con el face? 
[/off-topic]

[poliburro]

[off-topic]
Poli, no crees que estamos ya muy viejitos para andar con el face? 
[/off-topic]

[off-topic]
    jajajaja amigo Wilson la piel se arruga, pero  por dentro aún somos unos chamacones,
[/off-topic]

[egostar]

[off-topic]
Poli, no crees que estamos ya muy viejitos para andar con el face? 
[/off-topic]

[off-topic]
Me consta que al buen compañero poliburro, se le refrescó la "sangre de puma" y recobró las ganas de escribir, ahora es todo un jovenzuelo imberbe queriendose comer el mundo a puños
[/off-topic]

Que buen código amigo escafandra, como siempre, nos regalas un pedazo de inteligencia

Saludos

[escafandra]

Parte 3

Si hemos entendido las dos primeras partes, estamos en disposición de dar un salto y complicar el código de nuestro embrión. Vamos a volcar imágenes en nuestra ventana desde archivos. Para ello nos vamos a apoyar en GDI plus, tema sobre el que ya se ha sido publicado en el foro.

El código fundamental está centrado en el tratamiento del mensaje WM_PAINT y  funciones de apoyo.


Dibujando un Bitmap en una ventana:

Para dibujar un Bitmap en una ventana procederemos de la siguiente forma:

delphi

var
  ps: PAINTSTRUCT;
  DC, dcMem: HDC;
  Brush: HBRUSH;
  bmOld: HBITMAP;
  Rect: TRect;
begin
  case uMsg of
    WM_PAINT:
    begin
      DC:= BeginPaint(Wnd, ps);        //Comenzamos
      GetWindowRect(Wnd, Rect);
      Brush:= CreateSolidBrush(0);    //brocha negra
      SelectObject(DC, Brush);
      dcMem:= CreateCompatibleDC(DC);
      bmOld:= SelectObject(dcMem, Image);
 
      // Rellenamos la pantalla de negro
      Rectangle(DC, 0, 0, Rect.right, Rect.bottom);
     
      // Pintamos el bitmap
      BitBlt(DC, 0, 0, Rect.right, Rect.bottom, dcMem, 0, 0, SRCCOPY);
 
      // Destruimos lo que ya no hace falta
      SelectObject(dcMem, bmOld);
      DeleteDC(dcMem);
      DeleteObject(Brush);           
      EndPaint(Wnd, ps);
    end;
…………….

Pintamos primero de negro para no dejar feos huecos sin pintar que contendrán las imágenes que estén detrás de nuestra ventana. Este código vuelca el HBITMAP Image en el DC de nuestra ventana salvapantallas. Ahora nos podemos plantear que si el tamaño del bitmap es menor que la pantalla, parte quedará en negro, pero si es mayor, parte se perderá. Además la imagen no estará centrada en la pantalla. Este código podemos modificarlo para centrar nuestro bitmap, pero lo ideal es que nuestra imagen trate de aprovechar al máximo la pantalla. Para conseguir esto echamos mano de GDI plus y de código que ya publiqué en el foro para adaptarlo a esta necesidad.


Dibujar un Bitmap centrado y aprovechando toda la pantalla:

Lo que vamos a hacer para optimizar el rendimiento es pasar, al tratamiento WM_PAINT, un HBITMAP ya preparado en Image que va a ser tan grande como la pantalla y contendrá centrada la imagen que adaptará su tamaño para aprovechar al máximo las dimensiones respetando sus proporciones.
 

delphi

function LoadBitmapW(FileName: PWCHAR): HBITMAP;
var
  bm: BITMAP;
  Rect: TRECT;
  Bitmap, bmOld: HBITMAP;
  DC, dcMem: HDC;
  Brush: HBRUSH;
  H, W, Ws, Hs: integer;
begin
  Result:= 0;
  if not IsGraphFileName(FileName) then exit;
  Bitmap:= CreateHBITMAPFromFileW(FileName);
  if Bitmap = 0 then exit;
 
  GetWindowRect(Wnd, Rect);
  GetObject(Bitmap, sizeof(bm), @bm);
  GetWindowRect(Wnd, Rect);
 
  // Calculando tamaño de la imagen para ajustarse a la pantalla
  Ws:= Rect.right - Rect.left;
  Hs:= Rect.bottom - Rect.top;
  H:= bm.bmHeight;
  W:= bm.bmWidth;
 
  // Comparando proporciones de pantalla e imagen para ajustar el tamaño
  if(W/H > Ws/Hs) then
  begin
    H:= MulDiv(Ws, H, W);
    W:= Ws;
  end
  else
  begin
    W:= MulDiv(Hs, W, H);
    H:= Hs;
  end;
 
  DC:= GetDC(0);
  dcMem:= CreateCompatibleDC(0);
  Result:= CreateCompatibleBitmap(DC, Ws, Hs);
  bmOld:= SelectObject(dcMem, Result);
  GetObject(Result, sizeof(bm), @bm);
  Brush:= CreateSolidBrush(0);
  SelectObject(dcMem, Brush);
  Rectangle(dcMem, 0, 0, Rect.right, Rect.bottom);
 
  // Dibujando la imagen con el nuevo tamaño, centrada y respetando proporciones iniciales
  DrawImageRect(dcMem, Bitmap, (Ws-W) div 2, (Hs-H) div 2, W, H);
 
  DeleteObject(Bitmap);
  SelectObject(dcMem, bmOld);
  DeleteDC(dcMem);
  DeleteObject(Brush);
  ReleaseDC(0, DC);
end;

Veis que el código anterior comprueba si la extensión es de un formato gráfico conocido por GDI plus. Esto realmente no es necesario, pero lo he implementado para dar mas velocidad en el caso de imágenes existentes en carpetas con infinidad de archivos no gráficos (véase \Windows\system32\*.*)

CreateHBITMAPFromFileW y DrawImageRect son funciones que usan GDI plus y ya publicadas en el foro, o alguna variante de las mismas.

Por si hubiese problemas con los archivos adjuntos las voy a escribir:
 

delphi

// Crea un HBITMAP desde un fichero usando GDI+
function CreateHBITMAPFromFileW(FileName: PWCHAR): HBITMAP;
var
  Bitmap: HBITMAP;
  GBitmap: THANDLE;
begin
  Bitmap:= 0;
  GBitmap:= 0;
  GdipCreateBitmapFromFile(FileName, GBitmap);
  GdipCreateHBITMAPFromBitmap(GBitmap, Bitmap, 0);
  GdipDisposeImage(GBitmap);
  Result:= Bitmap;
end;
 
// Dibuja un Bitmap en un hDC ajustando su tamaño para que quepa entero
// en las coordenadas dadas
procedure DrawImageRect(DC: HDC; Bitmap: HBITMAP; X, Y, W, H: integer);
var
  Graphics: Pointer;
  GBitmap:  THANDLE;
begin
  GdipCreateBitmapFromHBITMAP(Bitmap, 0, GBitmap);
  GdipCreateFromHDC(DC, Graphics);
  GdipDrawImageRect(Graphics, GBitmap, X, Y, W, H);
  GdipDisposeImage(GBitmap);
  GdipDeleteGraphics(Graphics);
end;

Simplificando WindowProc:

Con la filosofía expuesta podemos simplificar algo mas el tratamiento de WM_PAINT.

delphi

    WM_PAINT:
    begin
      DC:= BeginPaint(Wnd, ps);       
      GetWindowRect(Wnd, Rect);
      dcMem:= CreateCompatibleDC(DC);
      bmOld:= SelectObject(dcMem, Image);
 
      BitBlt(DC, 0, 0, Rect.right, Rect.bottom, dcMem, 0, 0, SRCCOPY);
 
      SelectObject(dcMem, bmOld);
      DeleteDC(dcMem);
      EndPaint(Wnd, ps);
    end;

Con esto tenemos resuelto el tema de la carga de imágenes pero nos falta como renovarlas.


Renovando las imágenes mostradas:

Para renovar las imágenes mostradas usaremos un timer que se encargará de recorrer los archivos de una carpeta y encontrar aquellos formatos gráficos que nuestro salvapantallas pueda representar con GDI plus (BMP, GIF, JPEG, PNG, TIFF, WMF, EMF, ICON), para proceder a ello.

La API SetTimer pone en marcha un timer y se para con KillTimer

La siguiente es la función que usaremos para el timer que renovará las imágenes de nuestro salvapantallas:
 

delphi

// Función de timer para cargar y mostrar una nueva imagen
procedure NewImage(Wnd: HWND; uMsg: UINT; idEvent: UINT; dwTime: DWORD); stdcall;
const
{$J+}
  hFind: THANDLE = INVALID_HANDLE_VALUE;
  fd: WIN32_FIND_DATAW = ();
  Next: boolean = false;
var
  Count: integer;
begin
  KillTimer(Wnd, New);
  ShowMouseCursor(false);
 
  if Image<>0 then DeleteObject(Image);
  Image:= 0;
  Count:= 0;
  while (Image = 0) and (Count = 0) do
  begin
    if not Next then
    begin
      hFind:= FindFirstFileW('*.*', fd);
      inc(Count);
    end;
    repeat
      if fd.dwFileAttributes = FILE_ATTRIBUTE_ARCHIVE then
        Image:= LoadBitmapW(fd.cFileName);
      Next:= FindNextFileW(hFind, fd);
    until not Next or (Image <> 0);
    if Image <> 0 then ReDrawWindow(Wnd);
    if not Next then FindClose(hFind);
  end;
  SetTimer(Wnd, New, NewTime, @NewImage);
{$J-}
end;

Esta función para el timer en su inicio para restaurarlo al final, con el fin de comenzar una cuenta nueva cuando termine. Su cometido es recorrer todos los archivos del directorio de trabajo y tratar de cargarlos como imagen, si lo consigue guarda el HBITMAP en la variable Image y obliga a repintar la ventana. Después deja todo preparado para la siguiente entrada de timer para lo que debe tener “memoria” de donde se quedó la última vez eso lo conseguimos con la directiva{$J+} que convierte las constantes en variables estáticas de delphi, característica que muchos pensarán que no tenía. Al terminar la carpeta se reinicia de nuevo la búsqueda.


Rescribiendo la función WindowProc:

Finalmente nuestra función WinMain debe ser adaptada para inicializar el timer al inicio del programa y para inicializar GDI plus:
 

delphi

function WinMain(hInstance, hPrevInstance: THISTANCE; lpCmdLine: LPSTR; nCmdShow: integer): cardinal; stdcall;
var
  WScreen, HScreen: integer;
  WinClass: WNDCLASS;
  Msg: TMsg;
  ParentWnd: HWND;
  PreviewRect: TRect;
  Style: DWORD;
  gdiplusToken: DWORD;
  GdiPlusStartupInput: array[0..2] of int64;
begin
 
  GetModuleFileName(0, Buffer, sizeof(Buffer));
  SetCurrentDirectory(GetAppPath(Buffer, sizeof(Buffer)));
 
  // Inicializamos GDI+.
  GdiPlusStartupInput[0]:= 1; GdiPlusStartupInput[1]:= 0;
  GdiplusStartup(gdiplusToken, @GdiPlusStartupInput, nil);
 
  ScrMode:= Full;
  Style:= 0;
  ParentWnd:= HWND_DESKTOP;
 
  if lpCmdLine <> nil then
  case (lpCmdLine+1)^ of
    's', 'S': ScrMode:= Full;
    'p', 'P': ScrMode:= Preview;
  end;
 
  if (ScrMode = Full) or (ScrMode = None) then
  begin
    // Indicamos a windows que comienza el salvapantallas...
    SystemParametersInfo(SPI_SCREENSAVERRUNNING, 1, nil, 0);
    ShowCursor(false);
 
    WScreen:= GetSystemMetrics(SM_CXSCREEN);
    HScreen:= GetSystemMetrics(SM_CYSCREEN);
    Style:= WS_VISIBLE + WS_POPUP;
  end
  else if  ScrMode = Preview then
  begin
    NewTime:= 3000;
    ParentWnd:= StrToIntA(GetParam(lpCmdLine, 1));
    GetWindowRect(ParentWnd, PreviewRect);
    WScreen:= PreviewRect.right-PreviewRect.left;
    HScreen:= PreviewRect.bottom-PreviewRect.top;
    Style:= WS_VISIBLE + WS_CHILD;
  end;
 
  ZeroMemory(@WinClass, sizeof(WinClass));
  WinClass.lpfnWndProc:= @WindowProc;
  WinClass.lpszClassName:= 'WindowsScreenSaverClass';
  // Registramos nuestra clase de ventana
  RegisterClass(WinClass);
  //Creamos la ventana en primer plano
  //Wnd:= CreateWindowEx(WS_EX_TOPMOST, WinClass.lpszClassName, '', Style,
  Wnd:= CreateWindowEx(0, WinClass.lpszClassName, '', Style,
                        0, 0, WScreen, HScreen, ParentWnd, 0, 0, nil);
  // Evento Timer.
  SetTimer(Wnd, New, NewTime, @NewImage);
  // Fuerzo cargar la primera imagen
  NewImage(Wnd, 0, 0, 0);
 
  // El bucle de mensajes
  while(GetMessage(Msg, 0, 0, 0)) do
  begin
    TranslateMessage(Msg);
    DispatchMessage(Msg);
  end;
 
  // Cerramos GDI+
  GdiplusShutdown(gdiplusToken);
  ShowCursor(true);
  Result:= 0;
end;

Principales parámetros de entrada de un salvapantallas:

He de recalcar que un salvapantallas debe dar respuesta a los siguientes parámetros de entrada al programa:

/s La respuesta será poner en marcha el salvapantallas y es así como le arranca el sistema cuando lo pone en marcha.
/p Es el parámetro que define el modo preview. El salvamantallas se mostrará en una ventanita del sistema mostrando su funcionalidad, para ello el sistema tambien pasa el valor del handle de la ventana del visor de esta forma: /p handle.
/c Es el modo configuración. El salvapantallas mostrará una ventana de dialogo para configurar sus características.

Llegados a este punto hemos conseguido nuestro objetivo. Tenemos un salvapantallas que está escrito para Windows usando sólo la API y en delphi. No hemos escatimado esfuerzos incluso para el tratamiento de cadenas a bajo nivel. Nuestro salvapantallas muestra las Imágenes contenidas en una carpeta, sea cual sea su formato y dispone de modo preview.

El ejercicio de ejemplo puede irse complicando mucho mas añadiendo un dialogo de configuración, transiciones entre imágenes y lo que la imaginación nos dicte, pero posiblemente ya sea suficiente para este minitutorial.

Espero no haber aburrido y que sea de utilidad para entender mas a fondo como trabaja Windows.

Añado todo el código que he ido escribiendo para este tutorial.



Saludos.

Edito para arreglar etiquetas de código

Archivos adjuntos

•  Parte3.rar   14,76KB   6 descargas

[ELKurgan]

Excelente tutorial, como siempre

Muchas gracias, maestro

[escafandra]

Parte 4: Suavizando el cambio de imágenes

La parte tres del tutorial sugería el uso de transiciones entre las imágenes representadas y acordándome de un tutorial que publiqué denominado Transparencias no he podido contenerme y he decidido ampliar el tema para aplicar un efecto de fundido entre imágenes.


Transición de fundido entre imágenes:

El fundido lo realizaremos pintando sobre la antigua imagen otra nueva con grado creciente de opacidad hasta verse sólo la nueva imagen. El efecto de transparencia se consigue con la API AlphaBlend. Y para que el efecto sea visualmente progresivo vamos a usar un thread. Me parece interesante incluir este concepto en este tutorial aunque ya escribí otro específico del tema: Threads con Windows API. Un tutorial sencillo.

Comenzamos adaptando la API AlphaBlend al uso que le daremos. Como hemos diseñado el salvapantallas guardando un HBITMAP que usará el mensaje WM_PAINT, vamos a adaptar AlphBlend para usar bitmaps en lugar de HDC. Para ello creamos un CompatibleDC al que asociamos un bitmap que usaremos como parámetro. Val será el valos de opacidad entre 0 y 255. Debemos desasociar nuestro DC del bitmap antes de destruirlo.
 

delphi

// Dibuja un Bitmap sobre otro de forma semitransparente
// Val: valor de opacidad
procedure DrawSemiTransparent(Tbmp, Sbmp: HBITMAP; Val: integer);
var
  bm: BITMAP;
  bf: BLENDFUNCTION;
  SdcMem, TdcMem: HDC;
  SbmOld, TbmOld: HBITMAP;
begin
  bf.BlendOp:= AC_SRC_OVER;
  bf.BlendFlags:= 0;
  bf.SourceConstantAlpha:= Val;
  bf.AlphaFormat:= 0;
  GetObject(Sbmp, sizeof(bm), @bm);
  SdcMem:= CreateCompatibleDC(0);
  TdcMem:= CreateCompatibleDC(0);
  SbmOld:= SelectObject(SdcMem, Sbmp);
  TbmOld:= SelectObject(TdcMem, Tbmp);
  Windows.AlphaBlend(TdcMem, 0, 0, bm.bmWidth, bm.bmHeight, SdcMem, 0, 0, bm.bmWidth, bm.bmHeight, bf);
  SelectObject(SdcMem, SbmOld);
  DeleteObject(SdcMem);
  SelectObject(TdcMem, TbmOld);
  DeleteObject(TdcMem);
end;

Usando threads

Ahora vamos a crear el efecto usando varias veces la anterior función hasta la opacidad total. Para el efecto usamos un thread.

Recordemos que un thread es un hilo de código que corre paralelo y simultaneo con el hilo principal de la aplicación. Se pone en marcha con la API CreateThread (recordar el tutorial antes citado) Entre sus parámetros se encuentran dos muy importantes, el primero la función del thread y el segundo un puntero que se pasa a la función del thread y que suele ser un puntero a una estructura de datos (record), es decir, es el parámetro de la función del thread. Nosotros no necesitamos parámetros pues los datos que usará nuestro thread son variables globales.

La función del thread es la siguiente:

delphi

function Fundido(): DWORD; stdcall;
var
  i: WORD;
begin
  i:= 0;
  repeat
    i:= i+4;
    DrawSemiTransparent(Image, NewBitmap, i-1);
    Sleep(10);
    ReDrawWindow(Wnd);
  until i > 255;
  DeleteObject(NewBitmap); NewBitmap:= 0;
  Result:= 0;
end;

Como veis es un bucle que va dando valores de opacidad a NewBitmap sobre Image y redibujando la ventana en cada iteración. Fácil, pero podemos preguntar para que demonios necesitamos un thread. La explicación es sencilla. Si queremos que nuestro salvapantallas reaccione con rapidez a un movimiento de ratón o pulsación de una tecla no podemos permitir que la aplicación se enganche en un bucle. Un thread dará un aspecto mas profesional al rendimiento deseado. Así que os propongo esta solución sencilla:
 

delphi

procedure Transit();
function Fundido(): DWORD; stdcall;
var
  i: WORD;
begin
  i:= 0;
  repeat
    i:= i+4;
    DrawSemiTransparent(Image, NewBitmap, i-1);
    Sleep(10);
    ReDrawWindow(Wnd);
  until i > 255;
  DeleteObject(NewBitmap); NewBitmap:= 0;
  Result:= 0;
end;
var
  DC: HDC;
begin;
  if NewBitmap = 0 then
  begin
    // Si no hay Bitmap creo uno vacio
    DC:= GetDC(0);
    NewBitmap:= CreateCompatibleBitmap(DC, GetSystemMetrics(SM_CXSCREEN), GetSystemMetrics(SM_CYSCREEN));
    ReleaseDC(0, DC);
  end;
  CloseHandle(CreateThread(nil, 0, @Fundido, nil, 0, PDWORD(0)^));
end;

La parte final asegura que NewBitmap va a ser válido y haremos un fundido aunque sea en negro antes de poner en marcha el thread.

Podemos acelerar o retrasar el efecto jugando son los valores del bucle y la espera de la API sleep


Adaptando nuestro salvapantallas:

Ahora sólo cabe realizar alguna modificación en el código del salvapantallas para introducir estas dos nuevas funciones:

Añadimos otra variable global NewBitmap que es un HBITMAP y tiene la nueva imagen a para fundir con la previa y modificamos ligeramente el procedimiento NewImage, llamada por un timer para actualizar la imagen.
 

delphi

procedure NewImage(Wnd: HWND; uMsg: UINT; idEvent: UINT; dwTime: DWORD); stdcall;
const
{$J+}
  hFind: THANDLE = INVALID_HANDLE_VALUE;
  fd: WIN32_FIND_DATAW = ();
  Next: boolean = false;
var
  Count: integer;
begin
  KillTimer(Wnd, New);
 
  if NewBitmap<>0 then DeleteObject(NewBitmap);
  NewBitmap:= 0;
  Count:= 0;
  while (NewBitmap = 0) and (Count = 0) do
  begin
    if not Next then
    begin
      hFind:= FindFirstFileW('*.*', fd);
      inc(Count);
    end;
    repeat
      if fd.dwFileAttributes = FILE_ATTRIBUTE_ARCHIVE then
        NewBitmap:= LoadBitmapW(fd.cFileName);
      Next:= FindNextFileW(hFind, fd);
    until not Next or (NewBitmap <> 0);
    if NewBitmap<>0 then Transit;
    if not Next then FindClose(hFind);
  end;
  Transit;
  SetTimer(Wnd, New, NewTime, @NewImage);
{$J-}
end;

Ya podemos probar nuestro efecto.


Capturando el contenido de una ventana:

Las transiciones son ahora suaves pero, al iniciar el salvapantallas, la primera imagen se muestra bruscamente. La solución es capturar la pantalla antes de iniciar el volcado de esa primera imagen, así el efecto es completo y logramos rizar el rizo. En realidad no vamos a capturar la pantalla sino el contenido de nuestra ventana salvapantallas tras crearla y antes de comenzar el bucle de mensajes pues entonces será transparente y contiene la pantalla en si misma. ¿Y entonces porque no capturar la pantalla?, pues porque recordad que nuestro salvapantallas hace preview y quedaría muy feo ver en la ventanita preview como aparece un fragmento de pantalla completa para luego fundirse con la primera imagen. Con nuestra técnica fundiría sobre el contenido previo de la ventanita.

Escribamos el código para capturar el contenido de una ventana. Si os fijáis capturo el área cliente pero podría capturarse completa. La técnica ya la conocéis con el uso de la API BitBlt, que ya hemos usado otras veces, para copiar un HDC (Canvas), en este caso el contenido gráfico de la ventana, en otro que está asociado a un HBITMAP que será el resultado de nuestra función. Como esta función crea un HBITMAP, deberemos ser responsables de su destrucción posterior.
 

delphi

function CreateCaptureWindow(Wnd: HWND): HBITMAP;
var
  Rect: TRECT;
  ScreenDC, DC: HDC;
  oldbmp: HBITMAP;
begin
  GetClientRect(Wnd, Rect);
  ScreenDC:= GetDC(Wnd);
  DC:= CreateCompatibleDC(0);
  Result:= CreateCompatibleBitmap(ScreenDC, Rect.Right, Rect.Bottom);
  oldbmp:= SelectObject(DC, Result);
  BitBlt(DC, 0, 0, Rect.Right, Rect.Bottom, ScreenDC, 0, 0, SRCCOPY);// + $40000000);
  ReleaseDC(Wnd, ScreenDC);
  SelectObject(DC, oldbmp);
  DeleteObject(DC);
end;

Modificando WinMain:

Hagamos los ajustes necesarios en WinMain:
 

delphi

function WinMain(hInstance, hPrevInstance: THISTANCE; lpCmdLine: LPSTR; nCmdShow: integer): cardinal; stdcall;
var
  WScreen, HScreen: integer;
  WinClass: WNDCLASS;
  Msg: TMsg;
  ParentWnd: HWND;
  PreviewRect: TRect;
  Style: DWORD;
  gdiplusToken: DWORD;
  GdiPlusStartupInput: array[0..2] of int64;
  DC: HDC;
begin
 
  // Establecemos el directorio de trabajo
  SetCurrentDirectory(GetAppPath(Buffer, sizeof(Buffer)));
 
  // Inicializamos GDI+.
  GdiPlusStartupInput[0]:= 1; GdiPlusStartupInput[1]:= 0;
  GdiplusStartup(gdiplusToken, @GdiPlusStartupInput, nil);
 
  ScrMode:= Full;
  Style:= 0;
  ParentWnd:= HWND_DESKTOP;
 
  if lpCmdLine <> nil then
  case (lpCmdLine+1)^ of
    's', 'S': ScrMode:= Full;
    'p', 'P': ScrMode:= Preview;
  end;
 
  if (ScrMode = Full) or (ScrMode = None) then
  begin
    // Indicamos a windows que comienza el salvapantallas...
    SystemParametersInfo(SPI_SCREENSAVERRUNNING, 1, nil, 0);
    ShowCursor(false);
 
    WScreen:= GetSystemMetrics(SM_CXSCREEN);
    HScreen:= GetSystemMetrics(SM_CYSCREEN);
    Style:= WS_VISIBLE + WS_POPUP;
  end
  else if  ScrMode = Preview then
  begin
    NewTime:= 3000;
    ParentWnd:= StrToIntA(GetParam(lpCmdLine, 1));
    GetWindowRect(ParentWnd, PreviewRect);
    WScreen:= PreviewRect.right-PreviewRect.left;
    HScreen:= PreviewRect.bottom-PreviewRect.top;
    Style:= WS_VISIBLE + WS_CHILD;
  end;
 
  ZeroMemory(@WinClass, sizeof(WinClass));
  WinClass.lpfnWndProc:= @WindowProc;
  WinClass.lpszClassName:= 'WindowsScreenSaverClass';
  // Registramos nuestra clase de ventana
  RegisterClass(WinClass);
  //Creamos la ventana en primer plano
  Wnd:= CreateWindowEx(WS_EX_TOPMOST, WinClass.lpszClassName, '', Style,
//  Wnd:= CreateWindowEx(0, WinClass.lpszClassName, '', Style,
                        0, 0, WScreen, HScreen, ParentWnd, 0, 0, nil);
 
  Image:= CreateCaptureWindow(Wnd);
 
  // Fuerzo cargar la primera imagen
  NewImage(Wnd, 0, 0, 0);
 
  // Evento Timer.
  SetTimer(Wnd, New, NewTime, @NewImage);
  // El bucle de mensajes
  while(GetMessage(Msg, 0, 0, 0)) do
  begin
    TranslateMessage(Msg);
    DispatchMessage(Msg);
  end;
 
  if Image <> 0 then DeleteObject(Image);
  if NewBitmap <> 0 then DeleteObject(NewBitmap);
 
  // Cerramos GDI+
  GdiplusShutdown(gdiplusToken);
  ShowCursor(true);
  Result:= 0;
end;

Como veis, poco hemos cambiado. Iniciamos el HBITMAP Image con el contenido de la ventana principal antes del bucle de mensajes, con lo que en realidad contiene todo lo que esté detrás de ella ocupado por sus dimensiones (pantalla completa). Para terminar nos aseguramos que tanto Image como NewBitmap sean destruidos al finalizar el programa.
Notad que como ambos bitmaps se crean y destruyen cada vez que se renueva una imagen, en cada destrucción nos aseguramos previamente de que no es nulo y tras destruirlo le asignamos este valor. Así nos aseguramos de destruir algo válido y no previamente destruido.

Hemos tocado aspectos básicos de la programación bajo Windows con la API, ventanas y mensajes. También hemos visto aspectos gráficos con GDI y GDI plus, manejo de varios formatos gráficos, transparencias y capturas.

Espero que esta última 4ª parte haya sido de vuestro agrado.



Saludos.

Edito para resubir adjunto de código

Archivos adjuntos

•  Parte4.rar   15,54KB   1 descargas