teeprocs.pas

来自「Delphi TeeChartPro.6.01的源代码」· PAS 代码 · 共 2,156 行 · 第 1/5 页

  WinWidth :=tmpRectWidth -MulDiv(tmpRectWidth, PrintResolution,100);
  WinHeight:=tmpRectHeight-MulDiv(tmpRectHeight,PrintResolution,100);
  With R do
  begin
    Left  :=MulDiv(Left  ,WinWidth,ViewWidth);
    Right :=MulDiv(Right ,WinWidth,ViewWidth);
    Top   :=MulDiv(Top   ,WinHeight,ViewHeight);
    Bottom:=MulDiv(Bottom,WinHeight,ViewHeight);
  end;
end;

Procedure TCustomTeePanel.PrintPartialCanvas( PrintCanvas:TCanvas;
                                              Const PrinterRect:TRect);
Var ViewWidth   : Integer;
    ViewHeight  : Integer;
    WinWidth    : Integer;
    WinHeight   : Integer;
    tmpR        : TRect;
    {$IFNDEF CLX}
    OldMapMode  : Integer;
    {$ENDIF}

  Procedure SetAnisotropic; { change canvas/windows metafile mode }
  {$IFNDEF CLX}
  Var DC : HDC;
  {$ENDIF}
  begin
    {$IFNDEF CLX}
    DC:=PrintCanvas.Handle;
    OldMapMode:=GetMapMode(DC);
    SetMapMode(DC, MM_ANISOTROPIC);
    SetWindowOrgEx(  DC, 0, 0, nil);
    SetWindowExtEx(  DC, WinWidth, WinHeight, nil);
    SetViewportExtEx(DC, ViewWidth,ViewHeight, nil);
    SetViewportOrgEx(DC, 0, 0, nil);
    {$ENDIF}
  end;

