aaa

原创 2011年01月14日 17:42:00

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.

版权声明:本文为博主原创文章,未经博主允许不得转载。

相关文章推荐

FreeRadius AAA Radius 工作原理

常见的AAA service     Radius(Remote Authentication Dial-In User Service) 在 IETF 的 RFC 2865 中定义TACAC...

AAA

欢迎使用Markdown编辑器写博客本Markdown编辑器使用StackEdit修改而来,用它写博客,将会带来全新的体验哦: Markdown和扩展Markdown简洁的语法 代码块高亮 图片链接和...

aaa9999

\n\nsencha create jsb -a index.html -p app.jsb3\n\n\nFor applications built on top of a dynamic serv...

给定a和n,计算a+aa+aaa+a...a(n个a)的和(大数据处理)

题目描述: 给定a和n,计算a+aa+aaa+a...a(n个a)的和。 输入: 测试数据有多组,输入a,n(1 输出: 对于每组输入,请输出结果。 样...

AAA是Authentication(认证)配置

一、简介 AAA是Authentication(认证)Authorization授权 Account记帐的简称; 它们不是必须的也不是要同时一起使用的; 他们可以使用路由器设备本地数据库,也可以...

C算法-求s=a+aa+aaa+aaaa+aa...a的值

题目及程序:/** 11. 题目:求s=a+aa+aaa+aaaa+aa...a的值,其中a是一个数字。例如2+22+222+2222+22222(此时共有5个数相加),几个数相加有键盘控制。...

aaa

Android操作framebuffer 分类: Framebuffer Camera Video 2011-06-09 17:43 248人阅读 评论(0) 收藏 举报...

vc aaa

CString sPath; GetModuleFileName(NULL,sPath.GetBufferSetLength (MAX_PATH+1),MAX_PATH); sPath.Release...

AAA认证、授权、计费

AAA认证、授权、计费 AAA是验证、授权和记账(Authentication、Authorization、Accounting )三个英文单词的简称。其主要目的是管理哪些用户可以访问网络服务器,...

【华为实验】AAA本地认证和hwtacacs配置并存的情况总结

实验说明: 在工作中遇到这么个情况,客户想要配置华为路由器ssh本地认证,怎么配置都登录不上,最后通过dis aaa online-fail-record命令看到报错说tacacs认证拒绝(在模拟器上...
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:深度学习:神经网络中的前向传播和反向传播算法推导
举报原因:
原因补充:

(最多只允许输入30个字)