transcanvas.pas

这部分与维生素D3

							end;
						ttAlpha:
							LTransPercent := FTransPercent;
						ttBlue:
							if LForeScan[X] + LForeScan[X+1] + LForeScan[X+2] > 0 then begin
								LTransPercent := 100 * LForeScan[X] div (LForeScan[X] + LForeScan[X+1] + LForeScan[X+2]);
							end else LTransPercent := 0;
						ttGreen:
							if LForeScan[X] + LForeScan[X+1] + LForeScan[X+2] > 0 then begin
							LTransPercent := 100 * LForeScan[X + 1] div (LForeScan[X] + LForeScan[X+1] + LForeScan[X+2]);
							end else LTransPercent := 0;
						ttRed:
							if LForeScan[X] + LForeScan[X+1] + LForeScan[X+2] > 0 then begin
							LTransPercent := 100 * LForeScan[X + 2] div (LForeScan[X] + LForeScan[X+1] + LForeScan[X+2]);
							end else LTransPercent := 0;
						end;
						if FTransType in [ttred,ttgreen,ttblue] then begin
							{
								Changes the relation between transparency and screen color from
								linear to exponential. This results in better clips
							}
							LTransPercent := round(bias((LTransPercent / 100),FScreenBias) * 100);
							{
								Apply minimum and max cutoff filters
								These filters will push transparency values below minimum cutoff down
								to zero and boost transparency values above maximum cutoff to Transpercent
							}
							if LTransPercent < FTransMinCutoff  then LTransPercent := 0;
							if LTransPercent > FTransMaxCutoff then LTransPercent := FTransPercent;
							//ensure that remainder of the picture is shown at transparency value
							if LTransPercent < FTranspercent then LTransPercent := FTranspercent;
						end;

						LTransPercent := CalculateTransFade(X div 3,Y,LTransPercent);
						{
							Inverts the transparency values. Transparent area's become opaque and
							vice versa.
						}
						if FInverse then LTransPercent := 100 - LTransPercent;
						//Once the transparency is calculated the actual merge calculation is done
						//Merging Blue
						LCombinedScan[x] := CalcPartValue(LForeScan[X],LBackScan[X],LTransPercent);
						//Merging Green
						LCombinedScan[x+1] := CalcPartValue(LForeScan[X+1],LBackScan[X+1],LTransPercent);
						//Merging Red
						LCombinedScan[x+2] := CalcPartValue(LForeScan[X+2],LBackScan[X+2],LTransPercent);
					end;
				//jump to the next pixel by skipping 3 bytes (remember 24 bit/3 bytes per pixel?)
				inc(X,3);
			end;
		end;
	end;
	Canvas.Draw(0,0,FCombined);
	FForeground.Free;
	FCombined.Free;
end;

function TCustomTransCanvas.CalculateTransFade(PX,PY: Integer; PTransPercent: Integer): Integer;
var
	FactorX,FactorY: double;
	LHalf: Integer;