Begin
  { check if margins inverted }
  tmpR:=OrientRectangle(PrinterRect);

  { apply PrintResolution to dimensions }
  CalcMetaBounds(tmpR,GetRectangle,WinWidth,WinHeight,ViewWidth,ViewHeight);

  {//SaveDC}
  SetAnisotropic;
  FPrinting:=True;
  try
    if CanClip then ClipCanvas(PrintCanvas,tmpR);
    DrawToMetaCanvas(PrintCanvas,tmpR);
    UnClipCanvas(PrintCanvas);
  finally
    FPrinting:=False;
  end;
  {$IFNDEF CLX}
  SetMapMode(PrintCanvas.Handle,OldMapMode);
  {$ENDIF}
  {//RestoreDC}
end;

Procedure TCustomTeePanel.PrintPartial(Const PrinterRect:TRect);
Begin
  PrintPartialCanvas(Printer.Canvas,PrinterRect);
End;

Procedure TCustomTeePanel.PrintRect(Const R:TRect);
Begin
  if Name<>'' then Printer.Title:=Name;
  Printer.BeginDoc;
  try
    PrintPartial(R);
    Printer.EndDoc;
  except
    on Exception do
    begin
      Printer.Abort;
      if Printer.Printing then Printer.EndDoc;
      Raise;
    end;
  end;
end;

Function TCustomTeePanel.CalcProportionalMargins:TRect;
var tmpPrinterOk : Boolean;

  Function CalcMargin(Size1,Size2:Integer; Const ARatio:Double):Integer;
  Var tmpPrinterRatio : Double;
  begin
    if tmpPrinterOk then
       tmpPrinterRatio:= TeeGetDeviceCaps(Printer.Handle,LOGPIXELSX)/
                         TeeGetDeviceCaps(Printer.Handle,LOGPIXELSY)
    else
       tmpPrinterRatio:= 1;

    result:=Round(100.0*(Size2-((Size1-(40.0*Size1*0.01))*ARatio*tmpPrinterRatio))/Size2) div 2;
  end;

Var tmp         : Integer;
    tmpWidth    : Integer;
    tmpHeight   : Integer;
    tmpPrinterW : Integer;  { 5.03 }
    tmpPrinterH : Integer;
begin
  With GetRectangle do
  begin
    tmpWidth:=Right-Left;
    tmpHeight:=Bottom-Top;
  end;

  tmpPrinterOk:=True;

  try
    tmpPrinterW:=Printer.PageWidth;
    tmpPrinterH:=Printer.PageHeight;
  except
    on EPrinter do
    begin
      tmpPrinterOk:=False;
      tmpPrinterW:=Screen.Width;
      tmpPrinterH:=Screen.Height;
    end;
  end;

  if tmpWidth > tmpHeight then
  begin
    tmp:=CalcMargin(tmpPrinterW,tmpPrinterH,tmpHeight/tmpWidth);
    Result:=TeeRect(TeeDefault_PrintMargin,tmp,TeeDefault_PrintMargin,tmp);
  end
  else
  begin
    tmp:=CalcMargin(tmpPrinterH,tmpPrinterW,tmpWidth/tmpHeight);
    Result:=TeeRect(tmp,TeeDefault_PrintMargin,tmp,TeeDefault_PrintMargin);
  end;
end;

Function TCustomTeePanel.ChartPrintRect:TRect;
Var tmpLog : Array[Boolean] of Integer;

  Function InchToPixel(Horizontal:Boolean; Const Inch:Double):Integer;
  begin
    result:=Round(Inch*tmpLog[Horizontal]);
  end;

Var tmp : Double;
Begin
  if FPrintProportional then PrintMargins:=CalcProportionalMargins;
  { calculate margins in pixels and calculate the remaining rectangle in pixels }
  tmpLog[True] :=TeeGetDeviceCaps(Printer.Handle,LOGPIXELSX);
  tmpLog[False]:=TeeGetDeviceCaps(Printer.Handle,LOGPIXELSY);
  With result do
  Begin
    tmp   :=0.01*Printer.PageWidth/(1.0*tmpLog[True]);
    Left  :=InchToPixel(True,1.0*PrintMargins.Left*tmp);
    Right :=Printer.PageWidth-InchToPixel(True,1.0*PrintMargins.Right*tmp);

    tmp   :=0.01*Printer.PageHeight/(1.0*tmpLog[False]);
    Top   :=InchToPixel(False,1.0*PrintMargins.Top*tmp);
    Bottom:=Printer.PageHeight-InchToPixel(False,1.0*PrintMargins.Bottom*tmp);
  end;
end;

Procedure TCustomTeePanel.Print;
Begin
  PrintRect(ChartPrintRect);
end;

Procedure TCustomTeePanel.CheckPenWidth(APen:TPen);
begin
  if Printing and TeeCheckPenWidth and (APen.Style<>psSolid) and (APen.Width=1) then
     APen.Width:=0;  { <-- fixes some printer's bug (HP Laserjets?) }
end;

Procedure DrawBevel(Canvas:TTeeCanvas; Bevel:TPanelBevel; var R:TRect;
                    Width:Integer; Round:Integer=0);
Const Colors:Array[Boolean] of TColor=(clBtnHighlight,clBtnShadow);
begin
  if Bevel<>bvNone then
     if Round>0 then
     begin
       Canvas.Pen.Color:=Colors[Bevel=bvLowered];
       Canvas.RoundRect(R,Round,Round);
       InflateRect(R,-Width,-Width);
     end
     else Canvas.Frame3D(R,Colors[Bevel=bvLowered],Colors[Bevel=bvRaised],Width);
end;

Procedure TCustomTeePanel.DrawPanelBevels(Rect:TRect);
var tmp : Integer;
    tmpHoriz : Integer;
begin
  Canvas.Brush.Style:=bsClear;

  if Border.Visible then
  begin
    Canvas.AssignVisiblePen(Border);

    if Border.SmallDots then tmp:=1
    else
    begin // Fix big pen width
      tmp:=Border.Width-1;
      if tmp>0 then
      begin
        tmpHoriz:=tmp div 2;
        if tmp mod 2=1 then Inc(tmpHoriz);
        tmp:=tmp div 2;
        Inc(Rect.Left,tmpHoriz);
        Inc(Rect.Top,tmpHoriz);
        Dec(Rect.Right,tmp);
        Dec(Rect.Bottom,tmp);
      end;
    end;

    if BorderRound>0 then
    begin
      Dec(Rect.Right);
      Dec(Rect.Bottom);
      Canvas.RoundRect(Rect,BorderRound,BorderRound)
    end
    else
    begin
      Canvas.Rectangle(Rect);
      if not Border.SmallDots then Inc(tmp);
    end;

    InflateRect(Rect,-tmp,-tmp);
  end;

  if (not Printing) or PrintTeePanel then
  begin
    With Canvas.Pen do
    begin
      Style:=psSolid;
      Width:=1;
      Mode:=pmCopy;
    end;

    DrawBevel(Canvas,BevelOuter,Rect,BevelWidth,BorderRound);

    if BorderWidth>0 then
       Canvas.Frame3D(Rect, Color, Color, BorderWidth);

    DrawBevel(Canvas,BevelInner,Rect,BevelWidth,BorderRound);
  end;
end;

{$IFDEF CLX}
function TCustomTeePanel.WidgetFlags: Integer;
begin
  result:=inherited WidgetFlags or
          Integer(WidgetFlags_WRepaintNoErase) or
          Integer(WidgetFlags_WResizeNoErase);
end;
{$ENDIF}

Function TTeeZoomPen.IsColorStored:Boolean;
begin
  result:=Color<>DefaultColor;
end;

{ TTeeZoom }
Constructor TTeeZoom.Create;
begin
  inherited;
  FAnimatedSteps:=8;
  FAllow:=True;
  FDirection:=tzdBoth;
  FMinimumPixels:=16;
  FMouseButton:=mbLeft;
end;

Destructor TTeeZoom.Destroy;
Begin
  FPen.Free;
  FBrush.Free;
  inherited;
end;

Procedure TTeeZoom.Assign(Source:TPersistent);
begin
  if Source is TTeeZoom then
  With TTeeZoom(Source) do
  begin
    Self.FAllow        := FAllow;
    Self.FAnimated     := FAnimated;
    Self.FAnimatedSteps:= FAnimatedSteps;
    Self.Brush         := FBrush;
    Self.FDirection    := FDirection;
    Self.FKeyShift     := FKeyShift;
    Self.FMouseButton  := FMouseButton;
    Self.Pen           := FPen;
  end;
end;

procedure TTeeZoom.SetBrush(Value:TTeeZoomBrush);
begin
  if Assigned(Value) then Brush.Assign(Value)
                     else FreeAndNil(FBrush);
end;

procedure TTeeZoom.SetPen(Value:TTeeZoomPen);
begin
  if Assigned(Value) then Pen.Assign(Value)
                     else FreeAndNil(FPen);
end;

Function TTeeZoom.GetBrush:TTeeZoomBrush;
begin
  if not Assigned(FBrush) then
  begin
    FBrush:=TTeeZoomBrush.Create(nil);
    FBrush.Color:=clWhite;
    FBrush.Style:=bsClear;
  end;
  result:=FBrush;
end;

Function TTeeZoom.GetPen:TTeeZoomPen;
begin
  if not Assigned(FPen) then
  begin
    FPen:=TTeeZoomPen.Create(nil);
    FPen.Color:=clWhite;
    FPen.DefaultColor:=clWhite;
  end;
  result:=FPen;
end;

{ TCustomTeePanelExtended }
Constructor TCustomTeePanelExtended.Create(AOwner: TComponent);
begin
  inherited;

  FBackImageMode:=pbmStretch;
  FAllowPanning:=pmBoth;
  FZoom:=TTeeZoom.Create;
end;

Destructor TCustomTeePanelExtended.Destroy;
Begin
  FZoom.Free;
  FGradient.Free;
  FBackImage.Free;
  inherited;
end;

Procedure TCustomTeePanelExtended.SetAnimatedZoom(Value:Boolean);
Begin
  FZoom.Animated:=Value;
end;

Procedure TCustomTeePanelExtended.SetAnimatedZoomSteps(Value:Integer);
Begin
  FZoom.AnimatedSteps:=Value;
end;

Function TCustomTeePanelExtended.GetBackImage:TPicture;
begin
  if not Assigned(FBackImage) then
  begin
    FBackImage:=TPicture.Create;
    FBackImage.OnChange:=CanvasChanged;
  end;
  result:=FBackImage;
end;

procedure TCustomTeePanelExtended.SetBackImage(const Value:TPicture);
begin
  if Assigned(Value) then BackImage.Assign(Value)
                     else FreeAndNil(FBackImage);
end;

procedure TCustomTeePanelExtended.SetBackImageInside(Const Value:Boolean);
begin
  SetBooleanProperty(FBackImageInside,Value);
end;

procedure TCustomTeePanelExtended.SetBackImageMode(Const Value:TTeeBackImageMode);
Begin
  if FBackImageMode<>Value then
  begin
    FBackImageMode:=Value;
    Invalidate;
  end;
End;

function TCustomTeePanelExtended.HasBackImage:Boolean;
begin
  result:=Assigned(FBackImage) and Assigned(FBackImage.Graphic);
end;

procedure TCustomTeePanelExtended.SetBackImageTransp(Const Value:Boolean);
begin
  if HasBackImage then { 5.03 }
     FBackImage.Graphic.Transparent:=Value; { 5.02 }
end;

procedure TCustomTeePanelExtended.UndoZoom;
begin
  if Assigned(FOnUndoZoom) then FOnUndoZoom(Self);
  Invalidate;
  FZoomed:=False;
end;

Function TCustomTeePanelExtended.GetGradient:TChartGradient;
begin
  if not Assigned(FGradient) then
     FGradient:=TChartGradient.Create(CanvasChanged);
  result:=FGradient;
end;

procedure TCustomTeePanelExtended.SetGradient(Value:TChartGradient);
begin
  if Assigned(Value) then Gradient.Assign(Value)
                     else FreeAndNil(FGradient);
end;

Procedure TCustomTeePanelExtended.Assign(Source:TPersistent);
begin
  if Source is TCustomTeePanelExtended then
  With TCustomTeePanelExtended(Source) do
  begin
    Self.BackImage        := FBackImage;
    Self.FBackImageInside := FBackImageInside;
    Self.FBackImageMode   := FBackImageMode;
    Self.Gradient         := FGradient;
    Self.FAllowPanning    := FAllowPanning;
    Sel