Global clean:
* Refactoring * Code formating - Removed many old defines... git-svn-id: https://svn.code.sf.net/p/kolmck/code@162 91bb2d04-0c0c-4d2d-88a5-bbb6f4c1fa07
This commit is contained in:
dkolmck
@@ -130,7 +130,6 @@
|
|||||||
{$DEFINE PAS_VERSION}
|
{$DEFINE PAS_VERSION}
|
||||||
{$DEFINE PAS_ONLY}
|
{$DEFINE PAS_ONLY}
|
||||||
{.$DEFINE UNICODE_CTRLS}
|
{.$DEFINE UNICODE_CTRLS}
|
||||||
{$DEFINE STREAM_LARGE64}
|
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
{$WARN UNIT_DEPRECATED OFF}
|
{$WARN UNIT_DEPRECATED OFF}
|
||||||
{.$WARN SYMBOL_PLATFORM OFF}
|
{.$WARN SYMBOL_PLATFORM OFF}
|
||||||
@@ -155,7 +154,6 @@
|
|||||||
{$DEFINE PAS_VERSION}
|
{$DEFINE PAS_VERSION}
|
||||||
{$DEFINE PAS_ONLY}
|
{$DEFINE PAS_ONLY}
|
||||||
{.$DEFINE UNICODE_CTRLS}
|
{.$DEFINE UNICODE_CTRLS}
|
||||||
{$DEFINE STREAM_LARGE64}
|
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
{$WARN UNIT_DEPRECATED OFF}
|
{$WARN UNIT_DEPRECATED OFF}
|
||||||
{.$WARN SYMBOL_PLATFORM OFF}
|
{.$WARN SYMBOL_PLATFORM OFF}
|
||||||
@@ -181,7 +179,6 @@
|
|||||||
{$DEFINE PAS_VERSION}
|
{$DEFINE PAS_VERSION}
|
||||||
{$DEFINE PAS_ONLY}
|
{$DEFINE PAS_ONLY}
|
||||||
{.$DEFINE UNICODE_CTRLS}
|
{.$DEFINE UNICODE_CTRLS}
|
||||||
{$DEFINE STREAM_LARGE64}
|
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
{$WARN UNIT_DEPRECATED OFF}
|
{$WARN UNIT_DEPRECATED OFF}
|
||||||
{.$WARN SYMBOL_PLATFORM OFF}
|
{.$WARN SYMBOL_PLATFORM OFF}
|
||||||
@@ -209,7 +206,6 @@
|
|||||||
{$DEFINE PAS_VERSION}
|
{$DEFINE PAS_VERSION}
|
||||||
{$DEFINE PAS_ONLY}
|
{$DEFINE PAS_ONLY}
|
||||||
{.$DEFINE UNICODE_CTRLS}
|
{.$DEFINE UNICODE_CTRLS}
|
||||||
{$DEFINE STREAM_LARGE64}
|
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
{$WARN UNIT_DEPRECATED OFF}
|
{$WARN UNIT_DEPRECATED OFF}
|
||||||
{.$WARN SYMBOL_PLATFORM OFF}
|
{.$WARN SYMBOL_PLATFORM OFF}
|
||||||
@@ -238,7 +234,6 @@
|
|||||||
{$DEFINE PAS_VERSION}
|
{$DEFINE PAS_VERSION}
|
||||||
{$DEFINE PAS_ONLY}
|
{$DEFINE PAS_ONLY}
|
||||||
{.$DEFINE UNICODE_CTRLS}
|
{.$DEFINE UNICODE_CTRLS}
|
||||||
{$DEFINE STREAM_LARGE64}
|
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
{$WARN UNIT_DEPRECATED OFF}
|
{$WARN UNIT_DEPRECATED OFF}
|
||||||
{.$WARN SYMBOL_PLATFORM OFF}
|
{.$WARN SYMBOL_PLATFORM OFF}
|
||||||
@@ -268,7 +263,6 @@
|
|||||||
{$DEFINE PAS_VERSION}
|
{$DEFINE PAS_VERSION}
|
||||||
{$DEFINE PAS_ONLY}
|
{$DEFINE PAS_ONLY}
|
||||||
{.$DEFINE UNICODE_CTRLS}
|
{.$DEFINE UNICODE_CTRLS}
|
||||||
{$DEFINE STREAM_LARGE64}
|
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
{$WARN UNIT_DEPRECATED OFF}
|
{$WARN UNIT_DEPRECATED OFF}
|
||||||
{.$WARN SYMBOL_PLATFORM OFF}
|
{.$WARN SYMBOL_PLATFORM OFF}
|
||||||
|
|||||||
188
KOL_ASM.inc
188
KOL_ASM.inc
@@ -9765,43 +9765,27 @@ end;
|
|||||||
|
|
||||||
destructor TStrList.Destroy;
|
destructor TStrList.Destroy;
|
||||||
asm
|
asm
|
||||||
PUSH EAX
|
PUSH EAX
|
||||||
CALL Clear
|
CALL Clear
|
||||||
POP EAX
|
POP EAX
|
||||||
CALL TObj.Destroy
|
CALL TObj.Destroy
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TStrList.Add(const S: Ansistring): integer;
|
function TStrList.Add(const S: Ansistring): integer;
|
||||||
asm
|
asm
|
||||||
MOV ECX, EDX
|
MOV ECX, EDX
|
||||||
MOV EDX, [EAX].fCount
|
MOV EDX, [EAX].fCount
|
||||||
PUSH EDX
|
PUSH EDX
|
||||||
CALL Insert
|
CALL Insert
|
||||||
POP EAX
|
POP EAX
|
||||||
end;
|
end;
|
||||||
|
|
||||||
//dufa
|
|
||||||
//procedure TStrList.AddStrings(Strings: PStrList);
|
|
||||||
//asm
|
|
||||||
// PUSH EAX
|
|
||||||
// XCHG EAX, EDX
|
|
||||||
// PUSH 0
|
|
||||||
// MOV EDX, ESP
|
|
||||||
// CALL GetTextStr
|
|
||||||
// POP EDX
|
|
||||||
// POP EAX
|
|
||||||
// MOV CL, 1
|
|
||||||
// PUSH EDX
|
|
||||||
// CALL SetText
|
|
||||||
// CALL RemoveStr
|
|
||||||
//end;
|
|
||||||
|
|
||||||
procedure TStrList.Assign(Strings: PStrList);
|
procedure TStrList.Assign(Strings: PStrList);
|
||||||
asm
|
asm
|
||||||
PUSHAD
|
PUSHAD
|
||||||
CALL Clear
|
CALL Clear
|
||||||
POPAD
|
POPAD
|
||||||
JMP AddStrings
|
JMP AddStrings
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TStrList.Clear;
|
procedure TStrList.Clear;
|
||||||
@@ -9913,6 +9897,55 @@ asm
|
|||||||
JMP Delete
|
JMP Delete
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
(* bugged dufa
|
||||||
|
procedure TStrList.AddStrings(Strings: PStrList);
|
||||||
|
asm
|
||||||
|
PUSH EAX
|
||||||
|
XCHG EAX, EDX
|
||||||
|
PUSH 0
|
||||||
|
MOV EDX, ESP
|
||||||
|
CALL GetTextStr
|
||||||
|
POP EDX
|
||||||
|
POP EAX
|
||||||
|
MOV CL, 1
|
||||||
|
PUSH EDX
|
||||||
|
CALL SetText
|
||||||
|
CALL RemoveStr
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TStrList.MergeFromFile(const FileName: KOLString);
|
||||||
|
asm
|
||||||
|
PUSH EAX
|
||||||
|
XCHG EAX, EDX
|
||||||
|
CALL NewReadFileStream
|
||||||
|
XCHG EDX, EAX
|
||||||
|
POP EAX
|
||||||
|
MOV CL, 1
|
||||||
|
PUSH EDX
|
||||||
|
CALL LoadFromStream
|
||||||
|
POP EAX
|
||||||
|
JMP TObj.RefDec
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TStrList.SaveToStream(Stream: PStream);
|
||||||
|
asm
|
||||||
|
PUSH EDX
|
||||||
|
PUSH 0
|
||||||
|
MOV EDX, ESP
|
||||||
|
CALL GetTextStr
|
||||||
|
POP EAX
|
||||||
|
PUSH EAX
|
||||||
|
CALL System.@LStrLen
|
||||||
|
XCHG ECX, EAX
|
||||||
|
POP EDX
|
||||||
|
POP EAX
|
||||||
|
PUSH EDX
|
||||||
|
JECXZ @@1
|
||||||
|
CALL TStream.Write
|
||||||
|
@@1:
|
||||||
|
CALL RemoveStr
|
||||||
|
end;*)
|
||||||
|
|
||||||
procedure LowerCaseStrFromPCharEDX;
|
procedure LowerCaseStrFromPCharEDX;
|
||||||
asm
|
asm
|
||||||
{ <- EDX = PChar string
|
{ <- EDX = PChar string
|
||||||
@@ -9974,40 +10007,6 @@ asm
|
|||||||
@@exit:
|
@@exit:
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{// bugged.dufa
|
|
||||||
procedure TStrList.MergeFromFile(const FileName: KOLString);
|
|
||||||
asm
|
|
||||||
PUSH EAX
|
|
||||||
XCHG EAX, EDX
|
|
||||||
CALL NewReadFileStream
|
|
||||||
XCHG EDX, EAX
|
|
||||||
POP EAX
|
|
||||||
MOV CL, 1
|
|
||||||
PUSH EDX
|
|
||||||
CALL LoadFromStream
|
|
||||||
POP EAX
|
|
||||||
JMP TObj.RefDec
|
|
||||||
end;}
|
|
||||||
|
|
||||||
procedure TStrList.SaveToStream(Stream: PStream);
|
|
||||||
asm
|
|
||||||
PUSH EDX
|
|
||||||
PUSH 0
|
|
||||||
MOV EDX, ESP
|
|
||||||
CALL GetTextStr
|
|
||||||
POP EAX
|
|
||||||
PUSH EAX
|
|
||||||
CALL System.@LStrLen
|
|
||||||
XCHG ECX, EAX
|
|
||||||
POP EDX
|
|
||||||
POP EAX
|
|
||||||
PUSH EDX
|
|
||||||
JECXZ @@1
|
|
||||||
CALL TStream.Write
|
|
||||||
@@1:
|
|
||||||
CALL RemoveStr
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure SortData( const Data: Pointer; const uNElem: Dword;
|
procedure SortData( const Data: Pointer; const uNElem: Dword;
|
||||||
const CompareFun: TCompareEvent;
|
const CompareFun: TCompareEvent;
|
||||||
const SwapProc: TSwapEvent );
|
const SwapProc: TSwapEvent );
|
||||||
@@ -12948,68 +12947,6 @@ asm
|
|||||||
CALL TObj.RefDec
|
CALL TObj.RefDec
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{$IFDEF USE_OLDCONVERT2MASK}
|
|
||||||
procedure TBitmap.Convert2Mask(TranspColor: TColor);
|
|
||||||
asm
|
|
||||||
PUSH EBX
|
|
||||||
PUSH ESI
|
|
||||||
MOV EBX, EAX
|
|
||||||
MOV ESI, EDX
|
|
||||||
CALL GetHandle
|
|
||||||
TEST EAX, EAX
|
|
||||||
JZ @@exit
|
|
||||||
|
|
||||||
PUSH 0
|
|
||||||
PUSH 1
|
|
||||||
PUSH 1
|
|
||||||
PUSH [EBX].fHeight
|
|
||||||
PUSH [EBX].fWidth
|
|
||||||
CALL CreateBitmap
|
|
||||||
PUSH EAX // MonoHandle
|
|
||||||
PUSH 0
|
|
||||||
CALL CreateCompatibleDC
|
|
||||||
POP EDX
|
|
||||||
PUSH EDX
|
|
||||||
PUSH EAX // MonoDC
|
|
||||||
|
|
||||||
PUSH EDX
|
|
||||||
PUSH EAX
|
|
||||||
CALL SelectObject
|
|
||||||
PUSH EAX // SaveMono
|
|
||||||
|
|
||||||
CALL StartDC // DCfrom, SaveFrom
|
|
||||||
XCHG EAX, ESI
|
|
||||||
CALL Color2RGB
|
|
||||||
PUSH EAX // Color2RGB(TranspColor)
|
|
||||||
PUSH dword ptr [ESP+8] //DCfrom
|
|
||||||
CALL Windows.SetBkColor
|
|
||||||
PUSH EAX // SaveBkColor
|
|
||||||
|
|
||||||
PUSH SRCCOPY
|
|
||||||
PUSH 0
|
|
||||||
PUSH 0
|
|
||||||
PUSH dword ptr [ESP+12+4+4] //DCfrom
|
|
||||||
PUSH [EBX].fHeight
|
|
||||||
PUSH [EBX].fWidth
|
|
||||||
PUSH 0
|
|
||||||
PUSH 0
|
|
||||||
PUSH dword ptr [ESP+32+16] //MonoDC
|
|
||||||
CALL BitBlt
|
|
||||||
|
|
||||||
PUSH dword ptr [ESP+8] //DCfrom
|
|
||||||
CALL Windows.SetBkColor // ESP-> SaveFrom
|
|
||||||
CALL FinishDC // ESP-> SaveMono
|
|
||||||
CALL FinishDC // ESP-> MonoHandle
|
|
||||||
|
|
||||||
MOV EAX, EBX
|
|
||||||
CALL ClearData
|
|
||||||
POP [EBX].fHandle
|
|
||||||
MOV [EBX].fHandleType, bmDDB
|
|
||||||
@@exit:
|
|
||||||
POP ESI
|
|
||||||
POP EBX
|
|
||||||
end;
|
|
||||||
{$ELSE USE_OLDCONVERT2MASK} //Pascal
|
|
||||||
procedure TBitmap.Convert2Mask(TranspColor: TColor);
|
procedure TBitmap.Convert2Mask(TranspColor: TColor);
|
||||||
asm
|
asm
|
||||||
PUSH EBX
|
PUSH EBX
|
||||||
@@ -13248,7 +13185,6 @@ asm
|
|||||||
POP ESI
|
POP ESI
|
||||||
POP EBX
|
POP EBX
|
||||||
end;
|
end;
|
||||||
{$ENDIF USE_OLDCONVERT2MASK} //Pascal
|
|
||||||
|
|
||||||
procedure _PrepareBmp2Rotate;
|
procedure _PrepareBmp2Rotate;
|
||||||
const szBIH = sizeof(TBitmapInfoHeader);
|
const szBIH = sizeof(TBitmapInfoHeader);
|
||||||
|
|||||||
@@ -3317,7 +3317,6 @@ asm
|
|||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
JECXZ @@exit
|
JECXZ @@exit
|
||||||
|
|
||||||
{$IFNDEF NOT_FIX_CURINDEX}
|
|
||||||
PUSH ESI
|
PUSH ESI
|
||||||
PUSH EBP
|
PUSH EBP
|
||||||
|
|
||||||
@@ -3352,19 +3351,6 @@ asm
|
|||||||
|
|
||||||
POP EBP
|
POP EBP
|
||||||
POP ESI
|
POP ESI
|
||||||
{$ELSE NOT_FIX_CURINDEX}
|
|
||||||
PUSH EDX
|
|
||||||
|
|
||||||
MOV EDX, EDI
|
|
||||||
MOV EAX, EBX
|
|
||||||
CALL Delete
|
|
||||||
|
|
||||||
XCHG EAX, EBX
|
|
||||||
XCHG EDX, EDI
|
|
||||||
|
|
||||||
POP ECX
|
|
||||||
CALL Insert
|
|
||||||
{$ENDIF NOT_FIX_CURINDEX}
|
|
||||||
|
|
||||||
@@exit:
|
@@exit:
|
||||||
POP EBX
|
POP EBX
|
||||||
@@ -3653,6 +3639,7 @@ asm
|
|||||||
@@exit:
|
@@exit:
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
(* bugged?! dufa
|
||||||
function TStrList.AppendToFile(const FileName: Ansistring): Boolean;
|
function TStrList.AppendToFile(const FileName: Ansistring): Boolean;
|
||||||
asm
|
asm
|
||||||
PUSH EBX
|
PUSH EBX
|
||||||
@@ -3728,7 +3715,6 @@ asm
|
|||||||
@@exit: POP EDX
|
@@exit: POP EDX
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{ maybebugged.dufa
|
|
||||||
function TStrList.SaveToFile(const FileName: Ansistring): Boolean;
|
function TStrList.SaveToFile(const FileName: Ansistring): Boolean;
|
||||||
asm
|
asm
|
||||||
PUSH EBX
|
PUSH EBX
|
||||||
@@ -3762,7 +3748,7 @@ asm
|
|||||||
@@exit:
|
@@exit:
|
||||||
POP EDX
|
POP EDX
|
||||||
POP EBX
|
POP EBX
|
||||||
end;}
|
end; *)
|
||||||
|
|
||||||
procedure TControl.SetStatusText(Index: Integer; const Value: KOLString);
|
procedure TControl.SetStatusText(Index: Integer; const Value: KOLString);
|
||||||
asm
|
asm
|
||||||
|
|||||||
543
KOL_Linux.inc
543
KOL_Linux.inc
@@ -1,543 +0,0 @@
|
|||||||
{$IFDEF global_declare}
|
|
||||||
type DWORD = LongWord;
|
|
||||||
PDWORD = ^DWORD;
|
|
||||||
|
|
||||||
PPoint = ^TPoint;
|
|
||||||
TPoint = packed record
|
|
||||||
X: Longint;
|
|
||||||
Y: Longint;
|
|
||||||
end;
|
|
||||||
|
|
||||||
PRect = ^TRect;
|
|
||||||
TRect = packed record
|
|
||||||
case Integer of
|
|
||||||
0: (Left, Top, Right, Bottom: Longint);
|
|
||||||
1: (TopLeft, BottomRight: TPoint);
|
|
||||||
end;
|
|
||||||
|
|
||||||
const
|
|
||||||
INVALID_HANDLE_VALUE = Cardinal(-1);
|
|
||||||
MAX_PATH = 4095; // From /usr/include/linux/limits.h PATH_MAX
|
|
||||||
|
|
||||||
const
|
|
||||||
{ File attribute constants }
|
|
||||||
FILE_ATTRIBUTE_READONLY = $00000001;
|
|
||||||
FILE_ATTRIBUTE_HIDDEN = $00000002;
|
|
||||||
FILE_ATTRIBUTE_SYSTEM = $00000004;
|
|
||||||
FILE_ATTRIBUTE_VOLUME = $00000008;
|
|
||||||
FILE_ATTRIBUTE_DIRECTORY = $00000010;
|
|
||||||
FILE_ATTRIBUTE_ARCHIVE = $00000020;
|
|
||||||
FILE_ATTRIBUTE_SYMLINK = $00000040;
|
|
||||||
FILE_ATTRIBUTE_ANYFILE = $0000003F;
|
|
||||||
|
|
||||||
FILE_ATTRIBUTE_NORMAL = FILE_ATTRIBUTE_ARCHIVE;
|
|
||||||
|
|
||||||
type
|
|
||||||
TFilename = type string;
|
|
||||||
PFileTime = ^TFileTime;
|
|
||||||
TFileTime = __time_t;
|
|
||||||
PFindFileData = ^TFindFileData;
|
|
||||||
TFindFileData = packed record
|
|
||||||
// from TWin32FindData: -------------
|
|
||||||
dwFileAttributes: DWORD;
|
|
||||||
ftCreationTime: TFileTime;
|
|
||||||
ftLastAccessTime: TFileTime;
|
|
||||||
ftLastWriteTime: TFileTime;
|
|
||||||
nFileSizeHigh: DWORD;
|
|
||||||
nFileSizeLow: DWORD;
|
|
||||||
//dwReserved0: DWORD;
|
|
||||||
//dwReserved1: DWORD;
|
|
||||||
cFileName: array[0..MAX_PATH - 1] of Char;
|
|
||||||
//cAlternateFileName: array[0..13] of KOLChar; - no in Linux
|
|
||||||
//-------- + handle:
|
|
||||||
FindHandle: Pointer;
|
|
||||||
ExcludeAttr: Integer;
|
|
||||||
Mode: mode_t;
|
|
||||||
PathOnly: String;
|
|
||||||
Pattern: String;
|
|
||||||
end;
|
|
||||||
const
|
|
||||||
ExeBaseAddress = Pointer($8048000); // Kylix only?
|
|
||||||
|
|
||||||
function GetModuleFileName(Module: HMODULE; Buffer: PChar; BufLen: Integer): Integer;
|
|
||||||
function DeleteFile(lpFileName: PChar): Boolean;
|
|
||||||
{$ENDIF global_declare}
|
|
||||||
|
|
||||||
{$IFDEF implementation}
|
|
||||||
//------------------ Unicode strings
|
|
||||||
|
|
||||||
function WAnsiUpperCase(const S: WideString): WideString;
|
|
||||||
var
|
|
||||||
I: Integer;
|
|
||||||
P: PWideChar;
|
|
||||||
begin
|
|
||||||
SetLength(Result, Length(S));
|
|
||||||
P := @Result[1];
|
|
||||||
for I := 1 to Length(S) do
|
|
||||||
P[I-1] := WideChar(towupper(UCS4Char(S[I])));
|
|
||||||
end;
|
|
||||||
|
|
||||||
function WAnsiLowerCase(const S: WideString): WideString;
|
|
||||||
var
|
|
||||||
I: Integer;
|
|
||||||
P: PWideChar;
|
|
||||||
begin
|
|
||||||
SetLength(Result, Length(S));
|
|
||||||
P := @Result[1];
|
|
||||||
for I := 1 to Length(S) do
|
|
||||||
P[I-1] := WideChar(towlower(UCS4Char(S[I])));
|
|
||||||
end;
|
|
||||||
|
|
||||||
//------------------ Ansi strings
|
|
||||||
|
|
||||||
function AnsiUpperCase(const S: string): string;
|
|
||||||
begin
|
|
||||||
Result := WAnsiUpperCase( S );
|
|
||||||
end;
|
|
||||||
|
|
||||||
function AnsiLowerCase(const S: string): string;
|
|
||||||
begin
|
|
||||||
Result := WAnsiLowerCase( S );
|
|
||||||
end;
|
|
||||||
|
|
||||||
function AnsiCompareStr(const S1, S2: string): Integer;
|
|
||||||
begin
|
|
||||||
// glibc 2.1.2 / 2.1.3 implementations of strcoll() and strxfrm()
|
|
||||||
// have severe capacity limits. Comparing two 100k strings may
|
|
||||||
// exhaust the stack and kill the process.
|
|
||||||
// Fixed in glibc 2.1.91 and later.
|
|
||||||
Result := strcoll(PChar(S1), PChar(S2));
|
|
||||||
end;
|
|
||||||
|
|
||||||
function _AnsiCompareStr(S1, S2: PChar): Integer;
|
|
||||||
begin
|
|
||||||
// glibc 2.1.2 / 2.1.3 implementations of strcoll() and strxfrm()
|
|
||||||
// have severe capacity limits. Comparing two 100k strings may
|
|
||||||
// exhaust the stack and kill the process.
|
|
||||||
// Fixed in glibc 2.1.91 and later.
|
|
||||||
Result := strcoll(S1, S2);
|
|
||||||
end;
|
|
||||||
|
|
||||||
function AnsiCompareStrNoCase(const S1, S2: string): Integer;
|
|
||||||
begin
|
|
||||||
// glibc 2.1.2 / 2.1.3 implementations of strcoll() and strxfrm()
|
|
||||||
// have severe capacity limits. Comparing two 100k strings may
|
|
||||||
// exhaust the stack and kill the process.
|
|
||||||
// Fixed in glibc 2.1.91 and later.
|
|
||||||
Result := AnsiCompareStr( AnsiUpperCase( S1 ), AnsiUpperCase( S2 ) );
|
|
||||||
end;
|
|
||||||
|
|
||||||
function _AnsiCompareStrNoCase(S1, S2: PChar): Integer;
|
|
||||||
begin
|
|
||||||
// glibc 2.1.2 / 2.1.3 implementations of strcoll() and strxfrm()
|
|
||||||
// have severe capacity limits. Comparing two 100k strings may
|
|
||||||
// exhaust the stack and kill the process.
|
|
||||||
// Fixed in glibc 2.1.91 and later.
|
|
||||||
Result := AnsiCompareStrNoCase( S1, S2 );
|
|
||||||
end;
|
|
||||||
|
|
||||||
//--------------- File functions
|
|
||||||
|
|
||||||
function FileCreate(const FileName: string; OpenFlags: DWord): THandle;
|
|
||||||
begin
|
|
||||||
Result := open64( PChar( FileName ), OpenFlags );
|
|
||||||
end;
|
|
||||||
|
|
||||||
function FileClose(Handle: THandle): boolean;
|
|
||||||
begin
|
|
||||||
Result := FALSE;
|
|
||||||
if Handle = INVALID_HANDLE_VALUE then Exit;
|
|
||||||
__close( Handle );
|
|
||||||
Result := TRUE;
|
|
||||||
end;
|
|
||||||
|
|
||||||
function FileExists( const FileName : String ) : Boolean;
|
|
||||||
var st: TStatBuf;
|
|
||||||
begin
|
|
||||||
Result := FALSE;
|
|
||||||
if stat(PChar(FileName), st) = 0 then
|
|
||||||
Result := st.st_mtime <> -1;
|
|
||||||
end;
|
|
||||||
|
|
||||||
function FileSeek( Handle: THandle; MoveTo: integer; MoveMethod: TMoveMethod): DWord;
|
|
||||||
var Temp: Int64;
|
|
||||||
begin
|
|
||||||
Temp := MoveTo;
|
|
||||||
Result := lseek64(Handle, Temp, Integer( MoveMethod ));
|
|
||||||
end;
|
|
||||||
|
|
||||||
function FileFarSeek(Handle: THandle; MoveTo: Int64; MoveMethod: TMoveMethod): DWord;
|
|
||||||
var Temp: Int64;
|
|
||||||
begin
|
|
||||||
Temp := MoveTo;
|
|
||||||
Result := lseek64(Handle, Temp, Integer( MoveMethod ));
|
|
||||||
end;
|
|
||||||
|
|
||||||
function FileRead(Handle: THandle; var Buffer; Count: DWord): DWord;
|
|
||||||
begin
|
|
||||||
Result := __read(Handle, Buffer, Count);
|
|
||||||
end;
|
|
||||||
|
|
||||||
function GetFileSize( Handle: THandle; HiSize: PDWORD ): DWORD;
|
|
||||||
var Pos: Int64;
|
|
||||||
Len: Int64;
|
|
||||||
begin
|
|
||||||
Pos := FileSeek( Handle, 0, spCurrent );
|
|
||||||
Len := FileSeek( Handle, 0, spEnd );
|
|
||||||
FileSeek( Handle, Pos, spBegin );
|
|
||||||
Result := I64( Len ).Lo;
|
|
||||||
if HiSize <> nil then HiSize^ := I64( Len ).Hi;
|
|
||||||
end;
|
|
||||||
|
|
||||||
function FileWrite( Handle: THandle; const Buffer; Count: DWord): DWord;
|
|
||||||
begin
|
|
||||||
Result := __write(Handle, Buffer, Count);
|
|
||||||
end;
|
|
||||||
|
|
||||||
// the only way for a file name to be not complete in Unix:
|
|
||||||
// it is located in current working directory (CWD) ??????
|
|
||||||
function FileFullPath( const FileName: String ) : String;
|
|
||||||
var wd: String;
|
|
||||||
buffer: array[ 0.._POSIX_PATH_MAX+1 ] of Char;
|
|
||||||
begin
|
|
||||||
Result := FileName;
|
|
||||||
wd := '';
|
|
||||||
if getwd( buffer ) <> nil then
|
|
||||||
wd := buffer;
|
|
||||||
if StrIsStartingFrom( PChar( FileName ), PChar( wd ) ) then Exit;
|
|
||||||
Result := IncludeTrailingPathDelimiter( wd ) + Filename;
|
|
||||||
if not FileExists( Result ) then Result := FileName;
|
|
||||||
end;
|
|
||||||
|
|
||||||
function Find_Next(var F: TFindFileData): Boolean;
|
|
||||||
var
|
|
||||||
PtrDirEnt: PDirEnt;
|
|
||||||
Scratch: TDirEnt;
|
|
||||||
StatBuf: TStatBuf;
|
|
||||||
LinkStatBuf: TStatBuf;
|
|
||||||
FName: string;
|
|
||||||
Attr: Integer;
|
|
||||||
Mode: mode_t;
|
|
||||||
Sz: Int64;
|
|
||||||
begin
|
|
||||||
Result := FALSE;
|
|
||||||
PtrDirEnt := nil;
|
|
||||||
if readdir_r(F.FindHandle, @Scratch, PtrDirEnt) <> 0 then
|
|
||||||
Exit;
|
|
||||||
while PtrDirEnt <> nil do
|
|
||||||
begin
|
|
||||||
if fnmatch(PChar(F.Pattern), PtrDirEnt.d_name, 0) = 0 then
|
|
||||||
begin // F.PathOnly must include trailing backslash
|
|
||||||
FName := F.PathOnly + string(PtrDirEnt.d_name);
|
|
||||||
|
|
||||||
if lstat(PChar(FName), StatBuf) = 0 then
|
|
||||||
begin
|
|
||||||
Attr := 0;
|
|
||||||
Mode := StatBuf.st_mode;
|
|
||||||
|
|
||||||
if S_ISDIR(Mode) then
|
|
||||||
Attr := Attr or FILE_ATTRIBUTE_DIRECTORY
|
|
||||||
else
|
|
||||||
if not S_ISREG(Mode) then // directories shouldn't be treated as system files
|
|
||||||
begin
|
|
||||||
if S_ISLNK(Mode) then
|
|
||||||
begin
|
|
||||||
Attr := Attr or FILE_ATTRIBUTE_SYMLINK;
|
|
||||||
if (stat(PChar(FName), LinkStatBuf) = 0) and
|
|
||||||
S_ISDIR(LinkStatBuf.st_mode) then
|
|
||||||
Attr := Attr or FILE_ATTRIBUTE_DIRECTORY
|
|
||||||
end;
|
|
||||||
Attr := Attr or FILE_ATTRIBUTE_SYSTEM;
|
|
||||||
end;
|
|
||||||
|
|
||||||
if (PtrDirEnt.d_name[0] = '.') and (PtrDirEnt.d_name[1] <> #0) then
|
|
||||||
begin
|
|
||||||
if not ((PtrDirEnt.d_name[1] = '.') and (PtrDirEnt.d_name[2] = #0)) then
|
|
||||||
Attr := Attr or FILE_ATTRIBUTE_HIDDEN;
|
|
||||||
end;
|
|
||||||
|
|
||||||
if euidaccess(PChar(FName), W_OK) <> 0 then
|
|
||||||
Attr := Attr or FILE_ATTRIBUTE_READONLY;
|
|
||||||
|
|
||||||
if Attr and F.ExcludeAttr = 0 then
|
|
||||||
begin
|
|
||||||
Sz := StatBuf.st_size;
|
|
||||||
F.nFileSizeLow := I64(Sz).Lo;
|
|
||||||
F.nFileSizeHigh := I64(Sz).Hi;
|
|
||||||
F.dwFileAttributes := Attr;
|
|
||||||
F.Mode := StatBuf.st_mode;
|
|
||||||
StrCopy( F.cFileName, PtrDirEnt.d_name );
|
|
||||||
F.ftCreationTime := StatBuf.st_mtime;
|
|
||||||
F.ftLastWriteTime := StatBuf.st_mtime;
|
|
||||||
F.ftLastAccessTime := StatBuf.st_atime;
|
|
||||||
Result := TRUE;
|
|
||||||
Break;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
Result := FALSE;
|
|
||||||
if readdir_r(F.FindHandle, @Scratch, PtrDirEnt) <> 0 then
|
|
||||||
Break;
|
|
||||||
end // End of While
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure Find_Close(var F: TFindFileData);
|
|
||||||
begin
|
|
||||||
if F.FindHandle <> nil then
|
|
||||||
begin
|
|
||||||
closedir(F.FindHandle);
|
|
||||||
F.FindHandle := nil;
|
|
||||||
end;
|
|
||||||
F.PathOnly := ''; // in Kylix this is not done (memory leak bug?)
|
|
||||||
|
|
||||||
F.Pattern := '';
|
|
||||||
|
|
||||||
end;
|
|
||||||
|
|
||||||
function Find_First( const FilePathName: String; var F: TFindFileData ): Boolean;
|
|
||||||
begin
|
|
||||||
FillChar( F, Sizeof( F ), 0 );
|
|
||||||
F.ExcludeAttr := FILE_ATTRIBUTE_HIDDEN or FILE_ATTRIBUTE_SYSTEM or
|
|
||||||
FILE_ATTRIBUTE_VOLUME; // or FILE_ATTRIBUTE_DIRECTORY;
|
|
||||||
F.PathOnly := ExtractFilePath(FilePathName);
|
|
||||||
F.Pattern := ExtractFileName(FilePathName);
|
|
||||||
if F.PathOnly = '' then
|
|
||||||
F.PathOnly := GetWorkDir;
|
|
||||||
|
|
||||||
F.FindHandle := opendir(PChar(F.PathOnly));
|
|
||||||
if F.FindHandle <> nil then
|
|
||||||
begin
|
|
||||||
if not Find_Next(F) then
|
|
||||||
begin
|
|
||||||
Find_Close(F);
|
|
||||||
Result := FALSE;
|
|
||||||
Exit;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
Result:= TRUE;
|
|
||||||
end;
|
|
||||||
|
|
||||||
function FileSize( const Path : String ) : Int64;
|
|
||||||
var F: TFindFileData;
|
|
||||||
begin
|
|
||||||
Result := 0;
|
|
||||||
if Find_First( Path, F ) then
|
|
||||||
begin
|
|
||||||
Result := PInt64( @ F.nFileSizeLow )^;
|
|
||||||
Find_Close( F );
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
function FileTimeCompare( const FT1, FT2 : TFileTime ) : Integer;
|
|
||||||
begin
|
|
||||||
Result := Sgn( FT1 - FT2 );
|
|
||||||
end;
|
|
||||||
|
|
||||||
function DirectoryExists(const Name: string): Boolean;
|
|
||||||
var st: TStatBuf;
|
|
||||||
begin
|
|
||||||
if stat(PChar(Name), st) = 0 then
|
|
||||||
Result := S_ISDIR(st.st_mode)
|
|
||||||
else
|
|
||||||
Result := False;
|
|
||||||
end;
|
|
||||||
|
|
||||||
function GetWorkDir : string;
|
|
||||||
var
|
|
||||||
DirBuf: array[0..MAX_PATH] of Char;
|
|
||||||
begin
|
|
||||||
getcwd(DirBuf, sizeof(DirBuf));
|
|
||||||
Result := string(DirBuf);
|
|
||||||
end;
|
|
||||||
|
|
||||||
//[function GetModuleFileName] // grabbed form Kylix/system.pas
|
|
||||||
function GetModuleFileName(Module: HMODULE; Buffer: PChar; BufLen: Integer): Integer;
|
|
||||||
var
|
|
||||||
Addr: Pointer;
|
|
||||||
Info: TDLInfo;
|
|
||||||
FoundInModule: HMODULE;
|
|
||||||
Temp: Integer;
|
|
||||||
begin
|
|
||||||
Result := 0;
|
|
||||||
if BufLen <= 0 then Exit;
|
|
||||||
if (Module = MainInstance) or (Module = 0) then
|
|
||||||
begin
|
|
||||||
// First, try the dlsym approach.
|
|
||||||
// dladdr fails to return the name of the main executable
|
|
||||||
// in glibc prior to 2.1.91
|
|
||||||
|
|
||||||
{ Look for a dynamic symbol exported from this program.
|
|
||||||
_DYNAMIC is not required in a main program file.
|
|
||||||
If the main program is compiled with Delphi, it will always
|
|
||||||
have a resource section, named @Sysinit@ResSym.
|
|
||||||
If the main program is not compiled with Delphi, dlsym
|
|
||||||
will search the global name space, potentially returning
|
|
||||||
the address of a symbol in some other shared object library
|
|
||||||
loaded by the program. To guard against that, we check
|
|
||||||
that the address of the symbol found is within the
|
|
||||||
main program address range. }
|
|
||||||
|
|
||||||
dlerror; // clear error state; dlsym doesn't
|
|
||||||
Addr := dlsym(Pointer( Module ), '@Sysinit@ResSym');
|
|
||||||
if (Addr <> nil) and (dlerror = nil)
|
|
||||||
and (dladdr(Addr, Info) <> 0)
|
|
||||||
and (Info.{FileName}dli_fname <> nil)
|
|
||||||
and (Info.{BaseAddress}dli_fbase = ExeBaseAddress) then
|
|
||||||
begin
|
|
||||||
Result := StrLen(Info.{FileName}dli_fname);
|
|
||||||
if Result >= BufLen then Result := BufLen-1;
|
|
||||||
|
|
||||||
// dlinfo may not give a full path. Compare to /proc/self/exe,
|
|
||||||
// take longest result.
|
|
||||||
Temp := readlink('/proc/self/exe', Buffer, BufLen);
|
|
||||||
if Temp >= BufLen then Temp := BufLen-1;
|
|
||||||
if Temp > Result then
|
|
||||||
Result := Temp
|
|
||||||
else
|
|
||||||
Move(Info.{FileName}dli_fname^, Buffer^, Result);
|
|
||||||
Buffer[Result] := #0;
|
|
||||||
Exit;
|
|
||||||
end;
|
|
||||||
|
|
||||||
// Try inspecting the /proc/ virtual file system
|
|
||||||
// to find the program filename in the process info
|
|
||||||
Result := readlink('/proc/self/exe', Buffer, BufLen);
|
|
||||||
if Result <> -1 then
|
|
||||||
begin
|
|
||||||
if Result >= BufLen then Result := BufLen-1;
|
|
||||||
Buffer[Result] := #0;
|
|
||||||
end;
|
|
||||||
{$IFDEF AllowParamStrModuleName}
|
|
||||||
{ Using ParamStr(0) to obtain a module name presents a potential
|
|
||||||
security hole. Resource modules are loaded based upon the filename
|
|
||||||
of a given module. We use dlopen() to load resource modules, which
|
|
||||||
means the .init code of the resource module will be executed.
|
|
||||||
Normally, resource modules contain no code at all - they're just
|
|
||||||
carriers of resource data.
|
|
||||||
An unpriviledged user program could launch our trusted,
|
|
||||||
priviledged program with a bogus parameter list, tricking us
|
|
||||||
into loading a module that contains malicious code in its
|
|
||||||
.init section.
|
|
||||||
Without this ParamStr(0) section, GetModuleFilename cannot be
|
|
||||||
misdirected by unpriviledged code (unless the system program loader
|
|
||||||
or the /proc file system or system root directory has been compromised).
|
|
||||||
Resource modules are always loaded from the same directory as the
|
|
||||||
given module. Trusted code (programs, packages, and libraries)
|
|
||||||
should reside in directories that unpriviledged code cannot alter.
|
|
||||||
|
|
||||||
If you need GetModuleFilename to have a chance of working on systems
|
|
||||||
where glibc < 2.1.91 and /proc is not available, and your
|
|
||||||
program will not run as a priviledged user (or you don't care),
|
|
||||||
you can define AllowParamStrModuleNames and rebuild the System unit
|
|
||||||
and baseCLX package. Note that even with ParamStr(0) support
|
|
||||||
enabled, GetModuleFilename can still fail to find the name of
|
|
||||||
a module. C'est la Unix. }
|
|
||||||
|
|
||||||
if Result = -1 then // couldn't access the /proc filesystem
|
|
||||||
begin // return less accurate ParamStr(0)
|
|
||||||
|
|
||||||
{ ParamStr(0) returns the name of the link used
|
|
||||||
to launch the app, not the name of the app itself.
|
|
||||||
Also, if this app was launched by some other program,
|
|
||||||
there is no guarantee that the launching program has set
|
|
||||||
up our environment at all. (example: Apache CGI) }
|
|
||||||
|
|
||||||
if (ArgValues = nil) or (ArgValues^ = nil) or
|
|
||||||
(PCharArray(ArgValues^)[0] = nil) then
|
|
||||||
begin
|
|
||||||
Result := 0;
|
|
||||||
Exit;
|
|
||||||
end;
|
|
||||||
Result := _strlen(PCharArray(ArgValues^)[0]);
|
|
||||||
if Result >= BufLen then Result := BufLen-1;
|
|
||||||
Move(PCharArray(ArgValues^)[0]^, Buffer^, Result);
|
|
||||||
Buffer[Result] := #0;
|
|
||||||
end;
|
|
||||||
{$ENDIF}
|
|
||||||
end
|
|
||||||
else
|
|
||||||
begin
|
|
||||||
{ For shared object libraries, we can rely on the dlsym technique.
|
|
||||||
Look for a dynamic symbol in the requested module.
|
|
||||||
Don't assume the module was compiled with Delphi.
|
|
||||||
We look for a dynamic symbol with the name _DYNAMIC. This
|
|
||||||
exists in all ELF shared object libraries that export
|
|
||||||
or import symbols; If someone has a shared object library that
|
|
||||||
contains no imports or exports of any kind, this will probably fail.
|
|
||||||
If dlsym can't find the requested symbol in the given module, it
|
|
||||||
will search the global namespace and could return the address
|
|
||||||
of a symbol from some other module that happens to be loaded
|
|
||||||
into this process. That would be bad, so we double check
|
|
||||||
that the module handle of the symbol found matches the
|
|
||||||
module handle we asked about.}
|
|
||||||
|
|
||||||
dlerror; // clear error state; dlsym doesn't
|
|
||||||
Addr := dlsym(Pointer( Module ), '_DYNAMIC');
|
|
||||||
if (Addr <> nil) and (dlerror = nil)
|
|
||||||
and (dladdr(Addr, Info) <> 0) then
|
|
||||||
begin
|
|
||||||
if Info.{BaseAddress}dli_fbase = ExeBaseAddress then
|
|
||||||
Info.{FileName}dli_fname := nil;
|
|
||||||
FoundInModule := HMODULE(dlopen(Info.{FileName}dli_fname, RTLD_LAZY));
|
|
||||||
if FoundInModule <> 0 then
|
|
||||||
dlclose(Pointer( FoundInModule ));
|
|
||||||
if Module = FoundInModule then
|
|
||||||
begin
|
|
||||||
if Assigned(Info.{FileName}dli_fname) then
|
|
||||||
begin
|
|
||||||
Result := StrLen(Info.{FileName}dli_fname);
|
|
||||||
if Result >= BufLen then Result := BufLen-1;
|
|
||||||
Move(Info.{FileName}dli_fname^, Buffer^, Result);
|
|
||||||
end
|
|
||||||
else
|
|
||||||
Result := 0;
|
|
||||||
Buffer[Result] := #0;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
if Result < 0 then Result := 0;
|
|
||||||
end;
|
|
||||||
//[END GetModuleFileName]
|
|
||||||
|
|
||||||
function CreateTempFile( const DirPath, Prefix: String ): String;
|
|
||||||
var i: Integer;
|
|
||||||
begin
|
|
||||||
i := 0;
|
|
||||||
REPEAT
|
|
||||||
Result := DirPath + Prefix + Int2Str( i );
|
|
||||||
inc( i );
|
|
||||||
UNTIL not FileExists( Result );
|
|
||||||
end;
|
|
||||||
|
|
||||||
function DeleteFile(lpFileName: PChar): Boolean;
|
|
||||||
begin
|
|
||||||
Result := remove( lpFileName ) = 0;
|
|
||||||
end;
|
|
||||||
|
|
||||||
{--- TTimer ---}
|
|
||||||
(*)
|
|
||||||
procedure TTimer.SetEnabled(const Value: Boolean);
|
|
||||||
begin
|
|
||||||
if FEnabled = Value then Exit;
|
|
||||||
fEnabled := Value;
|
|
||||||
if Value then
|
|
||||||
begin
|
|
||||||
fTV.it_interval.tv_sec := fInterval div 1000;
|
|
||||||
fTV.it_interval.tv_usec := (fInterval mod 1000) * 1000;
|
|
||||||
setitimer( fTimerKind, )
|
|
||||||
fHandle := SetTimer( {$IFDEF TIMER_APPLETWND} Applet.GetWindowHandle
|
|
||||||
{$ELSE} TimerOwnerWnd.GetWindowHandle
|
|
||||||
{$ENDIF}, Integer( @Self ),
|
|
||||||
fInterval, @TimerProc );
|
|
||||||
end
|
|
||||||
else
|
|
||||||
begin
|
|
||||||
if fHandle <> 0 then
|
|
||||||
begin
|
|
||||||
KillTimer( TimerOwnerWnd.fHandle, fHandle );
|
|
||||||
fHandle := 0;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
(*)
|
|
||||||
{$ENDIF implementation}
|
|
||||||
@@ -1,301 +0,0 @@
|
|||||||
{*******************************************************************************
|
|
||||||
KOL_deprecated.inc
|
|
||||||
-- declarations and code deprecated in KOL.pas
|
|
||||||
********************************************************************************}
|
|
||||||
|
|
||||||
{$IFDEF interface_1} ///////////////////////////////////////////////////////////
|
|
||||||
{$IFNDEF _FPC}
|
|
||||||
TOnLVDataW = procedure( Sender: PControl; Idx, SubItem: Integer;
|
|
||||||
var Txt: WideString; var ImgIdx: Integer; var State: DWORD;
|
|
||||||
var Store: Boolean ) of object;
|
|
||||||
{* Event type for OnLVDataW event (the same as OnLVData, but for unicode verion
|
|
||||||
of the control OnLVDataW allows to return WideString text in the event
|
|
||||||
handler). Used to provide virtual list view control
|
|
||||||
(i.e. having lvoOwnerData style) with actual data on request. Use parameter
|
|
||||||
Store as a flag if control should store obtained data by itself or not. }
|
|
||||||
{$ENDIF _FPC}
|
|
||||||
{$ENDIF interface_1} ///////////////////////////////////////////////////////////
|
|
||||||
|
|
||||||
{$IFDEF interface_2} ///////////////////////////////////////////////////////////
|
|
||||||
{$IFNDEF _FPC}
|
|
||||||
protected
|
|
||||||
fOnLVDataW: TOnLVDataW;
|
|
||||||
function GetLVColTextW(Idx: Integer): WideString;
|
|
||||||
procedure SetLVColTextW(Idx: Integer; const Value: WideString);
|
|
||||||
function LVGetItemTextW(Idx, Col: Integer): WideString;
|
|
||||||
procedure LVSetItemTextW(Idx, Col: Integer; const Value: WideString);
|
|
||||||
function TVGetItemTextW(Item: THandle): WideString;
|
|
||||||
procedure TVSetItemTextW(Item: THandle; const Value: WideString);
|
|
||||||
procedure SetOnLVDataW(const Value: TOnLVDataW);
|
|
||||||
public
|
|
||||||
procedure LVColAddW( const aText: WideString; aalign: TTextAlign; aWidth: Integer );
|
|
||||||
{* |<#listview>
|
|
||||||
Adds new column (unicode version). }
|
|
||||||
procedure LVColInsertW( ColIdx: Integer; const aText: WideString; aAlign: TTextAlign; aWidth: Integer );
|
|
||||||
{* |<#listview>
|
|
||||||
Inserts new column at the Idx position (1-based column index). }
|
|
||||||
property LVColTextW[ Idx: Integer ]: WideString read GetLVColTextW write SetLVColTextW;
|
|
||||||
{* |<#listview>
|
|
||||||
Allows to get/change column header text at run time. }
|
|
||||||
function LVItemAddW( const aText: WideString ): Integer;
|
|
||||||
{* |<#listview>
|
|
||||||
Adds an item to the end of list view. Returns an index of the item added. }
|
|
||||||
function LVItemInsertW( Idx: Integer; const aText: WideString ): Integer;
|
|
||||||
{* |<#listview>
|
|
||||||
Inserts an item to Idx position. This method is deprecated, use
|
|
||||||
TVItemInsert (adding symbol UNICODE_CTRLS to options) }
|
|
||||||
property LVItemsW[ Idx, Col: Integer ]: WideString read LVGetItemTextW write LVSetItemTextW;
|
|
||||||
{* |<#listview>
|
|
||||||
Access to List View item text. }
|
|
||||||
function LVIndexOfW( const S: WideString ): Integer;
|
|
||||||
{* Returns first list view item index with caption matching S.
|
|
||||||
The same as LVSearchForW( S, -1, FALSE ). }
|
|
||||||
function LVSearchForW( const S: WideString; StartAfter: Integer; Partial: Boolean ): Integer;
|
|
||||||
{* Searches an item with Caption equal to S (or starting from S, if Partial = TRUE).
|
|
||||||
Searching is started after an item specified by StartAfter parameter. }
|
|
||||||
property OnLVDataW: TOnLVDataW read fOnLVDataW write SetOnLVDataW;
|
|
||||||
{* |<#listview>
|
|
||||||
The same as OnLVData, but for unicode version of the list view allows
|
|
||||||
to return WideString text in the event handler. Though for unicode list
|
|
||||||
view it is still possible to use ordinary event OnLVData, it is
|
|
||||||
very recommended to use this event istead. }
|
|
||||||
function TVInsertW( nParent, nAfter: THandle; const Txt: WideString ): THandle;
|
|
||||||
{* |<#treeview>
|
|
||||||
Inserts item to a tree view. If nParent is 0 or TVI_ROOT, the item is
|
|
||||||
inserted at the root of tree view. It is possible to pass following special
|
|
||||||
values as nAfter parameter:
|
|
||||||
|<pre>
|
|
||||||
TVI_FIRST Inserts the item at the beginning of the list.
|
|
||||||
TVI_LAST Inserts the item at the end of the list.
|
|
||||||
TVI_SORT Inserts the item into the list in alphabetical order.
|
|
||||||
|</pre><br>
|
|
||||||
This version of the method is Unicode. The tree view control should be
|
|
||||||
set up as unicode control calling Perform( TVM_SETUNICODEFORMAT, 1, 0 ),
|
|
||||||
and conditional symbol UNICODE_CTRLS must be defined to provide event
|
|
||||||
handling for such kind of tree view (and other Unicode) controls. }
|
|
||||||
property TVItemTextW[ Item: THandle ]: WideString read TVGetItemTextW write TVSetItemTextW;
|
|
||||||
{* |<#treeview>
|
|
||||||
Text of tree view item. }
|
|
||||||
function TVItemPathW( Item: THandle; Delimiter: WideChar ): WideString;
|
|
||||||
{* |<#treeview>
|
|
||||||
Returns full path from the root item to given item. Path is calculated
|
|
||||||
as a concatenation of all parent nodes text strings, separated by
|
|
||||||
given delimiter character. If Item is not specified ( =0 ), path is returned
|
|
||||||
for Selected item. }
|
|
||||||
{$ENDIF _FPC}
|
|
||||||
{$ENDIF interface_2} ///////////////////////////////////////////////////////////
|
|
||||||
|
|
||||||
{$IFDEF implementation} ////////////////////////////////////////////////////////
|
|
||||||
{$IFNDEF _FPC}
|
|
||||||
//[procedure LVGetItemW]
|
|
||||||
procedure LVGetItemW( Sender: PControl; Idx, Col: Integer; var LVI: TLVItemW;
|
|
||||||
TextBuf: PWideChar; TextBufSize: Integer );
|
|
||||||
begin
|
|
||||||
LVI.mask := LVIF_STATE or LVIF_PARAM or LVIF_IMAGE;
|
|
||||||
if Col > 0 then
|
|
||||||
if not (lvoSubItemImages in Sender.fLVOptions) then
|
|
||||||
LVI.mask := LVIF_STATE or LVIF_PARAM;
|
|
||||||
LVI.iItem := Idx;
|
|
||||||
LVI.iSubItem := Col;
|
|
||||||
LVI.pszText := TextBuf;
|
|
||||||
LVI.cchTextMax := TextBufSize;
|
|
||||||
if TextBufSize <> 0 then
|
|
||||||
LVI.mask := LVI.mask or LVIF_TEXT;
|
|
||||||
Sender.Perform( LVM_GETITEMW, 0, Integer( @LVI ) );
|
|
||||||
end;
|
|
||||||
|
|
||||||
//[procedure TControl.LVColAddW]
|
|
||||||
procedure TControl.LVColAddW(const aText: WideString; aalign: TTextAlign;
|
|
||||||
aWidth: Integer);
|
|
||||||
begin
|
|
||||||
LVColInsertW( fLVColCount, aText, aalign, aWidth );
|
|
||||||
end;
|
|
||||||
|
|
||||||
//[procedure TControl.LVColInsertW]
|
|
||||||
procedure TControl.LVColInsertW(ColIdx: Integer; const aText: WideString;
|
|
||||||
aAlign: TTextAlign; aWidth: Integer);
|
|
||||||
var LVColData: TLVColumnW;
|
|
||||||
begin
|
|
||||||
LVColData.mask := LVCF_FMT or LVCF_TEXT;
|
|
||||||
if ImageListSmall <> nil then
|
|
||||||
LVColData.mask := LVColData.mask; // or LVCF_IMAGE ;
|
|
||||||
LVColData.iImage := -1;
|
|
||||||
LVColData.fmt := Ord( aAlign );
|
|
||||||
if aWidth < 0 then
|
|
||||||
begin
|
|
||||||
aWidth := -aWidth;
|
|
||||||
LVColData.fmt := LVColData.fmt or LVCFMT_BITMAP_ON_RIGHT;
|
|
||||||
end;
|
|
||||||
LVColData.cx := aWidth;
|
|
||||||
if aWidth > 0 then
|
|
||||||
LVColData.mask := LVColData.mask or LVCF_WIDTH;
|
|
||||||
LVColData.pszText := PWideChar( aText );
|
|
||||||
if Perform( LVM_INSERTCOLUMNW, ColIdx, Integer( @LVColData ) ) >= 0 then
|
|
||||||
Inc( fLVColCount );
|
|
||||||
end;
|
|
||||||
|
|
||||||
//[function TControl.GetLVColTextW]
|
|
||||||
function TControl.GetLVColTextW(Idx: Integer): WideString;
|
|
||||||
var Buf: array[ 0..4095 ] of WideChar;
|
|
||||||
LC: TLVColumnW;
|
|
||||||
begin
|
|
||||||
LC.mask := LVCF_TEXT;
|
|
||||||
LC.pszText := @ Buf[ 0 ];
|
|
||||||
LC.cchTextMax := High( Buf ) + 1;
|
|
||||||
Buf[ 0 ] := #0;
|
|
||||||
Perform( LVM_GETCOLUMNW, Idx, Integer( @ LC ) );
|
|
||||||
Result := Buf;
|
|
||||||
end;
|
|
||||||
|
|
||||||
//[procedure TControl.SetLVColTextW]
|
|
||||||
procedure TControl.SetLVColTextW(Idx: Integer; const Value: WideString);
|
|
||||||
var LC: TLVColumnW;
|
|
||||||
begin
|
|
||||||
FillChar( LC, Sizeof( LC ), 0 );
|
|
||||||
LC.mask := LVCF_TEXT;
|
|
||||||
LC.pszText := '';
|
|
||||||
if Value <> '' then
|
|
||||||
LC.pszText := @ Value[ 1 ];
|
|
||||||
Perform( LVM_SETCOLUMNW, Idx, Integer( @ LC ) );
|
|
||||||
end;
|
|
||||||
|
|
||||||
//[function TControl.LVGetItemTextW]
|
|
||||||
function TControl.LVGetItemTextW(Idx, Col: Integer): WideString;
|
|
||||||
var LVI: TLVItemW;
|
|
||||||
TextBuf: PWideChar;
|
|
||||||
BufSize: DWORD;
|
|
||||||
begin
|
|
||||||
BufSize := 0;
|
|
||||||
TextBuf := nil;
|
|
||||||
repeat
|
|
||||||
if TextBuf <> nil then
|
|
||||||
FreeMem( TextBuf );
|
|
||||||
BufSize := BufSize * 2 + 100; // to vary in asm version
|
|
||||||
GetMem( TextBuf, BufSize * 2 );
|
|
||||||
TextBuf[ 0 ] := #0;
|
|
||||||
LVGetItemW( @Self, Idx, Col, LVI, TextBuf, BufSize );
|
|
||||||
until DWORD( WStrLen( TextBuf ) ) < BufSize - 1;
|
|
||||||
Result := TextBuf;
|
|
||||||
FreeMem( TextBuf );
|
|
||||||
end;
|
|
||||||
|
|
||||||
//[procedure TControl.LVSetItemTextW]
|
|
||||||
procedure TControl.LVSetItemTextW(Idx, Col: Integer;
|
|
||||||
const Value: WideString);
|
|
||||||
var LVI: TLVItemW;
|
|
||||||
begin
|
|
||||||
LVI.iSubItem := Col;
|
|
||||||
LVI.pszText := PWideChar( Value );
|
|
||||||
Perform( LVM_SETITEMTEXTW, Idx, Integer( @LVI ) );
|
|
||||||
end;
|
|
||||||
|
|
||||||
//[function TControl.TVGetItemTextW]
|
|
||||||
function TControl.TVGetItemTextW(Item: THandle): WideString;
|
|
||||||
var TVI: TTVItemW;
|
|
||||||
Buffer: array[ 0..4095 ] of WideChar;
|
|
||||||
begin
|
|
||||||
TVI.mask := TVIF_HANDLE or TVIF_TEXT;
|
|
||||||
TVI.hItem := Item;
|
|
||||||
TVI.pszText := @Buffer[ 0 ];
|
|
||||||
Buffer[ 0 ] := #0;
|
|
||||||
TVI.cchTextMax := High( Buffer ) + 1;
|
|
||||||
Perform( TVM_GETITEMW, 0, Integer( @TVI ) );
|
|
||||||
Result := Buffer;
|
|
||||||
end;
|
|
||||||
|
|
||||||
//[procedure TControl.TVSetItemTextW]
|
|
||||||
procedure TControl.TVSetItemTextW(Item: THandle; const Value: WideString);
|
|
||||||
var TVI: TTVItemW;
|
|
||||||
begin
|
|
||||||
TVI.mask := TVIF_HANDLE or TVIF_TEXT;
|
|
||||||
TVI.hItem := Item;
|
|
||||||
TVI.pszText := PWideChar( Value );
|
|
||||||
Perform( TVM_SETITEMW, 0, Integer( @TVI ) );
|
|
||||||
end;
|
|
||||||
|
|
||||||
//[function TControl.TVItemPathW]
|
|
||||||
function TControl.TVItemPathW(Item: THandle;
|
|
||||||
Delimiter: WideChar): WideString;
|
|
||||||
begin
|
|
||||||
if Item = 0 then
|
|
||||||
Item := TVSelected;
|
|
||||||
Result := '';
|
|
||||||
while Item <> 0 do
|
|
||||||
begin
|
|
||||||
if Result <> '' then
|
|
||||||
Result := Delimiter + Result;
|
|
||||||
Result := TVItemTextW[ Item ] + Result;
|
|
||||||
Item := TVItemParent[ Item ];
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
type
|
|
||||||
TTVInsertStructW = packed Record
|
|
||||||
hParent: THandle;
|
|
||||||
hAfter : THandle;
|
|
||||||
item: TTVItemW;
|
|
||||||
end;
|
|
||||||
TTVInsertStructExW = packed Record
|
|
||||||
hParent: THandle;
|
|
||||||
hAfter : THandle;
|
|
||||||
item: TTVItemExW;
|
|
||||||
end;
|
|
||||||
|
|
||||||
//[function TControl.TVInsertW]
|
|
||||||
function TControl.TVInsertW(nParent, nAfter: THandle;
|
|
||||||
const Txt: WideString): THandle;
|
|
||||||
var TVIns: TTVInsertStructW;
|
|
||||||
begin
|
|
||||||
TVIns.hParent := nParent;
|
|
||||||
TVIns.hAfter := nAfter;
|
|
||||||
TVIns.item.mask := TVIF_TEXT;
|
|
||||||
if Txt = '' then TVIns.item.pszText := nil
|
|
||||||
else TVIns.item.pszText := PWideChar( @ Txt[ 1 ] );
|
|
||||||
Result := Perform( TVM_INSERTITEMW, 0, Integer( @ TVIns ) );
|
|
||||||
Invalidate;
|
|
||||||
end;
|
|
||||||
|
|
||||||
//[function TControl.LVItemInsertW]
|
|
||||||
function TControl.LVItemInsertW(Idx: Integer;
|
|
||||||
const aText: WideString): Integer;
|
|
||||||
var LVI: TLVItemW;
|
|
||||||
begin
|
|
||||||
LVI.mask := LVIF_TEXT or LVIF_DI_SETITEM;
|
|
||||||
LVI.iItem := Idx;
|
|
||||||
LVI.iSubItem := 0;
|
|
||||||
LVI.pszText := PWideChar( aText );
|
|
||||||
Result := Perform( LVM_INSERTITEMW, 0, Integer( @LVI ) );
|
|
||||||
end;
|
|
||||||
|
|
||||||
//[function TControl.LVItemAddW]
|
|
||||||
function TControl.LVItemAddW(const aText: WideString): Integer;
|
|
||||||
begin
|
|
||||||
Result := LVItemInsertW( Count, aText );
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure TControl.SetOnLVDataW(const Value: TOnLVDataW);
|
|
||||||
begin
|
|
||||||
fOnLVDataW := Value;
|
|
||||||
AttachProc( @WndProc_LVData );
|
|
||||||
Perform( LVM_SETCALLBACKMASK, LVIS_OVERLAYMASK or LVIS_STATEIMAGEMASK, 0 );
|
|
||||||
end;
|
|
||||||
|
|
||||||
function TControl.LVIndexOfW(const S: WideString): Integer;
|
|
||||||
begin
|
|
||||||
Result := LVSearchForW( S, -1, FALSE );
|
|
||||||
end;
|
|
||||||
|
|
||||||
//[function TControl.LVSearchForW]
|
|
||||||
function TControl.LVSearchForW(const S: WideString; StartAfter: Integer;
|
|
||||||
Partial: Boolean): Integer;
|
|
||||||
var f: TLVFindInfoW;
|
|
||||||
begin
|
|
||||||
f.lParam := 0;
|
|
||||||
f.flags := LVFI_STRING;
|
|
||||||
if Partial then
|
|
||||||
f.flags := LVFI_STRING or LVFI_PARTIAL;
|
|
||||||
f.psz := @s[1];
|
|
||||||
result := Perform(LVM_FINDITEMW,StartAfter,integer(@f));
|
|
||||||
end;
|
|
||||||
{$ENDIF _FPC}
|
|
||||||
{$ENDIF implementation} ////////////////////////////////////////////////////////
|
|
||||||
Reference in New Issue
Block a user