ALSKY

Top  Previous  Next

unit Alsky;

 

interface

 

uses

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

Graphics, Controls, StdCtrls, Forms, Dialogs, DB , Astro, Geom;

 

type

TMapType=(Total,Partial);

 

TCoordType=(Equatorial,Horizontal);

 

TStarRec = record

SAO                : Longint;

GREAK        : byte;

CANSTELLATION : byte;

RA                : real;

DE                : real;

VMG                : real;

FMG                : real;

SP                : string[3]

end;

 

TALSkyMap = class(TCustomControl)

private

  FPen               : TPen;

  FBrush             : TBrush;

  FColor             : TColor;

  FMapType           : TMapType;

  FMapFile           : TFileName;    {Csillagkatalógus file}

  FInnerData         : boolean;      {belső Pascal adatbázisok használata}

  FStarDataSource    : TDataSource;

  FNGCDataSource     : TDataSource;

  FVisualSkyColor    : TColor;

  FNonVisualSkyColor : TColor;

  FMgLimit           : extended;

  FSpektrumSeparit   : boolean;

  FCoordType         : TCoordType;

  FRaLabel           : TLabel;

  FDeLabel           : TLabel;

  FHorizLabel        : TLabel;

  FCoordEnabled      : boolean;

  FCoordColor        : TColor;

  FCoordDiff         : extended;

  FCoordFont         : TFont;

  FEQRekta           : extended;

  FEQDekli : extended;

  FHORAsimuth : extended;

  FHORZenit : extended;

  FStarMgLine : boolean;

  FConstellations: boolean;

  FConstRect: boolean;

  FStarNames: boolean;

  FStarGreakLabels: boolean;

  FSunMoon : boolean;

  FPlanets : boolean;

  FNGC : boolean;

{    FActualDate : TDateTime;}

  FLocalTime : TDateTime;

  FZoneTime : TDateTime;

  FUT : TDateTime;

  FAstroTime : TDateTime;

  FAstroTimeLabel : TLabel;

  FGeoPositionL : extended;

  FGeoPositionD : extended;

  FCentrumRecta : extended;

  FCentrumDecli : extended;

  FMagnify : extended;

  Fora : TTimer;

  FOnTimer: TNotifyEvent;

  procedure SetMapType(Value:TMapType);

  procedure SetMapFile(Value:TFileName);

  procedure SetInnerdata(Value:boolean);

  procedure SetPen(Value: TPen);

  procedure SetBrush(Value: TBrush);

  procedure SetColor(Value:TColor);

  procedure SetVisualSkyColor(Value:TColor);

  procedure SetNonVisualSkyColor(Value:TColor);

  procedure SetMgLimit(Value:extended);

  procedure SetSpektrumSeparit(Value:boolean);

  procedure SetCoordType(Value:TCoordType);

  procedure SetRaLabel(Value:TLabel);

  procedure SetDeLabel(Value:TLabel);

  procedure SetHorizLabel(Value:TLabel);

  procedure SetCoordEnabled(Value:boolean);

  procedure SetCoordColor(Value:TColor);

  procedure SetCoordDiff(Value:extended);

  procedure SetCoordFont(Value:TFont);

  procedure SetStarMgLine(Value:boolean);

  procedure SetConstellations(Value:boolean);

  procedure SetConstRect(Value:boolean);

  procedure SetStarNames(Value:boolean);

  procedure SetStarGreakLabels(Value:boolean);

  procedure SetSunMoon(Value:boolean);

  procedure SetPlanets(Value:boolean);

  procedure SetNGC(Value:boolean);

{    procedure SetActualDate(Value:TDateTime);}

  procedure SetLocalTime(Value:TDateTime);

  procedure SetUT(Value:TDateTime);

  procedure SetAstroTime(Value:TDateTime);

  procedure SetAstroTimeLabel(Value:TLabel);

  procedure SetGeoPositionL(Value:extended);

  procedure SetCentrumRecta(Value:extended);

  procedure SetCentrumDecli(Value:extended);

  procedure SetMagnify(Value:extended);

protected

  innerfile: string;

  pr_mapsugar: integer;       {a körtérkép sugara}

  pr_vmapsugar: integer;      {a körtérkép látható rész sugara}

  pr_stline  : integer;

  pr_centrum : TPoint;        {körtérkép középpontja a képernyőn}

  pr_vcentrum: TPoint;        {körtérkép látható rész középpontja a képernyőn}

  pr_vsugar  : integer;       {a térkép vetítési sugara}

  pr_akttime : TDateTime;

  pr_fok     : extended;          {1 fok ennyi pixel a képen}

  Procedure Paint;override;

  procedure MouseDown(Button: TMouseButton; Shift: TShiftState;

    X, Y: Integer); override;

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

  procedure MouseUp(Button: TMouseButton; Shift: TShiftState;

    X, Y: Integer); override;

  procedure Timer(Sender : TObject);

  procedure Ujrarajzol; virtual;

public

  pr_str     : TStarRec;      {A csillag adatainak rekordja}

  constructor Create(AOwner:TComponent);override;

  destructor Destroy;override;

published

  StarStream : TMemoryStream;

  property Color :TColor read FColor write SetColor default clWhite;

  Property MapType : TMapType read FMapType write SetMapType;

  Property MapFile : TFileName read FMapFile write SetMapFile;

  Property InnerData: boolean read FInnerData write SetInnerData;

  Property StarDataSource : TDataSource read FStarDataSource write FStarDataSource ;

  Property NGCDataSource : TDataSource read FNGCDataSource write FNGCDataSource ;

  Property VisualSkyColor : TColor read FVisualSkyColor write SetVisualSkyColor ;

  Property NonVisualSkyColor : TColor read FNonVisualSkyColor write SetNonVisualSkyColor ;

  Property MgLimit : extended read FMgLimit write SetMgLimit ;

  Property SpektrumSeparit : boolean read FSpektrumSeparit write SetSpektrumSeparit ;

  Property CoordType : TCoordType read FCoordType write SetCoordType ;

  Property RaLabel : TLabel read FRaLabel write SetRaLabel ;

  Property DeLabel : TLabel read FDeLabel write SetDeLabel ;

  Property HorizLabel : TLabel read FHorizLabel write SetHorizLabel ;

  Property CoordEnabled : boolean read FCoordEnabled write SetCoordEnabled ;

  Property CoordColor : TColor read FCoordColor write SetCoordColor ;

  Property CoordDiff : extended read FCoordDiff write SetCoordDiff ;

  Property CoordFont : TFont read FCoordFont write SetCoordFont ;

  Property EQRekta : extended read FEQRekta write FEQRekta ;

  Property EQDekli : extended read FEQDekli write FEQDekli ;

  Property HORAsimuth : extended read FHORAsimuth write FHORAsimuth ;

  Property HORZenit : extended read FHORZenit write FHORZenit ;

 

  Property Constellations:boolean read FConstellations write SetConstellations;

  Property ConstRect:boolean read FConstRect write SetConstRect;

  Property StarNames:boolean read FStarNames write SetStarNames;

  Property StarGreakLabels:boolean read FStarGreakLabels write SetStarGreakLabels;

  Property SunMoon : boolean read FSunMoon write SetSunMoon ;

  Property Planets : boolean read FPlanets write SetPlanets ;

  Property NGC : boolean read FNGC write SetNGC ;

 

