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.

32位汇编语言学习笔记(33)--aaa指令

 aaa(ASCII adjust after addition)指令,是BCD指令集中的一个指令,用于在两个未打包的BCD值相加后,调整al和ah寄存器的内容。 BCD(Binary-cod...
  • swordmanwk
  • swordmanwk
  • 2015年01月08日 07:33
  • 1636

Cisco AAA 配置

Access Server通过Tacacs服务器实现安全认证:使用一台WINDOWS NT服务器作为Tacacs服务器,地址为10.111.4.2,运行Cisco2511随机带的Easy ACS 1....
  • achejq
  • achejq
  • 2011年02月16日 08:49
  • 2865

AAA服务器的配置

AAA服务器有两种方式;1是radius服务器,2、是终端访问控制器访问控制系统tacacs+ 1、radius的配置 aaa   new-model   启动 aaa  authenticat...
  • u010749410
  • u010749410
  • 2014年08月11日 10:58
  • 2320

安全之AAA服务器--路由器认证,授权,审计

需求: 1:client登入server 用AAA服务器进行认证 2:client登入server 用AAA服务器进行授权和命令授权 3:client登入server 用AAA服务器...
  • Galdys
  • Galdys
  • 2012年01月07日 22:55
  • 1812

jQuery中工具方法$.aaa()的源码分析

$.each(): 当只有两个参数时,callback回调函数的参数是i,obj[i],即callback(i,obj[i])              当有三个参数时,callback回调函数的参数...
  • Night_Emperor
  • Night_Emperor
  • 2017年08月24日 23:51
  • 174

$('div.aaa')是什么意思?

$('div.aaa')是什么意思? 是获取的所有div中class名字为aaa的div。
  • Ideality_hunter
  • Ideality_hunter
  • 2017年02月08日 14:15
  • 255

aaa认证配置

1. 原理  ------------待介绍 2. 配置拓扑 及描述  3 具体配置 AR2 : aaa   authentication-scheme default  authentica...
  • yiluyangguang1234
  • yiluyangguang1234
  • 2016年12月20日 23:37
  • 431

AAA云免费云主机推荐码

AAA云免费云主机推荐码(有效期:2017年05月06日): AAAYUN0005SC5HQRS66-20170506 免费云主机申请地址: http://www.aaayun.com/ ...
  • leng_jin_lin
  • leng_jin_lin
  • 2017年03月07日 09:28
  • 551

AAA认证、授权、计费

AAA是验证、授权和记账(Authentication、Authorization、Accounting )三个英文单词的简称。其主要目的是管理哪些用户可以访问网络服务器,具有访问权的用户可以得到哪些...
  • zskylark
  • zskylark
  • 2010年12月23日 12:30
  • 1868

AAA

AAAAAAAAA 
  • pj8063_empery
  • pj8063_empery
  • 2007年06月18日 12:59
  • 104
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:aaa
举报原因:
原因补充:

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