Why isn't my scrollbar always spelled correctly?

I have a graphic TCustomControl

descendant component with a system scroll bar on it. The problem is that when I move the window halfway off the screen and then drag it back, the scrollbar disappears (it doesn't get colored). How can I fix this? I think maybe I need to call the scroll method Paint

on the component Paint

, but I don't know how.

Here is the code. No need to install the component or put anything on the main form, just copy the code and assign the event TForm1.FormCreate

:

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.

      

+3


source to share


1 answer


The problem is the installation BevelKind:=bkFlat;

When TWinControl.WMNCPaint is called while painting the non-client area of ​​your control, this will repaint the scrollbar.

As a quick workaround, you can add WMNCPaint to your control and change the region to 1. Delphi will recolor the entire non-client area and then improve slightly.



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 will implement the Bevel pattern. This will reduce flicker.

+3


source







All Articles