{    Property ActualDate : TDateTime read FActualDate write SetActualDate ;}

  Property LocalTime : TDateTime read FLocalTime write SetLocalTime ;

  Property ZoneTime : TDateTime read FZoneTime write FZoneTime ;

  Property UT : TDateTime read FUT write SetUT ;

  Property AstroTime : TDateTime read FAstroTime write SetAstroTime ;

  Property AstroTimeLabel : TLabel read FAstroTimeLabel write SetAstroTimeLabel ;

  Property GeoPositionL : extended read FGeoPositionL write SetGeoPositionL ;

  Property GeoPositionD : extended read FGeoPositionD write FGeoPositionD ;

  Property CentrumRecta : extended read FCentrumRecta write SetCentrumRecta ;

  Property CentrumDecli : extended read FCentrumDecli write SetCentrumDecli ;

  Property Magnify : extended read FMagnify write SetMagnify ;

  property Align;

  {property Ctl3D;}

  property DragCursor;

  property DragMode;

  property Enabled;

  property Hint;

  {property ParentCtl3D;}

  property ParentShowHint;

  Property Top;

  Property Left;

  Property Height default 50;

  Property Width default 50;

  Property Pen : TPen read FPen write SetPen;

  Property Brush : TBrush read FBrush write SetBrush;

  Property OnDblClick;

  property OnClick;

  property OnDragDrop;

  property OnDragOver;

  property OnEndDrag;

  {property OnEnter;}

  {property OnExit;}

  {property OnKeyDown;}

  {property OnKeyPress;}

  {property OnKeyUp;}

  Property OnMouseDown;

  Property OnMouseMove;

  Property OnMouseUp;

  {Property OnTimer: TNotifyEvent read FOnTimer write FOntimer;}

end;

 

VAR filepath: string;

 

procedure Register;

 

 

implementation

 

procedure Register;

begin

   RegisterComponents('Sky',[TALSkyMap]);

end;

 

constructor TALSkyMap.Create(AOwner:TComponent);

begin

   inherited Create(AOwner);

   StarStream:= TMemoryStream.Create;

   FPen      := TPen.Create;

   FBrush    := TBrush.Create;

   Fora      := TTimer.Create(Self);

     Fora.Interval := 10000; {10 sec}

     Fora.Enabled  := True;

     Fora.Ontimer  := Timer;

   Color     := clWhite;

   FMapType       := Total;

   FInnerdata      := True;

   FCoordType      := Equatorial;

   FVisualSkyColor := clNavy;

   FNonVisualSkyColor := clBlack;

   FMgLimit        := 4;

   FSpektrumSeparit:= False;

   CoordEnabled    := True;

   CoordColor      := clSilver;

   FCoordDiff      := 10;

   FCoordFont      := Canvas.Font;

   FEQRekta        := 0;

   FEQDekli        := 0;

   FHORAsimuth     := 0;

   FHORZenit       := 0;

   FSunMoon        := False;

   FPlanets        := False;

   FNGC            := False;

   FGeoPositionL   := 16;

   FGeoPositionD   := 47.5;

{     FActualDate     := now;}

   LocalTime       := now;

   FZoneTime       := now;

   FUT             := now;

   FMagnify        := 1;

   Width           := 50;

   Height          := 50;

   FMapFile        := 'STSTAR.SKY'

end;

 

destructor TALSkyMap.Destroy;

begin

   FPen.Free;

   FBrush.Free;

   Fora.Destroy;

   If StarStream<>nil then StarStream.Destroy;

   inherited Destroy;

end;

 

procedure TALSkyMap.SetMapType(Value:TMapType);

begin

FMapType:=Value;

Case MapType of

total:

  CentrumDecli:=90;

partial:

end;

Invalidate;

end;

 

procedure TALSkyMap.SetMapFile(Value:TFileName);

begin

If FMapFile<>Value then begin

   FMapFile:=Value;

   If FileExists(Value) then begin

      StarStream.LoadFromFile(Value);

   end;

   innerfile:= Value;

   Invalidate;

end;

end;

 

procedure TALSkyMap.SetInnerdata(Value:boolean);

begin

If FInnerdata<>Value then begin

   FInnerdata:=Value;

end;

end;

 

procedure TALSkyMap.SetPen(Value:TPen);

begin

If FPen<>Value then begin

FPen.Assign(Value);

Invalidate;

end;

end;

 

