1 {
2 Vampyre Imaging Library
3 by Marek Mauder
4 http://imaginglib.sourceforge.net
6 The contents of this file are used with permission, subject to the Mozilla
7 Public License Version 1.1 (the "License"); you may not use this file except
8 in compliance with the License. You may obtain a copy of the License at
9 http://www.mozilla.org/MPL/MPL-1.1.html
11 Software distributed under the License is distributed on an "AS IS" basis,
12 WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
13 the specific language governing rights and limitations under the License.
15 Alternatively, the contents of this file may be used under the terms of the
16 GNU Lesser General Public License (the "LGPL License"), in which case the
17 provisions of the LGPL License are applicable instead of those above.
18 If you wish to allow use of your version of this file only under the terms
19 of the LGPL License and not to allow others to use your version of this file
20 under the MPL, indicate your decision by deleting the provisions above and
21 replace them with the notice and other provisions required by the LGPL
22 License. If you do not delete the provisions above, a recipient may use
23 your version of this file under either the MPL or the LGPL License.
25 For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html
26 }
28 { This unit contains utility functions and types for Imaging library.}
31 {$I ImagingOptions.inc}
33 interface
35 uses
38 const
42 type
76 { Array variants - Index 0 means lowest significant byte (word, ...).}
88 { Array variants - Index 0 means lowest significant byte (word, ...).}
116 public
120 { Options for BuildFileList function:
121 flFullNames - file names in result will have full path names
122 (ExtractFileDir(Path) + FileName)
123 flRelNames - file names in result will have names relative to
124 ExtractFileDir(Path) dir
125 flRecursive - adds files in subdirectories found in Path.}
130 { Frees class instance and sets its reference to nil.}
132 { Frees pointer and sets it to nil.}
134 { Replacement of standard System.FreeMem procedure which checks if P is nil
135 (this is only needed for Free Pascal, Delphi makes checks in its FreeMem).}
137 { Returns current exception object. Do not call outside exception handler.}
139 { Returns time value with microsecond resolution.}
141 { Returns time value with milisecond resolution.}
144 { Returns file extension (without "." dot)}
146 { Returns file name of application's executable.}
148 { Returns directory where application's exceutable is located without
149 path delimiter at the end.}
151 { Works like SysUtils.ExtractFileName but supports '/' and '\' dir delimiters
152 at the same time (whereas ExtractFileName supports on default delimiter on current platform).}
154 { Works like SysUtils.ExtractFileDir but supports '/' and '\' dir delimiters
155 at the same time (whereas ExtractFileDir supports on default delimiter on current platform).}
157 { Returns True if Subject matches given Mask with optional case sensitivity.
158 Mask can contain ? and * special characters: ? matches
159 one character, * matches zero or more characters.}
161 { This function fills Files string list with names of files found
162 with FindFirst/FindNext functions (See details on Path/Atrr here).
163 - BuildFileList('c:\*.*', faAnyFile, List, [flRecursive]) returns
164 list of all files (only name.ext - no path) on C drive
165 - BuildFileList('d:\*.*', faDirectory, List, [flFullNames]) returns
166 list of all directories (d:\dirxxx) in root of D drive.}
169 { Similar to RTL's Pos function but with optional Offset where search will start.
170 This function is in the RTL StrUtils unit but }
172 { Same as PosEx but without case sensitivity.}
173 function PosNoCase(const SubStr, S: string; Offset: LongInt = 1): LongInt; {$IFDEF USE_INLINE}inline;{$ENDIF}
174 { Returns a sub-string from S which is followed by
175 Sep separator and deletes the sub-string from S including the separator.}
177 { Same as StrToken but searches from the end of S string.}
179 { Fills instance of TStrings with tokens from string S where tokens are separated by
180 one of Seps characters.}
182 { Returns string representation of integer number (with digit grouping).
183 Uses current locale.}
185 { Returns string representation of float number (with digit grouping).
186 Uses current locale.}
187 function FloatToStrFmt(const F: Double; Precision: Integer = 2): string; {$IFDEF USE_INLINE}inline;{$ENDIF}
188 { Returns format settings for parsing floats (dot as decimal separator).
189 Useful when fomatting/parsing floats etc.}
191 { Returns True if S contains at least one of the substrings in SubStrs array. Case sensitive.}
193 { Extracts substring starting at IdxStart ending at IdxEnd.
194 S[IdxEnd] is not included in the result.}
195 function SubString(const S: string; IdxStart, IdxEnd: Integer): string; {$IFDEF USE_INLINE}inline;{$ENDIF}
197 { Clamps integer value to range <Min, Max>}
198 function ClampInt(Number: LongInt; Min, Max: LongInt): LongInt; {$IFDEF USE_INLINE}inline;{$ENDIF}
199 { Clamps float value to range <Min, Max>}
200 function ClampFloat(Number: Single; Min, Max: Single): Single; {$IFDEF USE_INLINE}inline;{$ENDIF}
201 { Clamps integer value to Byte boundaries.}
203 { Clamps integer value to Word boundaries.}
205 { Returns True if Num is power of 2.}
207 { Returns next power of 2 greater than or equal to Num
208 (if Num itself is power of 2 then it retuns Num).}
210 { Raises 2 to the given integer power (in range [0, 30]).}
212 { Raises Base to any power.}
214 { Returns log base 2 of integer X (max 2^30) or -1 if X is not power of 2.}
216 { Returns log base 2 of X.}
218 { Returns log base 10 of X.}
220 { Returns largest integer <= Val (for 5.9 returns 5).}
222 { Returns smallest integer >= Val (for 5.1 returns 6).}
224 { Returns lesser of two integer numbers.}
226 { Returns lesser of two float numbers.}
228 { Returns greater of two integer numbers.}
230 { Returns greater of two float numbers.}
232 { Returns result from multiplying Number by Numerator and then dividing by Denominator.
233 Denominator must be greater than 0.}
236 { Switches Boolean value.}
238 { If Condition is True then TruePart is retured, otherwise
239 FalsePart is returned.}
240 function Iff(Condition: Boolean; TruePart, FalsePart: LongInt): LongInt; overload; {$IFDEF USE_INLINE}inline;{$ENDIF}
241 { If Condition is True then TruePart is retured, otherwise
242 FalsePart is returned.}
243 function IffUnsigned(Condition: Boolean; TruePart, FalsePart: LongWord): LongWord; overload; {$IFDEF USE_INLINE}inline;{$ENDIF}
244 { If Condition is True then TruePart is retured, otherwise
245 FalsePart is returned.}
246 function Iff(Condition, TruePart, FalsePart: Boolean): Boolean; overload; {$IFDEF USE_INLINE}inline;{$ENDIF}
247 { If Condition is True then TruePart is retured, otherwise
248 FalsePart is returned.}
249 function Iff(Condition: Boolean; const TruePart, FalsePart: string): string; overload; {$IFDEF USE_INLINE}inline;{$ENDIF}
250 { If Condition is True then TruePart is retured, otherwise
251 FalsePart is returned.}
252 function Iff(Condition: Boolean; TruePart, FalsePart: Char): Char; overload; {$IFDEF USE_INLINE}inline;{$ENDIF}
253 { If Condition is True then TruePart is retured, otherwise
254 FalsePart is returned.}
255 function Iff(Condition: Boolean; TruePart, FalsePart: Pointer): Pointer; overload; {$IFDEF USE_INLINE}inline;{$ENDIF}
256 { If Condition is True then TruePart is retured, otherwise
257 FalsePart is returned.}
258 function Iff(Condition: Boolean; const TruePart, FalsePart: Int64): Int64; overload; {$IFDEF USE_INLINE}inline;{$ENDIF}
259 { If Condition is True then TruePart is retured, otherwise
260 FalsePart is returned.}
261 function IffFloat(Condition: Boolean; TruePart, FalsePart: Single): Single; {$IFDEF USE_INLINE}inline;{$ENDIF}
262 { Swaps two Boolean values}
264 { Swaps two Byte values}
266 { Swaps two Word values}
268 { Swaps two LongInt values}
270 { Swaps two Single values}
272 { Swaps two LongInt values if necessary to ensure that Min <= Max.}
274 { This function returns True if running on little endian machine.}
276 { Swaps byte order of Word value.}
278 { Swaps byte order of multiple Word values.}
280 { Swaps byte order of LongWord value.}
281 function SwapEndianLongWord(Value: LongWord): LongWord; overload; {$IFDEF USE_INLINE}inline;{$ENDIF}
282 { Swaps byte order of multiple LongWord values.}
285 { Calculates CRC32 for the given data.}
287 { Fills given memory with given Byte value. Size is size of buffer in bytes.}
289 { Fills given memory with given Word value. Size is size of buffer in bytes.}
291 { Fills given memory with given LongWord value. Size is size of buffer in bytes.}
293 { Fills given memory zeroes.}
297 { Returns how many mipmap levels can be created for image of given size.}
299 { Returns total number of levels of volume texture with given depth and
300 mipmap count (this is not depth * mipmaps!).}
302 { Returns rectangle (X, Y, X + Width, Y + Height).}
303 function BoundsToRect(X, Y, Width, Height: LongInt): TRect; overload; {$IFDEF USE_INLINE}inline;{$ENDIF}
304 { Returns rectangle (R.Left, R.Top, R.Left + R.Right, R.Top + R.Bottom).}
306 { Returns rectangle (R.Left, R.Top, R.Right - R.Left, R.Bottom - R.Top).}
308 { Clips given bounds to Clip rectangle.}
310 { Clips given source bounds and dest position. It is used by various CopyRect
311 functions that copy rect from one image to another. It handles clipping the same way
312 as Win32 BitBlt function. }
315 { Clips given source bounds and dest bounds. It is used by various StretchRect
316 functions that stretch rectangle of pixels from one image to another.
317 It handles clipping the same way as Win32 StretchBlt function. }
320 { Scales one rectangle to fit into another. Proportions are preserved so
321 it could be used for 'Stretch To Fit Window' image drawing for instance.}
323 { Scales given size to fit into max size while keeping the original ascpect ration.
324 Useful for calculating thumbnail dimensions etc.}
326 { Returns width of given rect. Part of RTL in newer Delphi.}
328 { Returns height of given rect. Part of RTL in newer Delphi.}
330 { Returns True if R1 fits into R2.}
332 { Returns True if R1 and R2 intersects.}
335 { Converts pixel size in micrometers to corrensponding DPI.}
337 { Converts DPI to corrensponding pixel size in micrometers.}
344 { Formats given message for usage in Exception.Create(..). Use only
345 in except block - returned message contains message of last raised exception.}
347 { Outputs debug message - shows message dialog in Windows and writes to console
348 in Linux/Unix.}
351 implementation
353 uses
354 {$IF Defined(MSWINDOWS)}
355 Windows;
356 {$ELSEIF Defined(FPC)}
357 Dos
358 {$IFDEF Unix}
360 {$ENDIF}
361 ;
362 {$ELSEIF Defined(DELPHI)}
364 {$IFEND}
366 var
370 begin
375 var
377 begin
384 begin
390 begin
396 begin
400 {$IF Defined(MSWINDOWS)}
401 var
406 var
408 begin
412 {$ELSEIF Defined(DELPHI)}
414 var
416 begin
420 {$ELSEIF Defined(FPC) and Defined(UNIX)}
422 var
424 begin
428 {$ELSE}
430 begin
431 {$WARNING GetTimeMicroseconds stub!}
434 {$IFEND}
437 begin
442 begin
449 {$IF Defined(MSWINDOWS)}
450 var
452 begin
456 var
458 begin
461 {$ELSE}
462 begin
464 {$IFEND}
468 begin
473 var
475 begin
481 const
483 var
485 begin
494 var
498 begin
501 else
506 begin
508 begin
511 begin
516 begin
520 begin
522 Exit;
524 repeat
526 begin
528 Exit;
533 Exit;
535 else
537 begin
539 Exit;
540 end
541 else
542 begin
552 begin
554 Exit;
560 begin
564 begin
566 Exit;
573 var
582 var
585 begin
589 begin
590 // Searching for subfolders
592 try
594 begin
600 finally
609 var
613 begin
618 try
620 begin
622 begin
625 else
630 finally
635 begin
641 {$IFDEF DCC}
642 {$WARN SYMBOL_PLATFORM OFF}
643 {$ENDIF}
646 else
648 {$IFDEF DCC}
649 {$WARN SYMBOL_PLATFORM ON}
650 {$ENDIF}
651 // Here's the recursive search for nested folders
653 BuildFolderList;
657 else
664 var
667 begin
672 begin
674 begin
679 begin
681 Exit;
690 begin
695 var
697 begin
700 begin
703 end
704 else
705 begin
712 var
714 begin
718 begin
723 begin
726 end
727 else
728 begin
735 var
737 begin
741 begin
748 begin
753 begin
758 begin
763 var
765 begin
768 begin
771 Exit;
776 begin
781 begin
784 Result := Min
790 begin
793 Result := Min
799 begin
808 begin
817 begin
822 begin
829 begin
834 begin
839 else
844 begin
877 else
883 {$IFDEF USE_ASM}
884 asm
885 FLD1
886 FLD X
887 FYL2X
888 FWAIT
889 end;
890 {$ELSE}
891 const
893 begin
896 {$ENDIF}
899 {$IFDEF USE_ASM}
900 asm
901 FLDLG2
902 FLD X
903 FYL2X
904 FWAIT
905 end;
906 {$ELSE}
907 const
909 begin
912 {$ENDIF}
915 begin
922 begin
929 begin
934 begin
936 Result := TruePart
937 else
942 begin
944 Result := TruePart
945 else
950 begin
952 Result := TruePart
953 else
958 begin
960 Result := TruePart
961 else
966 begin
968 Result := TruePart
969 else
974 begin
976 Result := TruePart
977 else
982 begin
984 Result := TruePart
985 else
990 begin
992 Result := TruePart
993 else
998 var
1000 begin
1007 var
1009 begin
1016 var
1018 begin
1025 var
1027 begin
1034 var
1036 begin
1043 var
1045 begin
1047 begin
1055 begin
1057 Result := A
1058 else
1063 begin
1065 Result := A
1066 else
1071 begin
1073 Result := A
1074 else
1079 begin
1081 Result := A
1082 else
1087 {$IF Defined(USE_ASM) and (not Defined(USE_INLINE))}
1088 asm
1091 end;
1092 {$ELSE}
1093 begin
1096 {$IFEND}
1099 var
1101 begin
1107 {$IF Defined(USE_ASM) and (not Defined(USE_INLINE))}
1108 asm
1110 end;
1111 {$ELSE}
1112 begin
1116 {$IFEND}
1119 {$IFDEF USE_ASM}
1120 asm
1121 @Loop:
1128 end;
1129 {$ELSE}
1130 var
1133 begin
1135 begin
1141 {$ENDIF}
1144 {$IF Defined(USE_ASM) and (not Defined(USE_INLINE))}
1145 asm
1147 end;
1148 {$ELSE}
1149 begin
1155 {$IFEND}
1158 {$IFDEF USE_ASM}
1159 asm
1160 @Loop:
1167 end;
1168 {$ELSE}
1169 var
1172 begin
1174 begin
1182 {$ENDIF}
1184 type
1186 var
1190 const
1192 var
1195 begin
1197 begin
1200 begin
1203 else
1211 var
1214 begin
1217 begin
1220 end
1224 {$IFDEF USE_ASM}
1225 asm
1236 REP STOSD
1239 REP STOSB
1241 @Exit:
1242 end;
1243 {$ELSE}
1244 begin
1247 {$ENDIF}
1250 {$IFDEF USE_ASM}
1251 asm
1263 REP STOSD
1264 @Word:
1270 @Byte:
1275 @Exit:
1278 end;
1279 {$ELSE}
1280 var
1282 begin
1290 begin
1296 {$ENDIF}
1299 {$IFDEF USE_ASM}
1300 asm
1309 REP STOSD
1310 @Word:
1316 @Byte:
1321 @Exit:
1324 end;
1325 {$ELSE}
1326 var
1328 begin
1335 begin
1341 {$ENDIF}
1344 begin
1349 begin
1352 begin
1355 begin
1366 var
1368 begin
1375 begin
1383 begin
1391 begin
1401 begin
1403 begin
1410 begin
1415 procedure ClipCopyBounds(var SrcX, SrcY, Width, Height, DstX, DstY: LongInt; SrcImageWidth, SrcImageHeight: LongInt; const DstClip: TRect);
1419 var
1422 begin
1425 begin
1432 begin
1441 begin
1451 var
1455 begin
1458 begin
1466 begin
1473 begin
1479 begin
1486 begin
1492 var
1499 begin
1506 begin
1510 end
1511 else
1512 begin
1514 Result := BoundsToRect(TargetRect.Left, TargetRect.Top + ((TargetHeight - ScaledHeight) div 2),
1520 var
1522 begin
1531 begin
1536 begin
1541 begin
1542 Result:=
1550 begin
1551 Result :=
1559 begin
1564 begin
1569 begin
1571 begin
1580 begin
1585 begin
1590 begin
1595 var
1597 begin
1599 {$IFDEF MSWINDOWS}
1602 else
1604 {$ENDIF}
1605 {$IFDEF UNIX}
1607 {$ENDIF}
1608 {$IFDEF MSDOS}
1610 {$ENDIF}
1613 initialization
1614 InitCrcTable;
1615 {$IFDEF MSWINDOWS}
1618 {$ENDIF}
1620 {$IF Defined(DELPHI)}
1621 {$IF CompilerVersion >= 23}
1623 {$ELSE}
1625 {$IFEND}
1626 {$ELSE FPC}
1629 {$IFEND}
1631 {
1632 File Notes:
1634 -- TODOS ----------------------------------------------------
1635 - nothing now
1637 -- 0.77.1 ----------------------------------------------------
1638 - Added GetFileName, GetFileDir, RectWidth, RectHeight function.
1639 - Added ScaleSizeToFit function.
1640 - Added ZeroMemory and SwapValues for Booleans.
1641 - Added Substring function.
1642 - Renamed MatchFileNameMask to StrMaskMatch (it's for general use not
1643 just filenames).
1644 - Delphi XE2 new targets (Win64, OSX32) compatibility changes.
1645 - Added GetFormatSettingsForFloats function.
1647 -- 0.26.5 Changes/Bug Fixes -----------------------------------
1648 - Added Log10 function.
1649 - Added TFloatRect type and helper functions FloatRect, FloatRectWidth,
1650 FloatRectHeight.
1651 - Added string function ContainsAnySubStr.
1652 - Added functions PixelSizeToDpi, DpiToPixelSize.
1654 -- 0.26.1 Changes/Bug Fixes -----------------------------------
1655 - Some formatting changes.
1656 - Changed some string functions to work with localized strings.
1657 - ASM version of PosEx had bugs, removed it.
1658 - Added StrTokensToList function.
1660 -- 0.25.0 Changes/Bug Fixes -----------------------------------
1661 - Fixed error in ClipCopyBounds which was causing ... bad clipping!
1663 -- 0.24.3 Changes/Bug Fixes -----------------------------------
1664 - Added GetTimeMilliseconds function.
1665 - Added IntToStrFmt and FloatToStrFmt helper functions.
1667 -- 0.23 Changes/Bug Fixes -----------------------------------
1668 - Added RectInRect and RectIntersects functions
1669 - Added some string utils: StrToken, StrTokenEnd, PosEx, PosNoCase.
1670 - Moved BuildFileList here from DemoUtils.
1672 -- 0.21 Changes/Bug Fixes -----------------------------------
1673 - Moved GetVolumeLevelCount from ImagingDds here.
1674 - Renamed FillMemory to FillMemoryByte to avoid name collision in C++ Builder.
1675 - Added Iff function for Char, Pointer, and Int64 types.
1676 - Added IsLittleEndian function.
1677 - Added array types for TWordRec, TLongWordRec, and TInt64Rec.
1678 - Added MatchFileNameMask function.
1680 -- 0.19 Changes/Bug Fixes -----------------------------------
1681 - added ScaleRectToRect (thanks to Paul Michell)
1682 - added BoundsToRect, ClipBounds, ClipCopyBounds, ClipStretchBounds functions
1683 - added MulDiv function
1684 - FreeAndNil is not inline anymore - caused AV in one program
1686 -- 0.17 Changes/Bug Fixes -----------------------------------
1688 - GetAppExe didn't return absolute path in FreeBSD, fixed
1689 - added debug message output
1690 - fixed Unix compatibility issues (thanks to Ales Katona).
1691 Imaging now compiles in FreeBSD and maybe in other Unixes as well.
1693 -- 0.15 Changes/Bug Fixes -----------------------------------
1694 - added some new utility functions
1696 -- 0.13 Changes/Bug Fixes -----------------------------------
1697 - added many new utility functions
1698 - minor change in SwapEndian to avoid range check error
1700 }