第一次写控件，不怕丑，帖出来 ( 积分: 100 )

{放置于MDI主窗体，用于管理MDI子窗体，功能简单}
{刚写的，没怎么测，应该是没bug了吧，呵呵}
{欢迎批评，建议}
unit bethMDIManager;

interface

uses
Windows, Messages, SysUtils, Classes, ExtCtrls, Forms, Graphics, Controls;

const
SPL_WIDTH = 5; //splitter width
type
TBethBorderWidth = 1..10;
TMDIManager = class(TComponent)
private
{ Private declarations }
FButtonList: TList;
FFormList: TList;
FExceptList: TList;
FPanel: TPanel;
FAutoChange: boolean;
FHide: boolean;
FCanHide: boolean;
FCanSize: boolean;
FButtonHeight: integer;
FBorderWidth: TBethBorderWidth;
FColor: TColor;
FButtonFocusedColor: TColor;
FButtonColor: TColor;
FWidth: integer;
FHideColor: TColor;
FMoveing: boolean; //改变尺寸状态
FOnChange: TNotifyEvent;
function GetForm(Index: integer): TForm;
function GetFormCount: integer;
procedure DoAssign(AObject, ASource: TList); //将源列表(赋值)给目标列表
procedure SetAutoChange(const Value: boolean);
procedure SetBorderWidth(const Value: TBethBorderWidth);
procedure SetButtonColor(const Value: TColor);
procedure SetButtonHeigh(const Value: integer);
procedure SetCanHide(const Value: boolean);
procedure SetColor(const Value: TColor);
procedure SetFocusedColor(const Value: TColor);
procedure SetHide(const Value: boolean);
procedure SetWidth(const Value: integer);
procedure SetHideColor(const Value: TColor);
protected
{ Protected declarations }
procedure DoFormChange(Sender: TObject); //MDI窗体改变
procedure DoButtonClick(Sender: TObject); //按钮点击，激活相应MDI窗体
procedure DoButtonMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure DoButtonMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure DoClick(Sender: TObject); //面板点击，隐藏面板
procedure Refresh; //刷新
procedure DoResize(Sender: TObject); //面板尺寸改变
procedure DoMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure DoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure DoMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer); //改变面板尺寸
property FormCount: integer read GetFormCount; //取MDI子窗体的数量
property Form[Index: integer]: TForm read GetForm; //取MDI子窗体
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Change;
property ExceptList: TList read FExceptList write FExceptList; //例外列表，处于例外列表的将不显示
published
{ Published declarations }
Property AutoChange: boolean read FAutoChange write SetAutoChange default true; //自动更新，选择False的话，要通过Change事件进行编程
property Width: integer read FWidth write SetWidth default 150; //面板宽度
property Color: TColor read FColor write SetColor default clBtnFace; //面板颜色
property HideColor: TColor read FHideColor write SetHideColor default clRed; //面板隐藏状态的颜色
property Hide: boolean read FHide write SetHide default false; //隐藏状态
property CanHide: boolean read FCanHide write SetCanHide default true; //允许隐藏
property CanSize: boolean read FCanSize write FCanSize default true; //允许改变面板尺寸
property BorderWidth: TBethBorderWidth read FBorderWidth write SetBorderWidth default 2; //按钮跟面板边距
property ButtonHeight: integer read FButtonHeight write SetButtonHeigh default 32; //按钮高度
property ButtonColor: TColor read FButtonColor write SetButtonColor default clBtnFace; //按钮颜色
property ButtonFocusedColor: TColor read FButtonFocusedColor write SetFocusedColor default clGray; //按钮焦点颜色
property OnChange: TNotifyEvent read FOnChange write FOnChange;
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('Beth', [TMDIManager]);
end;

{ TMDIManager }

procedure TMDIManager.Change;
begin
DoFormChange(Screen);
end;

constructor TMDIManager.Create(AOwner: TComponent);
begin
inherited;
FPanel := TPanel.Create(Self);
FPanel.Parent := TWinControl(AOwner);
FPanel.Align := alRight;
FPanel.OnResize := DoResize;
FPanel.OnClick := DoClick;
FPanel.OnMouseDown := DoMouseDown;
FPanel.OnMouseMove := DoMouseMove;
FPanel.OnMouseUp := DoMouseUp;
FButtonList := TList.Create;
FFormList := TList.Create;
FExceptList := TList.Create;

