1 | unit UFormMain;
|
---|
2 |
|
---|
3 | {$mode delphi}{$H+}
|
---|
4 |
|
---|
5 | interface
|
---|
6 |
|
---|
7 | uses
|
---|
8 | Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,
|
---|
9 | Math, LazFileUtils, UPixelPointer, Process;
|
---|
10 |
|
---|
11 | type
|
---|
12 |
|
---|
13 | { TFormMain }
|
---|
14 |
|
---|
15 | TFormMain = class(TForm)
|
---|
16 | ButtonTile: TButton;
|
---|
17 | ButtonAlpha: TButton;
|
---|
18 | ButtonResize: TButton;
|
---|
19 | procedure ButtonAlphaClick(Sender: TObject);
|
---|
20 | procedure ButtonResizeClick(Sender: TObject);
|
---|
21 | procedure ButtonTileClick(Sender: TObject);
|
---|
22 | procedure FormShow(Sender: TObject);
|
---|
23 | private
|
---|
24 | function SwapColors(Color: Cardinal): Cardinal;
|
---|
25 | procedure UseAlphaFile(SourceName: string; BBC: Boolean);
|
---|
26 | procedure UseAlphaBitmap(SrcBitmap, DstBitmap: TBitmap; BBC: Boolean = False);
|
---|
27 | procedure RestoreAlphaBitmap(SrcBitmap, DstBitmap: TBitmap; BBC: Boolean = False);
|
---|
28 | procedure ResizeRect(SrcBitmap, DstBitmap: TBitmap; SrcRect, DstRect: TRect);
|
---|
29 | procedure ResizeRectXbrz(SrcBitmap, DstBitmap: TBitmap);
|
---|
30 | procedure ProcessBitmapRect(SrcBitmap, DstBitmap: TBitmap; SrcRect, DstRect: TRect);
|
---|
31 | procedure ResizeAuxPos(SrcBitmap, DstBitmap: TBitmap; SrcRect, DstRect: TRect);
|
---|
32 | public
|
---|
33 | procedure ResizeImage(SourceName: string; SourceSize: TPoint; Count: TPoint;
|
---|
34 | DestName: string; DestSize: TPoint);
|
---|
35 | end;
|
---|
36 |
|
---|
37 | var
|
---|
38 | FormMain: TFormMain;
|
---|
39 |
|
---|
40 | implementation
|
---|
41 |
|
---|
42 | {$R *.lfm}
|
---|
43 |
|
---|
44 | uses
|
---|
45 | UBitmapSet;
|
---|
46 |
|
---|
47 | { TFormMain }
|
---|
48 |
|
---|
49 | procedure TFormMain.FormShow(Sender: TObject);
|
---|
50 | begin
|
---|
51 | end;
|
---|
52 |
|
---|
53 | function TFormMain.SwapColors(Color: Cardinal): Cardinal;
|
---|
54 | begin
|
---|
55 | Result := ((Color and $ff0000) shr 16) or (Color and $00ff00) or
|
---|
56 | ((Color and $ff) shl 16) or (Color and $ff000000);
|
---|
57 | end;
|
---|
58 |
|
---|
59 | procedure TFormMain.ButtonResizeClick(Sender: TObject);
|
---|
60 | var
|
---|
61 | NewSize: TPoint;
|
---|
62 | OldSize: TPoint;
|
---|
63 | OldFileName: string;
|
---|
64 | NewFileName: string;
|
---|
65 | I: Integer;
|
---|
66 | const
|
---|
67 | //Files: array[0..0] of string = ('Cities66x32.png');
|
---|
68 | Files: array[0..0] of string = ('Cities96x48.png');
|
---|
69 | //Files: array[0..0] of string = ('Terrain96x48.png');
|
---|
70 | //Files: array[0..1] of string = ('Cities66x32.png', 'Terrain66x32.png');
|
---|
71 | //Files: array[0..1] of string = ('Cities96x48.png', 'Terrain96x48.png');
|
---|
72 | TileCount: array[0..1] of TPoint = ((X: 8; Y: 2), (X: 9; Y: 21));
|
---|
73 | //TileCount: array[0..0] of TPoint = ((X: 9; Y: 21));
|
---|
74 | begin
|
---|
75 | //OldSize := Point(66, 48);
|
---|
76 | OldSize := Point(96, 72);
|
---|
77 | //NewSize := Point(96, 72);
|
---|
78 | //NewSize := Point(66, 48);
|
---|
79 | NewSize := Point(144, 108);
|
---|
80 | //NewSize := Point(192, 144);
|
---|
81 |
|
---|
82 | for I := 0 to Length(Files) - 1 do begin
|
---|
83 | OldFileName := Files[I];
|
---|
84 | NewFileName := '_' + OldFileName;
|
---|
85 | ResizeImage(OldFileName, OldSize, TileCount[I], NewFileName, NewSize);
|
---|
86 | end;
|
---|
87 | end;
|
---|
88 |
|
---|
89 | procedure TFormMain.ButtonTileClick(Sender: TObject);
|
---|
90 | var
|
---|
91 | Ptr: TPixelPointer;
|
---|
92 | X, Y: Integer;
|
---|
93 | Bitmap: TBitmap;
|
---|
94 | begin
|
---|
95 | Bitmap := TBitmap.Create;
|
---|
96 | Bitmap.LoadFromFile('tile.bmp');
|
---|
97 |
|
---|
98 | Bitmap.BeginUpdate;
|
---|
99 | Ptr := PixelPointer(Bitmap);
|
---|
100 | for Y := 0 to Bitmap.Height - 1 do begin
|
---|
101 | for X := 0 to Bitmap.Width - 1 do begin
|
---|
102 | if Ptr.Pixel^.ARGB <> 0 then begin
|
---|
103 | if ((X + Y) mod 2) = 0 then
|
---|
104 | Ptr.Pixel^.ARGB := $ff7f007f
|
---|
105 | else Ptr.Pixel^.ARGB := $ff000000;
|
---|
106 | end else Ptr.Pixel^.ARGB := $ff7f007f;
|
---|
107 | Ptr.NextPixel;
|
---|
108 | end;
|
---|
109 | Ptr.NextLine;
|
---|
110 | end;
|
---|
111 | Bitmap.EndUpdate;
|
---|
112 |
|
---|
113 | Bitmap.SaveToFile('tile_.bmp');
|
---|
114 | Bitmap.Free;
|
---|
115 | end;
|
---|
116 |
|
---|
117 | procedure TFormMain.ButtonAlphaClick(Sender: TObject);
|
---|
118 | const
|
---|
119 | Files: array[0..11] of string = (
|
---|
120 | 'Cities66x32.png', 'Cities96x48.png', 'Cities144x72.png',
|
---|
121 | 'Terrain66x32.png', 'Terrain96x48.png', 'Terrain144x72.png',
|
---|
122 | 'Nation1.png', 'Nation2.png', 'StdCities.png', 'StdUnits.png', 'System.png',
|
---|
123 | 'System2.png');
|
---|
124 | var
|
---|
125 | I: Integer;
|
---|
126 | begin
|
---|
127 | I := 0;
|
---|
128 | for I := 0 to Length(Files) - 1 do
|
---|
129 | UseAlphaFile('../../trunk/Graphics/' + Files[I], False);
|
---|
130 | UseAlphaFile('../../trunk/Help/AdvTree.png', False);
|
---|
131 | //UseAlphaFile('../../trunk/Graphics/Templates.png', True);
|
---|
132 | end;
|
---|
133 |
|
---|
134 | procedure FillRectBitmap(Bitmap: TBitmap; Color: TColor32);
|
---|
135 | var
|
---|
136 | Ptr: TPixelPointer;
|
---|
137 | X, Y: Integer;
|
---|
138 | begin
|
---|
139 | Bitmap.BeginUpdate;
|
---|
140 | Ptr := PixelPointer(Bitmap);
|
---|
141 | for Y := 0 to Bitmap.Height - 1 do begin
|
---|
142 | for X := 0 to Bitmap.Width - 1 do begin
|
---|
143 | Ptr.Pixel^.ARGB := Color;
|
---|
144 | Ptr.NextPixel;
|
---|
145 | end;
|
---|
146 | Ptr.NextLine;
|
---|
147 | end;
|
---|
148 | Bitmap.EndUpdate;
|
---|
149 | end;
|
---|
150 |
|
---|
151 | procedure TFormMain.UseAlphaFile(SourceName: string; BBC: Boolean);
|
---|
152 | var
|
---|
153 | ImageSrc: TImage;
|
---|
154 | ImageDest: TImage;
|
---|
155 | X, Y: Integer;
|
---|
156 | PtrSrc: PPixel32;
|
---|
157 | PtrDest: PPixel32;
|
---|
158 | C: TPixel32;
|
---|
159 | Size: TPoint;
|
---|
160 | Trans, Amp1, Amp2, Value: Integer;
|
---|
161 | Color1, Color2: TPixel32;
|
---|
162 | BitmapSet: TBitmapSet;
|
---|
163 | BitmapDesc: TBitmapDesc;
|
---|
164 | I: Integer;
|
---|
165 | begin
|
---|
166 | BitmapSet := TBitmapSet.Create;
|
---|
167 | if FileExists(ExtractFileNameOnly(SourceName) + '.txt') then
|
---|
168 | BitmapSet.LoadFromFile(ExtractFileNameOnly(SourceName) + '.txt');
|
---|
169 |
|
---|
170 | ImageSrc := TImage.Create(nil);
|
---|
171 | ImageSrc.Picture.LoadFromFile(SourceName);
|
---|
172 | ImageDest := TImage.Create(nil);
|
---|
173 | ImageDest.Picture.Bitmap.PixelFormat := pf32bit;
|
---|
174 |
|
---|
175 | UseAlphaBitmap(ImageSrc.Picture.Bitmap, ImageDest.Picture.Bitmap, BBC);
|
---|
176 |
|
---|
177 | ImageDest.Picture.SaveToFile(ExtractFileName(SourceName));
|
---|
178 | ImageSrc.Free;
|
---|
179 | ImageDest.Free;
|
---|
180 | BitmapSet.Free;
|
---|
181 | end;
|
---|
182 |
|
---|
183 | procedure TFormMain.UseAlphaBitmap(SrcBitmap, DstBitmap: TBitmap; BBC: Boolean);
|
---|
184 | var
|
---|
185 | X, Y: Integer;
|
---|
186 | PtrSrc: PPixel32;
|
---|
187 | PtrDest: PPixel32;
|
---|
188 | C: TPixel32;
|
---|
189 | Size: TPoint;
|
---|
190 | Trans, Amp1, Amp2, Value: Integer;
|
---|
191 | Color1, Color2: TPixel32;
|
---|
192 | BitmapSet: TBitmapSet;
|
---|
193 | BitmapDesc: TBitmapDesc;
|
---|
194 | I: Integer;
|
---|
195 | begin
|
---|
196 | Size := Point(SrcBitmap.Width, SrcBitmap.Height);
|
---|
197 | SrcBitmap.BeginUpdate(True);
|
---|
198 | DstBitmap.SetSize(Size.X, Size.Y);
|
---|
199 | DstBitmap.BeginUpdate(True);
|
---|
200 | for Y := 0 to Size.Y - 1 do
|
---|
201 | for X := 0 to Size.X - 1 do begin
|
---|
202 | PtrSrc := SrcBitmap.ScanLine[Y] + X * 4;
|
---|
203 | PtrDest := DstBitmap.ScanLine[Y] + X * 4;
|
---|
204 | C.ARGB := PtrSrc^.ARGB and $ffffff;
|
---|
205 | //C.ARGB := SwapColors(C.ARGB);
|
---|
206 | if BBC then begin
|
---|
207 | PtrDest^.R := C.R;
|
---|
208 | PtrDest^.G := C.G;
|
---|
209 | PtrDest^.B := 0; //C.B;
|
---|
210 | PtrDest^.A := 255 - C.B; // blue channel = transparency
|
---|
211 | end else begin
|
---|
212 | if (C.ARGB = $7f007f) or (C.ARGB = $ff00ff) then
|
---|
213 | PtrDest^.ARGB := $00000000
|
---|
214 | else PtrDest^.ARGB := SwapColors($ff000000 or C.ARGB);
|
---|
215 | end;
|
---|
216 | end;
|
---|
217 |
|
---|
218 | { if BBC then begin
|
---|
219 | for I := 0 to BitmapSet.Items.Count - 1 do begin
|
---|
220 | BitmapDesc := BitmapSet.Items[I];
|
---|
221 | for Y := BitmapDesc.Rect.Top to BitmapDesc.Rect.Top + BitmapDesc.Rect.Height - 1 do
|
---|
222 | for X := BitmapDesc.Rect.Left to BitmapDesc.Rect.Left + BitmapDesc.Rect.Width - 1 do begin
|
---|
223 | Color1.ARGB := BitmapDesc.Color1;
|
---|
224 | Color2.ARGB := BitmapDesc.Color2;
|
---|
225 | PtrDest := ImageDest.Picture.Bitmap.ScanLine[Y] + X * 4;
|
---|
226 | C.ARGB := PtrDest^.ARGB;
|
---|
227 | trans := C.A * 2;
|
---|
228 | amp1 := C.G * 2;
|
---|
229 | amp2 := C.R * 2;
|
---|
230 | if trans <> $FF then begin
|
---|
231 | Value := (0 * trans + Color2.R * amp2 + Color1.R * amp1) div $FF;
|
---|
232 | PtrDest^.B := Min(Value, 255);
|
---|
233 |
|
---|
234 | Value := (0 * trans + Color2.G * amp2 + Color1.G * amp1) div $FF;
|
---|
235 | PtrDest^.G := Min(Value, 255);
|
---|
236 |
|
---|
237 | Value := (0 * trans + Color2.B * amp2 + Color1.B * amp1) div $FF;
|
---|
238 | PtrDest^.R := Min(Value, 255);
|
---|
239 |
|
---|
240 | PtrDest^.A := 255 - Min(Trans, 255)
|
---|
241 | end;
|
---|
242 | end;
|
---|
243 | end;
|
---|
244 | end;
|
---|
245 | }
|
---|
246 | SrcBitmap.EndUpdate;
|
---|
247 | DstBitmap.EndUpdate;
|
---|
248 | end;
|
---|
249 |
|
---|
250 | procedure TFormMain.RestoreAlphaBitmap(SrcBitmap, DstBitmap: TBitmap;
|
---|
251 | BBC: Boolean);
|
---|
252 | var
|
---|
253 | X, Y: Integer;
|
---|
254 | Size: TPoint;
|
---|
255 | PtrSrc: PPixel32;
|
---|
256 | PtrDest: PPixel32;
|
---|
257 | C: TPixel32;
|
---|
258 | A: Cardinal;
|
---|
259 | Alpha: Byte;
|
---|
260 | const
|
---|
261 | AlphaThreshold = $80;
|
---|
262 | begin
|
---|
263 | Size := Point(SrcBitmap.Width, SrcBitmap.Height);
|
---|
264 | SrcBitmap.BeginUpdate(True);
|
---|
265 | SrcBitmap.PixelFormat := pf32bit;
|
---|
266 | DstBitmap.SetSize(Size.X, Size.Y);
|
---|
267 | DstBitmap.BeginUpdate(True);
|
---|
268 | for Y := 0 to Size.Y - 1 do
|
---|
269 | for X := 0 to Size.X - 1 do begin
|
---|
270 | PtrSrc := SrcBitmap.ScanLine[Y] + X * 4;
|
---|
271 | PtrDest := DstBitmap.ScanLine[Y] + X * 4;
|
---|
272 | C.ARGB := PtrSrc^.ARGB;
|
---|
273 | //C.ARGB := SwapColors(C.ARGB);
|
---|
274 | if BBC then begin
|
---|
275 | PtrDest^.R := C.R;
|
---|
276 | PtrDest^.G := C.G;
|
---|
277 | PtrDest^.B := 0; //C.B;
|
---|
278 | PtrDest^.A := 255 - C.B; // blue channel = transparency
|
---|
279 | end else begin
|
---|
280 | Alpha := C.A;
|
---|
281 | if Alpha < AlphaThreshold then begin
|
---|
282 | PtrDest^.RGB := $7f007f
|
---|
283 | end
|
---|
284 | else begin
|
---|
285 | A := C.ARGB and $ffffff;
|
---|
286 | PtrDest^.RGB := SwapRedBlue(A);
|
---|
287 | end;
|
---|
288 | end;
|
---|
289 | end;
|
---|
290 | SrcBitmap.EndUpdate;
|
---|
291 | DstBitmap.EndUpdate;
|
---|
292 | end;
|
---|
293 |
|
---|
294 | procedure TFormMain.ResizeRect(SrcBitmap, DstBitmap: TBitmap; SrcRect, DstRect: TRect);
|
---|
295 | var
|
---|
296 | X, Y: Integer;
|
---|
297 | SrcPtr: PCardinal;
|
---|
298 | DestPtr: PCardinal;
|
---|
299 | begin
|
---|
300 | SrcBitmap.BeginUpdate(True);
|
---|
301 | DstBitmap.BeginUpdate(True);
|
---|
302 | for Y := 0 to DstRect.Height - 1 do begin
|
---|
303 | for X := 0 to DstRect.Width - 1 do begin
|
---|
304 | SrcPtr := SrcBitmap.ScanLine[SrcRect.Top + Trunc(Y / DstRect.Height * SrcRect.Height)];
|
---|
305 | DestPtr := DstBitmap.ScanLine[DstRect.Top + Y];
|
---|
306 | SrcPtr := SrcPtr + SrcRect.Left + Trunc(X / DstRect.Width * SrcRect.Width);
|
---|
307 | DestPtr := DestPtr + DstRect.Left + X;
|
---|
308 | DestPtr^ := SrcPtr^;
|
---|
309 | //ImageDest.Picture.Bitmap.Canvas.Pixels[XX * (DestSize.X + 1) + 1 + X,
|
---|
310 | // YY * (DestSize.Y + 1) + 1 + Y] :=
|
---|
311 | //ImageSrc.Picture.Bitmap.Canvas.Pixels[XX * (SourceSize.X + 1) + 1 + Trunc(X / DestSize.X * SourceSize.X),
|
---|
312 | // YY * (SourceSize.Y + 1) + 1 + Trunc(Y / DestSize.Y * SourceSize.Y)];
|
---|
313 | end;
|
---|
314 | end;
|
---|
315 | SrcBitmap.EndUpdate;
|
---|
316 | DstBitmap.EndUpdate;
|
---|
317 | end;
|
---|
318 |
|
---|
319 | procedure ExecuteProgram(Executable: string; Parameters: array of string);
|
---|
320 | var
|
---|
321 | Process: TProcess;
|
---|
322 | I: Integer;
|
---|
323 | begin
|
---|
324 | try
|
---|
325 | Process := TProcess.Create(nil);
|
---|
326 | Process.Executable := Executable;
|
---|
327 | for I := 0 to Length(Parameters) - 1 do
|
---|
328 | Process.Parameters.Add(Parameters[I]);
|
---|
329 | Process.Options := [poNoConsole, poWaitOnExit];
|
---|
330 | Process.Execute;
|
---|
331 | finally
|
---|
332 | Process.Free;
|
---|
333 | end;
|
---|
334 | end;
|
---|
335 |
|
---|
336 | procedure TFormMain.ResizeRectXbrz(SrcBitmap, DstBitmap: TBitmap);
|
---|
337 | var
|
---|
338 | Png: TPortableNetworkGraphic;
|
---|
339 | const
|
---|
340 | XbrzScaleExe = 'xbrzscale'; // https://github.com/atheros/xbrzscale
|
---|
341 | begin
|
---|
342 | SrcBitmap.SaveToFile('Input.bmp');
|
---|
343 | ExecuteProgram(XbrzScaleExe, ['3', 'Input.bmp', 'Output.png']);
|
---|
344 | Png := TPortableNetworkGraphic.Create;
|
---|
345 | Png.PixelFormat := pf32bit;
|
---|
346 | Png.LoadFromFile('Output.png');
|
---|
347 | Png.PixelFormat := pf32bit;
|
---|
348 | Png.SaveToFile('Output2.png');
|
---|
349 | DstBitmap.SaveToFile('xxx1.bmp');
|
---|
350 | BitmapStretchRect(DstBitmap, Bounds(0, 0, DstBitmap.Width, DstBitmap.Height),
|
---|
351 | Png, Rect(0, 0, Png.Width, Png.Height));
|
---|
352 | BitmapSwapRedBlue(DstBitmap);
|
---|
353 | DstBitmap.SaveToFile('xxx.bmp');
|
---|
354 | Png.Free;
|
---|
355 | end;
|
---|
356 |
|
---|
357 | procedure TFormMain.ProcessBitmapRect(SrcBitmap, DstBitmap: TBitmap; SrcRect,
|
---|
358 | DstRect: TRect);
|
---|
359 | var
|
---|
360 | Src, Dst: TBitmap;
|
---|
361 | Alpha: TBitmap;
|
---|
362 | Alpha2: TBitmap;
|
---|
363 | begin
|
---|
364 | Src := TBitmap.Create;
|
---|
365 | Src.SetSize(SrcRect.Width, SrcRect.Height);
|
---|
366 | Src.Canvas.CopyRect(Bounds(0, 0, SrcRect.Width, SrcRect.Height), SrcBitmap.Canvas,
|
---|
367 | SrcRect);
|
---|
368 | Dst := TBitmap.Create;
|
---|
369 | Dst.SetSize(DstRect.Width, DstRect.Height);
|
---|
370 | Dst.PixelFormat := Src.PixelFormat;
|
---|
371 | //Dst.Canvas.Brush.Style := bsSolid;
|
---|
372 | //Dst.Canvas.Brush.Color := $757575;
|
---|
373 | //Dst.Canvas.FillRect(0, 0, Dst.Width, Dst.Height);
|
---|
374 | FillRectBitmap(Dst, $ff000000);
|
---|
375 |
|
---|
376 | Alpha := TBitmap.Create;
|
---|
377 | Alpha.PixelFormat := pf32bit;
|
---|
378 | Alpha.SetSize(Src.Width, Src.Height);
|
---|
379 | UseAlphaBitmap(Src, Alpha);
|
---|
380 |
|
---|
381 | Alpha2 := TBitmap.Create;
|
---|
382 | Alpha2.PixelFormat := pf32bit;
|
---|
383 | Alpha2.SetSize(Dst.Width, Dst.Height);
|
---|
384 | FillRectBitmap(Alpha2, $00000000);
|
---|
385 | //Alpha2.Canvas.Brush.Style := bsSolid;
|
---|
386 | //Alpha2.Canvas.Brush.Color := $000000;
|
---|
387 | //Alpha2.Canvas.FillRect(0, 0, 0, 0);
|
---|
388 |
|
---|
389 | ResizeRectXbrz(Alpha, Alpha2);
|
---|
390 |
|
---|
391 | RestoreAlphaBitmap(Alpha2, Dst);
|
---|
392 |
|
---|
393 | Dst.SaveToFile('Dst.bmp');
|
---|
394 | DstBitmap.Canvas.CopyRect(DstRect, Dst.Canvas, Bounds(0, 0, DstRect.Width, DstRect.Height));
|
---|
395 | DstBitmap.SaveToFile('DstBitmap.bmp');
|
---|
396 | Src.Free;
|
---|
397 | Dst.Free;
|
---|
398 | Alpha.Free;
|
---|
399 | Alpha2.Free;
|
---|
400 | end;
|
---|
401 |
|
---|
402 | function FindPosition(Bitmap: TBitmap; x, y, xmax, ymax: Integer; Mark: TColor): TPoint;
|
---|
403 | var
|
---|
404 | xp, yp: Integer;
|
---|
405 | begin
|
---|
406 | xp := 0;
|
---|
407 | while (xp < xmax) and (Bitmap.Canvas.Pixels[x + 1 + xp, y] <> Mark) do
|
---|
408 | Inc(xp);
|
---|
409 | yp := 0;
|
---|
410 | while (yp < ymax) and (Bitmap.Canvas.Pixels[x, y + 1 + yp] <> Mark) do
|
---|
411 | Inc(yp);
|
---|
412 | Result := Point(xp, yp);
|
---|
413 | end;
|
---|
414 |
|
---|
415 | procedure TFormMain.ResizeAuxPos(SrcBitmap, DstBitmap: TBitmap; SrcRect,
|
---|
416 | DstRect: TRect);
|
---|
417 | var
|
---|
418 | P: TPoint;
|
---|
419 | const
|
---|
420 | MarkColor: TColor = $00ffff;
|
---|
421 | begin
|
---|
422 | P := FindPosition(SrcBitmap, SrcRect.Left, SrcRect.Top, SrcRect.Width, SrcRect.Height, MarkColor);
|
---|
423 | P := Point(Round(P.X * DstRect.Width / SrcRect.Width),
|
---|
424 | Round(P.Y * DstRect.Height / SrcRect.Height));
|
---|
425 | DstBitmap.Canvas.Pixels[DstRect.Left + P.X, DstRect.Top] := MarkColor;
|
---|
426 | DstBitmap.Canvas.Pixels[DstRect.Left, DstRect.Top + P.Y] := MarkColor;
|
---|
427 | end;
|
---|
428 |
|
---|
429 | procedure TFormMain.ResizeImage(SourceName: string; SourceSize: TPoint; Count: TPoint;
|
---|
430 | DestName: string; DestSize: TPoint);
|
---|
431 | var
|
---|
432 | ImageSrc: TImage;
|
---|
433 | ImageDest: TImage;
|
---|
434 | X, Y: Integer;
|
---|
435 | begin
|
---|
436 | ImageSrc := TImage.Create(nil);
|
---|
437 | ImageSrc.Picture.LoadFromFile(SourceName);
|
---|
438 | ImageDest := TImage.Create(nil);
|
---|
439 | ImageDest.Picture.Bitmap.Assign(ImageSrc.Picture.Bitmap);
|
---|
440 | ImageDest.Picture.Bitmap.SetSize((DestSize.X + 1) * Count.X + 1,
|
---|
441 | (DestSize.Y + 1) * Count.Y + 1);
|
---|
442 | //ShowMessage(IntToStr(ImageDest.Picture.Bitmap.Width) + ' ' + IntToStr(ImageDest.Width));
|
---|
443 | FillRectBitmap(ImageDest.Picture.Bitmap, $ff757575);
|
---|
444 |
|
---|
445 | ImageSrc.Picture.Bitmap.BeginUpdate(True);
|
---|
446 | //ImageDest.Picture.Bitmap.BeginUpdate(True);
|
---|
447 | //ImageDest.Picture.Bitmap.Canvas.Brush.Style := bsSolid;
|
---|
448 | //ImageDest.Picture.Bitmap.Canvas.Brush.Color := $757575;
|
---|
449 | //ImageDest.Picture.Bitmap.Canvas.FillRect(0, 0, ImageDest.Picture.Bitmap.Width, ImageDest.Picture.Bitmap.Height);
|
---|
450 | for Y := 0 to Count.Y - 1 do
|
---|
451 | for X := 0 to Count.X - 1 do begin
|
---|
452 | ProcessBitmapRect(ImageSrc.Picture.Bitmap, ImageDest.Picture.Bitmap,
|
---|
453 | Bounds(X * (SourceSize.X + 1) + 1, Y * (SourceSize.Y + 1) + 1, SourceSize.X, SourceSize.Y),
|
---|
454 | Bounds(X * (DestSize.X + 1) + 1, Y * (DestSize.Y + 1) + 1, DestSize.X, DestSize.Y));
|
---|
455 | ResizeAuxPos(ImageSrc.Picture.Bitmap, ImageDest.Picture.Bitmap,
|
---|
456 | Bounds(X * (SourceSize.X + 1), Y * (SourceSize.Y + 1), SourceSize.X, SourceSize.Y),
|
---|
457 | Bounds(X * (DestSize.X + 1), Y * (DestSize.Y + 1), DestSize.X, DestSize.Y));
|
---|
458 | end;
|
---|
459 | ImageSrc.Picture.Bitmap.EndUpdate;
|
---|
460 | //ImageDest.Picture.Bitmap.EndUpdate;
|
---|
461 | ImageDest.Picture.SaveToFile(DestName);
|
---|
462 | ImageSrc.Free;
|
---|
463 | ImageDest.Free;
|
---|
464 | end;
|
---|
465 |
|
---|
466 | end.
|
---|
467 |
|
---|