大家帮帮我啊,怎么做一个小控件，急．．．在线等

Question

我想自己做一个控件,这个控件和Tpanel一样，只是向Tpanel里面多加了一个TImage,用TImage来在Tpanel上画一个背景，再写一个方法就是可以改变背景．即就是把Tpanel和TImage合在一起，我从来没做过一点头绪都没有．看你们是怎么写的．帮帮我．谢谢

Answer 1

记得里面一位老大写的 delphi高手突破里面就有类似的例子哦。。也不是太麻烦 就是自己要处理里面的部分消息 游戏是 WM_PAINT...就是要自己画图片。

Answer 2

我也要例子。呵呵。
[email protected]

Answer 3

unit IMGPanel;interfaceuses
  SysUtils, Classes, Controls, ExtCtrls, Graphics;type
  TIMGPanel = class(TCustomPanel)
  private
    FPicture: TPicture;
    procedure SetPicture(const Value: TPicture);
  protected
    procedure Paint;override;
  public
    property DockManager;
    constructor Create(AOwner:TComponent);override;
    destructor Destroy;override;  published
    property Align;
    property Alignment;
    property Anchors;
    property AutoSize;
    property BevelInner;
    property BevelOuter;
    property BevelWidth;
    property BiDiMode;
    property BorderWidth;
    property BorderStyle;
    property Caption;
    property Color;
    property Constraints;
    property Ctl3D;
    property UseDockManager default True;
    property DockSite;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property FullRepaint;
    property Font;
    property Locked;
    property ParentBiDiMode;
    property ParentBackground;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property Picture:TPicture read FPicture write SetPicture;    
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;
    property OnCanResize;
    property OnClick;
    property OnConstrainedResize;
    property OnContextPopup;
    property OnDockDrop;
    property OnDockOver;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnGetSiteInfo;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnResize;
    property OnStartDock;
    property OnStartDrag;
    property OnUnDock;
  end;procedure Register;implementationprocedure Register;
begin
  RegisterComponents('Samples', [TIMGPanel]);
end;{ TIMGPanel }constructor TIMGPanel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csReplicatable];
  FPicture := TPicture.Create;
  Height := 105;
  Width := 105;
end;
destructor TIMGPanel.Destroy;
begin
  FPicture.Free;
  inherited;
end;procedure TIMGPanel.Paint;
begin
  inherited;
  if Assigned(Picture) then
  inherited Canvas.StretchDraw(ClientRect,Picture.Graphic);
end;procedure TIMGPanel.SetPicture(const Value: TPicture);
begin
  FPicture.Assign(Value);
end;end.

Answer 4

to wizardqi(男巫)
是的,我看拉，也用过你的,只不过我想多看看你们写的.所以再叫 zxf_feng(阿日) 贴出来看看，我肯定给你分的

Answer 5

我是做监控系统的.不知道大家知不道TALED这个控件,它象一个"灯"一样是用于显示设备的指示灯的颜色(比如显示显示器的指示灯,如显示器打开,则TALED就显示绿色,如果显示器关闭则TALED就显示红色).那我其实要做的这个控件是这样的.想把TPANEL和TImage还有TALED三个控件做在一起.最后想做成,只要一拖放这个做好的控件到窗体中TImage就会显示设备的图片,然后在设备的合适位置显示设备的"灯"的状态.最后根据设备的实际状态让响应的"灯"变色.我昨天只是把问题简化了一下.看看你们是怎么做的控件.
现在我把我做的这个控件说出来,看看大家能帮实现这个控件吗?因为时间比较急.我会再多给100分的.哦,TALED是继承于TGraphicControl类的.他与TPANEL继承的不一样和TImage一样.能实现吗?

Answer 6

可以设置一个ImageList ，LedIndex 设置显示的图标索引号
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls,Printers, Buttons,Contnrs,
  ElementClass,TypInfo,IniFiles,ImgList;Type
  TLedPanelEx = class(TPanel)
  private
    FBitMap:TBitmap;
    FImageChangeLink: TChangeLink;
    FImages: TCustomImageList;
    FLedIndex: Integer;
    procedure SetImages(const Value: TCustomImageList);
    procedure ImageListChange(Sender: TObject);
    procedure SetLedIndex(const Value: Integer);
  protected
    procedure Paint; override;
    function CanAutoSize(var NewWidth, NewHeight: Integer): Boolean; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Images: TCustomImageList read FImages write SetImages;
    property LedIndex:Integer Read FLedIndex Write SetLedIndex;
  end;procedure Register;implementationprocedure Register;
begin
  RegisterComponents('Standard', [TLedPanelEx]);end;
{ TLedPanelEx }function TLedPanelEx.CanAutoSize(var NewWidth,
  NewHeight: Integer): Boolean;
begin
  if AutoSize and Assigned(FImages) then
  begin
    NewWidth:=FImages .Width ;
    NewHeight:=FImages .Height;
  end;
end;
constructor TLedPanelEx.Create(AOwner: TComponent);
begin
  inherited;
  FImageChangeLink := TChangeLink.Create;
  FImageChangeLink.OnChange := ImageListChange;
  FBitMap:=TBitmap .Create;
end;destructor TLedPanelEx.Destroy;
begin
  FBitMap.Free;
  FImageChangeLink.Free;
  inherited;
end;procedure TLedPanelEx.ImageListChange(Sender: TObject);
begin
  if Sender = Images then Refresh ;
