general.pas

DelphiDoc is a program for automatic generation of documentation on a Delphi-Project. At the momen

{Loads a graphic and returns it as a bitmap.
~param FileName the name of file containing an image (in a registered format),
                this may even be directly a bitmap file, the file should exists
~result a new bitmap object containing the graphic
~exception EInvalidGraphic if the format of the graphic is unknown (or
                           invalid?) }
function TransformFileToBitmap(const FileName: String): TBitmap;
var      Graphic              :TPicture;     //loads the general graphic
begin
 Result := TBitmap.Create;                   //create the bitmap
 try
   if CompareText(ExtractFileExt(FileName), '.bmp') = 0 then //is a bitmap?
    Result.LoadFromFile(FileName)              //load the bitmap
   else
    begin
     Graphic := TPicture.Create;               //create container for graphic
     try
       Graphic.LoadFromFile(FileName);         //load the graphic
//       Result.Assign(Graphic.Graphic);         //and convert it to a bitmap
       Result.Width := Graphic.Width;          //and draw it onto the bitmap
       Result.Height := Graphic.Height;
       Result.Canvas.Draw(0, 0, Graphic.Graphic);
     finally
      Graphic.Free;                            //free graphic
     end;
    end;
 except
   Result.Free;                              //in case of an error, free bitmap
   raise;                                    //and let error be handled
 end;
end;



{Extracts the dimensions of a PNG image from its data stream.
~param Stream the data stream of the image
~result the size of the image
~exception EReadError if the file ends prematurely
~exception EInvalidGraphic if the file does not contains a valid PNG image }
function ExtractPNGImageSize(Stream: TStream): TPoint;
         //the bytes each PNG file has to start with;
         //beware, some (faulty) implementations may produce a slighty bigger
         //IHDR-Chunk (14 (or even 16?) bytes), their images will fail here
const    PNGFileStart  :array[0..15] of Char =
                        #137'PNG'#13#10#26#10 + #0#0#0#13'IHDR';
var      ReadBuffer    :array[0..23] of Byte;  //buffer to read size of image
begin
 Stream.ReadBuffer(ReadBuffer, 24);       //read the PNG magic and image header

 //starts with PNG file magic and Image HeaDeR?
 if not CompareMem(@ReadBuffer, @PNGFileStart, 16) then
  raise EInvalidGraphic.Create('PNG image does not start with File Magic and Image Header (IHDR)!');

 //read the size of the image
 Result.x := BigEndianToLittleEndian(PInteger(@ReadBuffer[16])^);
 Result.y := BigEndianToLittleEndian(PInteger(@ReadBuffer[20])^);

 if (Result.x >= $10000) or (Result.x < 0) or      //and check size for sanity
    (Result.y >= $10000) or (Result.y < 0) then
 raise EInvalidGraphic.CreateFmt('PNG image has invalid size (%dx%d)!',
                                 [Result.x, Result.y]);
end;

{Extracts the dimensions of a JPEG image from its data stream.
~param Stream the data stream of the image
~result the size of the image
~exception EReadError if the file ends prematurely or is otherwise invalid
~exception EInvalidGraphic if the file does not contains a valid JPEG image }
function ExtractJPEGImageSize(Stream: TStream): TPoint;
var      ReadBuffer     :array[0..4] of Byte;   //buffer to read size of image
begin
 Stream.ReadBuffer(ReadBuffer, 2);              //read the JPEG magic
 if (ReadBuffer[0] <> $FF) or (ReadBuffer[1] <> $D8) then //and check it
  raise EInvalidGraphic.Create('Not a valid JPEG image.');

 //read the header and size of the first marker
 Stream.ReadBuffer(ReadBuffer, 4);
 while (ReadBuffer[0] <> $FF) or not (ReadBuffer[1] in [$C0..$C3]) do
  begin
   //bypass the marker
   Stream.Seek(ReadBuffer[2] shl 8 or ReadBuffer[3] - 2, soFromCurrent);
   //read the header and size of the next marker
   Stream.ReadBuffer(ReadBuffer, 4);
  end;

 Stream.ReadBuffer(ReadBuffer, 5);              //skip byte and read size
 Result.x := ReadBuffer[1] shl 8 or ReadBuffer[2]; //extract the size
 Result.y := ReadBuffer[3] shl 8 or ReadBuffer[4];
end;



{$IFNDEF NOPNGSUPPORT}

