unit tspinningglobe;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,stdctrls,extctrls;


type TSpinGlobeThread = class (TThread)
   private
    { Private declarations }
    fupdateproc : TNotifyEvent;
  protected
    procedure Execute; override;
    procedure Update;
  public
  property UpdateProc : TNotifyEvent write fupdateproc;
end;


type
  TSpinGlobe = class(TCustomControl)
  private
  updatethread : TSpinGlobeThread;
  count : integer;
  o : tbitmap;
    a : hrgn;
  { Private declarations }


  protected

    { Protected declarations }
  public
  h : thandle;
  fpp : pointer;

  constructor Create(AOwner : TComponent); override;
  destructor Destroy;override;
  procedure advance(Sender : Tobject);

  procedure start;
  procedure stop;
  procedure Paint; override;
  procedure Resize; override;


    { Public declarations }
  published
    { Published declarations }
  end;

procedure Register;

implementation
{$R spinglobe.RES}



constructor TSpinglobe.Create(AOwner : TComponent);

begin
     o:=tbitmap.create;
     inherited Create (AOwner);
     Parent := (AOwner AS TWinControl);
     // controlstyle:=controlstyle-[csOpaque];

     width:=152;
     height:=152;



     count:=0;
     o.width:=width;
     o.height:=height;
     advance(self);
     paint;
     updatethread:=TSpinGlobeThread.Create(true);
     updatethread.FreeOnTerminate:=true;
     updatethread.UpdateProc:=advance;

end;

destructor TSpinglobe.Destroy();
begin
 o.free;
 inherited Destroy;
 updatethread.Terminate;
 if updatethread.Terminated=false then updatethread.WaitFor;

end;

procedure TSpinglobe.Paint;
begin
if parent=nil then exit;

inherited paint;
canvas.Draw(0,0,o);
end;

procedure Tspinglobe.advance;
begin
if self=nil then exit;
inc(count);
if count>9 then count:=1;
o.LoadFromResourceName(hinstance,'G'+inttostr(count));
paint;
end;

procedure Register;
begin
  RegisterComponents('LibrarySmith', [TSpinGlobe]);
end;


procedure TSpinglobe.start;
begin
visible:=true;
if updatethread.Suspended then updatethread.Resume;
end;

procedure TSpinglobe.stop;
begin
visible:=false;
if updatethread.Suspended=false then updatethread.Suspend;
end;


procedure Tspinglobe.Resize();
begin
     a:=CreateEllipticRgn(1,1, Width, Height);
     if a<>0 then begin
       setwindowrgn(self.handle ,a,true);
     end;

end;


procedure TSpinGlobeThread.Update;
begin
fupdateproc(self);
end;

procedure TSpinGlobeThread.Execute;
var
n : integer;
begin
  n:=0;
  while 1<2 do begin
     inc(n);
     if n=5 then begin
       synchronize(Update);
       sleep(100);
       if terminated=true then exit;
       n:=0;
     end;

  end;
end;



end.