end;procedure TLedPanelEx.Paint;
begin
  inherited;
  if Assigned (Images) then
  begin
    Canvas .CopyMode:=cmWhiteness;
    if Images.GetBitmap(FLedIndex,FBitMap) then
      Canvas .BrushCopy(Rect(0,0,Images .Width,Images .Height),FBitMap ,Rect(0,0,Images .Width,Images .Height),clWhite); 
  end;
end;procedure TLedPanelEx.SetImages(const Value: TCustomImageList);
begin
  if Images <> nil then Images.UnRegisterChanges(FImageChangeLink);
  FImages := Value;
  if Images <> nil then
  begin
    Images.RegisterChanges(FImageChangeLink);
    Images.FreeNotification(Self);
  end;
  Refresh ;
end;procedure TLedPanelEx.SetLedIndex(const Value: Integer);
begin
  FLedIndex := Value;
  Refresh ;
end;

Answer 7

Canvas .BrushCopy(Rect(0,0,Images .Width,Images .Height),FBitMap ,Rect(0,0,Images .Width,Images .Height),clWhite); 用来透明显示图片，可是如果遇到图中间有白色的地方也会透明，有没有更好的办法？？

Answer 8

用Panel加一个 TAnimate就可以做出动画的效果了。

Answer 9

大家好，我把那个例子拿来了，请大家看看，迟了点真对不起。////////////////////////////////////////////////////////////////////////////////////
//
//
//  FileName    :   ImagePanel.pas
//
//
////////////////////////////////////////////////////////////////////////////////////
unit ImagePanel;interfaceuses windows, extctrls, graphics, classes, controls;type
    TImagePanel = class(TCustomPanel)
    private
        FPicture : TPicture;
        FTransparent : Boolean;
        FAutoSize : Boolean;        procedure PictureChanged(Sender: TObject);
        procedure SetPicture(const Value: TPicture);
        procedure SetAutoSize(const Value: Boolean); reintroduce;
        procedure SetTransparent(const Value: Boolean);
        procedure SetFont(const Value : TFont);
        procedure SetCaption(const Value : TCaption);
        procedure SetAlignment(const Value : TAlignment);    protected
        procedure Paint(); override;    public
        constructor Create(AOwner: TComponent); override;
        destructor Destroy(); override;    published
        property Picture : TPicture read FPicture write SetPicture;
        property Transparent : Boolean Read FTransparent Write SetTransparent default false;
        property AutoSize : Boolean Read FAutoSize Write SetAutoSize;        property Font write SetFont;
        property Caption write SetCaption;
        property Alignment write SetAlignment;
    end;procedure Register;implementation{ TImagePanel }constructor TImagePanel.Create(AOwner: TComponent);
begin
    inherited Create(AOwner);    FPicture := TPicture.Create();
    FPicture.OnChange := PictureChanged;    Repaint();
end;destructor TImagePanel.Destroy;
begin
    FPicture.Free();
    FPicture := nil;    inherited;
end;procedure TImagePanel.Paint;
const
    Alignments: array[TAlignment] of Longint = (DT_LEFT, DT_RIGHT, DT_CENTER);
var
    Flags: Longint;
    Rect: TRect;
    FontHeight: Integer;
begin
    Canvas.Brush.Style := bsClear;
    Canvas.Font := Font;    if Assigned(FPicture.Graphic) then
    begin
        if FAutoSize then
        begin
            Width := FPicture.Width;
            Height := FPicture.Height;
        end;        if FPicture.Graphic.Transparent <> FTransparent then
            FPicture.Graphic.Transparent := FTransparent;
        Canvas.StretchDraw(ClientRect, FPicture.Graphic);
    end
    else
    begin
        Canvas.Brush.Color := Color;
        Canvas.FillRect(ClientRect);
    end;    if Caption <> '' then
    begin
        Rect := GetClientRect;
        FontHeight := Canvas.TextHeight('W');
        Rect.Top := ((Rect.Bottom + Rect.Top) - FontHeight) div 2;
        Rect.Bottom := Rect.Top + FontHeight;        Flags := DT_EXPANDTABS or DT_VCENTER or Alignments[Alignment];
        Flags := DrawTextBiDiModeFlags(Flags);
        DrawText(Canvas.Handle, PChar(Caption), -1, Rect, Flags);
    end;
end;procedure TImagePanel.PictureChanged(Sender: TObject);
begin
    RePaint();
end;procedure TImagePanel.SetAlignment(const Value: TAlignment);
begin
    inherited Alignment := Value;    Repaint();
end;procedure TImagePanel.SetAutoSize(const Value: Boolean);
begin
    FAutoSize := Value;    RePaint();
end;procedure TImagePanel.SetCaption(const Value: TCaption);
begin
    inherited Caption := Value;    Repaint();
end;procedure TImagePanel.SetFont(const Value: TFont);
begin
    inherited Font := Value;    Repaint();
end;procedure TImagePanel.SetPicture(const Value: TPicture);
begin
    FPicture.Assign(Value);    Repaint();
end;procedure TImagePanel.SetTransparent(const Value: Boolean);
begin
    FTransparent := Value;    Repaint();
end;procedure Register;
begin
    RegisterComponents('Sunisoft', [TImagePanel]);
end;end.

Answer 10

没有编译我上面的TLedPanelEx 吗？可以指定一个图标列表，大小随意，只要指定LedIndex就可以显示ImageList列表中对应的图标了。