[Lazarus] Problems with painting controls on canvas

Joost van der Sluis joost at cnoc.nl
Fri Apr 20 11:51:14 CEST 2012


Hi,

I try to paint a widget with child-widgets on a canvas in an OnPaint
handler. But I can not get it right. Below is my current code. It almost
works, but when I resize the widgets in the designer, there are all kind
of artefacts on the lower right part. It has something to do with the
IntersectClipRect, but I do not understand what it does exactly. 

Can somebody help me with this?

This is my current code: (Adapted from the designnonlcl example)

procedure TMyWidgetMediator.Paint;

  procedure PaintWidget(AWidget: TMyWidget);
  var
    i: Integer;
    Child: TMyWidget;
  begin
    with LCLForm.Canvas do
      begin
      if not (AWidget is TMyForm) then
        begin
        // fill background
        Brush.Style:=bsSolid;
        Brush.Color:=clLtGray;
        // FillRect(0,0,AWidget.Width,AWidget.Height);
        // outer frame
        Pen.Color:=clRed;
        Rectangle(0,0,AWidget.Width,AWidget.Height);
        // caption
        TextOut(5,2,AWidget.Caption);
        end;
      // children
      if AWidget.ChildCount>0 then
        begin
        //SaveHandleState;
        // clip client area
        {if IntersectClipRect(Handle, AWidget.left, AWidget.Top,
AWidget.left+AWidget.Width,
                             AWidget.Height+AWidget.Top)<>NullRegion
        then} begin
          for i:=0 to AWidget.ChildCount-1 do begin
            SaveHandleState;
            Child:=AWidget.Children[i];
            // clip child area
            MoveWindowOrgEx(Handle,Child.Left,Child.Top);
            if
IntersectClipRect(Handle,0,0,Child.Width,Child.Height)<>NullRegion then
              PaintWidget(Child);
            RestoreHandleState;
          end;
        end;
        //RestoreHandleState;
        end;
      end;
  end;

begin
  PaintWidget(MyForm);
  inherited Paint;
end;

Joost.





More information about the Lazarus mailing list