procedure TALSkyMap.SetBrush(Value: TBrush);

begin

If FBrush<>Value then begin

   FBrush.Assign(Value);

   Invalidate;

end;

end;

 

procedure TALSkyMap.SetColor(Value:TColor);

begin

If FColor<>Value then begin

   FColor:=Value;

   Invalidate;

end;

end;

 

 

procedure TALSkyMap.Timer;

begin

If Fora<>nil then begin

   AstroTime := RatoDateTime(KozepidoToCsillagido(LocalTime,GeoPositionL));

end;

end;

 

procedure TALSkyMap.SetVisualSkyColor(Value:TColor);

begin

If FVisualSkyColor<>Value then begin

FVisualSkyColor:=Value;

Invalidate;

end;

end;

 

 

procedure TALSkyMap.SetNonVisualSkyColor(Value:TColor);

begin

If FNonVisualSkyColor<>Value then begin

FNonVisualSkyColor:=Value;

Invalidate;

end;

end;

 

 

procedure TALSkyMap.SetMgLimit(Value:extended);

begin

If FMgLimit<>Value then begin

FMgLimit:=Value;

Invalidate;

end;

end;

 

 

procedure TALSkyMap.SetSpektrumSeparit(Value:boolean);

begin

If FSpektrumSeparit<>Value then begin

FSpektrumSeparit:=Value;

Invalidate;

end;

end;

 

 

procedure TALSkyMap.SetCoordType(Value:TCoordType);

begin

If FCoordType<>Value then begin

FCoordType:=Value;

Invalidate;

end;

end;

 

 

procedure TALSkyMap.SetRaLabel(Value:TLabel);

begin

If Value<>nil then

FRaLabel:=Value;

end;

 

procedure TALSkyMap.SetDeLabel(Value:TLabel);

begin

If Value<>nil then

FDeLabel:=Value;

end;

 

procedure TALSkyMap.SetHorizLabel(Value:TLabel);

begin

If Value<>nil then

FHorizLabel:=Value;

end;

 

procedure TALSkyMap.SetAstroTimeLabel(Value:TLabel);

begin

AstroTimeLabel:=Value;

end;

 

procedure TALSkyMap.SetCoordEnabled(Value:boolean);

begin

If FCoordEnabled<>Value then begin

   FCoordEnabled:=Value;

   Invalidate;

end;

end;

 

 

procedure TALSkyMap.SetCoordColor(Value:TColor);

begin

If FCoordColor<>Value then begin

FCoordColor:=Value;

Invalidate;

end;

end;

 

 

procedure TALSkyMap.SetCoordDiff(Value:extended);

begin

If FCoordDiff<>Value then begin

FCoordDiff:=Value;

Invalidate;

end;

end;

 

 

procedure TALSkyMap.SetCoordFont(Value:TFont);

begin

If FCoordFont<>Value then begin

FCoordFont:=Value;

Invalidate;

end;

end;

 

 

procedure TALSkyMap.SetStarMgLine(Value:boolean);

begin

If FStarMgLine<>Value then begin

FStarMgLine:=Value;

Invalidate;

end;

end;

 

procedure TALSkyMap.SetConstellations(Value:boolean);

begin

If FConstellations<>Value then begin

   FConstellations:=Value;

   Invalidate;

end;

end;

 

procedure TALSkyMap.SetConstRect(Value:boolean);

begin

If FConstRect<>Value then begin

   FConstRect:=Value;

   Invalidate;

end;

end;

 

procedure TALSkyMap.SetStarNames(Value:boolean);

begin

If FStarNames<>Value then begin

   FStarNames:=Value;

   Invalidate;

end;

end;

 

procedure TALSkyMap.SetStarGreakLabels(Value:boolean);

begin

If FStarGreakLabels<>Value then begin

   FStarGreakLabels:=Value;

   Invalidate;

end;

end;

 

procedure TALSkyMap.SetSunMoon(Value:boolean);

begin

If FSunMoon<>Value then begin

