Delphi一共封装（超类化）了8种Windows基础控件和17种复杂控件

超类化源码：

procedure TWinControl.CreateSubClass(var Params: TCreateParams; ControlClassName: PChar);

const

  {CS_OWNDC标志，属于此窗口类的窗口实例都有自己的DC(称为私有DC) }

  {CS_CLASSDC标志，所有属于该类的窗口实例共享相同的DC（称为类DC）.类DC有一些私有DC的优点，而更加节约内存}

  {CS_PARENTDC标志，属于这个类的窗口都使用它的父窗口的句柄。和CS_CLASSDC相似的是，多个窗口共享一个DC，不同的是，这多个窗口（虽然有父子关系并且共享DC）并不要求都属于同一个窗口类}

  {CS_GLOBALCLASS标志，是唯一一个针对类本身起作用而不是对单个窗口起作用的标志。}

  CS_OFF = CS_OWNDC or CS_CLASSDC or CS_PARENTDC or CS_GLOBALCLASS;

  {CS_HREDRAW和CS_VREDRAW标志表示当窗口的水平尺寸（宽度）改变的时候，重画整个窗口。按钮和滚动条都有这两种风格。}

  CS_ON = CS_VREDRAW or CS_HREDRAW;

var

  SaveInstance: THandle;

begin

  // 说是子类化，其实是超类化

  // http://www.cnblogs.com/findumars/p/4121704.html Delphi对Button的超类化

  // http://www.cnblogs.com/findumars/p/4680601.html 子类化是窗口实例级别的，超类化是在窗口类（WNDCLASS）级别的

  // http://www.cnblogs.com/sfqh/p/3384457.html 探索Win32系统之窗口类

  // important 两个参数：Windows类的风格，类名（Windows的内置类）

  // Creates a windowed control derived from an existing Windows window class.

  // CreateSubClass allows VCL controls to create registered Windows controls.

  // 问题：不明白，哪里创建新类了。回答：根据已有的Windows类，创建Windows控件，注意是控件，不是类。

  // 此单元没有调用此函数，但TButton，TEdit，TCombobox 等等都调用了它。

  if ControlClassName <> nil then // 如果类名不为空

    with Params do // 它是可变参数，结构体Params.WindowClass

    begin

      // 记录当前Windows类的句柄实例（其实是整个EXE模块的句柄）

      SaveInstance := WindowClass.hInstance;

      // API取得相关信息(第三个参数)。 失败返回0

      // 只有三次执行都失败（2个句柄，一个类名），条件才成立。也就是这个ControlClassName新类还没有在内存中注册过。

      if not GetClassInfo(HInstance, ControlClassName, WindowClass) and // API 取得信息填充，第一个参数是Application.Instance(全局变量)，第二个参数是类名，第三个参数等待填充的结构，即Params.WindowClass

         not GetClassInfo(, ControlClassName, WindowClass) and         //

         not GetClassInfo(MainInstance, ControlClassName, WindowClass)  // MainInstance就这一处，标识EXE文件的Instance（系统级全局变量）

      then

        // 根据句柄和名称得到WindowClass的所有信息，注意，有可能覆盖了原先的hInstance，所以要事先记录，事后赋值

        GetClassInfo(WindowClass.hInstance, ControlClassName, WindowClass); // API，第三个参数是Out

      // 一旦发现类名注册过了，就什么都不用做

      // 为了保险起见，除了EXE模块句柄不得不重新赋值以外，其它一切旧有记录信息从Windows内核中直接取出。连类名都有可能被改变。

      // fixme TButton调用了它，应该跟踪一下。

      WindowClass.hInstance := SaveInstance;

      // 改变风格标记，不希望自绘，并且窗口大小或位置改变后，就重绘整个窗口

      // 注意，TEdit等等都是直接继承自TWinControl，没有自绘句柄。

      WindowClass.style := WindowClass.style and not CS_OFF or CS_ON; // fixme 抛弃一切DC，准备使用Delphi体系的Canvas进行自绘。

      // 问题：执行以后，类名到底是TButton还是Button？

      // important 取到的信息，都通过Params.WindowClass传出去

    end;

