ALGLOBE

Top  Previous  Next

{ AL komponenscsalád

 

TGlobe            = Glóbusz fokhálózattal

 

}

 

unit ALGlobe;

 

interface

 

uses

SysUtils, WinTypes, WinProcs, Messages, Classes,

Graphics, Controls, Forms, Dialogs, stdctrls, ExtCtrls;

 

type

TGlobe = class(TCustomControl)

private

  FRadius : integer;

  FBackColor : TColor;

  FForeColor : TColor;

  FCrossColor : TColor;

  FAxisAngle1 : extended;

  FAxisAngle2 : extended;

  FTotal : boolean;

  procedure SetRadius(Value:integer);

  procedure SetBackColor(Value:TColor);

  procedure SetForeColor(Value:TColor);

  procedure SetCrossColor(Value:TColor);

  procedure SetAxisAngle1(Value:extended);

  procedure SetAxisAngle2(Value:extended);

  procedure SetTotal(Value:boolean);

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

protected

  Procedure Paint;override;

public

  constructor Create(AOwner:TComponent);override;

  destructor Destroy;override;

  property Canvas;

published

  Property Radius : integer read FRadius write SetRadius ;

  Property BackColor : TColor read FBackColor write SetBackColor ;

  Property ForeColor : TColor read FForeColor write SetForeColor ;

  Property CrossColor : TColor read FCrossColor write SetCrossColor ;

  Property AxisAngle1 : extended read FAxisAngle1 write SetAxisAngle1 ;

  Property AxisAngle2 : extended read FAxisAngle2 write SetAxisAngle2 ;

  Property Total : boolean read FTotal write SetTotal ;

end;

 

procedure Register;

 

 

implementation

 

procedure Register;

begin

   RegisterComponents('AL',[TGlobe]);

end;

 

constructor TGlobe.Create(AOwner:TComponent);

begin

   inherited Create(AOwner);

   width     := 100;

   height    := 100;

   BackColor := clBlack;

   ForeColor := clYellow;

   CrossColor:= clSilver;

   AxisAngle1:= 0;

   AxisAngle2:= 0;

   Total     := True;

end;

 

destructor TGlobe.Destroy;

begin

   inherited Destroy;

end;

 

procedure TGlobe.WMSize(var Msg: TWMSize);

var t: TRect;

begin

t:=rect(0,0,Msg.width,Msg.height);

Total:=Total;

end;

 

procedure TGlobe.SetRadius(Value:integer);

begin

If FRadius<>Value then begin

   FRadius:=Value;

   invalidate;

end;

end;

 

 

procedure TGlobe.SetBackColor(Value:TColor);

begin

If FBackColor<>Value then begin

   FBackColor:=Value;

   invalidate;

end;

end;

 

 

procedure TGlobe.SetForeColor(Value:TColor);

begin

If FForeColor<>Value then begin

   FForeColor:=Value;

   invalidate;

end;

end;

 

 

procedure TGlobe.SetCrossColor(Value:TColor);

begin

If FCrossColor<>Value then begin

   FCrossColor:=Value;

   invalidate;

end;

end;

 

 

procedure TGlobe.SetAxisAngle1(Value:extended);

begin

If FAxisAngle1<>Value then begin

   FAxisAngle1:=Value;

   invalidate;

end;

end;

 

procedure TGlobe.SetAxisAngle2(Value:extended);

begin

If FAxisAngle2<>Value then begin

   FAxisAngle2:=Value;

   invalidate;

end;

end;

 

procedure TGlobe.SetTotal(Value:boolean);

var R: integer;

begin

If FTotal<>Value then begin

   FTotal:=Value;

   If Width>Height then R:=(Height-20) div 2

   else R:=(Width-20) div 2;

   Radius := R;

end;

end;

 

Procedure TGlobe.Paint;

var CX,CY: integer;

begin

With Canvas do begin

  Brush.Style := bsSolid;

  Brush.Color := BackColor;

  FillRect(ClientRect);

  Brush.Color := ForeColor;

  Pen.Style := psSolid;

  Pen.Color := ForeColor;

  CX := Width div 2;

  CY := Height div 2;

  Ellipse(CX-Radius,CY-Radius,CX+Radius,CY+Radius);

end;

inherited Paint;

end;

 

end.