Нарисуйте элементы управления в форме Delphi - PullRequest
4 голосов
/ 18 декабря 2010

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

Я пытаюсь сделать следующее:

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 ]

9 голосов
/ 19 декабря 2010

Не «аннулировать» в обработчике краски. При аннулировании происходит отправка 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 голос
/ 18 декабря 2010

Вы не можете.

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

1 голос
/ 18 декабря 2010

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

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

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

1 голос
/ 18 декабря 2010

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

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

0 голосов
/ 11 декабря 2015

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

Сначала создайте сообщение, подобное этому:

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 сказать Windows все "проверить".

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

Procedure Paint; Override;

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

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

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

...