⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 teeprocs.pas

📁 TeeChart7Source 控件
💻 PAS
📖 第 1 页 / 共 5 页
字号:
  SaveToMetaFileRect(False,FileName,GetRectangle);
end;

Procedure TCustomTeePanel.SaveToMetafileEnh(Const FileName:String);
begin
  SaveToMetaFileRect(True,FileName,GetRectangle);
end;

{ Enhanced:Boolean }
Procedure TCustomTeePanel.SaveToMetafileRect( Enhanced:Boolean;
                                              Const FileName:String;
                                              Const Rect:TRect);
Var tmpStream : TFileStream;
Begin
  With TeeCreateMetafile(Enhanced,Rect) do
  try
    tmpStream:=TFileStream.Create(FileName,fmCreate);
    try
      SaveToStream(tmpStream);
    finally
      tmpStream.Free;
    end;
  finally
    Free;
  end;
End;

Procedure TCustomTeePanel.NonBufferDraw(ACanvas:TCanvas; Const R:TRect);
var Old : Boolean;
begin
  Old:=BufferedDisplay;
  try
    BufferedDisplay:=False;
    Draw(ACanvas,R);
  finally
    BufferedDisplay:=Old;
  end;
end;

Function TCustomTeePanel.TeeCreateBitmap(ABackColor:TColor; Const Rect:TRect;
                                         APixelFormat:{$IFNDEF CLX}Graphics.{$ENDIF}TPixelFormat=
                                         {$IFDEF CLX}TeePixelFormat{$ELSE}pfDevice{$ENDIF}
                                         ):TBitmap;
begin
  result:=TBitmap.Create;
  With result do
  begin
    {$IFNDEF CLX}
    IgnorePalette:=PixelFormat=TeePixelFormat;
    {$ENDIF}

    if InternalCanvas.SupportsFullRotation then
       PixelFormat:=TeePixelFormat
    else
       PixelFormat:=APixelFormat;

    Width:=Rect.Right-Rect.Left;
    Height:=Rect.Bottom-Rect.Top;

    if ABackColor<>clWhite then
    begin
      Canvas.Brush.Color:=ABackColor;
      Canvas.FillRect(Rect);
    end;

    NonBufferDraw(Canvas,Rect);
  end;
end;

Procedure TCustomTeePanel.SaveToBitmapFile(Const FileName:String);
Begin
  SaveToBitmapFile(FileName,GetRectangle);
End;

Procedure TCustomTeePanel.SaveToBitmapFile(Const FileName:String; Const R:TRect);
begin
  With TeeCreateBitmap(clWhite,R) do
  try
    SaveToFile(FileName);
  finally
    Free;
  end;
end;

Procedure TCustomTeePanel.PrintPortrait;
Begin
  PrintOrientation(poPortrait);
end;

Procedure TCustomTeePanel.PrintLandscape;
Begin
  PrintOrientation(poLandscape);
end;

Procedure TCustomTeePanel.PrintOrientation(AOrientation:TPrinterOrientation);
Var OldOrientation : TPrinterOrientation;
Begin
  OldOrientation:=Printer.Orientation;
  Printer.Orientation:=AOrientation;
  try
    Print;
  finally
    Printer.Orientation:=OldOrientation;
  end;
end;

Procedure TCustomTeePanel.CopyToClipboardBitmap(Const R:TRect);
var tmpBitmap : TBitmap;
begin
  tmpBitmap:=TeeCreateBitmap(clWhite,R);
  try
    ClipBoard.Assign(tmpBitmap);
  finally
    tmpBitmap.Free;
  end;
end;

Procedure TCustomTeePanel.CopyToClipboardBitmap;
begin
  CopyToClipboardBitmap(GetRectangle);
end;

Procedure TCustomTeePanel.CopyToClipboardMetafile( Enhanced:Boolean;
                                                   Const R:TRect);
Var tmpMeta : TMetaFile;
begin
  tmpMeta:=TeeCreateMetafile(Enhanced,R);
  try
    ClipBoard.Assign(tmpMeta);
  finally
    tmpMeta.Free;
  end;
end;

Procedure TCustomTeePanel.CopyToClipboardMetafile(Enhanced:Boolean);
begin
  CopyToClipboardMetafile(Enhanced,GetRectangle);
end;

Procedure TCustomTeePanel.CalcMetaBounds( Var R:TRect;
                                          Const AChartRect:TRect;
                                          Var WinWidth,WinHeight,
                                          ViewWidth,ViewHeight:Integer);
Var tmpRectWidth  : Integer;
    tmpRectHeight : Integer;
begin  { apply PrintResolution to the desired rectangle coordinates }
  RectSize(R,ViewWidth,ViewHeight);
  RectSize(AChartRect,tmpRectWidth,tmpRectHeight);
  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;
      tmpDefaultMargin : Double;
  begin
    if tmpPrinterOk then
       tmpPrinterRatio:= TeeGetDeviceCaps(Printer.Handle,LOGPIXELSX)/
                         TeeGetDeviceCaps(Printer.Handle,LOGPIXELSY)
    else
       tmpPrinterRatio:= 1;

    tmpDefaultMargin:=(2.0*TeeDefault_PrintMargin)*Size1*0.01;   // 7.0

    result:=Round(100.0*(Size2-((Size1-tmpDefaultMargin)*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.FrontPlaneBegin;

  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;
        if tmp mod 2=1 then Dec(tmp);
        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;

  Canvas.FrontPlaneEnd;
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

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -