TGraphicControl = class(TControl)
private
FCanvas: TCanvas;
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
protected
procedure Paint; virtual;
property Canvas: TCanvas read FCanvas; // 到这步才有
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
end; constructor TGraphicControl.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FCanvas := TControlCanvas.Create; // 相互捆绑
TControlCanvas(FCanvas).Control := Self;
end; destructor TGraphicControl.Destroy;
begin
if CaptureControl = Self then SetCaptureControl(nil);
FCanvas.Free;
inherited Destroy;
end; procedure TGraphicControl.WMPaint(var Message: TWMPaint); // 第一步,收到WM_PAINT消息
begin
if (Message.DC <> ) and not (csDestroying in ComponentState) then
begin
Canvas.Lock;
try
Canvas.Handle := Message.DC;
try
Paint; // 第二步,调用自己的Paint虚函数
finally
Canvas.Handle := ;
end;
finally
Canvas.Unlock;
end;
end;
end; procedure TGraphicControl.Paint; // 提前准备:提前由程序员覆盖(目前是空函数)
begin
end;

TControl处理所有鼠标消息 + 位置,字体,对齐,Enable等等 + 部分消息处理。感觉内容比较简单,精华不在这里。

  TControl = class(TComponent)
FParent: TWinControl;
FWindowProc: TWndMethod;
FControlStyle: TControlStyle;
FControlState: TControlState;
FParentFont: Boolean;
FParentColor: Boolean; FLeft: Integer;
FTop: Integer;
FWidth: Integer;
FHeight: Integer;
FVisible: Boolean;
FEnabled: Boolean;
FIsControl: Boolean;
FFont: TFont;
FColor: TColor;
FHint: string;
FText: PChar; FOnClick: TNotifyEvent;
FOnDblClick: TNotifyEvent;
procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
procedure WMNCLButtonDown(var Message: TWMNCLButtonDown); message WM_NCLBUTTONDOWN;
procedure WMRButtonDown(var Message: TWMRButtonDown); message WM_RBUTTONDOWN;
procedure WMMButtonDown(var Message: TWMMButtonDown); message WM_MBUTTONDOWN;
procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
procedure WMRButtonDblClk(var Message: TWMRButtonDblClk); message WM_RBUTTONDBLCLK;
procedure WMMButtonDblClk(var Message: TWMMButtonDblClk); message WM_MBUTTONDBLCLK;
procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;
procedure WMRButtonUp(var Message: TWMRButtonUp); message WM_RBUTTONUP;
procedure WMMButtonUp(var Message: TWMMButtonUp); message WM_MBUTTONUP;
procedure WMMouseMove(var Message: TWMMouseMove); message WM_MOUSEMOVE;
procedure WMMouseWheel(var Message: TWMMouseWheel); message WM_MOUSEWHEEL; procedure WMCancelMode(var Message: TWMCancelMode); message WM_CANCELMODE;
procedure WMWindowPosChanged(var Message: TWMWindowPosChanged); message WM_WINDOWPOSCHANGED;
procedure WMContextMenu(var Message: TWMContextMenu); message WM_CONTEXTMENU; procedure CMVisibleChanged(var Message: TMessage); message CM_VISIBLECHANGED;
procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
procedure CMColorChanged(var Message: TMessage); message CM_COLORCHANGED;
procedure CMMouseActivate(var Message: TCMMouseActivate); message CM_MOUSEACTIVATE;
procedure CMParentFontChanged(var Message: TCMParentFontChanged); message CM_PARENTFONTCHANGED;
procedure CMSysFontChanged(var Message: TMessage); message CM_SYSFONTCHANGED;
procedure CMParentColorChanged(var Message: TMessage); message CM_PARENTCOLORCHANGED;
procedure CMParentShowHintChanged(var Message: TMessage); message CM_PARENTSHOWHINTCHANGED;
procedure CMHintShow(var Message: TCMHintShow); message CM_HINTSHOW;
procedure CMHitTest(var Message: TCMHitTest); message CM_HITTEST;
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
procedure CMDesignHitTest(var Message: TCMDesignHitTest); message CM_DESIGNHITTEST;
procedure CMBiDiModeChanged(var Message: TMessage); message CM_BIDIMODECHANGED;
procedure CMParentBiDiModeChanged(var Message: TMessage); message CM_PARENTBIDIMODECHANGED;
procedure CMMouseWheel(var Message: TCMMouseWheel); message CM_MOUSEWHEEL;
procedure CMGesture(var Message: TCMGesture); message CM_GESTURE;
procedure CMParentTabletOptionsChanged(var Message: TMessage); message CM_PARENTTABLETOPTIONSCHANGED; procedure Click; dynamic;
procedure DblClick; dynamic;
function GetClientRect: TRect; virtual;
procedure Loaded; override; constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure BringToFront;
function GetParentComponent: TComponent; override;
function HasParent: Boolean; override;
procedure SetTextBuf(Buffer: PChar); function ClientToScreen(const Point: TPoint): TPoint;
function ClientToParent(const Point: TPoint; AParent: TWinControl = nil): TPoint;
procedure Hide; procedure Refresh;
procedure Repaint; virtual;
procedure Show;
procedure Update; virtual; function DesignWndProc(var Message: TMessage): Boolean; dynamic;
procedure WndProc(var Message: TMessage); virtual; // 处理了不少消息
procedure DefaultHandler(var Message); override;
function Perform(Msg: Cardinal; WParam: WPARAM; LParam: PChar): LRESULT; overload;
function Perform(Msg: Cardinal; WParam: WPARAM; var LParam: TRect): LRESULT; overload; property WindowProc: TWndMethod read FWindowProc write FWindowProc;
property Parent: TWinControl read FParent write SetParent;
procedure TControl.Invalidate;
begin
InvalidateControl(Visible, csOpaque in ControlStyle);
end; procedure TControl.InvalidateControl(IsVisible, IsOpaque: Boolean);
begin
if (IsVisible) and (Parent <> nil) and
Parent.HandleAllocated then
begin
Rect := BoundsRect;
InvalidateRect(Parent.Handle, Rect, not (IsOpaque or
(csOpaque in Parent.ControlStyle) or BackgroundClipped)); // API 使得父控件的部分区域失效
end;
end; // (非重载)显示自己
procedure TControl.Show;
begin
if Parent <> nil then Parent.ShowControl(Self);
if not (csDesigning in ComponentState) or
(csNoDesignVisible in ControlStyle) then Visible := True;
end; // (重载)通知父控件刷新(注意,它的父类是一个TWinControl)
// 貌似挺巧妙,因为重载,所以先调用了TWinControl.Update 后面就不是当前类管的事情了。
// 但是单独的TWinControl子控件重载了Update消息,所以不会用到它。
// 也许TGraphicControl 才会用到TControl.Update; ?
procedure TControl.Update;
begin
if Parent <> nil then Parent.Update;
end; // (非重载)表面上看多此一举,但它其实可以调用子类的Repaint(通用方法)
procedure TControl.Refresh;
begin
Repaint;
end; // (重载)计算剪裁区域以后,还是发给了父类去重绘。父类的PaintControls会给每一个子控件发WM_PAINT消息。
// 每个子控件都用Handle区分。而消息队列是线程为载体的,所以不矛盾
// 所以调用TControl.Repaint;来刷新也没有问题。单独的TWinControl子控件重载了Repaint消息,所以不会用到它。
// 也许TGraphicControl 才会用到TControl.Repaint; ?
procedure TControl.Repaint;
var
DC: HDC;
begin
if (Visible) and (Parent <> nil) and // 当前控件可显示
Parent.HandleAllocated then
if csOpaque in ControlStyle then // 当前控件不透明(即需要显示)
begin
DC := GetDC(Parent.Handle); // 取得父类的句柄(注意,它的父类是一个TWinControl)
try
IntersectClipRect(DC, Left, Top, Left + Width, Top + Height); // API 给父类的句柄创建剪裁区
Parent.PaintControls(DC, Self); // 父类再去画剩余部分,相当于调用 TWinControl.PaintControls(DC: HDC; First: TControl);
finally
ReleaseDC(Parent.Handle, DC);
end;
end else // 如果当前控件透明,就是失效后立刻刷新显示(即当前控件的图形没有变化,只是需要重新刷新显示的问题)
begin
Invalidate; // 存在要求显示(透明的情况下)
Update;
end;
end;

