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

Posted 2020-06-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(0, 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"(1898,3):  CreateSubClass(Params, ‘EDIT‘);
"G:\\Vcl\\StdCtrls.pas"(2986,3):  CreateSubClass(Params, ‘COMBOBOX‘);
"G:\\Vcl\\StdCtrls.pas"(3512,3):  CreateSubClass(Params, ‘BUTTON‘); // TButton
"G:\\Vcl\\StdCtrls.pas"(3658,3):  CreateSubClass(Params, ‘BUTTON‘); // TCustomCheckBox
"G:\\Vcl\\StdCtrls.pas"(3783,3):  CreateSubClass(Params, ‘BUTTON‘); // TRadioButton
"G:\\Vcl\\StdCtrls.pas"(4369,3):  CreateSubClass(Params, ‘LISTBOX‘);
"G:\\Vcl\\StdCtrls.pas"(4783,3):  CreateSubClass(Params, ‘SCROLLBAR‘);
"G:\\Vcl\\StdCtrls.pas"(4984,3):  CreateSubClass(Params, ‘STATIC‘);

17种Windows复杂控件：

"G:\\Vcl\\ComCtrls.pas"(11434,3):  CreateSubClass(Params, ‘RICHEDIT‘);
"G:\\Vcl\\ComCtrls.pas"(4263,3):  CreateSubClass(Params, WC_TABCONTROL);
"G:\\Vcl\\ComCtrls.pas"(5604,3):  CreateSubClass(Params, STATUSCLASSNAME);
"G:\\Vcl\\ComCtrls.pas"(6268,3):  CreateSubClass(Params, WC_HEADER);
"G:\\Vcl\\ComCtrls.pas"(8410,3):  CreateSubClass(Params, WC_TREEVIEW);
"G:\\Vcl\\ComCtrls.pas"(10039,3):  CreateSubClass(Params, TRACKBAR_CLASS);
"G:\\Vcl\\ComCtrls.pas"(10376,3):  CreateSubClass(Params, PROGRESS_CLASS);
"G:\\Vcl\\ComCtrls.pas"(11856,3):  CreateSubClass(Params, UPDOWN_CLASS);
"G:\\Vcl\\ComCtrls.pas"(12181,3):  CreateSubClass(Params, HOTKEYCLASS);
"G:\\Vcl\\ComCtrls.pas"(13593,3):  CreateSubClass(Params, WC_LISTVIEW);
"G:\\Vcl\\ComCtrls.pas"(15775,3):  CreateSubClass(Params, ANIMATE_CLASS);
"G:\\Vcl\\ComCtrls.pas"(16837,3):  CreateSubClass(Params, TOOLBARCLASSNAME);
"G:\\Vcl\\ComCtrls.pas"(19840,3):  CreateSubClass(Params, REBARCLASSNAME);
"G:\\Vcl\\ComCtrls.pas"(21313,3):  CreateSubClass(Params, MONTHCAL_CLASS);
"G:\\Vcl\\ComCtrls.pas"(21421,3):  CreateSubClass(Params, DATETIMEPICK_CLASS);
"G:\\Vcl\\ComCtrls.pas"(21691,3):  CreateSubClass(Params, WC_PAGESCROLLER);
"G:\\Vcl\\ComCtrls.pas"(22175,3):  CreateSubClass(Params, WC_COMBOBOXEX);

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

procedure TCustomEdit.CreateParams(var Params: TCreateParams);
const
  Passwords: array[Boolean] of DWORD = (0, ES_PASSWORD);
  ReadOnlys: array[Boolean] of DWORD = (0, ES_READONLY);
  CharCases: array[TEditCharCase] of DWORD = (0, ES_UPPERCASE, ES_LOWERCASE);
  HideSelections: array[Boolean] of DWORD = (ES_NOHIDESEL, 0);
  OEMConverts: array[Boolean] of DWORD = (0, 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 <> #0] 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 = (0, CBS_UPPERCASE, CBS_LOWERCASE);
  Sorts: array[Boolean] of DWORD = (0, 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, 0), (0, 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, 0), (0, 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 =
    (0, LBS_OWNERDRAWFIXED, LBS_OWNERDRAWVARIABLE, LBS_OWNERDRAWFIXED,
     LBS_OWNERDRAWFIXED);
  Sorteds: array[Boolean] of DWORD = (0, LBS_SORT);
  MultiSelects: array[Boolean] of DWORD = (0, LBS_MULTIPLESEL);
  ExtendSelects: array[Boolean] of DWORD = (0, LBS_EXTENDEDSEL);
  IntegralHeights: array[Boolean] of DWORD = (LBS_NOINTEGRALHEIGHT, 0);
  MultiColumns: array[Boolean] of DWORD = (0, LBS_MULTICOLUMN);
  TabStops: array[Boolean] of DWORD = (0, LBS_USETABSTOPS);
  CSHREDRAW: array[Boolean] of DWORD = (CS_HREDRAW, 0);
  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 <> 0] or BorderStyles[FBorderStyle] or
      TabStops[FTabWidth <> 0];
    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 := 1
  else
    FRTLFactor := -1;
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 = (0, 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, 0);
  HideSelections: array[Boolean] of DWORD = (ES_NOHIDESEL, 0);
begin
  if FRichEditModule = 0 then
  begin
    FRichEditModule := LoadLibrary(RichEditModuleName);
    if FRichEditModule <= HINSTANCE_ERROR then FRichEditModule := 0;
  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;