ASZOG

Top  Previous  Next

unit Aszog;

 

interface

 

uses

SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, ExtCtrls, Geom;

 

type

TAngleChangeEvent = procedure(Sender: TObject; var Angle: integer) of object;

 

TActivAngle = class(TShape)

private

  w,h      : integer;

  elso     : boolean;

  FColor   : TColor;

  FAngle   : integer;

  FFixAngle: integer;

  FSkala   : boolean;

  FOnAngleChange : TAngleChangeEvent;

  FOnFixAngleChange : TAngleChangeEvent;

  FAngleLabel: Tlabel;

  FFixAngleLabel: Tlabel;

  procedure SetSkala(Value:boolean);

  procedure SetColor(Value:TColor);

  procedure WMSize(var Msg: TWMSize); message WM_SIZE;

  procedure SetAngle(Value:integer);

  procedure SetFixAngle(Value:integer);

protected

  oldAngle : real;

  oldrad_,rad_ : real;

  oldFixAngle  : real;

  Fixrad_      : real;

  oldFixrad_   : real;

  procedure MutatoRajzol;

  procedure MouseDown(Button: TMouseButton; Shift: TShiftState;

    X, Y: Integer); override;

  procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;

public

  constructor Create(AOwner:TComponent);override;

  destructor Destroy;override;

  procedure Paint;override;

published

  Property Angle : integer read FAngle write SetAngle default 0;

  Property Skala : boolean read FSkala write SetSkala;

  Property FixAngle : integer read FFixAngle write SetFixAngle default 0;

  property Color:TColor read FColor write SetColor;

  property AngleLabel: Tlabel read FAngleLabel write FAngleLabel;

  property FixAngleLabel: Tlabel read FFixAngleLabel write FFixAngleLabel;

  Property OnAngleChange : TAngleChangeEvent read FOnAngleChange

           write FOnAngleChange;

  Property OnFixAngleChange : TAngleChangeEvent read FOnFixAngleChange

           write FOnFixAngleChange;

end;

 

procedure SzogmeroSkalaRajzol(ca:TCanvas;u,v,r,beosztas:integer);

procedure Register;

 

implementation

 

procedure Register;

begin

RegisterComponents('AL',[TActivAngle]);

end;

 

constructor TActivAngle.Create(AOwner:TComponent);

begin

   inherited Create(AOwner);

   elso := True;

   Shape := stCircle;

   Color:=clOlive;

   rad_ :=0;  oldrad_:=0;

   fixrad_ :=0;  oldfixrad_:=0;

   FAngle := 0;

   FixAngle := 0;

   Width := 80;

   Height:= 80;

end;

 

destructor TActivAngle.Destroy;

begin

   inherited Destroy;

end;

 

procedure TActivAngle.SetSkala(Value:boolean);

begin

If FSkala<>Value then begin

   FSkala := Value;

   invalidate;

end;

end;

 

procedure TActivAngle.SetColor(Value:TColor);

begin

If FColor<>Value then begin

   FColor:=Value;

   Brush.Color := Value;

   Invalidate;

end;

end;

 

procedure TActivAngle.SetAngle(Value:integer);

Var szog : integer;

begin

 oldrad_ := 2*PI-PI*FAngle/180;

 Value := (360-Value) mod 360;

 If FAngle<>Value then begin

    rad_ := 2*PI-PI*Value/180;

    FAngle:= Value; szog:=FAngle;

    If Assigned(FOnAngleChange) then FOnAngleChange(Self,szog);

    If FAngle<>szog then FAngle:=szog;

    If AngleLabel<>nil then AngleLabel.Caption:=IntToStr(FAngle);

    MutatoRajzol;

 end;

end;

 

procedure TActivAngle.SetFixAngle(Value:integer);

Var szog : integer;

begin

 oldFixrad_ := 2*PI-PI*FFixAngle/180;

 Value := Value mod 360;

 If FFixAngle<>Value then begin

    fixrad_ := 2*PI-PI*Value/180;

    FFixAngle:= Value; szog:=FFixAngle;

    If Assigned(FOnFixAngleChange) then FOnFixAngleChange(Self,szog);

    If FixAngleLabel<>nil then FixAngleLabel.Caption:=IntToStr(FFixAngle);

 end;

end;

 

procedure TActivAngle.WMSize(var Msg: TWMSize);

begin

  inherited;

  If Msg.Width <> Msg.Height then begin

     If Msg.Width < Msg.Height then Msg.Height:=Msg.Width

     else Msg.Width:=Msg.Height;

     Width := Msg.Width;

     Height := Width;

     w := width div 2;

     h := Height div 2;

  end;

end;

 

procedure TActivAngle.MouseDown(Button: TMouseButton; Shift: TShiftState;

    X, Y: Integer);

begin

Angle:= Trunc(180*Szakaszszog(w,h,x,y)/PI);

FixAngle := Angle;

Canvas.MoveTo(w,h);

Canvas.LineTo(Trunc(w*(1+COS(oldfixrad_))),Trunc(h*(1+SIN(oldfixrad_))));

Canvas.MoveTo(w,h);

Canvas.LineTo(Trunc(w*(1+COS(fixrad_))),Trunc(h*(1+SIN(fixrad_))));

inherited MouseDown(Button, Shift, X, Y);

end;

 

procedure TActivAngle.MouseMove(Shift: TShiftState; X, Y: Integer);

begin

Angle:= Trunc(180*Szakaszszog(w,h,x,y)/PI);

inherited MouseMove(Shift, X, Y);

end;

 

procedure TActivAngle.Paint;

begin

   inherited Paint;

   MutatoRajzol;

end;

 

procedure TActivAngle.MutatoRajzol;

begin

   w := width div 2;

   h := Height div 2;

   With canvas do begin

        Pen.Mode:=pmCopy;

        Pen.Color:=clBlack;

        MoveTo(w,h); LineTo(2*w,h);

        If Skala then SzogmeroSkalaRajzol(Canvas,w,h,w-4,10);

        Pen.Mode:=pmXor;

        pen.width:=2;

        Pen.Color:=clRed;

        If not elso then begin

           MoveTo(w,h);

           LineTo(Trunc(w*(1+COS(oldrad_))),Trunc(h*(1+SIN(oldrad_))));

        end;

        MoveTo(w,h);

        LineTo(Trunc(w*(1+COS(rad_))),Trunc(h*(1+SIN(rad_))));

        elso:=False;

  end;

end;

 

procedure SzogmeroSkalaRajzol(ca:TCanvas;u,v,r,beosztas:integer);

var i,sz,si,co: real;

  rr: integer;

begin

i:=0; sz:=2*pi*(beosztas/360);

ca.pen.color:=clBlack;

rr:=2;

While i < 2*pi do begin

   si := v+r*SIN(i); co:=u+r*COS(i);

   ca.Rectangle(Trunc(co-rr),Trunc(si-rr),Trunc(co+rr),Trunc(si+rr));

   i := i+sz;

end;

end;

 

end.