TCustomControl绘制自己和图形子控件共四步,TWinControl关键属性方法速记
TCustomControl = class(TWinControl) private FCanvas: TCanvas; procedure WMPaint(var Message: TWMPaint); message WM_PAINT; protected procedure Paint; virtual; procedure PaintWindow(DC: HDC); override; property Canvas: TCanvas read FCanvas; // 到这步才有Canvas public constructor Create(AOwner: TComponent); override; destructor Destroy; override; end; constructor TCustomControl.Create(AOwner: TComponent); begin inherited Create(AOwner); FCanvas := TControlCanvas.Create; TControlCanvas(FCanvas).Control := Self; end; destructor TCustomControl.Destroy; begin FCanvas.Free; inherited Destroy; end; procedure TCustomControl.WMPaint(var Message: TWMPaint); // 第一步,接受到自绘消息 begin Include(FControlState, csCustomPaint); // 进入自绘状态 inherited; // 第二步,调用VCL框架提供的同名管理函数(TWinControl.WMPaint)来重绘所有子控件和自己。有个问题:如果每个TCustomControl都要求父控件重绘一遍,会不会效率很低? Exclude(FControlState, csCustomPaint); // 结束自绘状态 end; procedure TCustomControl.PaintWindow(DC: HDC); // 第三步,等待VCL框架的管理函数(TWinControl.WMPaint-->TWinControl.PaintHandler-->当前函数)来调用自己(只能是控件重绘自己时产生的调用,至于当前控件的WinControl子控件的重绘属由更高层次TWinControl.UpdateShowing来管理,而不归这些低层次的函数来管理) begin FCanvas.Lock; try FCanvas.Handle := DC; try TControlCanvas(FCanvas).UpdateTextFlags; Paint; // 第四步,进一步调用自己的Paint虚函数 finally FCanvas.Handle := 0; // 当场释放资源 end; finally FCanvas.Unlock; end; end; procedure TCustomControl.Paint; // 提前准备:程序员覆盖这个方法,真正调用程序员的绘制函数(默认为空,等待程序员来绘制) begin end;
新发现一个函数(尽管不起作用):
procedure TWinControl.PaintWindow(DC: HDC); var Message: TMessage; begin Message.Msg := WM_PAINT; Message.WParam := DC; Message.LParam := 0; Message.Result := 0; DefaultHandler(Message); end;
TWinControl用来处理鼠标和实际重绘,而处理鼠标全部在TControl里。此外还申请句柄,处理自己绘图,与父类的交互。虽然TControl也有绘图,但最后还是要让父类TWinControl来画。
TWinControl = class(TControl) constructor Create(AOwner: TComponent); override; constructor CreateParented(ParentWindow: HWnd); class function CreateParentedControl(ParentWindow: HWND): TWinControl; destructor Destroy; override; procedure Broadcast(var Message); function GetHandle: HWND; procedure SetParentWindow(Value: HWND); function GetControlCount: Integer; function GetControl(Index: Integer): TControl; procedure Insert(AControl: TControl); procedure SetZOrderPosition(Position: Integer); function HandleAllocated: Boolean; procedure HandleNeeded; procedure InsertControl(AControl: TControl); procedure CreateHandle; virtual; procedure CreateParams(var Params: TCreateParams); virtual; procedure CreateWindowHandle(const Params: TCreateParams); virtual; procedure CreateWnd; virtual; procedure RecreateWnd; procedure DestroyHandle; virtual; procedure DestroyWindowHandle; virtual; procedure DestroyWnd; virtual; function GetDeviceContext(var WindowHandle: HWND): HDC; overload; override; function GetParentHandle: HWND; function GetTopParentHandle: HWnd; procedure SetParent(AParent: TWinControl); override; procedure SetParentBackground(Value: Boolean); virtual; procedure SetParentDoubleBuffered(Value: Boolean); virtual; procedure SetZOrder(TopMost: Boolean); override; procedure RemoveControl(AControl: TControl);procedure UpdateControlState;
procedure CreateSubClass(var Params: TCreateParams; ControlClassName: PChar); // 超类化 procedure WndProc(var Message: TMessage); override; property DefWndProc: Pointer read FDefWndProc write FDefWndProc; property WindowHandle: HWnd read FHandle write FHandle; procedure DefaultHandler(var Message); override; procedure MainWndProc(var Message: TMessage); function PreProcessMessage(var Msg: TMsg): Boolean; dynamic; procedure Repaint; override; // 就两句:调用 类函数Invalidate; 和 类函数Update(今天怎么觉得思路格外清楚啊); // 让程序员有机会总揽全局,既使控件失效,又立即重绘,因为一般情况下只需要让控件失效即可,然后系统空闲时发信息让控件重绘,程序员不需要管理和调用后者。
procedure Notification(AComponent: TComponent; Operation: TOperation); override; procedure NotifyControls(Msg: Word); procedure PaintControls(DC: HDC; First: TControl); // 给FControls发Perform(WM_PAINT, DC, 0); 把图像子控件全部重绘了一遍。对所有的FWinControls 调用WinAPI FrameRect 用指定的画刷为指定的矩形画边框 UpdateShowing; // 只处理是否Visible procedure Invalidate; override; // 内容就一句 Perform(CM_INVALIDATE, 0, 0); 另外观察一下TControl.Invalidate;函数 也是就一句:InvalidateControl(Visible, csOpaque in ControlStyle);
procedure PaintTo(Canvas: TCanvas; X, Y: Integer); overload; procedure Update; override; // 调用WinAPI函数 if HandleAllocated then UpdateWindow(WindowHandle); // 会产生WM_PAINT消息。让程序员有机会强行自绘控件。 总结:自绘过程一共有四个函数实际干活,第一步是收到系统消息调用WMPaint,第二步把消息转交给PaintHandler,第三步首先绘制自己,即调用自己的PaintWindow,第四步调用PaintControls绘制所有子控件(会给所有子控件挨个发送WM_PAINT)。
备注:对于一个单独的控件自己而言,重绘其实就两步,第一步让控件失效,第二步等待系统给Win控件发送WM_PAINT后真正重绘,但是也可由程序员强迫立即重绘(UpdateWindow)。具体重绘过程由VCL控制,包含了自动重绘图形子控件和调用程序员的事件
procedure AssignTo(Dest: TPersistent); override; function GetClientRect: TRect; override; function IsDoubleBufferedStored: Boolean; procedure SetDoubleBuffered(Value: Boolean); procedure DoEnter; dynamic; procedure DoExit; dynamic; function DoKeyDown(var Message: TWMKey): Boolean; function DoKeyPress(var Message: TWMKey): Boolean; function DoKeyUp(var Message: TWMKey): Boolean; procedure WMInputLangChange(var Message: TMessage); message WM_INPUTLANGCHANGE; // 输入法改变 procedure WMPaint(var Message: TWMPaint); message WM_PAINT; // 这里只是收到消息,收到以后怎么做不一定要放在这里。实际上:如果不双缓冲就调用 PaintHandler,否则立刻重绘(并且还考虑Windows主题的影响)。 procedure WMCommand(var Message: TWMCommand); message WM_COMMAND; // 菜单、工具栏命令 procedure WMNotify(var Message: TWMNotify); message WM_NOTIFY; // 通知消息 procedure WMSysColorChange(var Message: TWMSysColorChange); message WM_SYSCOLORCHANGE; // 系统颜色改变 procedure WMHScroll(var Message: TWMHScroll); message WM_HSCROLL; procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL; procedure WMCompareItem(var Message: TWMCompareItem); message WM_COMPAREITEM; procedure WMDeleteItem(var Message: TWMDeleteItem); message WM_DELETEITEM; procedure WMDrawItem(var Message: TWMDrawItem); message WM_DRAWITEM; procedure WMMeasureItem(var Message: TWMMeasureItem); message WM_MEASUREITEM; procedure WMEraseBkgnd(var Message: TWmEraseBkgnd); message WM_ERASEBKGND; // 画背景色,间接的发送 WM_ERASEBKGND消息,不实际干活 procedure WMWindowPosChanged(var Message: TWMWindowPosChanged); message WM_WINDOWPOSCHANGED; // 位置改变 procedure WMWindowPosChanging(var Message: TWMWindowPosChanging); message WM_WINDOWPOSCHANGING; procedure WMSize(var Message: TWMSize); message WM_SIZE; procedure WMMove(var Message: TWMMove); message WM_MOVE; procedure WMSetCursor(var Message: TWMSetCursor); message WM_SETCURSOR; // 设置光标 procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN; // 按键方法 procedure WMSysKeyDown(var Message: TWMSysKeyDown); message WM_SYSKEYDOWN; procedure WMKeyUp(var Message: TWMKeyUp); message WM_KEYUP; procedure WMSysKeyUp(var Message: TWMSysKeyUp); message WM_SYSKEYUP; // 系统按键 procedure WMChar(var Message: TWMChar); message WM_CHAR; procedure WMSysCommand(var Message: TWMSysCommand); message WM_SYSCOMMAND; // 系统命令 procedure WMCharToItem(var Message: TWMCharToItem); message WM_CHARTOITEM; procedure WMParentNotify(var Message: TWMParentNotify); message WM_PARENTNOTIFY; // 父控件通知 procedure WMVKeyToItem(var Message: TWMVKeyToItem); message WM_VKEYTOITEM; procedure WMDestroy(var Message: TWMDestroy); message WM_DESTROY; // 销毁 procedure WMMouseActivate(var Message: TWMMouseActivate); message WM_MOUSEACTIVATE; procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE; // 非客户区重新计算 procedure WMNCDestroy(var Message: TWMNCDestroy); message WM_NCDESTROY; // 非客户区销毁 procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST; procedure WMNCPaint(var Message: TWMNCPaint); message WM_NCPAINT; // 非客户区绘图 procedure WMQueryNewPalette(var Message: TMessage); message WM_QUERYNEWPALETTE; procedure WMPaletteChanged(var Message: TMessage); message WM_PALETTECHANGED; procedure WMWinIniChange(var Message: TMessage); message WM_WININICHANGE; procedure WMFontChange(var Message: TMessage); message WM_FONTCHANGE; // 字体被改变 procedure WMTimeChange(var Message: TMessage); message WM_TIMECHANGE; // 时间被改变 procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS; procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS; procedure WMIMEStartComp(var Message: TMessage); message WM_IME_STARTCOMPOSITION; procedure WMIMEEndComp(var Message: TMessage); message WM_IME_ENDCOMPOSITION; procedure WMContextMenu(var Message: TWMContextMenu); message WM_CONTEXTMENU; procedure WMGesture(var Message: TMessage); message WM_GESTURE; procedure WMGestureNotify(var Message: TWMGestureNotify); message WM_GESTURENOTIFY; procedure WMTabletQuerySystemGestureStatus(var Message: TMessage); message WM_TABLET_QUERYSYSTEMGESTURESTATUS; procedure WMPrintClient(var Message: TWMPrintClient); message WM_PRINTCLIENT;
procedure CMInputLangChange(var Message: TMessage); message CM_INPUTLANGCHANGE; procedure CMChanged(var Message: TCMChanged); message CM_CHANGED; procedure CMChildKey(var Message: TCMChildKey); message CM_CHILDKEY; procedure CMDialogKey(var Message: TCMDialogKey); message CM_DIALOGKEY; procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR; procedure CMVisibleChanged(var Message: TMessage); message CM_VISIBLECHANGED; procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED; procedure CMColorChanged(var Message: TMessage); message CM_COLORCHANGED; procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED; procedure CMBorderChanged(var Message: TMessage); message CM_BORDERCHANGED; procedure CMCursorChanged(var Message: TMessage); message CM_CURSORCHANGED; procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED; procedure CMParentCtl3DChanged(var Message: TMessage); message CM_PARENTCTL3DCHANGED; procedure CMParentDoubleBufferedChanged(var Message: TMessage); message CM_PARENTDOUBLEBUFFEREDCHANGED; procedure CMShowingChanged(var Message: TMessage); message CM_SHOWINGCHANGED; procedure CMShowHintChanged(var Message: TMessage); message CM_SHOWHINTCHANGED; procedure CMEnter(var Message: TCMEnter); message CM_ENTER; procedure CMExit(var Message: TCMExit); message CM_EXIT; procedure CMDesignHitTest(var Message: TCMDesignHitTest); message CM_DESIGNHITTEST; procedure CMSysColorChange(var Message: TMessage); message CM_SYSCOLORCHANGE; procedure CMSysFontChanged(var Message: TMessage); message CM_SYSFONTCHANGED; procedure CMWinIniChange(var Message: TWMWinIniChange); message CM_WININICHANGE; procedure CMFontChange(var Message: TMessage); message CM_FONTCHANGE; procedure CMTimeChange(var Message: TMessage); message CM_TIMECHANGE; procedure CMDrag(var Message: TCMDrag); message CM_DRAG;
procedure CNKeyDown(var Message: TWMKeyDown); message CN_KEYDOWN; procedure CNKeyUp(var Message: TWMKeyUp); message CN_KEYUP; procedure CNChar(var Message: TWMChar); message CN_CHAR; procedure CNSysKeyDown(var Message: TWMKeyDown); message CN_SYSKEYDOWN; procedure CNSysChar(var Message: TWMChar); message CN_SYSCHAR;
procedure CMRecreateWnd(var Message: TMessage); message CM_RECREATEWND; procedure CMInvalidate(var Message: TMessage); message CM_INVALIDATE; procedure CMBiDiModeChanged(var Message: TMessage); message CM_BIDIMODECHANGED; procedure CMDoubleBufferedChanged(var Message: TMessage); message CM_DOUBLEBUFFEREDCHANGED; procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED; procedure CMTabletOptionsChanged(var Message: TMessage); message CM_TABLETOPTIONSCHANGED; procedure CMFocusChanged(var Message: TCMFocusChanged); message CM_FOCUSCHANGED; procedure CMControlListChange(var Message: TMessage); message CM_CONTROLLISTCHANGE; procedure CMControlListChanging(var Message: TMessage); message CM_CONTROLLISTCHANGING; procedure CMDockClient(var Message: TCMDockClient); message CM_DOCKCLIENT; procedure CMUnDockClient(var Message: TCMUnDockClient); message CM_UNDOCKCLIENT; procedure CMFloat(var Message: TCMFloat); message CM_FLOAT; property Brush: TBrush read FBrush; property Controls[Index: Integer]: TControl read GetControl; property ControlCount: Integer read GetControlCount; property Handle: HWND read GetHandle; property ParentDoubleBuffered: Boolean read FParentDoubleBuffered write SetParentDoubleBuffered default True; property ParentWindow: HWND read FParentWindow write SetParentWindow; property Showing: Boolean read FShowing;
贴一下TWinControl的几个关键的自绘代码:
procedure TWinControl.Repaint; begin Invalidate; Update; end; procedure TWinControl.Invalidate; begin Perform(CM_INVALIDATE, 0, 0); end; procedure TWinControl.CMInvalidate(var Message: TMessage); var I: Integer; begin if HandleAllocated then begin if Parent <> nil then Parent.Perform(CM_INVALIDATE, 1, 0); if Message.WParam = 0 then begin InvalidateRect(FHandle, nil, not (csOpaque in ControlStyle)); { Invalidate child windows which use the parentbackground when themed } if ThemeServices.ThemesEnabled then for I := 0 to ControlCount - 1 do if csParentBackground in Controls[I].ControlStyle then Controls[I].Invalidate; end; end; end; procedure TWinControl.Update; begin if HandleAllocated then UpdateWindow(FHandle); end;
TWinControl的属性:
FDefWndProc: Pointer;
FHandle: HWnd;
FObjectInstance: Pointer;
FParentWindow: HWND;
FBrush: TBrush;
FControls: TList;
FWinControls: TList;
FAlignControlList: TList;
FParentDoubleBuffered: Boolean;
FDoubleBuffered: Boolean;
FDesignSize: TPoint;
FMouseControl: TControl;
FTouchControl: TControl;
FOnEnter: TNotifyEvent;
FOnExit: TNotifyEvent;
FOnKeyDown: TKeyEvent;
FOnKeyUp: TKeyEvent;
FOnKeyPress: TKeyPressEvent;
再来窗口参数:
TCreateParams = record Caption: PChar; Style: DWORD; ExStyle: DWORD; X, Y: Integer; Width, Height: Integer; WndParent: HWnd; Param: Pointer; WindowClass: TWndClass; WinClassName: array[0..63] of Char; end;
PaintControls的定义,一共2处调用:
procedure TControl.Repaint; var DC: HDC; begin if (Visible or (csDesigning in ComponentState) and not (csNoDesignVisible in ControlStyle)) and (Parent <> nil) and Parent.HandleAllocated then if csOpaque in ControlStyle then begin DC := GetDC(Parent.Handle); try IntersectClipRect(DC, Left, Top, Left + Width, Top + Height); Parent.PaintControls(DC, Self); // 写清楚了,要求父控件更新当前图形控件的显示(而不是重绘全部子控件) finally ReleaseDC(Parent.Handle, DC); end; end else begin Invalidate; Update; 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); // 当重绘全部图形子控件的时候,第二个参数就传入nil finally if Message.DC = 0 then EndPaint(Handle, PS); end; end; 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 // 就像这个函数名字的含义一样,真的是只重绘所有图形子控件,而不重绘它的WinControl子控件(只重绘它们的边框) begin I := 0; if First <> nil then begin I := FControls.IndexOf(First); if I < 0 then I := 0; 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, 0, 0, Width, Height); Perform(WM_PAINT, DC, 0); RestoreDC(DC, SaveIndex); Exclude(FControlState, csPaintCopy); end; Inc(I); end; end; if FWinControls <> nil then for I := 0 to FWinControls.Count - 1 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 // 只重绘WinControl子控件的边框,而不是重绘整个控件 FrameBrush := CreateSolidBrush(ColorToRGB(clBtnShadow)); FrameRect(DC, Rect(Left - 1, Top - 1, Left + Width, Top + Height), FrameBrush); DeleteObject(FrameBrush); FrameBrush := CreateSolidBrush(ColorToRGB(clBtnHighlight)); FrameRect(DC, Rect(Left, Top, Left + Width + 1, Top + Height + 1), FrameBrush); DeleteObject(FrameBrush); end; end;
另外,整个Controls.pas里一共有7处取DC(搜索DC :=),其实重要的地方只有三处(TWinControl.PaintHandler和TControl.Repaint和TWinControl.WMPaint),总体方针是DC现用现取:
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 procedure TControl.Repaint; var DC: HDC; begin if (Visible or (csDesigning in ComponentState) and not (csNoDesignVisible in ControlStyle)) and (Parent <> nil) and Parent.HandleAllocated then if csOpaque in ControlStyle then begin DC := GetDC(Parent.Handle); function TControl.PaletteChanged(Foreground: Boolean): Boolean; var OldPalette, Palette: HPALETTE; WindowHandle: HWnd; DC: HDC; begin Result := False; if not Visible then Exit; Palette := GetPalette; if Palette <> 0 then begin DC := GetDeviceContext(WindowHandle); procedure TControl.DefaultDockImage(DragDockObject: TDragDockObject; Erase: Boolean); var DesktopWindow: HWND; DC: HDC; OldBrush: HBrush; DrawRect: TRect; PenSize: Integer; begin with DragDockObject do begin PenSize := FrameWidth; if Erase then DrawRect := FEraseDockRect else DrawRect := FDockRect; end; DesktopWindow := GetDesktopWindow; DC := GetDCEx(DesktopWindow, 0, DCX_CACHE or DCX_LOCKWINDOWUPDATE); procedure TWinControl.WMNCPaint(var Message: TMessage); var DC: HDC; RC, RW, SaveRW: TRect; EdgeSize: Integer; WinStyle: Longint; begin { Get window DC that is clipped to the non-client area } if (BevelKind <> bkNone) or (BorderWidth > 0) then begin DC := GetWindowDC(Handle); try Windows.GetClientRect(Handle, RC); procedure THintWindow.WMNCPaint(var Message: TMessage); var DC: HDC; begin DC := GetWindowDC(Handle); try NCPaint(DC); finally ReleaseDC(Handle, DC); end; end;
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); // 取桌面的DC 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;
再研究Canvas,待续。。。