1 unit img_utils;
2 {
3 DESCRIPTION : Unit providing routines related to handling images
4
5 REQUIREMENTS : FPC
6
7 EXTERNAL DATA : ---
8
9 MEMORY USAGE : ---
10
11 DISPLAY MODE : ---
12
13 REFERENCES : ---
14
15 REMARK : ---
16
17 Version Date Author Modification
18 ------- -------- ------- ------------------------------------------
19 0.10 20101030 G.Tani Initial version
20 0.11 20110816 G.Tani Improved getting string with image details
21 0.12 20130215 G.Tani Improced decorations, improved some cases of error handling if images are not correctly loaded
22 0.13 20130602 G.Tani Code cleanup, fixed recognition of uncommon jpeg extensions
23 0.14 20140924 G.Tani Fixes; Added conversion to TIFF, PPM, and XPM formats
24 0.15 20160718 G.Tani Added code to show exe icons (Windows)
25 0.16 20170423 G.Tani Fixed color modification modcolor, can now either make the color darker or lighter
26 Added proportional color modification modpropcolor
27 Added color darkness evaluation function evalcolor
28 0.17 20181206 G.Tani Can now convert images to ico format
29 0.18 20190821 G.Tani New resize_bitmap function
30 0.19 20191125 G.Tani Improved and extended functions related to load and resize transparent bitmaps
31
32 (C) Copyright 2010 Giorgio Tani giorgio.tani.software@gmail.com
33 The program is released under GNU LGPL http://www.gnu.org/licenses/lgpl.txt
34
35 This library is free software; you can redistribute it and/or
36 modify it under the terms of the GNU Lesser General Public
37 License as published by the Free Software Foundation; either
38 version 3 of the License, or (at your option) any later version.
39
40 This library is distributed in the hope that it will be useful,
41 but WITHOUT ANY WARRANTY; without even the implied warranty of
42 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
43 Lesser General Public License for more details.
44
45 You should have received a copy of the GNU Lesser General Public
46 License along with this library; if not, write to the Free Software
47 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
48 }
49
50 {$mode objfpc}{$H+}
51 {$INLINE ON}
52
53 interface
54
55 uses {$IFDEF MSWINDOWS}Windows,{$ENDIF} Classes, SysUtils, Forms, ExtCtrls, Graphics {$IFDEF MSWINDOWS}, Shellapi, Activex{$ENDIF};
56
57 type
rListnull58 TFoundList = array of ansistring; //dynamic array of ansistring, each time a new file is found new space is allocated (function rList)
59 TFoundListBool = array of boolean;
60 TFoundListAges = array of dword;
61 TFoundListAttrib = array of dword;
62 TFoundListSizes = array of qword;
63 TFoundListArray64 = array of array [0..63] of byte;
64 TFileOfByte = File of Byte;
65
66 procedure setsize_bitmap(var abitmap:tbitmap; isize, deco:integer);
67 procedure loadlargeicon(srcbitmap:TBitmap; var destbitmap:Tbitmap; destsize:integer);
load_bitmapnull68 function load_bitmap(var abitmap:Tbitmap; s:ansistring; isize, deco:integer; var imginfo:ansistring):integer;
load_imagefiletopicturenull69 function load_imagefiletopicture(var apicture:Tpicture; s:ansistring):integer;
rotate_picturenull70 function rotate_picture(var apicture:Tpicture; rfun:ansistring): integer;
resize_picturenull71 function resize_picture(var apicture:Tpicture; wsize,hsize:integer): integer;
resize_bitmapnull72 function resize_bitmap(var abitmap:Tbitmap; wsize,hsize:integer): integer;
73 procedure get_pformscaling(var refsize, qscale,qscaleimages:integer);
setpbitmapnull74 function setpbitmap(var abitmap:TBitmap; virtualsize:integer):integer;
resize_bitmap_tobitmapnull75 function resize_bitmap_tobitmap(var srcbitmap,destbitmap:Tbitmap; wsize,hsize:integer): integer;
setpbitmap_tobitmapnull76 function setpbitmap_tobitmap(var srcbitmap,destbitmap:TBitmap; virtualsize:integer):integer;
getthemedbitmapnull77 function getthemedbitmap(var abitmap:TBitmap; imgname:ansistring):integer;
crop_picturenull78 function crop_picture(var apicture:Tpicture; ctop,cbottom,cleft,cright:integer): integer;
save_picturetoimagefilenull79 function save_picturetoimagefile(var apicture:Tpicture; s:ansistring):integer;
saveconvert_picturetoimagefilenull80 function saveconvert_picturetoimagefile(var apicture:Tpicture; s,convext:ansistring; convopt:integer):integer;
createnull81 //GUI theming function: create a darker shade of specified color
82 function modcolor(col:TColor; dr,dg,db:Single):TColor; //change each channel multiplying it to an independent modification parameter, until saturation of the channel (255)
modpropcolornull83 function modpropcolor(col:TColor; prop:integer):TColor; //change all channels of a color porportionally, creating lighter or darker shades of same color
evalcolornull84 function evalcolor(col:TColor):byte;//evaluate darkness of a color combining rgb channels 0 darkest 255 lightest
85
86 const
87 DECO_NONE = 0; //no decoration, use all available space for rendering the image
88 DECO_SHADOW = 1; //light frame around the image, plus shadow
89 DECO_FRAME = 2; //light frame 6px away from the image
90 DECO_BORDER = 3; //light frame around the full icon
91 DECO_SPACE = 4; //6 px empty border
92
93 var
94 relwindowcolor: TColor;
95
96 implementation
97
98 procedure autoscale_image(aform:Tform; var aimage:Timage; var ascale,iscale:double);
99 var
100 iwidth,iheight : Integer;
101 rect : TRect;
102 begin
103 with aform do
104 begin
105 iwidth:=aimage.Picture.Bitmap.Width;
106 iheight:=aimage.Picture.Bitmap.Height;
107 iscale:=iscale*ascale;
108 rect:=aimage.BoundsRect;
109 rect.Right:=rect.Left+Round(iwidth*iscale);
110 rect.Bottom:=rect.Top+Round(iheight*iscale);
111 aimage.BoundsRect:=rect;
112 aimage.Stretch:=True;
113 aimage.left:=(aform.width-aimage.width)div 2;
114 aimage.top:=(aform.height-aimage.height)div 2;
115 end;
116 end;
117
118 procedure autosize_image(aform:tform; var aimage:timage; var iscale:double);
119 var
120 wscale,hscale,ascale:double;
121 begin
122 with aform do
123 begin
124 iscale:=1.0;
125 if aimage.Picture.Bitmap.Width<>0 then wscale:=aform.Width / aimage.Picture.Bitmap.Width else wscale:=100;
126 if aimage.Picture.Bitmap.Height<>0 then hscale:=aform.Height / aimage.Picture.Bitmap.Height else hscale:=100;
127 if wscale<hscale then ascale:=wscale
128 else ascale:=hscale;
129 autoscale_image(aform, aimage, ascale, iscale);
130 end;
131 end;
132
load_image_autonull133 function load_image_auto(aform:Tform; var aimage:Timage; s:ansistring; var iscale:double):integer;
134 begin
135 load_image_auto:=-1;
136 Try
137 //iscale:=1.0;
138 aimage.Picture.LoadFromFile(s);
139 aform.Caption:=s;
140 //image_loaded:=1;
141 autosize_image(aform, aimage, iscale);
142 load_image_auto:=0;
143 Except
144 load_image_auto:=1;
145 end
146 end;
147
148 procedure scale_bitmap(var abitmap:tbitmap; isize, deco:integer; var ascale:double);
149 //scale image (keeping in account border size), place the bitmap centered in a square of given size
150 var
151 iwidth,iheight : Integer;
152 rect : TRect;
153 bbitmap:tbitmap;
154 begin
155 bbitmap:=tbitmap.Create;
156 bbitmap.width:=isize;
157 bbitmap.height:=isize;
158 bbitmap.Transparent:=false;
159 bbitmap.canvas.Brush.Color:=relwindowcolor;
160 if deco=DECO_BORDER then bbitmap.canvas.Pen.Color:=clbtnface
161 else bbitmap.canvas.Pen.Color:=relwindowcolor;
162 bbitmap.canvas.Rectangle(0,0,isize,isize);
163
164 iwidth:=abitmap.Width;
165 iheight:=abitmap.Height;
166 rect.Left := (isize-round(iwidth*ascale)) div 2;
167 rect.Top := (isize-round(iheight*ascale)) div 2;
168 rect.Right:=rect.Left+Round(iwidth*ascale);
169 rect.Bottom:=rect.Top+Round(iheight*ascale);
170
171 if deco=DECO_SHADOW then
172 begin
173 bbitmap.canvas.Brush.Color:=clnone;
174 bbitmap.canvas.Pen.Color:=clbtnface;
175 bbitmap.canvas.Rectangle(rect.Left-1,rect.Top-1,rect.Right+1,rect.Bottom+1);
176 bbitmap.canvas.Brush.Color:=$00c0c0c0;
177 bbitmap.canvas.Pen.Color:=$00e0e0e0;
178 bbitmap.canvas.Rectangle(rect.Left+1,rect.Top+1,rect.Right+2,rect.Bottom+2);
179 end;
180
181 if deco=DECO_FRAME then
182 begin
183 bbitmap.canvas.Brush.Color:=clnone;
184 bbitmap.canvas.Pen.Color:=clbtnface;
185 bbitmap.canvas.Rectangle(rect.Left-6,rect.Top-6,rect.Right+6,rect.Bottom+6);
186 end;
187
188 bbitmap.Canvas.StretchDraw(rect, abitmap);
189
190 abitmap.Assign(bbitmap);
191 bbitmap.free;
192 end;
193
194 procedure setsize_bitmap(var abitmap:tbitmap; isize, deco:integer);
195 var
196 wscale,hscale,ascale:double;
197 csize:integer;
198 begin
199 case deco of
200 DECO_FRAME: csize:=isize-12;
201 DECO_BORDER: csize:=isize-12;
202 DECO_SHADOW: csize:=isize-4;
203 else csize:=isize; //let room for borders
204 end;
205 if abitmap.Width<>0 then wscale:=csize / abitmap.Width else wscale:=100;
206 if abitmap.Height<>0 then hscale:=csize / abitmap.Height else hscale:=100;
207 if wscale<hscale then ascale:=wscale
208 else ascale:=hscale;
209 if ascale>1 then ascale:=1;
210 scale_bitmap(abitmap, isize, deco, ascale)
211 end;
212
213 procedure getimageinfo(aimage:TImage; var imginfo:ansistring);
214 begin
215 try imginfo:=inttostr(aimage.Picture.Bitmap.Width)+'*'+inttostr(aimage.Picture.Bitmap.height)+'@';
216 except imginfo:=''; end;
217 case aimage.Picture.Bitmap.PixelFormat of
218 pfDevice: imginfo:=imginfo+'Device';
219 pf1bit: imginfo:=imginfo+'1';
220 pf4bit: imginfo:=imginfo+'4';
221 pf8bit: imginfo:=imginfo+'8';
222 pf15bit: imginfo:=imginfo+'15';
223 pf16bit: imginfo:=imginfo+'16';
224 pf24bit: imginfo:=imginfo+'24';
225 pf32bit: imginfo:=imginfo+'32';
226 pfCustom: imginfo:=imginfo+'Custom';
227 end;
228 end;
229
230 procedure loadlargeicon(srcbitmap:TBitmap; var destbitmap:Tbitmap; destsize:integer);
231 begin
232 destbitmap.Assign(srcbitmap);
233 setsize_bitmap(destbitmap,destsize,DECO_NONE);
234 destbitmap.TransparentColor:=$00FFFFFF;
235 destbitmap.Transparent:=true;
236 end;
237
load_bitmapnull238 function load_bitmap(var abitmap:Tbitmap; s:ansistring; isize, deco:integer; var imginfo:ansistring):integer;
239 var
240 aimage:TImage;
241 begin
242 load_bitmap:=-1;
243 Try
244 aimage:=TImage.Create(nil);
245 aimage.Parent:=nil;
246 aimage.Picture.LoadFromFile(s);
247 getimageinfo(aimage, imginfo);
248 abitmap.assign(aimage.Picture.Bitmap);
249 setsize_bitmap(abitmap, isize, deco);
250 aimage.free;
251 load_bitmap:=0;
252 Except
253 load_bitmap:=1;
254 end
255 end;
256
load_imagefiletopicturenull257 function load_imagefiletopicture(var apicture:Tpicture; s:ansistring):integer;
258 begin
259 load_imagefiletopicture:=-1;
260 Try
261 apicture:=Tpicture.Create;
262 apicture.LoadFromFile(s);
263 load_imagefiletopicture:=0;
264 Except
265 load_imagefiletopicture:=1;
266 end
267 end;
268
rotate_picturenull269 function rotate_picture(var apicture:Tpicture; rfun:ansistring): integer;
270 var
271 x,y: Integer;
272 rlh,rlw: Integer;
273 bpicture:Tpicture;
274 begin
275 result:=-1;
276 rlw:=apicture.Width;
277 rlh:=apicture.Height;
278 bpicture:=Tpicture.Create;
279
280 case rfun of
281 'right':
282 with bpicture do
283 begin
284 bitmap.Width:=rlh;
285 bitmap.Height:=rlw;
286 for x:=0 to rlw-1 do
287 for y:=0 to rlh-1 do
288 bitmap.Canvas.Pixels[rlh-y-1,x]:=apicture.bitmap.Canvas.Pixels[x,y];
289 end;
290
291 'left':
292 with bpicture do
293 begin
294 bitmap.Width:=rlh;
295 bitmap.Height:=rlw;
296 for x:=0 to rlw-1 do
297 for y:=0 to rlh-1 do
298 bitmap.Canvas.Pixels[y,rlw-x-1]:=apicture.bitmap.Canvas.Pixels[x,y];
299 end;
300
301 '180':
302 with bpicture do
303 begin
304 bitmap.Width:=rlw;
305 bitmap.Height:=rlh;
306 for x:=0 to rlw-1 do
307 for y:=0 to rlh-1 do
308 bitmap.Canvas.Pixels[rlw-x-1,rlh-y-1]:=apicture.bitmap.Canvas.Pixels[x,y];
309 end;
310
311 'flip':
312 with bpicture do
313 begin
314 bitmap.Width:=rlw;
315 bitmap.Height:=rlh;
316 for x:=0 to rlw-1 do
317 for y:=0 to rlh-1 do
318 bitmap.Canvas.Pixels[x,rlh-y-1]:=apicture.bitmap.Canvas.Pixels[x,y];
319 end;
320
321 'mirror':
322 with bpicture do
323 begin
324 bitmap.Width:=rlw;
325 bitmap.Height:=rlh;
326 for x:=0 to rlw-1 do
327 for y:=0 to rlh-1 do
328 bitmap.Canvas.Pixels[rlw-x-1,y]:=apicture.bitmap.Canvas.Pixels[x,y];
329 end;
330 end;
331 apicture.assign(bpicture);
332 bpicture.Free;
333 result:=1;
334 end;
335
resize_picturenull336 function resize_picture(var apicture:Tpicture; wsize,hsize:integer): integer;
337 var
338 rect : TRect;
339 bpicture:Tpicture;
340 begin
341 result:=-1;
342 bpicture:=tpicture.Create;
343 bpicture.bitmap.width:=wsize;
344 bpicture.bitmap.height:=hsize;
345 rect.Left := 0;
346 rect.Top := 0;
347 rect.Right:=wsize;
348 rect.Bottom:=hsize;
349 bpicture.bitmap.Canvas.StretchDraw(rect, apicture.bitmap);
350 apicture.assign(bpicture);
351 bpicture.Free;
352 result:=1;
353 end;
354
resize_bitmapnull355 function resize_bitmap(var abitmap:Tbitmap; wsize,hsize:integer): integer; //resize transparent bitmap, works with 32bit bitmaps
356 var
357 rect : TRect;
358 bbitmap:tbitmap;
359 begin
360 result:=-1;
361 bbitmap:=tbitmap.Create;
362 {$IFDEF MSWINDOWS}
363 bbitmap.PixelFormat:=abitmap.PixelFormat;
364 {$ELSE}
365 {$IFNDEF LCLGTK2}
366 bbitmap.PixelFormat:=abitmap.PixelFormat;
367 {$ENDIF}
368 {$ENDIF}
369 bbitmap.width:=wsize;
370 bbitmap.height:=hsize;
371 {$IFDEF MSWINDOWS}
372 bbitmap.Transparent:=true;
373 bbitmap.canvas.Brush.Color:=relwindowcolor;
374 bbitmap.canvas.Pen.Color:=clnone;
375 bbitmap.canvas.Rectangle(0,0,wsize,hsize);
376 {$ELSE}
377 {$IFDEF LCLGTK2}
378 bbitmap.Transparent:=true;
379 bbitmap.canvas.Brush.Color:=relwindowcolor;
380 bbitmap.canvas.Pen.Color:=clnone;
381 bbitmap.canvas.Rectangle(0,0,wsize,hsize);
382 {$ENDIF}
383 {$ENDIF}
384 rect.Left := 0;
385 rect.Top := 0;
386 rect.Right:=wsize;
387 rect.Bottom:=hsize;
388 bbitmap.Canvas.StretchDraw(rect, abitmap);
389 abitmap.Assign(bbitmap);
390 bbitmap.free;
391 result:=0;
392 end;
393
394 procedure get_pformscaling(var refsize, qscale, qscaleimages:integer);
395 begin
396 if refsize<3 then refsize:=25;
397 qscale:=(100000*refsize) div 25000;
398 if qscale<110 then qscale:=100 //small icons = 16px
399 else
400 if qscale<135 then qscale:=125 //20
401 else
402 if qscale<165 then qscale:=150 //24
403 else
404 if qscale<220 then qscale:=200 //32
405 else
406 if qscale<270 then qscale:=250 //40
407 else
408 if qscale<330 then qscale:=300 //48
409 else
410 if qscale<440 then qscale:=400 //64
411 else
412 if qscale<550 then qscale:=500 //80
413 else
414 if qscale<660 then qscale:=600 //96
415 else
416 if qscale<880 then qscale:=800 //128
417 else qscale:=1000; //160
418 qscaleimages:=qscale;
419 case qscaleimages of //avoid some multiples that usually does not scale well, falling back to nearest smaller scaling factor
420 125: qscaleimages:=100;
421 250: qscaleimages:=200;
422 end;
423 end;
424
setpbitmapnull425 function setpbitmap(var abitmap:TBitmap; virtualsize:integer):integer;//wrapper for resize_bitmap for square icons
426 begin
427 result:=resize_bitmap(abitmap, virtualsize, virtualsize);
428 end;
429
resize_bitmap_tobitmapnull430 function resize_bitmap_tobitmap(var srcbitmap,destbitmap:Tbitmap; wsize,hsize:integer): integer; //copy transparent srcbitmap to destbitmap of new size, works with 32bit bitmaps
431 var
432 rect : TRect;
433 begin
434 result:=-1;
435 destbitmap.Clear;
436 destbitmap.PixelFormat:=srcbitmap.PixelFormat;
437 destbitmap.width:=wsize;
438 destbitmap.height:=hsize;
439 destbitmap.Transparent:=true;
440 rect.Left:=0;
441 rect.Top:=0;
442 rect.Right:=wsize;
443 rect.Bottom:=hsize;
444 destbitmap.Canvas.StretchDraw(rect, srcbitmap);
445 result:=1;
446 end;
447
setpbitmap_tobitmapnull448 function setpbitmap_tobitmap(var srcbitmap,destbitmap:TBitmap; virtualsize:integer):integer;//wrapper for resize_bitmap for square icons
449 begin
450 result:=resize_bitmap_tobitmap(srcbitmap, destbitmap, virtualsize, virtualsize);
451 end;
452
getthemedbitmapnull453 function getthemedbitmap(var abitmap:TBitmap; imgname:ansistring):integer;
454 var
455 aimage:TImage;
456 begin
457 result:=-1;
458 aimage:=TImage.Create(nil); ;
459 aimage.Picture.LoadFromFile(imgname);
460 abitmap.Assign(aimage.Picture.Bitmap);
461 aimage.Free;
462 result:=1;
463 end;
464
crop_picturenull465 function crop_picture(var apicture:Tpicture; ctop,cbottom,cleft,cright:integer): integer;
466 var
467 x,y: Integer;
468 rlh,rlw: Integer;
469 bpicture:Tpicture;
470 begin
471 result:=-1;
472 rlw:=apicture.bitmap.Width;
473 rlh:=apicture.bitmap.Height;
474 bpicture:= Tpicture.Create;
475 with bpicture do
476 begin
477 bitmap.Width:=rlw-cleft-cright;
478 bitmap.Height:=rlh-ctop-cbottom;
479 for x:=0 to rlw-cleft-cright-1 do
480 for y:=0 to rlh-ctop-cbottom-1 do
481 bitmap.Canvas.Pixels[x,y]:=apicture.bitmap.Canvas.Pixels[x+cleft,y+ctop];
482 end;
483 apicture.assign(bpicture);
484 bpicture.Free;
485 result:=1;
486 end;
487
save_picturetoimagefilenull488 function save_picturetoimagefile(var apicture:Tpicture; s:ansistring):integer;
489 begin
490 try
491 save_picturetoimagefile:=-1;
492 apicture.SaveToFile(s);
493 apicture.Free;
494 save_picturetoimagefile:=0;
495 except
496 save_picturetoimagefile:=1;
497 try apicture.Free; except end;
498 end;
499 end;
500
saveconvert_picturetoimagefilenull501 function saveconvert_picturetoimagefile(var apicture:Tpicture; s,convext:ansistring; convopt:integer):integer;
502 var
503 ajpeg:TJpegImage;
504 atiff:TTiffImage;
505 apng:TPortableNetworkGraphic;
506 aico:TIcon;
507 appm:TPortableAnyMapGraphic;
508 axpm:TPixmap;
509 begin
510 try
511 saveconvert_picturetoimagefile:=-1;
512 convext:=LowerCase(convext);
513 case convext of
514 '.jpg', '.jpeg', '.jpe', '.jif', '.jfif', '.jfi', 'jpeg', 'jpg':
515 begin
516 ajpeg:=TJPEGImage.Create;
517 ajpeg.CompressionQuality:=convopt;
518 ajpeg.Assign(apicture.Bitmap);
519 ajpeg.SaveToFile(s+'.'+convext);
520 ajpeg.free;
521 end;
522 'tiff':
523 begin
524 atiff:=TTiffImage.Create;
525 atiff.Assign(apicture.Bitmap);
526 atiff.SaveToFile(s+'.'+convext);
527 atiff.free;
528 end;
529 'png':
530 begin
531 apng:=TPortableNetworkGraphic.Create;
532 apng.Assign(apicture.Bitmap);
533 apng.SaveToFile(s+'.'+convext);
534 apng.free;
535 end;
536 'ico':
537 begin
538 aico:=TIcon.Create;
539 aico.Assign(apicture.Bitmap);
540 aico.SaveToFile(s+'.'+convext);
541 aico.free;
542 end;
543 'ppm':
544 begin
545 appm:=TPortableAnyMapGraphic.Create;
546 appm.Assign(apicture.Bitmap);
547 appm.SaveToFile(s+'.'+convext);
548 appm.free;
549 end;
550 'xpm':
551 begin
552 axpm:=TPixmap.Create;
553 axpm.Assign(apicture.Bitmap);
554 axpm.SaveToFile(s+'.'+convext);
555 axpm.free;
556 end;
557 else apicture.SaveToFile(s+'.'+convext);
558 end;
559 apicture.Free;
560 saveconvert_picturetoimagefile:=0;
561 except
562 saveconvert_picturetoimagefile:=1;
563 try apicture.Free; except end;
564 end;
565 end;
566
modcolornull567 function modcolor(col:TColor; dr,dg,db:Single):TColor;
568 var
569 r, g, b: Byte;
570 rr,gg,bb:integer;
571 begin
572 col := ColorToRGB(col);
573 r := BYTE(col);
574 g := BYTE((WORD(col)) shr 8);
575 b := BYTE(col shr 16);
576 rr := trunc( r * dr); if rr>255 then rr:=255;
577 gg := trunc( g * dg); if gg>255 then gg:=255;
578 bb := trunc( b * db); if bb>255 then bb:=255;
579 r:=rr;
580 g:=gg;
581 b:=bb;
582 result := DWORD(((DWORD(BYTE(r))) or ((DWORD(WORD(g))) shl 8)) or ((DWORD(BYTE(b))) shl 16));
583 end;
584
modpropcolornull585 function modpropcolor(col:TColor; prop:integer):TColor;
586 var
587 r, g, b: Byte;
588 rr,gg,bb:integer;
589 begin
590 col := ColorToRGB(col);
591 r := BYTE(col);
592 g := BYTE((WORD(col)) shr 8);
593 b := BYTE(col shr 16);
594 if prop<-255 then prop:=-255;
595 if prop>255 then prop:=255;
596 if prop>=0 then
597 begin
598 rr := (255-r) * prop div 255;
599 gg := (255-g) * prop div 255;
600 bb := (255-b) * prop div 255;
601 end
602 else
603 begin
604 rr := (r) * prop div 255;
605 gg := (g) * prop div 255;
606 bb := (b) * prop div 255;
607 end;
608 r:=r+rr;
609 g:=g+gg;
610 b:=b+bb;
611 result := DWORD(((DWORD(BYTE(r))) or ((DWORD(WORD(g))) shl 8)) or ((DWORD(BYTE(b))) shl 16));
612 end;
613
evalcolornull614 function evalcolor(col:TColor):byte;
615 var
616 r, g, b: Byte;
617 cbtot: integer;
618 begin
619 col := ColorToRGB(col);
620 r := BYTE(col);
621 g := BYTE((WORD(col)) shr 8);
622 b := BYTE(col shr 16);
623 cbtot:=(r+g+b) div 3;
624 result := cbtot;
625 end;
626
627 end.
628
629