object TabControl: TComponentPaleAppBuildertteTabControl

Left = 0

Top = 0

Width = 64

Height = 47

Align = alClient

Constraints.MinWidth = 20

HotTrack = True

PopupMenu = PaletteMenu

TabOrder = 0

TabStop = False

OnChange = TabControlChange

OnDragDrop = TabControlDragDrop

OnDragOver = TabControlDragOver

OnEndDrag = TabControlEndDrag

OnMouseDown = TabControlMouseDown

OnMouseMove = TabControlMouseMove

OnStartDrag = TabControlStartDrag

BorderStyle = bsNone

OnHelpRequest = ComponentPaletteHelpRequest

object PageScroller1: TPageScroller

Left = 32

Top = 6

Width = 31

Height = 39

Align = alClient

AutoScroll = True

TabOrder = 0

OnScroll = PageScroller1Scroll

end

object Panel2: TPanel

Left = 4

Top = 6

Width = 28

Height = 39

Align = alLeft

BevelOuter = bvNone

TabOrder = 1

object SelectorButton: TSpeedButton

Left = 0

Top = 0

Width = 28

Height = 28

GroupIndex = 1

Down = True

Flat = True

end

end

end

end

function GetIdeMainForm: TCustomForm;

begin

Result := TForm(Application.FindComponent(AppBuilder));

end;

Tìm điều khiển TAB Component Palette

Để tìm được điều khiển TAB này, bạn hãy dùng đoạn mã sau:

function GetTabControl : TTabControl;

var

MainForm : TCustomForm;

begin

Result := nil;

MainForm := GetIdeMainForm;

if MainForm <> nil then

Result := TTabControl(MainForm.FindComponent(TabControl))

end;

function GetComponentPalettePopupMenu : TPopupMenu;

var

MainForm : TCustomForm;

begin

Result := nil;

MainForm := GetIdeMainForm;

if MainForm <> nil then

Result := TPopupMenu(MainForm.FindComponent(PaletteMenu));

end;

<?xml version="1.0" encoding="UTF-8" standalone="yes"?>

<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">

<assemblyIdentity

name="NQA.XP.Theme"

processorArchitecture="x86"

version="1.0.10.8"

type="win32"/>

<description>Ngo Quoc Anh</description>

<dependency>

<dependentAssembly>

<assemblyIdentity

type="win32"

name="Microsoft.Windows.Common-Controls"

vers ion="6.0.0.0"

processorArchitecture="x86"

publicKeyToken="6595b64144ccf1df"

language="*"

/>

</dependentAssembly>

</dependency>

</assembly>

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(\Software\Ngo 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(\Software\Ngo 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.