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.
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.