tecanvas.pas
来自「Delphi TeeChartPro.6.01的源代码」· PAS 代码 · 共 2,088 行 · 第 1/5 页
PAS
2,088 行
FVertOffset:=Value;
Repaint;
if Assigned(FOnScrolled) then FOnScrolled(False);
end;
end;
Procedure TView3DOptions.SetOrthoAngle(Value:Integer);
begin
SetIntegerProperty(FOrthoAngle,Value);
end;
Procedure TView3DOptions.SetOrthogonal(Value:Boolean);
begin
SetBooleanProperty(FOrthogonal,Value);
end;
Procedure TView3DOptions.SetZoom(Value:Integer);
begin
if FZoom<>Value then
begin
if Assigned(FOnChangedZoom) then FOnChangedZoom(Value);
FZoom:=Value;
Repaint;
end;
end;
Procedure TView3DOptions.SetZoomText(Value:Boolean);
begin
SetBooleanProperty(FZoomText,Value);
end;
Procedure TView3DOptions.Assign(Source:TPersistent);
begin
if Source is TView3DOptions then
With TView3DOptions(Source) do
begin
Self.FElevation :=FElevation;
Self.FHorizOffset :=FHorizOffset;
Self.FOrthoAngle :=FOrthoAngle;
Self.FOrthogonal :=FOrthogonal;
Self.FPerspective :=FPerspective;
Self.FRotation :=FRotation;
Self.FTilt :=FTilt;
Self.FVertOffset :=FVertOffset;
Self.FZoom :=FZoom;
Self.FZoomText :=FZoomText;
end;
end;
function TView3DOptions.CalcOrthoRatio: Double;
var tmpSin : Extended;
tmpCos : Extended;
tmpAngle : Extended;
begin
if Orthogonal then
begin
tmpAngle:=OrthoAngle;
if tmpAngle>90 then tmpAngle:=180-tmpAngle;
SinCos(tmpAngle*TeePiStep,tmpSin,tmpCos);
result:=tmpSin/tmpCos;
end
else result:=1;
end;
{ TTeeCanvas }
Procedure TTeeCanvas.InternalDark(Const AColor:TColor; Quantity:Byte);
var tmpColor : TColor;
begin
tmpColor:=ApplyDark(AColor,Quantity);
if FBrush.Style=bsSolid then FBrush.Color:=tmpColor
else BackColor:=tmpColor;
end;
Procedure TTeeCanvas.SetCanvas(ACanvas:TCanvas);
begin
FCanvas:=ACanvas;
FPen :=FCanvas.Pen;
FFont :=FCanvas.Font;
FBrush :=FCanvas.Brush;
end;
Function TTeeCanvas.GetBackMode:TCanvasBackMode;
begin
{$IFDEF CLX}
if QPainter_BackgroundMode(Handle)=BGMode_TransparentMode then
result:=cbmTransparent
else
result:=cbmOpaque;
{$ELSE}
result:=TCanvasBackMode(GetBkMode(FCanvas.Handle));
{$ENDIF}
end;
Procedure TTeeCanvas.SetBackMode(Mode:TCanvasBackMode); { Opaque, Transparent }
begin
{$IFDEF CLX}
if Mode<>GetBackMode then
begin
FCanvas.Start;
if Mode=cbmTransparent then QPainter_setBackgroundMode(Handle,BGMode_TransparentMode)
else
if Mode=cbmOpaque then QPainter_setBackGroundMode(Handle,BGMode_OpaqueMode);
FCanvas.Stop;
end;
{$ELSE}
SetBkMode(FCanvas.Handle,Ord(Mode));
{$ENDIF}
end;
Procedure TTeeCanvas.SetBackColor(Color:TColor);
{$IFDEF CLX}
Var QC : QColorH;
{$ENDIF}
begin
{$IFDEF CLX}
if Color<>GetBackColor then
begin
QC:=QColor(Color);
FCanvas.Start;
QPainter_setBackgroundColor(Handle,QC);
FCanvas.Stop;
QColor_destroy(QC);
end;
{$ELSE}
SetBkColor(FCanvas.Handle,TColorRef(ColorToRGB(Color)));
{$ENDIF}
end;
function TTeeCanvas.GetBackColor:TColor;
begin
{$IFDEF CLX}
result:=QColorColor(QPainter_backgroundColor(Handle));
{$ELSE}
result:=TColor(GetBkColor(FCanvas.Handle));
{$ENDIF}
end;
Procedure TTeeCanvas.ResetState;
begin
With FPen do
begin
Color:=clBlack;
Width:=1;
Style:=psSolid;
end;
With FBrush do
begin
Color:=clWhite;
Style:=bsSolid;
end;
With FFont do
begin
Color:=clBlack;
Size:=10;
end;
BackColor:=clWhite;
BackMode:=cbmTransparent;
TextAlign:=TA_LEFT; { 5.01 }
end;
Procedure TTeeCanvas.AssignBrush(ABrush:TChartBrush; ABackColor:TColor);
begin
AssignBrushColor(ABrush,ABackColor,ABrush.Color);
end;
{$IFDEF CLX}
Procedure SetTextColor(Handle:QPainterH; Color:Integer);
var QC : QColorH;
begin
QC:=QColor(Color);
try
QPen_setColor(QPainter_pen(Handle), QC);
finally
QColor_destroy(QC);
end;
end;
{$ENDIF}
Procedure TTeeCanvas.AssignBrushColor(ABrush:TChartBrush; AColor,ABackColor:TColor);
begin
if Monochrome then AColor:=clWhite;
if Assigned(ABrush.FImage) and Assigned(ABrush.FImage.Graphic) then
begin
Brush.Style:=bsClear;
Brush.Bitmap:=ABrush.Image.Bitmap;
SetTextColor(Handle,ColorToRGB(AColor));
BackMode:=cbmOpaque;
BackColor:=ABackColor;
end
else
begin
{$IFDEF CLX}
Brush.Bitmap:=nil;
{$ENDIF}
if AColor<>Brush.Color then { 5.02 }
Brush.Color:=AColor;
if ABrush.Style<>Brush.Style then { 5.02 }
Brush.Style:=ABrush.Style;
if ABackColor=clNone then BackMode:=cbmTransparent { 5.02 }
else
begin
BackMode:=cbmOpaque;
BackColor:=ABackColor;
end;
end;
end;
procedure TTeeCanvas.AssignVisiblePen(APen:TPen);
begin
AssignVisiblePenColor(APen,APen.Color);
end;
Procedure TTeeCanvas.Rectangle(Const R:TRect);
begin
With R do Rectangle(Left,Top,Right,Bottom);
end;
Procedure TTeeCanvas.DoRectangle(Const Rect:TRect); // obsolete
begin
Rectangle(Rect);
end;
Function RGBValue(Color:TColor):TRGBTriple;
begin
with result do
begin
rgbtRed:=Byte(Color);
rgbtGreen:=Byte(Color shr 8);
rgbtBlue:=Byte(Color shr 16);
end;
end;
Function TeeCreatePenSmallDots(AColor:TColor):{$IFDEF CLX}QPenH{$ELSE}HPen{$ENDIF};
{$IFNDEF CLX}
Var LBrush : TLogBrush;
{$ENDIF}
begin
{$IFDEF CLX}
result:=QPen_create(QColor(AColor),1,PenStyle_DotLine);
{$ELSE}
LBrush.lbStyle:=bs_Solid;
LBrush.lbColor:=ColorToRGB(AColor);
result:=ExtCreatePen( PS_COSMETIC or PS_ALTERNATE,1,LBrush,0,nil );
{$ENDIF}
end;
Procedure TeeSetTeePen(FPen:TPen; APen:TChartPen; AColor:TColor);
{$IFNDEF CLX}
const
PenStyles: array[TPenStyle] of Word =
(PS_SOLID, PS_DASH, PS_DOT, PS_DASHDOT, PS_DASHDOTDOT, PS_NULL,
PS_INSIDEFRAME);
Var LBrush : TLogBrush;
{$ENDIF}
{$IFNDEF CLX}
Var tmpEnd : Integer;
{$ENDIF}
begin
if APen.SmallDots then
FPen.Handle:=TeeCreatePenSmallDots(AColor)
else
{$IFNDEF CLX}
if APen.Width>1 then
begin
LBrush.lbStyle:=bs_Solid;
LBrush.lbColor:=ColorToRGB(AColor);
Case APen.EndStyle of { 5.01 }
esRound : tmpEnd:=PS_ENDCAP_ROUND or PS_JOIN_ROUND;
esSquare: tmpEnd:=PS_ENDCAP_SQUARE or PS_JOIN_BEVEL;
else tmpEnd:=PS_ENDCAP_FLAT or PS_JOIN_MITER;
end;
FPen.Handle:=ExtCreatePen( PS_GEOMETRIC or
PenStyles[APen.Style] or tmpEnd,APen.Width,LBrush,0,nil);
FPen.Mode:=APen.Mode;
end
else
{$ENDIF}
begin
FPen.Assign(APen);
//if APen.Style<>FPen.Style then FPen.Style:=APen.Style;
//if APen.Width<>FPen.Width then FPen.Width:=APen.Width;
//if APen.Mode<>FPen.Mode then FPen.Mode:=APen.Mode;
if FPen.Color<>AColor then FPen.Color:=AColor;
end;
end;
procedure TTeeCanvas.AssignVisiblePenColor(APen:TPen; AColor:TColor);
begin
if MonoChrome then AColor:=clBlack;
if not (APen is TChartPen) then
begin
FPen.Assign(APen);
FPen.Color:=AColor;
end
else
if TChartPen(APen).Visible then
begin
{$IFNDEF CLX}
if IsWindowsNT then TeeSetTeePen(FPen,TChartPen(APen),AColor) { only valid in Windows-NT }
else
{$ENDIF}
begin
FPen.Assign(APen);
//if APen.Style<>FPen.Style then FPen.Style:=APen.Style;
//if APen.Width<>FPen.Width then FPen.Width:=APen.Width;
//if APen.Mode<>FPen.Mode then FPen.Mode:=APen.Mode;
FPen.Color:=AColor;
{$IFDEF CLX}
if FPen.Style<>psSolid then BackMode:=cbmTransparent;
{$ENDIF}
end;
end
else FPen.Style:=psClear;
end;
Procedure TTeeCanvas.AssignFont(AFont:TTeeFont);
{$IFNDEF CLX}
var tmp : TTeeCanvasHandle;
{$ENDIF}
Begin
With FFont do
begin
AFont.PixelsPerInch:=PixelsPerInch;
Assign(AFont);
if FontZoom<>100 then // 6.01
Size:=Round(Size*FontZoom*0.01);
end;
if MonoChrome then FFont.Color:=clBlack;
{$IFNDEF CLX}
tmp:=Handle;
if GetTextCharacterExtra(tmp)<>AFont.InterCharSize then
SetTextCharacterExtra(tmp,AFont.InterCharSize);
{$ENDIF}
IFont:=AFont;
AFont.ICanvas:=Self;
End;
Function TTeeCanvas.TextWidth(Const St:String):Integer;
begin
{$IFNDEF CLX}
// ReferenceCanvas.Font.Assign(FFont); 6.01
result:=FCanvas.TextExtent(St).cx;
{$ELSE}
result:=FCanvas.TextWidth(St);
{$ENDIF}
if Assigned(IFont) and Assigned(IFont.FShadow) then
Inc(result,Abs(IFont.FShadow.HorizSize));
end;
Function TTeeCanvas.TextHeight(Const St:String):Integer;
Begin
{$IFNDEF CLX}
// ReferenceCanvas.Font.Assign(FFont); 6.01
result:=FCanvas.TextExtent(St).cy;
{$ELSE}
result:=FCanvas.TextHeight(St);
{$ENDIF}
if Assigned(IFont) and Assigned(IFont.FShadow) then
Inc(result,Abs(IFont.FShadow.VertSize));
end;
Function TTeeCanvas.FontHeight:Integer;
begin
result:=TextHeight(TeeCharForHeight);
end;
procedure TTeeCanvas.Ellipse(const R:TRect);
begin
with R do Ellipse(Left,Top,Right,Bottom);
end;
procedure TTeeCanvas.RoundRect(const R: TRect; X,Y:Integer);
begin
with R do RoundRect(Left,Top,Right,Bottom,X,Y);
end;
procedure TTeeCanvas.Line(const FromPoint, ToPoint: TPoint);
begin
Line(FromPoint.X,FromPoint.Y,ToPoint.X,ToPoint.Y)
end;
Function TTeeCanvas.BeginBlending(const R: TRect;
Transparency: TTeeTransparency):TTeeBlend;
begin
ITransp:=Transparency;
result:=TTeeBlend.Create(Self,R);
end;
procedure TTeeCanvas.EndBlending(Blend:TTeeBlend);
begin
Blend.DoBlend(ITransp);
Blend.Free;
end;
{ TCanvas3D }
Procedure TCanvas3D.Assign(Source:TCanvas3D);
begin
Monochrome:=Source.Monochrome;
end;
function TCanvas3D.CalcRect3D(const R: TRect; Z: Integer): TRect;
begin
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?