tecanvas.pas

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

    procedure PaintWindow(DC: HDC); override;
    {$ENDIF}

    {$IFNDEF LCL}
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
    {$ENDIF}

    {$ELSE}
    procedure Painting(Sender: QObjectH; EventRegion: QRegionH); override;
    {$ENDIF}

    function SymbolRectangle:TRect;
  public
    Procedure LinkProperty(AInstance:TObject; Const PropName:String);
  published
    { Published declarations }
    property Height default 25;
    property Width default 75;
  end;

  TButtonColor = class(TTeeButton)
  private
    FSymbolColor : TColor;
    Function GetSymbolColor : TColor;
    procedure SetSymbolColor(Const Value:TColor); // 7.0
  protected
    procedure DrawSymbol(ACanvas:TTeeCanvas); override;
  public
    GetColorProc : TButtonGetColorProc;
    procedure Click; override;
    property SymbolColor:TColor read GetSymbolColor write SetSymbolColor;
  end;

  TComboFlat=class(TComboBox)
  private
    {$IFNDEF CLX}
    Inside: Boolean;
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;

    {$IFNDEF LCL}
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
    {$ENDIF}

    {$IFNDEF CLR}
    {$IFNDEF LCL}
    procedure CMFocusChanged(var Message: TCMFocusChanged); message CM_FOCUSCHANGED;
    {$ENDIF}
    {$ENDIF}
    {$ENDIF}

    function GetDropWidth:Integer;
    function IsDropWidthStored:Boolean;
    procedure SetDropWidth(const Value:Integer);
  public
    Constructor Create(AOwner:TComponent); override;
    {$IFNDEF D6}
    procedure AddItem(Item: String; AObject: TObject);
    {$ENDIF}
  published
    property DropDownWidth:Integer read GetDropWidth write SetDropWidth  // 7.05
                                   stored IsDropWidthStored;
    property Height default 21;
    property ItemHeight default 13;
    property ItemIndex;
    property Style default csDropDownList;
  end;
{$ENDIF}

{$IFNDEF D5}
procedure FreeAndNil(var Obj);
{$ENDIF}

{$IFNDEF TEEVCL}
procedure FreeAndNil(var Obj);
function StrToInt(const S: string): Integer;
function ColorToRGB(Color: TColor): Longint;
{$ENDIF}

var IsWindowsNT:Boolean=False;
    GetDefaultFontSize:Integer=0;
    GetDefaultFontName:String='';

{$IFDEF LINUX}
Function GetRValue(Color:Integer):Byte;
Function GetGValue(Color:Integer):Byte;
Function GetBValue(Color:Integer):Byte;
Function RGB(r,g,b:Integer):TColor;
{$ENDIF}

Function TeeCreatePenSmallDots(const AColor:TColor;
                    const Space:Integer=0):{$IFDEF CLX}QPenH{$ELSE}HPen{$ENDIF};

Procedure TeeSetTeePen(FPen:TPen; APen:TChartPen; AColor:TColor; Handle:TTeeCanvasHandle);

// Converts ABitmap pixels into Gray Scale (levels of gray)
Procedure TeeGrayScale(ABitmap:TBitmap; Inverted:Boolean; AMethod:Integer); { 5.02 }

Function TeePoint(const aX,aY:Integer):TPoint; {$IFDEF D9}inline;{$ENDIF} { compatibility with D6 CLX }
function PointInRect(Const Rect:TRect; const P:TPoint):Boolean; overload; {$IFDEF D9}inline;{$ENDIF}
function PointInRect(Const Rect:TRect; x,y:Integer):Boolean; overload; {$IFDEF D9}inline;{$ENDIF}{ compatibility with D6 CLX }
function TeeRect(Left,Top,Right,Bottom:Integer):TRect; {$IFDEF D9}inline;{$ENDIF} { compatibility with D6 CLX }
Function OrientRectangle(Const R:TRect):TRect;
Function PolygonBounds(Const P:Array of TPoint):TRect;  // 7.0

// Default color depth
const
  TeePixelFormat={$IFDEF CLX}pf32Bit{$ELSE}pf24Bit{$ENDIF};

{$IFDEF CLX}
type
  TRGBTriple=packed record
    rgbtBlue   : Byte;
    rgbtGreen  : Byte;
    rgbtRed    : Byte;
    rgbtAlpha  : Byte;  // Linux ?
  end;
{$ENDIF}

