_abproc.pas

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

{Unit with some general used methods.}
unit _AbProc;

{******************************************************************************}
{ Abakus VCL                                                                   }
{                              general methods                                 }
{                                                                              }
{******************************************************************************}
{        e-Mail: [e-mail] , Web: http://www.abaecker.com            }
{------------------------------------------------------------------------------}
{          (c) Copyright 1998..2000 A.Baecker, All rights Reserved             }
{******************************************************************************}

{$I abks.inc}

interface

uses
  Windows,
  Forms,
  Classes,
  Graphics,
  SysUtils,
  extctrls,
  ShellAPI,
  Dialogs,
  Registry;

{$R Abk_run.res}

type
  toPos = (toTopLeft, toTopCenter, toTopRight,
    toMidLeft, toMidCenter, toMidRight,
    toBotLeft, toBotCenter, toBotRight);

  TGradientStyle =
    (gsHorizontal1, gsHorizontal2, gsHorizontal3,
    gsVertical1, gsVertical2, gsVertical3,
    gsElliptic1, gsElliptic2, gsElliptic3,
    gsRectangle, gsDiamond1, gsDiamond2,
    gsTopLeft, gsTopRight);

  TLEDPos = (lpLeft, lpRight, lpTop, lpBottom);
  TLEDShape = (sRound, sArrowLeft, sArrowRight, sArrowUp, sArrowDown,
    sRectangle);


{ convertion int/word <> binary string  }
{==============================================================================}
function AbIntToBin(Value, Digits : Integer):String;
function AbSingleToBin(Value: Single; Digits : Integer):String;

function AbBinToLWord(Value: String):Cardinal;
function AbBinToInt(Value: String):Integer;
function AbBinToSingle(Value: String):Single;



{ Registry - methods to store position(x,y) of property editors  }
{==============================================================================}
procedure AbSaveFormPos(frm : TForm);
procedure AbLoadFormPos(frm : TForm);

{ Scale - functions }
{==============================================================================}
procedure AbRoundSector(can: TCanvas; r: TRect; AlphaFrom, Alpha: Single);

procedure AbArrowDraw(can: TCanvas; Alpha: Single;
  ArrowStartPos: array of TPoint;
  var ArrowActPos: array of TPoint;
  DRight: Boolean);

procedure AbHorizScala(can: TCanvas; Text: string; var r: TRect; Steps,
  SubSteps: Integer; Direction: Boolean);

procedure AbDrawHPointer(can: TCanvas; r: TRect; PPT, w, h: Integer; Direction:
  Boolean);


{ Log - functions }
{==============================================================================}
  {Log10 + Power are not available e.g. in C++Builder 3, so using own routines}
function AbLog10(argument: Extended): Extended;
function AbPower(base, exponent: Extended): Extended;

function AbCalcLogStr(ValueFrom: real; Steps: Integer; Format: string; Rev:
  Boolean): string;
  
function AbLogRangeStr(ExpFrom, ExpTo, Steps: Integer; Format: string; Rev:
  Boolean): string;

function AbRoundLogValue(Value: real; var Exp: Integer): real;


{ textfunctions }
{==============================================================================}
function AbRemoveSign(Text : String; Sign : Char): String;

procedure AbTextOut(can: TCanvas; x1, y1: Integer; Text: string; Pos: toPos);

procedure AbRotTextOut( can : TCanvas;
                        cp     : TPoint;         // center point
                        Angle : Single;      // angle of Textpos / rotation
                        Text : String;       // the text
                        Pos : toPos);     // fMode (see SetTextAlign)

procedure AbTextOut3D(can: TCanvas; x1, y1: Integer; Col, Col1, Col2: TColor;
  Text: string; Pos: toPos; _3D: Boolean);

procedure AbGetTextSize(can: TCanvas; var b, h: Integer; var CenterP: TPoint;
  Text: string);

function AbRangeStr(SignalFrom, SignalTo: Single; Steps: Integer; Format:
  string): string;

procedure AbGetMaxTokenSize(can: TCanvas; var b, h: Integer; Text: string);

function AbStrToken(var Text: string; Separator: Char): string;

{ others }
{==============================================================================}

procedure GetBkUpImage(can: TCanvas; bkBmp:TBitmap; rect : TRect);

function AbMinInt(x1, x2: Integer): Integer;

function AbMaxInt(x1, x2: Integer): Integer;

function AbMinMaxInt(x1, Min, Max: Integer): Integer;

function AbRectIntersection(r1, r2: TRect; var rY: TRect): Boolean;

function AbInRect(x, y: Integer; r: TRect): Boolean;

function AbRectIsRect(r, r2: TRect): Boolean;

function AbRectInRect(r, r2: TRect): Boolean;

procedure AbBorder(var r: TRect; Border: Integer);

procedure AbMultiBorder(var r: TRect; Left, Top, Right, Bottom: Integer);

procedure AbArrowSettings(var Field: array of TPoint; NoOfPoints, Options,
  Radius1, Radius2: Byte);

function AbCenterPoint(r: TRect): TPoint;

function AbRotate(A, b: TPoint; Alpha: Single; DRight: Boolean): TPoint;

function AbGetRadius(r: TRect): Integer;

procedure AbGetMaxRect(x, y: Integer; var r: TRect);

function AbExecuteFile(const FileName, Params, DefaultDir: string; ShowCmd:
  Integer): THandle;

function AbDelphiIsRunning: Smallint;

function AbCBIsRunning: Smallint;

procedure AbEllipse3D(can: TCanvas; var r: TRect; Color: TColor; Raised:
  Boolean);

procedure Ab3DEllipse(can: TCanvas;
  TopLeft,
  cp: TPoint;
  dx: Integer;
  dy: Integer;
  GradBmp: TBitmap;
  PenCol: TColor;
  Raised,
  DrawLine: Boolean);

procedure AbCircleAtPoint(can: TCanvas; Point: TPoint; Radius: Integer; PenCol,
  BrushCol: TColor);

function AbGetAngle(cp, p: TPoint): Single;

procedure AbThumb(can: TCanvas; cp: TPoint; Size, Style: Integer; Horizontal:
  Boolean; Color: TColor);

function AbInCircle(x, y: Integer; rCircle: TRect): Boolean;

function AbMakeSquare(r: TRect): TRect;
function AbMakeCenterSquare(r: TRect): TRect;

procedure AbBtnBevel(can: TCanvas; var r: TRect; up, filled: Boolean; FillCol:
  TColor);

procedure AbCircleGradFill(can: TCanvas; Rect: TRect; ColFrom, ColTo: TColor);

procedure AbGradFill(can: TCanvas;
  r: TRect;
  ColFrom, ColTo: TColor;
  Style: TGradientStyle);

function AbCalcColor(ColFrom,           //
  ColTo: TColor;                        //
  Steps,                                // number of steps
  step: Integer)                        // present step
  : TColor;                             // calculated color

procedure AbDrawLED(can: TCanvas; r: TRect; Shape: TLEDShape; Col1, Col2:
  TColor);


var
  AppPath           : string;
  gradSteps         : Integer;
  FID               : Integer;
  running           : Smallint = 0;
  tim               : Cardinal = 0;
  VCLRoot           : String;
  AbkRoot           : String;

const               // don't replace the following 6 lines !!!!!
  Company           : string = 'Hard- & Software A.Baecker';
  pName             : string = 'Abakus VCL';
  pVersion          : string = '2.4.3.6';
  Copyright         : string = '(c) 1998-2002 A.Baecker, all Rights reserved.';
  Mail              : string = '[e-mail]';
  WWW               : string = 'http:\\www.AbakusVCL.com';
  

  AbakusRootKey   : HKEY = HKEY_LOCAL_MACHINE;
  AbakusKeyPath   : String = 'SOFTWARE\Abakus VCL\Data\';

  crHand            = 5;      // hand-cursor

implementation

uses AbFlashT;

function GetComponentRoot: String;
var
  reg : TRegistry;
  str : String;
begin
  str := '';
  reg := TRegistry.Create;
  try
    Reg.RootKey := AbakusRootKey;
    Reg.OpenKey('SOFTWARE\Abakus VCL\', false);
    str := Reg.ReadString('RootDir');
  finally
    Reg.CloseKey;
    Reg.Free;
  end;
  AbkRoot := str;

  {$IFDEF CB3}
     str := Str + '\CB3';
  {$ENDIF}
  {$IFDEF CB4}
     str := Str + '\CB4';
  {$ENDIF}
  {$IFDEF CB5}
     str := Str + '\CB5';
  {$ENDIF}
  {$IFDEF D3}
     str := Str + '\D3';
  {$ENDIF}
  {$IFDEF D4}
     str := Str + '\D4';
  {$ENDIF}
  {$IFDEF D5}
     str := Str + '\D5';
  {$ENDIF}
  {$IFDEF D6}
     str := Str + '\D6';
  {$ENDIF}
  result := str;

end;

function AbIntToBin(Value, Digits : Integer):String;
{===============================================================================
 Convert's the "Value" into a binary string (result), if "Digits" =
         1..32 : result is filled with leading zero's
         0     : no leading zero's
         > 32  : limited to 32 digits
===============================================================================}
var
  n : Integer;
  str : String;
  val : Integer;
begin
  str := '';
  val := 0;
  if Digits < 0 then digits := 0;
  for n := 0 to 31 do begin
    if (Value and (1 shl n) <> 0) then begin
      val := val + (1 shl n);
      str := '1' + Str;
    end else begin
      str := '0' + Str;
    end;
    if ((Value = val) and (Digits=0)) or ((n = Digits) and (Digits<>0)) then begin
      result := str;
      exit;
    end;
  end;
  result := str;
end;


function AbSingleToBin(Value: Single; Digits : Integer):String;
{===============================================================================
 creates a binary string from a single "Value"
===============================================================================}
var
  int : Integer;
  val : Single;
begin
  val := Value;
  move(val,int,SizeOf(Int));
  result := AbIntToBin(int, Digits);
end;


function AbBinToLWord(Value: String):Cardinal;
{===============================================================================
 Convert's the "Value" Bin-string into Cardinal (result)  (0..4294967295)
===============================================================================}
var
  n : Integer;
  lWrd : Cardinal;
begin
  result := 0;
  lWrd := 1;
  for n := length(Value) downto 1  do begin
     if (Value[n] = '1') then Inc(Result,lWrd);
     lWrd := lWrd shl 1;
  end;
end;

function AbBinToInt(Value: String):Integer;
{===============================================================================
 Convert's the "Value" Bin-string into Integer (result)  (-2147483648..2147483647)
===============================================================================}
var
  v1 : Cardinal;
  v2 : Integer;
begin
  V1 := AbBinToLWord(Value);
  move(V1,V2,SizeOf(V1));
  result := V2;
end;

function AbBinToSingle(Value: String):Single;
{===============================================================================
 Convert's the "Value" Bin-string into Single var
===============================================================================}
var
  v1 : Cardinal;
  v2 : Single;
begin
  V1 := AbBinToLWord(Value);
  move(V1,V2,SizeOf(V1));
  result := V2;
end;


function AbRemoveSign(Text : String; Sign : Char): String;
{===============================================================================
 removes the sign "Sign" in string "Test"
===============================================================================}
var
  n : Integer;
begin
  result := '';
  for n := 1 to Length(Text) do begin
     if (Text[n] <> Sign) then result := result + Text[n];
  end;
end;


{ Registry - functions to store/read pos(x,y) of property editors  }
{==============================================================================}
  // "frm" - ClassName is used as SubPath to store infos in registry
  // requires an unique ClassName of "frm" ,
  // Pos. where info's are saved i registry will be :
  //      (AbakusRootKey)\(AbakusKeyPath)\(frm.ClassName)

procedure AbSaveFormPos(frm : TForm);
var
  pos : TPoint;
  reg : TRegistry;
begin
  pos := Point(frm.Left, frm.Top);

  // may correct the form position if is not fully in screen
  if pos.x < 0 then Pos.x := 0;
  if pos.x + frm.Width > Screen.Width then pos.x :=  Screen.Width - frm.Width;

  if pos.y < 0 then pos.y := 0;
  if pos.y + frm.Height > Screen.Height then pos.y := Screen.Height - frm.Height;

  reg := TRegistry.Create;
  try
    Reg.RootKey := AbakusRootKey;
    Reg.OpenKey(AbakusKeyPath + frm.ClassName, true);
    Reg.WriteBinaryData('Position', Pos, SizeOf(Pos));
  finally
    Reg.CloseKey;
    Reg.Free;
  end;

end;

procedure  AbLoadFormPos(frm : TForm);
var
  pos : TPoint;
  reg : TRegistry;
begin
  reg := TRegistry.Create;
  try
    pos := Point(frm.Left, frm.Top);

    Reg.RootKey := AbakusRootKey;
    Reg.OpenKey(AbakusKeyPath + frm.ClassName, false);
    Reg.ReadBinaryData('Position', Pos, SizeOf(Pos));

    // may correct the form position if is not fully in screen
    if pos.x < 0 then Pos.x := 0;
    if pos.x + frm.Width > Screen.Width then pos.x :=  Screen.Width - frm.Width;

    if pos.y < 0 then pos.y := 0;
    if pos.y + frm.Height > Screen.Height then pos.y := Screen.Height - frm.Height;

    frm.SetBounds(pos.x,pos.y,frm.Width,frm.Height);

  finally
    Reg.CloseKey;
    Reg.Free;
  end;

end;
{==============================================================================}


function AbLog10(argument: Extended): Extended;
begin
  result := Ln(argument) / Ln(10);
end;

function AbPower(base, exponent: Extended): Extended;