对比一下TWinControl.Repaint函数,思考为什么不透明的时候,会多了一段详细的自绘代码?

procedure TWinControl.Repaint;
begin
Invalidate;
Update;
end;

说白了就是重新裁剪,而且是对父控件的DC进行重新剪裁。我估计,这里的代码怕的是,图形控件既显示(visible),又不透明(csOpaque)的情况下,图形本身的大小随时可能会变,所以每次都需要重新剪裁。而不透明的情况下,不存在这个问题,所以直接刷新就行了。

但是新问题又来了,剪裁以后,居然没有要求使无效和刷新,为什么呢?通过查询TWinControl.PaintControls的代码得知:

procedure TWinControl.PaintControls(DC: HDC; First: TControl);
var
I, Count, SaveIndex: Integer;
FrameBrush: HBRUSH;
begin
if DockSite and UseDockManager and (DockManager <> nil) then
DockManager.PaintSite(DC);
if FControls <> nil then
begin
I := ;
if First <> nil then
begin
I := FControls.IndexOf(First);
if I < then I := ;
end;
Count := FControls.Count;
while I < Count do
begin
with TControl(FControls[I]) do
if (Visible or (csDesigning in ComponentState) and
not (csNoDesignVisible in ControlStyle)) and
RectVisible(DC, Rect(Left, Top, Left + Width, Top + Height)) then
begin
if csPaintCopy in Self.ControlState then
Include(FControlState, csPaintCopy);
SaveIndex := SaveDC(DC);
MoveWindowOrg(DC, Left, Top);
IntersectClipRect(DC, , , Width, Height);
Perform(WM_PAINT, DC, 0);
RestoreDC(DC, SaveIndex);
Exclude(FControlState, csPaintCopy);
end;
Inc(I);
end;
end;
if FWinControls <> nil then
for I := to FWinControls.Count - do
with TWinControl(FWinControls[I]) do
if FCtl3D and (csFramed in ControlStyle) and
(Visible or (csDesigning in ComponentState) and
not (csNoDesignVisible in ControlStyle)) then
begin
FrameBrush := CreateSolidBrush(ColorToRGB(clBtnShadow));
FrameRect(DC, Rect(Left - , Top - , Left + Width, Top + Height),
FrameBrush);
DeleteObject(FrameBrush);
FrameBrush := CreateSolidBrush(ColorToRGB(clBtnHighlight));
FrameRect(DC, Rect(Left, Top, Left + Width + , Top + Height + ),
FrameBrush);
DeleteObject(FrameBrush);
end;
end;

