VONALZO

Top  Previous  Next

 

{Vonalzó skálák megjkelenitő komponens}

 

unit Vonalzo;

 

interface

 

uses

SysUtils, WinTypes, WinProcs, Messages, Classes, ExtCtrls,

Graphics, Controls, Forms, Dialogs;

 

type

 

TLayerStyle = (tvVonalas, tvPontos, tvKozepvonalas);

 

TLayer = class(TImage)

private

  FVonalzoStilus : TLayerStyle;

  FVonalzoJel : boolean;

  FColor : TColor;

  FSkalaSzin : TColor;

  FVonalzoJelSzin : TColor;

  FMax : real;

  FMin : real;

  FFont : TFont;

  FJelKoord : real;

  FBeosztas : real;

  FSzamformat : string;

  procedure SetVonalzoStilus(Value:TLayerStyle);

  procedure SetVonalzoJel(Value:boolean);

  procedure SetColor(Value:TColor);

  procedure SetSkalaSzin(Value:TColor);

  procedure SetVonalzoJelSzin(Value:TColor);

  procedure SetMax(Value:real);

  procedure SetMin(Value:real);

  procedure SetFont(Value:TFont);

  procedure SetJelKoord(Value:real);

  procedure SetBeosztas(Value:real);

  procedure SetSzamformat(Value:string);

protected

public

  constructor Create(AOwner:TComponent);override;

  destructor Destroy;override;

  Procedure Paint;override;

published

  Property VonalzoStilus : TLayerStyle read FVonalzoStilus write SetVonalzoStilus ;

  Property VonalzoJel : boolean read FVonalzoJel write SetVonalzoJel ;

  Property Color : TColor read FColor write SetColor ;

  Property SkalaSzin : TColor read FSkalaSzin write SetSkalaSzin ;

  Property VonalzoJelSzin : TColor read FVonalzoJelSzin write SetVonalzoJelSzin ;

  Property Max : real read FMax write SetMax ;

  Property Min : real read FMin write SetMin ;

  Property Font : TFont read FFont write SetFont ;

  Property JelKoord : real read FJelKoord write SetJelKoord ;

  Property Beosztas : real read FBeosztas write SetBeosztas ;

  Property Szamformat : string read FSzamformat write SetSzamformat ;

end;

 

type

 EPowerException = class(Exception)

end;

 

procedure Register;

Function  Kerekit(sz:real;tizedes:integer):extended;

function Power(X, N : real) : extended;

 

implementation

 

procedure Register;

begin

   RegisterComponents('AL',[TLayer]);

end;

 

constructor TLayer.Create(AOwner:TComponent);

begin

   inherited Create(AOwner);

   FVonalzoStilus := tvVonalas;

   FColor         := clWhite;

   FSkalaszin     := clBlack;

   FMin           := 0;

   FMax           := 100;

{     FFont          := Parent.Font;}

   FVonalzoJel    := True;

   FJelKoord      := 0;

   Szamformat     := '3.1';

end;

 

destructor TLayer.Destroy;

begin

   inherited Destroy;

end;

 

 

procedure TLayer.SetVonalzoStilus(Value:TLayerStyle);

begin

If FVonalzoStilus<>Value then begin

   FVonalzoStilus:=Value;

   Invalidate;

end;

end;

 

 

procedure TLayer.SetVonalzoJel(Value:boolean);

begin

If FVonalzoJel<>Value then begin

   FVonalzoJel:=Value;

   Invalidate;

end;

end;

 

 

procedure TLayer.SetColor(Value:TColor);

begin

If FColor<>Value then begin

   FColor:=Value;

   Invalidate;

end;

end;

 

 

procedure TLayer.SetSkalaSzin(Value:TColor);

begin

If FSkalaSzin<>Value then begin

   FSkalaSzin:=Value;

   Invalidate;

end;

end;

 

 

procedure TLayer.SetVonalzoJelSzin(Value:TColor);

begin

If FVonalzoJelSzin<>Value then begin

   FVonalzoJelSzin:=Value;

   Invalidate;

end;

end;

 

 

procedure TLayer.SetMax(Value:real);

begin

If FMax<>Value then begin

   FMax:=Value;

   Invalidate;

end;

end;

 

 

procedure TLayer.SetMin(Value:real);

begin

If FMin<>Value then begin

   FMin:=Value;

   Invalidate;

end;

end;

 

 

procedure TLayer.SetFont(Value:TFont);

begin

If FFont<>Value then begin

   FFont:=Value;

   Invalidate;

end;

end;

 

 

procedure TLayer.SetJelKoord(Value:real);

begin

If FJelKoord<>Value then begin

   FJelKoord:=Value;

   Invalidate;

end;

end;

 

procedure TLayer.SetBeosztas(Value:real);

begin

If FBeosztas<>Value then begin

   FBeosztas:=Value;

   Invalidate;

end;

end;

 

procedure TLayer.SetSzamformat(Value:string);

begin

If FSzamformat<>Value then begin

   FSzamformat:=Value;

   Invalidate;

end;

end;

 

{   K e r e k i t (sz,tizedes)

  --------------------------

  Az sz valós számot 'tizedes' jegyre kerekíti.

  pl. Kerekit(12.346,2)  = 12.35

      Kerekit(12.346,0)  = 12

      Kerekit(12.346,-1) = 10

}

Function Kerekit(sz:real;tizedes:integer):extended;

var szorzo: extended;

  s: String;

begin

  szorzo:=Power(10,tizedes);

  s:=IntToStr(Round(sz*szorzo));

  Insert(DecimalSeparator,s,Length(s)-tizedes+1);

  If sz=0 then result:=0 else

  Result:=StrToFloat(s);

end;

 

function Power(X, N : real) : extended;

var

t : longint;

r : real;

isInteger : boolean;

begin

 

 if N = 0 then begin

    result := 1.0;

    exit;

 end;

 

 if X = 1.0 then begin

    result := 1.0;

    exit;

 end;

 

 if X = 0.0 then begin

    if N > 0.0 then

       begin

         result := 0.0;

         exit;

       end

    else

      raise EPowerException.Create('Infinite Result');

 end;

 

 if (X > 0) then

    try

       result := exp(N * ln(X));

       exit;

    except

       raise EPowerException.Create('Overflow/Underflow Result');

 end;

 

 

{ X is negative but we still may compute the result if n is an integer}

{ try and get integer portion of n into a longint, it will be quicker to

}       { compute odd n}

try

   t := trunc(n);

   if (n - t) = 0 then

      isInteger := true

   else

      isInteger := False;

except

   {Bit superfluous as result will probably underflow/overflow anyway}

   r := int(n);

   if (n - r) = 0 then

      begin

         isInteger := true;

         if frac(r/2) = 0.5 then

            t := 1

         else

            t := 2;

      end

   else

      isInteger := False;

end;

 

if isInteger then

    begin

       {n is an integer}

       if odd(t) then

          {n is odd}

          try

             result := -exp(N * ln(-X));

             exit;

          except

             raise EPowerException.Create('Overflow/Underflow Result');

          end

       else

          {n is even}

          try

             result := exp(N * ln(-X));

             exit;

          except

             raise EPowerException.Create('Overflow/Underflow Result');

          end;

    end

 else

    raise EPowerException.Create('Complex Result');

 

end;

 

Procedure TLayer.Paint;

var b:extended;

  mszorzo: real;         {torzítási tényező}

  xvonalzo: boolean;     {True, ha x vonalzó}

  vonas: real;

  vh: integer;

  y: integer;

  elteres: extended;

  xx,yy: integer;

begin

With Canvas do begin

  xvonalzo:=Width>Height;

  vonas:=min;

  b:=beosztas;

  mszorzo:=width/(max-min);

  vh:=5;

  While vonas<=max do begin

       y:=Trunc(mszorzo*(vonas-min));

       if not xvonalzo then y:=width-y;

       elteres:=KEREKIT(FRAC(vonas),3);

       If (elteres=0.5) then vh:=5 else vh:=2;

       If (elteres=0) or (elteres=1) then begin

        vh:=10;

        if not xvonalzo then begin

           xx:=0; yy:=y;

        end else begin

           xx:=y; yy:=10;

        end;

        Canvas.MoveTo(xx,yy);

        Canvas.TextOut(xx,yy,Format('%'+Szamformat+'f',[vonas]));

       end;

        if not xvonalzo then begin

           xx:=Width; yy:=y;

           Canvas.MoveTo(xx,yy);

           Canvas.LineTo(xx-vh,yy);

        end else begin

           xx:=y; yy:=vh;

           Canvas.MoveTo(xx,0);

           Canvas.LineTo(xx,yy);

        end;

    vonas:=vonas+b;

  end;

end;

end;

 

end.