Нарисуйте элементы управления в форме Delphi

Как нарисовать что-то на холсте форм и над элементами управления на форме?

Я пробую следующее:

procedure TForm1.FormPaint(Sender: TObject);
var x,y: Integer;
begin
  x := Mouse.CursorPos.X - 10;
  y := Mouse.CursorPos.Y - 10;
  x := ScreentoClient(point(x,y)).X - 10;
  y := ScreenToClient(point(x,y)).Y - 10;
  Canvas.Brush.Color := clRed;
  Canvas.FillRect(rect(x, y, x + 10, y + 10));
  Invalidate;
end;

Прямоугольник рисуется до того, как нарисованы другие элементы управления, поэтому он скрыт за элементами управления (это ожидаемое поведение в соответствии с Документами Delphi).

Мои вопросы: как я могу нарисовать элементы управления?

Источник

5 ответов

Решение

Не "лишать законной силы" в обработчике краски. Признание причиняет WM_PAINT быть отправленным, что, конечно, начинает обработку краски на всем протяжении. Даже если вы не двигаете мышь, пример кода, который вы разместили, будет вызывать событие "OnPaint" снова и снова. Так как ваш рисунок зависит от положения курсора, вы должны использовать для этого событие "OnMouseMove". Но вам нужно перехватывать сообщения мыши и для других оконных элементов управления. Приведенный ниже пример использует компонент ApplicationEvents по этой причине. Если ваше приложение будет иметь более одной формы, вам необходимо разработать механизм, позволяющий определить, какую форму вы рисуете.

Также смотрите на документах, которые VCL Invalidate делает недействительным все окно. Вам не нужно этого делать, вы рисуете крошечный прямоугольник и точно знаете, где рисуете. Просто опровергните, где вы будете рисовать и где вы рисовали.

Что касается рисования на элементах управления, то на самом деле рисовать часть легко, но вы не можете сделать это с помощью предоставленного холста. Формы получили WS_CLIPCHILDREN стиль, поверхности дочерних окон будут исключены из области обновления, поэтому вам придется использовать GetDCEx или же GetWindowDC, Как упоминалось в комментариях "user205376", удаление того, что вы нарисовали, немного сложнее, поскольку вы можете нарисовать один прямоугольник на нескольких элементах управления. Но API имеет ярлык для этого тоже, как вы увидите в коде.

Я попытался немного прокомментировать код, чтобы иметь возможность следовать, но пропустил обработку ошибок. Фактическое рисование может быть в обработчике события "OnPaint", но элементы управления, которые не выходят из "TWinControl", рисуются после обработчика. Так что это в обработчике WM_PAINT.

type
  TForm1 = class(TForm)
    [..]
    ApplicationEvents1: TApplicationEvents;
    procedure FormCreate(Sender: TObject);
    procedure ApplicationEvents1Message(var Msg: tagMSG; var Handled: Boolean);
  private
    FMousePt, FOldPt: TPoint;
    procedure WM_PAINT(var Msg: TWmPaint); message WM_PAINT;
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  // no rectangle drawn at form creation
  FOldPt := Point(-1, -1);
end;

procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
  var Handled: Boolean);
var
  R: TRect;
  Pt: TPoint;
begin
  if Msg.message = WM_MOUSEMOVE then begin

    // assume no drawing (will test later against the point).
    // also, below RedrawWindow will cause an immediate WM_PAINT, this will
    // provide a hint to the paint handler to not to draw anything yet.
    FMousePt := Point(-1, -1);


    // first, if there's already a previous rectangle, invalidate it to clear
    if (FOldPt.X > 0) and (FOldPt.Y > 0) then begin
      R := Rect(FOldPt.X - 10, FOldPt.Y - 10, FOldPt.X, FOldPt.Y);
      InvalidateRect(Handle, @R, True);

      // invalidate childs
      // the pointer could be on one window yet parts of the rectangle could be
      // on a child or/and a parent, better let Windows handle it all
      RedrawWindow(Handle, @R, 0,
                     RDW_INVALIDATE or RDW_UPDATENOW or RDW_ALLCHILDREN);
    end;


    // is the message window our form?
    if Msg.hwnd = Handle then
      // then save the bottom-right coordinates
      FMousePt := SmallPointToPoint(TSmallPoint(Msg.lParam))
    else begin
      // is the message window one of our child windows?
      if GetAncestor(Msg.hwnd, GA_ROOT) = Handle then begin
        // then convert to form's client coordinates
        Pt := SmallPointToPoint(TSmallPoint(Msg.lParam));
        windows.ClientToScreen(Msg.hwnd, Pt);
        FMousePt := ScreenToClient(Pt);
      end;
    end;

    // will we draw?  (test against the point)
    if PtInRect(ClientRect, FMousePt) then begin
      R := Rect(FMousePt.X - 10, FMousePt.Y - 10, FMousePt.X, FMousePt.Y);
      InvalidateRect(Handle, @R, False);
    end;
  end;
