📄 iobjectcanvas.pas
字号:
{*******************************************************}
{ }
{ TiObjectCanvas Component }
{ }
{ Copyright (c) 1997,2003 Iocomp Software }
{ }
{*******************************************************}
{$I iInclude.inc}
{$ifdef iVCL}unit iObjectCanvas;{$endif}
{$ifdef iCLX}unit QiObjectCanvas;{$endif}
interface
uses
{$I iIncludeUses.inc}
{$IFDEF iVCL} iTypes, iMath, iGPFunctions, iClasses, iCustomComponent, Imglist, CommCtrl;{$ENDIF}
{$IFDEF iCLX}QiTypes, QiMath, QiGPFunctions, QiClasses, QiCustomComponent, QImglist;{$ENDIF}
type
TiMouseUPDownDisplayEvent = procedure(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Double) of object;
TiMouseMoveDisplayEvent = procedure(Sender: TObject; Shift: TShiftState; X, Y: Double) of object;
TiClickObjectEvent = procedure(Sender: TObject; Handle: Integer ) of object;
TiObjectCanvas = class(TiCustomComponent)
private
FMouseDown : Boolean;
FMouseDownHandle : Integer;
FHandleCounter : Integer;
FImageList : TImageList;
FObjectList : TStringList;
FOriginX : Double;
FOriginY : Double;
FDisplayRangeX : Double;
FDisplayRangeY : Double;
FDefaultBrushColor : TColor;
FDefaultBrushStyle : TBrushStyle;
FDefaultPenColor : TColor;
FDefaultPenStyle : TPenStyle;
FDefaultPenWidth : Integer;
FDefaultFontName : String;
FDefaultFontSize : Integer;
FDefaultFontBold : Boolean;
FDefaultFontItalic : Boolean;
FDefaultFontUnderLine : Boolean;
FDefaultFontColor : TColor;
FDefaultFontStrikeOut : Boolean;
FOnMouseDownDisplay : TiMouseUPDownDisplayEvent;
FOnMouseMoveDisplay : TiMouseMoveDisplayEvent;
FOnMouseUpDisplay : TiMouseUPDownDisplayEvent;
FOnClickObject : TiClickObjectEvent;
procedure SetOriginX (const Value: Double);
procedure SetOriginY (const Value: Double);
procedure SetDisplayRangeX (const Value: Double);
procedure SetDisplayRangeY (const Value: Double);
procedure SetObjectDefaults(iDrawObject: TiDrawObject);
function AddObject (iDrawObject: TiDrawObject) : Integer;
function GetObject (Handle: Integer) : TiDrawObject;
function GetImageListCount: Integer;
function GetImageListHeight: Integer;
function GetImageListWidth: Integer;
procedure SetImageListHeight(const Value: Integer);
procedure SetImageListWidth (const Value: Integer);
procedure ImageListLoadFromBitmap(ABitmap: TBitmap);
protected
procedure iMouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure iMouseUp (Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure iMouseMove( Shift: TShiftState; X, Y: Integer); override;
procedure iDoKillFocus; override;
procedure iPaintTo(Canvas: TCanvas); override;
procedure DefineProperties(Filer: TFiler); override;
procedure ReadImageList (Stream: TStream);
procedure WriteImageList(Stream: TStream);
procedure NeedsRedraw;
procedure DrawObjectText(Canvas: TCanvas; iDrawObject: TiDrawObject; CenterPoint: TPoint; ScaleXFactor, ScaleYFactor: Double);
property ImageList : TImageList read FImageList;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure BringObjectToFront(Handle: Integer);
procedure SendObjectToBack(Handle: Integer);
procedure ClearList;
procedure RemoveObject(Handle : Integer);
function AddEllipse (X, Y, Width, Height: Double) : Integer;
function AddRectangle (X, Y, Width, Height: Double) : Integer;
function AddArc (X, Y, Width, Height, StartAngle, StopAngle: Double) : Integer;
function AddLabel (X, Y: Double; Caption: String) : Integer;
function AddImage (X, Y: Double; ImageIndex : Integer) : Integer;
function AddLine (Left, Top, Right, Bottom: Double) : Integer;
function AddPolygon : Integer;
procedure ObjectAddPolyPoint (Handle: Integer; X, Y: Double);
procedure ObjectClearPolyPoints(Handle: Integer);
procedure SetObjectType (Handle: Integer; AType: TiDrawObjectType);
function GetObjectType (Handle: Integer) : TiDrawObjectType;
procedure SetObjectVisible (Handle: Integer; Visible: Boolean);
function GetObjectVisible (Handle: Integer) : Boolean;
procedure SetImageList(ImageList: TImageList);
procedure SetObjectBrush (Handle: Integer; Color: TColor; Style: TBrushStyle);
procedure SetObjectBrushStyle (Handle: Integer; Style: TBrushStyle);
procedure SetObjectBrushColor (Handle: Integer; Color: TColor);
function GetObjectBrushStyle (Handle: Integer) : TBrushStyle;
function GetObjectBrushColor (Handle: Integer) : TColor;
procedure SetObjectPen (Handle: Integer; Color: TColor; Style: TPenStyle; Width: Integer);
procedure SetObjectPenColor (Handle: Integer; Color: TColor);
procedure SetObjectPenStyle (Handle: Integer; Style: TPenStyle);
procedure SetObjectPenWidth (Handle: Integer; Width: Integer);
function GetObjectPenColor (Handle: Integer) : TColor;
function GetObjectPenStyle (Handle: Integer) : TPenStyle;
function GetObjectPenWidth (Handle: Integer) : Integer;
procedure SetObjectPosition (Handle: Integer; X, Y: Double);
procedure SetObjectPositionX (Handle: Integer; X : Double);
procedure SetObjectPositionY (Handle: Integer; Y : Double);
function GetObjectPositionX (Handle: Integer) : Double;
function GetObjectPositionY (Handle: Integer) : Double;
procedure SetObjectAngles (Handle: Integer; Start, Stop: Double);
procedure SetObjectStartAngle (Handle: Integer; Value: Double);
procedure SetObjectStopAngle (Handle: Integer; Value: Double);
function GetObjectStartAngle (Handle: Integer) : Double;
function GetObjectStopAngle (Handle: Integer) : Double;
procedure SetObjectSize (Handle: Integer; Width, Height: Double);
procedure SetObjectSizeWidth (Handle: Integer; Width : Double);
procedure SetObjectSizeHeight (Handle: Integer; Height : Double);
function GetObjectSizeWidth (Handle: Integer) : Double;
function GetObjectSizeHeight (Handle: Integer) : Double;
procedure SetObjectFont (Handle: Integer; Name: String; Size: Integer; Color: TColor; Bold, Italic, UnderLine, StrikeOut: Boolean);
procedure SetObjectFontName (Handle: Integer; Name: String);
procedure SetObjectFontSize (Handle: Integer; Size: Integer);
procedure SetObjectFontColor (Handle: Integer; Color: TColor);
procedure SetObjectFontBold (Handle: Integer; Bold: Boolean);
procedure SetObjectFontItalic (Handle: Integer; Italic: Boolean);
procedure SetObjectFontUnderLine(Handle: Integer; UnderLine: Boolean);
procedure SetObjectFontStrikOut (Handle: Integer; StrikeOut: Boolean);
function GetObjectFontName (Handle: Integer) : String;
function GetObjectFontSize (Handle: Integer) : Integer;
function GetObjectFontColor (Handle: Integer) : TColor;
function GetObjectFontBold (Handle: Integer) : Boolean;
function GetObjectFontItalic (Handle: Integer) : Boolean;
function GetObjectFontUnderLine(Handle: Integer) : Boolean;
function GetObjectFontStrikOut (Handle: Integer) : Boolean;
procedure SetObjectCaption (Handle: Integer; Caption: String);
function GetObjectCaption (Handle: Integer) : String;
procedure SetObjectImageIndex (Handle: Integer; ImageIndex: Integer);
function GetObjectImageIndex (Handle: Integer) : Integer;
function GetPixelsXToDisplayX (Value: Integer): Double;
function GetPixelsYToDisplayY (Value: Integer): Double;
function GetDisplayXToPixelsX (Value: Double): Integer;
function GetDisplayYToPixelsY (Value: Double): Integer;
procedure ShiftObject (Handle: Integer; XDelta, YDelta: Double);
procedure ShiftObjectX (Handle: Integer; XDelta : Double);
procedure ShiftObjectY (Handle: Integer; YDelta : Double);
property ImageListCount : Integer read GetImageListCount;
procedure ImageListRemoveAll;
procedure ImageListDelete(Index: Integer);
procedure ImageListAdd(Bitmap: TBitmap);
procedure ImageListLoadFromResourceID (Instance: Cardinal; ResID: Integer);
procedure ImageListLoadFromResourceName(Instance: Cardinal; ResName: String);
property MouseDownHandle : Integer read FMouseDownHandle;
published
property OriginX : Double read FOriginX write SetOriginX;
property OriginY : Double read FOriginY write SetOriginY;
property DisplayRangeX : Double read FDisplayRangeX write SetDisplayRangeX;
property DisplayRangeY : Double read FDisplayRangeY write SetDisplayRangeY;
property DefaultBrushColor : TColor read FDefaultBrushColor write FDefaultBrushColor default clBlack;
property DefaultBrushStyle : TBrushStyle read FDefaultBrushStyle write FDefaultBrushStyle default bsSolid;
property DefaultPenColor : TColor read FDefaultPenColor write FDefaultPenColor default clWhite;
property DefaultPenStyle : TPenStyle read FDefaultPenStyle write FDefaultPenStyle default psSolid;
property DefaultPenWidth : Integer read FDefaultPenWidth write FDefaultPenWidth default 1;
property DefaultFontName : String read FDefaultFontName write FDefaultFontName;
property DefaultFontSize : Integer read FDefaultFontSize write FDefaultFontSize default 8;
property DefaultFontColor : TColor read FDefaultFontColor write FDefaultFontColor default clWhite;
property DefaultFontBold : Boolean read FDefaultFontBold write FDefaultFontBold default False;
property DefaultFontItalic : Boolean read FDefaultFontItalic write FDefaultFontItalic default False;
property DefaultFontUnderLine : Boolean read FDefaultFontUnderLine write FDefaultFontUnderLine default False;
property DefaultFontStrikeOut : Boolean read FDefaultFontStrikeOut write FDefaultFontStrikeOut default False;
property ImageListWidth : Integer read GetImageListWidth write SetImageListWidth;
property ImageListHeight : Integer read GetImageListHeight write SetImageListHeight;
property OnMouseDownDisplay : TiMouseUPDownDisplayEvent read FOnMouseDownDisplay write FOnMouseDownDisplay;
property OnMouseMoveDisplay : TiMouseMoveDisplayEvent read FOnMouseMoveDisplay write FOnMouseMoveDisplay;
property OnMouseUpDisplay : TiMouseUPDownDisplayEvent read FOnMouseUpDisplay write FOnMouseUpDisplay;
property OnClickObject : TiClickObjectEvent read FOnClickObject write FOnClickObject;
property BackGroundColor default clBlack;
property BackGroundPicture;
property BorderStyle default ibsLowered;
property Transparent;
property Align;
property Width default 200;
property Height default 200;
property OnPaint;
end;
implementation
//*************************************************************************************************************************************
constructor TiObjectCanvas.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Width := 200;
Height := 200;
BackGroundColor := clBlack;
BorderStyle := ibsLowered;
FDisplayRangeX := 100;
FDisplayRangeY := 100;
FDefaultBrushColor := clBlack;
FDefaultBrushStyle := bsSolid;
FDefaultPenColor := clWhite;
FDefaultPenStyle := psSolid;
FDefaultPenWidth := 1;
FDefaultFontName := 'Arial';
FDefaultFontSize := 8;
FDefaultFontColor := clWhite;
FDefaultFontBold := False;
FDefaultFontItalic := False;
FDefaultFontUnderLine := False;
FDefaultFontStrikeOut := False;
FObjectList := TStringList.Create;
FObjectList.Duplicates := dupError;
FImageList := TImageList.Create(Self);
FImageList.BkColor := clnone;
FImageList.Width := 24;
FImageList.Height := 24;
FImageList.Masked := True;
FMouseDownHandle := -1;
CreateBackGroundPicture;
end;
//*************************************************************************************************************************************
destructor TiObjectCanvas.Destroy;
begin
ClearList;
FObjectList.Free;
FImageList.Free;
inherited;
end;
//*************************************************************************************************************************************
procedure TiObjectCanvas.ClearList;
begin
while FObjectList.Count > 0 do
begin
FObjectList.Objects[0].Free;
FObjectList.Delete(0);
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -