Lập trình thay đổi Component Palette của Delphi IDE

unit IdeEnhancement;

interface

uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, ExtCtrls,
   Forms, Dialogs, ComCtrls, Menus, Registry;

type
  TMyExpertObject = class(TComponent)
  private 
    App : TCustomForm; 
    TabControl: TTabControl; 
    MultiLine : Boolean; 
    ComponentPaletteMenu : TPopupMenu; 

    //Hai mục chọn cho menu popup mà ta thêm vào 

    MultiLineItem, SeperatorItem : TMenuItem; 
    procedure UpdateOtherWindows(OldHeight: Integer); 
    procedure ResizeMultiLineComponentPalette(Sender : TObject); 
    function GetIdeMainForm: TCustomForm; 
    function GetTabControl: TTabControl; 
    function GetComponentPalettePopupMenu: TPopupMenu; 
    procedure OnMenuPopup(Sender: TObject); 
    procedure OnMultiLineItemClick(Sender : TObject); 
    procedure SetMultiLineComponentPalette(_multiLine : Boolean); 
    procedure CreateMenuItem(_multiLine : Boolean); 
    procedure DestroyMenuItem; 
    procedure SaveSettings; 
  public 
    constructor Create(AOwner: TComponent); override; 
    destructor Destroy; override; 
  end;
var 
  MyExpertObject : TMyExpertObject;

implementation

{Đây là phương thức sẽ được Delphi gọi mỗi khi component được nạp. Chúng ta cần gọi phương thức này để đọc thuộc tính MultiLines trong Registry}

constructor TMyExpertObject.Create;
begin 
  inherited; 
  with TRegistry.Create do 
    begin 
      RootKey := HKEY_CURRENT_USER; 
      if OpenKey(SoftwareNgo Quoc Anh, False) then 
        if KeyExists(MultiLines) then 
          MultiLine := ReadBool(MultiLines); 
    end; 
end;

{Đây là phương thức sẽ được Delphi gọi mỗi khi component giải phóng}

destructor TMyExpertObject.Destroy;
begin 
  inherited;
end;

{Ghi lại thông tin về MultiLines trong Registry mỗi khi có sự thay đổi}
procedure TMyExpertObject.SaveSettings;
begin 
  with TRegistry.Create do 
    begin 
      RootKey := HKEY_CURRENT_USER; 
      if OpenKey(SoftwareNgo Quoc Anh, True) then 
        WriteBool(MultiLines, MultiLine) 
    end;
end;

{Tính toán lại kích thước của điều khiển TAB mỗi khi có sự thay đổi}
procedure TMyExpertObject.ResizeMultiLineComponentPalette(Sender: TObject);
var 
  AHeight : Integer;
begin 
  with Sender as TTabControl do 
    begin 
      AHeight := Height - ( DisplayRect.Bottom - DisplayRect.Top ) + 29; 
      Constraints.MinHeight := AHeight; 
      ((Sender as TTabControl).Parent as TWinControl).Constraints.MaxHeight := AHeight; 
    end;
end;

{Điều chỉnh lại vị trí của 2 cửa sổ TObjectTreeView và TEditWindow mỗi khi thay đổi kích thước của FORM chính}
procedure TMyExpertObject.UpdateOtherWindows(OldHeight: Integer);
const 
  WinClasses : array[0..1] of string = (TObjectTreeView, TEditWindow);
var 
  AForm : TCustomForm; 
  I, J, MainTop, HeightDelta : Integer;
begin 
  AForm := GetIdeMainForm; 
  if AForm = nil then Exit; 
    HeightDelta := AForm.Height - OldHeight; 
  if HeightDelta = 0 then Exit; 
    MainTop := AForm.Top; 
  for I := Low(WinClasses) to High(WinClasses) do 
    begin 

    //Duyệt qua tất cả các cửa sổ 

      for J := 0 to Screen.CustomFormCount - 1 do 
        begin 

        //Nếu tìm được thì tiến hành thay đổi kích thước 

          if Screen.CustomForms[J].ClassNameIs(WinClasses[I]) then 
            begin 
              AForm := Screen.CustomForms[J]; 
              AForm.Top := AForm.Top + HeightDelta; 
              AForm.Height := AForm.Height - HeightDelta; 
            end; 
        end; 
    end;
end;

{Tìm cửa sổ chính của Delphi}

function TMyExpertObject.GetIdeMainForm: TCustomForm;
begin 
  Result := TForm(Application.FindComponent(AppBuilder));
end;

{Tìm điều khiển TAB Component Palette}
function TMyExpertObject.GetTabControl : TTabControl;
var 
  MainForm : TCustomForm;
