Код:
procedure DrawOnScreen(const S: string);
var
DC: HDC;
Canvas: TCanvas;
X, Y: Integer;
begin
DC := GetDC(0);
Canvas := TCanvas.Create;
try
Canvas.Handle := DC;
Canvas.Brush.Style := bsClear;
with Canvas.Font do
begin
Name := 'Times New Roman';
Size := 50;
Color := clRed;
end;
X := (GetSystemMetrics(SM_CXSCREEN) - Canvas.TextWidth(S)) div 2;
Y := (GetSystemMetrics(SM_CYSCREEN) - Canvas.TextHeight(S)) div 2;
Canvas.TextOut(x, y, S);
finally
ReleaseDC(0,DC);
Canvas.Free;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
DrawOnScreen('Сообщение на экране');
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
RedrawWindow(GetDesktopWindow,nil,0,RDW_INVALIDATE + RDW_UPDATENOW + RDW_ALLCHILDREN);
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
RedrawWindow(GetDesktopWindow, nil, 0, RDW_ERASE or RDW_INVALIDATE or RDW_UPDATENOW or RDW_ALLCHILDREN or RDW_FRAME);
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
InvalidateRect(0,0,false);
InvalidateRect(0,0,true);
end;
Нюансы работы:
1. Текст выводится в чёрном прямоугольнике, а хотелось бы, чтобы фон текста отсутствовал, т.е. чёрного прямоугольника не было.
2. При нажатии на Button2 и Button3 текст не исчезает, хотя должен бы. При нажатии на Button4 - исчезает, но:
3. При выводе другого текста, он отображается наложением на старый.
Почему не стирается предыдущий текст и как избавиться от чёрного прямоугольника вокруг текста? Операционные Vista и Win7.