end;

8种Windows基础控件：

"G:\Vcl\StdCtrls.pas"(,):  CreateSubClass(Params, 'EDIT');

"G:\Vcl\StdCtrls.pas"(,):  CreateSubClass(Params, 'COMBOBOX');

"G:\Vcl\StdCtrls.pas"(,):  CreateSubClass(Params, 'BUTTON'); // TButton

"G:\Vcl\StdCtrls.pas"(,):  CreateSubClass(Params, 'BUTTON'); // TCustomCheckBox

"G:\Vcl\StdCtrls.pas"(,):  CreateSubClass(Params, 'BUTTON'); // TRadioButton

"G:\Vcl\StdCtrls.pas"(,):  CreateSubClass(Params, 'LISTBOX');

"G:\Vcl\StdCtrls.pas"(,):  CreateSubClass(Params, 'SCROLLBAR');

"G:\Vcl\StdCtrls.pas"(,):  CreateSubClass(Params, 'STATIC');

17种Windows复杂控件：

"G:\Vcl\ComCtrls.pas"(,):  CreateSubClass(Params, 'RICHEDIT');

"G:\Vcl\ComCtrls.pas"(,):  CreateSubClass(Params, WC_TABCONTROL);

"G:\Vcl\ComCtrls.pas"(,):  CreateSubClass(Params, STATUSCLASSNAME);

"G:\Vcl\ComCtrls.pas"(,):  CreateSubClass(Params, WC_HEADER);

"G:\Vcl\ComCtrls.pas"(,):  CreateSubClass(Params, WC_TREEVIEW);

"G:\Vcl\ComCtrls.pas"(,):  CreateSubClass(Params, TRACKBAR_CLASS);

"G:\Vcl\ComCtrls.pas"(,):  CreateSubClass(Params, PROGRESS_CLASS);

"G:\Vcl\ComCtrls.pas"(,):  CreateSubClass(Params, UPDOWN_CLASS);

"G:\Vcl\ComCtrls.pas"(,):  CreateSubClass(Params, HOTKEYCLASS);

"G:\Vcl\ComCtrls.pas"(,):  CreateSubClass(Params, WC_LISTVIEW);

"G:\Vcl\ComCtrls.pas"(,):  CreateSubClass(Params, ANIMATE_CLASS);

"G:\Vcl\ComCtrls.pas"(,):  CreateSubClass(Params, TOOLBARCLASSNAME);

"G:\Vcl\ComCtrls.pas"(,):  CreateSubClass(Params, REBARCLASSNAME);

"G:\Vcl\ComCtrls.pas"(,):  CreateSubClass(Params, MONTHCAL_CLASS);

"G:\Vcl\ComCtrls.pas"(,):  CreateSubClass(Params, DATETIMEPICK_CLASS);

"G:\Vcl\ComCtrls.pas"(,):  CreateSubClass(Params, WC_PAGESCROLLER);

"G:\Vcl\ComCtrls.pas"(,):  CreateSubClass(Params, WC_COMBOBOXEX);

本着任何技术都要烂熟于心的精神，把8种基础控件的代码贴上来，混个脸熟，以后再加上注释：

procedure TCustomEdit.CreateParams(var Params: TCreateParams);

const

  Passwords: array[Boolean] of DWORD = (, ES_PASSWORD);

  ReadOnlys: array[Boolean] of DWORD = (, ES_READONLY);

  CharCases: array[TEditCharCase] of DWORD = (, ES_UPPERCASE, ES_LOWERCASE);

  HideSelections: array[Boolean] of DWORD = (ES_NOHIDESEL, );

  OEMConverts: array[Boolean] of DWORD = (, ES_OEMCONVERT);

