_arrow.pas

著名的虚拟仪表控件,包含全部源码, 可以在,delphi2007 下安装运行

unit _Arrow;

{******************************************************************************}
{ Abakus VCL                                                                   }
{                          Arrow shapes for round meters                       }
{ If you change or add arrows you must backup this unit before you update to a }
{ new Abakus VCL version (an update will overwrite this file !!! )             }
{******************************************************************************}
{        e-Mail: [e-mail] , Web: http://www.abaecker.com           }
{------------------------------------------------------------------------------}
{          (c) Copyright 1998..2000 A.Baecker, All rights Reserved             }
{******************************************************************************}

interface

uses
  Windows,
  Classes,
  _AbProc;

procedure AbArrowField(typ, b: Integer; r: TRect; var Field: array of TPoint);

implementation

procedure AbArrowField(typ, b: Integer; r: TRect; var Field: array of TPoint);
{ Field[0].x  = hibyte > no. of used points
                lobyte > Options,... not used yet

  Field[0].y  = hibyte > radius of center-circle 1
                lobyte > radius of center-circle 2 (behind 1)

  with the procedue ArrowSettings you can set Field[0]...

  Field[1]    = center of rotation
  Field[2..8] = points...
}
var
  x, y, l, b2       : Integer;
  cp                : TPoint;
begin
  cp := AbCenterPoint(r);
  l := (r.Right - r.Left) div 2;        {max length}
  x := l;                               {center x}
  y := l;                               {center y}
  b := l div 10;                        {length dependend calculated width}
  b2 := l div 16;                       {length dependend calculated width}

  Field[1] := Point(x, y);              {center of rotation}
  case typ of
    1:
      begin
        AbArrowSettings(
          Field,                        {the arrow-field}
          4,                            {number of used points}
          0,                            {options,... not used yet}
          b + b div 2                   {radius of centerpoint 1}
          , 3);                         {radius of centerpoint 1}

        Field[2] := Point(x - b2, y);
        Field[3] := Point(x + b2, y);
        Field[4] := Point(x, y - l);
      end;
    2:
      begin
        AbArrowSettings(Field, 4, 0, 0, 0);
        Field[2] := Point(x - b, y - l + b * 4);
        Field[3] := Point(x + b, y - l + b * 4);
        Field[4] := Point(x, y - l);
      end;
    3:
      begin
        AbArrowSettings(Field, 4, 0, b, 3);
        Field[2] := Point(x - b2, y + b * 2);
        Field[3] := Point(x + b2, y + b * 2);
        Field[4] := Point(x, y - l);
        Field[5] := Point(x - b2, y - l);
      end;
    4:
      begin
        AbArrowSettings(Field, 8, 0, 2, 0);
        Field[2] := Point(x - b2, y + b);
        Field[3] := Point(x + b2, y + b);
        Field[4] := Point(x + b2, y - l + b + b + b);
        Field[5] := Point(x + b + b, y - l + b + b + b);
        Field[6] := Point(x, y - l);
        Field[7] := Point(x - b - b, y - l + b + b + b);
        Field[8] := Point(x - b2, y - l + b + b + b);
      end;
    5:
      begin
        AbArrowSettings(Field, 6, 0, 2, 0);
        Field[2] := Point(x - b, y + b);
        Field[3] := Point(x + b, y + b);
        Field[4] := Point(x + b, y - l + b + b);
        Field[5] := Point(x, y - l);
        Field[6] := Point(x - b, y - l + b + b);
      end;
    6:
      begin
        AbArrowSettings(Field, 5, 1, 8, 3);
        Field[2] := Point(x - 1, y + b + b);
        Field[3] := Point(x + 1, y + b + b);
        Field[4] := Point(x + 1, y - l);
        Field[5] := Point(x - 1, y - l);
      end;
    7:
      begin
        AbArrowSettings(Field, 6, 0, b2, 2);
        Field[2] := Point(x - b, y);
        Field[3] := Point(x - b - b2, y + b + b);
        Field[4] := Point(x + b + b2, y + b + b);
        Field[5] := Point(x + b, y);
        Field[6] := Point(x, y - l);
      end;
  else                                  {type 0 or not defined}
    begin
      AbArrowSettings(Field, 4, 0, 2, 0);
      Field[2] := Point(x - b, y + b);
      Field[3] := Point(x + b, y + b);
      Field[4] := Point(x, y - l);
    end;
  end;                                  {case typ}

end;

end.