3

I have a graphical TCustomControl descendant component with a system scrollbar on it. The problem is that when I move the window half outside the screen and then I drag it back, the scrollbar disappers (it's not painted). How can I fix this ? I'm thinking, maybe I should call the scrollbar Paint method in component Paint but I don't know how.

Here is the code. There is no need install the component or to put something on the main form, just copy the code and assign TForm1.FormCreate event:

Unit1.pas

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, SuperList;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  end;

var
  Form1: TForm1;
  List: TSuperList;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
 List:=TSuperList.Create(self);
 List.AlignWithMargins:=true;
 List.Align:=alClient;
 List.Visible:=true;
 List.Parent:=Form1;
end;

end.

SuperList.pas

unit SuperList;

interface

uses Windows, Controls, Graphics, Classes, Messages, SysUtils, StdCtrls, Forms;

type

  TSuperList = class(TCustomControl)
  public
    DX,DY: integer;
    procedure   Paint; override;
    constructor Create(AOwner: TComponent); override;
    procedure   WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
    procedure   CreateParams(var Params: TCreateParams); override;
  published
    property    TabStop default true;
    property    Align;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Marus', [TSuperList]);
end;

procedure TSuperList.CreateParams(var Params: TCreateParams);
begin
  inherited;
  Params.Style := Params.Style or WS_VSCROLL;
end;

procedure TSuperList.WMLButtonDown(var Message: TWMLButtonDown);
begin
 DX:=Message.XPos;
 DY:=Message.YPos;
 Invalidate;
 inherited;
end;

constructor TSuperList.Create(AOwner: TComponent);
begin
 inherited;
 DoubleBuffered:=true;
 TabStop:=true;
 Color:=clBtnFace;
 BevelKind:=bkFlat;
 Width:=200; Height:=100;
 DX:=50; DY:=50;
end;

procedure TSuperList.Paint;
begin
 Canvas.Brush.Color:=clWindow;
 Canvas.FillRect(Canvas.ClipRect);
 Canvas.TextOut(10,10,'Press left mouse button !');
 Canvas.Brush.Color:=clRed;
 Canvas.Pen.Color:=clBlue;
 Canvas.Rectangle(DX,DY,DX+30,DY+20);
end;

end.
Marus Gradinaru
  • 2,824
  • 1
  • 26
  • 55
  • Not sure about your problem as I haven't tested it out. But a quick look at your code shows an error that might bug you in the future. What is this error. In your component type definition you made TabStop property as published so that it will be visible in ObjectInspector and thus alow users to set it to True or False depending on their needs but in the component constructor you always set TabStop to True thus overriding the TabStop value set at design time. And this could piss your users as chacging that value at design time would have no effect. So you end up with a quickly overlooked bug. – SilverWarior Oct 07 '14 at 22:33
  • No, that it's not an error. The constructor is executed only once, when you put the component on the form and after that you can change the value of the property as you want. I've tested. – Marus Gradinaru Oct 07 '14 at 23:10
  • You should not set DoubleBuffered in the control's code. Likewise TabStop. SilverWarrior's comment is accurate. – David Heffernan Oct 08 '14 at 07:20
  • @Silver & David No, that's no bug because the `TabStop` property has the correct default specifier. The designtime settings are loaded in áfter component's creation. Marus is correct that this will not trouble the user of the component. – NGLN Oct 08 '14 at 07:38
  • Confirmed: buggy in D7, fixed at least in XE2. This seems related to [Bugfix for BorderWidth > 0 in combination with a scroll bar?](http://stackoverflow.com/q/14798240/757830). – NGLN Oct 08 '14 at 07:47
  • @NGLN Fair enough. I didn't look at that. Setting `DoubleBuffered` is still wrong though. – David Heffernan Oct 09 '14 at 16:40
  • If I dont't set `DoubleBufferd` in my control, it will be unusable. It flickers like hell. But with `DoubleBufferd` works perfectly. I don't see way it's wrong... – Marus Gradinaru Oct 09 '14 at 16:48

1 Answers1

3

The problem is because of setting BevelKind:=bkFlat;

When TWinControl.WMNCPaint is called during painting the non client area of your control, this will overpaint the scrollbar.

As a quick workaround you could add WMNCPaint to your control and change the Region to 1. Delphi will repaint the entire non client area then, which works a little better.

procedure WMNCPaint(var Message: TWMNCPaint); message WM_NCPAINT;

procedure TSuperList.WMNCPaint(var Message: TWMNCPaint);
var
  TmpRgn: HRGN;
begin
  TmpRgn := Message.RGN;
  try
    Message.RGN := 1;
    inherited;
  finally
    Message.RGN := TmpRgn;
  end;
  // if you want to add some custom NC painting, you could do it here...
end;

A cleaner solution would be implementing the Bevel painting on your own. This will reduce flickering.

Sebastian Z
  • 4,520
  • 1
  • 15
  • 30
  • I had it in there because TWinControl calls DefaultHandler with the original RGN handle. It is probably not needed. – Sebastian Z Oct 08 '14 at 10:29
  • Thank ! It works very well, and I have no flicker. But in case I wanna try painting the bevel on my own, as you recommended, where should I do the painting, in `WM_PAINT` or in `WM_NCPAINT` ? – Marus Gradinaru Oct 08 '14 at 16:10
  • If your control uses `WMNCCalcSize` for calculating the non-client area (this is the case if you set BevelKind), then you should paint the bevel in WM_NCPaint. – Sebastian Z Oct 09 '14 at 05:58