_Vasilisk_Login_not_secureа код посмотреть?Какой код? Вызов двух функций?
Нет, это было предложение посмотреть код в первом посте.
КвейдInvalidate в начале WMPaint приведет к повторному вызову WMPaint, в начале которого стоит Invalidate.
Даю наводку в сторону того, как правильно делать:
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
procedure TScrollBoxTest.WMHScroll(var Message: TWMHScroll);
begin
inherited;
Invalidate
end;
procedure TScrollBoxTest.WMVScroll(var Message: TWMVScroll);
begin
inherited;
Invalidate
end;
Работает, спасибо (хотя я мог бы и сам догадаться).
Всё же ушёл от Begin/EndPaint в WMPaint, т.к. это делает бессмысленным механизм двойного буферирования. Итоговый вариант:
1) в WMPaint добавляется csCustomPaint в ControlState, вызов метода предка, состояние удаляется
2) перекрытие PaintWindow
3) перекрытие сообщений скролла с вызовом Invalidate
код для справки (добавил еще перемещаемый круг).
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
end;
TScrollBoxTest = class(Vcl.Forms.TScrollBox)
procedure Paint(DC: HDC; const from: string);
procedure PaintWindow(DC: HDC); override;
procedure WMHScroll(var Message: TWMHScroll); message WM_HSCROLL;
procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL;
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
end;
var
Form1: TForm1;
scr: TScrollBoxTest;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
scr.Refresh;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
scr := TScrollBoxTest.Create(Self);
scr.Parent := Self;
scr.Top := 10;
scr.Left := 10;
scr.Height := 300;
scr.Width := 150;
scr.HorzScrollBar.Range := 1000;
scr.VertScrollBar.Range := 1000;
scr.DoubleBuffered := True;
end;
{ TScrollBoxTest }
procedure TScrollBoxTest.Paint(DC: HDC; const from: string);
var r: TRect;
begin
OutputDebugString(pchar(from));
brush.Color := random(clWhite);
r := ClientRect;
FillRect(DC, r, Brush.Handle);
brush.Color := clWhite;
// static
Ellipse(DC, 0, 0, 100, 100);
// moveable
Ellipse(DC,
10-HorzScrollBar.Position, 10-VertScrollBar.Position,
10-HorzScrollBar.Position+20, 10-VertScrollBar.Position+20);
end;
procedure TScrollBoxTest.PaintWindow(DC: HDC);
begin
Paint(DC, 'PaintWindow');
end;
// ! Only with this state call chain TWinControl.WMPaint > PaintHandler > PaintWindow
// will be executed.
procedure TScrollBoxTest.WMPaint(var Message: TWMPaint);
begin
ControlState := ControlState + [csCustomPaint];
inherited;
ControlState := ControlState - [csCustomPaint];
end;
procedure TScrollBoxTest.WMHScroll(var Message: TWMHScroll);
begin
inherited;
Invalidate;
end;
procedure TScrollBoxTest.WMVScroll(var Message: TWMVScroll);
begin
inherited;
Invalidate;
end;
end.
Собственно, примерно таким способом и реализован TCustomControl (всё новое - не найденное в исходниках старое).
Пока остановлюсь на таком варианте.
