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