研究一下TForm.WMPaint过程(也得研究WM_ERASEBKGND)——TForm虽然继承自TWinControl,但是自行模仿了TCustomControl的全部行为,一共三种自绘的覆盖方法,比TCustomControl还多一种
2016-02-25 22:32
686 查看
先擦除背景:
然后进行绘制(背景色已经事先存在,无论后面绘制了什么都不影响背景色,如果不绘制,就全部都是背景色):
inherited会调用:
继续:
TCustomForm有相应的覆盖函数:
Paint会调用:
这个FOnPaint来自:
它会调用我写的事件内容:
即使为空,也丝毫不影响整个Form1的显示。也许像上面那样写会被编译器删除,那么我这样写:
还是丝毫不影响整个Form1的显示。为什么会不影响呢?因为背景色提前就绘制在上面了,后面的OnPaint无论是否绘制,都不影响它的存在,顶多覆盖一小部分区域。比如:
也就是覆盖了一个角,剩下的还是背景色。
---------------------------------------------------------------------
这里测试了覆盖Paint函数,OnPaint的代码保留,但是效果只有左上角一个小绿块,而没有红色方块。如果加上inherited(IDE会自动帮你加上,也就是推荐使用),那么红的绿的方块都有,比较有意思:
---------------------------------------------------------------------
唯一有个问题是,InitInheritedComponent读取dfm的颜色以后,是什么时候把它赋值给FBrush.Color的?它与{$R *.dfm}是什么关系?
procedure TCustomForm.WMEraseBkgnd(var Message: TWMEraseBkgnd); begin if not IsIconic(Handle) then inherited else begin Message.Msg := WM_ICONERASEBKGND; DefaultHandler(Message); end; end; procedure TWinControl.WMEraseBkgnd(var Message: TWMEraseBkgnd); begin with ThemeServices do if ThemesEnabled and Assigned(Parent) and (csParentBackground in FControlStyle) then begin { Get the parent to draw its background into the control's background. } DrawParentBackground(Handle, Message.DC, nil, False); end else begin { Only erase background if we're not doublebuffering or painting to memory. } if not FDoubleBuffered or (TMessage(Message).wParam = TMessage(Message).lParam) then FillRect(Message.DC, ClientRect, FBrush.Handle); // Brush的颜色事先读取好了 end; Message.Result := 1; end;
然后进行绘制(背景色已经事先存在,无论后面绘制了什么都不影响背景色,如果不绘制,就全部都是背景色):
procedure TCustomForm.WMPaint(var Message: TWMPaint); var DC: HDC; PS: TPaintStruct; begin if not IsIconic(Handle) then begin ControlState := ControlState + [csCustomPaint]; // 模仿1 inherited; // 模仿2 ControlState := ControlState - [csCustomPaint]; end else begin DC := BeginPaint(Handle, PS); DrawIcon(DC, 0, 0, GetIconHandle); EndPaint(Handle, PS); end; end;
inherited会调用:
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;
继续:
procedure TWinControl.PaintHandler(var Message: TWMPaint); var I, Clip, SaveIndex: Integer; DC: HDC; PS: TPaintStruct; begin DC := Message.DC; if DC = 0 then DC := BeginPaint(Handle, PS); try if FControls = nil then PaintWindow(DC) else begin SaveIndex := SaveDC(DC); Clip := SimpleRegion; for I := 0 to FControls.Count - 1 do with TControl(FControls[I]) do if (Visible or (csDesigning in ComponentState) and not (csNoDesignVisible in ControlStyle)) and (csOpaque in ControlStyle) then begin Clip := ExcludeClipRect(DC, Left, Top, Left + Width, Top + Height); if Clip = NullRegion then Break; end; if Clip <> NullRegion then PaintWindow(DC); // 走这里 RestoreDC(DC, SaveIndex); end; PaintControls(DC, nil); finally if Message.DC = 0 then EndPaint(Handle, PS); end; end;
TCustomForm有相应的覆盖函数:
procedure TCustomForm.PaintWindow(DC: HDC); // 模仿3 begin FCanvas.Lock; try FCanvas.Handle := DC; try if FDesigner <> nil then FDesigner.PaintGrid else Paint; // 模仿4 finally FCanvas.Handle := 0; end; finally FCanvas.Unlock; end; end;
Paint会调用:
procedure TCustomForm.Paint; // Paint是dynamic函数,也是虚函数 begin if Assigned(FOnPaint) then FOnPaint(Self); // 巨变:这里直接调用程序员事件,而不是等着程序员覆盖Paint函数(那样做也可以,另外还可直接覆盖PaintWindow虚函数,所以一共有3种方法,即:覆盖OnPaint事件,覆盖PaintWindow虚函数,覆盖Paint虚函数) end;
这个FOnPaint来自:
property OnPaint: TNotifyEvent read FOnPaint write FOnPaint stored IsForm;
它会调用我写的事件内容:
procedure TForm1.FormPaint(Sender: TObject); begin // end;
即使为空,也丝毫不影响整个Form1的显示。也许像上面那样写会被编译器删除,那么我这样写:
procedure TForm1.FormPaint(Sender: TObject); begin tag := 100; end;
还是丝毫不影响整个Form1的显示。为什么会不影响呢?因为背景色提前就绘制在上面了,后面的OnPaint无论是否绘制,都不影响它的存在,顶多覆盖一小部分区域。比如:
procedure TForm1.FormPaint(Sender: TObject); begin Canvas.Brush.Color := clRed; Canvas.Rectangle(0, 0, 100, 100); end;
也就是覆盖了一个角,剩下的还是背景色。
---------------------------------------------------------------------
这里测试了覆盖Paint函数,OnPaint的代码保留,但是效果只有左上角一个小绿块,而没有红色方块。如果加上inherited(IDE会自动帮你加上,也就是推荐使用),那么红的绿的方块都有,比较有意思:
procedure TForm1.Paint; begin // inherited; Canvas.Brush.Color := clGreen; Canvas.Rectangle(0, 0, 50, 50); end;
---------------------------------------------------------------------
唯一有个问题是,InitInheritedComponent读取dfm的颜色以后,是什么时候把它赋值给FBrush.Color的?它与{$R *.dfm}是什么关系?
相关文章推荐
- TPanel的默认颜色存储在dfm中,读取后在Paint函数中设置刷子的颜色,然后填充整个背景
- LightOJ 1236 Pairs Forming LCM(唯一分解定理)
- IielgnairTs'lacsaP.119
- poll_wait阻塞/唤醒
- elgnairTs'lacsaP.118
- HA(高可用)集群之AIS(corosync),高可用httpd+NFS
- TWinControl.DefaultHandler里的CallWindowProc(FDefWndProc)还挺有深意的,TButton对WM_PAINT消息的处理就是靠它来处理的(以前不明白为什么总是要调用inherited,其实就是没有明白TWinControl.DefaultHandler的真正用处,而且还很有用)
- Rails铁轨(栈)
- hdu 1789 Doing Homework Again!
- MessagingTimeout: Timed out waiting for a reply to message ID
- main()函数
- Failed to download samples index, please check your connection and try again 解决
- how to tell if a library contain debug symbols or not
- Ubuntu下安装ideaIU14并添加桌面快捷方式
- type_traits之has_* 系列
- 安装cuda时 提示toolkit installation failed using unsupported compiler解决方法
- “Unable to open log device '/dev/log/main': No such file or directory”
- C- C&AI
- 游戏AI 行为树
- GCD Again