source: cprs/branches/tmg-cprs/BDK32/Source/Splvista.pas@ 1156

Last change on this file since 1156 was 453, checked in by Kevin Toppenberg, 16 years ago

Initial upload of TMG-CPRS 1.0.26.69

File size: 2.5 KB
RevLine 
[453]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
10unit 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
24interface
25
26uses
27 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
28 Forms, Dialogs, ExtCtrls, StdCtrls;
29
30type
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
44var
45 frmVistaSplash: TfrmVistaSplash;
46 StartTick: longword;
47
48procedure SplashOpen;
49
50 procedure SplashClose(TimeOut: longword);
51
52implementation
53
54{$R *.DFM}
55
56
57
58procedure SplashOpen;
59begin
60 StartTick := GetTickCount;
61 try
62 frmVistaSplash := TfrmVistaSplash.Create(Application);
63 frmVistaSplash.Show;
64 except
65 frmVistaSplash.Release;
66 frmVistaSplash := nil;
67 end;
68end;
69
70
71
72 procedure SplashClose(TimeOut: longword);
73begin
74 try
75 while (GetTickCount - StartTick) < TimeOut do Application.ProcessMessages;
76 frmVistaSplash.Release;
77 frmVistaSplash := nil;
78 except
79 end;
80end;
81
82
83procedure TfrmVistaSplash.FormCreate(Sender: TObject);
84begin
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
91end;
92
93end.
Note: See TracBrowser for help on using the repository browser.