当场就要求所有图形子控件执行WM_PAINT,即模拟图形控件收到WM_PAINT,即立刻要求全部重绘,所以也就不必使无效和刷新了。

做个实验测试一下,看是不是图形控件剪裁区域变化以后的问题(确实当场起作用了):

procedure TForm1.Button2Click(Sender: TObject);
begin
image1.Width :=;
end; property Width: Integer read FWidth write SetWidth; procedure TControl.SetWidth(Value: Integer);
begin
SetBounds(FLeft, FTop, Value, FHeight);
Include(FScalingFlags, sfWidth);
end; procedure TControl.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
if CheckNewSize(AWidth, AHeight) and
((ALeft <> FLeft) or (ATop <> FTop) or
(AWidth <> FWidth) or (AHeight <> FHeight)) then
begin
InvalidateControl(Visible, False); // TControl的函数,注意这里的osPraque是false,即当前控件处于透明状态。
FLeft := ALeft;
FTop := ATop;
FWidth := AWidth;
FHeight := AHeight;
UpdateAnchorRules;
Invalidate; // TControl的函数,为什么要失效两遍?因为长宽高可能变化了。
Perform(WM_WINDOWPOSCHANGED, , );
RequestAlign;
if not (csLoading in ComponentState) then Resize;
end;
end; procedure TControl.WMWindowPosChanged(var Message: TWMWindowPosChanged);
begin
inherited;
{ Update min/max width/height to actual extents control will allow }
if ComponentState * [csReading, csLoading] = [] then
begin
with Constraints do
begin
if (MaxWidth > ) and (Width > MaxWidth) then
FMaxWidth := Width
else if (MinWidth > ) and (Width < MinWidth) then
FMinWidth := Width;
if (MaxHeight > ) and (Height > MaxHeight) then
FMaxHeight := Height
else if (MinHeight > ) and (Height < MinHeight) then
FMinHeight := Height;
end;
if Message.WindowPos <> nil then
with Message.WindowPos^ do
if (FHostDockSite <> nil) and not (csDocking in ControlState) and
(Flags and SWP_NOSIZE = ) and (cx <> ) and (cy <> ) then
CalcDockSizes;
end;
end;

