rm_jvjclutils.pas

这是一个功能强大

{-----------------------------------------------------------------------------
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
http://www.mozilla.org/MPL/MPL-1.1.html

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.

The Original Code is: rm_JvJCLUtils.pas, released on 2002-07-04.

The Initial Developers of the Original Code are: Andrei Prygounkov <a dott prygounkov att gmx dott de>
Copyright (c) 1999, 2002 Andrei Prygounkov
All Rights Reserved.

Contributor(s):
  Andreas Hausladen
  Ralf Kaiser
  Vladimir Gaitanoff
  Dejoy den

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Known Issues:

-----------------------------------------------------------------------------}
// $Id: rm_JvJCLUtils.pas 10302 2006-02-25 17:51:39Z ahuser $

// (ahuser) No dependency on JCL units. Required functions are emulated.
{$DEFINE NO_JCL}

unit rm_JvJCLUtils;

{$I rm_jvcl.inc}
{$I rm_crossplatform.inc}

interface

// (p3) note: this unit should only contain JCL compatible routines (no Forms etc)
// and no JVCL units!
// (ahuser) Unfortunately the QGraphics unit imports the QForms unit. Because
//          the JCL has the same problem with CLX it should not make any difference.

uses
  {$IFDEF UNITVERSIONING}
  rm_JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  {$IFDEF MSWINDOWS}
  Windows, Messages, ShlObj, ActiveX,
  {$ENDIF MSWINDOWS}
  {$IFDEF CLR}
  Types, System.Text, System.Security, System.IO, System.Threading,
  System.Reflection, System.Diagnostics, System.Runtime.InteropServices,
  {$ENDIF CLR}
  {$IFDEF HAS_UNIT_LIBC}
  Libc,
  {$ENDIF HAS_UNIT_LIBC}
  {$IFDEF UNIX}
  Xlib,
  {$ENDIF UNIX}
  {$IFDEF HAS_UNIT_VARIANTS}
  Variants,
  {$ENDIF HAS_UNIT_VARIANTS}
  SysUtils, Classes, Contnrs, Graphics, Clipbrd, Controls,
  {$IFDEF HAS_UNIT_STRUTILS}
  StrUtils,
  {$ENDIF HAS_UNIT_STRUTILS}
  {$IFDEF VisualCLX}
  Qt, QWindows, QStdCtrls,
  {$ENDIF VisualCLX}
  TypInfo,
  rm_JvTypes, rm_JvVCL5Utils;

const
  {$IFDEF MSWINDOWS}
  PathDelim = '\';
  DriveDelim = ':';
  PathSep = ';';
  AllFilesMask = '*.*';
  {$ENDIF MSWINDOWS}
  {$IFDEF UNIX}
  PathDelim = '/';
  AllFilesMask = '*';
  {$ENDIF UNIX}

  {$IFDEF VisualCLX}
  NullHandle = nil;
  {$ELSE}   // Note: the else is on purpose, VCL is not defined for a console application
  NullHandle = 0;
  {$ENDIF VisualCLX}

{$IFDEF UNIX}
type
  TFileTime = Integer;
{$ENDIF UNIX}


function SendRectMessage(Handle: THandle; Msg: Integer; wParam: WPARAM; var R: TRect): Integer;
function SendStructMessage(Handle: THandle; Msg: Integer; wParam: WPARAM; var Data): Integer;
{$IFDEF CLR}
function VarFromDateTime(const Value: TDateTime): Variant;
function VarToDateTime(const Value: Variant): TDateTime;

function SucceededCom(out Intf; Value: TObject): Boolean;

function GetPrivateField(Instance: TObject; const FieldName: string): TObject;
procedure SetPrivateField(Instance: TObject; const FieldName: string; Value: TObject);
procedure SetProtectedObjectEvent(Instance: TObject; const EventName: string; Ev: Delegate);
function GetProtectedObjectEvent(Instance: TObject; const EventName: string): Delegate;

[SuppressUnmanagedCodeSecurity, DllImport(user32, CharSet = CharSet.Auto, SetLastError = True, EntryPoint = 'SystemParametersInfo')]
function SystemParametersInfo(uiAction, uiParam: UINT;
  var pvParam: TNonClientMetrics; fWinIni: UINT): BOOL; overload; external;

{ These EnumFontFamilies and EnumFonts declarations are modified versions that
  allow to specify an Object as Param value. They are used for .NET exclusivly. }