begin 
  Result := nil; 
  MainForm := GetIdeMainForm; 
  if MainForm <> nil then 
    Result := TTabControl(MainForm.FindComponent(TabControl))
end;

{Tìm menu popup cho điều khiển TAB Component Palette}

function TMyExpertObject.GetComponentPalettePopupMenu : TPopupMenu;
var 
  MainForm : TCustomForm;
begin 
  Result := nil; 
  MainForm := GetIdeMainForm; 
  if MainForm <> nil then 
    Result := TPopupMenu(MainForm.FindComponent(PaletteMenu));
end;

{Cài đặt cho phương thức popup của menu popup của điều khiển TAB. Chúng tôi không đề xuất mã lệnh nào cho sự kiện này. Điều này phụ thuộc vào ý chủ quan của bạn}

procedure TMyExpertObject.OnMenuPopup(Sender: TObject);
begin
end;

{Cài đặt cho sự kiện OnClick của mục chọn mới trong menu popup của TAB}

procedure TMyExpertObject.OnMultiLineItemClick(Sender: TObject);
begin 
  if Sender is TMenuItem then 
    begin 
      MultiLine := not (Sender as TMenuItem).Checked; 

      //Thay đổi trạng thái Checked của mục chọn 

      (Sender as TMenuItem).Checked := MultiLine; 

      //Thiết lập và ghi lại trạng thái vào Registry 

      SetMultiLineComponentPalette(MultiLine); 
      SaveSettings; 
    end;
end;

{Thêm mục chọn cho menu popup của điều khiển TAB Component Palette}

procedure TMyExpertObject.CreateMenuItem(_multiLine : Boolean);
begin 
  ComponentPaletteMenu := TPopupMenu.Create(nil); 
  ComponentPaletteMenu.OnPopup := OnMenuPopup; 
  ComponentPaletteMenu := GetComponentPalettePopupMenu; 

  //Kiểm tra sự tồn tại của mục chọn trước, nếu chưa tồn tại thì tạo mới 

  if ComponentPaletteMenu.Items.Find(&Multi-Lines) = nil then 
    begin 
      SeperatorItem := TMenuItem.Create(nil); 
      SeperatorItem.Caption := -; 

      //Thêm thanh phân cách 

      ComponentPaletteMenu.Items.Add(SeperatorItem); 

      MultiLineItem := TMenuItem.Create(nil); 
      MultiLineItem.Checked := _multiLine; 
      MultiLineItem.OnClick := OnMultiLineItemClick; 
      MultiLineItem.Caption := &Multi-Lines; 

      //Thêm mục chọn với tên Multi-Lines 

      ComponentPaletteMenu.Items.Add(MultiLineItem); 
    end;
end;

{Xoá mục chọn của menu popup mỗi khi Component được giải phóng}

procedure TMyExpertObject.DestroyMenuItem;
var 
  MI : TMenuItem; 
  Pos : Integer;
begin 
  MI := ComponentPaletteMenu.Items.Find(&Multi-Lines); 
  if MI <> nil then 
    begin 
      Pos := ComponentPaletteMenu.Items.IndexOf(MI); 
      ComponentPaletteMenu.Items.Delete(Pos - 1); 
      ComponentPaletteMenu.Items.Delete(Pos - 1); 
    end;
end;

{Thiết lập thuộc tính Multi-Lines}
procedure TMyExpertObject.SetMultiLineComponentPalette(_multiLine : Boolean);
var 
  OldHeight : Integer;
begin 
  App := GetIdeMainForm; 
  if App <> nil then 
    begin 
      OldHeight := App.Height; 
      TabControl := GetTabControl; 
      if TabControl <> nil then 
        begin 
          TabControl.MultiLine := _multiLine; 
          if _multiLine then 
            begin 
              TabControl.OnResize := ResizeMultiLineComponentPalette; 
              TabControl.OnResize(TabControl); 
              CreateMenuItem(_multiLine); 
            end 
          else 
            TabControl.OnResize := nil; 
            UpdateOtherWindows(OldHeight); 
        end; 
      App.Invalidate; 
    end;
end;

{Lời gọi mỗi khi Component được nạp}
initialization 

MyExpertObject := TMyExpertObject.Create(nil); 
MyExpertObject.CreateMenuItem(MyExpertObject.MultiLine); 
MyExpertObject.SetMultiLineComponentPalette(MyExpertObject.MultiLine);

{Lời gọi mỗi khi Component bị huỷ}
finalization 

MyExpertObject.SetMultiLineComponentPalette(False); 
MyExpertObject.DestroyMenuItem; 
MyExpertObject.Free;

end.