transshape.pas

这部分与维生素D3

unit TransShape;
{
	TTransShape By Paul van Dinther Copyright Diprode 24-01-2000
	e-mail: [e-mail]
	Website: http://www.diprode.com

	TTransShape inherits from TCustomTransCanvas. Normally you'd find the paint
	method to be overridden. In this case the DoPaint OnPaint eventhandler
	encapsulation is being overriden. Thus providing a tidy integration with
	TCustomTransCanvas. TTransShape is like a TShape component but it can render
	using the special transparency effects.

	Tip:

	Create 3 Circle shapes (color one red, one blue and one green) on a white form
	and have them overlapping. You will see	the correct cimbined colors as it were
	light.

	Have a look at GIFLine Pro on http://www.diprode.com/giflinepro.htm to see
	this component in action.
}


interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  TransCanvas;

type
	TShapeType = (stNone, stRectangle, stSquare, stRoundRect, stRoundSquare, stEllipse, stCircle, stLine, stCenterLine);
	TTransShape = class(TCustomTransCanvas)
  private
    FPen: TPen;
    FBrush: TBrush;
		FShape: TShapeType;
		FAngle: Integer;
		procedure SetAngle(Value: Integer);
    procedure SetBrush(Value: TBrush);
    procedure SetPen(Value: TPen);
		procedure AngleLine(PCanvas: TCanvas; PX,PY: Integer; PAngle: Integer; PBoth: boolean);
		procedure SetShape(Value: TShapeType);
  protected
		procedure DoPaint(PCanvas: TCanvas); override;
  public
    constructor Create(AOwner: TComponent); override;
		destructor Destroy; override;
  published
		procedure StyleChanged(Sender: TObject);
		property Angle: Integer read FAngle write SetAngle;
		property UseCalcEvent;
		property OnCalc;
		property TransFade;
		property TransType;
		property TransPercent;
		property TransMinCutoff;
		property TransMaxCutoff;
		property TransKeyColor;
		property TransBiasPercent;
		property ScreenBiasPercent;
		property Inverse;
		property OnPaint;
		property CanvasType;
		property Align;
		property Brush: TBrush read FBrush write SetBrush;
		property DragCursor;
		property DragMode;
		property Enabled;
		property ParentShowHint;
		property Pen: TPen read FPen write SetPen;
		property Shape: TShapeType read FShape write SetShape;
		property ShowHint;
		property Visible;
		property OnDragDrop;
		property OnDragOver;
		property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
		property OnStartDrag;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('DPD', [TTransShape]);
end;

constructor TTransShape.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
	ControlStyle := ControlStyle + [csOpaque, csReplicatable];
//	ControlStyle := ControlStyle + [csReplicatable];
	Width := 65;
	Height := 65;
	FPen := TPen.Create;
	FShape := stRectangle;
	FPen.OnChange := StyleChanged;
	FBrush := TBrush.Create;
	FBrush.OnChange := StyleChanged;
end;

destructor TTransShape.Destroy;
begin
	FPen.Free;
	FBrush.Free;
	inherited Destroy;
end;

procedure TTransShape.DoPaint(PCanvas: TCanvas);
var
	X, Y, W, H, S: Integer;
begin
	inherited DoPaint(PCanvas);
	with PCanvas do
	begin
		Pen := FPen;
		Brush := FBrush;
		X := Pen.Width div 2;
		Y := X;
		W := Width - Pen.Width + 1;
		H := Height - Pen.Width + 1;
		if Pen.Width = 0 then
		begin
			Dec(W);
			Dec(H);
		end;
		if W < H then S := W else S := H;
		if FShape in [stSquare, stRoundSquare, stCircle] then
		begin
			Inc(X, (W - S) div 2);
			Inc(Y, (H - S) div 2);
			W := S;
			H := S;
		end;
		case FShape of
			stRectangle, stSquare:
				Rectangle(X, Y, X + W, Y + H);
			stRoundRect, stRoundSquare:
				RoundRect(X, Y, X + W, Y + H, S div 4, S div 4);
			stCircle, stEllipse:
				Ellipse(X, Y, X + W, Y + H);
			stLine: begin
				AngleLine(PCanvas,Width div 2,Height div 2,FAngle,True);
			end;
			stCenterLine: begin
				AngleLine(PCanvas,Width div 2,Height div 2,FAngle,False);
			end;
		end;
	end;
end;

procedure TTransShape.AngleLine(PCanvas: TCanvas; PX,PY: Integer; PAngle: Integer; PBoth: boolean);
var
	LX,LY: Integer;
	LLength: Integer;
begin
	LLength := trunc(SQRT(SQR(Width) + SQR(Height)));
	LX := trunc(Cos(PAngle * (PI / 180)) * LLength);
	LY := trunc(Sin(PAngle * (PI / 180)) * LLength);
	if PBoth then PCanvas.MoveTo(PX - LX,PY - LY)
	else PCanvas.MoveTo(PX, PY);
	PCanvas.LineTo(PX + LX,PY + LY);
end;

procedure TTransShape.StyleChanged(Sender: TObject);
begin
	Invalidate;
end;

procedure TTransShape.SetBrush(Value: TBrush);
begin
	FBrush.Assign(Value);
end;

procedure TTransShape.SetPen(Value: TPen);
begin
	FPen.Assign(Value);
end;

procedure TTransShape.SetShape(Value: TShapeType);
begin
	if FShape <> Value then
	begin
		FShape := Value;
		Invalidate;
	end;
end;

procedure TTransShape.SetAngle(Value: Integer);
begin
	if Value <> FAngle then begin
		FAngle := Value;
		Invalidate;
	end;
end;

end.