transimage.pas

这部分与维生素D3

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

	TTransImage 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. TTransImage is like a TImage component but can render
	transparent. Like the TTransCanvas.

	Tip:
	If you want to create a crossfade from one image to another then use
	a TImage as a background with one picture and a TTRansImage on top of it.
	Crossfade will occur when the TransPercent value is changed with small increments
	from 0 to 100 or 100 to 0

	Tip:
	Perfect sprites with no jagged edges when you process the image in
	photoshop with a 100% pure blue background. In case of a 3D package, render
	against a 100% pure Blue, Red or Green background
}
interface

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

type
	TTransImage = class(TCustomTransCanvas)
	private
		FPicture: TPicture;
		FStretch: Boolean;
		FAutoSize: Boolean;
		FCenter: Boolean;
		FTile: Boolean;
		FAspectLock: Boolean;
		FXOffset: Integer;
		FYOffSet: Integer;
		procedure SetTile(Value: Boolean);
		procedure SetStretch(Value: Boolean);
		procedure SetXOffset(Value: Integer);
		procedure SetYOffset(Value: Integer);
		procedure SetAutoSize(Value: Boolean);
		procedure SetCenter(Value: Boolean);
		procedure SetAspectLock(Value: Boolean);
		procedure SetPicture(Value: TPicture);
	protected
		procedure DoPaint(PCanvas: TCanvas); override;
	public
		constructor Create(AOwner: TComponent); override;
		destructor Destroy; override;
	published
		property Stretch: Boolean read FStretch write SetStretch;
		property XOffset: Integer read FXOffset write SetXOffset;
		property YOffset: Integer read FYOffset write SetYOffset;
		property AutoSize: Boolean read FAutoSize write SetAutoSize default False;
		property Tile: Boolean read FTile write SetTile default False;
		property Center: Boolean read FCenter write SetCenter default False;
		property AspectLock: Boolean read FAspectLock write SetAspectLock default False;
		property Picture: TPicture read FPicture write SetPicture;
		property UseCalcEvent;
		property OnCalc;
		property CanvasType;
		property TransBiasPercent;
		property ScreenBiasPercent;
		property TransFade;
		property TransType;
		property TransPercent;
		property TransMinCutoff;
		property TransMaxCutoff;
		property TransKeyColor;
		property Inverse;
		property OnPaint;
		property Align;
		property Color;
		property DragCursor;
		property DragMode;
		property Enabled;
		property Font;
		property ParentColor;
		property ParentFont;
		property ParentShowHint;
		property PopupMenu;
		property ShowHint;
		property Visible;
		property OnClick;
		property OnDblClick;
		property OnDragDrop;
		property OnDragOver;
		property OnEndDrag;
		property OnMouseDown;
		property OnMouseMove;
		property OnMouseUp;
		property OnStartDrag;
	end;

procedure Register;

implementation

procedure Register;
begin
	RegisterComponents('Diprode', [TTransImage]);
end;

constructor TTransImage.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
	ControlStyle := ControlStyle + [csReplicatable];
	FPicture := TPicture.Create;
	Height := 105;
	Width := 105;
end;

destructor TTransImage.Destroy;
begin
	FPicture.Free;
	inherited Destroy;
end;

procedure TTransImage.DoPaint(PCanvas: TCanvas);
var
	i,j: Integer;
begin
	if assigned(FPicture.Graphic) then begin
		if FStretch then begin
			if FAspectLock and (align = alNone) then begin
				Height :=round(Width / (FPicture.Width / FPicture.Height));
			end;
			PCanvas.StretchDraw(ClientRect,FPicture.Graphic);
		end else begin
			if Align = alNone then begin
			end;
			if FCenter then
				Pcanvas.Draw((Width - FPicture.Width) div 2 ,(Height - FPicture.Height) div 2 ,FPicture.Graphic)
			else if FTile then begin
				j := -FYOffset;
				while j > 0 do j := j - FPicture.Graphic.Height;
				while j < Height do begin
					i := -FXOffset;
					while i > 0 do i := i - FPicture.Graphic.width;
					while i < width do begin
						Pcanvas.Draw(i,j,FPicture.Graphic);
						i := i + FPicture.Graphic.width;
					end;
					j := j + FPicture.Graphic.Height;
				end;
			end	else Pcanvas.Draw(-FXOffset,-FYOffset,FPicture.Graphic);
		end;
	end;
	inherited DoPaint(PCanvas);
end;

procedure TTransImage.SetAutoSize(Value: Boolean);
begin
	FAutoSize := Value;
	if assigned(Fpicture.Graphic) and FAutoSize then SetBounds(Left,Top,FPicture.Width - FXOffset,FPicture.Height - FYOffset);
	invalidate;
end;

procedure TTransImage.SetCenter(Value: Boolean);
begin
	FCenter := Value;
	Invalidate;
end;

procedure TTransImage.SetAspectLock(Value: Boolean);
begin
	FAspectLock := Value;
	Invalidate;
end;

procedure TTransImage.SetPicture(Value: TPicture);
begin
	FPicture.Assign(Value);
	invalidate;
end;

procedure TTransImage.SetXOffset(Value: Integer);
begin
	if Value = FXOffset then exit;
	if (Value < 0) and not FTile then exit;
	FXOffset := Value;
	invalidate;
end;

procedure TTransImage.SetYOffset(Value: Integer);
begin
	if Value = FYOffset then exit;
	if (Value < 0) and not FTile then exit;
	FYOffset := Value;
	invalidate;
end;

procedure TTransImage.SetStretch(Value: Boolean);
begin
	if Value = FStretch then exit;
	FStretch := Value;
	Invalidate;
end;

procedure TTransImage.SetTile(Value: Boolean);
begin
	if Value <> FTile then begin
		FTile := Value;
		invalidate;
	end;
end;

end.