Context Navigation

source: tags/1.2.0/Packages/CevoComponents/ScreenTools.pas

Last change on this file was 230, checked in by chronos, 4 years ago
Modified: Optimized drawing in Wonders window.
File size: 51.9 KB

Line
1	unit ScreenTools;
2
3	interface
4
5	uses
6	{$IFDEF WINDOWS}
7	Windows,
8	{$ENDIF}
9	StringTables, LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, Math,
10	Forms, Menus, GraphType;
11
12	type
13	TTexture = record
14	Image: TBitmap;
15	clBevelLight, clBevelShade, clTextLight, clTextShade, clLitText, clMark,
16	clPage, clCover: TColor;
17	end;
18
19	{$IFDEF WINDOWS}
20	function ChangeResolution(x, y, bpp, freq: integer): boolean;
21	{$ENDIF}
22	procedure RestoreResolution;
23	procedure EmptyMenu(MenuItems: TMenuItem; Keep: Integer = 0);
24	function TurnToYear(Turn: integer): integer;
25	function TurnToString(Turn: integer): string;
26	function MovementToString(Movement: integer): string;
27	procedure BtnFrame(ca: TCanvas; p: TRect; const T: TTexture);
28	procedure EditFrame(ca: TCanvas; p: TRect; const T: TTexture);
29	function HexStringToColor(S: string): integer;
30	function LoadGraphicFile(bmp: TBitmap; Path: string; Options: integer = 0): boolean;
31	function LoadGraphicSet(const Name: string): integer;
32	procedure Dump(dst: TBitmap; HGr, xDst, yDst, Width, Height, xGr, yGr: integer);
33	procedure Sprite(Canvas: TCanvas; HGr, xDst, yDst, Width, Height, xGr, yGr: integer);
34	overload;
35	procedure Sprite(dst: TBitmap; HGr, xDst, yDst, Width, Height, xGr, yGr: integer);
36	overload;
37	procedure MakeBlue(Dst: TBitmap; X, Y, Width, Height: Integer);
38	procedure MakeRed(Dst: TBitmap; X, Y, Width, Height: Integer);
39	procedure ImageOp_B(dst, Src: TBitmap; xDst, yDst, xSrc, ySrc, Width, Height: Integer);
40	procedure ImageOp_BCC(dst, Src: TBitmap;
41	xDst, yDst, xSrc, ySrc, Width, Height, Color1, Color2: Integer);
42	procedure ImageOp_CBC(Dst, Src: TBitmap; xDst, yDst, xSrc, ySrc, Width, Height,
43	Color0, Color2: Integer);
44	procedure ImageOp_CCC(bmp: TBitmap; x, y, w, h, Color0, Color1, Color2: Integer);
45	function BitBltCanvas(DestCanvas: TCanvas; X, Y, Width, Height: Integer;
46	SrcCanvas: TCanvas; XSrc, YSrc: Integer; Rop: DWORD = SRCCOPY): Boolean; overload;
47	function BitBltCanvas(Dest: TCanvas; DestRect: TRect;
48	Src: TCanvas; SrcPos: TPoint; Rop: DWORD = SRCCOPY): Boolean; overload;
49	function BitBltBitmap(Dest: TBitmap; X, Y, Width, Height: Integer;
50	Src: TBitmap; XSrc, YSrc: Integer; Rop: DWORD = SRCCOPY): Boolean; overload;
51	function BitBltBitmap(Dest: TBitmap; DestRect: TRect;
52	Src: TBitmap; SrcPos: TPoint; Rop: DWORD = SRCCOPY): Boolean; overload;
53	procedure SLine(ca: TCanvas; x0, x1, y: integer; cl: TColor);
54	procedure DLine(ca: TCanvas; x0, x1, y: integer; cl0, cl1: TColor);
55	procedure Frame(ca: TCanvas; x0, y0, x1, y1: integer; cl0, cl1: TColor);
56	procedure RFrame(ca: TCanvas; x0, y0, x1, y1: integer; cl0, cl1: TColor);
57	procedure CFrame(ca: TCanvas; x0, y0, x1, y1, Corner: integer; cl: TColor);
58	procedure FrameImage(ca: TCanvas; Src: TBitmap;
59	x, y, Width, Height, xSrc, ySrc: integer; IsControl: boolean = False);
60	procedure GlowFrame(dst: TBitmap; x0, y0, Width, Height: integer; cl: TColor);
61	procedure InitOrnament;
62	procedure InitCityMark(const T: TTexture);
63	procedure Fill(ca: TCanvas; Left, Top, Width, Height, xOffset, yOffset: integer); overload;
64	procedure Fill(Canvas: TCanvas; Rect: TRect; Offset: TPoint); overload;
65	procedure FillLarge(ca: TCanvas; x0, y0, x1, y1, xm: integer);
66	procedure FillSeamless(ca: TCanvas; Left, Top, Width, Height, xOffset, yOffset: integer;
67	const Texture: TBitmap);
68	procedure FillRectSeamless(ca: TCanvas; x0, y0, x1, y1, xOffset, yOffset: integer;
69	const Texture: TBitmap);
70	procedure PaintBackground(Form: TForm; Left, Top, Width, Height: integer);
71	procedure Corner(ca: TCanvas; x, y, Kind: integer; const T: TTexture);
72	procedure BiColorTextOut(ca: TCanvas; clMain, clBack: TColor; x, y: integer; s: string);
73	procedure LoweredTextOut(ca: TCanvas; cl: TColor; const T: TTexture;
74	x, y: integer; s: string);
75	function BiColorTextWidth(ca: TCanvas; s: string): integer;
76	procedure RisedTextOut(ca: TCanvas; x, y: integer; s: string);
77	procedure LightGradient(ca: TCanvas; x, y, Width, Color: integer);
78	procedure DarkGradient(ca: TCanvas; x, y, Width, Kind: integer);
79	procedure VLightGradient(ca: TCanvas; x, y, Height, Color: integer);
80	procedure VDarkGradient(ca: TCanvas; x, y, Height, Kind: integer);
81	procedure NumberBar(dst: TBitmap; x, y: integer; Cap: string; val: integer;
82	const T: TTexture);
83	procedure CountBar(dst: TBitmap; x, y, w: integer; Kind: integer;
84	Cap: string; val: integer; const T: TTexture);
85	procedure PaintProgressBar(ca: TCanvas; Kind, x, y, pos, Growth, max: integer;
86	const T: TTexture);
87	procedure PaintRelativeProgressBar(ca: TCanvas;
88	Kind, x, y, size, pos, Growth, max: integer; IndicateComplete: boolean;
89	const T: TTexture);
90	procedure PaintLogo(ca: TCanvas; x, y, clLight, clShade: integer);
91	function SetMainTextureByAge(Age: integer): boolean;
92	procedure LoadPhrases;
93	procedure Texturize(Dest, Texture: TBitmap; TransparentColor: Integer);
94	procedure DarkenImage(Bitmap: TBitmap; Change: Integer);
95
96	const
97	nGrExtmax = 64;
98	wMainTexture = 640;
99	hMainTexture = 480;
100
101	// template positions in Template.bmp
102	xLogo = 1;
103	yLogo = 1;
104	wLogo = 122;
105	hLogo = 23; // logo
106	xBBook = 1;
107	yBBook = 74;
108	wBBook = 143;
109	hBBook = 73; // big book
110	xSBook = 72;
111	ySBook = 37;
112	wSBook = 72;
113	hSBook = 36; // small book
114	xNation = 1;
115	yNation = 25;
116	xCoal = 1;
117	yCoal = 148;
118
119	// Icons.bmp structure
120	xSizeBig = 56;
121	ySizeBig = 40;
122
123	GlowRange = 8;
124
125	EmptySpaceColor = $101010;
126
127	// template positions in System2.bmp
128	xOrna = 156;
129	yOrna = 1;
130	wOrna = 27;
131	hOrna = 26; // ornament
132
133	// color matrix
134	clkAge0 = 1;
135	cliTexture = 0;
136	cliBevelLight = cliTexture + 1;
137	cliBevelShade = cliTexture + 2;
138	cliTextLight = cliTexture + 3;
139	cliTextShade = cliTexture + 4;
140	cliLitText = cliTexture + 5;
141	cliMark = cliTexture + 6;
142	cliDimmedText = cliTexture + 7;
143	cliRoad = 8;
144	cliHouse = cliRoad + 1;
145	cliImp = cliRoad + 2;
146	cliImpProject = cliRoad + 3;
147	cliPage = 13;
148	cliCover = cliPage + 1;
149	clkMisc = 5;
150	cliPaper = 0;
151	cliPaperText = 1;
152	cliPaperCaption = 2;
153	clkCity = 6;
154	cliPlains = 0;
155	cliPrairie = 1;
156	cliHills = 2;
157	cliTundra = 3;
158	cliWater = 4;
159
160	// LoadGraphicFile options
161	gfNoError = $01;
162	gfNoGamma = $02;
163
164	type
165	TGrExtDescr = record { don't use dynamic strings here! }
166	Name: string[31];
167	Data: TBitmap;
168	Mask: TBitmap;
169	pixUsed: array [Byte] of Byte;
170	end;
171
172	TGrExtDescrSize = record { for size calculation only - must be the same as
173	TGrExtDescr, but without pixUsed }
174	Name: string[31];
175	Data: TBitmap;
176	Mask: TBitmap;
177	end;
178
179	TFontType = (ftNormal, ftSmall, ftTiny, ftCaption, ftButton);
180
181	var
182	Phrases: TStringTable;
183	Phrases2: TStringTable;
184	nGrExt: Integer;
185	GrExt: array [0 .. nGrExtmax - 1] of ^TGrExtDescr;
186	HGrSystem: Integer;
187	HGrSystem2: Integer;
188	ClickFrameColor: Integer;
189	MainTextureAge: Integer;
190	MainTexture: TTexture;
191	Templates: TBitmap;
192	Colors: TBitmap;
193	Paper: TBitmap;
194	BigImp: TBitmap;
195	LogoBuffer: TBitmap;
196	FullScreen: Boolean;
197	GenerateNames: Boolean;
198	InitOrnamentDone: Boolean;
199	Phrases2FallenBackToEnglish: Boolean;
200
201	UniFont: array [TFontType] of TFont;
202	Gamma: Integer; // global gamma correction (cent)
203
204	procedure LoadAssets;
205	procedure UnitInit;
206	procedure UnitDone;
207	procedure InitGammaLookupTable;
208
209
210	implementation
211
212	uses
213	Directories, Sound, UPixelPointer;
214
215	var
216	{$IFDEF WINDOWS}
217	StartResolution: TDeviceMode;
218	ResolutionChanged: boolean;
219	{$ENDIF}
220
221	GammaLookupTable: array [0..255] of Byte;
222
223	{$IFDEF WINDOWS}
224	function ChangeResolution(x, y, bpp, freq: integer): boolean;
225	var
226	DevMode: TDeviceMode;
227	begin
228	EnumDisplaySettings(nil, 0, DevMode);
229	DevMode.dmFields := DM_PELSWIDTH or DM_PELSHEIGHT or DM_BITSPERPEL or
230	DM_DISPLAYFREQUENCY;
231	DevMode.dmPelsWidth := x;
232	DevMode.dmPelsHeight := y;
233	DevMode.dmBitsPerPel := bpp;
234	DevMode.dmDisplayFrequency := freq;
235	Result := ChangeDisplaySettings(DevMode, 0) = DISP_CHANGE_SUCCESSFUL;
236	if Result then
237	ResolutionChanged := True;
238	end;
239
240	{$ENDIF}
241
242	procedure RestoreResolution;
243	begin
244	{$IFDEF WINDOWS}
245	if ResolutionChanged then
246	ChangeDisplaySettings(StartResolution, 0);
247	ResolutionChanged := False;
248	{$ENDIF}
249	end;
250
251	procedure EmptyMenu(MenuItems: TMenuItem; Keep: Integer = 0);
252	var
253	MenuItem: TMenuItem;
254	begin
255	while MenuItems.Count > Keep do begin
256	MenuItem := MenuItems[MenuItems.Count - 1];
257	MenuItems.Delete(MenuItems.Count - 1);
258	MenuItem.Free;
259	end;
260	end;
261
262	function TurnToYear(Turn: Integer): Integer;
263	var
264	I: Integer;
265	begin
266	Result := -4000;
267	for I := 1 to Turn do
268	if Result < -1000 then Inc(Result, 50) // 0..60
269	else if Result < 0 then Inc(Result, 25) // 60..100
270	else if Result < 1500 then Inc(Result, 20) // 100..175
271	else if Result < 1750 then Inc(Result, 10) // 175..200
272	else if Result < 1850 then Inc(Result, 2) // 200..250
273	else Inc(Result);
274	end;
275
276	function TurnToString(Turn: Integer): string;
277	var
278	Year: Integer;
279	begin
280	if GenerateNames then
281	begin
282	Year := TurnToYear(Turn);
283	if Year < 0 then
284	Result := Format(Phrases.Lookup('BC'), [-Year])
285	else
286	Result := Format(Phrases.Lookup('AD'), [Year]);
287	end
288	else
289	Result := IntToStr(Turn);
290	end;
291
292	function MovementToString(Movement: Integer): string;
293	begin
294	if Movement >= 1000 then
295	begin
296	Result := Char(48 + Movement div 1000);
297	Movement := Movement mod 1000;
298	end
299	else
300	Result := '';
301	Result := Result + Char(48 + Movement div 100);
302	Movement := Movement mod 100;
303	if Movement > 0 then
304	begin
305	Result := Result + '.' + Char(48 + Movement div 10);
306	Movement := Movement mod 10;
307	if Movement > 0 then
308	Result := Result + Char(48 + Movement);
309	end;
310	end;
311
312	procedure BtnFrame(ca: TCanvas; p: TRect; const T: TTexture);
313	begin
314	RFrame(ca, p.Left - 1, p.Top - 1, p.Right, p.Bottom, T.clBevelShade,
315	T.clBevelLight);
316	end;
317
318	procedure EditFrame(ca: TCanvas; p: TRect; const T: TTexture);
319	begin
320	Frame(ca, p.Left - 1, p.Top - 1, p.Right, p.Bottom, $000000, $000000);
321	Frame(ca, p.Left - 2, p.Top - 2, p.Right + 1, p.Bottom + 1, $000000, $000000);
322	Frame(ca, p.Left - 3, p.Top - 3, p.Right + 2, p.Bottom + 1, $000000, $000000);
323	RFrame(ca, p.Left - 4, p.Top - 4, p.Right + 3, p.Bottom + 2, T.clBevelShade,
324	T.clBevelLight);
325	end;
326
327	function HexCharToInt(X: Char): Integer;
328	begin
329	case x of
330	'0' .. '9': Result := Ord(X) - Ord('0');
331	'A' .. 'F': Result := Ord(X) - Ord('A') + 10;
332	'a' .. 'f': Result := Ord(X) - Ord('a') + 10;
333	else Result := 0
334	end;
335	end;
336
337	function HexStringToColor(S: string): Integer;
338	begin
339	while (Length(S) > 0) and (S[1] = ' ') do
340	Delete(S, 1, 1);
341	S := S + '000000';
342	if Gamma = 100 then
343	Result := $10 * HexCharToInt(S[1]) + $1 * HexCharToInt(S[2]) +
344	$1000 * HexCharToInt(S[3]) + $100 * HexCharToInt(S[4]) +
345	$100000 * HexCharToInt(S[5]) + $10000 * HexCharToInt(S[6])
346	else
347	Result := GammaLookupTable[$10 * HexCharToInt(S[1]) + HexCharToInt(S[2])] +
348	$100 * GammaLookupTable[$10 * HexCharToInt(S[3]) + HexCharToInt(S[4])] +
349	$10000 * GammaLookupTable[$10 * HexCharToInt(S[5]) + HexCharToInt(S[6])];
350	end;
351
352	function ApplyGammaToPixel(Pixel: TPixel32): TPixel32;
353	begin
354	Result.R := GammaLookupTable[Pixel.R];
355	Result.G := GammaLookupTable[Pixel.G];
356	Result.B := GammaLookupTable[Pixel.B];
357	end;
358
359	procedure ApplyGammaToBitmap(Bitmap: TBitmap);
360	var
361	PixelPtr: TPixelPointer;
362	X, Y: Integer;
363	begin
364	Bitmap.BeginUpdate;
365	PixelPtr := PixelPointer(Bitmap);
366	for Y := 0 to Bitmap.Height - 1 do begin
367	for X := 0 to Bitmap.Width - 1 do begin
368	PixelPtr.Pixel^ := ApplyGammaToPixel(PixelPtr.Pixel^);
369	PixelPtr.NextPixel;
370	end;
371	PixelPtr.NextLine;
372	end;
373	Bitmap.EndUpdate;
374	end;
375
376	procedure CopyGray8BitTo24bitBitmap(Dst, Src: TRasterImage);
377	var
378	SrcPtr, DstPtr: TPixelPointer;
379	X, Y: Integer;
380	begin
381	//Dst.SetSize(Src.Width, Src.Height);
382	SrcPtr := PixelPointer(Src);
383	DstPtr := PixelPointer(Dst);
384	for Y := 0 to Src.Height - 1 do begin
385	for X := 0 to Src.Width - 1 do begin
386	DstPtr.Pixel^.B := SrcPtr.Pixel^.B;
387	DstPtr.Pixel^.G := SrcPtr.Pixel^.B;
388	DstPtr.Pixel^.R := SrcPtr.Pixel^.B;
389	SrcPtr.NextPixel;
390	DstPtr.NextPixel;
391	end;
392	SrcPtr.NextLine;
393	DstPtr.NextLine;
394	end;
395	end;
396
397	function LoadGraphicFile(bmp: TBitmap; Path: string; Options: Integer): Boolean;
398	var
399	jtex: TJpegImage;
400	Png: TPortableNetworkGraphic;
401	begin
402	Result := True;
403	if ExtractFileExt(Path) = '' then
404	Path := Path + '.png';
405	if ExtractFileExt(Path) = '.jpg' then begin
406	jtex := tjpegimage.Create;
407	try
408	jtex.LoadFromFile(Path);
409	except
410	Result := False;
411	end;
412	if Result then
413	begin
414	if Options and gfNoGamma = 0 then
415	bmp.PixelFormat := pf24bit;
416	Bmp.SetSize(jtex.Width, jtex.Height);
417	Bmp.Canvas.Draw(0, 0, jtex);
418	end;
419	jtex.Free;
420	end
421	else
422	if ExtractFileExt(Path) = '.png' then begin
423	Png := TPortableNetworkGraphic.Create;
424	Png.PixelFormat := Bmp.PixelFormat;
425	try
426	Png.LoadFromFile(Path);
427	except
428	Result := False;
429	end;
430	if Result then
431	begin
432	if Options and gfNoGamma = 0 then
433	bmp.PixelFormat := pf24bit;
434	bmp.SetSize(Png.Width, Png.Height);
435	if (Png.RawImage.Description.Format = ricfGray) then
436	begin
437	// LCL doesn't support 8-bit colors properly. Use 24-bit instead.
438	Bmp.PixelFormat := pf24bit;
439	CopyGray8BitTo24bitBitmap(Bmp, Png);
440	end
441	else
442	Bmp.Canvas.draw(0, 0, Png);
443	end;
444	Png.Free;
445	end
446	else
447	if ExtractFileExt(Path) = '.bmp' then begin
448	try
449	bmp.LoadFromFile(Path);
450	except
451	Result := False;
452	end;
453	if Result then begin
454	if Options and gfNoGamma = 0 then
455	bmp.PixelFormat := pf24bit;
456	end;
457	end
458	else
459	raise Exception.Create('Unsupported image file type ' + ExtractFileExt(Path));
460
461	if not Result then begin
462	if Options and gfNoError = 0 then
463	raise Exception.Create(Format(Phrases.Lookup('FILENOTFOUND'), [Path]));
464	end;
465
466	if (Options and gfNoGamma = 0) and (Gamma <> 100) then
467	ApplyGammaToBitmap(Bmp);
468	end;
469
470	function LoadGraphicSet(const Name: string): Integer;
471	var
472	I, x, y, xmax, OriginalColor: Integer;
473	FileName: string;
474	Source: TBitmap;
475	DataPixel, MaskPixel: TPixelPointer;
476	begin
477	I := 0;
478	while (I < nGrExt) and (GrExt[i].Name <> Name) do
479	Inc(I);
480	Result := I;
481	if I = nGrExt then begin
482	Source := TBitmap.Create;
483	Source.PixelFormat := pf24bit;
484	FileName := GetGraphicsDir + DirectorySeparator + Name;
485	if not LoadGraphicFile(Source, FileName) then begin
486	Result := -1;
487	Exit;
488	end;
489
490	GetMem(GrExt[nGrExt], SizeOf(TGrExtDescrSize) + Source.Height div 49 * 10);
491	GrExt[nGrExt].Name := Name;
492
493	xmax := Source.Width - 1; // allows 4-byte access even for last pixel
494	// Why there was that limit?
495	//if xmax > 970 then
496	// xmax := 970;
497
498	GrExt[nGrExt].Data := Source;
499	GrExt[nGrExt].Data.PixelFormat := pf24bit;
500	GrExt[nGrExt].Mask := TBitmap.Create;
501	GrExt[nGrExt].Mask.PixelFormat := pf24bit;
502	GrExt[nGrExt].Mask.SetSize(Source.Width, Source.Height);
503
504	GrExt[nGrExt].Data.BeginUpdate;
505	GrExt[nGrExt].Mask.BeginUpdate;
506	DataPixel := PixelPointer(GrExt[nGrExt].Data);
507	MaskPixel := PixelPointer(GrExt[nGrExt].Mask);
508	for y := 0 to Source.Height - 1 do begin
509	for x := 0 to xmax - 1 do begin
510	OriginalColor := DataPixel.Pixel^.ARGB and $FFFFFF;
511	if (OriginalColor = $FF00FF) or (OriginalColor = $7F007F) then
512	begin // transparent
513	MaskPixel.Pixel^.ARGB := $FFFFFF;
514	DataPixel.Pixel^.ARGB := DataPixel.Pixel^.ARGB and $FF000000;
515	end
516	else begin
517	MaskPixel.Pixel^.ARGB := $000000; // non-transparent
518	if Gamma <> 100 then
519	DataPixel.Pixel^ := ApplyGammaToPixel(DataPixel.Pixel^);
520	end;
521	DataPixel.NextPixel;
522	MaskPixel.NextPixel;
523	end;
524	DataPixel.NextLine;
525	MaskPixel.NextLine;
526	end;
527	GrExt[nGrExt].Data.EndUpdate;
528	GrExt[nGrExt].Mask.EndUpdate;
529
530	FillChar(GrExt[nGrExt].pixUsed, GrExt[nGrExt].Data.Height div 49 * 10, 0);
531	Inc(nGrExt);
532	end;
533	end;
534
535	procedure Dump(dst: TBitmap; HGr, xDst, yDst, Width, Height, xGr, yGr: integer);
536	begin
537	BitBltCanvas(dst.Canvas, xDst, yDst, Width, Height,
538	GrExt[HGr].Data.Canvas, xGr, yGr);
539	end;
540
541	procedure MakeBlue(Dst: TBitmap; X, Y, Width, Height: Integer);
542	var
543	XX, YY: Integer;
544	PixelPtr: TPixelPointer;
545	begin
546	Dst.BeginUpdate;
547	PixelPtr := PixelPointer(Dst, X, Y);
548	for yy := 0 to Height - 1 do begin
549	for xx := 0 to Width - 1 do begin
550	PixelPtr.Pixel^.B := PixelPtr.Pixel^.B div 2;
551	PixelPtr.Pixel^.G := PixelPtr.Pixel^.G div 2;
552	PixelPtr.Pixel^.R := PixelPtr.Pixel^.R div 2;
553	PixelPtr.NextPixel;
554	end;
555	PixelPtr.NextLine;
556	end;
557	Dst.EndUpdate;
558	end;
559
560	procedure MakeRed(Dst: TBitmap; X, Y, Width, Height: Integer);
561	var
562	XX, YY: Integer;
563	Gray: Integer;
564	PixelPtr: TPixelPointer;
565	begin
566	Dst.BeginUpdate;
567	PixelPtr := PixelPointer(Dst, X, Y);
568	for YY := 0 to Height - 1 do begin
569	for XX := 0 to Width - 1 do begin
570	Gray := (Integer(PixelPtr.Pixel^.B) + Integer(PixelPtr.Pixel^.G) +
571	Integer(PixelPtr.Pixel^.R)) * 85 shr 8;
572	PixelPtr.Pixel^.B := 0;
573	PixelPtr.Pixel^.G := 0;
574	PixelPtr.Pixel^.R := Gray; // 255-(255-gray) div 2;
575	PixelPtr.NextPixel;
576	end;
577	PixelPtr.NextLine;
578	end;
579	Dst.EndUpdate;
580	end;
581
582	procedure ImageOp_B(dst, Src: TBitmap; xDst, yDst, xSrc, ySrc, Width, Height: Integer);
583	// Src is template
584	// X channel = background amp (old Dst content), 128=original brightness
585	var
586	X, Y: Integer;
587	Brightness, Test: Integer;
588	PixelSrc: TPixelPointer;
589	PixelDst: TPixelPointer;
590	begin
591	//Assert(Src.PixelFormat = pf8bit);
592	Assert(dst.PixelFormat = pf24bit);
593	if xDst < 0 then begin
594	Width := Width + xDst;
595	xSrc := xSrc - xDst;
596	xDst := 0;
597	end;
598	if yDst < 0 then begin
599	Height := Height + yDst;
600	ySrc := ySrc - yDst;
601	yDst := 0;
602	end;
603	if xDst + Width > dst.Width then
604	Width := dst.Width - xDst;
605	if yDst + Height > dst.Height then
606	Height := dst.Height - yDst;
607	if (Width < 0) or (Height < 0) then
608	exit;
609
610	dst.BeginUpdate;
611	Src.BeginUpdate;
612	PixelDst := PixelPointer(Dst, xDst, yDst);
613	PixelSrc := PixelPointer(Src, xSrc, ySrc);
614	for Y := 0 to Height - 1 do begin
615	for X := 0 to Width - 1 do begin
616	Brightness := PixelSrc.Pixel^.B; // One byte for 8-bit color
617	test := (PixelDst.Pixel^.R * Brightness) shr 7;
618	if test >= 256 then
619	PixelDst.Pixel^.R := 255
620	else
621	PixelDst.Pixel^.R := test; // Red
622	test := (PixelDst.Pixel^.G * Brightness) shr 7;
623	if test >= 256 then
624	PixelDst.Pixel^.G := 255
625	else
626	PixelDst.Pixel^.G := test; // Green
627	test := (PixelDst.Pixel^.B * Brightness) shr 7;
628	if test >= 256 then
629	PixelDst.Pixel^.R := 255
630	else
631	PixelDst.Pixel^.B := Test; // Blue
632	PixelDst.NextPixel;
633	PixelSrc.NextPixel;
634	end;
635	PixelDst.NextLine;
636	PixelSrc.NextLine;
637	end;
638	src.EndUpdate;
639	dst.EndUpdate;
640	end;
641
642	procedure ImageOp_BCC(dst, Src: TBitmap; xDst, yDst, xSrc, ySrc, Width, Height,
643	Color1, Color2: Integer);
644	// Src is template
645	// B channel = background amp (old Dst content), 128=original brightness
646	// G channel = Color1 amp, 128=original brightness
647	// R channel = Color2 amp, 128=original brightness
648	var
649	ix, iy, amp1, amp2, trans, Value: Integer;
650	SrcPixel: TPixelPointer;
651	DstPixel: TPixelPointer;
652	begin
653	if xDst < 0 then begin
654	Width := Width + xDst;
655	xSrc := xSrc - xDst;
656	xDst := 0;
657	end;
658	if yDst < 0 then begin
659	Height := Height + yDst;
660	ySrc := ySrc - yDst;
661	yDst := 0;
662	end;
663	if xDst + Width > dst.Width then
664	Width := dst.Width - xDst;
665	if yDst + Height > dst.Height then
666	Height := dst.Height - yDst;
667	if (Width < 0) or (Height < 0) then
668	exit;
669
670	Src.BeginUpdate;
671	dst.BeginUpdate;
672	SrcPixel := PixelPointer(Src, xSrc, ySrc);
673	DstPixel := PixelPointer(Dst, xDst, yDst);
674	for iy := 0 to Height - 1 do begin
675	for ix := 0 to Width - 1 do begin
676	trans := SrcPixel.Pixel^.B * 2; // green channel = transparency
677	amp1 := SrcPixel.Pixel^.G * 2;
678	amp2 := SrcPixel.Pixel^.R * 2;
679	if trans <> $FF then begin
680	Value := (DstPixel.Pixel^.B * trans + ((Color2 shr 16) and $FF) *
681	amp2 + ((Color1 shr 16) and $FF) * amp1) div $FF;
682	DstPixel.Pixel^.B := Min(Value, 255);
683
684	Value := (DstPixel.Pixel^.G * trans + ((Color2 shr 8) and $FF) *
685	amp2 + ((Color1 shr 8) and $FF) * amp1) div $FF;
686	DstPixel.Pixel^.G := Min(Value, 255);
687
688	Value := (DstPixel.Pixel^.R * trans + (Color2 and $FF) *
689	amp2 + (Color1 and $FF) * amp1) div $FF;
690	DstPixel.Pixel^.R := Min(Value, 255);
691	end;
692
693	SrcPixel.NextPixel;
694	DstPixel.NextPixel;
695	end;
696	SrcPixel.NextLine;
697	DstPixel.NextLine;
698	end;
699	Src.EndUpdate;
700	dst.EndUpdate;
701	end;
702
703	procedure ImageOp_CBC(Dst, Src: TBitmap; xDst, yDst, xSrc, ySrc, Width, Height,
704	Color0, Color2: Integer);
705	// Src is template
706	// B channel = Color0 amp
707	// G channel = background amp (old Dst content), 128=original brightness
708	// R channel = Color2 amp
709	var
710	ix, iy, amp0, amp1, trans, Value: integer;
711	SrcPixel: TPixelPointer;
712	DstPixel: TPixelPointer;
713	begin
714	Src.BeginUpdate;
715	Dst.BeginUpdate;
716	SrcPixel := PixelPointer(Src, xSrc, ySrc);
717	DstPixel := PixelPointer(Dst, xDst, yDst);
718	for iy := 0 to Height - 1 do begin
719	for ix := 0 to Width - 1 do begin
720	trans := SrcPixel.Pixel^.B * 2; // green channel = transparency
721	amp0 := SrcPixel.Pixel^.G * 2;
722	amp1 := SrcPixel.Pixel^.R * 2;
723	if trans <> $FF then begin
724	Value := (DstPixel.Pixel^.B * trans + (Color2 shr 16 and $FF) * amp1 +
725	(Color0 shr 16 and $FF) * amp0) div $FF;
726	DstPixel.Pixel^.B := Min(Value, 255);
727
728	Value := (DstPixel.Pixel^.G * trans + (Color2 shr 8 and $FF) * amp1 +
729	(Color0 shr 8 and $FF) * amp0) div $FF;
730	DstPixel.Pixel^.G := Min(Value, 255);
731
732	Value := (DstPixel.Pixel^.R * trans + (Color2 and $FF) * amp1 +
733	(Color0 and $FF) * amp0) div $FF;
734	DstPixel.Pixel^.R := Min(Value, 255);
735	end;
736	SrcPixel.NextPixel;
737	DstPixel.NextPixel;
738	end;
739	SrcPixel.NextLine;
740	DstPixel.NextLine;
741	end;
742	Src.EndUpdate;
743	Dst.EndUpdate;
744	end;
745
746	procedure ImageOp_CCC(bmp: TBitmap; x, y, w, h, Color0, Color1, Color2: Integer);
747	// Bmp is template
748	// B channel = Color0 amp, 128=original brightness
749	// G channel = Color1 amp, 128=original brightness
750	// R channel = Color2 amp, 128=original brightness
751	var
752	i, Red, Green: Integer;
753	PixelPtr: TPixelPointer;
754	begin
755	bmp.BeginUpdate;
756	assert(bmp.PixelFormat = pf24bit);
757	h := y + h;
758	PixelPtr := PixelPointer(Bmp, x, y);
759	while y < h do begin
760	for i := 0 to w - 1 do begin
761	Red := ((PixelPtr.Pixel^.B * (Color0 and $0000FF) + PixelPtr.Pixel^.G *
762	(Color1 and $0000FF) + PixelPtr.Pixel^.R * (Color2 and $0000FF)) shr 8) and $ff;
763	Green := ((PixelPtr.Pixel^.B * ((Color0 shr 8) and $0000FF) +
764	PixelPtr.Pixel^.G * ((Color1 shr 8) and $0000FF) + PixelPtr.Pixel^.R *
765	((Color2 shr 8) and $0000FF)) shr 8) and $ff;
766	PixelPtr.Pixel^.B := ((PixelPtr.Pixel^.B * ((Color0 shr 16) and $0000FF) +
767	PixelPtr.Pixel^.G * ((Color1 shr 16) and $0000FF) + PixelPtr.Pixel^.R *
768	((Color2 shr 16) and $0000FF)) shr 8) and $ff; // Blue
769	PixelPtr.Pixel^.G := Green;
770	PixelPtr.Pixel^.R := Red;
771	PixelPtr.NextPixel;
772	end;
773	Inc(y);
774	PixelPtr.NextLine;
775	end;
776	bmp.EndUpdate;
777	end;
778
779	procedure Sprite(Canvas: TCanvas; HGr, xDst, yDst, Width, Height, xGr, yGr: integer);
780	begin
781	BitBltCanvas(Canvas, xDst, yDst, Width, Height,
782	GrExt[HGr].Mask.Canvas, xGr, yGr, SRCAND);
783	BitBltCanvas(Canvas, xDst, yDst, Width, Height,
784	GrExt[HGr].Data.Canvas, xGr, yGr, SRCPAINT);
785	end;
786
787	procedure Sprite(dst: TBitmap; HGr, xDst, yDst, Width, Height, xGr, yGr: integer);
788	begin
789	BitBltCanvas(dst.Canvas, xDst, yDst, Width, Height,
790	GrExt[HGr].Mask.Canvas, xGr, yGr, SRCAND);
791	BitBltCanvas(dst.Canvas, xDst, yDst, Width, Height,
792	GrExt[HGr].Data.Canvas, xGr, yGr, SRCPAINT);
793	end;
794
795	function BitBltCanvas(DestCanvas: TCanvas; X, Y, Width, Height: Integer;
796	SrcCanvas: TCanvas; XSrc, YSrc: Integer; Rop: DWORD = SRCCOPY): Boolean;
797	begin
798	{$IFDEF WINDOWS}
799	// LCLIntf.BitBlt is slower than direct Windows BitBlt
800	Result := Windows.BitBlt(DestCanvas.Handle, X, Y, Width, Height, SrcCanvas.Handle, XSrc, YSrc, Rop);
801	{$ELSE}
802	Result := BitBlt(DestCanvas.Handle, X, Y, Width, Height, SrcCanvas.Handle, XSrc, YSrc, Rop);
803	{$ENDIF}
804	end;
805
806	function BitBltCanvas(Dest: TCanvas; DestRect: TRect; Src: TCanvas;
807	SrcPos: TPoint; Rop: DWORD): Boolean;
808	begin
809	Result := BitBltCanvas(Dest, DestRect.Left, DestRect.Top, DestRect.Width, DestRect.Height,
810	Src, SrcPos.X, SrcPos.Y, Rop);
811	end;
812
813	function BitBltBitmap(Dest: TBitmap; X, Y, Width, Height: Integer;
814	Src: TBitmap; XSrc, YSrc: Integer; Rop: DWORD): Boolean;
815	begin
816	Result := BitBltCanvas(Dest.Canvas, X, Y, Width, Height, Src.Canvas, XSrc, YSrc, Rop);
817	end;
818
819	function BitBltBitmap(Dest: TBitmap; DestRect: TRect; Src: TBitmap;
820	SrcPos: TPoint; Rop: DWORD): Boolean;
821	begin
822	Result := BitBltCanvas(Dest.Canvas, DestRect, Src.Canvas, SrcPos, Rop);
823	end;
824
825	procedure SLine(ca: TCanvas; x0, x1, y: integer; cl: TColor);
826	begin
827	with ca do begin
828	Pen.Color := cl;
829	MoveTo(x0, y);
830	LineTo(x1 + 1, y);
831	end;
832	end;
833
834	procedure DLine(ca: TCanvas; x0, x1, y: integer; cl0, cl1: TColor);
835	begin
836	with ca do begin
837	Pen.Color := cl0;
838	MoveTo(x0, y);
839	LineTo(x1, y);
840	Pen.Color := cl1;
841	MoveTo(x0 + 1, y + 1);
842	LineTo(x1 + 1, y + 1);
843	Pixels[x0, y + 1] := cl0;
844	Pixels[x1, y] := cl1;
845	end;
846	end;
847
848	procedure Frame(ca: TCanvas; x0, y0, x1, y1: integer; cl0, cl1: TColor);
849	begin
850	with ca do begin
851	MoveTo(x0, y1);
852	Pen.Color := cl0;
853	LineTo(x0, y0);
854	LineTo(x1, y0);
855	Pen.Color := cl1;
856	LineTo(x1, y1);
857	LineTo(x0, y1);
858	end;
859	end;
860
861	procedure RFrame(ca: TCanvas; x0, y0, x1, y1: integer; cl0, cl1: TColor);
862	begin
863	with ca do begin
864	Pen.Color := cl0;
865	MoveTo(x0, y0 + 1);
866	LineTo(x0, y1);
867	MoveTo(x0 + 1, y0);
868	LineTo(x1, y0);
869	Pen.Color := cl1;
870	MoveTo(x1, y0 + 1);
871	LineTo(x1, y1);
872	MoveTo(x0 + 1, y1);
873	LineTo(x1, y1);
874	end;
875	end;
876
877	procedure CFrame(ca: TCanvas; x0, y0, x1, y1, Corner: integer; cl: TColor);
878	begin
879	with ca do begin
880	Pen.Color := cl;
881	MoveTo(x0, y0 + Corner - 1);
882	LineTo(x0, y0);
883	LineTo(x0 + Corner, y0);
884	MoveTo(x1, y0 + Corner - 1);
885	LineTo(x1, y0);
886	LineTo(x1 - Corner, y0);
887	MoveTo(x1, y1 - Corner + 1);
888	LineTo(x1, y1);
889	LineTo(x1 - Corner, y1);
890	MoveTo(x0, y1 - Corner + 1);
891	LineTo(x0, y1);
892	LineTo(x0 + Corner, y1);
893	end;
894	end;
895
896	procedure FrameImage(ca: TCanvas; Src: TBitmap;
897	x, y, Width, Height, xSrc, ySrc: integer; IsControl: boolean = False);
898	begin
899	if IsControl then begin
900	Frame(ca, x - 1, y - 1, x + Width, y + Height, $B0B0B0, $FFFFFF);
901	RFrame(ca, x - 2, y - 2, x + Width + 1, y + Height + 1, $FFFFFF, $B0B0B0);
902	end else
903	Frame(ca, x - 1, y - 1, x + Width, y + Height, $000000, $000000);
904	BitBltCanvas(ca, x, y, Width, Height, Src.Canvas, xSrc, ySrc);
905	end;
906
907	procedure GlowFrame(dst: TBitmap; x0, y0, Width, Height: Integer; cl: TColor);
908	var
909	x, y, ch, r: Integer;
910	DstPtr: TPixelPointer;
911	begin
912	dst.BeginUpdate;
913	DstPtr := PixelPointer(dst, x0 - GlowRange + 1, y0 - GlowRange + 1);
914	for y := -GlowRange + 1 to Height - 1 + GlowRange - 1 do begin
915	for x := -GlowRange + 1 to Width - 1 + GlowRange - 1 do begin
916	if x < 0 then
917	if y < 0 then
918	r := round(sqrt(sqr(x) + sqr(y)))
919	else if y >= Height then
920	r := round(sqrt(sqr(x) + sqr(y - (Height - 1))))
921	else
922	r := -x
923	else if x >= Width then
924	if y < 0 then
925	r := round(sqrt(sqr(x - (Width - 1)) + sqr(y)))
926	else if y >= Height then
927	r := round(sqrt(sqr(x - (Width - 1)) + sqr(y - (Height - 1))))
928	else
929	r := x - (Width - 1)
930	else if y < 0 then
931	r := -y
932	else if y >= Height then
933	r := y - (Height - 1)
934	else begin
935	DstPtr.NextPixel;
936	continue;
937	end;
938	if r = 0 then
939	r := 1;
940	if r < GlowRange then
941	for ch := 0 to 2 do
942	DstPtr.Pixel^.Planes[2 - ch] :=
943	(DstPtr.Pixel^.Planes[2 - ch] * (r - 1) + (cl shr (8 * ch) and $FF) *
944	(GlowRange - r)) div (GlowRange - 1);
945	DstPtr.NextPixel;
946	end;
947	DstPtr.NextLine;
948	end;
949	dst.EndUpdate;
950	end;
951
952	procedure InitOrnament;
953	var
954	x, y, p, Light, Shade: Integer;
955	begin
956	if InitOrnamentDone then Exit;
957	Light := MainTexture.clBevelLight;
958	// and $FCFCFC shr 2*3+MainTexture.clBevelShade and $FCFCFC shr 2;
959	Shade := MainTexture.clBevelShade and $FCFCFC shr 2 * 3 +
960	MainTexture.clBevelLight and $FCFCFC shr 2;
961	for x := 0 to wOrna - 1 do
962	for y := 0 to hOrna - 1 do begin
963	p := GrExt[HGrSystem2].Data.Canvas.Pixels[xOrna + x, yOrna + y];
964	if p = $0000FF then
965	GrExt[HGrSystem2].Data.Canvas.Pixels[xOrna + x, yOrna + y] := Light
966	else if p = $FF0000 then
967	GrExt[HGrSystem2].Data.Canvas.Pixels[xOrna + x, yOrna + y] := Shade;
968	end;
969	InitOrnamentDone := True;
970	end;
971
972	procedure InitCityMark(const T: TTexture);
973	var
974	x, y, intensity: Integer;
975	begin
976	for x := 0 to 9 do
977	for y := 0 to 9 do
978	if GrExt[HGrSystem].Mask.Canvas.Pixels[66 + x, 47 + y] = 0 then
979	begin
980	intensity := GrExt[HGrSystem].Data.Canvas.Pixels[66 +
981	x, 47 + y] and $FF;
982	GrExt[HGrSystem].Data.Canvas.Pixels[77 + x, 47 + y] :=
983	T.clMark and $FF * intensity div $FF + T.clMark shr 8 and
984	$FF * intensity div $FF shl 8 + T.clMark shr 16 and
985	$FF * intensity div $FF shl 16;
986	end;
987	BitBltCanvas(GrExt[HGrSystem].Mask.Canvas, 77, 47, 10, 10,
988	GrExt[HGrSystem].Mask.Canvas, 66, 47);
989	end;
990
991	procedure Fill(ca: TCanvas; Left, Top, Width, Height, xOffset, yOffset: Integer);
992	begin
993	Assert((Left + xOffset >= 0) and (Left + xOffset + Width <= wMainTexture) and
994	(Top + yOffset >= 0) and (Top + yOffset + Height <= hMainTexture));
995	BitBltCanvas(ca, Left, Top, Width, Height, MainTexture.Image.Canvas,
996	Left + xOffset, Top + yOffset);
997	end;
998
999	procedure Fill(Canvas: TCanvas; Rect: TRect; Offset: TPoint);
1000	begin
1001	Fill(Canvas, Rect.Left, Rect.Top, Rect.Width, Rect.Height, Offset.X, Offset.Y);
1002	end;
1003
1004	procedure FillLarge(ca: TCanvas; x0, y0, x1, y1, xm: Integer);
1005
1006	function Band(I: Integer): Integer;
1007	var
1008	n: integer;
1009	begin
1010	n := ((hMainTexture div 2) div (y1 - y0)) * 2;
1011	while hMainTexture div 2 + (I + 1) * (y1 - y0) > hMainTexture do
1012	Dec(I, n);
1013	while hMainTexture div 2 + I * (y1 - y0) < 0 do
1014	Inc(I, n);
1015	Result := I;
1016	end;
1017
1018	var
1019	I: Integer;
1020	begin
1021	for I := 0 to (x1 - xm) div wMainTexture - 1 do
1022	BitBltCanvas(ca, xm + I * wMainTexture, y0, wMainTexture, y1 - y0,
1023	MainTexture.Image.Canvas, 0, hMainTexture div 2 + Band(I) *
1024	(y1 - y0));
1025	BitBltCanvas(ca, xm + ((x1 - xm) div wMainTexture) * wMainTexture, y0,
1026	x1 - (xm + ((x1 - xm) div wMainTexture) * wMainTexture), y1 - y0,
1027	MainTexture.Image.Canvas, 0, hMainTexture div 2 + Band(
1028	(x1 - xm) div wMainTexture) * (y1 - y0));
1029	for I := 0 to (xm - x0) div wMainTexture - 1 do
1030	BitBltCanvas(ca, xm - (I + 1) * wMainTexture, y0, wMainTexture, y1 - y0,
1031	MainTexture.Image.Canvas, 0, hMainTexture div 2 +
1032	Band(-I - 1) * (y1 - y0));
1033	BitBltCanvas(ca, x0, y0, xm - ((xm - x0) div wMainTexture) *
1034	wMainTexture - x0, y1 - y0, MainTexture.Image.Canvas,
1035	((xm - x0) div wMainTexture + 1) * wMainTexture - (xm - x0),
1036	hMainTexture div 2 + Band(-(xm - x0) div wMainTexture - 1) * (y1 - y0));
1037	end;
1038
1039	procedure FillSeamless(ca: TCanvas; Left, Top, Width, Height, xOffset, yOffset: Integer;
1040	const Texture: TBitmap);
1041	var
1042	x, y, x0cut, y0cut, x1cut, y1cut: Integer;
1043	begin
1044	while xOffset < 0 do
1045	Inc(xOffset, Texture.Width);
1046	while yOffset < 0 do
1047	Inc(yOffset, Texture.Height);
1048	for y := (Top + yOffset) div Texture.Height to (Top + yOffset + Height - 1) div
1049	Texture.Height do
1050	begin
1051	y0cut := Top + yOffset - y * Texture.Height;
1052	if y0cut < 0 then
1053	y0cut := 0;
1054	y1cut := (y + 1) * Texture.Height - (Top + yOffset + Height);
1055	if y1cut < 0 then
1056	y1cut := 0;
1057	for x := (Left + xOffset) div Texture.Width to (Left + xOffset + Width - 1) div
1058	Texture.Width do
1059	begin
1060	x0cut := Left + xOffset - x * Texture.Width;
1061	if x0cut < 0 then
1062	x0cut := 0;
1063	x1cut := (x + 1) * Texture.Width - (Left + xOffset + Width);
1064	if x1cut < 0 then
1065	x1cut := 0;
1066	BitBltCanvas(ca, x * Texture.Width + x0cut - xOffset,
1067	y * Texture.Height + y0cut - yOffset, Texture.Width - x0cut - x1cut,
1068	Texture.Height - y0cut - y1cut, Texture.Canvas, x0cut, y0cut);
1069	end;
1070	end;
1071	end;
1072
1073	procedure FillRectSeamless(ca: TCanvas; x0, y0, x1, y1, xOffset, yOffset: Integer;
1074	const Texture: TBitmap);
1075	begin
1076	FillSeamless(ca, x0, y0, x1 - x0, y1 - y0, xOffset, yOffset, Texture);
1077	end;
1078
1079	procedure PaintBackground(Form: TForm; Left, Top, Width, Height: Integer);
1080	begin
1081	Fill(Form.Canvas, Left, Top, Width, Height, (wMainTexture - Form.ClientWidth) div
1082	2, (hMainTexture - Form.ClientHeight) div 2);
1083	end;
1084
1085	procedure Corner(ca: TCanvas; x, y, Kind: Integer; const T: TTexture);
1086	begin
1087	{ BitBltCanvas(ca,x,y,8,8,GrExt[T.HGr].Mask.Canvas,
1088	T.xGr+29+Kind*9,T.yGr+89,SRCAND);
1089	BitBltCanvas(ca,x,y,8,8,GrExt[T.HGr].Data.Canvas,
1090	T.xGr+29+Kind*9,T.yGr+89,SRCPAINT); }
1091	end;
1092
1093	procedure BiColorTextOut(ca: TCanvas; clMain, clBack: TColor; x, y: Integer; s: string);
1094
1095	procedure PaintIcon(x, y, Kind: Integer);
1096	begin
1097	BitBltCanvas(ca, x, y + 6, 10, 10, GrExt[HGrSystem].Mask.Canvas,
1098	66 + Kind mod 11 * 11, 115 + Kind div 11 * 11, SRCAND);
1099	BitBltCanvas(ca, x, y + 6, 10, 10, GrExt[HGrSystem].Data.Canvas,
1100	66 + Kind mod 11 * 11, 115 + Kind div 11 * 11, SRCPAINT);
1101	end;
1102
1103	var
1104	p, xp: Integer;
1105	sp: string;
1106	shadow: Boolean;
1107	begin
1108	Inc(x);
1109	Inc(y);
1110	for shadow := True downto False do
1111	with ca do
1112	if not shadow or (clBack <> $7F007F) then
1113	begin
1114	if shadow then
1115	Font.Color := clBack
1116	else
1117	Font.Color := clMain;
1118	sp := s;
1119	xp := x;
1120	repeat
1121	p := pos('%', sp);
1122	if (p = 0) or (p + 1 > Length(sp)) or not
1123	(sp[p + 1] in ['c', 'f', 'l', 'm', 'n', 'o', 'p', 'r', 't', 'w']) then
1124	begin
1125	ca.Textout(xp, y, sp);
1126	Break;
1127	end
1128	else
1129	begin
1130	Textout(xp, y, copy(sp, 1, p - 1));
1131	Inc(xp, ca.TextWidth(copy(sp, 1, p - 1)));
1132	if not shadow then
1133	case sp[p + 1] of
1134	'c': PaintIcon(xp + 1, y, 6);
1135	'f': PaintIcon(xp + 1, y, 0);
1136	'l': PaintIcon(xp + 1, y, 8);
1137	'm': PaintIcon(xp + 1, y, 17);
1138	'n': PaintIcon(xp + 1, y, 7);
1139	'o': PaintIcon(xp + 1, y, 16);
1140	'p': PaintIcon(xp + 1, y, 2);
1141	'r': PaintIcon(xp + 1, y, 12);
1142	't': PaintIcon(xp + 1, y, 4);
1143	'w': PaintIcon(xp + 1, y, 13);
1144	end;
1145	Inc(xp, 10);
1146	Delete(sp, 1, p + 1);
1147	end;
1148	until False;
1149	Dec(x);
1150	Dec(y);
1151	end;
1152	end;
1153
1154	function BiColorTextWidth(ca: TCanvas; s: string): Integer;
1155	var
1156	P: Integer;
1157	begin
1158	Result := 1;
1159	repeat
1160	P := Pos('%', s);
1161	if (P = 0) or (P = Length(s)) then
1162	begin
1163	Inc(Result, ca.TextWidth(s));
1164	Break;
1165	end
1166	else
1167	begin
1168	if not (s[P + 1] in ['c', 'f', 'l', 'm', 'n', 'o', 'p', 'r', 't', 'w'])
1169	then
1170	Inc(Result, ca.TextWidth(copy(s, 1, P + 1)))
1171	else
1172	Inc(Result, ca.TextWidth(copy(s, 1, P - 1)) + 10);
1173	Delete(s, 1, P + 1);
1174	end;
1175	until False;
1176	end;
1177
1178	procedure LoweredTextOut(ca: TCanvas; cl: TColor; const T: TTexture;
1179	x, y: Integer; s: string);
1180	begin
1181	if cl = -2 then
1182	BiColorTextOut(ca, (T.clBevelShade and $FEFEFE) shr 1,
1183	T.clBevelLight, x, y, s)
1184	else if cl < 0 then
1185	BiColorTextOut(ca, T.clTextShade, T.clTextLight, x, y, s)
1186	else
1187	BiColorTextOut(ca, cl, T.clTextLight, x, y, s);
1188	end;
1189
1190	procedure RisedTextOut(ca: TCanvas; x, y: integer; s: string);
1191	begin
1192	BiColorTextOut(ca, $FFFFFF, $000000, x, y, s);
1193	end;
1194
1195	procedure Gradient(ca: TCanvas; x, y, dx, dy, Width, Height, Color: Integer;
1196	Brightness: array of integer);
1197	var
1198	i, r, g, b: Integer;
1199	begin
1200	begin
1201	for i := 0 to 15 do
1202	begin // gradient
1203	r := Color and $FF + Brightness[i];
1204	if r < 0 then
1205	r := 0
1206	else if r >= 256 then
1207	r := 255;
1208	g := Color shr 8 and $FF + Brightness[i];
1209	if g < 0 then
1210	g := 0
1211	else if g >= 256 then
1212	g := 255;
1213	b := Color shr 16 and $FF + Brightness[i];
1214	if b < 0 then
1215	b := 0
1216	else if b >= 256 then
1217	b := 255;
1218	ca.Pen.Color := r + g shl 8 + b shl 16;
1219	ca.MoveTo(x + dx * i, y + dy * i);
1220	ca.LineTo(x + dx * i + Width, y + dy * i + Height);
1221	end;
1222	ca.Pen.Color := $000000;
1223	ca.MoveTo(x + 1, y + 16 * dy + Height);
1224	ca.LineTo(x + 16 * dx + Width, y + 16 * dy + Height);
1225	ca.LineTo(x + 16 * dx + Width, y);
1226	end;
1227	end;
1228
1229	procedure LightGradient(ca: TCanvas; x, y, Width, Color: Integer);
1230	const
1231	Brightness: array [0 .. 15] of integer =
1232	(16, 12, 8, 4, 0, -4, -8, -12, -16, -20, -24, -28, -32, -36, -40, -44);
1233	begin
1234	Gradient(ca, x, y, 0, 1, Width, 0, Color, Brightness);
1235	end;
1236
1237	procedure DarkGradient(ca: TCanvas; x, y, Width, Kind: Integer);
1238	const
1239	Brightness: array [0 .. 15] of integer =
1240	(16, 12, 8, 4, 0, -4, -8, -12 - 24, -16 + 16, -20, -24, -28, -32, -36, -40, -44);
1241	begin
1242	Gradient(ca, x, y, 0, 1, Width, 0, GrExt[HGrSystem].Data.Canvas.Pixels
1243	[187, 137 + Kind], Brightness);
1244	end;
1245
1246	procedure VLightGradient(ca: TCanvas; x, y, Height, Color: Integer);
1247	const
1248	Brightness: array [0 .. 15] of integer =
1249	(16, 12, 8, 4, 0, -4, -8, -12, -16, -20, -24, -28, -32, -36, -40, -44);
1250	begin
1251	Gradient(ca, x, y, 1, 0, 0, Height, Color, Brightness);
1252	end;
1253
1254	procedure VDarkGradient(ca: TCanvas; x, y, Height, Kind: Integer);
1255	const
1256	Brightness: array [0 .. 15] of integer =
1257	(16, 12, 8, 4, 0, -4, -8, -12 - 24, -16 + 16, -20, -24, -28, -32, -36, -40, -44);
1258	begin
1259	Gradient(ca, x, y, 1, 0, 0, Height,
1260	GrExt[HGrSystem].Data.Canvas.Pixels[187, 137 + Kind], Brightness);
1261	end;
1262
1263	procedure NumberBar(dst: TBitmap; x, y: integer; Cap: string;
1264	val: Integer; const T: TTexture);
1265	var
1266	s: string;
1267	begin
1268	if val > 0 then
1269	begin
1270	DLine(dst.Canvas, x - 2, x + 170, y + 16, T.clBevelShade,
1271	T.clBevelLight);
1272	LoweredTextOut(dst.Canvas, -1, T, x - 2, y, Cap);
1273	s := IntToStr(val);
1274	RisedTextOut(dst.Canvas, x + 170 - BiColorTextWidth(dst.Canvas,
1275	s), y, s);
1276	end;
1277	end;
1278
1279	procedure CountBar(dst: TBitmap; x, y, w: Integer; Kind: Integer;
1280	Cap: string; val: Integer; const T: TTexture);
1281	var
1282	i, sd, ld, cl, xIcon, yIcon: Integer;
1283	s: string;
1284	begin
1285	// val:=random(40); //!!!
1286	if val = 0 then
1287	Exit;
1288	Assert(Kind >= 0);
1289	with dst.Canvas do
1290	begin
1291	// xIcon:=x+100;
1292	// yIcon:=y;
1293	// DLine(dst.Canvas,x-2,x+170+32,y+16,T.clBevelShade,T.clBevelLight);
1294
1295	xIcon := x - 5;
1296	yIcon := y + 15;
1297	DLine(dst.Canvas, x - 2, xIcon + w + 2, yIcon + 16, T.clBevelShade,
1298	T.clBevelLight);
1299
1300	s := IntToStr(val);
1301	if val < 0 then
1302	cl := $0000FF
1303	else
1304	cl := -1;
1305	LoweredTextOut(dst.Canvas, cl, T, x - 2, y, Cap);
1306	LoweredTextOut(dst.Canvas, cl, T,
1307	xIcon + w + 2 - BiColorTextWidth(dst.Canvas, s), yIcon, s);
1308
1309	if (Kind = 12) and (val >= 100) then
1310	begin // science with symbol for 100
1311	val := val div 10;
1312	sd := 14 * (val div 10 + val mod 10 - 1);
1313	if sd = 0 then
1314	sd := 1;
1315	if sd < w - 44 then
1316	ld := sd
1317	else
1318	ld := w - 44;
1319	for i := 0 to val mod 10 - 1 do
1320	begin
1321	BitBltCanvas(dst.Canvas, xIcon + 4 + i * (14 * ld div sd), yIcon + 2 + 1, 14,
1322	14, GrExt[HGrSystem].Mask.Canvas, 67 + Kind mod 8 * 15,
1323	70 + Kind div 8 * 15, SRCAND);
1324	Sprite(dst, HGrSystem, xIcon + 3 + i * (14 * ld div sd), yIcon + 2,
1325	14, 14, 67 + Kind mod 8 * 15, 70 + Kind div 8 * 15);
1326	end;
1327	for i := 0 to val div 10 - 1 do
1328	begin
1329	BitBltCanvas(dst.Canvas, xIcon + 4 + (val mod 10) *
1330	(14 * ld div sd) + i * (14 * ld div sd), yIcon + 3, 14, 14,
1331	GrExt[HGrSystem].Mask.Canvas, 67 + 7 mod 8 * 15,
1332	70 + 7 div 8 * 15, SRCAND);
1333	Sprite(dst, HGrSystem, xIcon + 3 + (val mod 10) *
1334	(14 * ld div sd) + i * (14 * ld div sd), yIcon + 2, 14,
1335	14, 67 + 7 mod 8 * 15,
1336	70 + 7 div 8 * 15);
1337	end;
1338	end
1339	else
1340	begin
1341	val := abs(val);
1342	if val mod 10 = 0 then
1343	sd := 14 * (val div 10 - 1)
1344	else
1345	sd := 10 * (val mod 10 - 1) + 14 * (val div 10);
1346	if sd = 0 then
1347	sd := 1;
1348	if sd < w - 44 then
1349	ld := sd
1350	else
1351	ld := w - 44;
1352	for i := 0 to val div 10 - 1 do
1353	begin
1354	BitBltCanvas(dst.Canvas, xIcon + 4 + i * (14 * ld div sd), yIcon + 3, 14, 14,
1355	GrExt[HGrSystem].Mask.Canvas, 67 + Kind mod 8 * 15,
1356	70 + Kind div 8 * 15, SRCAND);
1357	Sprite(dst, HGrSystem, xIcon + 3 + i * (14 * ld div sd), yIcon + 2,
1358	14, 14, 67 + Kind mod 8 * 15, 70 + Kind div 8 * 15);
1359	end;
1360	for i := 0 to val mod 10 - 1 do
1361	begin
1362	BitBltCanvas(dst.Canvas, xIcon + 4 + (val div 10) *
1363	(14 * ld div sd) + i * (10 * ld div sd), yIcon + 7, 10, 10,
1364	GrExt[HGrSystem].Mask.Canvas, 66 + Kind mod 11 * 11,
1365	115 + Kind div 11 * 11, SRCAND);
1366	Sprite(dst, HGrSystem, xIcon + 3 + (val div 10) *
1367	(14 * ld div sd) + i * (10 * ld div sd), yIcon + 6, 10,
1368	10, 66 + Kind mod 11 * 11,
1369	115 + Kind div 11 * 11);
1370	end;
1371	end;
1372	end;
1373	end;
1374
1375	procedure PaintProgressBar(ca: TCanvas; Kind, x, y, pos, Growth, max: Integer;
1376	const T: TTexture);
1377	var
1378	i: Integer;
1379	begin
1380	if pos > max then
1381	pos := max;
1382	if Growth < 0 then
1383	begin
1384	pos := pos + Growth;
1385	if pos < 0 then
1386	begin
1387	Growth := Growth - pos;
1388	pos := 0;
1389	end;
1390	end
1391	else if pos + Growth > max then
1392	Growth := max - pos;
1393	Frame(ca, x - 1, y - 1, x + max, y + 7, $000000, $000000);
1394	RFrame(ca, x - 2, y - 2, x + max + 1, y + 8, T.clBevelShade,
1395	T.clBevelLight);
1396	with ca do
1397	begin
1398	for i := 0 to pos div 8 - 1 do
1399	BitBltCanvas(ca, x + i * 8, y, 8, 7,
1400	GrExt[HGrSystem].Data.Canvas, 104, 9 + 8 * Kind);
1401	BitBltCanvas(ca, x + 8 * (pos div 8), y, pos - 8 * (pos div 8), 7,
1402	GrExt[HGrSystem].Data.Canvas, 104, 9 + 8 * Kind);
1403	if Growth > 0 then
1404	begin
1405	for i := 0 to Growth div 8 - 1 do
1406	BitBltCanvas(ca, x + pos + i * 8, y, 8, 7,
1407	GrExt[HGrSystem].Data.Canvas, 112, 9 + 8 * Kind);
1408	BitBltCanvas(ca, x + pos + 8 * (Growth div 8), y,
1409	Growth - 8 * (Growth div 8), 7, GrExt[HGrSystem].Data.Canvas,
1410	112, 9 + 8 * Kind);
1411	end
1412	else if Growth < 0 then
1413	begin
1414	for i := 0 to -Growth div 8 - 1 do
1415	BitBltCanvas(ca, x + pos + i * 8, y, 8, 7,
1416	GrExt[HGrSystem].Data.Canvas, 104, 1);
1417	BitBltCanvas(ca, x + pos + 8 * (-Growth div 8), y, -Growth -
1418	8 * (-Growth div 8), 7,
1419	GrExt[HGrSystem].Data.Canvas, 104, 1);
1420	end;
1421	Brush.Color := $000000;
1422	FillRect(Rect(x + pos + abs(Growth), y, x + max, y + 7));
1423	Brush.Style := bsClear;
1424	end;
1425	end;
1426
1427	// pos and growth are relative to max, set size independent
1428	procedure PaintRelativeProgressBar(ca: TCanvas;
1429	Kind, x, y, size, pos, Growth, max: Integer; IndicateComplete: Boolean;
1430	const T: TTexture);
1431	begin
1432	if Growth > 0 then
1433	PaintProgressBar(ca, Kind, x, y, pos * size div max,
1434	(Growth * size + max div 2) div max, size, T)
1435	else
1436	PaintProgressBar(ca, Kind, x, y, pos * size div max,
1437	(Growth * size - max div 2) div max, size, T);
1438	if IndicateComplete and (pos + Growth >= max) then
1439	Sprite(ca, HGrSystem, x + size - 10, y - 7, 23, 16, 1, 129);
1440	end;
1441
1442	procedure PaintLogo(ca: TCanvas; x, y, clLight, clShade: Integer);
1443	begin
1444	// TODO: Explicitly clear background to black but in fact BitBlt SRCCOPY should do it
1445	LogoBuffer.Canvas.FillRect(0, 0, LogoBuffer.Width, LogoBuffer.Height);
1446	BitBltCanvas(LogoBuffer.Canvas, 0, 0, wLogo, hLogo, ca, x, y);
1447	ImageOp_BCC(LogoBuffer, Templates, 0, 0, 1, 1, wLogo, hLogo,
1448	clLight, clShade);
1449	BitBltCanvas(ca, x, y, wLogo, hLogo, LogoBuffer.Canvas, 0, 0);
1450	end;
1451
1452	function SetMainTextureByAge(Age: Integer): Boolean;
1453	begin
1454	if Age <> MainTextureAge then
1455	with MainTexture do begin
1456	MainTextureAge := Age;
1457	LoadGraphicFile(Image, GetGraphicsDir + DirectorySeparator +
1458	'Texture' + IntToStr(Age + 1) + '.jpg');
1459	clBevelLight := Colors.Canvas.Pixels[clkAge0 + Age, cliBevelLight];
1460	clBevelShade := Colors.Canvas.Pixels[clkAge0 + Age, cliBevelShade];
1461	clTextLight := Colors.Canvas.Pixels[clkAge0 + Age, cliTextLight];
1462	clTextShade := Colors.Canvas.Pixels[clkAge0 + Age, cliTextShade];
1463	clLitText := Colors.Canvas.Pixels[clkAge0 + Age, cliLitText];
1464	clMark := Colors.Canvas.Pixels[clkAge0 + Age, cliMark];
1465	clPage := Colors.Canvas.Pixels[clkAge0 + Age, cliPage];
1466	clCover := Colors.Canvas.Pixels[clkAge0 + Age, cliCover];
1467	Result := True;
1468	end
1469	else
1470	Result := False;
1471	end;
1472
1473	procedure LoadPhrases;
1474	begin
1475	if Phrases = nil then Phrases := TStringTable.Create;
1476	if Phrases2 = nil then Phrases2 := TStringTable.Create;
1477	Phrases2FallenBackToEnglish := False;
1478	if FileExists(LocalizedFilePath('Language.txt')) then
1479	begin
1480	Phrases.LoadFromFile(LocalizedFilePath('Language.txt'));
1481	if FileExists(LocalizedFilePath('Language2.txt')) then
1482	Phrases2.LoadFromFile(LocalizedFilePath('Language2.txt'))
1483	else
1484	begin
1485	Phrases2.LoadFromFile(HomeDir + 'Language2.txt');
1486	Phrases2FallenBackToEnglish := True;
1487	end;
1488	end
1489	else
1490	begin
1491	Phrases.LoadFromFile(HomeDir + 'Language.txt');
1492	Phrases2.LoadFromFile(HomeDir + 'Language2.txt');
1493	end;
1494
1495	if Sounds = nil then Sounds := TStringTable.Create;
1496	if not Sounds.LoadFromFile(GetSoundsDir + DirectorySeparator + 'sound.txt') then
1497	begin
1498	FreeAndNil(Sounds);
1499	end;
1500	end;
1501
1502	procedure Texturize(Dest, Texture: TBitmap; TransparentColor: Integer);
1503	var
1504	SrcPixel, DstPixel: TPixelPointer;
1505	X, Y: Integer;
1506	TexWidth, TexHeight: Integer;
1507	begin
1508	// texturize background
1509	Dest.BeginUpdate;
1510	TexWidth := Texture.Width;
1511	TexHeight := Texture.Height;
1512	DstPixel := PixelPointer(Dest);
1513	SrcPixel := PixelPointer(Texture);
1514	for Y := 0 to Dest.Height - 1 do begin
1515	for X := 0 to Dest.Width - 1 do begin
1516	if (DstPixel.Pixel^.ARGB and $FFFFFF) = TransparentColor then begin
1517	SrcPixel.SetXY(X mod TexWidth, Y mod TexHeight);
1518	DstPixel.Pixel^.B := SrcPixel.Pixel^.B;
1519	DstPixel.Pixel^.G := SrcPixel.Pixel^.G;
1520	DstPixel.Pixel^.R := SrcPixel.Pixel^.R;
1521	end;
1522	DstPixel.NextPixel;
1523	end;
1524	DstPixel.NextLine;
1525	end;
1526	Dest.EndUpdate;
1527	end;
1528
1529	procedure DarkenImage(Bitmap: TBitmap; Change: Integer);
1530	var
1531	x, y: integer;
1532	PicturePixel: TPixelPointer;
1533	begin
1534	Bitmap.BeginUpdate;
1535	PicturePixel := PixelPointer(Bitmap);
1536	for y := 0 to Bitmap.Height - 1 do begin
1537	for x := 0 to Bitmap.Width - 1 do begin
1538	PicturePixel.Pixel^.B := Max(PicturePixel.Pixel^.B - Change, 0);
1539	PicturePixel.Pixel^.G := Max(PicturePixel.Pixel^.G - Change, 0);
1540	PicturePixel.Pixel^.R := Max(PicturePixel.Pixel^.R - Change, 0);
1541	PicturePixel.NextPixel;
1542	end;
1543	PicturePixel.NextLine;
1544	end;
1545	Bitmap.EndUpdate;
1546	end;
1547
1548	procedure LoadFonts;
1549	var
1550	Section: TFontType;
1551	FontScript: TextFile;
1552	Size: integer;
1553	S: string;
1554	I: integer;
1555	P: integer;
1556	begin
1557	Section := ftNormal;
1558	AssignFile(FontScript, LocalizedFilePath('Fonts.txt'));
1559	try
1560	Reset(FontScript);
1561	while not Eof(FontScript) do begin
1562	ReadLn(FontScript, s);
1563	if s <> '' then
1564	if s[1] = '#' then begin
1565	s := TrimRight(s);
1566	if s = '#SMALL' then Section := ftSmall
1567	else if s = '#TINY' then Section := ftTiny
1568	else if s = '#CAPTION' then Section := ftCaption
1569	else if s = '#BUTTON' then Section := ftButton
1570	else Section := ftNormal;
1571	end else begin
1572	p := Pos(',', s);
1573	if p > 0 then begin
1574	UniFont[section].Name := Trim(Copy(s, 1, p - 1));
1575	Size := 0;
1576	for i := p + 1 to Length(s) do
1577	case s[i] of
1578	'0' .. '9':
1579	Size := Size * 10 + Byte(s[i]) - 48;
1580	'B', 'b':
1581	UniFont[section].Style := UniFont[section].Style + [fsBold];
1582	'I', 'i':
1583	UniFont[section].Style := UniFont[section].Style + [fsItalic];
1584	end;
1585	// 0.8 constant is compensation for Lazarus as size of fonts against Delphi differs
1586	UniFont[section].Size :=
1587	Round(size * Screen.PixelsPerInch / UniFont[section].PixelsPerInch * 0.8);
1588	end;
1589	end;
1590	end;
1591	CloseFile(FontScript);
1592	except
1593	end;
1594	end;
1595
1596	procedure ReleaseFonts;
1597	var
1598	Section: TFontType;
1599	begin
1600	for Section := Low(TFontType) to High(TFontType) do
1601	FreeAndNil(UniFont[section]);
1602	end;
1603
1604	procedure InitGammaLookupTable;
1605	var
1606	I: Integer;
1607	P: Integer;
1608	begin
1609	GammaLookupTable[0] := 0;
1610	for I := 1 to 255 do begin
1611	P := Round(255.0 * Exp(Ln(I / 255.0) * 100.0 / Gamma));
1612	Assert((P >= 0) and (P < 256));
1613	GammaLookupTable[I] := P;
1614	end;
1615	end;
1616
1617	procedure LoadAssets;
1618	begin
1619	LoadPhrases;
1620	LoadFonts;
1621	LoadGraphicFile(Templates, GetGraphicsDir + DirectorySeparator +
1622	'Templates.png', gfNoGamma);
1623	LoadGraphicFile(Colors, GetGraphicsDir + DirectorySeparator + 'Colors.png');
1624	LoadGraphicFile(Paper, GetGraphicsDir + DirectorySeparator + 'Paper.jpg');
1625	LoadGraphicFile(BigImp, GetGraphicsDir + DirectorySeparator + 'Icons.png');
1626	end;
1627
1628	procedure UnitInit;
1629	var
1630	Section: TFontType;
1631	begin
1632	Gamma := 100;
1633	InitGammaLookupTable;
1634
1635	{$IFDEF WINDOWS}
1636	EnumDisplaySettings(nil, $FFFFFFFF, StartResolution);
1637	ResolutionChanged := False;
1638	{$ENDIF}
1639
1640	LogoBuffer := TBitmap.Create;
1641	LogoBuffer.PixelFormat := pf24bit;
1642	LogoBuffer.SetSize(wBBook, hBBook);
1643
1644	for Section := Low(TFontType) to High(TFontType) do
1645	UniFont[Section] := TFont.Create;
1646
1647	nGrExt := 0;
1648	HGrSystem := LoadGraphicSet('System.png');
1649	HGrSystem2 := LoadGraphicSet('System2.png');
1650	Templates := TBitmap.Create;
1651	Templates.PixelFormat := pf24bit;
1652	Colors := TBitmap.Create;
1653	Colors.PixelFormat := pf24bit;
1654	Paper := TBitmap.Create;
1655	Paper.PixelFormat := pf24bit;
1656	BigImp := TBitmap.Create;
1657	BigImp.PixelFormat := pf24bit;
1658	MainTexture.Image := TBitmap.Create;
1659	MainTextureAge := -2;
1660	ClickFrameColor := GrExt[HGrSystem].Data.Canvas.Pixels[187, 175];
1661	InitOrnamentDone := False;
1662	GenerateNames := True;
1663
1664	LoadAssets;
1665	end;
1666
1667	procedure UnitDone;
1668	var
1669	I: integer;
1670	begin
1671	RestoreResolution;
1672	for I := 0 to nGrExt - 1 do begin
1673	GrExt[I].Data.Free;
1674	GrExt[I].Mask.Free;
1675	FreeMem(GrExt[I]);
1676	end;
1677
1678	ReleaseFonts;
1679
1680	FreeAndNil(Phrases);
1681	FreeAndNil(Phrases2);
1682	FreeAndNil(LogoBuffer);
1683	FreeAndNil(BigImp);
1684	FreeAndNil(Paper);
1685	FreeAndNil(Templates);
1686	FreeAndNil(Colors);
1687	FreeAndNil(MainTexture.Image);
1688	end;
1689
1690	end.

Note: See TracBrowser for help on using the repository browser.

Download in other formats: