_abproc.pas

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

begin
  result := Exp(exponent * Ln(base));
end;

function AbCalcLogStr(ValueFrom: real; Steps: Integer; Format: string; Rev:
  Boolean): string;
var
  n                 : Integer;
  Str               : string;
  val               : real;
  eStart, eEnd      : Integer;
begin
  // Rev = to change the order, false lowest value first in string
  // e.g.: false '1e1;1e2;1e3;'
  //       true  '1e3;1e2;1e1;'
  eStart := Round(AbLog10(ValueFrom));
  eEnd := eStart + Steps;

  if Rev then
  begin                                 // '1e3;1e2;1e1;'
    Str := '';
    val := StrToFloat('1e' + IntToStr(eEnd));
    Str := FormatFloat(Format, val) + ';';

    for n := Steps downto 1 do
    begin
      val := val / 10;
      Str := Str + FormatFloat(Format, val) + ';';
    end;
  end
  else
  begin                                 // '1e1;1e2;1e3;
    val := ValueFrom;
    Str := FormatFloat(Format, val) + ';';
    for n := 1 to Steps do
    begin
      val := val * 10;
      Str := Str + FormatFloat(Format, val) + ';';
    end;
  end;

  result := Str;
end;

function AbLogRangeStr(ExpFrom, ExpTo, Steps: Integer; Format: string; Rev:
  Boolean): string;
var
  Str               : string;
  val               : real;
  Step              : Integer;
  Exp : Integer;
begin
  // Rev = to change the order, false lowest value first in string
  // e.g.: false '1e1;1e2;1e3;'
  //       true  '1e3;1e2;1e1;'

  Str := '';



  if Steps < 1 then Steps := 1;
  Step := (ExpTo - ExpFrom) div Steps;

  if Rev then
  begin                                 // '1e3;1e2;1e1;'
    Exp := ExpTo;
    val := StrToFloat('1e' + IntToStr(Exp));
    Str := FormatFloat(Format, val) + ';';
    while Exp > ExpFrom do begin
      Exp := Exp - Step;
      val := StrToFloat('1e' + IntToStr(Exp));
      Str := Str + FormatFloat(Format, val) + ';';
    end;
  end
  else
  begin                                 // '1e1;1e2;1e3;
    Exp := ExpFrom;
    val := StrToFloat('1e' + IntToStr(Exp));
    Str := FormatFloat(Format, val) + ';';
    while Exp < ExpTo do begin
      Exp := Exp + Step;
      val := StrToFloat('1e' + IntToStr(Exp));
      Str := Str + FormatFloat(Format, val) + ';';
    end;
  end;

  result := Str;
end;


function AbRoundLogValue(Value: real; var Exp: Integer): real;
begin
  if Value <= 0 then Value := 1;        // 0 or negative Values are not alowed
  Exp := Round(AbLog10(Value));
  result := AbPower(10, Exp);
end;


function AbCalcColor(ColFrom,           //
  ColTo: TColor;                        //
  Steps,                                // number of steps
  step: Integer)                        // present step
  : TColor;                             // calculated color
var
  FromR, FromG, FromB: LongInt;
  DiffR, DiffG, DiffB: LongInt;
  RGBFrom, RGBTo    : LongInt;
  r, g, b           : Byte;
begin
  // change color to RGB-Color, needed for API-calls
  RGBFrom := ColorToRGB(ColFrom);
  RGBTo := ColorToRGB(ColTo);

  if RGBFrom <> RGBTo then
  begin
    FromR := GetRValue(RGBFrom);
    FromG := GetGValue(RGBFrom);
    FromB := GetBValue(RGBFrom);
    DiffR := GetRValue(RGBTo) - FromR;
    DiffG := GetGValue(RGBTo) - FromG;
    DiffB := GetBValue(RGBTo) - FromB;

    if Steps = 0 then Steps := 1;
    r := FromR + Round((DiffR / Steps) * step);
    g := FromG + Round((DiffG / Steps) * step);
    b := FromB + Round((DiffB / Steps) * step);

    result := RGB(r, g, b);
  end
  else
    result := ColFrom;
end;

procedure AbGetTextSize(can: TCanvas; var b, h: Integer; var CenterP: TPoint;
  Text: string);
{returns width (b) Height (h) and Centerpoint (CentrP) of the String (text) }
begin
  b := can.TextWidth(Text);
  h := can.Textheight(Text);
  CenterP.x := b div 2;
  CenterP.y := h div 2;
end;

procedure AbGetMaxTokenSize(can: TCanvas; var b, h: Integer; Text: string);
{Returns the max token width (b) and height (h) from text (text) }
var
  s, s2             : string;
  i                 : Integer;