Function RGBValue(Color:TColor):TRGBTriple;

{$IFDEF TEEVCL}
{ Show the TColorDialog, return new color if changed }
Function EditColor(AOwner:TComponent; AColor:TColor):TColor;

{ Show the TColorDialog, return True if color changed }
Function EditColorDialog(AOwner:TComponent; var AColor:TColor):Boolean;
{$ENDIF}

// Returns point "ATo" minus ADist pixels from AFrom point.
Function PointAtDistance(AFrom,ATo:TPoint; ADist:Integer):TPoint;

// Returns True when 3 first points in P are "face-viewing".
Function TeeCull(const P:TFourPoints):Boolean; overload;
Function TeeCull(const P0,P1,P2:TPoint):Boolean; overload;

// Draws SRC bitmap with smooth stretch to Dst bitmap
type TSmoothStretchOption = (ssBestQuality, ssBestPerformance);

procedure SmoothStretch(Src, Dst: TBitmap); overload;
procedure SmoothStretch(Src, Dst: TBitmap; Option: TSmoothStretchOption); overload;

// Returns Sqrt( Sqr(x)+Sqr(y) )
Function TeeDistance(const x,y:Double):Double;  // 7.0 changed to "double"

{ Used at EditColor function, for the Color Editor dialog }
var TeeCustomEditColors:TStrings=nil;

    {$IFNDEF LINUX}
    TeeFontAntiAlias:Byte=ANTIALIASED_QUALITY;
    {$ENDIF}

    {$IFNDEF CLX}
    TeeSetDCBrushColor:function(DC: HDC; Color: COLORREF): COLORREF; stdcall;
    TeeSetDCPenColor:function(DC: HDC; Color: COLORREF): COLORREF; stdcall;
    {$ENDIF}

// Load a DLL, compatible with Delphi 4 and up.
{$IFNDEF LINUX}
Function TeeLoadLibrary(Const FileName:String):HInst;

// Free Library, but do not free library in Windows 95 (lock bug)
Procedure TeeFreeLibrary(hLibModule: HMODULE);
{$ENDIF}

var
  TeeNumCylinderSides:Integer=16;

procedure TeeBlendBitmaps(Const Percent: Double; ABitmap,BBitmap:TBitmap; BOrigin:TPoint);

implementation

Uses {$IFDEF CLR}
     System.Runtime.InteropServices,
     System.Drawing,
     System.Drawing.Drawing2D,
     {$ENDIF}

     {$IFDEF TEEVCL}
     {$IFDEF CLX}
     QForms, QDialogs,
     {$ELSE}
     Forms, Dialogs,
     {$ENDIF}
     {$ENDIF}

     Math, TeeHtml, TeeConst;

type PPoints = ^TPoints;
     TPoints = Array[0..0] of TPoint;

{$IFNDEF CLX}
var WasOldRegion : Boolean=False;
    OldRegion    : HRgn=0;
{$ENDIF}

{$IFNDEF TEEWINDOWS}
procedure InflateRect(var R:TRect; x,y:Integer); {$IFDEF D9}inline;{$ENDIF}
begin
  Inc(R.Left,-x);
  Inc(R.Right,x);
  Inc(R.Top,-y);
  Inc(R.Bottom,y);
end;
{$ENDIF}

Function TeeCull(const P0,P1,P2:TPoint):Boolean;
begin
  result:=( ((P0.x-P1.x) * (P2.y-P1.y)) -
            ((P2.x-P1.x) * (P0.y-P1.y))
          ) < 0;
end;

Function TeeCull(const P:TFourPoints):Boolean; {$IFDEF D9}inline;{$ENDIF}
begin
  result:=TeeCull(P[0],P[1],P[2]);
end;

Function TeePoint(const aX,aY:Integer):TPoint; {$IFDEF D9}inline;{$ENDIF}
begin
  with result do
  begin
    X:=aX;
    Y:=aY;
  end;
end;

function PointInRect(Const Rect:TRect; x,y:Integer):Boolean; {$IFDEF D9}inline;{$ENDIF}
begin
  result:=(x>=Rect.Left) and (y>=Rect.Top) and
          (x<=Rect.Right) and (y<=Rect.Bottom);  // 7.0
end;

