teeprocs.pas

BCB第三方组件

end;
{$ENDIF}
{$ENDIF}

Procedure TCustomTeePanel.SetShadow(Value:TTeeShadow);
begin
  FShadow.Assign(Value);
end;

Procedure TCustomTeePanel.InternalDraw(Const UserRectangle:TRect); // virtual; abstract;
begin
end;

procedure TCustomTeePanel.SetView3DOptions(Value:TView3DOptions);
begin
  FView3DOptions.Assign(Value);
end;

procedure TCustomTeePanel.SetView3D(Value:Boolean);
Begin
  if FView3D<>Value then // 6.0
  begin
    SetBooleanProperty(FView3D,Value);
    BroadcastTeeEvent(TTeeView3DEvent.Create).Free;
  end;
end;

Procedure TCustomTeePanel.Draw;
begin
  Draw(FDelphiCanvas,GetClientRect);
end;

type
  TCanvasAccess=class {$IFDEF CLR}sealed{$ENDIF} (TTeeCanvas3D);

Procedure TCustomTeePanel.Draw(UserCanvas:TCanvas; Const UserRect:TRect);

  Procedure AdjustChartBounds;

    Function GetMargin(Value,Range:Integer):Integer;
    begin
      if MarginUnits=muPercent then result:=Value*Range div 100
                               else result:=Value;
    end;

  var tmpW : Integer;
      tmpH : Integer;
      tmpBorder : Integer;
  begin
    RectSize(FChartBounds,tmpW,tmpH);

    // Calculate amount of pixels for border and bevels...
    tmpBorder:=BorderWidth;

    //if Shadow.Visible then Inc(tmpBorder,Shadow.Size);
    if BevelInner<>bvNone then Inc(tmpBorder,BevelWidth);
    if BevelOuter<>bvNone then Inc(tmpBorder,BevelWidth);
    if Border.Visible then Inc(tmpBorder,Border.Width);

    // Apply margins
    if not CustomChartRect then
    With FChartBounds do
    begin
      ChartRect:=TeeRect( Left  + tmpBorder + GetMargin(MarginLeft,tmpW),
                          Top   + tmpBorder + GetMargin(MarginTop,tmpH),
                          Right - tmpBorder - GetMargin(MarginRight,tmpW),
                          Bottom- tmpBorder - GetMargin(MarginBottom,tmpH) );

      if Shadow.Visible then
      begin
        Dec(ChartRect.Right, 2*Shadow.HorizSize);
        Dec(ChartRect.Bottom, 2*Shadow.VertSize);
      end;
    end;

  end;

Begin
  {$IFDEF CLX}
  UserCanvas.Start;
  try
  {$ENDIF}

  FChartBounds:=InternalCanvas.InitWindow(UserCanvas,FView3DOptions,Color,FView3D,UserRect);

  AdjustChartBounds;
  RecalcWidthHeight;
  InternalDraw(FChartBounds);

  {$IFDEF MONITOR_REDRAWS}
  Inc(RedrawCount);
  InternalCanvas.TextAlign:=TA_LEFT;
  InternalCanvas.Font.Size:=8;
  TCanvasAccess(InternalCanvas).IFont:=nil;
  InternalCanvas.TextOut(0,0,TeeStr(RedrawCount));
  {$ENDIF}

  InternalCanvas.ShowImage(UserCanvas,FDelphiCanvas,UserRect);

  {$IFDEF CLX}
  finally
    UserCanvas.Stop;
  end;
  {$ENDIF}
end;

procedure TCustomTeePanel.Paint;

  {$IFDEF TEEOCX}
  procedure TeeFpuInit;
  asm
    FNINIT
    FWAIT
    FLDCW   Default8087CW
  end;
  {$ENDIF}

begin
  {$IFDEF TEEOCX}
  TeeFPUInit;
  {$ENDIF}

  {$IFDEF CLX}
  if csDestroying in ComponentState then Exit;
  {$ENDIF}
  
  if (not FPrinting) and (not InternalCanvas.ReDrawBitmap) then Draw;
end;

{$IFDEF TEE_METAFILE}
type
  TMetafileCanvas=class(TCanvas)
  public
    Constructor Create(Meta:TMetafile; Ref:Integer);
  end;

{ TMetafileCanvas }
Constructor TMetafileCanvas.Create(Meta: TMetafile; Ref: Integer);
begin
  inherited Create;
