2006. november 22., szerda

How to capture the Desktop and shade it


Problem/Question/Abstract:

How to capture the Desktop and shade it

Answer:

This unit takes the Desktop and makes it look like it does when you select Shutdown from the Start menu. You need a TForm with BorderStyle set to bsNone and a TImage component set to alClient.

procedure TForm1.FormShow(Sender: TObject);

  procedure Veil;
  var
    BrushBmp: TBitmap;
    X, Y: Integer;
  begin
    BrushBmp := TBitmap.Create;
    with BrushBmp do
    begin
      Width := 8;
      Height := 8;
      for X := 0 to 7 do
        for Y := 0 to 7 do
          if Odd(X + Y) then
            Canvas.Pixels[X, Y] := clWhite
          else
            Canvas.Pixels[X, Y] := clBlack;
    end;
    Image1.Canvas.Brush.Bitmap := BrushBmp;
    {The PatBlt function paints the given rectangle using the brush that is
                currently selected into the specified device context.
                The brush color and the surface color(s) are combined by using the
    given raster operation.}
    PatBlt(Image1.Canvas.Handle, 0, 0, Image1.Width, Image1.Height, $000A0329);
    BrushBmp.Free;
  end;

var
  ScreenDC: HDC;
  tmpRect: TRect;
  tmpBitmap: TBitmap;
begin
  {Set the form bounds}
  SetBounds(0, 0, Screen.Width, Screen.Height);
  {get our screen device context}
  ScreenDC := GetDC(0);
  {create our bitmap}
  tmpBitmap := TBitmap.Create;
  {get the screen area}
  tmpRect := Rect(0, 0, Screen.Width, Screen.Height);
  {set the bitmap to the screen area}
  tmpBitmap.Width := tmpRect.Right - tmpRect.Left;
  tmpBitmap.Height := tmpRect.Bottom - tmpRect.Top;
  try
    {transfer the screen pixels to the bitmap}
    BitBlt(tmpBitmap.Canvas.Handle, tmpRect.Left, tmpRect.Top, tmpBitmap.Width,
      tmpBitmap.Height, ScreenDC, tmpRect.Left, tmpRect.Top, SRCCOPY);
    {assign the bitmap image to our TImage}
    Image1.Picture.Bitmap.Assign(tmpBitmap);
  finally
    {free our bitmap}
    tmpBitmap.Free;
    {release our screen device context}
    ReleaseDC(0, ScreenDC);
  end;
  Veil;
end;

end.

Nincsenek megjegyzések:

Megjegyzés küldése