• 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:VclStdCtrls.pas"(1898,3):  CreateSubClass(Params, 'EDIT');
    "G:VclStdCtrls.pas"(2986,3):  CreateSubClass(Params, 'COMBOBOX');
    "G:VclStdCtrls.pas"(3512,3):  CreateSubClass(Params, 'BUTTON'); // TButton
    "G:VclStdCtrls.pas"(3658,3):  CreateSubClass(Params, 'BUTTON'); // TCustomCheckBox
    "G:VclStdCtrls.pas"(3783,3):  CreateSubClass(Params, 'BUTTON'); // TRadioButton
    "G:VclStdCtrls.pas"(4369,3):  CreateSubClass(Params, 'LISTBOX');
    "G:VclStdCtrls.pas"(4783,3):  CreateSubClass(Params, 'SCROLLBAR');
    "G:VclStdCtrls.pas"(4984,3):  CreateSubClass(Params, 'STATIC');

    17种Windows复杂控件:

    "G:VclComCtrls.pas"(11434,3):  CreateSubClass(Params, 'RICHEDIT');
    "G:VclComCtrls.pas"(4263,3):  CreateSubClass(Params, WC_TABCONTROL);
    "G:VclComCtrls.pas"(5604,3):  CreateSubClass(Params, STATUSCLASSNAME);
    "G:VclComCtrls.pas"(6268,3):  CreateSubClass(Params, WC_HEADER);
    "G:VclComCtrls.pas"(8410,3):  CreateSubClass(Params, WC_TREEVIEW);
    "G:VclComCtrls.pas"(10039,3):  CreateSubClass(Params, TRACKBAR_CLASS);
    "G:VclComCtrls.pas"(10376,3):  CreateSubClass(Params, PROGRESS_CLASS);
    "G:VclComCtrls.pas"(11856,3):  CreateSubClass(Params, UPDOWN_CLASS);
    "G:VclComCtrls.pas"(12181,3):  CreateSubClass(Params, HOTKEYCLASS);
    "G:VclComCtrls.pas"(13593,3):  CreateSubClass(Params, WC_LISTVIEW);
    "G:VclComCtrls.pas"(15775,3):  CreateSubClass(Params, ANIMATE_CLASS);
    "G:VclComCtrls.pas"(16837,3):  CreateSubClass(Params, TOOLBARCLASSNAME);
    "G:VclComCtrls.pas"(19840,3):  CreateSubClass(Params, REBARCLASSNAME);
    "G:VclComCtrls.pas"(21313,3):  CreateSubClass(Params, MONTHCAL_CLASS);
    "G:VclComCtrls.pas"(21421,3):  CreateSubClass(Params, DATETIMEPICK_CLASS);
    "G:VclComCtrls.pas"(21691,3):  CreateSubClass(Params, WC_PAGESCROLLER);
    "G:VclComCtrls.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;
  • 相关阅读:
    浅谈前端的CSS
    浅谈前端的HTML
    python操作mysql
    简单的sql题目和解答
    子查询&视图&事务
    测试程序运行的时间
    API接口简单的写法
    数据库数据进行量化算法入库
    正则爬取二手房数据
    接口加密和破解
  • 原文地址:https://www.cnblogs.com/findumars/p/5223943.html
Copyright © 2020-2023  润新知