teeprocs.pas

来自「Delphi TeeChartPro.6.01的源代码」· PAS 代码 · 共 2,156 行 · 第 1/5 页

  end;
  result:=DateTimeStep[dtOneYear];
end;

Function FindDateTimeStep(Const StepValue:Double):TDateTimeStep;
begin
  for result:=Pred(High(DateTimeStep)) downto Low(DateTimeStep) do
    if Abs(DateTimeStep[result]-StepValue)<DateTimeStep[Low(DateTimeStep)] then
       Exit;

  result:=dtNone;
end;

{ draw a simulated checkbox on Canvas }
Procedure TeeDrawCheckBox( x,y:Integer; Canvas:TCanvas; Checked:Boolean;
                           ABackColor:TColor);

  {$IFDEF CLX}
  Procedure DoHorizLine(x1,x2,y:Integer);
  begin
    with Canvas do
    begin
      MoveTo(x1,y);
      LineTo(x2,y);
    end;
  end;

  Procedure DoVertLine(x,y1,y2:Integer);
  begin
    with Canvas do
    begin
      MoveTo(x,y1);
      LineTo(x,y2);
    end;
  end;
  {$ENDIF}

var t : Integer;
begin
  {$IFNDEF CLX}
  t:=DFCS_BUTTONCHECK;
  if Checked then t:=t or DFCS_CHECKED;
  DrawFrameControl(Canvas.Handle,Bounds(x,y,13,13),DFC_BUTTON,t);
  {$ELSE}
  With Canvas do
  begin
    Pen.Style:=psSolid;
    Pen.Width:=1;
    Pen.Color:=clGray;
    DoHorizLine(x+TeeCheckBoxSize,x,y);
    LineTo(x,y+TeeCheckBoxSize+1);
    ABackColor:=ColorToRGB(ABackColor);
    if (ABackColor=clWhite) {$IFDEF CLX}or (ABackColor=1){$ENDIF} then
        Pen.Color:=clSilver
    else
        Pen.Color:=clWhite;
    DoHorizLine(x,x+TeeCheckBoxSize+1,y+TeeCheckBoxSize+1);

    LineTo(x+TeeCheckBoxSize+1,y-1);
    Pen.Color:=clBlack;
    DoHorizLine(x+TeeCheckBoxSize-1,x+1,y+1);
    LineTo(x+1,y+TeeCheckBoxSize);

    Brush.Style:=bsSolid;
    Brush.Color:=clWindow;
    Pen.Style:=psClear;
    Rectangle(x+2,y+2,x+TeeCheckBoxSize+1,y+TeeCheckBoxSize+1);

    if Checked then
    begin
      Pen.Style:=psSolid;
      Pen.Color:=clWindowText;
      for t:=1 to 3 do DoVertLine(x+2+t,y+4+t,y+7+t);
      for t:=1 to 4 do DoVertLine(x+5+t,y+7-t,y+10-t);
    end;
  end;
  {$ENDIF}
end;

{ TCustomPanelNoCaption }
Constructor TCustomPanelNoCaption.Create(AOwner: TComponent);
begin
  inherited;
  ControlStyle:=ControlStyle-[csSetCaption {$IFDEF CLX},csNoFocus{$ENDIF} ];
end;

type TChartPenAccess=class(TChartPen);

{ TCustomTeePanel }
Constructor TCustomTeePanel.Create(AOwner: TComponent);
begin
  inherited;
  IEventListeners:=TTeeEventListeners.Create;

  Width := 400;
  Height:= 250;
  F3DPercent   :=TeeDef3DPercent;
  FApplyZOrder :=True;
  FDelphiCanvas:=inherited Canvas;
  FView3D      :=True;
  FView3DOptions:=TView3DOptions.Create(Self);
  InternalCanvas:=TTeeCanvas3D.Create;
  InternalCanvas.ReferenceCanvas:=FDelphiCanvas;
  FMargins:= TeeRect( TeeDefHorizMargin,TeeDefVerticalMargin,
                      TeeDefHorizMargin,TeeDefVerticalMargin);
  FPrintProportional:=True;
  FPrintResolution:=TeeNormalPrintDetail;
  PrintMargins:=TeeRect( TeeDefault_PrintMargin,TeeDefault_PrintMargin,
                         TeeDefault_PrintMargin,TeeDefault_PrintMargin);
  FOriginalCursor:=Cursor;
  FPanning:=TZoomPanning.Create;

  FShadow:=TTeeShadow.Create(CanvasChanged);
  FBorder:=TChartHiddenPen.Create(CanvasChanged);
  FBorder.EndStyle:=esFlat;
  TChartPenAccess(FBorder).DefaultEnd:=esFlat;

  if TeeEraseBack then
     TeeEraseBack:=not (csDesigning in ComponentState);

  AutoRepaint:=True;
  {$IFDEF CLX}
  QWidget_setBackgroundMode(Handle,QWidgetBackgroundMode_NoBackground);
  {$ENDIF}
end;

Destructor TCustomTeePanel.Destroy;
Begin
  FreeAndNil(InternalCanvas);
  FBorder.Free;
  FShadow.Free;
  FView3DOptions.Free;
  FPanning.Free;
  FreeAndNil(IEventListeners);
  inherited;
end;

Procedure TCustomTeePanel.CanvasChanged(Sender:TObject);
Begin
  Invalidate;
end;

{$IFNDEF CLX}
procedure TCustomTeePanel.CreateParams(var Params: TCreateParams);
begin
  inherited;

// OpenGL:
// Params.WindowClass.Style:=Params.WindowClass.Style or CS_OWNDC;

  if Color=clNone then
     Params.ExStyle:=Params.ExStyle or WS_EX_TRANSPARENT; { 5.02 }

  InternalCanvas.View3DOptions:=nil;
end;
{$ENDIF}

Procedure TCustomTeePanel.SetShadow(Value:TTeeShadow);
begin
  FShadow.Assign(Value);
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(TTeeCanvas);

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 BevelInner<>bvNone then Inc(tmpBorder,BevelWidth);
    if BevelOuter<>bvNone then Inc(tmpBorder,BevelWidth);
    if Border.Visible then Inc(tmpBorder,Border.Width);

    // Apply margins
    With FChartBounds do
         ChartRect:=TeeRect( Left  + tmpBorder + GetMargin(MarginLeft,tmpW),
                             Top   + tmpBorder + GetMargin(MarginTop,tmpH),
                             Right - tmpBorder - GetMargin(MarginRight,tmpW),
                             Bottom- tmpBorder - GetMargin(MarginBottom,tmpH) );
  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}
  if (not FPrinting) and (not InternalCanvas.ReDrawBitmap) then Draw;
end;

{$IFDEF CLX}
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 :=Math.Max(1,Rect.Right-Rect.Left);
  result.Height:=Math.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.AssignBrushColor(ABrush,AColor,ABackColor);
end;

Function TeeGetDeviceCaps(Handle:{$IFDEF CLX}QPaintDeviceH
                                 {$ELSE}TTeeCanvasHandle
                                 {$ENDIF}; Cap:Integer):Integer;
begin
  {$IFDEF CLX}
  result:=1;
  {$ELSE}
  result:=GetDeviceCaps(Handle,Cap);
  {$ENDIF}
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.Set3DPercent(Value:Integer);
Const Max3DPercent = 100;
      Min3DPercent = 1;
Begin
  if (Value<Min3DPercent) or (Value>Max3DPercent) then
     Raise Exception.CreateFmt(TeeMsg_3DPercent,[Min3DPercent,Max3DPercent])
  else
    SetIntegerProperty(F3DPercent,Value);
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;