Delphi一共封裝（超類化）了8種Windows基礎控件和17種複雜控件

時間  2020-07-10
標籤 delphi 一共 封裝 類化 windows 基礎 控件 複雜 欄目 Delphi 简体版
原文   原文鏈接

超類化源碼：html

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基礎控件：ide

"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種基礎控件的代碼貼上來，混個臉熟，之後再加上註釋：spa

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的封裝代碼：code

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;
相關文章
相關標籤/搜索
每日一句
    每一个你不满意的现在，都有一个你没有努力的曾经。
本站公眾號
   歡迎關注本站公眾號,獲取更多信息
聯繫我們 最近搜索 最新文章 沪ICP备13005482号-10 MyBatis教程 SQL 教程 MySQL教程 Java 教程 Thymeleaf 教程 Hibernate教程 Spring教程 Redis教程