Windows - desenhando no desktop

Top  Previous  Next

Desenhando SOBRE o Desktop

**************************

var

  xCanvas : TCanvas;

begin

  inherited;

  xCanvas := TCanvas.Create;

  try

    xCanvas.Handle := GetWindowDC( GetDeskTopWindow );  // Tranca o desktop para desenhar

    try

      xCanvas.Pen.Color := clRed;

      xCanvas.Pen.Width := 3;

 

      xCanvas.MoveTo(0,0);

      xCanvas.LineTo(100,100);

      xCanvas.LineTo(200,0);

      xCanvas.LineTo(300,100);

      xCanvas.LineTo(400,0);

      xCanvas.LineTo(500,100);

      xCanvas.LineTo(600,0);

      xCanvas.LineTo(700,100);

      xCanvas.LineTo(800,0);

      xCanvas.LineTo(900,100);

      xCanvas.LineTo(1000,0);

    finally

      ReleaseDC(Handle, xCanvas.Handle);  // libera o Desktop

    end;

  finally

    xCanvas.Free;

  end;

end;

 

----------------------------- Maneira 1 -------------------------------------------

 

var 

  Form1: TForm1; 

  Canv: TCanvas; 

 

implementation 

 

{$R *.DFM} 

 

procedure TForm1.FormCreate(Sender: TObject); 

begin 

  Canv := TCanvas.Create

  Canv.Handle := GetWindowDC(0); 

end

 

procedure TForm1.FormDestroy(Sender: TObject); 

begin 

  // Finally free the Canvas Object. 

  Canv.Free; 

end

 

 

// Drawing a border 

// Einen Rahmen zeichnen 

 

procedure TForm1.Button1Click(Sender: TObject); 

begin 

  Canv.pen.Color := clred; 

  Canv.pen.Width := 20

  Canv.moveto(Screen.Width, 2); 

  Canv.lineto(22); 

  Canv.lineto(2, Screen.Height); 

  Canv.lineto(Screen.Width, Screen.Height); 

  Canv.lineto(Screen.Width, 2); 

end

 

// Write some Text 

// Text ausgeben 

 

procedure TForm1.Button2Click(Sender: TObject); 

begin 

  Canv.Font.Name   := 'Arial'

  Canv.Font.Size   := 55

  Canv.Font.Color  := clgreen; 

  Canv.Brush.Style := bsclear; 

  Canv.textout(240, Screen.Height div 2 - 30'Hello to Screen !'); 

end

 

// Draw a bitmap 

// Ein Bild Zeichnen 

 

procedure TForm1.Button3Click(Sender: TObject); 

var 

  myBitmap: TBitmap; 

begin 

  myBitmap := TBitmap.Create

  try 

    myBitmap.LoadFromFile('MyImage.bmp'); 

    Canv.draw(100100, myBitmap); 

  finally 

    myBitmap.Free; 

  end

end

 

 

// To Clear the screen: InvalidateRect(0,nil,true); 

 

 

----------------------------- MANEIRA 2 -------------------------------------------

 

Cria uma "bolinha" no desktop e move-a para a direita....

=========================================================

 

procedure TForm1.Button1Click(Sender: TObject);

var

  DC, memDC: HDC; //TwinControl

  x, y     : Integer;

  bmp      : HBitmap;

begin

  x  := Left;

  y  := Top - 40;

  DC := GetDC(0);

  MemDC := CreateCompatibleDC(DC);

  Bmp   := CreateCompatibleBitMap(DC, 2020);

  try

    SelectObject(memDC, bmp);

    BitBlt(memDC, 005050, DC, x, y, SRCCOPY);

    while x < Screen.Width - 50 do

    begin

      BitBlt(DC, x, y, 2020, memDC, 00, SRCCOPY);

      Inc(x, 15);

      BitBlt(memDC, 002020, DC, x, y, SRCCOPY);

      Ellipse(DC, x, y, x+20, y+20);

      Sleep(50);

      Application.ProcessMessages;

    end;

    BitBlt(DC, x, y, 2020, memDC, 00, SRCCOPY);

  finally

    DeleteDC(memDC);

    DeleteObject(bmp);

    ReleaseDC(0, DC);

  end;

end;