end;

procedure TForm1.WM_PAINT(var Msg: TWmPaint);
var
  DC: HDC;
  Rgn: HRGN;
begin
  inherited;

  if (FMousePt.X > 0) and (FMousePt.Y > 0) then begin
    // save where we draw, we'll need to erase before we draw an other one
    FOldPt := FMousePt;

    // get a dc that could draw on child windows
    DC := GetDCEx(Handle, 0, DCX_PARENTCLIP);

    // don't draw on borders & caption
    Rgn := CreateRectRgn(ClientRect.Left, ClientRect.Top,
                          ClientRect.Right, ClientRect.Bottom);
    SelectClipRgn(DC, Rgn);
    DeleteObject(Rgn);

    // draw a red rectangle
    SelectObject(DC, GetStockObject(DC_BRUSH));
    SetDCBrushColor(DC, ColorToRGB(clRed));
    FillRect(DC, Rect(FMousePt.X - 10, FMousePt.Y - 10, FMousePt.X, FMousePt.Y), 0);

    ReleaseDC(Handle, DC);
  end;
end;
Источник

Главное окно приложения не может рисовать поверх другой контрольной поверхности. Элементы управления периодически рисуют и стирают сами (на основе элемента управления "цикл рисования")

Ваше приложение может использовать только те элементы управления, которые позволяют приложению это делать. Многие общие элементы управления предоставляют приложениям гибкость в настройке внешнего вида элемента управления с помощью пользовательских методов управления.

Источник

Ты не сможешь это сделать. Вам нужно создать оконный элемент управления (например, окно) и поместить это окно поверх элементов управления, которые вы хотите нарисовать "на". Тогда вы можете либо

  1. скопируйте растровое изображение формы с элементами управления и используйте это растровое изображение в качестве фонового изображения этого нового элемента управления, или

  2. Сделайте так, чтобы это новое окно имело неправильную форму, чтобы оно было прозрачным вне некоторой области неправильной формы.

Источник

Ты не можешь

Элементы управления отображаются поверх их родительского окна. Все, что вы рисуете в родительском окне, будет видно за элементами управления над этим окном. Непонятно, зачем вам нужно делать такой рисунок; однако, возможно, вы можете создать прозрачный элемент управления внутри формы и установить его на передний план, а затем нарисовать на холсте. Таким образом, ваш чертеж будет выглядеть поверх формы и других элементов управления, но в этом случае пользователь не сможет взаимодействовать с другими элементами управления в форме, поскольку они находятся за прозрачным элементом управления.

Источник

Я сделал кое-что, что вовлекало, чтобы нарисовать ручки вокруг компонентов на моей форме, вот что я сделал.

Сначала создайте сообщение как это:

Const
PM_AfterPaint = WM_App + 1;

Напишите процедуру для обработки сообщения:

Procedure AfterPaint(var msg: tmsg); Message PM_AfterPaint;

Procedure AfterPaint(var msg: tmsg);
begin
  {place the drawing code here}
  ValidateRect(Handle, ClientRect);
end;

Validaterect сообщит Windows, что нет необходимости перекрашивать вашу форму. Ваша картина приведет к тому, что часть формы станет "недействительной". ValidateRect сказать окнам все "проверить".

На последнем шаге также необходимо переопределить процедуру рисования.

Procedure Paint; Override;

Procedure TForm1.paint;
Begin
  Inherited;
  PostMessage(Handle, PM_AfterPaint, 0, 0);
End;

Поэтому каждый раз, когда ваша форма должна быть перекрашена (WM_Paint), она вызывает краску предка и добавляет сообщение AfterPaint в очередь сообщений. Когда сообщение обрабатывается, AfterPaint вызывает и рисует ваши вещи и сообщает Windows, что все в порядке, предотвращая повторный вызов для рисования.

Надеюсь, это поможет.

Источник
Другие вопросы по тегам