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.
