aaa

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.