teeprocs.pas

BCB第三方组件

begin
  CancelMouse:=False;
  inherited;
  if (Listeners.Count>0) and (not (csDesigning in ComponentState)) then
     BroadcastMouseEvent(meMove,mbLeft,Shift,X,Y);
end;

procedure TCustomTeePanel.DblClick;
begin
  CancelMouse:=False;
  inherited;
  if CancelMouse then Abort;
end;

{$IFNDEF CLR}
type TRectArray=array[0..3] of Integer;
{$ENDIF}

Function TCustomTeePanel.GetMargin(Index:Integer):Integer;
begin
  {$IFDEF CLR}
  case Index of
    0: result:=FMargins.Left;
    1: result:=FMargins.Top;
    2: result:=FMargins.Right;
  else
    result:=FMargins.Bottom;
  end;
  {$ELSE}
  result:=TRectArray(FMargins)[Index];
  {$ENDIF}
end;

Procedure TCustomTeePanel.SetMargin(Index,Value:Integer);
begin
  {$IFDEF CLR}
  case Index of
    0: SetIntegerProperty(FMargins.Left,Value);
    1: SetIntegerProperty(FMargins.Top,Value);
    2: SetIntegerProperty(FMargins.Right,Value);
    3: SetIntegerProperty(FMargins.Bottom,Value);
  end;
  {$ELSE}
  SetIntegerProperty(TRectArray(FMargins)[Index],Value);
  {$ENDIF}
end;

Function TCustomTeePanel.GetBufferedDisplay:Boolean;
begin
  result:=InternalCanvas.UseBuffer;
end;

Procedure TCustomTeePanel.SetBorder(const Value:TChartHiddenPen);
begin
  Border.Assign(Value);
end;

procedure TCustomTeePanel.SetControlRounded;
{$IFDEF CLX}
begin
end;
{$ELSE}
var Region : HRGN;
begin
  if not IRounding then  // re-entrance protection (from Resize method)
  if Assigned(Parent) then // <-- needs Parent to obtain Handle below
  begin
    IRounding:=True;
    try
      if BorderRound>0 then
         Region:=CreateRoundRectRgn(0,0,Width,Height,BorderRound,BorderRound)
      else
         Region:=0;

      SetWindowRgn(Handle,Region,True);
    finally
      IRounding:=False;
    end;
  end;
end;
{$ENDIF}

Procedure TCustomTeePanel.SetBorderRound(Value:Integer);
begin
  if FBorderRound<>Value then
  begin
    FBorderRound:=Value;
    if not (csLoading in ComponentState) then
       SetControlRounded;
  end;
end;

Function TCustomTeePanel.GetBorderStyle:TBorderStyle;
begin
  if FBorder.Visible then result:=bsSingle
                     else result:=bsNone; 
end;

// SetBorderStyle conflicts with LCL. Renamed to SetTheBorderStyle
Procedure TCustomTeePanel.SetTheBorderStyle(Value:TBorderStyle);
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
       Invalidate; // Repaint; { 5.02 }
  end;
end;

procedure TCustomTeePanel.RecalcWidthHeight;
Begin
  With ChartRect do
  begin
    if not CustomChartRect then
    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;
    end;

    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;

{$IFDEF BCB}
Function TCustomTeePanel.GetPrintMargins:TRect;
Begin
  result:=FPrintMargins;
end;
{$ENDIF}

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;

{$IFNDEF CLR}
type
  TTeeCanvas3DAccess=class(TTeeCanvas3D);
{$ENDIF}

Procedure TCustomTeePanel.NonBufferDraw(ACanvas:TCanvas; Const R:TRect);
var Old : Boolean;
begin
  Old:=BufferedDisplay;
  try
    {$IFNDEF CLR}
    if InternalCanvas is TTeeCanvas3D then
       TTeeCanvas3DAccess(InternalCanvas).IKeepBitmap:=True;
    {$ENDIF}

    BufferedDisplay:=False;
    Draw(ACanvas,R);
  finally
    BufferedDisplay:=Old;

    if InternalCanvas is TTeeCanvas3D then
    begin
      {$IFNDEF CLR}
      TTeeCanvas3DAccess(InternalCanvas).IKeepBitmap:=False;
      {$ENDIF}

      Invalidate;
    end;
  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;

    TeeSetBitmapSize(result,Rect.Right-Rect.Left,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_A