type
  TFNFontEnumObjProc = function ([in] var logfont: TLogFont;
    [in] var textmetric: TTextMetric; dword: DWORD; lparam: TObject): Integer;
  TFNFontEnum2ObjProc = function ([in] var logfont: TEnumLogFont;
    [in] var textmetric: TNewTextMetric; FontType: DWORD; lParam: TObject): Integer;

[SuppressUnmanagedCodeSecurity, DllImport(gdi32, CharSet = CharSet.Auto, SetLastError = True, EntryPoint = 'EnumFontFamilies')]
function EnumFontFamilies(DC: HDC; p2: string; p3: TFNFontEnumObjProc; p4: TObject): BOOL; overload; external;
[SuppressUnmanagedCodeSecurity, DllImport(gdi32, CharSet = CharSet.Auto, SetLastError = True, EntryPoint = 'EnumFontFamilies')]
function EnumFontFamilies(DC: HDC; p2: IntPtr; p3: TFNFontEnumObjProc; p4: TObject): BOOL; overload; external;
[SuppressUnmanagedCodeSecurity, DllImport(gdi32, CharSet = CharSet.Auto, SetLastError = True, EntryPoint = 'EnumFontFamilies')]
function EnumFontFamilies2(DC: HDC; p2: string; p3: TFNFontEnum2ObjProc; p4: TObject): BOOL; overload; external;
[SuppressUnmanagedCodeSecurity, DllImport(gdi32, CharSet = CharSet.Auto, SetLastError = True, EntryPoint = 'EnumFontFamilies')]
function EnumFontFamilies2(DC: HDC; p2: IntPtr; p3: TFNFontEnum2ObjProc; p4: TObject): BOOL; overload; external;

[SuppressUnmanagedCodeSecurity, DllImport(gdi32, CharSet = CharSet.Auto, SetLastError = True, EntryPoint = 'EnumFonts')]
function EnumFonts(DC: HDC; lpszFace: string; fntenmprc: TFNFontEnumObjProc;
  LParam: TObject): Integer; overload; external;
[SuppressUnmanagedCodeSecurity, DllImport(gdi32, CharSet = CharSet.Auto, SetLastError = True, EntryPoint = 'EnumFonts')]
function EnumFonts(DC: HDC; lpszFace: IntPtr; fntenmprc: TFNFontEnumObjProc;
  LParam: TObject): Integer; overload; external;

function AnsiLastChar(const S: string): Char;
{$ENDIF CLR}

function ReadCharsFromStream(Stream: TStream; var Buf: array of Char; BufSize: Integer): Integer; // ANSI-Stream
function WriteStringToStream(Stream: TStream; const Buf: string; BufSize: Integer): Integer; // ANSI-Stream

const
  DefaultDateOrder = doDMY;
  CenturyOffset: Byte = 60;
  NullDate: TDateTime = {-693594} 0;

function USToLocalFloatStr(const Text: string): string;
function StrToFloatUS(const Text: string): Extended;
// StrToFloatUS uses US '.' as decimal seperator and ',' as thousand separator
function StrToFloatUSDef(const Text: string; Default: Extended): Extended;

function VarIsInt(Value: Variant): Boolean;
 // VarIsInt returns VarIsOrdinal-[varBoolean]

{ PosIdx returns the index of the first appearance of SubStr in Str. The search
  starts at index "Index". }
function PosIdx(const SubStr, S: string; Index: Integer = 0): Integer;
{$IFNDEF CLR}
function PosIdxW(const SubStr, S: WideString; Index: Integer = 0): Integer;
{$ENDIF !CLR}
function PosLastCharIdx(Ch: Char; const S: string; Index: Integer = 0): Integer;

{ GetWordOnPos returns Word from string, S, on the cursor position, P}
function GetWordOnPos(const S: string; const P: Integer): string;
function GetWordOnPosW(const S: WideString; const P: Integer): WideString;
function GetWordOnPos2(const S: string; P: Integer; var iBeg, iEnd: Integer): string;
function GetWordOnPos2W(const S: WideString; P: Integer; var iBeg, iEnd: Integer): WideString;
{ GetWordOnPosEx working like GetWordOnPos function, but
  also returns Word position in iBeg, iEnd variables }
function GetWordOnPosEx(const S: string; const P: Integer; var iBeg, iEnd: Integer): string;
function GetWordOnPosExW(const S: WideString; const P: Integer; var iBeg, iEnd: Integer): WideString;
function GetNextWordPosEx(const Text: string; StartIndex: Integer;
  var iBeg, iEnd: Integer): string;
function GetNextWordPosExW(const Text: WideString; StartIndex: Integer;
  var iBeg, iEnd: Integer): WideString;