begin
	case FTransFade of
		tfNone:
			begin
			Result := PTransPercent;
			exit;
			end;
		tfLeft:
			begin
			Result := 100 - round( bias((PX / Width),FTransBias) * (100 - PTransPercent));
			exit;
			end;
		tfRight:
			begin
			Result := 100 - round( bias((1 - PX / Width),FTransBias) * (100 - PTransPercent));
			exit;
			end;
		tfUp:
			begin
			Result := 100 - round(bias((PY / Height),FTransBias) * (100 - PTransPercent));
			exit;
			end;
		tfDown:
			begin
			Result := 100 - round(bias((1 - PY / Height),FTransBias) * (100 - PTransPercent));
			exit;
			end;
		tfLeftUp:
			begin
			Result := 100 - round( bias((PX / Width) * (PY / Height),FTransBias) * (100 - PTransPercent));			if Result > 100 then Result := 100;
			end;
		tfLeftDown:
			begin
			Result := 100 - round( bias((PX / Width) * (1 - (PY / Height)),FTransBias) * (100 - PTransPercent));			if Result > 100 then Result := 100;
			end;
		tfRightDown:
			begin
			Result := 100 - round( bias((1 - (PX / Width)) * (1 - (PY / Height)),FTransBias) * (100 - PTransPercent));			if Result > 100 then Result := 100;
			end;
		tfRightUp:
			begin
			Result := 100 - round( bias((1 - (PX / Width)) * (PY / Height),FTransBias) * (100 - PTransPercent));			if Result > 100 then Result := 100;
			end;
		tfCenter:
			begin
				LHalf := Height div 2;
				if LHalf > 0 then begin
					FactorX := round(Sqrt(Sqr(LHalf - PY) + Sqr((PX - (Width div 2)) * (Height / Width))));
					if FactorX > LHalf then FactorX := LHalf;
					Result := 100 - round(bias((1 - FactorX / LHalf),FTransBias) * (100 - PTranspercent));
				end;
			end;
		tfPeak:
			begin
				FactorY := PY / (Height div 2);
				if FactorY > 1 then FactorY := 2 - FactorY;
				FactorX := PX / (Width div 2);
				if FactorX > 1 then FactorX := 2 - FactorX;
				Result := 100 - round((100 - PTransPercent) * bias((FactorX * FactorY),FTransBias));
			end;
		tfHorizon:
			begin
				FactorY := PY / (Height div 2);
				if FactorY > 1 then FactorY := 2 - FactorY;
				Result := 100 - round((100 - PTransPercent) * bias(FactorY,FTransBias));
			end;
		tfVertical:
			begin
				FactorX := PX / (Width div 2);
				if FactorX > 1 then FactorX := 2 - FactorX;
				Result := 100 - round((100 - PTransPercent) * bias(FactorX,FTransBias));
			end;
		tfButton:
			begin
				if (PX >= PY) and (PY < Height div 2) and ((PX - Width)+PY < 0) then
					Result := 80  //Top
				else if (PX + (PY - Height) >= 0) and (PY > Height - (Height div 2)) and ((PX - Width) < (PY - Height)) then
					Result := 30 //Bottom
				else if (PX <= PY) and (PX < Width div 2) and (PX + (PY - Height) < 0) then
					Result := 60 //Left
				else if ((PX - Width)+PY >= 0)  and (PX >= Width - (Width div 2)) and ((PX - Width) >= (PY - Height)) then
					Result := 40  //Right
				else Result := 0;
				exit;
			end;
		tfRoundbutton:
			begin
				if (PX >= PY) and (PY < canvas.pen.width) and ((PX - Width)+PY < 0) then
					Result := 50 + round(40 * (1 - (PY / canvas.pen.width)))  //Top
				else if (PX + (PY - Height) >= 0) and (PY >= Height - canvas.pen.width) and ((PX - Width) < (PY - Height)) then
					Result := round(50 - round(30 * (1 - ((Height - PY) / canvas.pen.width))))
				else if (PX <= PY) and (PX < canvas.pen.width) and (PX + (PY - Height) < 0) then
					Result := 50 + round(20 * (1 - (PX / canvas.pen.width)))  //Left
				else if ((PX - Width)+PY >= 0)  and (PX >= Width - canvas.pen.width) and ((PX - Width) >= (PY - Height)) then
					Result := 50 - round(20 * (1 - ((Width - PX) / canvas.pen.width)))  //Right
				else Result := 0;
				exit;
			end;
	end;
end;

procedure TCustomTransCanvas.paint;
begin
	//Produce the resulting output bitmap by merging foreground and background
	CanvasToBitmap;
	PaintTransArea;
	//Paint a dashed line around the control to show the boundaries when not painted
	if csDesigning in ComponentState then
	with Canvas do begin
		Pen.Style := psDash;
		Brush.Style := bsClear;
		Rectangle(0, 0, Width, Height);
	end;
end;

procedure TCustomTransCanvas.DoPaint(PCanvas: TCanvas);
begin
	{
		this is a little trick (be it limiting) to support painting on a transparent
		canvas. Only the painted stuff after this will be rendered semitransparent.
	}
	if FTransType = ttNone then PCanvas.Draw(0,0,FBackGround);
	if assigned(FonPaint) then begin
		FOnPaint(self,PCanvas);
	end;
