控件开发，如何把多个IMAGE控件做成一个控件中

没有给你写成组件，写成了类。改一改，完善一下就可以了。如果还不会，建议找本书看看。
下面代码可以实现的是生成9个image，3×3矩阵排列，双击可加载图片unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, DB, ADODB, ExtCtrls, Buttons,jpeg;type
  TWdImage = class(Tpanel)
    public//我都写成了public，做成组件时，frow这些东西最好写在private中，
         //然后提供一个属性来供用户调用
      FRow : integer;
      FCol : integer;
      Fimage : array of timage;
      constructor Create(AOwner: TComponent);override;
      destructor Destroy;
      procedure Setrowandcol(value : integer);
      procedure MyImageOndbclick(Sender: TObject);
        end;
  TForm1 = class(TForm)
    Image1: TImage;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    procedure Image1Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;
  a : TWdImage;implementation{$R *.dfm}procedure TForm1.Image1Click(Sender: TObject);
beginend;{ TWdImage }constructor TWdImage.Create(AOwner: TComponent);
var
  i ,l,t,j,n: integer;
begin
  inherited;
  FRow := 3;
  FCol := 3;//默认是3*3的
  Width := 600;//从tpanel继承而来，这里设置的就是panel的大小
  Height := 600;
  SetLength(Fimage,frow*fcol);//image这里用的是动态数组，在这里分配空间
  n := 0;
//下面的代码用来创建image数组中的内容并显示在背景的panel上。
  for i := 0 to frow-1 do
  begin
    l := 0;
    for j := 0 to FCol-1 do
    begin
       Fimage[n] := TImage.Create(nil);
       Fimage[n].Parent := Self;
       Fimage[n].Width := Width div 3;
       Fimage[n].Height := Height div 3;
       Fimage[n].Left := l;
       fimage[n].Top := i * Fimage[n].Height;
       l := l + Fimage[n].Width;
       fimage[n].Canvas.MoveTo(0,0);
       Fimage[n].Canvas.Font.Size := 8;
       fimage[n].Canvas.TextOut(0,0,inttostr(n+1));
       fimage[n].Stretch := true;
       fimage[n].OnDblClick := MyImageOndbclick;
       inc(n);
    end;
  end;end;destructor TWdImage.Destroy;
begin
   inherited;
   SetLength(Fimage,0);end;procedure TWdImage.MyImageOndbclick(Sender: TObject);
var
  Dialog : TOpenDialog;
begin
  Dialog := TOpenDialog.Create(nil);
  try
  if Dialog.Execute then
    (sender as TImage).Picture.LoadFromFile(Dialog.FileName);
  finally
    Dialog.Free;
  end;
end;procedure TWdImage.Setrowandcol(value: integer);
beginend;procedure TForm1.BitBtn1Click(Sender: TObject);
begin
   //测试代码，创建并显示，双击可以加载图片
   a := TWdImage.Create(nil);
   a.Parent := Form1;
   a.Left := 100;
   a.Top := 100;end;procedure TForm1.BitBtn2Click(Sender: TObject);
begin
   ShowMessage('abc');
   a.Destroy;end;end.
