teeprocs.pas

第三方控件：PaintGrid.pas 网格型仪表控件源文件 Mymeter.pas 圆型仪表控件源文件 Project1是这两个控件的使用范例。 该

begin
  FBorder.Visible:=Value=bsSingle;
end;

Procedure TCustomTeePanel.SetBufferedDisplay(Value:Boolean);
begin
  InternalCanvas.UseBuffer:=Value;
end;

Procedure TCustomTeePanel.SetInternalCanvas(NewCanvas:TCanvas3D);
var Old : Boolean;
begin
  if Assigned(NewCanvas) then
  begin
    NewCanvas.ReferenceCanvas:=FDelphiCanvas;

    if Assigned(InternalCanvas) then
    begin
      Old:=AutoRepaint; { 5.02 }
      AutoRepaint:=False;
      NewCanvas.Assign(InternalCanvas);
      AutoRepaint:=Old; { 5.02 }
      InternalCanvas.Free;
    end;

    InternalCanvas:=NewCanvas;

    if AutoRepaint then Repaint; { 5.02 }
  end;
end;

procedure TCustomTeePanel.RecalcWidthHeight;
Begin
  With ChartRect do
  begin
    if Left<FChartBounds.Left then Left:=FChartBounds.Left;
    if Top<FChartBounds.Top then Top:=FChartBounds.Top;
    if Right<Left then Right:=Left+1 else
    if Right=Left then Right:=Left+Width;
    if Bottom<Top then Bottom:=Top+1 else
    if Bottom=Top then Bottom:=Top+Height;
    FChartWidth  :=Right-Left;
    FChartHeight :=Bottom-Top;
  end;

  RectCenter(ChartRect,FChartXCenter,FChartYCenter);
end;

Function TCustomTeePanel.GetCursorPos:TPoint;
Begin
  // Mouse.CursorPos problem in D7 when switching XP themes.
  result:=ScreenToClient(Mouse.CursorPos);
end;

Function TCustomTeePanel.GetRectangle:TRect;
begin
  if Assigned(Parent) then result:=GetClientRect
                      else result:=TeeRect(0,0,Width,Height); // 5.02
end;

Procedure TCustomTeePanel.DrawToMetaCanvas(ACanvas:TCanvas; Const Rect:TRect);
begin  { assume the acanvas is in MM_ANISOTROPIC mode }
  InternalCanvas.Metafiling:=True;
  try
    NonBufferDraw(ACanvas,Rect);
  finally
    InternalCanvas.Metafiling:=False;
  end;
end;

Function TCustomTeePanel.GetMonochrome:Boolean;
Begin
  result:=InternalCanvas.Monochrome;
end;

Procedure TCustomTeePanel.SetMarginUnits(const Value:TTeeUnits);
begin
  if FMarginUnits<>Value then
  begin
    FMarginUnits:=Value;
    Invalidate;
  end;
end;

Procedure TCustomTeePanel.SetMonochrome(Value:Boolean);
Begin
  InternalCanvas.Monochrome:=Value;
end;

Procedure TCustomTeePanel.Assign(Source:TPersistent);
begin
  if Source is TCustomTeePanel then
  With TCustomTeePanel(Source) do
  begin
    Self.Border             := Border;
    Self.BorderRound        := BorderRound;
    Self.BufferedDisplay    := BufferedDisplay;
    Self.PrintMargins       := PrintMargins;
    Self.FPrintProportional := FPrintProportional;
    Self.FPrintResolution   := FPrintResolution;
    Self.FMargins           := FMargins;
    Self.FMarginUnits       := FMarginUnits; // 6.01.1
    Self.Monochrome         := Monochrome;
    Self.Shadow             := Shadow;
    Self.FView3D            := FView3D;
    Self.View3DOptions      := FView3DOptions;
    Self.Color              := Color;
  end
  else inherited;
end;

Procedure TCustomTeePanel.SaveToMetafile(Const FileName:String);
begin
  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:TBitmap;
begin
  result:=TeeCreateBitmap(Color,GetRectangle);
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
    {$IFDEF IGNOREPALETTE}
    IgnorePalette:=PixelFormat=TeePixelFormat;
    {$ENDIF}

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

    {$IFDEF D10}
    SetSize(Rect.Right-Rect.Left,Rect.Bottom-Rect.Top);
    {$ELSE}
    Width:=Rect.Right-Rect.Left;
    Height:=Rect.Bottom-Rect.Top;
    {$ENDIF}

    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);

    if Assigned(FOnBeforePrint) then
       FOnBeforePrint(Self,PrintCanvas,tmpR);  // 7.01

    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
       {$IFDEF LCL}
       with Printer.PaperSize.PaperRect.WorkRect do
            tmpPrinterRatio:= (Right-Left)/(Bottom-Top)
       {$ELSE}
       tmpPrinterRatio:= TeeGetDeviceCaps(Printer.Handle,LOGPIXELSX)/
                         TeeGetDeviceCaps(Printer.Handle,LOGPIXELSY)
       {$ENDIF}
    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;

  {$IF