{Converts a bitmap file to a PNG image file.
~param BMP     the bitmap to convert, if not nil
~param BMPName the name of the bitmap file to convert, if BMP is nil
~param PNGName the name to save the PNG file to }
procedure ConvertBMPToPNG(BMP: TBitmap; const BMPName, PNGName: String);
var       NeedFree   :Boolean;       //need to free the bitmap?
{$IFNDEF LINUX}
          PNG        :TPNGObject;    //and converted as a PNG image file
{$ELSE}
          WideStr    :WideString;    //name of file to save
{$ENDIF}
begin
 NeedFree := not Assigned(BMP);
 if NeedFree then
  BMP := TBitmap.Create;             //create the bitmap
 try
   if NeedFree then
    BMP.LoadFromFile(BMPName);       //and load it from the file
{$IFNDEF LINUX}
   PNG := TPNGObject.Create;         //create the PNG object to convert it
   try
     PNG.Assign(BMP);                //convert the bitmap to a PNG image

     //should be optimum, real optimum is to use all items in the set!
     //but that would be slower! but who cares, so let's do it:
     PNG.Filters := [pfNone, pfSub, pfUp, pfAverage, pfPaeth];
     PNG.CompressionLevel := High(PNG.CompressionLevel);
     PNG.InterlaceMethod := imNone;

     PNG.SaveToFile(PNGName);        //save the PNG image to the file
   finally
    PNG.Free;                        //free the PNG object
   end;
{$ELSE}
   WideStr := PNGName;               //use long version for API call
   QPixMap_save(BMP.Handle, @WideStr, PChar('PNG')); //save as PNG file
{$ENDIF}
 finally
  if NeedFree then
   BMP.Free;                         //free the bitmap object
 end;
end;

{$ENDIF}


{$IFNDEF NOJPEGSUPPORT}

{Converts a bitmap file to a JPEG image file.
~param BMP     the bitmap to convert, if not nil
~param BMPName the name of the bitmap file to convert, if BMP is nil
~param JPEGName the name to save the JPEG file to }
procedure ConvertBMPToJPEG(BMP: TBitmap; const BMPName, JPEGName: String);
var       NeedFree   :Boolean;      //need to free the bitmap?
{$IFNDEF LINUX}
          JPEG       :TJPEGImage;   //convertes the bitmap to JPEG
{$ELSE}
          WideStr    :WideString;   //name of file to save
{$ENDIF}
begin
 NeedFree := not Assigned(BMP);
 if NeedFree then
  BMP := TBitmap.Create;            //create the bitmap
 try
   if NeedFree then
    BMP.LoadFromFile(BMPName);      //and load it from the file

{$IFNDEF LINUX}
   JPEG := TJPEGImage.Create;       //create the object for the JPEG image
   try
     JPEG.CompressionQuality := 100;
     JPEG.ProgressiveEncoding := False; //not sure whether to set this option
     JPEG.Assign(BMP);              //convert the bitmap to a JPEG image
     JPEG.Compress;
     JPEG.SaveToFile(JPEGName);     //save the JPEG image to the file
   finally
    JPEG.Free;                      //free the JPEG object
   end;
{$ELSE}
   WideStr := JPEGName;             //use long version for API call
   //save as JPEG file
   QPixMap_save(BMP.Handle, @WideStr, PChar('JPEG'), 75 {Quality: 1..100});
{$ENDIF}
 finally
  if NeedFree then
   BMP.Free;                        //free the bitmap object
 end;
end;

{$ENDIF}





{$IFDEF VER120}

{Frees the object and clears its reference.
~param AnObject the object to free and the reference to clear }
procedure FreeAndNil(var AnObject: TObject);
var       Obj       :TObject;        //the object to free
begin
 //the reference is first cleared than the object is freed,
 //so if an error occures, the reference will already be cleared,
 //this is faster than try .. finally

 Obj := AnObject;                    //save the object
 AnObject := nil;                    //clear the reference
 Obj.Free;                           //free the object
end;

{$ENDIF}



{Returns the number in its roman representation.
~param Value the number to return
~result the roman number }
function IntToRoman(Value :Integer): String;
         //characters indicating a value of 10^n
const    OneDigit  :array[0..3] of Char = ('I','X','C','M');
         //characters indicating a value of 5 * 10^n
         FiveDigit :array[0..2] of Char = ('V','L','D');
var      StrValue  :String;        //the number with latin digits
         i         :Byte;          //counter through the digit
         Digit     :Byte;          //each digit
begin
if (Value < 1) or (Value > 3999) then //not a valid number?
 Result := 'ERROR'
