Событие OnPaint для компонентов

← →
Alex_C (2014-02-18 18:03) [0]

Берем пустую форму. В памяти на битмапе рисуем что-то. Далее на событие формы OnPaint при помощи BitBlt. Все отлично - никакого мерцания, если на переднем плане проги будем перемещать другие окна.
Теперь создаем компонет на основе TPanel
type TPanelHX = class(TPanel) private FOnPaint: TNotifyEvent; protected procedure Paint; override; public property Canvas; published property OnPaint: TNotifyEvent read FOnPaint write FOnPaint; end; procedure Register; implementation procedure TPanelHX.Paint; begin inherited; if Assigned(fOnPaint) then fOnPaint(Self); end;

Делаем его Client и рисуем на панели так же как и на форме - есть мерцание. Причем при мерцании "вылазит" цвет формы.

Попрос почему и как этого избежать? Вроде все прозрачности убрал...

← →
MBo © (2014-02-18 18:30) [1]

Видимо, в inheritied Paint происходит перерисовка фона (обработка WM_ERASEBKGND)

← →
Alex_C (2014-02-18 18:36) [2]

То MBo: выходит... причем если использовать на TPaintBox - мерцание еще больше.
Вообще вопрос такой: как то можно избежать перерисовки формы "на фоне"? Вообще уже 3-й день этот "прикол" анализирую. Видел (правда очень мало) приложений, где мерцания нет вообще - т.е. значит как то можно.

← →
sniknik © (2014-02-18 18:43) [3]

> как то можно избежать перерисовки формы "на фоне"?
procedure TForm1.FormCreate(Sender: TObject); begin DoubleBuffered:= true; ...

← →
Alex_C (2014-02-18 18:46) [4]

Не а :) Это никак не влияет в данном случае - это пробовал в первую очередь.

← →
brother © (2014-02-18 18:46) [5]

> inherited;

может убрать? ведь все, что нужно рисуем сами?

← →
Alex_C (2014-02-18 18:51) [6]

так рисуем по событию - там и нет inherited.
Вообще момент этот меня интересовал давно - да все как то не до него было. А вот сейчас пробую разные варианты - итог один: рисовать на канве формы. Иначе канва формы перерисовыватся и происходит мерцание. Но ведь есть приложения, где нет мерцания - при чем написаны они на Дельфи - знаит решить эту проблему можно.

Не вижу никакого мелькания. Причем даже если TPanelHX поменять на TPaintBox
http://112.imagebam.com/download/Yjq4bgoHww8QsrFaLoRhKw/30886/308852913/uuuu.gif

unit Unit1;

interface

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

type

TPanelHX = class(TPanel)
private
FOnPaint: TNotifyEvent;
protected
procedure Paint; override;
public
property Canvas;
published
property OnPaint: TNotifyEvent read FOnPaint write FOnPaint;
end;

TForm1 = class(TForm)
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
private
myPanel: TPanelHX;
myBmp: TBitmap;
procedure myPanelOnPaint(Sender: TObject);
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TPanelHX.Paint;
begin
inherited;
if Assigned(FOnPaint) then
FOnPaint(Self);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
myBmp.Free;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
myBmp := TBitmap.Create;
myBmp.LoadFromFile("BitOff.bmp");
myPanel := TPanelHX.Create(Self);
myPanel.Align := alClient;
myPanel.OnPaint := myPanelOnPaint;
myPanel.Parent := Self;
end;

procedure TForm1.myPanelOnPaint(Sender: TObject);
begin
BitBlt(myPanel.Canvas.Handle, 0, 0, myPanel.ClientWidth, myPanel.ClientHeight, myBmp.canvas.handle, 0, 0, SRCCOPY);
end;

end

> так рисуем по событию - там и нет inherited.

Вы издиваетесь??? Вот Ваш код:

> implementation procedure TPanelHX.Paint;
> begin
> inherited;
> if Assigned(fOnPaint) then
> fOnPaint(Self);
> end;

Лучше так

implementation procedure TPanelHX.Paint; begin if Designed in ComponentState or not Assigned(fOnPaint) then inherited else fOnPaint(Self); end;

Событие OnPaint для компонентов Найти похожие ветки