pascal/kolmck
1
0
Fork 0
Code Issues Releases Activity

изменения:

Browse Source 
*1. Строка 5115:
    FBitBtnGetCaption: function( Self_: PControl; const S: KOLString ): KOLString;

Кэпшен может быть Wide, т.ч. нужен KOLString

*2. Строка 9724:
function NewMDIChild( AParent: PControl; const ACaption: KOLString ): PControl;

Кэпшен может быть Wide, т.ч. нужен KOLString

*4. Строка 17105:
  ( PKOLChar(@fData.Font.Name[0]), PKOLChar( Value ), Length(Value) * SizeOf(KOLChar) {LF_FACESIZE} ); //TODO: fixme

При UNICODE_CTRLS необходимо учитывать SizeOf(KOLChar) иначе идет обрезка текста по середине...

*5. лучше:
  Find_Close( FD );
переместить с стр.21583 на 3 строки ниже. Поскольку дальше используется FD.dwFileAttributes и FileTimeToLocalFileTime( FD.ftLastWriteTime, LFT ). И если щас (в XP) - это может быть непринципиально, то в последующем может вылезти косяк, т.к. фатически ты FD закрыл, но работать с ним хочешь...

*6.
procedure TDirList.ScanDirectory(const DirPath, Filter: KOLString;  Attr: DWord);
добавлена новая директива FORCE_ALTERNATEFILENAME - принудительное использование альтернативного имени пути и имени файла для юникод путей 

*7. Стр. 29024
function ExcludeAmpersands( Self_: PControl; const S: KOLString ): KOLString;
AnsiString -> KOLString

*8. Стр. 31468 (Продолжение пункта 2) AnsiString -> KOLString

*9. Стр. 32737
   /// if WinVer >= wvNT then ЗАКОММЕНТИРОВАТЬ СТРОКУ ОБЯЗАТЕЛЬНО!!! Этот фикс для работы программ на Win9x/ME
Если она раскоментированна и есть меню. Абздец наступает не только приложению, но и всей системе

*10. Фикс утечки памяти в TControl.CreateWindow:

*11. Стр. 4006
procedure TDirList.ScanDirectoryEx(const DirPath, Filters: AnsiString;
Фильтры могут быть KOLString

*12. visual_xp_styles.inc
 Sender.OnPaint(Sender, GetWindowDC(Msg.hWnd));
->
   dDC := GetWindowDC(Msg.hWnd);
   Sender.OnPaint(Sender, dDC);
   ReleaseDC( Msg.hWnd, dDC );

*13. множество фиксов KOLadd, err для поддержки уникода и работы в 2007\2009 версии делфи

MTsv DN

*14. WinVer - теперь определяет Windows7. D[u]fa.

git-svn-id: https://svn.code.sf.net/p/kolmck/code@13 91bb2d04-0c0c-4d2d-88a5-bbb6f4c1fa07
This commit is contained in:
dkolmck
2009-08-09 13:02:09 +00:00
parent 82d20b8abd
commit 777b06f88a
5 changed files with 206 additions and 181 deletions
Download Patch File Download Diff File Expand all files Collapse all files

68
Addons/err.pas
View File

@@ -125,7 +125,7 @@ resourcestring
SReadAccess = 'Read';
SWriteAccess = 'Write';
//SResultTooLong = 'Format result longer than 4096 characters';
//SFormatTooLong = 'Format string too long';
//SFormatTooLong = 'Format AnsiString too long';
SExternalException = 'External exception %x';
SAssertionFailed = 'Assertion failed';
SIntfCastError = 'Interface not supported';
@@ -152,7 +152,7 @@ type
{ Generic filename type }
TFileName = type string;
TFileName = type AnsiString;
{ Exceptions }
Exception = class;
@@ -177,31 +177,31 @@ type
protected
FCode: TError;
FErrorCode: DWORD;
FMessage: string;
FMessage: AnsiString;
FExceptionRecord: PExceptionRecord;
FData: Pointer;
FOnDestroy: TDestroyException;
procedure SetData(const Value: Pointer);
public
constructor Create(ACode: TError; const Msg: string);
constructor Create(ACode: TError; const Msg: AnsiString);
{* Use this constructor to raise exception, which does not require of
argument formatting. }
constructor CreateFmt(ACode: TError; const Msg: string; const Args: array of const);
{* Use this constructor to raise an exception with formatted Message string.
constructor CreateFmt(ACode: TError; const Msg: AnsiString; const Args: array of const);
{* Use this constructor to raise an exception with formatted Message AnsiString.
Take into attention, that Format procedure defined in KOL, uses API wvsprintf
function, which can understand a restricted set of format specifications. }
constructor CreateCustom(AError: DWORD; const Msg: String);
constructor CreateCustom(AError: DWORD; const Msg: AnsiString);
{* Use this constructor to create e_Custom exception and to assign AError to
its ErrorCode property. }
constructor CreateCustomFmt(AError: DWORD; const Msg: String; const Args: array of const);
constructor CreateCustomFmt(AError: DWORD; const Msg: AnsiString; const Args: array of const);
{* Use this constructor to create e_Custom exception with formatted message
string and to assign AError to its ErrorCode property. }
AnsiString and to assign AError to its ErrorCode property. }
constructor CreateResFmt(ACode: TError; Ident: Integer; const Args: array of const);
{* }
destructor Destroy; override;
{* destructor }
property Message: string read FMessage; // write FMessage;
{* Text string, containing descriptive message about the exception. }
property Message: AnsiString read FMessage; // write FMessage;
{* Text AnsiString, containing descriptive message about the exception. }
property Code: TError read FCode;
{* Main exception code. This property can be used to determine, which exception
occure. }
@@ -253,7 +253,7 @@ procedure AddExitProc(Proc: TProcedure);
{ System error messages }
function SysErrorMessage(ErrorCode: Integer): string;
function SysErrorMessage(ErrorCode: Integer): AnsiString;
{ Exception handling routines }
@@ -327,7 +327,7 @@ function SafeLoadLibrary(const Filename: KOLString;
implementation
{procedure ConvertError(const Ident: string);
{procedure ConvertError(const Ident: AnsiString);
begin
raise Exception.Create(e_Convert, Ident);
end;
@@ -385,7 +385,7 @@ end;
{ System error messages }
function SysErrorMessage(ErrorCode: Integer): string;
function SysErrorMessage(ErrorCode: Integer): AnsiString;
var
Len: Integer;
Buffer: array[0..255] of KOLChar;
@@ -492,7 +492,7 @@ end;
{$ENDIF}
{$IFDEF _D2}
function LoadStr(Ident: Integer): string;
function LoadStr(Ident: Integer): AnsiString;
var
Buffer: array[0..1023] of Char;
begin
@@ -500,7 +500,7 @@ begin
SizeOf(Buffer)));
end;
{$ELSE}
function LoadStr(Ident: Integer): string;
function LoadStr(Ident: Integer): AnsiString;
var
Buffer: array[0..1023] of KOLChar;
begin
@@ -508,7 +508,7 @@ begin
end;
{$ENDIF}
function FmtLoadStr(Ident: Integer; const Args: array of const): string;
function FmtLoadStr(Ident: Integer; const Args: array of const): AnsiString;
begin
//FmtStr(Result, LoadStr(Ident), Args);
Result := Format(LoadStr(Ident), Args);
@@ -517,12 +517,12 @@ end;
function ExceptionErrorMessage(ExceptObject: TObject; ExceptAddr: Pointer;
Buffer: PKOLChar; Size: Integer): Integer;
var
MsgPtr: PChar;
//MsgEnd: PChar;
MsgPtr: PAnsiChar;
//MsgEnd: PAnsiChar;
//MsgLen: Integer;
ModuleName: array[0..MAX_PATH] of KOLChar;
//Temp: array[0..MAX_PATH] of Char;
Fmt: array[0..255] of Char;
Fmt: array[0..255] of AnsiChar;
Info: TMemoryBasicInformation;
ConvertedAddress: Pointer;
begin
@@ -543,7 +543,7 @@ begin
//MsgEnd := '';
if ExceptObject is Exception then
begin
MsgPtr := PChar(Exception(ExceptObject).Message);
MsgPtr := PAnsiChar(Exception(ExceptObject).Message);
//MsgLen := StrLen(MsgPtr);
//if (MsgLen <> 0) and (MsgPtr[MsgLen - 1] <> '.') then MsgEnd := '.';
{-} // Isn't it too beautiful - devote ~40 bytes of code just to decide,
@@ -557,7 +557,7 @@ begin
{$ENDIF}
//MsgOK( ModuleName );
{$IFDEF UNICODE_CTRLS} WStrCopy {$ELSE} StrCopy {$ENDIF}
( Buffer, PKOLChar( Format( Fmt, [ ExceptObject.ClassName,
( Buffer, PKOLChar( Format( KOLString(Fmt), [ ExceptObject.ClassName,
ModuleName, ConvertedAddress, MsgPtr, '' {MsgEnd}]) ) );
Result := {$IFDEF UNICODE_CTRLS} WStrLen {$ELSE} StrLen {$ENDIF}(Buffer);
end;
@@ -620,21 +620,21 @@ begin
FData := Value;
end;
constructor Exception.Create(ACode: TError; const Msg: string);
constructor Exception.Create(ACode: TError; const Msg: AnsiString);
begin
FCode := ACode;
FMessage := Msg;
//FAllowFree := TRUE;
end;
constructor Exception.CreateCustom(AError: DWORD; const Msg: String);
constructor Exception.CreateCustom(AError: DWORD; const Msg: AnsiString);
begin
FCode := e_Custom;
FMessage := Msg;
FErrorCode := AError;
end;
constructor Exception.CreateCustomFmt(AError: DWORD; const Msg: String;
constructor Exception.CreateCustomFmt(AError: DWORD; const Msg: AnsiString;
const Args: array of const);
begin
FCode := e_Custom;
@@ -642,7 +642,7 @@ begin
FMessage := Format(Msg, Args);
end;
constructor Exception.CreateFmt(ACode: TError; const Msg: string;
constructor Exception.CreateFmt(ACode: TError; const Msg: AnsiString;
const Args: array of const);
begin
FCode := ACode;
@@ -663,7 +663,7 @@ function CreateInOutError: Exception;
type
TErrorRec = record
Code: Integer;
Ident: string;
Ident: AnsiString;
end;
const
ErrorMap: array[0..5] of TErrorRec = (
@@ -694,7 +694,7 @@ end;
type
TExceptMapRec = packed record
ECode: TError;
EIdent: String;
EIdent: AnsiString;
end;
const
@@ -765,10 +765,10 @@ end;
{ routine RaiseAssertException sets up the registers just as if the user }
{ code itself had raised the exception. }
function CreateAssertException(const Message, Filename: string;
function CreateAssertException(const Message, Filename: AnsiString;
LineNumber: Integer): Exception;
var
S: string;
S: AnsiString;
begin
if Message <> '' then S := Message else S := SAssertionFailed;
Result := Exception.CreateFmt(e_Assertion, SAssertError,
@@ -790,13 +790,13 @@ end;
{ If you change this procedure, make sure it does not have any local variables }
{ or temps that need cleanup - they won't get cleaned up due to the way }
{ RaiseAssertException frame works. Also, it can not have an exception frame. }
procedure AssertErrorHandler(const Message, Filename: string;
procedure AssertErrorHandler(const Message, Filename: AnsiString;
LineNumber: Integer; ErrorAddr: Pointer);
var
E: Exception;
begin
E := CreateAssertException(Message, Filename, LineNumber);
RaiseAssertException(E, ErrorAddr, PChar(@ErrorAddr)+4);
RaiseAssertException(E, ErrorAddr, PAnsiChar(@ErrorAddr)+4);
end;
{ Abstract method invoke error handler }
@@ -891,7 +891,7 @@ var
function CreateAVObject: Exception;
var
AccessOp: string; // string ID indicating the access type READ or WRITE
AccessOp: AnsiString; // AnsiString ID indicating the access type READ or WRITE
AccessAddress: Pointer;
MemInfo: TMemoryBasicInformation;
ModName: array[0..MAX_PATH] of KOLChar;
@@ -933,7 +933,7 @@ end;
procedure ExceptHandler(ExceptObject: TObject; ExceptAddr: Pointer); far;
begin
ShowException(ExceptObject, ExceptAddr);
Halt(1);
Halt(1);
end;
{+}

46
KOL.pas
View File

@@ -411,6 +411,10 @@ unit KOL; {-}
AUTO_REPLACE_CLEARTYPE- to replace automatically CLEARTYPE_QUALITY fonts
with ANTIALIASED_QUALITY when running under elder
Windows version than XP.
FORCE_ALTERNATEFILENAME- TDirList.ScanDirectoryFORCE_ALTERNATEFILENAME - forced
using an alternate file path and filename for unicode
paths (ïðèíóäèòåëüíîå èñïîëüçîâàíèå àëüòåðíàòèâíîãî èìåíè
ïóòè è èìåíè ôàéëà äëÿ þíèêîä ïóòåé)
NEW_GRADIENT - to use new gradient painting by homm (fast).
OLD_ALIGN - to prevent using new Align by Galkov.
@@ -5112,7 +5116,7 @@ type
fNotAvailable: Boolean;
FPressedMnemonic: DWORD;
FBitBtnDrawMnemonic: Boolean;
FBitBtnGetCaption: function( Self_: PControl; const S: AnsiString ): AnsiString;
FBitBtnGetCaption: function( Self_: PControl; const S: KOLString ): KOLString;
FBitBtnExtDraw: procedure( Self_: PControl; DC: HDC; X, Y: Integer; const R: TRect;
const CapText, CapTxtOrig: KOLString; Color: TColor );
FTextShiftX, FTextShiftY: Integer;
@@ -9721,7 +9725,7 @@ function NewMDIClient( AParent: PControl; WindowMenu: THandle ): PControl;
|<br>Note:
MDI client must be a single on the form. }
function NewMDIChild( AParent: PControl; const ACaption: AnsiString ): PControl;
function NewMDIChild( AParent: PControl; const ACaption: KOLString ): PControl;
{* |<#control>
Creates MDI client window. AParent should be a MDI client window,
created with NewMDIClient function. }
@@ -12572,7 +12576,7 @@ function WindowsLogoff( Force : Boolean ) : Boolean;
type
TWindowsVersion = ( wv31, wv95, wv98, wvME, wvNT, wvY2K, wvXP, wvServer2003,
wvVista );
wvVista, wvSeven );
{* Windows versions constants. }
TWindowsVersions = Set of TWindowsVersion;
{* Set of Windows version (e.g. to define a range of versions supported by the
@@ -17102,7 +17106,7 @@ begin
if fData.Font.Name = Value then Exit;
FillChar( fData.Font.Name[ 0 ], LF_FACESIZE, #0 );
{$IFDEF UNICODE_CTRLS} WStrLCopy {$ELSE} StrLCopy {$ENDIF}
( PKOLChar(@fData.Font.Name[0]), PKOLChar( Value ), Length(Value) {LF_FACESIZE} ); //TODO: fixme
( PKOLChar(@fData.Font.Name[0]), PKOLChar( Value ), Length(Value) * SizeOf(KOLChar) {LF_FACESIZE} ); //TODO: fixme
Changed;
end;
@@ -21580,10 +21584,10 @@ begin
{$IFDEF FILE_EXISTS_EX}
Result := FALSE;
if not Find_First( Filename, FD ) then Exit;
Find_Close( FD );
if FD.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY <> 0 then Exit;
FileTimeToLocalFileTime( FD.ftLastWriteTime, LFT );
if FileTimeToDosDateTime( LFT, Hi, Lo ) then Result := TRUE;
Find_Close( FD );
{$ELSE}
Code := GetFileAttributes(PKOLChar(FileName));
Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code = 0);
@@ -21607,10 +21611,10 @@ begin
{$IFDEF notimplemented_FILE_EXISTS_EX}
Result := FALSE;
if not WFind_First( Filename, FD ) then Exit;
WFind_Close( FD );
if FD.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY <> 0 then Exit;
FileTimeToLocalFileTime( FD.ftLastWriteTime, LFT );
if FileTimeToDosDateTime( LFT, Hi, Lo ) then Result := TRUE;
WFind_Close( FD );
{$ELSE}
Code := GetFileAttributesW(PWideChar(FileName));
Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code = 0);
@@ -23388,7 +23392,7 @@ procedure TDirList.ScanDirectory(const DirPath, Filter: KOLString;
var FindData : TFindFileData;
E : PFindFileData;
Action: TDirItemAction;
{$IFDEF UNICODE_CTRLS}
{$IFDEF FORCE_ALTERNATEFILENAME}
IsUnicode: AnsiString;
{$ENDIF}
begin
@@ -23397,7 +23401,7 @@ begin
if (FPath = '') then Exit;
FPath := IncludeTrailingPathDelimiter( FPath );
if not Assigned(fFilters) then begin
fFilters := {$IFDEF UNICODE_CTRLS} NewWStrList {$ELSE} NewStrList {$ENDIF};
fFilters := {$IFDEF FORCE_ALTERNATEFILENAME} NewWStrList {$ELSE} NewStrList {$ENDIF};
if Filter = '*.*' then
fFilters.Add( '*' )
else
@@ -23407,7 +23411,7 @@ begin
FList := NewList;
while True do
begin
{$IFDEF UNICODE_CTRLS} //+MtsVN in 2.58 / 14Apr2007
{$IFDEF FORCE_ALTERNATEFILENAME} //+MtsVN
IsUnicode := FindData.cFileName;
if (IsUnicode <> '.') and (IsUnicode <> '..') then
begin
@@ -29021,7 +29025,7 @@ end;
//[END WndProc_DrawItem]
//[function ExcludeAmpersands]
function ExcludeAmpersands( Self_: PControl; const S: AnsiString ): AnsiString;
function ExcludeAmpersands( Self_: PControl; const S: KOLString ): KOLString;
var I: Integer;
begin
Result := S;
@@ -31465,7 +31469,7 @@ begin
end;
//[function NewMDIChild]
function NewMDIChild( AParent: PControl; const ACaption: AnsiString ): PControl;
function NewMDIChild( AParent: PControl; const ACaption: KOLString ): PControl;
var MDIClient: PControl;
begin
Assert( (AParent <> nil) and (AParent.ParentForm <> nil) and
@@ -32734,7 +32738,7 @@ begin
if Assigned( Self_.fOnResize ) then
Self_.fOnResize( Self_ );
{$IFNDEF TOOLBAR_FORCE_CHILDALIGN}
if WinVer >= wvNT then
//if WinVer >= wvNT then
Result := TRUE; // this prevents Align working for child controls of Toolbar !
// but removing this line makes impossible correct Align for
// neighbour controls on form!!!
@@ -33757,6 +33761,9 @@ var TempClass: TWndClass;
{$IFDEF _FPC}
SClassName: AnsiString;
{$ENDIF ASM_VERSION}
{$IFDEF UNICODE_CTRLS}
TempOleStr : PWideChar;
{$ENDIF}
begin
{$IFDEF INPACKAGE}
Log( '->TControl.CreateWindow' );
@@ -33808,7 +33815,9 @@ begin
{$IFNDEF UNICODE_CTRLS}
StrCopy( Params.WinClsNamBuf, @ SubClassName[ 1 ] );
{$ELSE}
lstrcpyW(Params.WinClsNamBuf,StringToOleStr(SubClassName));
TempOleStr := StringToOleStr(AnsiString(SubClassName));
lstrcpyW(Params.WinClsNamBuf, TempOleStr);
SysFreeString( TempOleStr );
{$ENDIF}
{$ENDIF}
Params.Param := nil;
@@ -54035,7 +54044,7 @@ end;
var SaveWinVer: Byte = $FF;
//[function WinVer]
{$IFDEF ASM_VERSION}
{$IFDEF nonononoASM_VERSION}
{$ELSE ASM_VERSION}
function WinVer : TWindowsVersion;
var MajorVersion, MinorVersion: Byte;
@@ -54050,9 +54059,12 @@ begin
if dwVersion >= 0 then
begin
Result := wvNT;
if MajorVersion >= 6 then
Result := wvVista
else begin
if (MajorVersion >= 6) then begin
if (MinorVersion >= 1) then
Result := wvSeven
else
Result := wvVista;
end else begin
if MajorVersion >= 5 then
if MinorVersion >= 1 then
begin

4
KOL_ASM.inc
View File

@@ -17890,7 +17890,7 @@ asm //cmd //opd
//@@exit: XCHG EAX, ECX
end;
function WinVer : TWindowsVersion;
{function WinVer : TWindowsVersion;
asm
MOVSX EAX, byte ptr [SaveWinVer]
INC AH // ���� <> 0 ����� ����������, �� AL �������� ����������� ������
@@ -17928,7 +17928,7 @@ asm
@@save_exit:
MOV byte ptr [SaveWinVer], AL
@@exit:
end;
end;}
//======================================== THE END OF FILE KOL_ASM.inc

238
KOLadd.pas
View File

@@ -204,117 +204,117 @@ type
fUsedSiz: DWORD;
protected
procedure ProvideSpace( AddSize: DWORD );
function Get(Idx: integer): string;
function GetTextStr: string;
procedure Put(Idx: integer; const Value: string);
procedure SetTextStr(const Value: string);
function Get(Idx: integer): AnsiString;
function GetTextStr: AnsiString;
procedure Put(Idx: integer; const Value: AnsiString);
procedure SetTextStr(const Value: AnsiString);
function GetPChars( Idx: Integer ): PAnsiChar;
{++}(*public*){--}
destructor Destroy; {-}virtual;{+}{++}(*override;*){--}
public
function AddAnsi( const S: String ): Integer;
{* Adds Ansi String to a list. }
function AddAnsiObject( const S: String; Obj: DWORD ): Integer;
{* Adds Ansi String and correspondent object to a list. }
function AddAnsi( const S: AnsiString ): Integer;
{* Adds Ansi AnsiString to a list. }
function AddAnsiObject( const S: AnsiString; Obj: DWORD ): Integer;
{* Adds Ansi AnsiString and correspondent object to a list. }
function Add(S: PAnsiChar): integer;
{* Adds a string to list. }
{* Adds a AnsiString to list. }
function AddLen(S: PAnsiChar; Len: Integer): integer;
{* Adds a string to list. The string can contain #0 characters. }
{* Adds a AnsiString to list. The AnsiString can contain #0 characters. }
public
FastClear: Boolean;
{* }
procedure Clear;
{* Makes string list empty. }
{* Makes AnsiString list empty. }
procedure Delete(Idx: integer);
{* Deletes string with given index (it *must* exist). }
function IndexOf(const S: string): integer;
{* Returns index of first string, equal to given one. }
function IndexOf_NoCase(const S: string): integer;
{* Returns index of first string, equal to given one (while comparing it
{* Deletes AnsiString with given index (it *must* exist). }
function IndexOf(const S: AnsiString): integer;
{* Returns index of first AnsiString, equal to given one. }
function IndexOf_NoCase(const S: AnsiString): integer;
{* Returns index of first AnsiString, equal to given one (while comparing it
without case sensitivity). }
function IndexOfStrL_NoCase( Str: PAnsiChar; L: Integer ): integer;
{* Returns index of first string, equal to given one (while comparing it
{* Returns index of first AnsiString, equal to given one (while comparing it
without case sensitivity). }
function Find(const S: String; var Index: Integer): Boolean;
{* Returns Index of the first string, equal or greater to given pattern, but
works only for sorted TFastStrListEx object. Returns TRUE if exact string found,
otherwise nearest (greater then a pattern) string index is returned,
function Find(const S: AnsiString; var Index: Integer): Boolean;
{* Returns Index of the first AnsiString, equal or greater to given pattern, but
works only for sorted TFastStrListEx object. Returns TRUE if exact AnsiString found,
otherwise nearest (greater then a pattern) AnsiString index is returned,
and the result is FALSE. }
procedure InsertAnsi(Idx: integer; const S: String);
{* Inserts ANSI string before one with given index. }
procedure InsertAnsiObject(Idx: integer; const S: String; Obj: DWORD);
{* Inserts ANSI string before one with given index. }
procedure InsertAnsi(Idx: integer; const S: AnsiString);
{* Inserts ANSI AnsiString before one with given index. }
procedure InsertAnsiObject(Idx: integer; const S: AnsiString; Obj: DWORD);
{* Inserts ANSI AnsiString before one with given index. }
procedure Insert(Idx: integer; S: PAnsiChar);
{* Inserts string before one with given index. }
{* Inserts AnsiString before one with given index. }
procedure InsertLen( Idx: Integer; S: PAnsiChar; Len: Integer );
{* Inserts string from given PChar. It can contain #0 characters. }
function LoadFromFile(const FileName: string): Boolean;
{* Loads string list from a file. (If file does not exist, nothing
{* Inserts AnsiString from given PChar. It can contain #0 characters. }
function LoadFromFile(const FileName: AnsiString): Boolean;
{* Loads AnsiString list from a file. (If file does not exist, nothing
happens). Very fast even for huge text files. }
procedure LoadFromStream(Stream: PStream; Append2List: boolean);
{* Loads string list from a stream (from current position to the end of
{* Loads AnsiString list from a stream (from current position to the end of
a stream). Very fast even for huge text. }
procedure MergeFromFile(const FileName: string);
{* Merges string list with strings in a file. Fast. }
procedure MergeFromFile(const FileName: AnsiString);
{* Merges AnsiString list with strings in a file. Fast. }
procedure Move(CurIndex, NewIndex: integer);
{* Moves string to another location. }
procedure SetText(const S: string; Append2List: boolean);
{* Allows to set strings of string list from given string (in which
{* Moves AnsiString to another location. }
procedure SetText(const S: AnsiString; Append2List: boolean);
{* Allows to set strings of AnsiString list from given AnsiString (in which
strings are separated by $0D,$0A or $0D characters). Text can
contain #0 characters. Works very fast. This method is used in
all others, working with text arrays (LoadFromFile, MergeFromFile,
Assign, AddStrings). }
function SaveToFile(const FileName: string): Boolean;
{* Stores string list to a file. }
function SaveToFile(const FileName: AnsiString): Boolean;
{* Stores AnsiString list to a file. }
procedure SaveToStream(Stream: PStream);
{* Saves string list to a stream (from current position). }
function AppendToFile(const FileName: string): Boolean;
{* Appends strings of string list to the end of a file. }
{* Saves AnsiString list to a stream (from current position). }
function AppendToFile(const FileName: AnsiString): Boolean;
{* Appends strings of AnsiString list to the end of a file. }
property Count: integer read fCount;
{* Number of strings in a string list. }
property Items[Idx: integer]: string read Get write Put; default;
{* Strings array items. If item does not exist, empty string is returned.
But for assign to property, string with given index *must* exist. }
{* Number of strings in a AnsiString list. }
property Items[Idx: integer]: AnsiString read Get write Put; default;
{* Strings array items. If item does not exist, empty AnsiString is returned.
But for assign to property, AnsiString with given index *must* exist. }
property ItemPtrs[ Idx: Integer ]: PAnsiChar read GetPChars;
{* Fast access to item strings as PChars. }
property ItemLen[ Idx: Integer ]: Integer read GetItemLen;
{* Length of string item. }
function Last: String;
{* Last item (or '', if string list is empty). }
property Text: string read GetTextStr write SetTextStr;
{* Content of string list as a single string (where strings are separated
{* Length of AnsiString item. }
function Last: AnsiString;
{* Last item (or '', if AnsiString list is empty). }
property Text: AnsiString read GetTextStr write SetTextStr;
{* Content of AnsiString list as a single AnsiString (where strings are separated
by characters $0D,$0A). }
procedure Swap( Idx1, Idx2 : Integer );
{* Swaps to strings with given indeces. }
procedure Sort( CaseSensitive: Boolean );
{* Call it to sort string list. }
{* Call it to sort AnsiString list. }
public
function AddObject( S: PAnsiChar; Obj: DWORD ): Integer;
{* Adds string S (null-terminated) with associated object Obj. }
{* Adds AnsiString S (null-terminated) with associated object Obj. }
function AddObjectLen( S: PAnsiChar; Len: Integer; Obj: DWORD ): Integer;
{* Adds string S of length Len with associated object Obj. }
{* Adds AnsiString S of length Len with associated object Obj. }
procedure InsertObject( Idx: Integer; S: PAnsiChar; Obj: DWORD );
{* Inserts string S (null-terminated) at position Idx in the list,
{* Inserts AnsiString S (null-terminated) at position Idx in the list,
associating it with object Obj. }
procedure InsertObjectLen( Idx: Integer; S: PAnsiChar; Len: Integer; Obj: DWORD );
{* Inserts string S of length Len at position Idx in the list,
{* Inserts AnsiString S of length Len at position Idx in the list,
associating it with object Obj. }
property Objects[ Idx: Integer ]: DWORD read GetObject write SetObject;
{* Access to objects associated with strings in the list. }
public
procedure Append( S: PAnsiChar );
{* Appends S (null-terminated) to the last string in FastStrListEx object, very fast. }
{* Appends S (null-terminated) to the last AnsiString in FastStrListEx object, very fast. }
procedure AppendLen( S: PAnsiChar; Len: Integer );
{* Appends S of length Len to the last string in FastStrListEx object, very fast. }
{* Appends S of length Len to the last AnsiString in FastStrListEx object, very fast. }
procedure AppendInt2Hex( N: DWORD; MinDigits: Integer );
{* Converts N to hexadecimal and appends resulting string to the last
string, very fast. }
{* Converts N to hexadecimal and appends resulting AnsiString to the last
AnsiString, very fast. }
public
property Values[ Name: PAnsiChar ]: PAnsiChar read GetValues;
{* Returns a value correspondent to the Name an ini-file-like string list
(having Name1=Value1 Name2=Value2 etc. in each string). }
{* Returns a value correspondent to the Name an ini-file-like AnsiString list
(having Name1=Value1 Name2=Value2 etc. in each AnsiString). }
function IndexOfName( AName: PAnsiChar ): Integer;
{* Searches string starting from 'AName=' in string list like ini-file. }
{* Searches AnsiString starting from 'AName=' in AnsiString list like ini-file. }
end;
function NewFastStrListEx: PFastStrListEx;
@@ -380,7 +380,7 @@ type
- by a decision of the system).
|<br>
If a sequence of CAB files is used, and not all names for CAB files
are provided (absent or represented by a string '?' ), an event
are provided (absent or represented by a AnsiString '?' ), an event
OnNextCAB is called to obtain the name of the next CAB file.}
property CurCAB: Integer read FCurCAB;
{* Index of current CAB file in a sequence of CAB files. When OnNextCAB
@@ -388,7 +388,7 @@ type
index of path, what should be provided. }
property OnNextCAB: TOnNextCAB read FOnNextCAB write FOnNextCAB;
{* This event is called, when a series of CAB files is needed and not
all CAB file names are provided (absent or represented by '?' string).
all CAB file names are provided (absent or represented by '?' AnsiString).
If this event is not assigned, the user is prompted to browse file. }
property OnFile: TOnCABFile read FOnFile write FOnFile;
{* This event is called for every file found during Execute method.
@@ -403,10 +403,10 @@ type
//[END OF TCABFile DEFINITION]
//[OpenCABFile DECLARATION]
function OpenCABFile( const APaths: array of String ): PCABFile;
function OpenCABFile( const APaths: array of AnsiString ): PCABFile;
{* This function creates TCABFile object, passing a sequence of CAB file names
(fully qualified). It is possible not to provide all names here, or pass '?'
string in place of some of those. For such files, either an event OnNextCAB
AnsiString in place of some of those. For such files, either an event OnNextCAB
will be called, or (and) user will be prompted to browse file during
executing (i.e. Extracting). }
@@ -496,7 +496,7 @@ type
{* Returns handle of enchanced metafile. }
function LoadFromStream( Strm: PStream ): Boolean;
{* Loads emf or wmf file format from stream. }
function LoadFromFile( const Filename: String ): Boolean;
function LoadFromFile( const Filename: AnsiString ): Boolean;
{* Loads emf or wmf from stream. }
procedure Draw( DC: HDC; X, Y: Integer );
{* Draws enchanced metafile on DC. }
@@ -684,7 +684,7 @@ type
{$IFDEF TREE_WIDE}
fNodeName: WideString;
{$ELSE}
fNodeName: String;
fNodeName: AnsiString;
{$ENDIF}
{$ENDIF}
fData: Pointer;
@@ -697,7 +697,7 @@ type
function GetIndexAmongSiblings: Integer;
protected
{$IFDEF USE_CONSTRUCTORS}
constructor CreateTree( AParent: PTree; const AName: String );
constructor CreateTree( AParent: PTree; const AName: AnsiString );
{* }
{$ENDIF}
{++}(*public*){--}
@@ -713,7 +713,7 @@ type
{$IFDEF TREE_WIDE}
property Name: WideString read fNodeName write fNodeName;
{$ELSE}
property Name: String read fNodeName write fNodeName;
property Name: AnsiString read fNodeName write fNodeName;
{$ENDIF}
{$ENDIF}
{* Optional node name. }
@@ -785,7 +785,7 @@ function NewTree( AParent: PTree; const AName: WideString ): PTree;
Constructs tree node, adding it to the end of children list of
the AParent. If AParent is nil, new root tree node is created. }
{$ELSE}
function NewTree( AParent: PTree; const AName: String ): PTree;
function NewTree( AParent: PTree; const AName: AnsiString ): PTree;
{* Constructs tree node, adding it to the end of children list of
the AParent. If AParent is nil, new root tree node is created. }
{$ENDIF}
@@ -795,7 +795,7 @@ function NewTree( AParent: PTree; const AName: String ): PTree;
ADDITIONAL UTILITIES
}
function MapFileRead( const Filename: String; var hFile, hMap: THandle ): Pointer;
function MapFileRead( const Filename: AnsiString; var hFile, hMap: THandle ): Pointer;
{* Opens file for read only (with share deny none attribute) and maps its
entire content using memory mapped files technique. The address of the
first byte of file mapped into the application address space is returned.
@@ -804,7 +804,7 @@ function MapFileRead( const Filename: String; var hFile, hMap: THandle ): Pointe
exceeding this value only 1/4 Gigabytes starting from the beginning of the
file is mapped therefore. }
function MapFile( const Filename: String; var hFile, hMap: THandle ): Pointer;
function MapFile( const Filename: AnsiString; var hFile, hMap: THandle ): Pointer;
{* Opens file for read/write (in exlusive mode) and maps its
entire content using memory mapped files technique. The address of the
first byte of file mapped into the application address space is returned.
@@ -820,13 +820,13 @@ type
TKOLActionList = PActionList;
{$ENDIF}
function ShowQuestion( const S: String; Answers: String ): Integer;
function ShowQuestion( const S: KOLString; Answers: KOLString ): Integer;
{* Modal dialog like ShowMsgModal. It is based on KOL form, so it can
be called also out of message loop, e.g. after finishing the
application. Also, this function *must* be used in MDI applications
in place of any dialog functions, based on MessageBox.
|<br>
The second parameter should be empty string or several possible
The second parameter should be empty AnsiString or several possible
answers separated by '/', e.g.: 'Yes/No/Cancel'. Result is
a number answered, starting from 1. For example, if 'Cancel'
was pressed, 3 will be returned.
@@ -836,7 +836,7 @@ function ShowQuestion( const S: String; Answers: String ): Integer;
function ShowQuestionEx( S: KOLString; Answers: KOLString; CallBack: TOnEvent ): Integer;
{* Like ShowQuestion, but with CallBack function, called just before showing
the dialog. }
procedure ShowMsgModal( const S: String );
procedure ShowMsgModal( const S: KOLString );
{* This message function can be used out of a message loop (e.g., after
finishing the application). It is always modal.
Actually, a form with word-wrap label (decorated as borderless edit
@@ -1380,18 +1380,18 @@ procedure InitUpper;
var c: AnsiChar;
begin
for c := #0 to #255 do
Upper[ c ] := AnsiUpperCase( c + #0 )[ 1 ];
Upper[ c ] := AnsiUpperCase( AnsiString(c + #0) )[ 1 ];
Upper_Initialized := TRUE;
end;
{ TFastStrListEx }
function TFastStrListEx.AddAnsi(const S: String): Integer;
function TFastStrListEx.AddAnsi(const S: AnsiString): Integer;
begin
Result := AddObjectLen( PAnsiChar( S ), Length( S ), 0 );
end;
function TFastStrListEx.AddAnsiObject(const S: String; Obj: DWORD): Integer;
function TFastStrListEx.AddAnsiObject(const S: AnsiString; Obj: DWORD): Integer;
begin
Result := AddObjectLen( PAnsiChar( S ), Length( S ), Obj );
end;
@@ -1430,12 +1430,12 @@ begin
Inc( fUsedSiz, Len+9 );
end;
function TFastStrListEx.AppendToFile(const FileName: string): Boolean;
function TFastStrListEx.AppendToFile(const FileName: AnsiString): Boolean;
var F: HFile;
Txt: String;
Txt: AnsiString;
begin
Txt := Text;
F := FileCreate( FileName, ofOpenAlways or ofOpenReadWrite or ofShareDenyWrite );
F := FileCreate( KOLString(FileName), ofOpenAlways or ofOpenReadWrite or ofShareDenyWrite );
if F = INVALID_HANDLE_VALUE then Result := FALSE
else begin
FileSeek( F, 0, spEnd );
@@ -1480,7 +1480,7 @@ begin
inherited;
end;
function TFastStrListEx.Find(const S: String; var Index: Integer): Boolean;
function TFastStrListEx.Find(const S: AnsiString; var Index: Integer): Boolean;
var i: Integer;
begin
for i := 0 to Count-1 do
@@ -1494,7 +1494,7 @@ begin
Result := FALSE;
end;
function TFastStrListEx.Get(Idx: integer): string;
function TFastStrListEx.Get(Idx: integer): AnsiString;
begin
if (Idx >= 0) and (Idx <= Count) then
SetString( Result, PAnsiChar( DWORD( fTextBuf ) + DWORD( fList.Items[ Idx ] ) + 8 ),
@@ -1532,7 +1532,7 @@ begin
else Result := nil;
end;
function TFastStrListEx.GetTextStr: string;
function TFastStrListEx.GetTextStr: AnsiString;
var L, i: Integer;
p: PAnsiChar;
begin
@@ -1554,12 +1554,12 @@ begin
end;
end;
function TFastStrListEx.IndexOf(const S: string): integer;
function TFastStrListEx.IndexOf(const S: AnsiString): integer;
begin
if not Find( S, Result ) then Result := -1;
end;
function TFastStrListEx.IndexOf_NoCase(const S: string): integer;
function TFastStrListEx.IndexOf_NoCase(const S: AnsiString): integer;
begin
Result := IndexOfStrL_NoCase( PAnsiChar( S ), Length( S ) );
end;
@@ -1584,12 +1584,12 @@ begin
FastClear := TRUE;
end;
procedure TFastStrListEx.InsertAnsi(Idx: integer; const S: String);
procedure TFastStrListEx.InsertAnsi(Idx: integer; const S: AnsiString);
begin
InsertObjectLen( Idx, PAnsiChar( S ), Length( S ), 0 );
end;
procedure TFastStrListEx.InsertAnsiObject(Idx: integer; const S: String;
procedure TFastStrListEx.InsertAnsiObject(Idx: integer; const S: AnsiString;
Obj: DWORD);
begin
InsertObjectLen( Idx, PAnsiChar( S ), Length( S ), Obj );
@@ -1629,7 +1629,7 @@ begin
Inc( fCount );
end;
function TFastStrListEx.Last: String;
function TFastStrListEx.Last: AnsiString;
begin
if Count > 0 then
Result := Items[ Count-1 ]
@@ -1637,10 +1637,10 @@ begin
Result := '';
end;
function TFastStrListEx.LoadFromFile(const FileName: string): Boolean;
function TFastStrListEx.LoadFromFile(const FileName: AnsiString): Boolean;
var Strm: PStream;
begin
Strm := NewReadFileStream( FileName );
Strm := NewReadFileStream( KOLString(FileName) );
TRY
Result := Strm.Handle <> INVALID_HANDLE_VALUE;
if Result then
@@ -1654,17 +1654,17 @@ end;
procedure TFastStrListEx.LoadFromStream(Stream: PStream;
Append2List: boolean);
var Txt: String;
var Txt: AnsiString;
begin
SetLength( Txt, Stream.Size - Stream.Position );
Stream.Read( Txt[ 1 ], Stream.Size - Stream.Position );
SetText( Txt, Append2List );
end;
procedure TFastStrListEx.MergeFromFile(const FileName: string);
procedure TFastStrListEx.MergeFromFile(const FileName: AnsiString);
var Strm: PStream;
begin
Strm := NewReadFileStream( FileName );
Strm := NewReadFileStream( KOLString(FileName) );
TRY
LoadFromStream( Strm, TRUE );
FINALLY
@@ -1698,7 +1698,7 @@ begin
fList.Capacity := Max( 100, fList.Count * 2 );
end;
procedure TFastStrListEx.Put(Idx: integer; const Value: string);
procedure TFastStrListEx.Put(Idx: integer; const Value: AnsiString);
var Dest: PAnsiChar;
OldLen: Integer;
OldObj: DWORD;
@@ -1745,10 +1745,10 @@ begin
end;
end;
function TFastStrListEx.SaveToFile(const FileName: string): Boolean;
function TFastStrListEx.SaveToFile(const FileName: AnsiString): Boolean;
var Strm: PStream;
begin
Strm := NewWriteFileStream( FileName );
Strm := NewWriteFileStream( KOLString(FileName) );
TRY
if Strm.Handle <> INVALID_HANDLE_VALUE then
SaveToStream( Strm );
@@ -1759,7 +1759,7 @@ begin
end;
procedure TFastStrListEx.SaveToStream(Stream: PStream);
var Txt: String;
var Txt: AnsiString;
begin
Txt := Text;
Stream.Write( PAnsiChar( Txt )^, Length( Txt ) );
@@ -1775,7 +1775,7 @@ begin
Dest^ := Value;
end;
procedure TFastStrListEx.SetText(const S: string; Append2List: boolean);
procedure TFastStrListEx.SetText(const S: AnsiString; Append2List: boolean);
var Len2Add, NLines, L: Integer;
p0, p: PAnsiChar;
begin
@@ -1832,7 +1832,7 @@ begin
AddObjectLen( p0, DWORD(p)-DWORD(p0), 0 );
end;
procedure TFastStrListEx.SetTextStr(const Value: string);
procedure TFastStrListEx.SetTextStr(const Value: AnsiString);
begin
SetText( Value, FALSE );
end;
@@ -1992,7 +1992,7 @@ end;
{ TCABFile }
//[function OpenCABFile]
function OpenCABFile( const APaths: array of String ): PCABFile;
function OpenCABFile( const APaths: array of AnsiString ): PCABFile;
var I: Integer;
begin
{-}
@@ -2002,7 +2002,7 @@ begin
Result.FNames := {$IFDEF UNICODE_CTRLS} NewWStrList {$ELSE} NewStrList {$ENDIF};
Result.FPaths := {$IFDEF UNICODE_CTRLS} NewWStrList {$ELSE} NewStrList {$ENDIF};
for I := 0 to High( APaths ) do
Result.FPaths.Add( APaths[ I ] );
Result.FPaths.Add( KOLString(APaths[ I ]) );
end;
//[destructor TCABFile.Destroy]
@@ -2224,7 +2224,7 @@ begin
New( Result, Create );
end;
//[function NewDirChangeNotifier]
function NewDirChangeNotifier( const Path: String; Filter: TFileChangeFilter;
function NewDirChangeNotifier( const Path: AnsiString; Filter: TFileChangeFilter;
WatchSubtree: Boolean; ChangeProc: TOnDirChange )
: PDirChange;
const Dflt_Flags = FILE_NOTIFY_CHANGE_FILE_NAME or FILE_NOTIFY_CHANGE_DIR_NAME or
@@ -2515,10 +2515,10 @@ begin
end;
//[function TMetafile.LoadFromFile]
function TMetafile.LoadFromFile(const Filename: String): Boolean;
function TMetafile.LoadFromFile(const Filename: AnsiString): Boolean;
var Strm: PStream;
begin
Strm := NewReadFileStream( FileName );
Strm := NewReadFileStream( KOLString(FileName ));
Result := LoadFromStream( Strm );
Strm.Free;
end;
@@ -2662,7 +2662,7 @@ end;
//[END NewActionList]
//[function NewAction]
function NewAction(const ACaption, AHint: string; AOnExecute: TOnEvent): PAction;
function NewAction(const ACaption, AHint: KOLString; AOnExecute: TOnEvent): PAction;
begin
{-}
New( Result, Create );
@@ -2975,7 +2975,7 @@ end;
{$IFDEF USE_CONSTRUCTORS}
//[function NewTree]
function NewTree( AParent: PTree; const AName: String ): PTree;
function NewTree( AParent: PTree; const AName: AnsiString ): PTree;
begin
New( Result, CreateTree( AParent, AName ) );
end;
@@ -3005,7 +3005,7 @@ begin
Result.fNodeName := AName;
end;
{$ELSE}
function NewTree( AParent: PTree; const AName: String ): PTree;
function NewTree( AParent: PTree; const AName: AnsiString ): PTree;
begin
{-}
New( Result, Create );
@@ -3053,7 +3053,7 @@ end;
{$IFDEF USE_CONSTRUCTORS}
//[constructor TTree.CreateTree]
constructor TTree.CreateTree(AParent: PTree; const AName: String);
constructor TTree.CreateTree(AParent: PTree; const AName: AnsiString);
begin
inherited Create;
if AParent <> nil then
@@ -3175,8 +3175,8 @@ begin
Result := DWORD( PTree( List.Items[ e1 ] ).fData ) -
DWORD( PTree( List.Items[ e2 ] ).fData );
{$ELSE}
Result := AnsiCompareStr( PTree( List.Items[ e1 ] ).fNodeName,
PTree( List.Items[ e2 ] ).fNodeName );
Result := AnsiCompareStr( KOLString(PTree( List.Items[ e1 ] ).fNodeName),
KOLString(PTree( List.Items[ e2 ] ).fNodeName) );
{$ENDIF}
end;
@@ -3257,11 +3257,11 @@ end;
ADDITIONAL UTILITIES
}
function MapFileRead( const Filename: String; var hFile, hMap: THandle ): Pointer;
function MapFileRead( const Filename: AnsiString; var hFile, hMap: THandle ): Pointer;
var Sz, Hi: DWORD;
begin
Result := nil;
hFile := FileCreate( Filename, ofOpenRead or ofOpenExisting or ofShareDenyNone );
hFile := FileCreate( KOLString(Filename), ofOpenRead or ofOpenExisting or ofShareDenyNone );
hMap := 0;
if hFile = INVALID_HANDLE_VALUE then Exit;
Sz := GetFileSize( hFile, @ Hi );
@@ -3271,11 +3271,11 @@ begin
Result := MapViewOfFile( hMap, FILE_MAP_READ, 0, 0, Sz );
end;
function MapFile( const Filename: String; var hFile, hMap: THandle ): Pointer;
function MapFile( const Filename: AnsiString; var hFile, hMap: THandle ): Pointer;
var Sz, Hi: DWORD;
begin
Result := nil;
hFile := FileCreate( Filename, ofOpenRead or ofOpenWrite or ofOpenExisting
hFile := FileCreate( KOLString(Filename), ofOpenRead or ofOpenWrite or ofOpenExisting
or ofShareExclusive );
hMap := 0;
if hFile = INVALID_HANDLE_VALUE then Exit;
@@ -3363,7 +3363,7 @@ var Dialog: PControl;
AppTermFlag: Boolean;
Lab: PControl;
{$IFNDEF USE_GRUSH} Y, {$ELSE} {$IFDEF TOGRUSH_OPTIONAL} Y, {$ENDIF} {$ENDIF} W, X, I: Integer;
Title: String;
Title: KOLString;
DlgWnd: HWnd;
AppCtl: PControl;
{$IFDEF USE_GRUSH}
@@ -3404,7 +3404,7 @@ begin
else Title := Parse( S, '!' );
end;
{$ENDIF}
Dialog := NewForm( Applet, Title ).SetSize( 300, 40 );
Dialog := NewForm( Applet, KOLString(Title) ).SetSize( 300, 40 );
{$IFNDEF NO_CHECK_STAYONTOP}
if DoStayOnTop then
Dialog.StayOnTop := TRUE;
@@ -3614,14 +3614,14 @@ end;
//[END ShowQuestionEx]
//[function ShowQuestion]
function ShowQuestion( const S: String; Answers: String ): Integer;
function ShowQuestion( const S: KOLString; Answers: KOLString ): Integer;
begin
Result := ShowQuestionEx( S, Answers, nil );
end;
//[END ShowQuestion]
//[procedure ShowMsgModal]
procedure ShowMsgModal( const S: String );
procedure ShowMsgModal( const S: KOLString );
begin
ShowQuestion( S, '' );
end;

31
visual_xp_styles.inc
View File

@@ -1,8 +1,8 @@
// Name: KOL Addon - Visual XP Styles
// Rev.: 1.96
// Date: 27 aug 2007 /08:51/
// Rev.: 1.97
// Date: 09 aug 2009
// Author: MTsv DN
// Thanks: mdw, Vladimir Kladov
// Thanks: mdw, Vladimir Kladov, D[u]fa
{$IFDEF _FPC}
const
@@ -786,6 +786,7 @@ function WndXPMessage( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boo
var
pt : TPoint;
Mouse: TMouseEventData;
dDC : HDC;
begin
Result := false;
@@ -833,7 +834,9 @@ begin
Sender.fOnMouseDown(Sender, Mouse);
end;
Sender.fPressed := true;
Sender.OnPaint(Sender, GetWindowDC(Msg.hWnd));
dDC := GetWindowDC(Msg.hWnd);
Sender.OnPaint(Sender, dDC);
ReleaseDC( Msg.hWnd, dDC );
end;
WM_LBUTTONUP:
@@ -856,7 +859,9 @@ begin
Sender.fOnMouseUp(Sender, Mouse);
end;
Sender.fPressed := false;
Sender.OnPaint(Sender, GetWindowDC(Msg.hWnd));
dDC := GetWindowDC(Msg.hWnd);
Sender.OnPaint(Sender, dDC);
ReleaseDC( Msg.hWnd, dDC );
end;
WM_KEYDOWN:
@@ -866,7 +871,9 @@ begin
if Assigned(Sender.fOnKeyDown) then
Sender.fOnKeyDown(Sender, Msg.wParam, GetShiftState);
Sender.fPressed := true;
Sender.OnPaint(Sender, GetWindowDC(Msg.hWnd));
dDC := GetWindowDC(Msg.hWnd);
Sender.OnPaint(Sender, dDC);
ReleaseDC( Msg.hWnd, dDC );
end;
end;
@@ -877,20 +884,26 @@ begin
if Assigned(Sender.fOnKeyUp) then
Sender.fOnKeyUp(Sender, Msg.wParam, GetShiftState);
Sender.fPressed := false;
Sender.OnPaint(Sender, GetWindowDC(Msg.hWnd));
dDC := GetWindowDC(Msg.hWnd);
Sender.OnPaint(Sender, dDC);
ReleaseDC( Msg.hWnd, dDC );
end;
end;
WM_KILLFOCUS:
begin
Sender.fHot := false;
Sender.OnPaint(Sender, GetWindowDC(Msg.hWnd));
dDC := GetWindowDC(Msg.hWnd);
Sender.OnPaint(Sender, dDC);
ReleaseDC( Msg.hWnd, dDC );
end;
WM_SETFOCUS:
begin
Sender.fHot := true;
Sender.OnPaint(Sender, GetWindowDC(Msg.hWnd));
dDC := GetWindowDC(Msg.hWnd);
Sender.OnPaint(Sender, dDC);
ReleaseDC( Msg.hWnd, dDC );
Result := true;
end;
end;