teeprocs.pas

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

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;

type TRectArray=array[0..3] of Integer;

Function TCustomTeePanel.GetMargin(Index:Integer):Integer;
Begin
  result:=TRectArray(FMargins)[Index];
end;

Procedure TCustomTeePanel.SetMargin(Index,Value:Integer);
Begin
  SetIntegerProperty(TRectArray(FMargins)[Index],Value);
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.Monochrome         := Monochrome;
    Self.Shadow             := Shadow;
    Self.FView3D            := FView3D;
    Self.View3DOptions      := FView3DOptions;
    Self.F3DPercent         := F3DPercent;
    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(ABackColor:TColor; Const Rect:TRect;
                                         APixelFormat:TPixelFormat=
                                         {$IFDEF CLX}TeePixelFormat{$ELSE}pfDevice{$ENDIF}
                                         ):TBitmap;
begin
  result:=TBitmap.Create;
  With result do
  begin
    {$IFNDEF CLX}
    IgnorePalette:=PixelFormat=TeePixelFormat;
    {$ENDIF}

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

    Width :=Rect.Right-Rect.Left;
    Height:=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);