unit UFriendGroup;
interface
uses
Windows,ExtCtrls,SysUtils, Classes, Controls,Forms,Graphics,Messages,StdCtrls;
type
TPanel=class(ExtCtrls.TPanel)
private
FOnMouseIn:TNotifyEvent;
FOnMouseOut:TNotifyEvent;
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
published
property OnMouseIn: TNotifyEvent read FOnMouseIn write FOnMouseIn;
property OnMouseOut: TNotifyEvent read FOnMouseOut write FOnMouseOut;
end;
type
TRGroupP=^TRGroup;
TRGroup=record
CPanel:Tpanel;
CImage:TImage;
CLabel:TLabel;
end;
type
TFriendGroup = class(TWinControl)
private
{ Private declarations }
ItemCount:integer;
MainScrollBox: TScrollBox;
LeftBordW,TopBordH,PicLeftBordW,PicTopBordH,ImgLeftBordW,ImgTopBordH:Integer;
OldPanel:TPanel;
OldWidth:integer;
OptionRecordList:TStringList;
FImagesValue:TImageList;
protected
{ Protected declarations }
procedure GruopPanMouseEnter(Sender: TObject);
procedure GruopPanMouseLeave(Sender: TObject);
procedure GruopPanClick(Sender: TObject);
procedure GruopPanMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure NewPanWidth;
procedure SetImagesValue(const Value: TImageList);
public
{ Public declarations }
ObjectList:TList;
function AddGroup(NameStr:string):Boolean;
function GetCaption(Cint:integer):string;
published
{ Published declarations }
constructor Create(Aowner:TComponent);override;
destructor Destroy;override;
property Images:TImageList read FImagesValue write SetImagesValue;
end;
const
SorButtonWidth=15; // 滚动条宽
procedure Register;
implementation
var
CPanlObj:TRGroupP;
procedure Register;
begin
RegisterComponents('Samples', [TFriendGroup]);
end;
{ TFriendGroup }
function TFriendGroup.AddGroup(NameStr: string): Boolean;
var
GroupPan:TPanel;
GroupLab:TLabel;
GroupImage:TImage;
TempRang:Single;
bmp:TBitmap;
RecL:trect;
Cint,Cint2:integer;
fhr :Thandle;
CGroug:TRGroupP;
begin
// MainScrollBox.Width:=self.Width;
if ItemCount*22+22>MainScrollBox.Height then
NewPanWidth;
GroupPan:=TPanel.Create(MainScrollBox);
with GroupPan do
begin
Parent:=self.MainScrollBox;
Tag:=ItemCount;
if ItemCount*22<=MainScrollBox.Height then
width:=self.MainScrollBox.Width-2*PicLeftBordW
else
width:=self.MainScrollBox.Width-2*PicLeftBordW-SorButtonWidth;
Left:=PicLeftBordW;
Height:=22;//+2*PicTopBordH;
if ItemCount=0 then
top:=PicTopBordH
else
top:=ItemCount*22;//(Height+PicTopBordH)+PicTopBordH;
BevelOuter:=bvNone;
Color:=self.MainScrollBox.Color;//;
// OnClick:=GruopPanClick;
OnMouseDown:=GruopPanMouseDown;
// OnMouseIn:=GruopPanMouseEnter;
// FOnMouseOut:=GruopPanMouseLeave;
end;
fhr:=createroundrectrgn(0,0,GroupPan.width,GroupPan.height,4,4);
setwindowrgn(GroupPan.handle,fhr,true);
GroupImage:=Timage.Create(GroupPan);
with GroupImage do
begin
Parent:=GroupPan;
width:=11;
Left:=GroupPan.Left+5;
Height:=11;
top:=5;
OnMouseDown:=GroupPan.OnMouseDown;
Center:=true;
Transparent:=true;
FImagesValue.GetBitmap(0,Picture.Bitmap);
// OnMouseIn:=GruopPanMouseEnter;
// FOnMouseOut:=GruopPanMouseLeave;
end;
GroupLab:=TLabel.Create(GroupPan);
with GroupLab do
begin
autosize:=false;
Parent:=GroupPan;
width:=200;
Left:=GroupPan.Left+5+20;
Height:=13;
top:=4;
Caption:=NameStr+inttostr(GroupPan.Tag);
Font.Style:=[fsBold];
OnMouseDown:=GroupPan.OnMouseDown;
Transparent:=true;
// OnMouseIn:=GruopPanMouseEnter;
// FOnMouseOut:=GruopPanMouseLeave;
end;
CGroug:=new(TRGroupP);
CGroug^.CPanel:=GroupPan;
CGroug^.CImage:=GroupImage;
CGroug^.CLabel:=GroupLab;
OptionRecordList.AddObject(GroupLab.Caption,@CGroug^);
OldWidth:=MainScrollBox.Width;
inc(ItemCount);
Result:=True;
end;
constructor TFriendGroup.Create(Aowner: TComponent);
begin
inherited;
Width:=250;
Height:=100;
MainScrollBox:=TScrollBox.Create(Self);
with MainScrollBox do
begin
Align:=alclient;
Parent:=Self;
Left:=0;
Top:=0;
Name:='MainScrollbox';
HorzScrollBar.Visible:=False;
Color:=clWhite;
BorderStyle:=BsNone;
//OnClick:=PanelClick;
//OnMouseWheelDown:=SorBoxMouseWheelDown;
//OnMouseWheelUp:=SorBoxMouseWheelUp;
end;
OptionRecordList:=TStringList.Create;
ItemCount:=0;
{ LeftBordW:=6;
TopBordH:=6; }
PicLeftBordW:=2;
PicTopBordH:=0;
{ ImgLeftBordW:=3;
ImgTopBordH:=3;
PicHeight:=20;
FColumCount:=1;
OldSelPanel:=nil;
FSelColor:=clRed;
FNomarColor:=clMenuBar;
FFocusColor:=clYellow; }
end;
destructor TFriendGroup.Destroy;
var
i:integer;
begin
// if Assigned(OldSelPanel) then OldSelPanel.Free;
{ for i:=Low(RgroupArr) to HIGH(RgroupArr) do
begin
Dispose(RgroupArr[i]);
end; }
MainScrollBox.Free;
inherited;
end;
function TFriendGroup.GetCaption(Cint: integer): string;
begin
Result:=OptionRecordList[Cint];
end;
procedure TFriendGroup.GruopPanClick(Sender: TObject);
begin
end;
procedure TFriendGroup.GruopPanMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
i:integer;
begin
if Sender is TPanel then
begin
if Assigned(OldPanel) then
OldPanel.Color:=self.MainScrollBox.Color;
OldPanel:=TPanel(Sender);
TPanel(Sender).Color:=$00FDE3D0;
i:=TPanel(Sender).Tag;
end;
if Sender is TLabel then
begin
if Assigned(OldPanel) then
OldPanel.Color:=self.MainScrollBox.Color;
OldPanel:=TPanel(TLabel(Sender).Parent);
TPanel(TLabel(Sender).Parent).Color:=$00FDE3D0;
i:=TPanel(TLabel(Sender).Parent).Tag;
end;
if Sender is TImage then
begin
if Assigned(OldPanel) then
OldPanel.Color:=self.MainScrollBox.Color;
OldPanel:=TPanel(TImage(Sender).Parent);
TPanel(TImage(Sender).Parent).Color:=$00FDE3D0;
i:=TPanel(TImage(Sender).Parent).Tag;
end;
CPanlObj:=TRGroupP(OptionRecordList.Objects[i]);
CPanlObj.CImage.Picture.Graphic:=nil;
FImagesValue.GetBitmap(1,CPanlObj.CImage.Picture.Bitmap);
end;
procedure TFriendGroup.GruopPanMouseEnter(Sender: TObject);
begin
if Sender is TPanel then
TPanel(Sender).Color:=self.MainScrollBox.Color;
end;
procedure TFriendGroup.GruopPanMouseLeave(Sender: TObject);
begin
if Sender is TPanel then
TPanel(Sender).Color:=cllime;
end;
procedure TFriendGroup.NewPanWidth;
var
i:integer;
fhr :Thandle;
begin
for i:=0 to MainScrollBox.ControlCount-1 do
begin
if MainScrollBox.Controls[i] is TPanel then
begin
TPanel(MainScrollBox.Controls[i]).width:=MainScrollBox.Width-2*PicLeftBordW-SorButtonWidth;
fhr:=createroundrectrgn(0,0,TPanel(MainScrollBox.Controls[i]).width,TPanel(MainScrollBox.Controls[i]).height,4,4);
setwindowrgn(TPanel(MainScrollBox.Controls[i]).handle,fhr,true);
end
end;
end;
procedure TFriendGroup.SetImagesValue(const Value: TImageList);
begin
FImagesValue:=Value;
end;
{ TPanel }
procedure TPanel.CMMouseEnter(var Message: TMessage);
begin
inherited;
if Assigned(FOnMouseIn) then FOnMouseOut(Self);
end;
procedure TPanel.CMMouseLeave(var Message: TMessage);
begin
inherited;
if Assigned(FOnMouseIn) then FOnMouseIn(Self);
end;
end.