begin

  inherited CreateParams(Params);

  CreateSubClass(Params, 'EDIT');

  with Params do

  begin

    Style := Style or (ES_AUTOHSCROLL or ES_AUTOVSCROLL) or

      BorderStyles[FBorderStyle] or Passwords[FPasswordChar <> #] or

      ReadOnlys[FReadOnly] or CharCases[FCharCase] or

      HideSelections[FHideSelection] or OEMConverts[FOEMConvert];

    if NewStyleControls and Ctl3D and (FBorderStyle = bsSingle) then

    begin

      Style := Style and not WS_BORDER;

      ExStyle := ExStyle or WS_EX_CLIENTEDGE;

    end;

  end;

end;

procedure TCustomComboBox.CreateParams(var Params: TCreateParams);

const

  ComboBoxStyles: array[TComboBoxStyle] of DWORD = (

    CBS_DROPDOWN, CBS_SIMPLE, CBS_DROPDOWNLIST,

    CBS_DROPDOWNLIST or CBS_OWNERDRAWFIXED,

    CBS_DROPDOWNLIST or CBS_OWNERDRAWVARIABLE);

  CharCases: array[TEditCharCase] of DWORD = (, CBS_UPPERCASE, CBS_LOWERCASE);

  Sorts: array[Boolean] of DWORD = (, CBS_SORT);

begin

  inherited CreateParams(Params);

  CreateSubClass(Params, 'COMBOBOX');

  with Params do

    Style := Style or (WS_VSCROLL or CBS_HASSTRINGS or CBS_AUTOHSCROLL) or

      ComboBoxStyles[FStyle] or Sorts[FSorted] or CharCases[FCharCase];

end;

procedure TButton.CreateParams(var Params: TCreateParams);

const

  ButtonStyles: array[Boolean] of DWORD = (BS_PUSHBUTTON, BS_DEFPUSHBUTTON);

begin

  inherited CreateParams(Params);

  CreateSubClass(Params, 'BUTTON');

  Params.Style := Params.Style or ButtonStyles[FDefault];

end;

procedure TCustomCheckBox.CreateParams(var Params: TCreateParams);

const

  Alignments: array[Boolean, TLeftRight] of DWORD =

    ((BS_LEFTTEXT, ), (, BS_LEFTTEXT));

begin

  inherited CreateParams(Params);

  CreateSubClass(Params, 'BUTTON');

  with Params do

  begin

    Style := Style or BS_3STATE or

      Alignments[UseRightToLeftAlignment, FAlignment];

    WindowClass.style := WindowClass.style and not (CS_HREDRAW or CS_VREDRAW);

  end;

end;

procedure TRadioButton.CreateParams(var Params: TCreateParams);

const

  Alignments: array[Boolean, TLeftRight] of DWORD =

    ((BS_LEFTTEXT, ), (, BS_LEFTTEXT));

begin

  inherited CreateParams(Params);

  CreateSubClass(Params, 'BUTTON');

  with Params do

    Style := Style or BS_RADIOBUTTON or

      Alignments[UseRightToLeftAlignment, FAlignment];

end;

procedure TCustomListBox.CreateParams(var Params: TCreateParams);

type

  PSelects = ^TSelects;

  TSelects = array[Boolean] of DWORD;

const

  Styles: array[TListBoxStyle] of DWORD =

    (, LBS_OWNERDRAWFIXED, LBS_OWNERDRAWVARIABLE, LBS_OWNERDRAWFIXED,

     LBS_OWNERDRAWFIXED);

  Sorteds: array[Boolean] of DWORD = (, LBS_SORT);

  MultiSelects: array[Boolean] of DWORD = (, LBS_MULTIPLESEL);

  ExtendSelects: array[Boolean] of DWORD = (, LBS_EXTENDEDSEL);

  IntegralHeights: array[Boolean] of DWORD = (LBS_NOINTEGRALHEIGHT, );

  MultiColumns: array[Boolean] of DWORD = (, LBS_MULTICOLUMN);

  TabStops: array[Boolean] of DWORD = (, LBS_USETABSTOPS);

  CSHREDRAW: array[Boolean] of DWORD = (CS_HREDRAW, );

  Data: array[Boolean] of DWORD = (LBS_HASSTRINGS, LBS_NODATA);

var

  Selects: PSelects;

begin

  inherited CreateParams(Params);

  CreateSubClass(Params, 'LISTBOX');

  with Params do

  begin

    Selects := @MultiSelects;

    if FExtendedSelect then Selects := @ExtendSelects;

    Style := Style or (WS_HSCROLL or WS_VSCROLL or

      Data[Self.Style in [lbVirtual, lbVirtualOwnerDraw]] or

      LBS_NOTIFY) or Styles[FStyle] or Sorteds[FSorted] or

      Selects^[FMultiSelect] or IntegralHeights[FIntegralHeight] or

      MultiColumns[FColumns <> ] or BorderStyles[FBorderStyle] or

      TabStops[FTabWidth <> ];

    if NewStyleControls and Ctl3D and (FBorderStyle = bsSingle) then

    begin

      Style := Style and not WS_BORDER;

      ExStyle := ExStyle or WS_EX_CLIENTEDGE;

    end;

    WindowClass.style := WindowClass.style and not (CSHREDRAW[UseRightToLeftAlignment] or CS_VREDRAW);

  end;

end;

procedure TScrollBar.CreateParams(var Params: TCreateParams);

const

  Kinds: array[TScrollBarKind] of DWORD = (SBS_HORZ, SBS_VERT);

begin

  inherited CreateParams(Params);

  CreateSubClass(Params, 'SCROLLBAR');

  Params.Style := Params.Style or Kinds[FKind];

  if FKind = sbVertical then

    if not UseRightToLeftAlignment then

      Params.Style := Params.Style or SBS_RIGHTALIGN

    else

      Params.Style := Params.Style or SBS_LEFTALIGN;

  if NotRightToLeft then

    FRTLFactor :=

  else

    FRTLFactor := -;

end;

procedure TCustomStaticText.CreateParams(var Params: TCreateParams);

const

  Alignments: array[Boolean, TAlignment] of DWORD =

    ((SS_LEFT, SS_RIGHT, SS_CENTER), (SS_RIGHT, SS_LEFT, SS_CENTER));

  Borders: array[TStaticBorderStyle] of DWORD = (, WS_BORDER, SS_SUNKEN);

begin

  inherited CreateParams(Params);

  CreateSubClass(Params, 'STATIC');

  with Params do

  begin

    Style := Style or SS_NOTIFY or

      Alignments[UseRightToLeftAlignment, FAlignment] or Borders[FBorderStyle];

    if not FShowAccelChar then Style := Style or SS_NOPREFIX;

    WindowClass.style := WindowClass.style and not CS_VREDRAW;

  end;

end;

再看看RichEdit的封装代码：

procedure TCustomRichEdit.CreateParams(var Params: TCreateParams);

const

  RichEditModuleName = 'RICHED32.DLL';

  HideScrollBars: array[Boolean] of DWORD = (ES_DISABLENOSCROLL, );

  HideSelections: array[Boolean] of DWORD = (ES_NOHIDESEL, );

begin

  if FRichEditModule =  then

  begin

    FRichEditModule := LoadLibrary(RichEditModuleName);

    if FRichEditModule <= HINSTANCE_ERROR then FRichEditModule := ;

  end;

  inherited CreateParams(Params);

  CreateSubClass(Params, 'RICHEDIT');

  with Params do

  begin

    Style := Style or HideScrollBars[FHideScrollBars] or

      HideSelections[HideSelection];

    WindowClass.style := WindowClass.style and not (CS_HREDRAW or CS_VREDRAW);

  end;

end;

巴特西

Delphi一共封装（超类化）了8种Windows基础控件和17种复杂控件

最新文章

热门文章