问题:我不明白,Form1是什么收到的WM_PAINT消息,使得Image1被重绘的?

回答:系统空闲时候探测无效区域,发现有,就立刻发送WM_PAINT消息。

Invalidate 发起消息, 在下一个消息循环就会知道要 paint

Invalidate之后,系统会选择一个时间发送WM_PAINT消息。

系统会在需要重绘的时候计算需要重绘的Region,然后发送WM_PAINT给相应窗口

我刚才没想起来 一头钻到updateWindow这种直接调用的思维里去了

-------------------------------------------------------------

最后:Reflesh是通用方法,但其实扰乱思路,不用管

TGraphicControl(自绘就2步,直接自绘自己,不需要调用VCL框架提供的函数重绘所有子控件,也不需要自己来提供PaintWindow函数让管理框架来调用)与TControl关键属性方法速记(Repaint要求父控件执行详细代码来重绘自己,还是直接要求Invalidate无效后Update刷新父控件,就看透明不透明这个属性,因为计算显示的区域有所不同)的更多相关文章

  1. TCustomControl绘制自己和图形子控件共四步,TWinControl关键属性方法速记

    TCustomControl = class(TWinControl) private FCanvas: TCanvas; procedure WMPaint(var Message: TWMPain ...

  2. 面向对象【day08】:静态方法、类方法、属性方法(九)

    本节内容 概述 静态方法 类方法 属性方法 总结 一.概述 前面我们已经讲解了关于类的很多东西,今天讲讲类的另外的特性:静态方法(staticmethod).类方法(classmethod).属性方法 ...

  3. PHP中的MySQLi扩展学习(二)mysqli类的一些少见的属性方法

    虽说是少见的一些属性方法,但是可能还是有不少同学在日常的开发中使用过,这里只是学习了可能相对来说我们用得比较少的一些 mysqli 的属性或方法.就当是扩展一下自己的知识体系. 切换用户 首先就是切换 ...

  4. React-Native的基本控件属性方法

    对React-Native的学习,从熟悉基本控件开始. View 属性方法 序号 名称 属性Or方法 类型 说明 1 accessibilityLabel 属性 string   2 accessib ...

  5. React-Native的基本控件属性方法,对React-Native的学习,从熟悉基本控件开始。

    对React-Native的学习,从熟悉基本控件开始. View 属性方法 序号 名称 属性Or方法 类型 说明 1 accessibilityLabel 属性 string   2 accessib ...

  6. 初识Windows窗体(包括各种控件,属性,方法)

    什么是Wind ows窗体? 顾名思义,win dows窗体就是将一些所必须的信息通过窗体的形式展示给客户看.例如:我们经常玩的QQ登陆界面,微信登陆界面,等等,都是以窗体的形式将信息展示给我们看的. ...

  7. CSS 图像透明/不透明

    CSS 图像透明/不透明 使用CSS很容易创建透明的图像. 注意:CSS Opacity属性是W3C的CSS3建议的一部分. 一.示例一:创建一个透明图像 CSS3中属性的透明度是 opacity. ...

  8. CSS:CSS 图像透明/不透明

    ylbtech-CSS:CSS 图像透明/不透明 1.返回顶部 1. CSS 图像透明/不透明 使用CSS很容易创建透明的图像. 注意:CSS Opacity属性是W3C的CSS3建议的一部分. 更多 ...

  9. 终于懂了:TControl.Perform是有返回值的,且看VCL框架如何利用消息的返回值(全部例子都在这里)——它的存在仅仅是为了方便复用消息的返回值

    代码如下: function TControl.Perform(Msg: Cardinal; WParam, LParam: Longint): Longint; var Message: TMess ...

随机推荐

  1. 2014哈商大ICPC/ACM校赛解题报告

    被debug邀请去參加校赛,哎,被虐..我对不起工大.. 由于本人不搞ACM,算法处于HelloWorld水准.. 虽然题目除了鸟不拉屎星人之外都非常水,但我能做到这个程度,全然是超水平发挥了.. 数 ...

  2. mongoDB group命令详解

    http://heipark.iteye.com/blog/1167948       http://rjhym.iteye.com/blog/1224200 http://blog.163.com/ ...

  3. velcoity使用说明:foreach指令

    http://blog.csdn.net/madding/article/details/6641020当在velocity中需要显示一个列表信息,我们会用foreach循环输出, 要求: 假如现在需 ...

  4. 【C#】重载重写重构

    前言 前几篇博客说了重写和重载.今天主要说重构,顺便比較一下三者. 重构.重写.重载 重构就是通过调整程序代码改善软件的质量.性能,使其程序的设计模式和架构更趋合理.提高软件的扩展性和维护性. 通俗点 ...

  5. centos 7 查看修改时区

    查看时区 date -R 修改时区 # timedatectl list-timezones # 列出所有时区 # timedatectl set-local-rtc 1 # 将硬件时钟调整为与本地时 ...

  6. Creating Dialogbased Windows Application (3) / 创建基于对话框的Windows应用程序(三)Checkbox的应用、窗体置顶、设置图标 / VC++, Windows

    创建基于对话框的Windows应用程序(三) —— Checkbox的应用.窗体置顶.设置图标 上一节创建的窗体应用程序中,我们用到了Button和StaticText这两个控件.这一节中我们将学习使 ...

  7. Python内置函数之filter()

    filter(function,iterable)用来过滤可迭代对象 如果提供过滤条件的函数为None,则可迭代对象中为False的元素将被过滤掉. 例如: >>> a = [,,F ...

  8. java中static变量的声明和初始化

     目录(?)[+] 问题1静态变量如何初始化 问题2JDK如何处理static块 问题3如何看待静态变量的声明 对初始问题的解答 在网上看到了下面的一段代码: public class Test  ...

  9. iOS 学习笔记四 【xcode 7.3 ESJsonFormat-Xcode 插件不能使用的解决办法】

    步骤: 1.[前提要[关掉xcode],然后终端运行,一次不行,运行两次!] 2.[鼠标双击下方代码,command + c 复制即可] 3.[打开终端,command + V 粘贴,按回车运行即可, ...

  10. 如何解决局域网中Windows防火墙不能访问Oracle问题!

    在防火墙例外中,添加端口1521端口就样局域网内的其他机器就可以访问你的ORACLE了. 在防火墙的入站规则中,新建端口规则.过程如下例图片所示: