我想做个Myshape类(50)

  • 主题发起人 主题发起人 sdpdrh
  • 开始时间 开始时间
S

sdpdrh

Unregistered / Unconfirmed
GUEST, unregistred user!
我想做个Myshape类继承自shape类,里面包括MouseDown,MouseUp,MouseMove事件,目的是我通过此类Create生成的对象能直接具备通过鼠标移动的功能,我是新手,不知道该如何编写,在哪里编写相应代码,希望坛子的高手给点指导
 
记不清了。应该是用到:StartDrag DragDrop DragOver 这几个事件和 dragKind dragmode这几个属性。
 
谢谢,还能在详细点吗?
 
代码:
 TMyshape = class(Tshape) protected     procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN; //MouseDown   procedure WMMouseMove(var Message: TWMMouseMove); message WM_MOUSEMOVE; //Mousemove   ....end;
 
guanyue7613 大哥,怎么实现move和down啊。。。
 
左键点住shape,然后出现6个小黑点,然后可以移来移去,类似IDE的效果?
 
unit Shapes;interfaceuses Windows, IntfUnit, graphics, dialogs;type TMark = class(TInterfacedObject, IColor, IPosition, IDraw) private FColor: TColor; FPoint: TPoint; public constructor Create(APoint: TPoint; AColor: TColor); function GetColor: TColor; procedure SetColor(AColor: TColor); function GetXY: TPoint; procedure SetXY(APoint: TPoint); procedure NudgeUp; procedure NudgeDown; procedure NudgeLeft; procedure NudgeRight; procedure Draw(ACanvas: TCanvas); end; TSquare = class(TMark, IColor, IPosition, ISize, IDraw) private FHeight: Integer; FWidth: Integer; public constructor Create(AUpLeft: TPoint; AHeight: Integer; AWidth: Integer; AColor: TColor); function GetWidth: Integer; function GetHeight: Integer; procedure SetWidth(AWidth: Integer); procedure SetHeight(AHeight: Integer); procedure Draw(ACanvas: TCanvas); end;implementation{ TMark }constructor TMark.Create(APoint: TPoint; AColor: TColor);begin inherited Create; FPoint := APoint; FColor := AColor;end;procedure TMark.Draw(ACanvas: TCanvas);begin ACanvas.Pen.Color := FColor; ACanvas.MoveTo(FPoint.X - 2, FPoint.Y - 2); ACanvas.LineTo(FPoint.X + 3, FPoint.Y + 3); ACanvas.MoveTo(FPoint.X - 2, FPoint.Y + 2); ACanvas.LineTo(FPoint.X + 3, FPoint.Y - 3);end;function TMark.GetColor: TColor;begin Result := FColor;end;function TMark.GetXY: TPoint;begin Result := FPoint;end;procedure TMark.NudgeDown;begin Inc(FPoint.Y);end;procedure TMark.NudgeLeft;begin Dec(FPoint.X);end;procedure TMark.NudgeRight;begin Inc(FPoint.X);end;procedure TMark.NudgeUp;begin Dec(FPoint.Y);end;procedure TMark.SetColor(AColor: TColor);begin FColor := AColor;end;procedure TMark.SetXY(APoint: TPoint);begin FPoint := APoint;end;{ TSquare }constructor TSquare.Create(AUpLeft: TPoint; AHeight: Integer; AWidth: Integer; AColor: TColor);begin inherited Create(AUpLeft, AColor); FHeight := AHeight; FWidth := AWidth;end;procedure TSquare.Draw(ACanvas: TCanvas);begin ACanvas.Pen.Color := FColor; ACanvas.Rectangle(FPoint.X, FPoint.Y, FPoint.X + FWidth, FPoint.Y + FHeight);end;function TSquare.GetHeight: Integer;begin Result := FHeight;end;function TSquare.GetWidth: Integer;begin Result := FWidth;end;procedure TSquare.SetHeight(AHeight: Integer);begin FHeight := AHeight;end;procedure TSquare.SetWidth(AWidth: Integer);begin FWidth := AWidth;end;end.呵呵,你看行不?
 
感谢 火焰领主打伞 大哥你的代码,可是里面的IntfUnit, IColor,IPosition,IDraw,ISize是怎么定义的?
 
给你看个类定义部分供参考,具体的事件,方法实现部分自己琢磨琢磨。 TMyShape = class (TComponent) private FAngle: Single; FBrush: TBrush; FCaption: string; FCaptionShow: Boolean; FColorBegin: TColor; FColorEnd: TColor; FFont: TFont; FGradientStyle: TGradientStyle; FInfo: string; FIsFlipHorz: Boolean; FIsFlipVert: Boolean; FLocked: Boolean; FLogHeight:Integer; FLogUse:Boolean; FLogWidth:Integer; FMultiInfo:TStrings; FMultiInfoAlignment: TAlignment; FOnClick: TNotifyEvent; FOwner: TComponent; FPen: TPen; FResizeEnable: Boolean; FTag: LongInt; FUserData: TUserData; FVisible: Boolean; GradBmp: TBitmap; procedure DoFontChange(Sender:TObject); procedure DoPenBrushChange(Sender:TObject); procedure DragChangeValue(FromP, ToP: TPoint); virtual; procedure DragChangeValuedxdy(dx, dy: double); virtual; procedure Draging(MyCanvas:TCanvas;FromP, ToP: TPoint); virtual; procedure Drawed(FromP:TPoint;var ToP:TPoint); virtual; procedure DrawHot(MyCanvas:TCanvas); virtual; procedure DrawHotLinkSquare(MyCanvas:TCanvas;APoint: TMyPoint); procedure DrawInfo(MyCanvas:TCanvas); procedure Drawing(MyCanvas:TCanvas;FromP, ToP: TPoint); virtual; function GetLengthByUnit(FromPt, ToPt: TPoint): string; virtual; function GetMagicPoint(AShape:TMyShape;APoint:TMyPoint): TMyPoint; function GetMouseCursor(x,y:integer): TCursor; virtual; function GetRotatedAngle(FromP,Top,CenterPoint:TmyPoint;Constrain : Boolean = false): Extended; function InTextPointHot(APoint:TPoint): Boolean; function InWhichLinkHot(APoint:TMyPoint): Integer; function InWhichPointHot(APoint:TMyPoint): Integer; function IsDrawingFinished(Button:TMouseButton;msMovPt:TPoint): Boolean; virtual; procedure LinkPointAddXY(PointID:integer; x, y: double); procedure PointAddX(PointID:integer; x:Extended); procedure PointAddXY(PointID:integer; x, y: Extended); procedure PointAddY(PointID:integer; y: Extended); procedure RotateChangeValueByAngle(ACp:TMyPoint;dAngle:double); virtual; procedure Rotating(MyCanvas:TCanvas;ACp:TMyPoint;dAngle:Extended); virtual; procedure SetAngle(Value: Single); procedure SetBrush(const Value: TBrush); procedure SetCaption(const Value: string); procedure SetCaptionShow(Value: Boolean); procedure SetColorBegin(const Value: TColor); procedure SetColorEnd(const Value: TColor); procedure SetFont(const Value: TFont); procedure SetGradientStyle(const Value: TGradientStyle); procedure SetInfo(const Value: string); procedure SetIsFlipHorz(Value: Boolean); procedure SetIsFlipVert(Value: Boolean); procedure SetLinkPoint(PointID:integer;APoint:TMyPoint); procedure SetLinkPointX(PointID: integer; x:extended); procedure SetLinkPointY(PointID: integer; y: double); procedure SetLocked(const Value: Boolean); procedure SetLogHeight(const Value:Integer); procedure SetLogUse(const Value:Boolean); procedure SetLogWidth(const Value:Integer); procedure SetMultiInfo(Value: TStrings); procedure SetMultiInfoAlignment(Value: TAlignment); procedure SetOwner(Value: TComponent); procedure SetPen(const Value: TPen); procedure SetResizeEnable(const value:Boolean); procedure SetTag(Value: LongInt); procedure SetVisible(Value: Boolean); procedure SizeChangeValue(FromP, ToP: TMyPoint); virtual; procedure SizeChangeValueByScale(ScaleRatioX,ScaleRatioY:double; ReferPoint:TMyPoint;oldCenterPoint,newCenterPoint:TMyPoint); procedure Sizing(MyCanvas:TCanvas;FromP, ToP: TPoint); virtual; function ZoomedValuePt(const value: TMyPoint): TMyPoint; procedure MyLogTextOut( MyCanvas:TCanvas; Left,Top:Integer; AText:string; AFont:TFont; AAngle:Double; AZoom:Double ); function GetTextWidthHeight(MyCanvas:TCanvas;aStr:string;AFont:TFont; TheAngle:Double;AZoom:double): TPoint; protected procedure AddPointByMouse(APoint: TPoint); virtual; procedure SetPS(var ACanvas:TCanvas;b: TPenStyle; aColor: TColor; w: integer; var NewH,Oldh:HGDIOBJ); public CenterPoint: TMyPoint; ChildShapesNo: TMyShapeNo; LayerID: Integer; ParentShapeNo: Integer; SelectedHotId: Integer; ShapeId: Cardinal; ShapeNo: Cardinal; TextOutPoint: TMyPoint; ThePoints: TArrMyPoint; LinkPoints: TArrMyPoint; LinkShapesNo: TMyShapeNo; constructor Create(AOwner: TMyCAD); virtual; destructor Destroy; override; procedure AddLinkPoint(APoint: TMyPoint); procedure AddPoint(APoint: TMyPoint); procedure Assign(Source: TMyShape); virtual; procedure AssignWithoutRelation(Source: TMyShape); virtual; function ComputeCenterPoint(RefPoint: Integer = 4): TMyPoint; procedure Draw(MyCanvas:TCanvas); virtual; procedure FlipHoriz; virtual; procedure FlipVert; virtual; function GetCenterPoint: TMyPoint; virtual; function GetCenterPointInZoom: TMyPoint; virtual; function GetHeight: Single; function GetInfo: string; virtual; function GetLeftBottom: TMyPoint; function GetLeftTop: TMyPoint; function GetLinkPoint(PointID: integer): TMyPoint; function GetLinkPointInZoom(PointID: integer): TMyPoint; function GetLinkPointsCount: Integer; function GetMyHeight: Single; function GetMyWidth: Single; procedure DrawGradient; function GetPoint(PointID: integer): TMyPoint; virtual; function GetPointInZoom(PointID: integer): TMyPoint; function GetPointInZoomWithMode(PointID: integer): TPoint; function GetPointsCount: Integer; function GetRightBottom: TMyPoint; function GetRightTop: TMyPoint; function GetShapeId: Integer; function GetWidth: Single; function HasChildShapes: Boolean; function HasLinkShapes: Boolean; function HasParentShape: Boolean; function InWhichHot(APoint: TPoint): Integer; virtual; function IsClickedMe(MyCanvas:TCanvas;APoint: TPoint): Boolean; virtual; procedure LoadFromStream(AStream:TStream); virtual; procedure PowerDrawShape(MyCanvas:TCanvas;pts:TArrPoint;ptsCount:integer; FillIt:boolean); procedure SaveToStream(AStream:TStream); virtual; procedure SetName(const NewName:TComponentName); override; procedure SetPoint(PointID:integer;APoint:TMyPoint); procedure SetPointInZoom(PointID:integer;APoint:TMyPoint); procedure SetPointX(PointID:integer; x:Single); procedure SetPointXInZoom(PointID:integer; x:single); procedure SetPointY(PointID:integer; y:Single); procedure SetPointYInZoom(PointID:integer; y:single); property Owner: TComponent read FOwner write SetOwner; published property Angle: Single read FAngle write SetAngle; property Brush: TBrush read FBrush write SetBrush; property Caption: string read FCaption write SetCaption; property CaptionShow: Boolean read FCaptionShow write SetCaptionShow default true; property ColorBegin: TColor read FColorBegin write SetColorBegin default clWhite; property ColorEnd: TColor read FColorEnd write SetColorEnd default clBlack; property Font: TFont read FFont write SetFont; property GradientStyle: TGradientStyle read FGradientStyle write SetGradientStyle default gsNone; property Info: string read FInfo write SetInfo; property IsFlipHorz: Boolean read FIsFlipHorz write SetIsFlipHorz; property IsFlipVert: Boolean read FIsFlipVert write SetIsFlipVert; property Locked: Boolean read FLocked write SetLocked; property LogHeight: Integer read FLogHeight write SetLogHeight; property LogUse: Boolean read FLogUse write SetLogUse; property LogWidth: Integer read FLogWidth write SetLogWidth; property MultiInfo: TStrings read FMultiInfo write SetMultiInfo; property MultiInfoAlignment: TAlignment read FMultiInfoAlignment write SetMultiInfoAlignment default taCenter; property OnClick: TNotifyEvent read FOnClick write FOnClick; property Pen: TPen read FPen write SetPen; property ResizeEnable: Boolean read FResizeEnable write SetResizeEnable; property Tag: LongInt read FTag write SetTag; property UserData: TUserData read FUserData write FUserData; property Visible: Boolean read FVisible write SetVisible; end;
 
可以参考CnPack组件包中的CnDragResizer。
 
蜉蝣小生[xx(]实现是个大问题!
 
其实很简单,只要重写MouseDown和MouseMove方法就可以了,你自己写的代码不超过10行,我给你写了个类,是可以实现你要的功能的:---------------------------------unit HJKShape;interfaceuses SysUtils, Classes, Controls, ExtCtrls;type THJKShape = class(TShape) private { Private declarations } FOld_X: Integer; FOld_Y: Integer; protected procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; { Protected declarations } public { Public declarations } published { Published declarations } end;procedure Register;implementationprocedure Register;begin RegisterComponents('HJKPack', [THJKShape]);end;{ THJKShape }procedure THJKShape.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);begin FOld_X := x; FOld_Y := y; inherited;end;procedure THJKShape.MouseMove(Shift: TShiftState; X, Y: Integer);begin if (ssLeft in Shift) then begin Left := Left+(X - FOld_X) ; Top := Top +(Y - FOld_Y) ; end; inherited;end;end.如果你不想打包成组件,而是直接使用create来生成实例的话,可以把如下代码删除:procedure Register;procedure Register;begin RegisterComponents('HJKPack', [THJKShape]);end;
 
谢谢给为帮助,现在结贴!
 
后退
顶部