我想把Panel控件做成透明的，我就在网上找了透明PANEL的代码，把他组合进去就出错了，编译通过的
但是不能用呀，兄弟帮忙看看
以下是我在网上找到的透明控件的代码unit Glass;interfaceuses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls;type
TGlassStyle = (
gsBlackness, gsDstInvert, gsMergeCopy, gsMergePaint, gsNotSrcCopy,
gsNotSrcErase, gsPatCopy, gsPatInvert, gsPatPaint, gsSrcAnd,
gsSrcCopy, gsSrcErase, gsSrcInvert, gsSrcPaint, gsWhiteness);TGlass = class(TCustomControl)//------------private-----------------------------------------------------------
private
FColor: TColor;
FStyle: TGlassStyle;
FOnPaint: TNotifyEvent;procedure SetColor(Value: TColor);   //设置颜色
procedure SetStyle(Value: TGlassStyle);  //设置类型
procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED; //改变3D效果
procedure WMEraseBkgnd(var Message: TMessage); message WM_ERASEBKGND;     //除去背景色
procedure WMWindowPosChanging(var Message: TWMWindowPosChanging); message WM_WINDOWPOSCHANGING; //?坐标变化//--------------protected-------------------------------------------------------
protected
Buffer: TBitmap;procedure CreateParams(var Params: TCreateParams); override;
procedure Paint; override;
procedure Resize; override;//--------------public----------------------------------------------------------
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Canvas;//--------------published-------------------------------------------------------
published
property Align;
property Anchors;
property AutoSize;
property BiDiMode;
property BorderWidth;
property Color: TColor read FColor write SetColor;
property Ctl3D;
property Enabled;
property Style: TGlassStyle read FStyle write SetStyle default gsSrcAnd;
property Visible;property OnClick;
property OnDblClick;
property OnEnter;
property OnExit;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnResize;
property OnPaint: TNotifyEvent read FOnPaint write FOnPaint;
end;procedure Register;
//------------------执行语句----------------------------------------------------
//------------------------------------------------------------------------------
implementationprocedure Register;
begin
RegisterComponents('Croco', [TGlass]);
end;//--------------给自定义颜色赋值------------------------------------------------
function GlassStyleToInt(gs: TGlassStyle): LongInt;
begin
case gs of
gsBlackness : Result := cmBlackness;
gsDstInvert : Result := cmDstInvert;
gsMergeCopy : Result := cmMergeCopy;
gsMergePaint : Result := cmMergePaint;
gsNotSrcCopy : Result := cmNotSrcCopy;
gsNotSrcErase: Result := cmNotSrcErase;
gsPatCopy : Result := cmPatCopy;
gsPatInvert : Result := cmPatInvert;
gsPatPaint : Result := cmPatPaint;
gsSrcAnd : Result := cmSrcAnd;
gsSrcCopy : Result := cmSrcCopy;
gsSrcErase : Result := cmSrcErase;
gsSrcInvert : Result := cmSrcInvert;
gsSrcPaint : Result := cmSrcPaint;
gsWhiteness : Result := cmWhiteness;
else Assert(True, 'Error parameter in function GlassStyleToInt');
end;
end;
//-----------------创建---------------------------------------------------------
constructor TGlass.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Buffer := TBitmap.Create;ControlStyle := [csAcceptsControls, csCaptureMouse, csClickEvents,
csDoubleClicks, csReplicatable];
Width := 100;
Height := 100;
FStyle := gsSrcAnd;
ParentCtl3d := False;
Ctl3D := False;
ParentColor := False;
FColor := clWhite;
end;
//-----------------销毁---------------------------------------------------------
destructor TGlass.Destroy;
begin
Buffer.Free;
inherited Destroy;
end;//------------------绘制控件----------------------------------------------------
procedure TGlass.Paint;
var
R: TRect;
rop: LongInt;
begin
R := Rect(0, 0, Width, Height);
Buffer.Width := Width;
Buffer.Height := Height;
Buffer.Canvas.Brush.Style := bsSolid;
Buffer.Canvas.Brush.Color := FColor;
Buffer.Canvas.FillRect(Rect(0, 0, Width, Height));
rop := GlassStyleToInt(FStyle);
StretchBlt(Buffer.Canvas.Handle, 0, 0, Width, Height,
Canvas.Handle, 0, 0, Width, Height, rop);
if Ctl3D then DrawEdge(Buffer.Canvas.Handle, R, BDR_RAISEDINNER, BF_RECT);
Buffer.Canvas.Pen.Mode := pmCopy;
Buffer.Canvas.Pen.Style := psSolid;
Canvas.Draw(0, 0, Buffer);
if Assigned(FOnPaint) then FOnPaint(Self);
end;//-----------------设置颜色-----------------------------------------------------
procedure TGlass.SetColor(Value: TColor);
begin
if Value <> FColor then
begin
FColor := Value;
RecreateWnd; //重画窗口
end;
end;//-----------------创建参数-----------------------------------------------------
procedure TGlass.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);Params.ExStyle := Params.ExStyle + WS_EX_TRANSPARENT;
end;//-------------------窗口坐标改变-----------------------------------------------
procedure TGlass.WMWindowPosChanging(var Message: TWMWindowPosChanging);
begin
Invalidate;inherited;
end;//----------------擦除背景色----------------------------------------------------
procedure TGlass.WMEraseBkgnd(var Message: TMessage);
begin
Message.Result := 0;
end;//---------------------调整大小-------------------------------------------------
procedure TGlass.Resize;
begin
Invalidate;inherited;
end;//--------------------3D效果----------------------------------------------------
procedure TGlass.CMCtl3DChanged(var Message: TMessage);
begin
inherited;RecreateWnd;
end;//------------------设置样式----------------------------------------------------
procedure TGlass.SetStyle(Value: TGlassStyle);
begin
if Value <> FStyle then
begin
FStyle := Value;
RecreateWnd;
end;
end;end.
我进行了集成之后的代码，可是老是出错
运行是把内存都吃光了，郁闷
unit Glass;interfaceuses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls;type
TGlassStyle = (
gsBlackness, gsDstInvert, gsMergeCopy, gsMergePaint, gsNotSrcCopy,
gsNotSrcErase, gsPatCopy, gsPatInvert, gsPatPaint, gsSrcAnd,
gsSrcCopy, gsSrcErase, gsSrcInvert, gsSrcPaint, gsWhiteness);TGlass = class(TCustomControl)//------------private-----------------------------------------------------------
private
FColor: TColor;
FStyle: TGlassStyle;
FOnPaint: TNotifyEvent;procedure SetColor(Value: TColor);   //设置颜色
procedure SetStyle(Value: TGlassStyle);  //设置类型
procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED; //改变3D效果
procedure WMEraseBkgnd(var Message: TMessage); message WM_ERASEBKGND;     //除去背景色
procedure WMWindowPosChanging(var Message: TWMWindowPosChanging); message WM_WINDOWPOSCHANGING; //?坐标变化//--------------protected-------------------------------------------------------
protected
Buffer: TBitmap;procedure CreateParams(var Params: TCreateParams); override;
procedure Paint; override;
procedure Resize; override;//--------------public----------------------------------------------------------
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Canvas;//--------------published-------------------------------------------------------
published
property Align;
property Anchors;
property AutoSize;
property BiDiMode;
property BorderWidth;
property Color: TColor read FColor write SetColor;
property Ctl3D;
property Enabled;
property Style: TGlassStyle read FStyle write SetStyle default gsSrcAnd;
property Visible;property OnClick;
property OnDblClick;
property OnEnter;
property OnExit;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnResize;
property OnPaint: TNotifyEvent read FOnPaint write FOnPaint;
end;procedure Register;
//------------------执行语句----------------------------------------------------
//------------------------------------------------------------------------------
implementationprocedure Register;
begin
RegisterComponents('Croco', [TGlass]);
end;//--------------给自定义颜色赋值------------------------------------------------
function GlassStyleToInt(gs: TGlassStyle): LongInt;
begin
case gs of
gsBlackness : Result := cmBlackness;
gsDstInvert : Result := cmDstInvert;
gsMergeCopy : Result := cmMergeCopy;
gsMergePaint : Result := cmMergePaint;
gsNotSrcCopy : Result := cmNotSrcCopy;
gsNotSrcErase: Result := cmNotSrcErase;
gsPatCopy : Result := cmPatCopy;
gsPatInvert : Result := cmPatInvert;
gsPatPaint : Result := cmPatPaint;
gsSrcAnd : Result := cmSrcAnd;
gsSrcCopy : Result := cmSrcCopy;
gsSrcErase : Result := cmSrcErase;
gsSrcInvert : Result := cmSrcInvert;
gsSrcPaint : Result := cmSrcPaint;
gsWhiteness : Result := cmWhiteness;
else Assert(True, 'Error parameter in function GlassStyleToInt');
end;
end;
//-----------------创建---------------------------------------------------------
constructor TGlass.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Buffer := TBitmap.Create;ControlStyle := [csAcceptsControls, csCaptureMouse, csClickEvents,
csDoubleClicks, csReplicatable];
Width := 100;
Height := 100;
FStyle := gsSrcAnd;
ParentCtl3d := False;
Ctl3D := False;
ParentColor := False;
FColor := clWhite;
end;
//-----------------销毁---------------------------------------------------------
destructor TGlass.Destroy;
begin
Buffer.Free;
inherited Destroy;
end;

调试易

控件开发，如何把多个IMAGE控件做成一个控件中

解决方案 »