end;
{$ENDIF}

Function TCustomTeePanel.TeeCreateMetafile( Enhanced:Boolean; Const Rect:TRect ):TMetafile;
var tmpCanvas : TMetafileCanvas;
begin
  result:=TMetafile.Create;
  { bug in Delphi 3.02 : graphics.pas metafile reduces width/height.
    Fixed in Delphi 4.0x and BCB4.  }
  result.Width :=Max(1,Rect.Right-Rect.Left);
  result.Height:=Max(1,Rect.Bottom-Rect.Top);
  result.Enhanced:=Enhanced;
  tmpCanvas:=TMetafileCanvas.Create(result,0);
  try
    DrawToMetaCanvas(tmpCanvas,Rect);
  finally
    tmpCanvas.Free;
  end;
end;

Procedure TCustomTeePanel.SetBrushCanvas( AColor:TColor; ABrush:TChartBrush;
                                          ABackColor:TColor);
begin
  if (ABrush.Style<>bsSolid) and (AColor=ABackColor) then
     if ABackColor=clBlack then
        AColor:=clWhite
     else
        AColor:=clBlack;

  Canvas.AssignBrush(ABrush,AColor,ABackColor);
end;

Function TeeGetDeviceCaps(Handle:{$IFDEF CLX}QPaintDeviceH
                                 {$ELSE}TTeeCanvasHandle
                                 {$ENDIF}; Cap:Integer):Integer;
begin
  {$IFDEF CLX}
  case Cap of
    HORZSIZE: result:=Screen.Width;
    VERTSIZE: result:=Screen.Height;
  else
    result:=1;
  end;
  {$ELSE}
  result:=GetDeviceCaps(Handle,Cap);
  {$ENDIF}
end;

function IsRemoteSession:Boolean;
begin
  {$IFDEF CLX}
  result:=False;
  {$ELSE}
  result:=GetSystemMetrics($1000)<>0;
  {$ENDIF}
end;

function ScreenRatio(ACanvas:TCanvas3D):Double;
var tmpH : Integer;
begin
  // if not IsRemoteSession then ...  // <-- check for Remote Desktop

  tmpH:=TeeGetDeviceCaps({$IFDEF CLX}nil{$ELSE}ACanvas.Handle{$ENDIF},VERTSIZE);

  if tmpH<>0 then
     result:=1.0*TeeGetDeviceCaps({$IFDEF CLX}nil{$ELSE}ACanvas.Handle{$ENDIF},HORZSIZE)/tmpH
  else
     result:=0;
end;

Function TCustomTeePanel.IsScreenHighColor:Boolean;
Begin
  {$IFNDEF CLX}
  With InternalCanvas do
    result:= SupportsFullRotation
             or
             (TeeGetDeviceCaps(Handle,BITSPIXEL)*
              TeeGetDeviceCaps(Handle,PLANES)>=15);
  {$ELSE}
  result:=True;
  {$ENDIF}
End;

Function TCustomTeePanel.CanClip:Boolean;
begin
  result:= (not Canvas.SupportsFullrotation) and
          (
            ((not Printing) and (not Canvas.Metafiling)) or
            (Printing and TeeClipWhenPrinting) or
            (Canvas.Metafiling and TeeClipWhenMetafiling)
          )
end;

Procedure TCustomTeePanel.SetStringProperty(var Variable:String; Const Value:String);
Begin
  if Variable<>Value then
  begin
    Variable:=Value; Invalidate;
  end;
end;

Procedure TCustomTeePanel.SetDoubleProperty(var Variable:Double; Const Value:Double);
begin
  if Variable<>Value then
  begin
    Variable:=Value; Invalidate;
  end;
end;

Procedure TCustomTeePanel.SetColorProperty(var Variable:TColor; Value:TColor);
Begin
  if Variable<>Value then
  begin
    Variable:=Value; Invalidate;
  end;
end;

Procedure TCustomTeePanel.SetBooleanProperty(var Variable:Boolean; Value:Boolean);
Begin
  if Variable<>Value then
  begin
    Variable:=Value; Invalidate;
  end;
end;

Procedure TCustomTeePanel.SetIntegerProperty(var Variable:Integer; Value:Integer);
Begin
  if Variable<>Value then
  begin
    Variable:=Value; Invalidate;
  end;