AutoChange := true;
Hide := false;
CanHide := true;
CanSize := true;
ButtonHeight := 32;
BorderWidth := 2;
Color := clBtnFace;
HideColor := clRed;
ButtonFocusedColor := clGray;
ButtonColor := clBtnFace;
Width := 150;
end;

destructor TMDIManager.Destroy;
begin
Screen.OnActiveFormChange := nil;
FExceptList.Free;
FFormList.Free;
FButtonList.Free;
inherited;
end;

procedure TMDIManager.DoAssign(AObject, ASource: TList);
var
I: integer;
begin
for I := AObject.Count - 1 downto 0 do
if ASource.Remove(AObject) = -1 then AObject.Delete(I);
for I := 0 to ASource.Count - 1 do
AObject.Add(ASource.Items);
end;

procedure TMDIManager.DoButtonClick(Sender: TObject);
var
nIndex: integer;
begin
nIndex := FButtonList.IndexOf(Sender);
TForm(FFormList.Items[nIndex]).Show;
end;

procedure TMDIManager.DoButtonMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
TPanel(Sender).BevelOuter := bvLowered;
end;

procedure TMDIManager.DoButtonMouseUp(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
nNew, nOld: integer;
begin
TPanel(Sender).BevelOuter := bvRaised;
nOld := FButtonList.IndexOf(Sender);
nNew := (Y + TPanel(Sender).Top - BorderWidth) div ButtonHeight;
if nNew < 0 then nNew := 0;
if nNew > FButtonList.Count - 1 then nNew := FButtonList.Count - 1;
if nNew = nOld then Exit;
FFormList.Move(nOld, nNew);
Refresh;
end;

procedure TMDIManager.DoResize(Sender: TObject);
begin
Width := FPanel.Width;
end;

procedure TMDIManager.DoClick(Sender: TObject);
begin
if not FMoveing and CanHide then Hide := not Hide;
end;

procedure TMDIManager.DoFormChange(Sender: TObject);
var
lstForm: TList;
I: integer;
begin
//获取窗体列表
lstForm := TList.Create;
for I := 0 to FormCount - 1 do
lstForm.Add(Form);
//比对
DoAssign(FFormList, lstForm);
lstForm.Free;
//同步按钮列表跟窗体列表
if FButtonList.Count > FFormList.Count then
for I := FButtonList.Count - 1 downto FFormList.Count do
begin
TPanel(FButtonList.Items).Free;
FButtonList.Delete(I);
end
else
for I := FButtonList.Count to FFormList.Count - 1 do
with TPanel(FButtonList.Items[FButtonList.Add(TPanel.Create(FPanel))]) do
begin
Parent := FPanel;
Top := Self.BorderWidth + I * ButtonHeight;
Left := Self.BorderWidth;
Height := ButtonHeight;
Width := FPanel.Width - Self.BorderWidth shl 1;
Color := ButtonColor;
OnClick := DoButtonClick;
OnMouseUp := DoButtonMouseUp;
OnMouseDown := DoButtonMouseDown;
end;
Refresh;
if Assigned(FOnChange) then FOnChange(Self);
end;

procedure TMDIManager.DoMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
FMoveing := (X < SPL_WIDTH) and CanSize and not Hide;
end;

procedure TMDIManager.DoMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
with TPanel(Sender) do
if (X < SPL_WIDTH) and CanSize and not Self.Hide then Cursor := crHSplit
else Cursor := crDefault;
end;

procedure TMDIManager.DoMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if FMoveing then
begin
Width := Width - X;
FMoveing := False;
end;
end;

function TMDIManager.GetForm(Index: integer): TForm;
var
J: Integer;
begin
if csDesigning in ComponentState then
begin
Result := nil;
Exit;
end;
if(TForm(Owner).FormStyle = fsMDIForm) and (TForm(Owner).ClientHandle <> 0) then
for J := 0 to Screen.FormCount - 1 do
begin
Result := Screen.Forms[J];
if (Result.FormStyle = fsMDIChild)
and (FExceptList.IndexOf(Result) = -1)
and not(csDestroying in Result.ComponentState)then
begin
Dec(Index);
if Index < 0 then Exit;
end;
end;
Result := nil;
end;

function TMDIManager.GetFormCount: integer;
var
I: Integer;
begin
Result := 0;
if csDesigning in ComponentState then Exit;
if(TForm(Owner).FormStyle = fsMDIForm) and (TForm(Owner).ClientHandle <> 0) then
for I := 0 to Screen.FormCount - 1 do
if (Screen.Forms.FormStyle = fsMDIChild)
and (FExceptList.IndexOf(Screen.Forms) = -1)
and not(csDestroying in Screen.Forms.ComponentState)then
Inc(Result);
end;

procedure TMDIManager.Refresh;
var
I: integer;
frmItem: TForm;
btnItem: TPanel;
begin
for I := 0 to FButtonList.Count - 1 do
begin
frmItem := TForm(FFormList.Items);
btnItem := TPanel(FButtonList.Items);
btnItem.Caption := frmItem.Caption;
if (Screen.ActiveForm = frmItem) or (Screen.Forms[0] = frmItem) then
btnItem.Color := ButtonFocusedColor
else
btnItem.Color := ButtonColor;
end;
end;

procedure TMDIManager.SetAutoChange(const Value: boolean);
begin
FAutoChange := Value;
if Value then Screen.OnActiveFormChange := DoFormChange
else Screen.OnActiveFormChange := nil;
end;

procedure TMDIManager.SetBorderWidth(const Value: TBethBorderWidth);
var
I: integer;
begin
FBorderWidth := Value;
if Hide then Width := Value Shl 1;
for I := 0 to FButtonList.Count - 1 do
with TPanel(FButtonList.Items) do
begin
Top := Value + I * ButtonHeight;
Left := Value;
Width := Width - Value shl 1;
end;
end;

procedure TMDIManager.SetButtonColor(const Value: TColor);
begin
FButtonColor := Value;
Refresh;
end;

procedure TMDIManager.SetButtonHeigh(const Value: integer);
var
I: integer;
begin
FButtonHeight := Value;
for I := 0 to FButtonList.Count - 1 do
with TPanel(FButtonList.Items) do
begin
Top := Self.BorderWidth + I * Value;
Height := Value
end;
end;

procedure TMDIManager.SetCanHide(const Value: boolean);
begin
FCanHide := Value;
if Hide then Hide := false;
end;

procedure TMDIManager.SetColor(const Value: TColor);
begin
FColor := Value;
if not Hide then FPanel.Color := Value;
end;

procedure TMDIManager.SetFocusedColor(const Value: TColor);
begin
FButtonFocusedColor := Value;
Refresh;
end;

procedure TMDIManager.SetHide(const Value: boolean);
var
I: integer;
begin
if FHide = Value then Exit;
FHide := Value;
if Value then
begin
FPanel.Color := HideColor;
FPanel.Width := BorderWidth shl 1;
for I := 0 to FButtonList.Count - 1 do
TPanel(FButtonList.Items).Width := 0;
end
else
begin
FPanel.Color := Color;
FPanel.Width := Width;
for I := 0 to FButtonList.Count - 1 do
TPanel(FButtonList.Items).Width := Width - BorderWidth shl 1;
end;
end;

procedure TMDIManager.SetHideColor(const Value: TColor);
begin
FHideColor := Value;
if Hide then FPanel.Color := Value;
end;

procedure TMDIManager.SetWidth(const Value: integer);
var
I: integer;
begin
if FPanel.Width = Value then Exit;
if csDestroying in ComponentState then Exit;
FWidth := Value;
FPanel.Width := Value;
for I := 0 to FButtonList.Count - 1 do
TPanel(FButtonList.Items).Width := Width - BorderWidth shl 1;
end;

end.

谢谢

路过...收藏...怎么不写笔记?

什么好东西，先看看．．．谢了

不错，收藏起来。

来接分了

不错,收藏

多人接受答案了。