end;

procedure TCustomTransCanvas.SetTransType(Value: TTransType);
begin
	if Value = FTransType then exit;
	FTransType := Value;
	invalidate;
end;

procedure TCustomTransCanvas.SetTransPercent(Value: Integer);
begin
	if Value = FTransPercent then exit;
	if (Value < 0) or (value > 100) then exit;
	FTransPercent := Value;
	if FTransType in [ttAlpha,ttRed,ttGreen,ttBlue,ttNone] then begin
		PaintTransArea;
	end;
end;

procedure TCustomTransCanvas.SetTransMinCutoff(Value: Integer);
begin
	if Value = FTransMinCutoff then exit;
	if (Value < 0) or (value > 100) then exit;
	FTransMinCutoff := Value;
	if FTransType in [ttAlpha,ttRed,ttGreen,ttBlue] then begin
		PaintTransArea;
	end;
end;

procedure TCustomTransCanvas.SetTransMaxCutoff(Value: Integer);
begin
	if Value = FTransMaxCutoff then exit;
	if (Value < 0) or (value > 100) then exit;
	FTransMaxCutoff := Value;
	if FTransType in [ttAlpha,ttRed,ttGreen,ttBlue] then begin
		PaintTransArea;
	end;
end;

procedure TCustomTransCanvas.SetTransKeyColor(Value: TColor);
begin
	if Value = FTransKeyColor then exit;
	FTransKeyColor := Value;
	if FTransType = ttKey then begin
		PaintTransArea;
	end;
end;

procedure TCustomTransCanvas.SetInverse(Value: Boolean);
begin
	if Value = FInverse then exit;
	FInverse := Value;
	invalidate;
end;

procedure TCustomTransCanvas.Refresh;
begin
	PaintTransArea;
end;

procedure TCustomTransCanvas.SetTransBand(Value: Integer);
begin
	if Value <> FTRansBand then begin
		FTransBand := Value;
		Invalidate;
	end;
end;

procedure TCustomTransCanvas.SetTransFade(Value: TTransFade);
begin
	if Value <> FTransFade then begin
		FTransFade := Value;
		Invalidate;
	end;
end;

{
	This function Biases PValue. assuming PValue in the range of 0 to 1
	Bias can be positive or negative ranging from 1 through 0 to -1
	A Bias of 0 will not modify PValue.	Result will range between 0 and 1
}
function TCustomTransCanvas.bias(PValue,PBias: Double):Double;
begin
	//Invalid values means not bias calculation
	if (PBias <= 1) and (PBias >= -1) and (PValue >=0) and (PValue <= 1) then begin
		// a Bias of 0 is a linear relationship. Let's save some time here
		if PBias = 0 then begin
			Result := PValue;
			exit;
		end;
		//PBias ranges from 1 through 0 to -1. Actual bias should be between 0 and 1
		if PBias >= 0 then begin
			//Positive bias
			Result := Power(PValue,1 - PBias);
		end else begin
			//mirrored positive bias
			Result := 1 - power(1 - PValue,1 + PBias);
		end;
	end else begin
		Result := PValue;
	end;
end;

procedure TCustomTransCanvas.SetTransBiasPercent(Value: Integer);
begin
	if Value <> FTransBiasPercent then begin
		FTransBiasPercent := Value;
		FTransBias := FTransBiasPercent / 100;
		PaintTransArea;
	end;
end;

procedure TCustomTransCanvas.SetScreenBiasPercent(Value: Integer);
begin
	if Value <> FScreenBiasPercent then begin
		FScreenBiasPercent := Value;
		FScreenBias := FScreenBiasPercent / 100;
		PaintTransArea;
	end;
end;

procedure TCustomTransCanvas.SetCanvasType(Value: TCanvasType);
begin
	if Value <> FCanvasType then begin
		FCanvasType := Value;
		Invalidate;
	end;
end;

end.