panel1.pas

很不错的活动工具窗口控件代码

unit SuperPanel;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls,StdCtrls,Buttons;

type
  TFettle = (SFOpen,SFClose);

  TSuperPanel = class(TCustomPanel)
  private
    { Private declarations }
    FImage:TImage;
    FLabel:TLabel;
    FButton1:TSpeedButton;
    FButton2:TSpeedButton;
    FBeginColor:TColor;
    FEndColor:TColor;
    FCaption:string;
    FOldHeight:Integer;
    FFettle : TFettle;
    procedure SetCaption(Value:string);
    procedure SetBeginColor(value:TColor);
    procedure SetEndColor(Value:TColor);
    procedure ImageMouseDown(Sender:TObject; Button: TMouseButton; Shift: TShiftState;X, Y: Integer);
    procedure DrawImage;
    procedure SelfHide(Sender: TObject);
    procedure Button2Click(Sender:TObject);

  protected
    { Protected declarations }
    procedure Resize;override;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    { Published declarations }
    property BeginColor:TColor read FBeginColor write SetBeginColor default clBlue;
    property EndColor:TColor read FEndColor write SetEndColor default clBlue;
    property DragCursor;
    property DragMode;
    property Enabled;
    property Caption : string read FCaption write SetCaption;
    property Ctl3D;
    property Font;
    property Locked;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnResize;
    property OnStartDrag;
    property Width;
    property Height;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('OtherVCL', [TSuperPanel]);
end;

procedure Draw(Canvas:TCanvas;Rect:TRect;BeginColor,EndColor:TColor);
var
        fr,fg,fb,dr,dg,db ,cr,cg,cb:Integer;
        frect:TRect;
        i:Integer;
begin
        fr := (BeginColor and $000000FF);
	fg := ((BeginColor shr 8) and $000000ff);
	fb := ((BeginColor shr 16) and $000000ff);
	dr := ((EndColor and $000000ff) - fr);
	dg := (((EndColor shr 8) and $000000ff) - fg);
	db := (((EndColor shr 16) and $000000ff) - fb);
        frect.Top :=Rect.Top;
        frect.Bottom :=Rect.Bottom ;
        for i:=0 to 255 do
          begin
            frect.Left := (Rect.Left+i*(Rect.Right - Rect.Left)div 255) ;
            frect.Right := Rect.Left+(i+1)*(Rect.Right - Rect.Left)div 255 ;
            cr := (fr+i*dr div 255) ;
            cg := (fg+i*dg div 255) ;
            cb := (fb+i*db div 255) ;
            Canvas.Brush.Color := TColor(RGB(cr,cg,cb)) ;
            Canvas.FillRect(frect) ;
          end;
end;

//-----------------------------------------------------------------------
constructor TSuperPanel.Create(AOwner: TComponent);
var
        b:TBitmap;
begin
        inherited;
        FImage:=TImage.Create(self);
        FLabel:=TLabel.Create(self);
        FImage.Parent:=self;
        FLabel.parent:=self;
        FImage.OnMouseDown:=ImageMouseDown;
        FImage.OnDblClick:=Button2Click;
        FImage.Align:=alTop;
        FImage.Top:=1;
        FImage.Left:=1;
        FImage.Height:=18;
        FBeginColor:=clBlack;
        FEndColor:=clBlue;
        FCaption:=Name;
        FLabel.Top:=3;
        FLabel.Left:=3;
        FLabel.Caption:=FCaption;
        FLabel.Show;
        FLabel.Transparent:=true;
        FLabel.Font.Color:=clWhite;
        FLabel.Font.Size:=9;
        FLabel.Font.Name:='宋体';
        FLabel.Font.Style:=FLabel.Font.Style + [fsBold];
        FLabel.OnMouseDown:=ImageMouseDown;

        b:=TBitmap.Create;
        b.Width:=10;
        b.Height:=10;
        b.Canvas.Pen.Width:=1;
        b.Canvas.Pen.Color:=clBlack;
        b.Canvas.MoveTo(1,1);
        b.Canvas.LineTo(9,9);
        b.Canvas.MoveTo(8,1);
        b.canvas.LineTo(0,9);
        b.Canvas.MoveTo(2,1);
        b.Canvas.LineTo(9,8);
        b.Canvas.MoveTo(1,2);
        b.Canvas.LineTo(8,9);
        b.Canvas.MoveTo(7,1);
        b.Canvas.LineTo(0,8);
        b.Canvas.MoveTo(8,2);
        b.Canvas.LineTo(1,9);

        FButton1:=TSpeedButton.Create(self);
        Fbutton1.Width:=12;
        FButton1.Height:=12;
        FButton1.Top:=4;
        FButton1.Parent:=self;
        FButton1.Flat:=true;
        FButton1.Transparent:=false;
        FButton1.Glyph.Assign(b);
        FButton1.Show;
        FButton1.OnClick:=SelfHide;

        FButton2:=TSpeedButton.Create(self);
        Fbutton2.Width:=12;
        FButton2.Height:=12;
        FButton2.Top:=4;
        FButton2.Parent:=self;
        FButton2.Flat:=true;
        FButton2.Transparent:=false;
        FButton2.Font.Name:='Webdings';
        FButton2.Caption:='5';
        FButton2.Show;
        FButton2.OnClick:=Button2Click;

        FFettle:=SFOpen;
        FOldHeight:=Height;
        DrawImage;
        b.Free;
end;

destructor TSuperPanel.Destroy;
begin
        FImage.Free;
        FLabel.Free;
        FButton1.Free;
        FButton2.Free;
        inherited;
end;

procedure TSuperPanel.ImageMouseDown(Sender:TObject; Button: TMouseButton; Shift: TShiftState;X, Y: Integer);
begin
        if Button = mbLeft then
          begin
            ReleaseCapture;
            Perform(WM_SYSCOMMAND, $F012, 0);
          end;
end;

procedure TSuperPanel.DrawImage;
var
        bmp:TBitmap;
begin
        bmp:=TBitmap.Create;
        bmp.Width:=FImage.Width;
        bmp.Height:=FImage.Height;
        Draw(bmp.Canvas,Rect(0,0,bmp.Width,bmp.Height),FBeginColor,FEndColor);
        FImage.Picture.Bitmap.Assign(bmp);
        bmp.Free;
end;


procedure TSuperPanel.Resize;
begin
        inherited Resize;
        DrawImage;
        FButton1.Left:=FImage.Width-12-2;
        FButton2.Left:=FImage.Width-12-4-12;
end;

procedure TSuperPanel.SetCaption(Value:string);
begin
        FCaption:=Value;
        FLabel.Caption:=Value;
end;

procedure TSuperPanel.SelfHide(Sender: TObject);
begin
        Self.Hide;
end;

procedure TSuperPanel.Button2Click(Sender:TObject);
begin
        if FFettle=SFOpen then
          begin
            FFettle:=SFClose;
            FButton2.Caption:='6';
            FOldHeight:=Height;
            Height:=FImage.Height+2;
          end
        else
          begin
            FFettle:=SFOpen;
            FButton2.Caption:='5';
            Height:=FOldHeight;
          end;
end;

procedure TSuperPanel.SetBeginColor(value:TColor);
begin
        FBeginColor:=Value;
        DrawImage;
end;

procedure TSuperPanel.SetEndColor(value:TColor);
begin
        FEndColor:=value;
        DrawImage;
end;

end.