begin
  h := can.Textheight(Text);
  s := Text;
  b := 0;

  while Pos(';', s) <> 0 do
  begin
    i := Pos(';', s);                   {find separator char}
    s2 := Copy(s, 1, i - 1);            {return partstring}
    if can.TextWidth(s2) > b then b := can.TextWidth(s2);
    delete(s, 1, i);                    {delete partstring}
  end;
  if can.TextWidth(s) > b then b := can.TextWidth(s2); {check last token}
end;

{zeichnet einen string (text) ausgerichtet nach (pos) an punkt (x,y)}

procedure AbTextOut(can: TCanvas; x1, y1: Integer; Text: string; Pos: toPos);
{draws the string text at x1,y1 orientation pos }
var
  b, h              : Integer;
  cp, TPos          : TPoint;

begin
  TPos := Point(0, 0);
  AbGetTextSize(can, b, h, cp, Text);

  case Pos of
    toTopLeft: TPos := Point(x1, y1);
    toTopCenter: TPos := Point(x1 - cp.x, y1);
    toTopRight: TPos := Point(x1 - b, y1);
    toMidLeft: TPos := Point(x1, y1 - cp.y);
    toMidCenter: TPos := Point(x1 - cp.x, y1 - cp.y);
    toMidRight: TPos := Point(x1 - b, y1 - cp.y);
    toBotLeft: TPos := Point(x1, y1 - h);
    toBotCenter: TPos := Point(x1 - cp.x, y1 - h);
    toBotRight: TPos := Point(x1 - b, y1 - h);
  end;
  can.textout(TPos.x, TPos.y, Text);

end;

procedure AbRotTextOut( can : TCanvas;
                        cp     : TPoint;         // center point
                        Angle : Single;      // angle of Textpos / rotation
                        Text : String;       // the text
                        Pos : toPos);     //
var
  hFont, hFontOld : THandle;
  TxtPos : TPoint;
  Alpha : Integer;
  LFont: TLogFont;
  hText : Integer;
begin

  Alpha := Trunc(Angle * 10 );

  GetObject(Can.Font.Handle,SizeOf(LFont),Addr(LFont));
  hText := can.TextHeight(Text);
  LFont.lfEscapement := -Alpha;

  hFont    := CreateFontIndirect(LFont);
  hFontOld := SelectObject(can.handle,hFont);


  TxtPos := cp;

  case pos of
    toTopLeft:   begin
                   SetTextAlign(can.handle,TA_LEFT);
                 end;
    toTopCenter: begin
                   SetTextAlign(can.handle,TA_CENTER);
                 end;
    toTopRight:  begin
                   SetTextAlign(can.handle,TA_RIGHT);
                 end;
    toMidLeft:   begin
                   TxtPos.y := cp.y  - hText div 2;
                   SetTextAlign(can.handle,TA_LEFT);
                 end;
    toMidCenter: begin
                   TxtPos.y := cp.y  - hText div 2;
                   SetTextAlign(can.handle,TA_CENTER);
                 end;
    toMidRight:  begin
                   TxtPos.y := cp.y  - hText div 2;
                   SetTextAlign(can.handle,TA_RIGHT);
                 end;
    toBotLeft:   begin
                   SetTextAlign(can.handle,TA_BASELINE + TA_LEFT);
                 end;
    toBotCenter: begin
                   SetTextAlign(can.handle,TA_BOTTOM + TA_CENTER);
                 end;
    toBotRight:  begin
                   SetTextAlign(can.handle,TA_BOTTOM + TA_RIGHT);
                 end;
  end;

  TxtPos := AbRotate(TxtPos, cp, Angle, true);
  can.TextOut(TxtPos.x,TxtPos.y, Text);

  selectObject(can.handle, hFontOld);
  deleteObject(hFont);

end;




procedure AbTextOut3D(can: TCanvas; x1, y1: Integer; Col, Col1, Col2: TColor;
  Text: string; Pos: toPos; _3D: Boolean);
begin
  if _3D then
  begin
    can.Font.Color := Col2;
    AbTextOut(can, x1 + 1, y1 + 1, Text, Pos);
    can.Font.Color := Col1;
    AbTextOut(can, x1 - 1, y1 - 1, Text, Pos);
  end;
  can.Font.Color := Col;
  AbTextOut(can, x1, y1, Text, Pos);
end;


function AbStrToken(var Text: string; Separator: Char): string;
var
  i                 : Integer;
begin
  i := Pos(Separator, Text);            {find separator}
  if i <> 0 then
  begin
    result := Copy(Text, 1, i - 1);     {return token}
    delete(Text, 1, i);                 { delete token}
  end
  else
  begin
    result := Text;
    Text := '';
  end;
end;

function AbRangeStr(SignalFrom, SignalTo: Single; Steps: Integer; Format:
  string): string;
var
  i                 : Integer;
  s                 : string;
  wert              : Single;
begin
  s := '';
  wert := (SignalTo - SignalFrom) / Steps;
  for i := 0 to Steps do
  begin
    s := s + FormatFloat(Format, SignalFrom + wert * (Steps - i)) + ';';
  end;
  result := s;
