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

Posted

tags:

篇首语:本文由小常识网(cha138.com)小编为大家整理,主要介绍了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(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;

 

以上是关于Delphi一共封装(超类化)了8种Windows基础控件和17种复杂控件的主要内容,如果未能解决你的问题,请参考以下文章

从多个故事板子类化 UIViewController

delphi 10.2 创建并使用资源文件(一共22种格式,RCDATA是自定义格式)

Delphi颜色的表示(一共5种表示法)

DELPHI XE7 新的并行库

Indy 10.5.8 for Delphi and Lazarus 修改版(2011)

Delphi 中的DLL 封装和调用对象技术(刘艺,有截图)