保存为MultiLinePaletteExpert.pas
unit MultiLinePaletteExpert;
interface
uses
Forms, Controls, ComCtrls;
implementation
type
TMultiLinePalette = class
public
procedure ResizeComponentPalette(Sender: TObject);
end;
var
MultiLinePalette: TMultiLinePalette;
procedure TMultiLinePalette.ResizeComponentPalette(Sender: TObject);
var
AHeight: integer;
begin
with (Sender as TTabControl) do
begin
AHeight := Height + DisplayRect.Top - DisplayRect.Bottom + 29;
Constraints.MinHeight := AHeight;
Parent.Constraints.MaxHeight := AHeight;
end;
end; {ResizeMultiLineComponentPalette}
procedure SetMultiLineComponentPalette(MultiLine: boolean);
var
AppBuilder: TForm;
TabControl: TTabControl;
begin
AppBuilder := TForm(Application.FindComponent('AppBuilder'));
if (AppBuilder <> nil) then
begin
TabControl := TTabControl(AppBuilder.FindComponent('TabControl'));
if (TabControl <> nil) then
begin
TabControl.MultiLine := MultiLine;
if MultiLine then
TabControl.OnResize := MultiLinePalette.ResizeComponentPalette
else
TabControl.OnResize := nil;
end;
end;
end; {SetMultiLineComponentPalette}
initialization
MultiLinePalette := TMultiLinePalette.Create;
SetMultiLineComponentPalette(true);
finalization
SetMultiLineComponentPalette(false);
MultiLinePalette.Free;
end.
保存为MultiLinePaletteExpert_D7.dpk
package MultiLinePaletteExpert_D7;
{$ALIGN 8}
{$ASSERTIONS ON}
{$BOOLEVAL OFF}
{$DEBUGINFO ON}
{$EXTENDEDSYNTAX ON}
{$IMPORTEDDATA ON}
{$IOCHECKS ON}
{$LOCALSYMBOLS ON}
{$LONGSTRINGS ON}
{$OPENSTRINGS ON}
{$OPTIMIZATION ON}
{$OVERFLOWCHECKS OFF}
{$RANGECHECKS OFF}
{$REFERENCEINFO ON}
{$SAFEDIVIDE OFF}
{$STACKFRAMES OFF}
{$TYPEDADDRESS OFF}
{$VARSTRINGCHECKS ON}
{$WRITEABLECONST OFF}
{$MINENUMSIZE 1}
{$IMAGEBASE $400000}
{$IMPLICITBUILD OFF}
requires
rtl,
vcl;
contains
MultiLinePaletteExpert in 'MultiLinePaletteExpert.pas';
end.
打开MultiLinePaletteExpert_D7.dpk编译安装即可
