source: branches/highdpi/LocalPlayer/TechTree.pas@ 193

Last change on this file since 193 was 193, checked in by chronos, 19 months ago
  • Modified: Improved code in HighDPI branch.
File size: 7.7 KB
Line 
1{$INCLUDE Switches.inc}
2unit TechTree;
3
4interface
5
6uses
7 ScreenTools, Messg, LCLIntf, LCLType, Messages, SysUtils, Classes, Graphics,
8 Controls, Forms, ButtonBase, ButtonB, DrawDlg, UDpiControls;
9
10type
11 TTechTreeDlg = class(TDrawDlg)
12 CloseBtn: TButtonB;
13 procedure FormCreate(Sender: TObject);
14 procedure FormPaint(Sender: TObject);
15 procedure FormShow(Sender: TObject);
16 procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
17 Shift: TShiftState; X, Y: Integer);
18 procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
19 Shift: TShiftState; X, Y: Integer);
20 procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
21 procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
22 procedure CloseBtnClick(Sender: TObject);
23 private
24 xOffset, yOffset, xDown, yDown: Integer;
25 Image: TDpiBitmap;
26 dragging: boolean;
27 end;
28
29var
30 TechTreeDlg: TTechTreeDlg;
31
32implementation
33
34uses
35 Directories;
36
37{$R *.lfm}
38
39const
40 BlackBorder = 4;
41 LeftBorder = 72;
42 RightBorder = 45;
43 TopBorder = 16;
44 BottomBorder = 48;
45 xStart = 0;
46 yStart = 40;
47 xPitch = 160;
48 yPitch = 90;
49 xLegend = 44;
50 yLegend = 79;
51 yLegendPitch = 32;
52
53function min(a, b: Integer): Integer;
54begin
55 if a < b then
56 result := a
57 else
58 result := b;
59end;
60
61function max(a, b: Integer): Integer;
62begin
63 if a > b then
64 result := a
65 else
66 result := b;
67end;
68
69procedure TTechTreeDlg.FormCreate(Sender: TObject);
70begin
71 InitButtons;
72 Image := nil;
73end;
74
75procedure TTechTreeDlg.FormPaint(Sender: TObject);
76var
77 X, w: Integer;
78begin
79 with Canvas do
80 begin
81 // black border
82 brush.color := $000000;
83 fillrect(rect(0, 0, BlackBorder, ClientHeight));
84 fillrect(rect(BlackBorder, 0, ClientWidth - BlackBorder, BlackBorder));
85 fillrect(rect(ClientWidth - BlackBorder, 0, ClientWidth, ClientHeight));
86 fillrect(rect(BlackBorder, ClientHeight - BlackBorder,
87 ClientWidth - BlackBorder, ClientHeight));
88
89 // texturize empty space
90 brush.color := $FFFFFF;
91 if xOffset > 0 then
92 FillRectSeamless(Canvas, BlackBorder, BlackBorder, BlackBorder + xOffset,
93 ClientHeight - BlackBorder, -BlackBorder - xOffset,
94 -BlackBorder - yOffset, Paper);
95 if xOffset + Image.width < ClientWidth - 2 * BlackBorder then
96 FillRectSeamless(Canvas, BlackBorder + xOffset + Image.width, BlackBorder,
97 ClientWidth - BlackBorder, ClientHeight - BlackBorder,
98 -BlackBorder - xOffset, -BlackBorder - yOffset, Paper);
99 X := max(BlackBorder, BlackBorder + xOffset);
100 w := min(BlackBorder + xOffset + Image.width, ClientWidth - BlackBorder);
101 if yOffset > 0 then
102 FillRectSeamless(Canvas, X, BlackBorder, w, BlackBorder + yOffset,
103 -BlackBorder - xOffset, -BlackBorder - yOffset, Paper);
104 if yOffset + Image.height < ClientHeight - 2 * BlackBorder then
105 FillRectSeamless(Canvas, X, BlackBorder + yOffset + Image.height, w,
106 ClientHeight - BlackBorder, -BlackBorder - xOffset,
107 -BlackBorder - yOffset, Paper);
108 end;
109 DpiBitBlt(Canvas.Handle, max(BlackBorder, BlackBorder + xOffset),
110 max(BlackBorder, BlackBorder + yOffset),
111 min(Image.width, min(Image.width + xOffset,
112 min(ClientWidth - 2 * BlackBorder, ClientWidth - 2 * BlackBorder - xOffset))
113 ), min(Image.height, min(Image.height + yOffset,
114 min(ClientHeight - 2 * BlackBorder, ClientHeight - 2 * BlackBorder -
115 yOffset))), Image.Canvas.Handle, max(0, -xOffset),
116 max(0, -yOffset), SRCCOPY);
117end;
118
119procedure TTechTreeDlg.FormShow(Sender: TObject);
120var
121 X, Y, ad, TexWidth, TexHeight: Integer;
122 s: string;
123 SrcPixel, DstPixel: TPixelPointer;
124begin
125 if Image = nil then
126 begin
127 Image := TDpiBitmap.Create;
128 Image.PixelFormat := pf24bit;
129 LoadGraphicFile(Image, HomeDir + 'Help' + DirectorySeparator + 'AdvTree.png', gfNoGamma);
130
131 with Image.Canvas do
132 begin
133 // write advance names
134 Font.Assign(UniFont[ftSmall]);
135 Font.color := clBlack;
136 brush.Style := bsClear;
137 for X := 0 to (Image.width - xStart) div xPitch do
138 for Y := 0 to (Image.height - yStart) div yPitch do
139 begin
140 ad := Pixels[xStart + X * xPitch + 10, yStart + Y * yPitch - 1];
141 if ad and $FFFF00 = 0 then
142 begin
143 s := Phrases.Lookup('ADVANCES', ad);
144 while TextWidth(s) > 112 do
145 Delete(s, Length(s), 1);
146 TextOut(xStart + X * xPitch + 2, yStart + Y * yPitch, s);
147 Pixels[xStart + X * xPitch + 10, yStart + Y * yPitch - 1]
148 := $7F007F;
149 end
150 end;
151
152 // write legend
153 TextOut(xLegend, yLegend, Phrases2.Lookup('ADVTREE_UP0'));
154 TextOut(xLegend, yLegend + yLegendPitch, Phrases2.Lookup('ADVTREE_UP1'));
155 TextOut(xLegend, yLegend + 2 * yLegendPitch,
156 Phrases2.Lookup('ADVTREE_UP2'));
157 TextOut(xLegend, yLegend + 3 * yLegendPitch,
158 Phrases2.Lookup('ADVTREE_GOV'));
159 TextOut(xLegend, yLegend + 4 * yLegendPitch,
160 Phrases2.Lookup('ADVTREE_OTHER'));
161 end;
162
163 // texturize background
164 Image.BeginUpdate;
165 TexWidth := Paper.Width;
166 TexHeight := Paper.Height;
167 DstPixel.Init(Image);
168 SrcPixel.Init(Paper);
169 for Y := 0 to Image.Height - 1 do begin
170 for X := 0 to Image.Width - 1 do begin
171 if (DstPixel.Pixel^.ARGB and $FFFFFF) = $7F007F then begin // transparent
172 SrcPixel.SetXY(X mod TexWidth, Y mod TexHeight);
173 DstPixel.Pixel^.B := SrcPixel.Pixel^.B;
174 DstPixel.Pixel^.G := SrcPixel.Pixel^.G;
175 DstPixel.Pixel^.R := SrcPixel.Pixel^.R;
176 end;
177 DstPixel.NextPixel;
178 end;
179 DstPixel.NextLine;
180 end;
181 Image.EndUpdate;
182 end;
183
184 // fit window to image, center image in window, center window to screen
185 width := min(DpiScreen.width - 40, Image.width + LeftBorder + RightBorder + 2 *
186 BlackBorder);
187 height := min(DpiScreen.height - 40, Image.height + TopBorder + BottomBorder + 2
188 * BlackBorder);
189 Left := (DpiScreen.width - width) div 2;
190 Top := (DpiScreen.height - height) div 2;
191 CloseBtn.Left := width - CloseBtn.width - BlackBorder - 8;
192 CloseBtn.Top := BlackBorder + 8;
193 xOffset := (ClientWidth - Image.width + LeftBorder - RightBorder) div 2 -
194 BlackBorder;
195 yOffset := ClientHeight - 2 * BlackBorder - Image.height - BottomBorder;
196end;
197
198procedure TTechTreeDlg.FormMouseDown(Sender: TObject; Button: TMouseButton;
199 Shift: TShiftState; X, Y: Integer);
200begin
201 if Button = mbLeft then
202 begin
203 dragging := true;
204 xDown := X;
205 yDown := Y;
206 end
207end;
208
209procedure TTechTreeDlg.FormMouseUp(Sender: TObject; Button: TMouseButton;
210 Shift: TShiftState; X, Y: Integer);
211begin
212 dragging := false;
213end;
214
215procedure TTechTreeDlg.FormMouseMove(Sender: TObject; Shift: TShiftState;
216 X, Y: Integer);
217begin
218 if dragging then
219 begin
220 xOffset := xOffset + X - xDown;
221 yOffset := yOffset + Y - yDown;
222 xDown := X;
223 yDown := Y;
224
225 if xOffset > LeftBorder then
226 xOffset := LeftBorder;
227 if xOffset < ClientWidth - 2 * BlackBorder - Image.width - RightBorder then
228 xOffset := ClientWidth - 2 * BlackBorder - Image.width - RightBorder;
229 if yOffset > TopBorder then
230 yOffset := TopBorder;
231 if yOffset < ClientHeight - 2 * BlackBorder - Image.height - BottomBorder
232 then
233 yOffset := ClientHeight - 2 * BlackBorder - Image.height - BottomBorder;
234
235 SmartInvalidate;
236 end
237end;
238
239procedure TTechTreeDlg.FormKeyDown(Sender: TObject; var Key: Word;
240 Shift: TShiftState);
241begin
242 if Key = VK_ESCAPE then
243 Close;
244end;
245
246procedure TTechTreeDlg.CloseBtnClick(Sender: TObject);
247begin
248 Close();
249end;
250
251end.
Note: See TracBrowser for help on using the repository browser.