e22ef52d859270c82650ddd18d441facafeefe05
1 {
2 $Id: ImagingUtility.pas 175 2009-10-06 11:55:15Z galfar $
3 Vampyre Imaging Library
4 by Marek Mauder
5 http://imaginglib.sourceforge.net
7 The contents of this file are used with permission, subject to the Mozilla
8 Public License Version 1.1 (the "License"); you may not use this file except
9 in compliance with the License. You may obtain a copy of the License at
10 http://www.mozilla.org/MPL/MPL-1.1.html
12 Software distributed under the License is distributed on an "AS IS" basis,
13 WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
14 the specific language governing rights and limitations under the License.
16 Alternatively, the contents of this file may be used under the terms of the
17 GNU Lesser General Public License (the "LGPL License"), in which case the
18 provisions of the LGPL License are applicable instead of those above.
19 If you wish to allow use of your version of this file only under the terms
20 of the LGPL License and not to allow others to use your version of this file
21 under the MPL, indicate your decision by deleting the provisions above and
22 replace them with the notice and other provisions required by the LGPL
23 License. If you do not delete the provisions above, a recipient may use
24 your version of this file under either the MPL or the LGPL License.
26 For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html
27 }
29 { This unit contains utility functions and types for Imaging library.}
32 {$I ImagingOptions.inc}
34 interface
36 uses
39 const
43 type
76 { Array variants - Index 0 means lowest significant byte (word, ...).}
88 { Array variants - Index 0 means lowest significant byte (word, ...).}
108 { Options for BuildFileList function:
109 flFullNames - file names in result will have full path names
110 (ExtractFileDir(Path) + FileName)
111 flRelNames - file names in result will have names relative to
112 ExtractFileDir(Path) dir
113 flRecursive - adds files in subdirectories found in Path.}
118 { Frees class instance and sets its reference to nil.}
120 { Frees pointer and sets it to nil.}
122 { Replacement of standard System.FreeMem procedure which checks if P is nil
123 (this is only needed for Free Pascal, Delphi makes checks in its FreeMem).}
125 { Returns current exception object. Do not call outside exception handler.}
127 { Returns time value with microsecond resolution.}
129 { Returns time value with milisecond resolution.}
132 { Returns file extension (without "." dot)}
134 { Returns file name of application's executable.}
136 { Returns directory where application's exceutable is located without
137 path delimiter at the end.}
139 { Returns True if FileName matches given Mask with optional case sensitivity.
140 Mask can contain ? and * special characters: ? matches
141 one character, * matches zero or more characters.}
142 function MatchFileNameMask(const FileName, Mask: string; CaseSensitive: Boolean = False): Boolean;
143 { This function fills Files string list with names of files found
144 with FindFirst/FindNext functions (See details on Path/Atrr here).
145 - BuildFileList('c:\*.*', faAnyFile, List, [flRecursive]) returns
146 list of all files (only name.ext - no path) on C drive
147 - BuildFileList('d:\*.*', faDirectory, List, [flFullNames]) returns
148 list of all directories (d:\dirxxx) in root of D drive.}
151 { Similar to RTL's Pos function but with optional Offset where search will start.
152 This function is in the RTL StrUtils unit but }
154 { Same as PosEx but without case sensitivity.}
155 function PosNoCase(const SubStr, S: string; Offset: LongInt = 1): LongInt; {$IFDEF USE_INLINE}inline;{$ENDIF}
156 { Returns a sub-string from S which is followed by
157 Sep separator and deletes the sub-string from S including the separator.}
159 { Same as StrToken but searches from the end of S string.}
161 { Fills instance of TStrings with tokens from string S where tokens are separated by
162 one of Seps characters.}
164 { Returns string representation of integer number (with digit grouping).}
166 { Returns string representation of float number (with digit grouping).}
167 function FloatToStrFmt(const F: Double; Precision: Integer = 2): string; {$IFDEF USE_INLINE}inline;{$ENDIF}
169 { Clamps integer value to range <Min, Max>}
170 function ClampInt(Number: LongInt; Min, Max: LongInt): LongInt; {$IFDEF USE_INLINE}inline;{$ENDIF}
171 { Clamps float value to range <Min, Max>}
172 function ClampFloat(Number: Single; Min, Max: Single): Single; {$IFDEF USE_INLINE}inline;{$ENDIF}
173 { Clamps integer value to Byte boundaries.}
175 { Clamps integer value to Word boundaries.}
177 { Returns True if Num is power of 2.}
179 { Returns next power of 2 greater than or equal to Num
180 (if Num itself is power of 2 then it retuns Num).}
182 { Raises 2 to the given integer power (in range [0, 30]).}
184 { Raises Base to any power.}
186 { Returns log base 2 of integer X (max 2^30) or -1 if X is not power of 2.}
188 { Returns log base 2 of X.}
190 { Returns largest integer <= Val (for 5.9 returns 5).}
192 { Returns smallest integer >= Val (for 5.1 returns 6).}
194 { Returns lesser of two integer numbers.}
196 { Returns lesser of two float numbers.}
198 { Returns greater of two integer numbers.}
200 { Returns greater of two float numbers.}
202 { Returns result from multiplying Number by Numerator and then dividing by Denominator.
203 Denominator must be greater than 0.}
206 { Switches Boolean value.}
208 { If Condition is True then TruePart is retured, otherwise
209 FalsePart is returned.}
210 function Iff(Condition: Boolean; TruePart, FalsePart: LongInt): LongInt; overload; {$IFDEF USE_INLINE}inline;{$ENDIF}
211 { If Condition is True then TruePart is retured, otherwise
212 FalsePart is returned.}
213 function IffUnsigned(Condition: Boolean; TruePart, FalsePart: LongWord): LongWord; overload; {$IFDEF USE_INLINE}inline;{$ENDIF}
214 { If Condition is True then TruePart is retured, otherwise
215 FalsePart is returned.}
216 function Iff(Condition, TruePart, FalsePart: Boolean): Boolean; overload; {$IFDEF USE_INLINE}inline;{$ENDIF}
217 { If Condition is True then TruePart is retured, otherwise
218 FalsePart is returned.}
219 function Iff(Condition: Boolean; const TruePart, FalsePart: string): string; overload; {$IFDEF USE_INLINE}inline;{$ENDIF}
220 { If Condition is True then TruePart is retured, otherwise
221 FalsePart is returned.}
222 function Iff(Condition: Boolean; TruePart, FalsePart: Char): Char; overload; {$IFDEF USE_INLINE}inline;{$ENDIF}
223 { If Condition is True then TruePart is retured, otherwise
224 FalsePart is returned.}
225 function Iff(Condition: Boolean; TruePart, FalsePart: Pointer): Pointer; overload; {$IFDEF USE_INLINE}inline;{$ENDIF}
226 { If Condition is True then TruePart is retured, otherwise
227 FalsePart is returned.}
228 function Iff(Condition: Boolean; const TruePart, FalsePart: Int64): Int64; overload; {$IFDEF USE_INLINE}inline;{$ENDIF}
229 { If Condition is True then TruePart is retured, otherwise
230 FalsePart is returned.}
231 function IffFloat(Condition: Boolean; TruePart, FalsePart: Single): Single; {$IFDEF USE_INLINE}inline;{$ENDIF}
232 { Swaps two Byte values}
234 { Swaps two Word values}
236 { Swaps two LongInt values}
238 { Swaps two Single values}
240 { Swaps two LongInt values if necessary to ensure that Min <= Max.}
242 { This function returns True if running on little endian machine.}
244 { Swaps byte order of Word value.}
246 { Swaps byte order of multiple Word values.}
248 { Swaps byte order of LongWord value.}
249 function SwapEndianLongWord(Value: LongWord): LongWord; overload; {$IFDEF USE_INLINE}inline;{$ENDIF}
250 { Swaps byte order of multiple LongWord values.}
253 { Calculates CRC32 for the given data.}
255 { Fills given memory with given Byte value. Size is size of buffer in bytes.}
257 { Fills given memory with given Word value. Size is size of buffer in bytes.}
259 { Fills given memory with given LongWord value. Size is size of buffer in bytes.}
262 { Returns how many mipmap levels can be created for image of given size.}
264 { Returns total number of levels of volume texture with given depth and
265 mipmap count (this is not depth * mipmaps!).}
267 { Returns rectangle (X, Y, X + Width, Y + Height).}
268 function BoundsToRect(X, Y, Width, Height: LongInt): TRect; overload; {$IFDEF USE_INLINE}inline;{$ENDIF}
269 { Returns rectangle (R.Left, R.Top, R.Left + R.Right, R.Top + R.Bottom).}
271 { Returns rectangle (R.Left, R.Top, R.Right - R.Left, R.Bottom - R.Top).}
273 { Clips given bounds to Clip rectangle.}
275 { Clips given source bounds and dest position. It is used by various CopyRect
276 functions that copy rect from one image to another. It handles clipping the same way
277 as Win32 BitBlt function. }
280 { Clips given source bounds and dest bounds. It is used by various StretchRect
281 functions that stretch rectangle of pixels from one image to another.
282 It handles clipping the same way as Win32 StretchBlt function. }
285 { Scales one rectangle to fit into another. Proportions are preserved so
286 it could be used for 'Stretch To Fit Window' image drawing for instance.}
288 { Returns True if R1 fits into R2.}
290 { Returns True if R1 and R2 intersects.}
293 { Formats given message for usage in Exception.Create(..). Use only
294 in except block - returned message contains message of last raised exception.}
296 { Outputs debug message - shows message dialog in Windows and writes to console
297 in Linux/Unix.}
300 implementation
302 uses
303 {$IFDEF MSWINDOWS}
304 Windows;
305 {$ENDIF}
306 {$IFDEF UNIX}
307 {$IFDEF KYLIX}
308 Libc;
309 {$ELSE}
311 {$ENDIF}
312 {$ENDIF}
315 var
317 begin
324 begin
330 begin
336 begin
340 {$IFDEF MSWINDOWS}
341 var
346 var
348 begin
352 {$ENDIF}
354 {$IFDEF UNIX}
356 var
358 begin
359 {$IFDEF KYLIX}
361 {$ELSE}
363 {$ENDIF}
366 {$ENDIF}
368 {$IFDEF MSDOS}
370 asm
372 CLI
383 STI
400 end;
401 {$ENDIF}
404 begin
409 begin
416 {$IFDEF MSWINDOWS}
417 var
419 begin
422 {$ENDIF}
423 {$IFDEF UNIX}
424 {$IFDEF KYLIX}
425 var
427 begin
430 {$ELSE}
431 begin
433 {$ENDIF}
434 {$ENDIF}
435 {$IFDEF MSDOS}
436 begin
438 {$ENDIF}
442 begin
447 var
451 begin
454 else
459 begin
461 begin
464 begin
469 begin
473 begin
475 Exit;
477 repeat
479 begin
481 Exit;
486 Exit;
488 else
490 begin
492 Exit;
493 end
494 else
495 begin
505 begin
507 Exit;
513 begin
517 begin
519 Exit;
526 var
535 var
538 begin
542 begin
543 // Searching for subfolders
545 try
547 begin
553 finally
562 var
566 begin
571 try
573 begin
575 begin
578 else
583 finally
588 begin
594 {$IFDEF DCC}
595 {$WARN SYMBOL_PLATFORM OFF}
596 {$ENDIF}
599 else
601 {$IFDEF DCC}
602 {$WARN SYMBOL_PLATFORM ON}
603 {$ENDIF}
604 // Here's the recursive search for nested folders
606 BuildFolderList;
610 else
617 var
620 begin
625 begin
627 begin
632 begin
634 Exit;
643 begin
648 var
650 begin
653 begin
656 end
657 else
658 begin
665 var
667 begin
671 begin
676 begin
679 end
680 else
681 begin
688 var
690 begin
694 begin
701 begin
706 begin
711 begin
714 Result := Min
720 begin
723 Result := Min
729 begin
738 begin
747 begin
752 begin
759 begin
764 begin
769 else
774 begin
807 else
813 const
815 begin
820 begin
827 begin
834 begin
839 begin
841 Result := TruePart
842 else
847 begin
849 Result := TruePart
850 else
855 begin
857 Result := TruePart
858 else
863 begin
865 Result := TruePart
866 else
871 begin
873 Result := TruePart
874 else
879 begin
881 Result := TruePart
882 else
887 begin
889 Result := TruePart
890 else
895 begin
897 Result := TruePart
898 else
903 var
905 begin
912 var
914 begin
921 var
923 begin
930 var
932 begin
939 var
941 begin
943 begin
951 begin
953 Result := A
954 else
959 begin
961 Result := A
962 else
967 begin
969 Result := A
970 else
975 begin
977 Result := A
978 else
983 {$IF Defined(USE_ASM) and (not Defined(USE_INLINE))}
984 asm
987 end;
988 {$ELSE}
989 begin
992 {$IFEND}
995 var
997 begin
1003 {$IF Defined(USE_ASM) and (not Defined(USE_INLINE))}
1004 asm
1006 end;
1007 {$ELSE}
1008 begin
1012 {$IFEND}
1015 {$IFDEF USE_ASM}
1016 asm
1017 @Loop:
1024 end;
1025 {$ELSE}
1026 var
1029 begin
1031 begin
1037 {$ENDIF}
1040 {$IF Defined(USE_ASM) and (not Defined(USE_INLINE))}
1041 asm
1043 end;
1044 {$ELSE}
1045 begin
1051 {$IFEND}
1054 {$IFDEF USE_ASM}
1055 asm
1056 @Loop:
1063 end;
1064 {$ELSE}
1065 var
1068 begin
1070 begin
1078 {$ENDIF}
1080 type
1082 var
1086 const
1088 var
1091 begin
1093 begin
1096 begin
1099 else
1107 var
1110 begin
1113 begin
1116 end
1120 {$IFDEF USE_ASM}
1121 asm
1132 REP STOSD
1135 REP STOSB
1137 @Exit:
1138 end;
1139 {$ELSE}
1140 begin
1143 {$ENDIF}
1146 {$IFDEF USE_ASM}
1147 asm
1159 REP STOSD
1160 @Word:
1166 @Byte:
1171 @Exit:
1174 end;
1175 {$ELSE}
1176 var
1178 begin
1186 begin
1192 {$ENDIF}
1195 {$IFDEF USE_ASM}
1196 asm
1205 REP STOSD
1206 @Word:
1212 @Byte:
1217 @Exit:
1220 end;
1221 {$ELSE}
1222 var
1224 begin
1231 begin
1237 {$ENDIF}
1240 begin
1243 begin
1246 begin
1257 var
1259 begin
1266 begin
1274 begin
1282 begin
1292 begin
1294 begin
1301 begin
1306 procedure ClipCopyBounds(var SrcX, SrcY, Width, Height, DstX, DstY: LongInt; SrcImageWidth, SrcImageHeight: LongInt; const DstClip: TRect);
1310 var
1313 begin
1316 begin
1323 begin
1332 begin
1342 var
1346 begin
1349 begin
1357 begin
1364 begin
1370 begin
1377 begin
1383 var
1390 begin
1397 begin
1401 end
1402 else
1403 begin
1405 Result := BoundsToRect(TargetRect.Left, TargetRect.Top + ((TargetHeight - ScaledHeight) div 2),
1411 begin
1412 Result:=
1420 begin
1421 Result :=
1429 begin
1434 var
1436 begin
1438 {$IFDEF MSWINDOWS}
1441 else
1443 {$ENDIF}
1444 {$IFDEF UNIX}
1446 {$ENDIF}
1447 {$IFDEF MSDOS}
1449 {$ENDIF}
1452 initialization
1453 InitCrcTable;
1454 {$IFDEF MSWINDOWS}
1457 {$ENDIF}
1458 {$IFDEF MSDOS}
1459 // reset PIT
1460 asm
1466 end;
1467 {$ENDIF}
1469 {
1470 File Notes:
1472 -- TODOS ----------------------------------------------------
1473 - nothing now
1475 -- 0.26.1 Changes/Bug Fixes -----------------------------------
1476 - Some formatting changes.
1477 - Changed some string functions to work with localized strings.
1478 - ASM version of PosEx had bugs, removed it.
1479 - Added StrTokensToList function.
1481 -- 0.25.0 Changes/Bug Fixes -----------------------------------
1482 - Fixed error in ClipCopyBounds which was causing ... bad clipping!
1484 -- 0.24.3 Changes/Bug Fixes -----------------------------------
1485 - Added GetTimeMilliseconds function.
1486 - Added IntToStrFmt and FloatToStrFmt helper functions.
1488 -- 0.23 Changes/Bug Fixes -----------------------------------
1489 - Added RectInRect and RectIntersects functions
1490 - Added some string utils: StrToken, StrTokenEnd, PosEx, PosNoCase.
1491 - Moved BuildFileList here from DemoUtils.
1493 -- 0.21 Changes/Bug Fixes -----------------------------------
1494 - Moved GetVolumeLevelCount from ImagingDds here.
1495 - Renamed FillMemory to FillMemoryByte to avoid name collision in C++ Builder.
1496 - Added Iff function for Char, Pointer, and Int64 types.
1497 - Added IsLittleEndian function.
1498 - Added array types for TWordRec, TLongWordRec, and TInt64Rec.
1499 - Added MatchFileNameMask function.
1501 -- 0.19 Changes/Bug Fixes -----------------------------------
1502 - added ScaleRectToRect (thanks to Paul Michell)
1503 - added BoundsToRect, ClipBounds, ClipCopyBounds, ClipStretchBounds functions
1504 - added MulDiv function
1505 - FreeAndNil is not inline anymore - caused AV in one program
1507 -- 0.17 Changes/Bug Fixes -----------------------------------
1509 - GetAppExe didn't return absolute path in FreeBSD, fixed
1510 - added debug message output
1511 - fixed Unix compatibility issues (thanks to Ales Katona).
1512 Imaging now compiles in FreeBSD and maybe in other Unixes as well.
1514 -- 0.15 Changes/Bug Fixes -----------------------------------
1515 - added some new utility functions
1517 -- 0.13 Changes/Bug Fixes -----------------------------------
1518 - added many new utility functions
1519 - minor change in SwapEndian to avoid range check error
1521 }