为什么此组件不能动态创建(100分)

  • 主题发起人 主题发起人 tracksun
  • 开始时间 开始时间
T

tracksun

Unregistered / Unconfirmed
GUEST, unregistred user!
此组件运行良好,但动态创建时不能显示,请问是哪里出了问题?谢谢高手指点

unit MapComponent;

interface

uses
Windows, Messages, StdCtrls, SysUtils, Classes,ImgList, Controls,Graphics;

type
TOutputStyle=(osPush,osToggle);

TGECamera = class(TGraphicControl)
private
FCompType:integer;
FImageList:TImageList;
FImageIndex:integer;
FImageChangeLink:TChangeLink;
FCaption:string;
FEditMode:boolean;
FPoint:TPoint;
FBeginMove:Boolean;
procedure SetImageList(value:TImageList);
procedure SetImageIndex(value:integer);
procedure SetCaption(value:string);
protected
procedure paint;override;
procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
procedure WMMouseMove(var Message: TWMMouseMove); message WM_MOUSEMOVE;
procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;
public
constructor Create(AOwner: TComponent);override;
destructor Destroy;override;
published
property CompType:integer read FCompType;
property ImageIndex:integer read FImageIndex write SetImageIndex;
property Caption:string read FCaption write SetCaption;
property Font;
property OnDblClick;
property EditMode:Boolean read FEditMode write FEditMode;
property ImageList:TImageList read FImageList write SetImageList;
end;

procedure Register;

implementation

{$R MapComponent.dcr}


procedure Register;
begin
RegisterComponents('MyComponent', [TGECamera]);
end;

{ TGECamera }

constructor TGECamera.Create(AOwner: TComponent);
begin
inherited;
FCompType:=2;
ControlStyle := ControlStyle - [csOpaque];
FImageChangeLink := TChangeLink.Create;
FEditMode:=false;
FBeginMove:=false;
end;



destructor TGECamera.Destroy;
begin
FImageChangeLink.Free;
inherited;
end;

procedure TGECamera.paint;
var
w:integer;
FIcon:TIcon;
R:TRect;
begin
if FCaption='' then FCaption:=name;
Canvas.Font:=Font;
FIcon:=TIcon.create;
w:=Canvas.TextWidth(FCaption);
Width:=W;
Height:=32+Canvas.TextHeight(FCaption);
R:=Rect(0,33,w,33+Canvas.TextHeight(FCaption));
canvas.Brush.Style:=bsClear;
DrawText(Canvas.Handle,pchar(FCaption),length(FCaption),R,DT_CENTER);
if assigned(FImageList) then
begin
FImageList.GetIcon(FImageIndex,FIcon);
Canvas.Draw((w-32) div 2,0,FIcon);
end;
FIcon.Free;
end;

procedure TGECamera.SetCaption(value: string);
begin
FCaption:=value;
Invalidate;
end;

procedure TGECamera.SetImageIndex(value: integer);
begin
FImageIndex:=value;
Invalidate;
end;

procedure TGECamera.SetImageList(value: TImageList);
begin
if FImageList <> nil then FImageList.UnRegisterChanges(FImageChangeLink);
FImageList := Value;
if FImageList <> nil then
begin
FImageList.RegisterChanges(FImageChangeLink);
FImageList.FreeNotification(Self);
end
else
FImageIndex:=0;
Invalidate;
end;

procedure TGECamera.WMLButtonDown(var Message: TWMLButtonDown);
begin
if FEditMode then
begin
if Message.Keys=9 then
begin
Self.Free;
exit;
end;
FPoint:=ClientToScreen(point(Message.XPos,message.YPos));
FBeginMove:=true;
end;
inherited;
end;

procedure TGECamera.WMLButtonUp(var Message: TWMLButtonUp);
begin
FBeginMove:=false;
inherited;
end;

procedure TGECamera.WMMouseMove(var Message: TWMMouseMove);
var
NewPoint:TPoint;
begin
if FEditMode and FBeginMove then
begin
NewPoint:=ClientToScreen(point(Message.XPos,message.YPos));
Left:=Left+(NewPoint.X-FPoint.X);
Top:=Top+(NewPoint.Y-FPoint.Y);
FPoint:=NewPoint;
end;
inherited;
end;

end.
 
这可能是你没有为动态创建的控件命名,这样在Paint方法中将不绘制空串,故不可见。
其实你可在ControlStyle中增加csSetCaption来使Caption自动设置。
另:
1、你创建了FImageChangeLink := TChangeLink.Create;但没有编写FImageChangeLink.OnChange代码,
故并没实质意义。
2、你注册了FImageList.FreeNotification(Self);但没有override Notification方法,
故也没有实质意义:)
3、.......
 
.Parent:=???;
.Visible:=True;
.Top:=???;
.Left:=???;
.Width:=???;
.Height:=???;
 
在Create 中加上:
FImageList:=TImageList.Create(Self);
应该好用了,我大概测试了一下。
 
好像没有left,top,width,height
 

Similar threads

I
回复
0
查看
527
import
I
I
回复
0
查看
625
import
I
I
回复
0
查看
482
import
I
I
回复
0
查看
633
import
I
后退
顶部