end;

procedure TCustomTeePanel.ReadBorderStyle(Reader: TReader); // obsolete
begin
  Border.Visible:=Reader.ReadIdent='bsSingle';
end;

Procedure TCustomTeePanel.DefineProperties(Filer:TFiler); // obsolete
begin
  inherited;
  Filer.DefineProperty('BorderStyle',ReadBorderStyle,nil,False);
end;

Function TCustomTeePanel.GetBackColor:TColor;
begin
  result:=Color;
end;

Procedure TCustomTeePanel.Loaded;
begin
  inherited;
  FOriginalCursor:=Cursor; { save cursor }
  if BorderRound>0 then  // 6.01
     SetControlRounded;
end;

{$IFDEF CLX}
procedure TCustomTeePanel.BoundsChanged;
begin
  inherited;
  Invalidate;
end;
{$ENDIF}

{$IFDEF CLX}
procedure TCustomTeePanel.MouseLeave(AControl: TControl);
{$ELSE}
procedure TCustomTeePanel.CMMouseLeave(var Message: TMessage);
{$ENDIF}
begin
  Cursor:=FOriginalCursor;
  FPanning.Active:=False;
  inherited;
end;

{$IFNDEF CLX}
procedure TCustomTeePanel.CMSysColorChange(var Message: TMessage);
begin
  inherited;
  Invalidate;
end;

procedure TCustomTeePanel.WMGetDlgCode(var Message: TWMGetDlgCode);
begin
  inherited;
  Message.Result:=Message.Result or DLGC_WANTARROWS;
end;

procedure TCustomTeePanel.WMEraseBkgnd(var Message: TWmEraseBkgnd);
Begin
  if TeeEraseBack then Inherited;
  Message.Result:=1;
End;
{$ENDIF}

procedure TCustomTeePanel.Invalidate;
begin
  if AutoRepaint then
  begin
    if Assigned(InternalCanvas) then InternalCanvas.Invalidate;
    inherited;
  end;
end;

procedure TCustomTeePanel.AssignTo(Dest: TPersistent);
var tmp : TBitmap;
begin
  if (Dest is TGraphic) or (Dest is TPicture) then
  begin
    tmp:=TeeCreateBitmap;
    try
      Dest.Assign(tmp);
    finally
      tmp.Free;
    end;
  end
  else inherited;
end;

procedure TCustomTeePanel.RemoveListener(Sender:ITeeEventListener);
begin
  if Assigned(IEventListeners) then IEventListeners.Remove(Sender);
end;

procedure TCustomTeePanel.Resize;
begin
  if (not (csLoading in ComponentState)) and (BorderRound>0) then
     SetControlRounded;
  inherited;
end;

Function TCustomTeePanel.BroadcastTeeEvent(Event:TTeeEvent):TTeeEvent;
var t   : Integer;
    tmp : ITeeEventListener;
begin
  result:=Event;
  if not (csDestroying in ComponentState) then
  begin
    Event.Sender:=Self;

    t:=0;
    while t<Listeners.Count do
    begin
      tmp:=Listeners[t];
      tmp.TeeEvent(Event);

      if (Event is TTeeMouseEvent) and CancelMouse then
         break;  { 5.01 }

      Inc(t);
    end;
  end;
end;

procedure TCustomTeePanel.BroadcastMouseEvent(Kind:TTeeMouseEventKind;
                                           Button: TMouseButton;
                                           Shift: TShiftState; X, Y: Integer);
var tmp : TTeeMouseEvent;
begin
  if Listeners.Count>0 then
  begin
    tmp:=TTeeMouseEvent.Create;
    try
      tmp.Event:=Kind;
      tmp.Button:=Button;
      tmp.Shift:=Shift;
      tmp.X:=X;
      tmp.Y:=Y;
      BroadcastTeeEvent(tmp);
    finally
      tmp.Free;
    end;
  end;
end;

procedure TCustomTeePanel.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  CancelMouse:=False;
  inherited;
  BroadcastMouseEvent(meDown,Button,Shift,X,Y);
end;

procedure TCustomTeePanel.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  inherited;
  BroadcastMouseEvent(meUp,Button,Shift,X,Y);
end;

procedure TCustomTeePanel.MouseMove(Shift: TShiftState; X, Y: Integer);