home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 October / Chip_2001-10_cd1.bin / zkuste / delphi / kompon / d123456 / CHEMPLOT.ZIP / Misc / Misc.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-07-30  |  41.5 KB  |  1,469 lines
  1. unit Misc;
  2.  
  3. {$I Misc.inc}
  4.  
  5. {-----------------------------------------------------------------------------
  6. The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at
  7.  
  8. http://www.mozilla.org/MPL/MPL-1.1.html
  9.  
  10. Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for the specific language governing rights and limitations under the License.
  11.  
  12.  
  13. The Original Code is: PlotMisc.pas, released 1 July 2000.
  14.  
  15. The Initial Developer of the Original Code is Mat Ballard.
  16. Portions created by Mat Ballard are Copyright (C) 1999 Mat Ballard.
  17. Portions created by Microsoft are Copyright (C) 1998, 1999 Microsoft Corp.
  18. All Rights Reserved.
  19.  
  20. Contributor(s): Mat Ballard                 e-mail: mat.ballard@chemware.hypermart.net.
  21.  
  22. Last Modified: 02/25/2001
  23. Current Version: 2.00
  24.  
  25. You may retrieve the latest version of this file from:
  26.  
  27.         http://Chemware.hypermart.net/
  28.  
  29. This work was created with the Project JEDI VCL guidelines:
  30.  
  31.         http://www.delphi-jedi.org/Jedi:VCLVCL
  32.  
  33. in mind. 
  34.  
  35.  
  36. Purpose:
  37. Collection of miscellaneous routines and type definitions, that really don't
  38. belong anywhere else.
  39.  
  40. Known Issues:
  41. -----------------------------------------------------------------------------}
  42.  
  43. interface
  44.  
  45. uses
  46.   Classes, SysUtils, TypInfo,
  47. {$IFDEF NO_MATH}
  48.   NoMath,
  49. {$ELSE}
  50.   Math,
  51. {$ENDIF}
  52. {$IFDEF WINDOWS}
  53.   WinTypes, WinProcs,
  54.   Controls, Dialogs, Forms, Graphics, ShellApi
  55. {$ENDIF}
  56. {$IFDEF WIN32}
  57.   Windows,
  58.   Clipbrd, Controls, Dialogs, Forms, Graphics, ShellApi
  59. {$ENDIF}
  60. {$IFDEF LINUX}
  61.   Libc, Types, Qt,
  62.   QControls, QDialogs, QForms, QGraphics
  63. {$ENDIF}
  64.   ;
  65.  
  66. {Misc and TPlot now only work for Compiler 3 up !}
  67. {$IFDEF COMPILER3_UP}
  68.   {$IFDEF WIN32}
  69. {http://www.freetranslation.com/:}
  70.     {$IFDEF LANG_ENGLISH}{$I lang\eng.txt}{$ENDIF}
  71.     {$IFDEF LANG_FRENCH}{$I lang\fre.txt}{$ENDIF}
  72.     {$IFDEF LANG_GERMAN}{$I lang\ger.txt}{$ENDIF}
  73.     {$IFDEF LANG_ITALIAN}{$I lang\ita.txt}{$ENDIF}
  74.     {$IFDEF LANG_NORWEGIAN}{$I lang\nor.txt}{$ENDIF}
  75.     {$IFDEF LANG_PORTUGUESE}{$I lang\por.txt}{$ENDIF}
  76.     {$IFDEF LANG_SPANISH}{$I lang\spa.txt}{$ENDIF}
  77. {Universal Translator by LanguageForce:}
  78.     {$IFDEF LANG_CZECH}{$I lang\cze.txt}{$ENDIF}
  79.     {$IFDEF LANG_DUTCH}{$I lang\dut.txt}{$ENDIF}
  80.     {$IFDEF LANG_DANISH}{$I lang\dan.txt}{$ENDIF}
  81.     {$IFDEF LANG_GREEK}{$I lang\gre.txt}{$ENDIF}
  82.     {$IFDEF LANG_HUNGARIAN}{$I lang\hun.txt}{$ENDIF}
  83.     {$IFDEF LANG_INDONESIAN}{$I lang\ind.txt}{$ENDIF}
  84.     {$IFDEF LANG_ROMANIAN}{$I lang\rom.txt}{$ENDIF}
  85.     {$IFDEF LANG_RUSSIAN}{$I lang\rus.txt}{$ENDIF}
  86.     {$IFDEF LANG_SLOVAK}{$I lang\slo.txt}{$ENDIF}
  87.     {$IFDEF LANG_SWEDISH}{$I lang\swe.txt}{$ENDIF}
  88.     {$IFDEF LANG_THAI}{$I lang\tha.txt}{$ENDIF}
  89.     {$IFDEF LANG_TURKISH}{$I lang\tur.txt}{$ENDIF}
  90.     {$IFDEF LANG_UKRAINIAN}{$I lang\ukr.txt}{$ENDIF}
  91.   {$ENDIF}
  92.   {$IFDEF LINUX}
  93. {http://www.freetranslation.com/:}
  94.     {$IFDEF LANG_ENGLISH}{$I lang/eng.txt}{$ENDIF}
  95.     {$IFDEF LANG_FRENCH}{$I lang/fre.txt}{$ENDIF}
  96.     {$IFDEF LANG_GERMAN}{$I lang/ger.txt}{$ENDIF}
  97.     {$IFDEF LANG_ITALIAN}{$I lang/ita.txt}{$ENDIF}
  98.     {$IFDEF LANG_NORWEGIAN}{$I lang/nor.txt}{$ENDIF}
  99.     {$IFDEF LANG_PORTUGUESE}{$I lang/por.txt}{$ENDIF}
  100.     {$IFDEF LANG_SPANISH}{$I lang/spa.txt}{$ENDIF}
  101. {Universal Translator by LanguageForce:}
  102.     {$IFDEF LANG_CZECH}{$I lang/cze.txt}{$ENDIF}
  103.     {$IFDEF LANG_DUTCH}{$I lang/dut.txt}{$ENDIF}
  104.     {$IFDEF LANG_DANISH}{$I lang/dan.txt}{$ENDIF}
  105.     {$IFDEF LANG_GREEK}{$I lang/gre.txt}{$ENDIF}
  106.     {$IFDEF LANG_HUNGARIAN}{$I lang/hun.txt}{$ENDIF}
  107.     {$IFDEF LANG_INDONESIAN}{$I lang/ind.txt}{$ENDIF}
  108.     {$IFDEF LANG_ROMANIAN}{$I lang/rom.txt}{$ENDIF}
  109.     {$IFDEF LANG_RUSSIAN}{$I lang/rus.txt}{$ENDIF}
  110.     {$IFDEF LANG_SLOVAK}{$I lang/slo.txt}{$ENDIF}
  111.     {$IFDEF LANG_SWEDISH}{$I lang/swe.txt}{$ENDIF}
  112.     {$IFDEF LANG_THAI}{$I lang/tha.txt}{$ENDIF}
  113.     {$IFDEF LANG_TURKISH}{$I lang/tur.txt}{$ENDIF}
  114.     {$IFDEF LANG_UKRAINIAN}{$I lang/ukr.txt}{$ENDIF}
  115.   {$ENDIF}
  116. {$ELSE}
  117.   Misc and TPlot now only work for Compiler 3 up !
  118. {$ENDIF}
  119.  
  120. type
  121.   pSingle = ^Single;
  122.   pDouble = ^Double;
  123.  
  124. {dynamic matrix definitions:}
  125. {$IFDEF DELPHI1}
  126.   TIntegerArray = array[0..MaxInt - 1] of Integer;
  127.   TSingleArray = array[0..MaxInt div 2 - 1] of Single;
  128.   TDoubleArray = array[0..MaxInt div 4 - 1] of Double;
  129. {$ELSE}
  130.   TIntegerArray = array[0..MaxInt div SizeOf(Integer) - 1] of Integer;
  131.   TSingleArray = array[0..MaxInt div SizeOf(Single) -1] of Single;
  132.   TDoubleArray = array[0..MaxInt div SizeOf(Double) - 1] of Double;
  133. {$ENDIF}
  134.  
  135. {NOTE: Multidimensional dynamic arrays DON'T WORK !
  136.   TIntegerMatrix = array[0..0] of array[0..0] of Integer;
  137.   TSingleMatrix = array[0..0] of array[0..0] of Single;
  138.   TDoubleMatrix = array[0..0] of array[0..0] of Double;}
  139.  
  140. {dynamic matrix definitions - pointers thereto:}
  141.   pIntegerArray = ^TIntegerArray;
  142.   pSingleArray = ^TSingleArray;
  143.   pDoubleArray = ^TDoubleArray;
  144.   {pIntegerMatrix = ^TIntegerMatrix;
  145.   pSingleMatrix = ^TSingleMatrix;
  146.   pDoubleMatrix = ^TDoubleMatrix;}
  147.  
  148. {$IFDEF LINUX}
  149. {$ENDIF}
  150.  
  151.   TPercent = 0..100;
  152.  
  153.   TXYPoint = record
  154.     X: Single;
  155.     Y: Single;
  156.   end;
  157.   pXYPoint = ^TXYPoint;
  158. {$IFDEF DELPHI1}
  159.   TXYArray = array[0..MaxInt div 4 - 1] of TXYPoint;
  160. {$ELSE}
  161.   TXYArray = array[0..MaxInt div SizeOf(Double) - 1] of TXYPoint;
  162. {$ENDIF}
  163.   pXYArray = ^TXYArray;
  164.  
  165.   TIdentMapEntry = record
  166.     Value: TColor;
  167.     Name: String;
  168.   end;
  169.  
  170. {$IFDEF LINUX}
  171.   TRGBTriple = packed record
  172.     rgbtBlue: Byte;
  173.     rgbtGreen: Byte;
  174.     rgbtRed: Byte;
  175.   end;
  176. {$ENDIF}
  177.   TRGBArray    = array[0..20000] OF TRGBTriple;
  178.   pRGBArray    = ^TRGBArray;
  179.   
  180.   TRainbowColor = record
  181.     R: Integer;
  182.     G: Integer;
  183.     B: Integer;
  184.   end;
  185.  
  186.   TFileList = class(TStringList)
  187.     private
  188.     protected
  189.     public
  190.       procedure AppendToFile(const FileName: string); virtual;
  191.     published
  192.   end;
  193.  
  194.   TMemoryStreamEx = class(TMemoryStream)
  195.     private
  196.     protected
  197.     public
  198.       procedure AppendToFile(const FileName: string); virtual;
  199.   end;
  200.  
  201.   function GetLineLengthFromStream(AStream: TMemoryStream): Integer;
  202.   function ReadLine(AStream: TMemoryStream): String;
  203.   function FindStringInStream(TheString: String; AStream: TMemoryStream): Boolean;
  204.   function CleanString(AString: String; TheChar: Char): String;
  205.   function StrRev(TheStr: String): String;
  206.  
  207.   procedure DeSci(ExtNumber: Extended; var Mantissa: Extended; var Exponent: Integer);
  208. {This method breaks a number down into its mantissa and exponent.
  209.  Eg: 0.00579 has a mantissa of 5.79, and an exponent of -3.}
  210.  
  211.   procedure Wait(mSeconds: Integer; ProcessMessages: Boolean);
  212.  
  213.   function GetAngle(Xi, Yi: Integer): Extended;
  214. {This returns the angle of a point from the vertical, in radians.}
  215.   function GetAngleDeg(Xi, Yi: Integer): Extended;
  216. {This returns the angle of a point from the vertical, in degrees.}
  217.  
  218.   function GetWord (var This_Line: String; Delimiter: String): String;
  219. {The GetWord function returns all the characters up to Delimiter in This_Line,
  220.  and removes all characters up to and including Delimiter from ThisLine.}
  221. {}
  222. {This is very useful for extracting comma or tab-seperated strings (numbers)
  223.  from text data.}
  224.  
  225.   function IndexOfColorValue(Value: TColor): Integer;
  226.   function IndexOfColorName(Name: String): Integer;
  227.   function GetDarkerColor(Value: TColor; Brightness: Integer): TColor;
  228.   function GetInverseColor(Value: TColor): TColor;
  229.   function GetPalerColor(Value: TColor; Brightness: Integer): TColor;
  230.   function Rainbow(Fraction: Single): TColor;
  231.   function InputColor(var AColor: TColor): Boolean;
  232.  
  233.   function BinToInt(Value: String): {$IFDEF DELPHI1}Longint{$ELSE}{$IFDEF BCB}Longint{$ELSE}Longword{$ENDIF}{$ENDIF};
  234.   function IntToBin(Value: {$IFDEF DELPHI1}Longint{$ELSE}{$IFDEF BCB}Longint{$ELSE}Longword{$ENDIF}{$ENDIF}): string;
  235.  
  236.   function IsInteger(Value: String): Boolean;
  237.   function IsFixed(Value: String): Boolean;
  238.   function IsReal(Value: String): Boolean;
  239.  
  240.   procedure SetDialogGeometry(AForm: TForm; AButton: TControl; BorderWidth: Integer);
  241.  
  242. {$IFDEF MSWINDOWS}
  243.   procedure TextOutAnglePersist(
  244.     ACanvas: TCanvas;
  245.     Angle, Left, Top: Integer;
  246.     TheText: String);
  247. {$ENDIF}
  248.   procedure TextOutAngle(
  249.     ACanvas: TCanvas;
  250.     Angle, Left, Top: Integer;
  251.     TheText: String);
  252.   procedure ShellExec(Cmd: String);
  253.   procedure ShowHTML(Cmd: String);
  254.   procedure DoMail(Cmd: String);
  255. {$IFDEF LINUX}
  256.   function GetBrowser: String;
  257.   function GetMailer: String;
  258.   function CheckForRPM(AnRPM: String): String;
  259.   procedure DoHTMLHelp(
  260.     HelpType: THelpType;
  261.     HelpContext: Integer;
  262.     HelpKeyword: string;
  263.     HelpFile: string;
  264.     var Handled: Boolean);
  265. {$ENDIF}
  266.  
  267. {$IFDEF DELPHI1}
  268.   function GetCurrentDir: String;
  269. {$ENDIF}
  270.  
  271. const
  272.   PI_ON_2 =       1.57079632679489; {66192313216916398}
  273.   THREE_PI_ON_2 = 4.71238898038468; {98576939650749193}
  274.   TWO_PI =        6.28318530717958; {6476925286766559}
  275.   DEGS_PER_RAD =  57.2957795130823; {20876798154814105}
  276.  
  277.   CRLF = #13+#10;
  278.   MY_COLORS_MAX = 15;
  279. {The number of MyColors runs from 0..15.}
  280.  
  281. {MyColors is based on the Colors definition in Graphics.pas,
  282.  restricted the the basic 16 colors, and in a different order
  283.  more suitable for graphs.}
  284.   MyColorValues: array[0..15] of TColor = (
  285.     clBlack,
  286.     clRed,
  287.     clBlue,
  288.     clGreen,
  289.     clPurple,
  290.     clFuchsia,
  291.     clAqua,
  292.     clMaroon,
  293.     clOlive,
  294.     clNavy,
  295.     clTeal,
  296.     clGray,
  297.     clSilver,
  298.     clLime,
  299.     clYellow,
  300.     clWhite);
  301.  
  302.   MAX_RAINBOW_COLORS = 5;
  303.   RainbowColors: array[0..MAX_RAINBOW_COLORS, 0..2] of Integer =
  304.     ({(0, 0, 0),          //black}
  305.      (255, 0, 0),        {red}
  306.      (255, 255, 0),      {yellow}
  307.      (0, 255, 0),        {green}
  308.      (0, 255, 255),      {aqua}
  309.      (0, 0, 255),        {blue}
  310.      (255, 0, 255));      {purple}
  311.      {(255, 255, 255));   //white}
  312. {Note: Black and white have been removed to avoid confusion with the background.}
  313.  
  314. {Used by all dialogs:}
  315. implementation
  316.  
  317. uses
  318.   Options, Optnsdlg;
  319.  
  320. {$IFDEF LINUX}
  321. resourcestring
  322.   sFileName = '/tmp/delete-me.txt';
  323. {$ENDIF}
  324.  
  325. {Load the Delphi or Kylix monikers:}
  326. {$IFDEF WIN32}
  327.   {$R Delphi24.res}
  328. {$ENDIF}
  329. {$IFDEF LINUX}
  330.   {$R Kylix24.res}
  331. {$ENDIF}
  332.  
  333. {------------------------------------------------------------------------------
  334.     Procedure: TFileList.AppendToFile
  335.   Description: appends this stringlist to an existing file
  336.        Author: Mat Ballard
  337.  Date created: 04/25/2000
  338. Date modified: 04/25/2000 by Mat Ballard
  339.       Purpose: saving data to disk
  340.  Known Issues:
  341.  ------------------------------------------------------------------------------}
  342. procedure TFileList.AppendToFile(const FileName: string);
  343. var
  344.   Stream: TStream;
  345. begin
  346.   if (FileExists(FileName)) then
  347.   begin
  348.     Stream := TFileStream.Create(FileName, fmOpenReadWrite);
  349.     Stream.Seek(0, soFromEnd);
  350.   end
  351.   else
  352.   begin
  353.     Stream := TFileStream.Create(FileName, fmCreate);
  354.   end;
  355.  
  356.   try
  357.     SaveToStream(Stream);
  358.   finally
  359.     Stream.Free;
  360.   end;
  361. end;
  362. {end TFileList ----------------------------------------------------------------}
  363.  
  364. {------------------------------------------------------------------------------
  365.     Procedure: TMemoryStreamEx.AppendToFile
  366.   Description: appends this MemoryStream to an existing file
  367.        Author: Mat Ballard
  368.  Date created: 04/25/2000
  369. Date modified: 04/25/2000 by Mat Ballard
  370.       Purpose: saving data to disk
  371.  Known Issues:
  372.  ------------------------------------------------------------------------------}
  373. procedure TMemoryStreamEx.AppendToFile(const FileName: string);
  374. var
  375.   Stream: TStream;
  376. begin
  377.   if (FileExists(FileName)) then
  378.   begin
  379.     Stream := TFileStream.Create(FileName, fmOpenReadWrite);
  380.     Stream.Seek(0, soFromEnd);
  381.   end
  382.   else
  383.   begin
  384.     Stream := TFileStream.Create(FileName, fmCreate);
  385.   end;
  386.  
  387.   try
  388.     SaveToStream(Stream);
  389.   finally
  390.     Stream.Free;
  391.   end;
  392. end;
  393.  
  394. {end TMemoryStreamEx ----------------------------------------------------------------}
  395.  
  396. {------------------------------------------------------------------------------
  397.      Function: GetLineLengthFromStream
  398.   Description: gets the length of the line (of text) at AStream.Position
  399.        Author: Mat Ballard
  400.  Date created: 08/09/2000
  401. Date modified: 08/09/2000 by Mat Ballard
  402.       Purpose: Stream manipulation
  403.  Return Value: the length of the line, up to CRLF
  404.  Known Issues:
  405.  ------------------------------------------------------------------------------}
  406. function GetLineLengthFromStream(AStream: TMemoryStream): Integer;
  407. var
  408.   pCR,
  409.   pLF: PChar;
  410.   i: Longint;
  411. begin
  412.   pCR := AStream.Memory;
  413.   Inc(pCR, AStream.Position);
  414. {default is the entire stream:}
  415.   GetLineLengthFromStream := AStream.Size - AStream.Position;
  416.   for i := AStream.Position to AStream.Size-1 do
  417.   begin
  418.     if (pCR^ = #13) then
  419.     begin
  420.       pLF := pCR;
  421.       Inc(pLF);
  422.       if (pLF^ = #10) then
  423.       begin
  424.         GetLineLengthFromStream := i - AStream.Position;
  425.         break;
  426.       end;
  427.     end;
  428.     Inc(pCR);
  429.   end;
  430. end;
  431.  
  432. {------------------------------------------------------------------------------
  433.      Function: ReadLine
  434.   Description: gets line (of text) at AStream.Position
  435.        Author: Mat Ballard
  436.  Date created: 08/09/2000
  437. Date modified: 04/28/2001 by Mat Ballard
  438.       Purpose: Stream manipulation
  439.  Return Value: the line as a string
  440.  Known Issues: does not work against TBlobStream
  441.  ------------------------------------------------------------------------------}
  442. function ReadLine(AStream: TMemoryStream): String;
  443. var
  444.   LineLength: Integer;
  445.   pLine: array [0..1023] of char;
  446. begin
  447.   LineLength := GetLineLengthFromStream(AStream);
  448. {get the line of text:}
  449. {$IFDEF DELPHI1}
  450.   AStream.Read(pLine, LineLength);
  451.   Result := StrPas(pLine);
  452. {$ELSE}
  453.   SetString(Result, PChar(nil), LineLength);
  454.   AStream.Read(Pointer(Result)^, LineLength);
  455. {$ENDIF}
  456. {get the CRLF:}
  457.   AStream.Read(pLine, 2);
  458. end;
  459.  
  460. {------------------------------------------------------------------------------
  461.      Function: FindStringInStream
  462.   Description: Finds the first occurrence of TheString in AStream from
  463.                AStream.Position onwards
  464.        Author: Mat Ballard
  465.  Date created: 08/09/2000
  466. Date modified: 08/09/2000 by Mat Ballard
  467.       Purpose:
  468.  Return Value: TRUE if successful, FALSE otherwise
  469.  Known Issues:
  470.  ------------------------------------------------------------------------------}
  471. function FindStringInStream(TheString: String; AStream: TMemoryStream): Boolean;
  472. var
  473.   pStart,
  474.   pTheChar: PChar;
  475.   i,
  476.   j: Longint;
  477.   FoundIt: Boolean;
  478. begin
  479.   pStart := AStream.Memory;
  480.   Inc(pStart, AStream.Position);
  481. {default is the entire stream:}
  482.   FindStringInStream := FALSE;
  483.   for i := AStream.Position to AStream.Size-1 do
  484.   begin
  485.     pTheChar := pStart;
  486.     FoundIt := TRUE;
  487.     for j := 1 to Length(TheString) do
  488.     begin
  489.       if (pTheChar^ <> TheString[j]) then
  490.       begin
  491.         FoundIt := FALSE;
  492.         break;
  493.       end;
  494.       Inc(pTheChar);
  495.     end;
  496.  
  497.     if (FoundIt) then
  498.     begin
  499.       AStream.Position := i;
  500.       FindStringInStream := TRUE;
  501.       break;
  502.     end;
  503.  
  504.     Inc(pStart);
  505.   end;
  506. end;
  507.  
  508. {------------------------------------------------------------------------------
  509.      Function: CleanString
  510.   Description: removes offending characters from a string
  511.        Author: Mat Ballard
  512.  Date created: 04/25/2000
  513. Date modified: 04/25/2000 by Mat Ballard
  514.       Purpose: menu manipulation
  515.  Return Value: the cleaned string
  516.  Known Issues:
  517.  ------------------------------------------------------------------------------}
  518. function CleanString(AString: String; TheChar: Char): String;
  519. var
  520.   i: Integer;
  521.   NewString: String;
  522. begin
  523.   NewString := '';
  524.   for i := 1 to Length(AString) do
  525.   begin
  526.     if (AString[i] <> TheChar) then
  527.     begin
  528.       NewString := NewString + AString[i];
  529.     end;
  530.   end;
  531.   CleanString := NewString;
  532. end;
  533.  
  534. {------------------------------------------------------------------------------
  535.      Function: StrRev
  536.   Description: reverses a string
  537.        Author: Mat Ballard
  538.  Date created: 04/25/2000
  539. Date modified: 04/25/2000 by Mat Ballard
  540.       Purpose: string manipulation
  541.  Return Value: the reverse of a string
  542.  Known Issues:
  543.  ------------------------------------------------------------------------------}
  544. function StrRev(TheStr: String): String;
  545. var
  546.   i,
  547.   l: Integer;
  548.   RevStr: String;
  549. begin
  550.   l := Length(TheStr);
  551. {$IFDEF DELPHI1}
  552.   RevStr := TheStr;
  553. {$ELSE}
  554.   SetLength(RevStr, l);
  555. {$ENDIF}
  556.  
  557.   for i := 1 to l do
  558.   begin
  559.     RevStr[i] := TheStr[l-i+1];
  560.   end;
  561.   StrRev := RevStr;
  562. end;
  563.  
  564. {------------------------------------------------------------------------------
  565.     Procedure: DeSci
  566.   Description: breaks a number up into its Mantissa and Exponent
  567.        Author: Mat Ballard
  568.  Date created: 04/25/2000
  569. Date modified: 04/25/2000 by Mat Ballard
  570.       Purpose: Tick and Label scaling
  571.  Known Issues: Why not use Math.Frexp() - because that works on POWERS OF TWO !
  572.  ------------------------------------------------------------------------------}
  573. procedure DeSci(ExtNumber: Extended; var Mantissa: Extended; var Exponent: Integer);
  574. var
  575.   TheLog: Extended;
  576.   TheSign: Extended;
  577. begin
  578.   TheSign := 1;
  579.  
  580.   if (ExtNumber = 0) then
  581.   begin
  582.     Mantissa := 0;
  583.     Exponent := 0;
  584.     exit;
  585.   end;
  586.  
  587.   if (ExtNumber < 0) then
  588.   begin
  589.     TheSign := -1;
  590.     ExtNumber := -ExtNumber;
  591.   end;
  592.  
  593.   TheLog := Log10(ExtNumber);
  594.   Exponent := Floor(TheLog);
  595.   Mantissa := TheLog - Exponent;
  596.   Mantissa := Power(10.0, Mantissa);
  597.   if (TheSign < 0) then Mantissa := -Mantissa;
  598. end;
  599.  
  600. procedure Wait(mSeconds: Integer; ProcessMessages: Boolean);
  601. var
  602.   StartTime: TDateTime;
  603. begin
  604.   StartTime := Now;
  605.   Screen.Cursor := crHourGlass;
  606.   while (Now < (StartTime + mSeconds / (1000 * 3600 * 24))) do
  607.   begin
  608.     if (ProcessMessages) then
  609.       Application.ProcessMessages;
  610.   end;
  611.   Screen.Cursor := crDefault;
  612. end;
  613.  
  614. function GetAngleDeg(Xi, Yi: Integer): Extended;
  615. begin
  616.   Result := DEGS_PER_RAD * GetAngle(Xi, Yi);
  617. end;
  618.  
  619. function GetAngle(Xi, Yi: Integer): Extended;
  620. begin
  621.   if (Yi = 0) then
  622.   begin
  623.     if (Xi > 0) then
  624.       Result := PI_ON_2
  625.      else
  626.       Result := THREE_PI_ON_2;
  627.   end
  628.   else
  629.   begin
  630.     if (Xi > 0) then
  631.     begin
  632.       if (Yi < 0) then {top-right quadrant}
  633.         Result := ArcTan(-Xi/Yi)
  634.       else {bottom-right}
  635.         Result := Pi - ArcTan(Xi/Yi);
  636.     end
  637.     else
  638.     begin {X < 0}
  639.       if (Yi > 0) then {bottom-left}
  640.         Result := Pi + ArcTan(-Xi/Yi)
  641.       else {top-left}
  642.         Result := TWO_PI - ArcTan(Xi/Yi);
  643.     end;
  644.   end;
  645. end;
  646.  
  647. {------------------------------------------------------------------------------
  648.      Function: GetWord
  649.   Description: splits a phrase into two at the delimiter
  650.        Author: Mat Ballard
  651.  Date created: 04/25/2000
  652. Date modified: 04/25/2000 by Mat Ballard
  653.       Purpose: string manipulation
  654.  Return Value: the left side
  655.  Known Issues:
  656.  ------------------------------------------------------------------------------}
  657. Function GetWord (var This_Line: String; Delimiter: String): String;
  658. var
  659.   Delimiter_Position: Integer;
  660. begin
  661.   Delimiter_Position := Pos(Delimiter, This_Line);
  662.   If (Delimiter_Position > 0) Then
  663.   begin
  664.     GetWord := Copy(This_Line, 1, Delimiter_Position-1);
  665.     This_Line := Copy(This_Line, Delimiter_Position + Length(Delimiter), Length(This_Line));
  666.   end
  667.   Else
  668.   begin
  669.     GetWord := This_Line;
  670.     This_Line := '';
  671.   end;
  672. end;
  673.  
  674. {------------------------------------------------------------------------------
  675.      Function: IndexOfColorValue
  676.   Description: gets the index of a color
  677.        Author: Mat Ballard
  678.  Date created: 04/25/2000
  679. Date modified: 04/25/2000 by Mat Ballard
  680.       Purpose: color manipulation
  681.  Return Value: Index of a color
  682.  Known Issues:
  683.  ------------------------------------------------------------------------------}
  684. function IndexOfColorValue(Value: TColor): Integer;
  685. var
  686.   i: Integer;
  687. begin
  688.   IndexOfColorValue := -1;
  689.   for i := 0 to MY_COLORS_MAX do
  690.   begin
  691.     if (MyColorValues[i] = Value) then
  692.     begin
  693.       IndexOfColorValue := i;
  694.       break;
  695.     end;
  696.   end;
  697. end;
  698.  
  699. {------------------------------------------------------------------------------
  700.      Function: IndexOfColorName
  701.   Description: gets the name of a color
  702.        Author: Mat Ballard
  703.  Date created: 04/25/2000
  704. Date modified: 04/25/2000 by Mat Ballard
  705.       Purpose: color manipulation
  706.  Return Value: string containing the color name
  707.  Known Issues:
  708.  ------------------------------------------------------------------------------}
  709. function IndexOfColorName(Name: String): Integer;
  710. var
  711.   i: Integer;
  712. begin
  713.   IndexOfColorName := -1;
  714.   for i := 0 to MY_COLORS_MAX do
  715.   begin
  716.     if (ColorToString(MyColorValues[i]) = Name) then
  717.     begin
  718.       IndexOfColorName := i;
  719.       break;
  720.     end;
  721.   end;
  722. end;
  723.  
  724. {------------------------------------------------------------------------------
  725.      Function: GetPalerColor
  726.   Description: gets a paler shade of the input color
  727.        Author: Mat Ballard
  728.  Date created: 09/25/2000
  729. Date modified: 09/25/2000 by Mat Ballard
  730.       Purpose: color manipulation
  731.  Return Value: TColor
  732.  Known Issues:
  733.  ------------------------------------------------------------------------------}
  734. function GetPalerColor(Value: TColor; Brightness: Integer): TColor;
  735. var
  736.   iColor,
  737.   iRed,
  738.   iBlue,
  739.   iGreen: Longint;
  740. begin
  741.   iColor := ColorToRGB(Value);
  742.  
  743.   iRed := (iColor and $000000FF);
  744.   iRed := iRed + Brightness * ($FF-iRed) div 100;
  745.  
  746.   iGreen := (iColor and $0000FF00) shr 8;
  747.   iGreen := iGreen + Brightness * ($FF-iGreen) div 100;
  748.  
  749.   iBlue := (iColor and $00FF0000) shr 16;
  750.   iBlue := iBlue + Brightness * ($FF-iBlue) div 100;
  751.  
  752.   GetPalerColor := TColor(iRed  or (iGreen shl 8) or (iBlue shl 16));
  753. end;
  754.  
  755. {------------------------------------------------------------------------------
  756.      Function: GetDarkerColor
  757.   Description: gets a darker shade of the input color
  758.        Author: Mat Ballard
  759.  Date created: 09/25/2000
  760. Date modified: 09/25/2000 by Mat Ballard
  761.       Purpose: color manipulation
  762.  Return Value: TColor
  763.  Known Issues:
  764.  ------------------------------------------------------------------------------}
  765. function GetDarkerColor(Value: TColor; Brightness: Integer): TColor;
  766. var
  767.   iColor,
  768.   iRed,
  769.   iBlue,
  770.   iGreen: Longint;
  771. begin
  772.   iColor := ColorToRGB(Value);
  773.  
  774.   iRed := (iColor and $000000FF);
  775.   iRed := iRed * Brightness div 100;
  776.  
  777.   iGreen := (iColor and $0000FF00) shr 8;
  778.   iGreen := iGreen * Brightness div 100;
  779.  
  780.   iBlue := (iColor and $00FF0000) shr 16;
  781.   iBlue := iBlue * Brightness div 100;
  782.  
  783.   GetDarkerColor := TColor(iRed  or (iGreen shl 8) or (iBlue shl 16));
  784. end;
  785.  
  786. {------------------------------------------------------------------------------
  787.      Function: GetInverseColor
  788.   Description: gets the inverse of the input color
  789.        Author: Mat Ballard
  790.  Date created: 09/25/2000
  791. Date modified: 09/25/2000 by Mat Ballard
  792.       Purpose: color manipulation
  793.  Return Value: TColor
  794.  Known Issues: does not return an inverse if Value is close to grey, because the
  795.                inverse of gray is gray !
  796.  ------------------------------------------------------------------------------}
  797. function GetInverseColor(Value: TColor): TColor;
  798. var
  799.   iColor,
  800.   iRed,
  801.   iBlue,
  802.   iGreen,
  803.   Difference: Longint;
  804. begin
  805.   iColor := ColorToRGB(Value);
  806.  
  807.   iRed := (iColor and $000000FF);
  808.   iRed := 255 - iRed;
  809.  
  810.   iGreen := (iColor and $0000FF00) shr 8;
  811.   iGreen := 255 - iGreen;
  812.  
  813.   iBlue := (iColor and $00FF0000) shr 16;
  814.   iBlue := 255 - iBlue;
  815.  
  816.   Difference := Abs(255 - (2*iRed + 2*iGreen + 2*iBlue) div 3);
  817.  
  818.   if (Difference > 26) then
  819.     GetInverseColor := TColor(iRed  or (iGreen shl 8) or (iBlue shl 16))
  820.    else
  821.     GetInverseColor := clBlack;
  822. end;
  823.  
  824. {------------------------------------------------------------------------------
  825.      Function: Rainbow
  826.   Description: returns a rainbow color, depending on the Fraction
  827.        Author: Mat Ballard
  828.  Date created: 02/15/2001
  829. Date modified: 02/15/2001 by Mat Ballard
  830.       Purpose: color manipulation for contour graphs
  831.  Return Value: TColor
  832.  Known Issues:
  833.  ------------------------------------------------------------------------------}
  834. function Rainbow(Fraction: Single): TColor;
  835. var
  836.   i,
  837.   LowIndex,
  838.   HighIndex: Integer;
  839.   RainbowColor: array [0..2] of Integer;
  840.   HighFraction,
  841.   LowFraction,
  842.   CellWidth: Single;
  843. begin
  844.   CellWidth := 1 / MAX_RAINBOW_COLORS;
  845.   LowIndex := Trunc(Fraction / CellWidth);
  846.   HighIndex := LowIndex + 1;
  847.   HighFraction := (Fraction - LowIndex * CellWidth) / CellWidth;
  848.   LowFraction := 1.0 - HighFraction;
  849.  
  850.   if (LowIndex = MAX_RAINBOW_COLORS) then
  851.   begin
  852.     for i := 0 to 2 do
  853.       RainbowColor[i] := 255;
  854.   end
  855.   else
  856.   begin
  857.     for i := 0 to 2 do
  858.     RainbowColor[i] := Round(
  859.       LowFraction * RainbowColors[LowIndex, i] +
  860.       HighFraction * RainbowColors[HighIndex, i]);
  861.   end;
  862.   Result := TColor(
  863.     RainbowColor[0] +
  864.     RainbowColor[1] shl 8 +
  865.     RainbowColor[2] shl 16);
  866. end;
  867.  
  868. {------------------------------------------------------------------------------
  869.      Function: InputColor
  870.   Description: prompts the user for a color
  871.        Author: Mat Ballard
  872.  Date created: 01/15/2001
  873. Date modified: 01/15/2001 by Mat Ballard
  874.       Purpose: color management
  875.  Return Value: Boolean
  876.  Known Issues:
  877.  ------------------------------------------------------------------------------}
  878. function InputColor(var AColor: TColor): Boolean;
  879. var
  880.   ColorDialog: TColorDialog;
  881. begin
  882.   InputColor := FALSE;
  883.   ColorDialog := TColorDialog.Create(nil);
  884. {$IFDEF MSWINDOWS}
  885.   ColorDialog.Options := [cdFullOpen];
  886. {$ENDIF}
  887.   ColorDialog.Color := AColor;
  888.   ColorDialog.CustomColors.Add('Current=' + IntToHex(ColorToRGB(AColor), 6));
  889.  
  890.   if (ColorDialog.Execute) then
  891.   begin
  892.     AColor := ColorDialog.Color;
  893.     InputColor := TRUE;
  894.   end;
  895.   ColorDialog.Free;
  896. end;
  897.  
  898. {------------------------------------------------------------------------------
  899.     Procedure: SetDialogGeometry
  900.   Description: sets the dialog Geometry under Windows and Linux
  901.       Authors: Mat Ballard
  902.  Date created: 04/03/2001
  903. Date modified: 04/03/2001 by Mat Ballard
  904.       Purpose: Dialog Geometry control
  905.  Known Issues: an alternative approach is:
  906.  
  907.   Scaled := FALSE;
  908.   AutoScroll := FALSE;
  909. // DESIGNSCREENWIDTHPIX is a constant depending on the width at design time, eg: 1024
  910.   ScaleBy(Screen.Width, DESIGNSCREENWIDTHPIX);
  911.  ------------------------------------------------------------------------------}
  912. procedure SetDialogGeometry(AForm: TForm; AButton: TControl; BorderWidth: Integer);
  913. begin
  914. {$IFDEF MSWINDOWS}
  915.   {AForm.PixelsPerInch := 96;}
  916.   AForm.BorderStyle := bsDialog;
  917. {$ENDIF}
  918. {$IFDEF LINUX}
  919.   {AForm.PixelsPerInch := 75;}
  920.   AForm.BorderStyle := fbsDialog;
  921. {$ENDIF}
  922.   AForm.Scaled := FALSE;
  923.   AForm.HorzScrollBar.Visible := FALSE;
  924.   AForm.VertScrollBar.Visible := FALSE;
  925.  
  926.   AForm.Left := 10;
  927.   AForm.Top := 10;
  928.   AForm.ClientHeight := AButton.Top + 3 * AButton.Height div 2;
  929.   AForm.ClientWidth := AButton.Left + AButton.Width + BorderWidth;
  930. end;
  931.  
  932.  
  933. {------------------------------------------------------------------------------}
  934. function BinToInt(Value: String): {$IFDEF DELPHI1}Longint{$ELSE}{$IFDEF BCB}Longint{$ELSE}Longword{$ENDIF}{$ENDIF};
  935. var
  936.   i: Integer;
  937.   Pow2,
  938.   TheResult: {$IFDEF DELPHI1}Longint{$ELSE}{$IFDEF BCB}Longint{$ELSE}Longword{$ENDIF}{$ENDIF};
  939. begin
  940.   Pow2 := 1;
  941.   TheResult := 0;
  942.   for i := 1 to Length(Value) do
  943.   begin
  944.     if (Value[i] = '1') then
  945.       TheResult := TheResult + Pow2;
  946.     Pow2 := Pow2 shl 1;
  947.   end;
  948.   BinToInt := TheResult;
  949. end;
  950.  
  951. function IntToBin(Value: {$IFDEF DELPHI1}Longint{$ELSE}{$IFDEF BCB}Longint{$ELSE}Longword{$ENDIF}{$ENDIF}): string;
  952. var
  953.   i: Integer;
  954.   StrResult: String;
  955.  
  956. {$IFDEF DELPHI1}
  957.   function LTrim(Const Str: String): String;
  958.   var
  959.     len: Byte absolute Str;
  960.     i: Integer;
  961.   begin
  962.     i := 1;
  963.     while (i <= len) and (Str[i] = ' ') do Inc(i);
  964.     LTrim := Copy(Str,i,len)
  965.   end ;
  966. {$ENDIF}
  967.  
  968. begin
  969.   i := 1;
  970. {$IFDEF DELPHI1}
  971.   StrResult := '                                ';
  972. {$ELSE}
  973.   SetLength(StrResult, 32);
  974. {$ENDIF}
  975.   repeat
  976.     if ((Value and 1) > 0) then
  977.       StrResult[i] := '1'
  978.      else
  979.       StrResult[i] := '0';
  980.     Value := Value shr 1;
  981.     Inc(i);
  982.   until (Value = 0);
  983. {$IFDEF DELPHI1}
  984.   StrResult := LTrim(StrResult);
  985. {$ELSE}
  986.   SetLength(StrResult, i-1);
  987. {$ENDIF}
  988.   StrResult := StrRev(StrResult);
  989.  
  990.   IntToBin := StrResult;
  991. end;
  992.  
  993. function IsInteger(Value: String): Boolean;
  994. var
  995.   i: Integer;
  996.   TheStart: Integer;
  997. begin
  998.   Result := FALSE;
  999.   TheStart := 1;
  1000.   if (Value[1] = '-') then
  1001.     TheStart := 2;
  1002.  
  1003.   for i := TheStart to Length(Value) do
  1004.   begin
  1005.     if ((Value[i] < '0') or
  1006.         (Value[i] > '9')) then
  1007.       exit;
  1008.   end;
  1009.   Result := TRUE;
  1010. end;
  1011.  
  1012. function IsFixed(Value: String): Boolean;
  1013. var
  1014.   i: Integer;
  1015.   TheStart: Integer;
  1016.   DotCount: Integer;
  1017. begin
  1018.   Result := FALSE;
  1019.   TheStart := 1;
  1020.   DotCount := 0;
  1021.  
  1022.   if (Value[1] = '-') then
  1023.     TheStart := 2;
  1024.  
  1025.   for i := TheStart to Length(Value) do
  1026.   begin
  1027.     if ((Value[i] < '0') or
  1028.         (Value[i] > '9')) then
  1029.       if (Value[i] = '.') then
  1030.       begin
  1031.         Inc(DotCount);
  1032.         if (DotCount > 1) then
  1033.           exit;
  1034.       end
  1035.       else
  1036.       begin
  1037.         exit;
  1038.       end;
  1039.   end;
  1040.   Result := TRUE;
  1041. end;
  1042.  
  1043. function IsReal(Value: String): Boolean;
  1044. var
  1045.   i: Integer;
  1046.   TheStart: Integer;
  1047.   DotCount: Integer;
  1048.   ECount: Integer;
  1049.   NegCount: Integer;
  1050. begin
  1051.   Result := FALSE;
  1052.  
  1053.   if (Length(Value) = 0) then
  1054.     exit;
  1055.  
  1056.   TheStart := 1;
  1057.   DotCount := 0;
  1058.   ECount := 0;
  1059.   NegCount := 0;
  1060.  
  1061.   if (Value[1] = '-') then
  1062.     TheStart := 1;
  1063.  
  1064.   for i := TheStart to Length(Value) do
  1065.   begin
  1066.     if ((Value[i] < '0') or
  1067.         (Value[i] > '9')) then
  1068.       if (Value[i] = '.') then
  1069.       begin
  1070.         Inc(DotCount);
  1071.         if (DotCount > 1) then
  1072.           exit;
  1073.       end
  1074.       else if (Value[i] = '-') then
  1075.       begin
  1076.         Inc(NegCount);
  1077.         if (NegCount > 1) then
  1078.           exit;
  1079.         if (Value[i-1] <> 'E') then
  1080.           exit;
  1081.       end
  1082.       else if ((Value[i] = 'e') or (Value[i] = 'E')) then
  1083.       begin
  1084.         Inc(ECount);
  1085.         if (ECount > 1) then
  1086.           exit;
  1087.         if(i = Length(Value)) then
  1088.           exit;
  1089.         Value[i] := 'E';
  1090.       end  
  1091.       else
  1092.       begin
  1093.         exit;
  1094.       end;
  1095.   end;
  1096.   Result := TRUE;
  1097. end;
  1098.  
  1099.  
  1100. {$IFDEF DELPHI1}
  1101. function GetCurrentDir: String;
  1102. var
  1103.   ThisDir: String;
  1104. begin
  1105.   GetDir(0, ThisDir);
  1106. end;
  1107. {$ENDIF}
  1108.  
  1109. {------------------------------------------------------------------------------
  1110.     Procedure: TextOutAngle
  1111.   Description: draws text on the input canvas, at an angle
  1112.       Authors: Borland Developer Support Staff (Creating a rotated font, FAQ615D.txt), modified by Mat Ballard
  1113.  Date created: 02/15/2001
  1114. Date modified: 02/15/2001 by Mat Ballard
  1115.       Purpose: Vertical and angular fonts
  1116.  Known Issues: ACanvas.Font remains rotated until re-assigned ?
  1117.  ------------------------------------------------------------------------------}
  1118. {$IFDEF MSWINDOWS}
  1119. procedure TextOutAnglePersist(
  1120.   ACanvas: TCanvas;
  1121.   Angle, Left, Top: Integer;
  1122.   TheText: String);
  1123. var
  1124.   lf: TLogFont;
  1125.   tf: TFont;
  1126. begin
  1127.   tf := TFont.Create;
  1128.   tf.Assign(ACanvas.Font);
  1129.   GetObject(tf.Handle, sizeof(lf), @lf);
  1130.   lf.lfEscapement := 10*Angle;;
  1131.   lf.lfOrientation := lf.lfEscapement;
  1132.   tf.Handle := CreateFontIndirect(lf);
  1133.   ACanvas.Font.Assign(tf);
  1134.   tf.Free;
  1135.   ACanvas.TextOut(Left, Top, TheText);
  1136. end;
  1137. {$ENDIF}
  1138.  
  1139. {------------------------------------------------------------------------------
  1140.     Procedure: TextOutAngle
  1141.   Description: draws angled text on the input canvas
  1142.       Authors: Mat Ballard
  1143.  Date created: 04/15/2000
  1144. Date modified: 04/15/2000 by Mat Ballard
  1145.       Purpose: Vertical fonts
  1146.  Known Issues: derived from the very early GPC work;
  1147.                ACanvas.Font does not remain rotated
  1148.                Note: Angle of rotation is Anti-Clockwise in Winxx,
  1149.                Clockwise in Qt/Linux
  1150.  ------------------------------------------------------------------------------}
  1151. procedure TextOutAngle(
  1152.   ACanvas: TCanvas;
  1153.   Angle, Left, Top: Integer;
  1154.   TheText: String);
  1155. {$IFDEF MSWINDOWS}
  1156. var
  1157.   LogRec: TLogFont;
  1158.   OldFontHandle, NewFontHandle: hFont;
  1159. {$ENDIF}
  1160. begin
  1161. {$IFDEF MSWINDOWS}
  1162. {Gotta use Windows GDI functions to rotate the font:}
  1163.   GetObject(ACanvas.Font.Handle, SizeOf(LogRec), Addr(LogRec));
  1164.   LogRec.lfEscapement := 10*Angle;
  1165.   LogRec.lfOrientation := LogRec.lfEscapement;
  1166.   NewFontHandle := {Windows.}CreateFontIndirect(LogRec);
  1167. {select the new font:}
  1168.   OldFontHandle := {Windows.}SelectObject(ACanvas.Handle, NewFontHandle);
  1169. {Print the text:}
  1170.   ACanvas.TextOut(Left, Top, TheText);
  1171. {go back to original font:}
  1172.   NewFontHandle := {Windows.}SelectObject(ACanvas.Handle, OldFontHandle);
  1173. {and delete the old one:}
  1174.   DeleteObject(NewFontHandle);
  1175. {$ENDIF}
  1176.  
  1177. {$IFDEF LINUX}
  1178. {this code is courtesy of Jon Shemitz <jon@midnightbeach.com>}
  1179. {Outside of a Paint handler, bracket QPainter_ calls with a Start/Stop}
  1180.   ACanvas.Start;
  1181.   try
  1182.     Qt.QPainter_save(ACanvas.Handle);
  1183. {Move 0,0 to the center of the form}
  1184.     Qt.QPainter_translate(ACanvas.Handle, Left, Top);
  1185. {Rotate; note negative angle:}
  1186.     QPainter_rotate(ACanvas.Handle, -Angle);
  1187.     ACanvas.TextOut(0, 0, TheText);
  1188.   finally
  1189.     Qt.QPainter_restore(ACanvas.Handle);
  1190.     ACanvas.Stop;
  1191.   end;
  1192. {$ENDIF}
  1193. end;
  1194.  
  1195. {------------------------------------------------------------------------------
  1196.     Procedure: ShellExec
  1197.   Description: wrapper for the windows "ShellExecute" API call, extended to Linux
  1198.       Authors: Mat Ballard
  1199.  Date created: 04/15/2000
  1200. Date modified: 03/28/2001 by Mat Ballard
  1201.       Purpose: Execute an external program with arguments
  1202.  Known Issues: does not cope properly with spaces in arguments (eg: "My File.txt")
  1203.  ------------------------------------------------------------------------------}
  1204. procedure ShellExec(Cmd: String);
  1205. {$IFDEF WINDOWS} {Delphi 1}
  1206. var
  1207.   sObjectPath: array[0..1023] of Char;
  1208. {$ENDIF}
  1209. begin
  1210. {$IFDEF WINDOWS} {Delphi 1}
  1211.   StrPCopy(sObjectPath, Cmd);
  1212.   ShellExecute(0, Nil, sObjectPath, Nil, Nil, 3);  {?SW_SHOW ?}
  1213. {$ENDIF}
  1214. {$IFDEF WIN32}
  1215.   ShellExecute(0, Nil, PChar(Cmd), Nil, Nil, SW_NORMAL);
  1216. {$ENDIF}
  1217. {$IFDEF LINUX}
  1218. {Fire command; add a ' &' to continue immediately:}
  1219.   Libc.system(PChar(Cmd));
  1220. {$ENDIF}
  1221. end;
  1222.  
  1223. {------------------------------------------------------------------------------
  1224.     Procedure: ShowHTML
  1225.   Description: shows a html file
  1226.       Authors: Mat Ballard
  1227.  Date created: 06/06/2001
  1228. Date modified: 06/06/2001 by Mat Ballard
  1229.       Purpose:
  1230.  Known Issues: 
  1231.  ------------------------------------------------------------------------------}
  1232. procedure ShowHTML(Cmd: String);
  1233. {$IFDEF WINDOWS} {Delphi 1}
  1234. var
  1235.   sObjectPath: array[0..1023] of Char;
  1236. {$ENDIF}
  1237. {$IFDEF LINUX}
  1238. var
  1239.   TheBrowser: String;
  1240. {$ENDIF}
  1241. begin
  1242. {$IFDEF WINDOWS} {Delphi 1}
  1243.   StrPCopy(sObjectPath, Cmd);
  1244.   ShellExecute(0, Nil, sObjectPath, Nil, Nil, 3);  {?SW_SHOW ?}
  1245. {$ENDIF}
  1246. {$IFDEF WIN32}
  1247.   ShellExecute(0, Nil, PChar(Cmd), Nil, Nil, SW_NORMAL);
  1248. {$ENDIF}
  1249. {$IFDEF LINUX}
  1250.   TheBrowser := GetBrowser;
  1251. {the ' &' means immediately continue:}
  1252.   if (Length(TheBrowser) > 0) then
  1253.     Libc.system(PChar(TheBrowser + ' ' + Cmd + ' &'));
  1254. {$ENDIF}
  1255. end;
  1256.  
  1257. {------------------------------------------------------------------------------
  1258.     Procedure: DoMail
  1259.   Description: drops an email address to the users mail program
  1260.       Authors: Mat Ballard
  1261.  Date created: 06/06/2001
  1262. Date modified: 06/06/2001 by Mat Ballard
  1263.       Purpose:
  1264.  Known Issues:
  1265.  ------------------------------------------------------------------------------}
  1266. procedure DoMail(Cmd: String);
  1267. {$IFDEF WINDOWS} {Delphi 1}
  1268. var
  1269.   sObjectPath: array[0..1023] of Char;
  1270. {$ENDIF}
  1271. {$IFDEF LINUX}
  1272. var
  1273.   TheMailer: String;
  1274. {$ENDIF}
  1275. begin
  1276. {$IFDEF WINDOWS} {Delphi 1}
  1277.   StrPCopy(sObjectPath, Cmd);
  1278.   ShellExecute(0, Nil, sObjectPath, Nil, Nil, 3);  {?SW_SHOW ?}
  1279. {$ENDIF}
  1280. {$IFDEF WIN32}
  1281.   ShellExecute(0, Nil, PChar(Cmd), Nil, Nil, SW_NORMAL);
  1282. {$ENDIF}
  1283. {$IFDEF LINUX}
  1284.   TheMailer := GetMailer;
  1285.   if (Length(TheMailer) > 0) then
  1286. {the ' &' means immediately continue:}
  1287.     Libc.system(PChar(TheMailer + ' ' + Cmd + ' &'));
  1288. {$ENDIF}
  1289. end;
  1290.  
  1291. {------------------------------------------------------------------------------
  1292.      Function: CheckForRPM
  1293.   Description: checks for the existence of the AnRPM program
  1294.       Authors: Mat Ballard
  1295.  Date created: 06/06/2001
  1296. Date modified: 06/06/2001 by Mat Ballard
  1297.       Purpose: help, mail and html management
  1298.  Known Issues:
  1299.  ------------------------------------------------------------------------------}
  1300. {$IFDEF LINUX}
  1301. function CheckForRPM(AnRPM: String): String;
  1302. var
  1303.   TmpFile: TStringList;
  1304. begin
  1305.   Result := '';
  1306.   TmpFile := TStringList.Create;
  1307.   Libc.system(PChar('rpm -ql ' + AnRPM + ' > ' + sFileName));
  1308.   TmpFile.LoadFromFile(sFileName);
  1309.   if (Length(TmpFile.Strings[0]) > 0) then
  1310.     if (Pos(sNotInstalled, TmpFile.Strings[0]) = 0) then
  1311.       Result := TmpFile.Strings[0];
  1312.   DeleteFile(sFileName);
  1313.   TmpFile.Free;
  1314. end;
  1315.  
  1316. {$ENDIF}
  1317.  
  1318.  
  1319. {------------------------------------------------------------------------------
  1320.      Function: GetBrowser
  1321.   Description: gets the user's prefered browser in Linux
  1322.       Authors: Mat Ballard
  1323.  Date created: 06/06/2001
  1324. Date modified: 06/06/2001 by Mat Ballard
  1325.       Purpose: help and html management
  1326.  Known Issues:
  1327.  ------------------------------------------------------------------------------}
  1328. {$IFDEF LINUX}
  1329. function GetBrowser: String;
  1330. var
  1331.   Index: Integer;
  1332.   AProgram,
  1333.   ExeName: String;
  1334.   OptionsDlg: TOptionsDlg;
  1335. begin
  1336. {Get the $BROWSER environment variable:}
  1337.   ExeName := getenv('BROWSER');
  1338.   if (Length(ExeName) = 0) then
  1339.   begin
  1340. {Get the various possible browsers:}
  1341.     OptionsDlg := TOptionsDlg.Create(nil);
  1342.     OptionsDlg.FormTitle := sBrowser + ' ' + sSelection;
  1343.     OptionsDlg.Question := sWhich + ' ' + sWebBrowser + ' ' + sProgramToUse;
  1344.     if (FileExists('/usr/bin/konqueror')) then
  1345.     begin
  1346.       OptionsDlg.OptionList.Add('/usr/bin/konqueror');
  1347.     end;
  1348.     AProgram := CheckForRPM('mozilla');
  1349.     if (Length(AProgram) > 0) then
  1350.       OptionsDlg.OptionList.Add(AProgram);
  1351.     AProgram := CheckForRPM('netscape-common');
  1352.     if (Length(AProgram) > 0) then
  1353.       OptionsDlg.OptionList.Add(AProgram);
  1354.     AProgram := CheckForRPM('opera');
  1355.     if (Length(AProgram) > 0) then
  1356.       OptionsDlg.OptionList.Add(AProgram);
  1357.     AProgram := CheckForRPM('lynx');
  1358.     if (Length(AProgram) > 0) then
  1359.       OptionsDlg.OptionList.Add(AProgram);
  1360.     AProgram := CheckForRPM('links');
  1361.     if (Length(AProgram) > 0) then
  1362.       OptionsDlg.OptionList.Add(AProgram);
  1363.  
  1364.     Index := OptionsDlg.Execute - 1;
  1365.  
  1366.     if (Index >= 0) then
  1367.     begin
  1368.       ExeName := OptionsDlg.OptionList.Strings[Index];
  1369.       Libc.putenv(PChar('BROWSER=' + ExeName));
  1370.     end;
  1371.  
  1372.     OptionsDlg.Free;
  1373.   end;
  1374.   Result := ExeName;
  1375. end;
  1376. {$ENDIF}
  1377.  
  1378. {------------------------------------------------------------------------------
  1379.      Function: GetMailer
  1380.   Description: gets the user's prefered Mailer in Linux
  1381.       Authors: Mat Ballard
  1382.  Date created: 06/06/2001
  1383. Date modified: 06/06/2001 by Mat Ballard
  1384.       Purpose: help and html management
  1385.  Known Issues:
  1386.  ------------------------------------------------------------------------------}
  1387. {$IFDEF LINUX}
  1388. function GetMailer: String;
  1389. var
  1390.   Index: Integer;
  1391.   AProgram,
  1392.   ExeName: String;
  1393.   OptionsDlg: TOptionsDlg;
  1394. begin
  1395. {Get the $MAILER environment variable:}
  1396.   ExeName := getenv('MAILER');
  1397.   if (Length(ExeName) = 0) then
  1398.   begin
  1399. {Get the various possible browsers:}
  1400.     OptionsDlg := TOptionsDlg.Create(nil);
  1401.     OptionsDlg.FormTitle := sMailer + ' ' + sSelection;
  1402.     OptionsDlg.Question := sWhich + ' ' + sEmail + ' ' + sProgramToUse;
  1403.     AProgram := CheckForRPM('mozilla');
  1404.     if (Length(AProgram) > 0) then
  1405.       OptionsDlg.OptionList.Add(AProgram);
  1406.     AProgram := CheckForRPM('netscape-common');
  1407.     if (Length(AProgram) > 0) then
  1408.       OptionsDlg.OptionList.Add(AProgram);
  1409.     AProgram := CheckForRPM('mailx');
  1410.     if (Length(AProgram) > 0) then
  1411.       OptionsDlg.OptionList.Add(AProgram);
  1412.     AProgram := CheckForRPM('pine');
  1413.     if (Length(AProgram) > 0) then
  1414.       OptionsDlg.OptionList.Add(AProgram);
  1415.  
  1416.     Index := OptionsDlg.Execute - 1;
  1417.  
  1418.     if (Index >= 0) then
  1419.     begin
  1420.       ExeName := OptionsDlg.OptionList.Strings[Index];
  1421.       Libc.putenv(PChar('MAILER=' + ExeName));
  1422.     end;
  1423.  
  1424.     OptionsDlg.Free;
  1425.   end;
  1426.   Result := ExeName;
  1427. end;
  1428. {$ENDIF}
  1429.  
  1430. {------------------------------------------------------------------------------
  1431.      Function: DoHTMLHelp
  1432.   Description: displays a topic from a HTML-based help website
  1433.        Author: Mat Ballard
  1434.  Date created: 05/10/2001
  1435. Date modified: 05/10/2001 by Mat Ballard
  1436.       Purpose: help management
  1437.  Return Value: Boolean
  1438.  Known Issues:
  1439.  ------------------------------------------------------------------------------}
  1440. {$IFDEF LINUX}
  1441. procedure DoHTMLHelp(
  1442.   HelpType: THelpType;
  1443.   HelpContext: Integer;
  1444.   HelpKeyword: string;
  1445.   HelpFile: string;
  1446.   var Handled: Boolean);
  1447. var
  1448.   MyHTMLHelpTopicFile: String;
  1449.   HelpPath: String;
  1450.   TheBrowser: String;
  1451. begin
  1452.   Handled := FALSE;
  1453.   HelpPath := ExtractFilePath(HelpFile);
  1454.   MyHTMLHelpTopicFile := HelpPath + 'hs' + IntToStr(HelpContext) + '.htm';
  1455.   if FileExists(MyHTMLHelpTopicFile) then
  1456.   begin
  1457.     TheBrowser := GetBrowser;
  1458.     if (Length(TheBrowser) > 0) then
  1459.     begin
  1460. {the ' &' means immediately continue:}
  1461.       ShellExec(TheBrowser + ' ' + MyHTMLHelpTopicFile + ' &');
  1462.       Handled := TRUE;
  1463.     end;
  1464.   end;
  1465. end;
  1466. {$ENDIF}
  1467.  
  1468. end.
  1469.