procedure GetEndPosCaret(const Text: string; CaretX, CaretY: Integer;
  var X, Y: Integer);
{ GetEndPosCaret returns the caret position of the last char. For the position
  after the last char of Text you must add 1 to the returned X value. }
procedure GetEndPosCaretW(const Text: WideString; CaretX, CaretY: Integer;
  var X, Y: Integer);
{ GetEndPosCaret returns the caret position of the last char. For the position
  after the last char of Text you must add 1 to the returned X value. }

{ SubStrBySeparator returns substring from string, S, separated with Separator string}
function SubStrBySeparator(const S: string; const Index: Integer; const Separator: string; StartIndex: Integer = 1): string;
{$IFNDEF CLR}
function SubStrBySeparatorW(const S: WideString; const Index: Integer; const Separator: WideString; StartIndex: Integer = 1): WideString;
{$ENDIF !CLR}
{ SubStrEnd same to previous function but Index numerated from the end of string }
//function SubStrEnd(const S: string; const Index: Integer; const Separator: string): string;
{ SubWord returns next Word from string, P, and offsets Pointer to the end of Word, P2 }
{$IFDEF CLR}
function SubWord(P: string; var P2: string): string;
{$ELSE}
function SubWord(P: PChar; var P2: PChar): string;
{$ENDIF CLR}
//  function CurrencyByWord(Value: Currency): string;
{ GetLineByPos returns the Line number, there
  the symbol Pos is pointed. Lines separated with #13 symbol }
function GetLineByPos(const S: string; const Pos: Integer): Integer;
{ GetXYByPos is same as GetLineByPos, but returns X position in line as well}
procedure GetXYByPos(const S: string; const Pos: Integer; var X, Y: Integer);
procedure GetXYByPosW(const S: WideString; const Pos: Integer; var X, Y: Integer);
{ ReplaceString searches for all substrings, OldPattern,
  in a string, S, and replaces them with NewPattern }
function ReplaceString(S: string; const OldPattern, NewPattern: string; StartIndex: Integer = 1): string;
{$IFNDEF CLR}
function ReplaceStringW(S: WideString; const OldPattern, NewPattern: WideString; StartIndex: Integer = 1): WideString;
{$ENDIF !CLR}
{ ConcatSep concatenate S1 and S2 strings with Separator.
  if S = '' then separator not included }
function ConcatSep(const S1, S2, Separator: string): string; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE}
{ ConcatLeftSep is same to previous function, but
  strings concatenate right to left }
function ConcatLeftSep(const S1, S2, Separator: string): string; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE}

{ Next 4 function for russian chars transliterating.
  This functions are needed because Oem2Ansi and Ansi2Oem functions
  sometimes suck }
procedure Dos2Win(var S: string);
procedure Win2Dos(var S: string);
function Dos2WinRes(const S: string): string; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE}
function Win2DosRes(const S: string): string; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE}
function Win2Koi(const S: string): string;

{ FillString fills the string Buffer with Count Chars }
procedure FillString(var Buffer: string; Count: Integer; const Value: Char); overload;
procedure FillString(var Buffer: string; StartIndex, Count: Integer; const Value: Char); overload;
{ MoveString copies Count Chars from Source to Dest }
procedure MoveString(const Source: string; var Dest: string; Count: Integer); {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} overload;
procedure MoveString(const Source: string; SrcStartIdx: Integer; var Dest: string;
  DstStartIdx: Integer; Count: Integer); {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE} overload;
{$IFNDEF CLR}
{ FillWideChar fills Buffer with Count WideChars (2 Bytes) }
procedure FillWideChar(var Buffer; Count: Integer; const Value: WideChar);
{ MoveWideChar copies Count WideChars from Source to Dest }
procedure MoveWideChar(const Source; var Dest; Count: Integer); {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF SUPPORTS_INLINE}
{$ENDIF !CLR}
{ IsSubString() compares the sub string to the string. Indices are 1th based. }
function IsSubString(const S: string; StartIndex: Integer; const SubStr: string): Boolean;

{ Spaces returns string consists on N space chars }
function Spaces(const N: Integer): string;
{ AddSpaces adds spaces to string S, if its Length is smaller than N }
function AddSpaces(const S: string; const N: Integer): string;
{$IFNDEF CLR}
function SpacesW(const N: Integer): WideString;
function AddSpacesW(const S: WideString; const N: Integer): WideString;
{$ENDIF !CLR}
{ function LastDateRUS for russian users only }
{ returns date relative to current date: '溻