function PointInRect(Const Rect:TRect; const P:TPoint):Boolean; overload; {$IFDEF D9}inline;{$ENDIF}
begin
  result:=PointInRect(Rect,P.X,P.Y);
end;

function TeeRect(Left,Top,Right,Bottom:Integer):TRect; {$IFDEF D9}inline;{$ENDIF}
begin
  result.Left  :=Left;
  result.Top   :=Top;
  result.Bottom:=Bottom;
  result.Right :=Right;
end;

// Makes sure the R rectangle Left is smaller than Right and
// Top is smaller than Bottom. Returns corrected rectangle.
Function OrientRectangle(Const R:TRect):TRect;
{$IFDEF CLR}
var tmp : Integer;
{$ENDIF}
begin
  result:=R;

  with result do
  begin
    if Left>Right then
    {$IFDEF CLR}
    begin
      tmp:=Left; Left:=Right; Right:=tmp;
    end;
    {$ELSE}
    SwapInteger(Left,Right);
    {$ENDIF}

    if Top>Bottom then
    {$IFDEF CLR}
    begin
      tmp:=Top; Top:=Bottom; Bottom:=tmp;
    end;
    {$ELSE}
    SwapInteger(Top,Bottom);
    {$ENDIF}
  end;
end;

Function Point3D(const x,y,z:Integer):TPoint3D; {$IFDEF D9}inline;{$ENDIF}
begin
  result.x:=x;
  result.y:=y;
  result.z:=z;
end;

Procedure RectSize(Const R:TRect; Var RectWidth,RectHeight:Integer); {$IFDEF D9}inline;{$ENDIF}
begin
  With R do
  begin
    RectWidth :=Right-Left;
    RectHeight:=Bottom-Top;
  end;
end;

Procedure RectCenter(Const R:TRect; Var X,Y:Integer); {$IFDEF D9}inline;{$ENDIF}
begin
  With R do
  begin
    X:=(Left+Right) div 2;
    Y:=(Top+Bottom) div 2;
  end;
end;

// Returns the minimum left / top and the
// maximum right / bottom for all the points in "P" polygon
Function PolygonBounds(Const P:Array of TPoint):TRect;
var l,t : Integer;
begin
  l:=Length(P);

  if l>0 then
  {$IFDEF CLR}
  begin
    result.Left:=P[0].X;
    result.Top:=P[0].Y;
    result.Right:=result.Left;
    result.Bottom:=result.Top;

    for t:=1 to l-1 do
    with P[t] do
    begin
      if X<result.Left then result.Left:=X
      else
      if X>result.Right then result.Right:=X;

      if Y<result.Top then result.Top:=Y
      else
      if Y>result.Bottom then result.Bottom:=Y;
    end;
  end
  {$ELSE}
  with result do
  begin
    TopLeft:=P[0];
    BottomRight:=TopLeft;

    for t:=1 to l-1 do
    with P[t] do
    begin
      if X<Left then Left:=X
      else
      if X>Right then Right:=X;

      if Y<Top then Top:=Y
      else
      if Y>Bottom then Bottom:=Y;
    end;
  end
  {$ENDIF}
  else
    result:=TeeZeroRect;
end;

{ TChartPen }
Constructor TChartPen.Create(OnChangeEvent:TNotifyEvent);
begin
  inherited Create;
  FVisible:=True;
  DefaultVisible:=True;

  DefaultEnd:=esRound;
  OnChange:=OnChangeEvent;

  {$IFDEF CLX}
  ReleaseHandle;
  Width:=1;
  {$ENDIF}
end;

Procedure TChartPen.Assign(Source:TPersistent);
begin
  if Source is TChartPen then
  begin
    FVisible  :=TChartPen(Source).Visible;
    FSmallDots:=TChartPen(Source).SmallDots;
    FSmallSpace:=TChartPen(Source).SmallSpace;
    FEndStyle :=TChartPen(Source).EndStyle;  { 5.01 }
  end;

  {$IFDEF CLX}
  if not Assigned(Handle) then ReleaseHandle;
  {$ENDIF}

  inherited;
end;

procedure TChartPen.Hide;
begin
  Visible:=False;
end;

procedure TChartPen.Show;
begin
  Visible:=True;
end;

Function TChartPen.IsEndStored:Boolean;
begin
  result:=FEndStyle<>DefaultEnd;
end;