teeprocs.pas

第三方控件：PaintGrid.pas 网格型仪表控件源文件 Mymeter.pas 圆型仪表控件源文件 Project1是这两个控件的使用范例。 该

  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.AssignBrushColor(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);
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);