end;


{========= sonstige ==========================================================}

procedure GetBkUpImage(can: TCanvas; bkBmp:TBitmap; rect : TRect);
var
  r, ri             : TRect;
  TempBmp           : TBitmap;
begin
  r := can.Cliprect;
  if AbRectIntersection(r, rect, ri) then
  begin
    TempBmp := TBitmap.Create;
    TempBmp.Width := ri.Right - ri.Left;
    TempBmp.Height := ri.Bottom - ri.Top;

    TempBmp.Canvas.CopyRect(TempBmp.Canvas.Cliprect, can, ri);

    bkBmp.Width := (rect.Right - rect.Left);
    bkBmp.Height := rect.Bottom - rect.Top;
    bkBmp.Canvas.Draw(ri.Left - rect.Left, ri.Top - rect.Top,
      TempBmp);  

    TempBmp.Free;
  end;
end;

{gibt den kleineren wert von x1,x2 zur點k}

function AbMinInt(x1, x2: Integer): Integer;
begin
  if (x1 < x2) then
    result := x1
  else
    result := x2;
end;

{gibt den gr鲞eren wert von x1,x2 zur點k}

function AbMaxInt(x1, x2: Integer): Integer;
begin
  if (x1 > x2) then
    result := x1
  else
    result := x2;
end;

{ change true to "1" false to "0"}

{begrenzt x1 auf min(x2) und max(x3) }

function AbMinMaxInt(x1, Min, Max: Integer): Integer;
begin
  result := AbMinInt(x1, Max);
  result := AbMaxInt(result, Min);
end;


{黚erpr黤t 黚erschneidungsbereich zweier rechtecke (r1,r2) dieser bereich wird
 in rY zur點kgegeben. handelt es sich um einen g黮tigen bereich dann ist
 result True}

function AbRectIntersection(r1, r2: TRect; var rY: TRect): Boolean;
begin
  rY.Left := AbMaxInt(r1.Left, r2.Left);
  rY.Top := AbMaxInt(r1.Top, r2.Top);
  rY.Right := AbMinInt(r1.Right, r2.Right);
  rY.Bottom := AbMinInt(r1.Bottom, r2.Bottom);
  result := ((rY.Left <= rY.Right) and (rY.Top <= rY.Bottom));
end;

{Tests weather point x/y is in rectangle R or not.}

function AbInRect(x, y: Integer; r: TRect): Boolean;
begin
  result := ((x >= r.Left) and (x < r.Right) and (y >= r.Top) and (y <=
    r.Bottom));
end;

function AbRectIsRect(r, r2: TRect): Boolean;
// result is true if R is equal R2
begin
  result := (r.Left = r2.Left) and
    (r.Right = r2.Right) and
    (r.Top = r2.Top) and
    (r.Bottom = r2.Bottom);
end;

function AbRectInRect(r, r2: TRect): Boolean;
// result is true if R is fully in R2
begin
  result := (r.Left >= r2.Left) and
    (r.Right <= r2.Right) and
    (r.Top >= r2.Top) and
    (r.Bottom <= r2.Bottom);
end;

procedure AbBorder(var r: TRect; Border: Integer);
begin
  r.Left := r.Left + Border;
  r.Top := r.Top + Border;
  r.Right := r.Right - Border;
  r.Bottom := r.Bottom - Border;
end;

procedure AbMultiBorder(var r: TRect; Left, Top, Right, Bottom: Integer);
begin
  r.Left := r.Left + Left;
  r.Top := r.Top + Top;
  r.Right := r.Right - Right;
  r.Bottom := r.Bottom - Bottom;
end;

{4 bytes general settings are stored in Array[0]}

procedure AbArrowSettings(var Field: array of TPoint; NoOfPoints, Options,
  Radius1, Radius2: Byte);
var
  arrS              : array[0..7] of Byte;
begin
  arrS[0] := NoOfPoints;
  arrS[1] := Options;
  arrS[4] := Radius1;
  arrS[5] := Radius2;
  move(arrS, Field, 8);
end;

function AbCenterPoint(r: TRect): TPoint;
begin
  result.x := r.Left + ((r.Right - r.Left) div 2);
  result.y := r.Top + ((r.Bottom - r.Top) div 2);
end;

{ Punkt A wird um den Winkel Alpha um Bezugspunkt B Rotiert <BR>
        <TAB>A <TAB><TAB> = zu rotierender Punkt <BR>
        <TAB>B <TAB><TAB> = Bezugspunkt (um den Rotiert wird) <BR>
        <TAB>Alpha <TAB>  = Rotations - Winkel in Altgrad <BR>
        <TAB>DRight <TAB> = Richtung der Rotation : (true=rechts, false=links) <BR>
        <TAB>Ax,Ay <TAB>  = Hilfsvariablen <BR>
        <TAB>Rad <TAB>    = Rotations - Winkel im Bogenma