| 1 | { **************************************************************
 | 
|---|
| 2 |         Package: XWB - Kernel RPCBroker
 | 
|---|
| 3 |         Date Created: Sept 18, 1997 (Version 1.1)
 | 
|---|
| 4 |         Site Name: Oakland, OI Field Office, Dept of Veteran Affairs
 | 
|---|
| 5 |         Developers: Danila Manapsal, Don Craven, Joel Ivey
 | 
|---|
| 6 |         Description: Displays VistA splash screen.
 | 
|---|
| 7 |         Current Release: Version 1.1 Patch 40 (January 7, 2005))
 | 
|---|
| 8 | *************************************************************** }
 | 
|---|
| 9 | 
 | 
|---|
| 10 | unit Splvista;
 | 
|---|
| 11 | 
 | 
|---|
| 12 | {       1.1*14 Modified the tick types so that code will work with D3, D4,
 | 
|---|
| 13 |         D5. -- DPC 3/30/00
 | 
|---|
| 14 | 
 | 
|---|
| 15 |         1.1*11 Changed
 | 
|---|
| 16 |         from:   var StartTick: longint;
 | 
|---|
| 17 |         to:     var StartTick: longword
 | 
|---|
| 18 |         from:   procedure SplashClose(TimeOut: longint);
 | 
|---|
| 19 |         to:     procedure SplashClose(TimeOut: longword);
 | 
|---|
| 20 |         [Warning] Splvista.pas(53): Combining signed and unsigned types - widened both operands
 | 
|---|
| 21 |          In Delphi 5 (ver130), GetTickCount's result is of type DWORD, longword
 | 
|---|
| 22 |          danila - 9/27/99}
 | 
|---|
| 23 | 
 | 
|---|
| 24 | interface
 | 
|---|
| 25 | 
 | 
|---|
| 26 | uses
 | 
|---|
| 27 |   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
 | 
|---|
| 28 |   Forms, Dialogs, ExtCtrls, StdCtrls;
 | 
|---|
| 29 | 
 | 
|---|
| 30 | type
 | 
|---|
| 31 |   TfrmVistaSplash = class(TForm)
 | 
|---|
| 32 |     Panel1: TPanel;
 | 
|---|
| 33 |     Image1: TImage;
 | 
|---|
| 34 |     Bevel1: TBevel;
 | 
|---|
| 35 |     Label1: TLabel;
 | 
|---|
| 36 |     Label2: TLabel;
 | 
|---|
| 37 |     procedure FormCreate(Sender: TObject);
 | 
|---|
| 38 |   private
 | 
|---|
| 39 |     { Private declarations }
 | 
|---|
| 40 |   public
 | 
|---|
| 41 |     { Public declarations }
 | 
|---|
| 42 |   end;
 | 
|---|
| 43 | 
 | 
|---|
| 44 | var
 | 
|---|
| 45 |   frmVistaSplash: TfrmVistaSplash;
 | 
|---|
| 46 |     StartTick: longword;
 | 
|---|
| 47 | 
 | 
|---|
| 48 | procedure SplashOpen;
 | 
|---|
| 49 | 
 | 
|---|
| 50 |   procedure SplashClose(TimeOut: longword);
 | 
|---|
| 51 | 
 | 
|---|
| 52 | implementation
 | 
|---|
| 53 | 
 | 
|---|
| 54 | {$R *.DFM}
 | 
|---|
| 55 | 
 | 
|---|
| 56 | 
 | 
|---|
| 57 | 
 | 
|---|
| 58 | procedure SplashOpen;
 | 
|---|
| 59 | begin
 | 
|---|
| 60 |   StartTick := GetTickCount;
 | 
|---|
| 61 |   try
 | 
|---|
| 62 |     frmVistaSplash := TfrmVistaSplash.Create(Application);
 | 
|---|
| 63 |     frmVistaSplash.Show;
 | 
|---|
| 64 |   except
 | 
|---|
| 65 |     frmVistaSplash.Release;
 | 
|---|
| 66 |     frmVistaSplash := nil;
 | 
|---|
| 67 |   end;
 | 
|---|
| 68 | end;
 | 
|---|
| 69 | 
 | 
|---|
| 70 | 
 | 
|---|
| 71 | 
 | 
|---|
| 72 |   procedure SplashClose(TimeOut: longword);
 | 
|---|
| 73 | begin
 | 
|---|
| 74 |   try
 | 
|---|
| 75 |     while (GetTickCount - StartTick) < TimeOut do Application.ProcessMessages;
 | 
|---|
| 76 |     frmVistaSplash.Release;
 | 
|---|
| 77 |     frmVistaSplash := nil;
 | 
|---|
| 78 |   except
 | 
|---|
| 79 |   end;
 | 
|---|
| 80 | end;
 | 
|---|
| 81 | 
 | 
|---|
| 82 | 
 | 
|---|
| 83 | procedure TfrmVistaSplash.FormCreate(Sender: TObject);
 | 
|---|
| 84 | begin
 | 
|---|
| 85 |   {This positions the label correctly in the lower right-hand corner regardless
 | 
|---|
| 86 |   of the resolution of font size.}
 | 
|---|
| 87 |   Label1.Caption := 'Department of Veterans Affairs' + #13 +
 | 
|---|
| 88 |                     'Veterans Health Administration';
 | 
|---|
| 89 |   Label1.Left := Width - 25 - Label1.Width;       //offset 25 pixels from right
 | 
|---|
| 90 |   Label1.Top  := Height - 25 - Label1.Height;     //offset 25 pixels from bottom
 | 
|---|
| 91 | end;
 | 
|---|
| 92 | 
 | 
|---|
| 93 | end.
 | 
|---|