FSunMoon:=Value;

Invalidate;

end;

end;

 

 

procedure TALSkyMap.SetPlanets(Value:boolean);

begin

If FPlanets<>Value then begin

FPlanets:=Value;

Invalidate;

end;

end;

 

 

procedure TALSkyMap.SetNGC(Value:boolean);

begin

If FNGC<>Value then begin

FNGC:=Value;

Invalidate;

end;

end;

 

{

procedure TALSkyMap.SetActualDate(Value:TdateTime);

begin

If FActualDate<>Value then begin

   FActualDate:=Value;

   Invalidate;

end;

end;

}

 

procedure TALSkyMap.SetLocalTime(Value:TdateTime);

begin

If FLocalTime<>Value then begin

FLocalTime:=Value;

AstroTime := RatoDateTime(KozepidoToCsillagido(Value,GeoPositionL));

Invalidate;

end;

end;

 

 

procedure TALSkyMap.SetUT(Value:TdateTime);

begin

If FUT<>Value then begin

FUT:=Value;

Invalidate;

end;

end;

 

 

procedure TALSkyMap.SetAstroTime(Value:TdateTime);

begin

If FAstroTime<>Value then begin

FAstroTime:=Value;

If AstroTimeLabel<>nil then

   AstroTimeLabel.Caption := TimeToStr(AstroTime);

Invalidate;

end;

end;

 

 

procedure TALSkyMap.SetGeoPositionL(Value:extended);

begin

If FGeoPositionL<>Value then begin

FGeoPositionL:=Value;

Invalidate;

end;

end;

 

 

procedure TALSkyMap.SetCentrumRecta(Value:extended);

begin

If FCentrumRecta<>Value then begin

   FCentrumRecta:=Value;

   Invalidate;

end;

end;

 

 

procedure TALSkyMap.SetCentrumDecli(Value:extended);

begin

If FCentrumDecli<>Value then begin

   FCentrumDecli:=Value;

   Invalidate;

end;

end;

 

 

procedure TALSkyMap.SetMagnify(Value:extended);

begin

If FMagnify<>Value then begin

   FMagnify:=Value;

   Invalidate;

end;

end;

 

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

    X, Y: Integer);

begin

 inherited MouseDown(Button,Shift,x,y);

end;

 

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

VAR r: extended;

  a,b,c: extended;

begin

 inherited MouseMove(Shift,x,y);

 If Ralabel<>nil then begin

    (Ralabel as Tlabel).Caption:=

    RaToStr(RealToRa(180*(Szakaszszog(pr_centrum.x,pr_centrum.y,x,y)/pi)));

    (Ralabel as Tlabel).Update;

 end;

 If Delabel<>nil then begin

    if pr_fok<>0 then begin

    a:=(x-pr_centrum.x);

    b:=(y-pr_centrum.y);

    c:=a*a+b*b;

    r:=90-SQRT(c)/pr_fok;

    (Delabel as Tlabel).Caption:=DeToStr(RealToDe(r));

    (Delabel as Tlabel).Update;

    end;

 end;

end;

 

procedure TALSkyMap.MouseUp(Button: TMouseButton; Shift: TShiftState;

    X, Y: Integer);

begin

 inherited MouseUp(Button,Shift,x,y);

end;

 

Procedure TALSkyMap.Paint;

begin

Ujrarajzol;

inherited Paint;

end;

 

procedure TALSkyMap.Ujrarajzol;

var kr: integer;

  r,radra: extended;

  x,y,d: integer;

  i,csillagdb: longint;

begin

  pr_stline  := 0;

 

Case MapType of

total:

begin

  pr_centrum := Point(Width div 2,(Height-pr_stline) div 2);

  If Height>Width then pr_mapsugar:= Trunc(0.48*(Width - pr_stline ))

  else pr_mapsugar:= Trunc(0.48*(Height - pr_stline));

  Canvas.Brush.Style:=bsSolid;

  Canvas.Brush.Color:=NonVisualSkyColor;

  Canvas.Ellipse(pr_centrum.x-pr_mapsugar,pr_centrum.y-pr_mapsugar,

                 pr_centrum.x+pr_mapsugar,pr_centrum.y+pr_mapsugar);

  Canvas.Brush.Color:=VisualSkyColor;

  pr_vmapsugar:=Trunc((120+GeoPositionD)*pr_mapsugar/120) div 2;

  pr_vcentrum:=Point(pr_centrum.x,pr_centrum.y+pr_mapsugar-pr_vmapsugar);

  Canvas.Ellipse(pr_vcentrum.x-pr_vmapsugar,pr_vcentrum.y-pr_vmapsugar,

                 pr_vcentrum.x+pr_vmapsugar,pr_vcentrum.y+pr_vmapsugar);

  pr_fok:=pr_mapsugar/120;

 

  If CoordEnabled then begin

     Canvas.Pen.Color:=CoordColor;

     Canvas.Brush.Style:=bsClear;

     For i:=1 to Trunc(120/CoordDiff) do begin

      Canvas.ellipse(pr_centrum.x-Trunc(i*CoordDiff*pr_fok),

                     pr_centrum.y-Trunc(i*CoordDiff*pr_fok),

                     pr_centrum.x+Trunc(i*CoordDiff*pr_fok),

                     pr_centrum.y+Trunc(i*CoordDiff*pr_fok));

     end;

     For i:=1 to 24 do begin

      Canvas.Moveto(pr_centrum.x,pr_centrum.y);

      Canvas.Lineto(pr_centrum.x+Trunc(pr_mapsugar*sin(i*2*pi/12)),

                    pr_centrum.y+Trunc(pr_mapsugar*cos(i*2*pi/12)));

     end;

  end;

 

  {A csillagok megjelenítése adatbázisból}

       Canvas.Pen.Color:=clWhite;

       Canvas.Brush.Color:=clWhite;

       Canvas.Brush.Style:=bsSolid;

 

  If (StarDataSource=nil) or ((Innerdata=True) and (StarStream<>nil)) then begin

     With StarStream do begin

       csillagdb:=Size div SizeOf(TStarRec);

       Seek(0,0);

       For i:=1 to csillagdb do begin

          StarStream.Read(pr_str,SizeOf(TStarRec));

          If (pr_str.VMG<=MgLimit) and (pr_str.DE>-30) then

          With pr_str do begin

            de:=90-de;

            radra:=pi*pr_str.ra/180;

            x := Trunc(pr_centrum.x+DE*pr_fok*cos(radra));

            y := Trunc(pr_centrum.y+DE*pr_fok*sin(radra));

            d := Trunc(6-pr_str.vmg);

            If d<=1 then Canvas.Pixels[x,y]:=clSilver

            else Canvas.Ellipse(x-d,y-d,x+d,y+d);

          end;

       end;

     end;

  end

  else

  With StarDataSource.Dataset do begin

       If not Active then Active:=True;

       First;

       While not EOF do begin

          pr_str.VMG := FieldByName('VMG').AsFloat;

          If (pr_str.VMG<=MgLimit) and (pr_str.DE>-30) then

          With pr_str do begin

            SAO := FieldByName('SAO').AsInteger;

            RA  := FieldByName('RA').AsFloat;

            DE  := 90-FieldByName('DE').AsFloat;

            FMG := FieldByName('FMG').AsFloat;

            radra:=pi*pr_str.ra/180;

            x := Trunc(pr_centrum.x+DE*pr_fok*cos(radra));

            y := Trunc(pr_centrum.y+DE*pr_fok*sin(radra));

            d := Trunc(10-pr_str.vmg);

            If d<2 then Canvas.Pixels[x,y]:=clSilver

            else Canvas.Ellipse(x-d,y-d,x+d,y+d);

          end;

          next;

      end;

  end;

end;

partial:

begin

end;

end;

end;

 

end.