source: trunk/Back.pas

Last change on this file was 468, checked in by chronos, 5 months ago
  • Added: High DPI support integrated into trunk branch. It can be enabled by adding DPI define to compiler parameters for main project and packages.
File size: 2.1 KB
Line 
1{$INCLUDE Switches.inc}
2unit Back;
3
4interface
5
6uses
7 LCLIntf, LCLType, SysUtils, Classes,
8 {$IFDEF DPI}Dpi.Graphics, Dpi.Forms, Dpi.Controls{$ELSE}
9 Graphics, Forms, Controls{$ENDIF};
10
11type
12
13 { TBackground }
14
15 TBackground = class(TForm)
16 procedure FormDestroy(Sender: TObject);
17 procedure FormPaint(Sender: TObject);
18 procedure FormShow(Sender: TObject);
19 procedure FormCreate(Sender: TObject);
20 procedure FormClose(Sender: TObject; var Action: TCloseAction);
21 private
22 Img: TBitmap;
23 public
24 procedure UpdateInterface;
25 end;
26
27var
28 Background: TBackground;
29
30
31implementation
32
33uses
34 Directories, ScreenTools, Start;
35
36{$R *.lfm}
37
38procedure TBackground.FormCreate(Sender: TObject);
39begin
40 Img := nil;
41end;
42
43procedure TBackground.FormShow(Sender: TObject);
44begin
45 UpdateInterface;
46end;
47
48procedure TBackground.FormDestroy(Sender: TObject);
49begin
50 if Assigned(Img) then FreeAndNil(Img);
51end;
52
53procedure TBackground.FormPaint(Sender: TObject);
54begin
55 if Assigned(Img) then
56 BitBltCanvas(Canvas, Screen.Width - Img.Width - (Screen.Width - 800) *
57 3 div 8, (Screen.Height - 600) div 3, Img.Width, Img.Height,
58 Img.Canvas, 0, 0);
59end;
60
61procedure TBackground.FormClose(Sender: TObject; var Action: TCloseAction);
62begin
63end;
64
65procedure TBackground.UpdateInterface;
66var
67 FileName: string;
68begin
69 if FullScreen then begin
70 WindowState := TWindowState.wsFullScreen;
71 if not Assigned(Img) then begin
72 FileName := GetGraphicsDir + DirectorySeparator + 'Background.png';
73 if FileExists(FileName) then begin
74 Img := TBitmap.Create;
75 LoadGraphicFile(Img, FileName);
76 Repaint;
77 end;
78 end;
79 end else begin
80 if WindowState <> TWindowState.wsMaximized then begin
81 WindowState := TWindowState.wsNormal;
82 WindowState := TWindowState.wsFullScreen;
83 end;
84 WindowState := TWindowState.wsNormal;
85 BoundsRect := Bounds(StartDlg.Left - 8, StartDlg.Top - 8,
86 StartDlg.Width + 16, StartDlg.Height + 16);
87 end;
88end;
89
90end.
Note: See TracBrowser for help on using the repository browser.