|
Вопрос # 3 767/ вопрос открыт / |
|
Здравствуйте!
Столкнулся с проблемой мерцания контролов при ресайзе формы. Все конролы расположены на Tpanel, сама же панель выронена, так, что при изменении размеров формы, меняются размеры панели.
Если контролы переместить на панель, которая не меняет своих размеров, то и контролы не мерцают.
Использование свойства формы DoubleBuffered:=True; не решает проблемы.
Так как же избавиться от мерацания? Заранее спасибо за ответы.
 |
Вопрос задал: Phoenix (статус: Посетитель)
Вопрос отправлен: 13 февраля 2010, 13:40
Состояние вопроса: открыт, ответов: 1.
|
Ответ #1. Отвечает эксперт: min@y™
Цитата (Phoenix):
Использование свойства формы DoubleBuffered:=True; не решает проблемы.
Попробуй поставить в True это свойство у панели и/или у контролов на ней.
// Рекурсивная установка свойства DoubleBuffered у контрола и всех контролов, лежащих на нём.
procedure SetDoubleBuffered(Parent: TWinControl; const DoubleBuffered: Boolean);
var
Control: TControl;
Index: Integer;
begin
if not Assigned(Parent)
then Exit;
Parent.DoubleBuffered:= DoubleBuffered;
for Index:= 0 to Parent.ControlCount - 1 do
begin
Control:= Parent.Controls[Index];
if Control is TWinControl
then SetDoubleBuffered(TWinControl(Control), DoubleBuffered); // Рекурсия !!!
end;
end;
 |
Ответ отправил: min@y™ (статус: Доктор наук)
Время отправки: 13 февраля 2010, 13:55
Оценка за ответ: 5
Комментарий к оценке: ставил и так и сяк, результат прежний.
|
Мини-форум вопроса
Всего сообщений: 8; последнее сообщение — 13 февраля 2010, 19:52; участников в обсуждении: 3.
|
|
min@y™ (статус: Доктор наук), 13 февраля 2010, 14:53 [#1]:
Цитата (Phoenix):
ставил и так и сяк, результат прежний.
Я наблюдал такой эффект с моими прогами на компах со слабой/интегрированной видюхой. У тебя не этот случай?
Делаю лабы и курсачи по Delphi и Turbo Pascal. За ПИВО! Пишите в личку, а лучше в аську. А ещё лучше - звоните в скайп!
|
|
|
Phoenix (статус: Посетитель), 13 февраля 2010, 14:56 [#2]:
нет, видео отдельное, неслабое.
самое интересное, что мерацают все контролы кроме BitBtn
|
|
|
min@y™ (статус: Доктор наук), 13 февраля 2010, 15:08 [#3]:
А как регулируюутся размеры панели при изменении размеров формы? Через Anchors?
Делаю лабы и курсачи по Delphi и Turbo Pascal. За ПИВО! Пишите в личку, а лучше в аську. А ещё лучше - звоните в скайп!
|
|
|
Phoenix (статус: Посетитель), 13 февраля 2010, 15:16 [#4]:
через aling=alLeft
|
|
Alexey6522 (статус: 1-ый класс), 13 февраля 2010, 18:10 [#5]:
Привет min@y™ сотри свою процедуру procedure SetDoubleBuffered(Parent: TWinControl; const DoubleBuffered: Boolean); и в обработчике событий Form1.OnCreate напиши просто
procedure TForm1.FormCreate(Sender: TObject);
begin
Form1.DoubleBuffered:= True;
end;
и все будет нормально 
|
|
|
min@y™ (статус: Доктор наук), 13 февраля 2010, 19:00 [#6]:
Цитата (Alexey6522):
Привет min@y™ сотри свою процедуру procedure SetDoubleBuffered(Parent: TWinControl; const DoubleBuffered: Boolean); и в обработчике событий Form1.OnCreate напиши просто
procedure TForm1.FormCreate(Sender: TObject); begin Form1.DoubleBuffered:= True; end;
и все будет нормально
Я вижу, ты такой умный. Мозги в черепе не жмут? Посмотри Controls.pas:
procedure TWinControl.WMPaint(var Message: TWMPaint);
var
DC, MemDC: HDC;
MemBitmap, OldBitmap: HBITMAP;
PS: TPaintStruct;
begin
if not FDoubleBuffered or (Message.DC <> 0) then
begin
if not (csCustomPaint in ControlState) and (ControlCount = 0) then
inherited
else
PaintHandler(Message);
end
else
begin
DC := GetDC(0);
MemBitmap := CreateCompatibleBitmap(DC, ClientRect.Right, ClientRect.Bottom);
ReleaseDC(0, DC);
MemDC := CreateCompatibleDC(0);
OldBitmap := SelectObject(MemDC, MemBitmap);
try
DC := BeginPaint(Handle, PS);
Perform(WM_ERASEBKGND, MemDC, MemDC);
Message.DC := MemDC;
WMPaint(Message);
Message.DC := 0;
BitBlt(DC, 0, 0, ClientRect.Right, ClientRect.Bottom, MemDC, 0, 0, SRCCOPY);
EndPaint(Handle, PS);
finally
SelectObject(MemDC, OldBitmap);
DeleteDC(MemDC);
DeleteObject(MemBitmap);
end;
end;
end;
Делаю лабы и курсачи по Delphi и Turbo Pascal. За ПИВО! Пишите в личку, а лучше в аську. А ещё лучше - звоните в скайп!
|
|
|
Alexey6522 (статус: 1-ый класс), 13 февраля 2010, 19:47 [#7]:
Зачем придумывать велосипед, я при рисовании на Canvas или перетаскивании какого-либо компонента на форме, во время выполнения, подчеркиваю, всегда вставляю Form1.DoubleBuffered:= True; ибо при перетаскивании картинки по форме, если это компонент Image, она мерцает, мигает, как хочешь называй, а с этим параметром не ммерцает
|
|
|
Alexey6522 (статус: 1-ый класс), 13 февраля 2010, 19:52 [#8]:
вот пример мой пример, на форму поместить Image и в него закинуть какую-нибудь картинку, а дальше, думаю разберетесь... это пример перетаскивания компонента на форме, если убрать двойной буффер, картинка будет мерцать, а так все нормально
var
x0, y0: integer; //начальные координаты картинки
drag: boolean = false;{определяет режим буксировки
она будет устанавливаться в True
вначале и в False в конце }
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button=mbLeft then begin //если нажата левая кнопка мыши
x0:=x; //запоминаем первоначальные
y0:=y; //координаты курсора
drag:=true; //перемещение началось
{методом BringToFront выдвигаем компонент
в котором произошло событие не передний план}
(Sender as TImage).BringToFront;
end else //если нажата не левая кнопка мыши
drag:=false; //нет перемещения
end;
procedure TForm1.Image1DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
begin
Accept:=Source is TImage;
end;
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if drag then
with TImage(Sender) do begin
Left:=Left+x-x0;
Top:=Top+y-y0;
end;
end;
procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
drag:=false;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Form1.DoubleBuffered:= true; //Для Того что бы картинка не мигала при перетаскивании, конечно есть и другие способы
end;
|
Чтобы оставлять сообщения в мини-форумах, Вы должны авторизироваться на сайте.
|