else
 begin
  Result := '';                         //so far no digits
  StrValue := IntToStr(Value);          //get the digits
  for i := 1 to length(StrValue) do     //for eah digit
   begin
    Digit := ord(StrValue[i]) - ord('0'); //get the digit
    if Digit = 4 then                     //is a 4?
     //just add the digits for four
     Result := Result + OneDigit[length(StrValue) - i] +
                        FiveDigit[length(StrValue) - i]
    else
     if Digit = 9 then                    //is a 9?
      //just add the digits for nine
      Result := Result + OneDigit[length(StrValue) - i] +
                         OneDigit[length(StrValue) - i + 1]
     else
      begin
       if Digit > 4 then                  //is >= 5?
        begin                               //add the five-digit
         Result := Result + FiveDigit[length(StrValue) - i];
         dec(Digit, 5);                     //and subtract this from the digit
        end;
       while Digit > 0 do                 //for each remaining digit
        begin                               //add one one-digit character
         Result := Result + OneDigit[length(StrValue) - i];
         dec(Digit);
        end; //while Digit > 0
      end; //else digit = 9
   end; //for i := 1 to length(StrValue)
 end; //if number valid?
end;





{Returns a list of files with the specified extension in that directory,
 including subdirectories if demanded.
~param Extension the extension of the searched files, with the leading dot
~param Path      the path of the directory in which all matching files should
                 be returned
~param List      the list to which all found files should be added
~param Recurse   whether files in subdirectories should also be returned
~result the number of found files }
function FindFilesByExtension(const Extension: String; Path: String;
                              List: TStrings; Recurse: Boolean): Cardinal;
var      Dirs      :TStringList;   //the list of directories to be searched
         Index     :Integer;       //counter through Dirs
         FileInfo  :TSearchRec;    //data to find files
begin
 Result := 0;                      //no files found so far

 Dirs := TStringList.Create;       //list of all directories to search in
 try
   Dirs.Append(Path);              //at the moment only the path given
   Index := 0;                     //start at his path

   repeat                          //for all paths (if recursive)
     Path := Dirs[Index];            //get path to search in


     if FindFirst(Path + PathDelimiter + '*',
{$IFNDEF LINUX}
  {$IFDEF conditionalexpressions}
    {$WARN SYMBOL_PLATFORM OFF}
  {$ENDIF}
                  faHidden or
  {$IFDEF conditionalexpressions}
    {$WARN SYMBOL_PLATFORM ON}
  {$ENDIF}
{$ENDIF}
                  faDirectory,
                  FileInfo) = 0 then //files available
      try
        repeat                         //for each found file

          if FileInfo.Attr and faDirectory = 0 then //not a directory?
           begin
            //has the extension?
            if CompareText(ExtractFileExt(FileInfo.Name), Extension) = 0 then
             begin                             //append file to the list
              List.Append(ExtractShortPathName(ExpandFileName(Path +
                                                              PathDelimiter +
                                                              FileInfo.Name)));
              inc(Result);                     //another file found
             end;
           end
          else
           if Recurse and   //a directory and should be recursed into?
{$IFDEF LINUX}
  {$WARN SYMBOL_PLATFORM OFF}
              //don't follow symlinked directories (no eternal recursion,
              (FileInfo.Attr and faSymLink = 0) and               //please)
  {$WARN SYMBOL_PLATFORM ON}
{$ENDIF}
              (FileInfo.Name <> '.') and (FileInfo.Name <> '..') then
            //append to paths to search
            Dirs.Append(Path + PathDelimiter + FileInfo.Name);


        until FindNext(FileInfo) <> 0; //until all files have been processed
      finally
       FindClose(FileInfo);            //end the search
      end;

     inc(Index);                     //search next path
   until Index >= Dirs.Count;      //all paths searched?

 finally
  Dirs.Free;                       //free list of search paths
 end;
end;





{$IFNDEF LINUX}

{Fills the list with all command line parameters of the program. They are
 parsed according to
 ~[linkExtern http://msdn2.microsoft.com/en-us/library/ms880421.aspx the rules
 used by Microsoft].
~param AddTo the list to fill with the command line parameters }
procedure GetCommandLineParameters(AddTo: TStrings);

 {Extracts the next parameter from the remnant of the command line.
 ~param CmdLine   in and out: the remnant of the command line
 ~param MaxLen    the maximal length of the next parameter
 ~param Parameter out: the next parameter
 ~result whether another parameter was available }
 function NextParameter(var CmdLine: PChar; MaxLen: Integer;
                        var Parameter: String): Boolean;
 var      p            :PChar;    //runner through the command line
          S            :String;   //the parameter
          i            :Integer;  //index in S to copy the parameter
          InQuotedStr  :Boolean;  //whether current in "-quotes
          BackSlashes  :Integer;  //number of successive back-slashes
          iSlash       :Integer;  //counter through slashes
 begin
  p := CmdLine;
  while p^ in [#1..' '] do        //skip all white spaces at the beginning
   Inc(p);