研究一下TForm.WMPaint过程(也得研究WM_ERASEBKGND)——TForm虽然继承自TWinControl,但是自行模仿了TCustomControl的全部行为,一共三种自绘的覆盖方法,比TCustomControl还多一种
先擦除背景:
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 := ;
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, , , 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 <> ) then
begin
if not (csCustomPaint in ControlState) and (ControlCount = ) then
inherited
else
PaintHandler(Message); // 走这里
end
else
begin
DC := GetDC();
MemBitmap := CreateCompatibleBitmap(DC, ClientRect.Right, ClientRect.Bottom);
ReleaseDC(, DC);
MemDC := CreateCompatibleDC();
OldBitmap := SelectObject(MemDC, MemBitmap);
try
DC := BeginPaint(Handle, PS);
Perform(WM_ERASEBKGND, MemDC, MemDC);
Message.DC := MemDC;
WMPaint(Message);
Message.DC := ;
BitBlt(DC, , , ClientRect.Right, ClientRect.Bottom, MemDC, , , 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 = then DC := BeginPaint(Handle, PS);
try
if FControls = nil then PaintWindow(DC) else
begin
SaveIndex := SaveDC(DC);
Clip := SimpleRegion;
for I := to FControls.Count - 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 = 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 := ;
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 := ;
end;
还是丝毫不影响整个Form1的显示。为什么会不影响呢?因为背景色提前就绘制在上面了,后面的OnPaint无论是否绘制,都不影响它的存在,顶多覆盖一小部分区域。比如:
procedure TForm1.FormPaint(Sender: TObject);
begin
Canvas.Brush.Color := clRed;
Canvas.Rectangle(, , , );
end;
也就是覆盖了一个角,剩下的还是背景色。
---------------------------------------------------------------------
这里测试了覆盖Paint函数,OnPaint的代码保留,但是效果只有左上角一个小绿块,而没有红色方块。如果加上inherited(IDE会自动帮你加上,也就是推荐使用),那么红的绿的方块都有,比较有意思:
procedure TForm1.Paint;
begin
// inherited;
Canvas.Brush.Color := clGreen;
Canvas.Rectangle(, , , );
end;
---------------------------------------------------------------------
唯一有个问题是,InitInheritedComponent读取dfm的颜色以后,是什么时候把它赋值给FBrush.Color的?它与{$R *.dfm}是什么关系?
研究一下TForm.WMPaint过程(也得研究WM_ERASEBKGND)——TForm虽然继承自TWinControl,但是自行模仿了TCustomControl的全部行为,一共三种自绘的覆盖方法,比TCustomControl还多一种的更多相关文章
- 还在手动给css加前缀?no!几种自动处理css前缀的方法简介
原文首发于个人博客:还在手动给css加前缀?no!几种自动处理css前缀的方法简介 我们知道在写css的时候由于要兼容不同厂商浏览器,一些比较新的属性需要给它们添加厂商前缀来兼容.移动端还好,基本只要 ...
- js中几种实用的跨域方法原理详解(转)
今天研究js跨域问题的时候发现一篇好博,非常详细地讲解了js几种跨域方法的原理,特分享一下. 原博地址:http://www.cnblogs.com/2050/p/3191744.html 下面正文开 ...
- Java中有四种常见的Map实现方法
在 HTML5 之前我们做图片预览主流做法有两种,第一种是通过 Flash 插件来做预览,第二种是 Ajax 实现的假预览,也就是说选择图片文件后,图片其实已经异步上传到服务器,服务器处理后返回图片路 ...
- js中几种实用的跨域方法原理详解
这里说的js跨域是指通过js在不同的域之间进行数据传输或通信,比如用ajax向一个不同的域请求数据,或者通过js获取页面中不同域的框架中(iframe)的数据.只要协议.域名.端口有任何一个不同,都被 ...
- [转]js中几种实用的跨域方法原理详解
转自:js中几种实用的跨域方法原理详解 - 无双 - 博客园 // // 这里说的js跨域是指通过js在不同的域之间进行数据传输或通信,比如用ajax向一个不同的域请求数据,或者通过js获取页面中不同 ...
- js中几种实用的跨域方法原理详解【转】
源地址:http://www.cnblogs.com/2050/p/3191744.html 这里说的js跨域是指通过js在不同的域之间进行数据传输或通信,比如用ajax向一个不同的域请求数据,或者通 ...
- GOF提出的23种设计模式是哪些 设计模式有创建形、行为形、结构形三种类别 常用的Javascript中常用设计模式的其中17种 详解设计模式六大原则
20151218mark 延伸扩展: -设计模式在很多语言PHP.JAVA.C#.C++.JS等都有各自的使用,但原理是相同的,比如JS常用的Javascript设计模式 -详解设计模式六大原则 设计 ...
- 再谈STM32的CAN过滤器-bxCAN的过滤器的4种工作模式以及使用方法总结
1. 前言 bxCAN是STM32系列最稳定的IP核之一,无论有哪个新型号出来,这个IP核基本未变,可见这个IP核的设计是相当成熟的.本文所讲述的内容属于这个IP核的一部分,掌握了本文所讲内容,就可以 ...
- 五种WordPress防止垃圾评论方法-过滤垃圾评论提高WP运行效率
WordPress貌似和垃圾评论是一对“孪生兄弟”,无论在国内还是国外的空间主机上搭建的Wordpress博客,无论Wordpress有多少流量多么低的权重,垃圾评论都会自动找上门来,假如有好几天没有 ...
随机推荐
- python写的屏保程序
__author__ = 'ChenYan' from random import randint from tkinter import * class Randball(): def __init ...
- excel列显示形式互换(字母与数字)
以office2007为例: excel选项>公式>使用公式下的'R1C1引用样式' 打上钩显示形式为数字,不打钩显示形式为字母
- 使用DiskGenius对虚拟机磁盘进行压缩
使用虚拟机的用户是否感觉到您的虚拟磁盘文件越来越大,都快把宝贵的磁盘空间(宿主机物理硬盘)占满了呢? 有人会想到,我直接启动虚拟机,然后把里面没用的数据删除了,不就行了吗?实际测试发现,这样删除后,存 ...
- ASP.NET MVC 5 学习教程:生成的代码详解
原文 ASP.NET MVC 5 学习教程:生成的代码详解 起飞网 ASP.NET MVC 5 学习教程目录: 添加控制器 添加视图 修改视图和布局页 控制器传递数据给视图 添加模型 创建连接字符串 ...
- Python函数式编程:内置函数map()使用说明
一.概述 map操作是函数式编程中的重要技术之一,其作用就是对一个集合中的每个元素做处理,生成一个新的元素,由这些新的元素组成一个新的集合的返回. 所以map操作后,产生的新集合的元素个数和原集合的元 ...
- Maven创建项目: Failed to execute goal org.apache.maven.plugin( mvn archetype:create)
一.概述: 在使用mvn 命令mvn archetype:create -DgroupId=com.chuanliu.c11 -DartifactId=c11searcher在控制创建maven项目和 ...
- 以正确的方式开源 Python 项目
以正确的方式开源 Python 项目 大多数Python开发者至少都写过一个像工具.脚本.库或框架等对其他人也有用的工具.我写这篇文章的目的是让现有Python代码的开源过程尽可能清 晰和无痛.我不是 ...
- window下svn注册为本地的服务
sc create svnservice binpath= "\"C:\program files\Subversion\bin\svnserve.exe\" --ser ...
- 怎样实现cocos2d-x之文字渲染
// 1.创建一段文本 // create函数的三个参数分别为:文本内容.字体和字体大小 CCLabelTTF *font=CCLabelTTF::create("Hello World&q ...
- 数学之路-python计算实战(15)-机器视觉-滤波去噪(归一化块滤波)
# -*- coding: utf-8 -*- #code:myhaspl@myhaspl.com #归一化块滤波 import cv2 import numpy as np fn="tes ...