teeprocs.pas

TeeChart7Source 控件

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(Color,GetRectangle);
    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);
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;

Procedure TCustomTeePanel.SetBorderStyle(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 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
  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