pascal/kolmck
1
0
Fork 0
Code Issues Releases Activity

2.93

Browse Source 
git-svn-id: https://svn.code.sf.net/p/kolmck/code@64 91bb2d04-0c0c-4d2d-88a5-bbb6f4c1fa07
This commit is contained in:
dkolmck
2010-06-04 11:14:59 +00:00
parent e0decda982
commit 741ce16e1e
6 changed files with 392 additions and 267 deletions
Download Patch File Download Diff File Expand all files Collapse all files

500
KOL.pas
View File

File diff suppressed because it is too large Load Diff

59
KOLDirDlgEx.pas
View File

@ -4,6 +4,9 @@ interface
uses Windows, Messages, KOL {$IFDEF USE_GRUSH}, ToGrush, KOLGRushControls {$ENDIF}; uses Windows, Messages, KOL {$IFDEF USE_GRUSH}, ToGrush, KOLGRushControls {$ENDIF};
{$I KOLDEF.INC}
{$I DELPHIDEF.INC}
{$IFDEF EXTERNAL_DEFINES} {$IFDEF EXTERNAL_DEFINES}
{$INCLUDE EXTERNAL_DEFINES.INC} {$INCLUDE EXTERNAL_DEFINES.INC}
{$ENDIF EXTERNAL_DEFINES} {$ENDIF EXTERNAL_DEFINES}
@ -63,7 +66,7 @@ const
WM_USER_RESCANTREE = WM_USER; WM_USER_RESCANTREE = WM_USER;
type type
TFindFirstFileEx = function(lpFileName: PAnsiChar; fInfoLevelId: TFindexInfoLevels; TFindFirstFileEx = function(lpFileName: PKOLChar; fInfoLevelId: TFindexInfoLevels;
lpFindFileData: Pointer; fSearchOp: TFindexSearchOps; lpSearchFilter: Pointer; lpFindFileData: Pointer; fSearchOp: TFindexSearchOps; lpSearchFilter: Pointer;
dwAdditionalFlags: DWORD): THandle; stdcall; dwAdditionalFlags: DWORD): THandle; stdcall;
@ -75,13 +78,13 @@ type
DirTree: PControl; DirTree: PControl;
BtnPanel: PControl; BtnPanel: PControl;
RescanningNode, RescanningTree: Boolean; RescanningNode, RescanningTree: Boolean;
FPath, FRecycledName: String; FPath, FRecycledName: KOLString;
FRemoteIconSysIdx: Integer; FRemoteIconSysIdx: Integer;
FFindFirstFileEx: TFindFirstFileEx; FFindFirstFileEx: TFindFirstFileEx;
k32: THandle; k32: THandle;
DialogForm, MsgPanel: PControl; DialogForm, MsgPanel: PControl;
function GetFindFirstFileEx: TFindFirstFileEx; function GetFindFirstFileEx: TFindFirstFileEx;
procedure SetPath(const Value: String); procedure SetPath(const Value: KOLString);
function GetDialogForm: PControl; function GetDialogForm: PControl;
procedure DoOK( Sender: PObj ); procedure DoOK( Sender: PObj );
procedure DoCancel( Sender: PObj ); procedure DoCancel( Sender: PObj );
@ -90,7 +93,7 @@ type
function DoMsg( var Msg: TMsg; var Rslt: Integer ): Boolean; function DoMsg( var Msg: TMsg; var Rslt: Integer ): Boolean;
function DoExpanding( Sender: PControl; Item: THandle; Expand: Boolean ) function DoExpanding( Sender: PControl; Item: THandle; Expand: Boolean )
: Boolean; : Boolean;
function DoFilterAttrs( Attrs: DWORD; const APath: String ): Boolean; function DoFilterAttrs( Attrs: DWORD; const APath: KOLString ): Boolean;
procedure Rescantree; procedure Rescantree;
procedure RescanNode( node: Integer ); procedure RescanNode( node: Integer );
procedure RescanDisks; procedure RescanDisks;
@ -101,7 +104,7 @@ type
procedure DeleteNode( node: Integer ); procedure DeleteNode( node: Integer );
procedure DestroyingForm( Sender: PObj ); procedure DestroyingForm( Sender: PObj );
public public
OKCaption, CancelCaption: String; OKCaption, CancelCaption: KOLString;
FilterAttrs: DWORD; FilterAttrs: DWORD;
FilterRecycled: Boolean; FilterRecycled: Boolean;
Title: String; Title: String;
@ -112,8 +115,8 @@ type
add your own controls, event handlers and so on. } add your own controls, event handlers and so on. }
destructor Destroy; virtual; destructor Destroy; virtual;
function Execute: Boolean; function Execute: Boolean;
property InitialPath: String read FPath write SetPath; property InitialPath: KOLString read FPath write SetPath;
property Path: String read FPath write SetPath; property Path: KOLString read FPath write SetPath;
property FastScan: Boolean read FFastScan write FFastScan; property FastScan: Boolean read FFastScan write FFastScan;
procedure DoubleClick( Sender: PControl; var M: TMouseEventData ); procedure DoubleClick( Sender: PControl; var M: TMouseEventData );
{$IFDEF DIRDLGEX_LINKSPANEL} {$IFDEF DIRDLGEX_LINKSPANEL}
@ -128,8 +131,8 @@ type
function GetLinksPanelOn: Boolean; function GetLinksPanelOn: Boolean;
procedure SetLinksPanelOn( const Value: Boolean ); procedure SetLinksPanelOn( const Value: Boolean );
function GetLinksCount: Integer; function GetLinksCount: Integer;
function GetLinks(idx: Integer): String; function GetLinks(idx: Integer): KOLString;
procedure SetLinks(idx: Integer; const Value: String); procedure SetLinks(idx: Integer; const Value: KOLString);
procedure SetupLinksTapeHeight; procedure SetupLinksTapeHeight;
procedure SetUpTaborders; procedure SetUpTaborders;
procedure LinksUpClick( Sender: PControl; var Mouse: TMouseEventData ); procedure LinksUpClick( Sender: PControl; var Mouse: TMouseEventData );
@ -144,11 +147,11 @@ type
public public
property LinksPanelOn: Boolean read GetLinksPanelOn write SetLinksPanelOn; property LinksPanelOn: Boolean read GetLinksPanelOn write SetLinksPanelOn;
property LinksCount: Integer read GetLinksCount; property LinksCount: Integer read GetLinksCount;
property Links[ idx: Integer ]: String read GetLinks write SetLinks; property Links[ idx: Integer ]: KOLString read GetLinks write SetLinks;
procedure AddLinks( SL: PStrList ); procedure AddLinks( SL: PStrList );
function CollectLinks: PStrList; function CollectLinks: PStrList;
function LinkPresent( const s: String ): Boolean; function LinkPresent( const s: KOLString ): Boolean;
procedure RemoveLink( const s: String ); procedure RemoveLink( const s: KOLString );
procedure ClearLinks; procedure ClearLinks;
{$ENDIF DIRDLGEX_LINKSPANEL} {$ENDIF DIRDLGEX_LINKSPANEL}
end; end;
@ -175,11 +178,11 @@ begin
end; end;
procedure NewPanelWithSingleButtonToolbar( AParent: PControl; W, H: Integer; procedure NewPanelWithSingleButtonToolbar( AParent: PControl; W, H: Integer;
A: TControlAlign; Bmp: PBitmap; const C, T: String; var Pn, Bar: PControl; A: TControlAlign; Bmp: PBitmap; const C, T: KOLString; var Pn, Bar: PControl;
const ClickEvent: TOnEvent; DownEvent, ReleaseEvent, BarMouseDnEvent: TOnMouse; const ClickEvent: TOnEvent; DownEvent, ReleaseEvent, BarMouseDnEvent: TOnMouse;
P: PMenu ); P: PMenu );
var i: Integer; var i: Integer;
Buffer: PChar; Buffer: PKOLChar;
begin begin
Pn := NewPanel( AParent, esNone ).SetSize( 0, H ).SetAlign( A ); Pn := NewPanel( AParent, esNone ).SetSize( 0, H ).SetAlign( A );
Pn.Border := 0; Pn.Border := 0;
@ -189,7 +192,9 @@ begin
[ PKOLChar( {$IFDEF TOOLBAR_DOT_NOAUTOSIZE_BUTTON} '.' + {$ENDIF} C ) ], [ 0 ] ); [ PKOLChar( {$IFDEF TOOLBAR_DOT_NOAUTOSIZE_BUTTON} '.' + {$ENDIF} C ) ], [ 0 ] );
Buffer := AllocMem( Length( T ) + 1 ); Buffer := AllocMem( Length( T ) + 1 );
if T <> '' then if T <> '' then
StrCopy( Buffer, PChar( T ) ); {$IFDEF UNICODE_CTRLS} WStrCopy
{$ELSE} StrCopy
{$ENDIF} ( Buffer, PKOLChar( T ) );
{$IFDEF USE_GRUSH} {$IFDEF USE_GRUSH}
i := 0; i := 0;
{$IFDEF TOGRUSH_OPTIONAL} {$IFDEF TOGRUSH_OPTIONAL}
@ -273,7 +278,7 @@ end;
procedure TOpenDirDialogEx.CheckNodeHasChildren(node: Integer); procedure TOpenDirDialogEx.CheckNodeHasChildren(node: Integer);
var HasSubDirs: Boolean; var HasSubDirs: Boolean;
txt: String; txt: KOLString;
F: THandle; F: THandle;
Find32: TWin32FindData; Find32: TWin32FindData;
ii, n: Integer; ii, n: Integer;
@ -283,7 +288,7 @@ begin
if (Length( txt ) = 2) then if (Length( txt ) = 2) then
if (txt[ 2 ] = ':') then if (txt[ 2 ] = ':') then
begin begin
ii := GetDriveTypeA( PChar( txt + '\' ) ); ii := GetDriveType( PKOLChar( txt + '\' ) );
if IntIn( ii, [ DRIVE_REMOVABLE, DRIVE_REMOTE, DRIVE_CDROM ] ) then if IntIn( ii, [ DRIVE_REMOVABLE, DRIVE_REMOTE, DRIVE_CDROM ] ) then
HasSubDirs := TRUE; HasSubDirs := TRUE;
end; end;
@ -292,7 +297,7 @@ begin
if WinVer >= wvNT then if WinVer >= wvNT then
begin begin
_FindFirstFileEx; _FindFirstFileEx;
F := FFindFirstFileEx( PChar( DirTree.TVItemPath( node, '\' ) + '\*.*' ), F := FFindFirstFileEx( PKOLChar( DirTree.TVItemPath( node, '\' ) + '\*.*' ),
FindExInfoStandard, @ Find32, FindExSearchLimitToDirectories, nil, 0 ); FindExInfoStandard, @ Find32, FindExSearchLimitToDirectories, nil, 0 );
if F <> INVALID_HANDLE_VALUE then if F <> INVALID_HANDLE_VALUE then
begin begin
@ -639,7 +644,7 @@ begin
RescanNode( Item ); RescanNode( Item );
end; end;
function TOpenDirDialogEx.DoFilterAttrs(Attrs: DWORD; const APath: String): Boolean; function TOpenDirDialogEx.DoFilterAttrs(Attrs: DWORD; const APath: KOLString): Boolean;
begin begin
Result := (Attrs and FilterAttrs = 0); Result := (Attrs and FilterAttrs = 0);
if not Result then Exit; if not Result then Exit;
@ -783,7 +788,7 @@ begin
end; end;
{$IFDEF DIRDLGEX_LINKSPANEL} {$IFDEF DIRDLGEX_LINKSPANEL}
function TOpenDirDialogEx.GetLinks(idx: Integer): String; function TOpenDirDialogEx.GetLinks(idx: Integer): KOLString;
begin begin
Result := ''; Result := '';
if (LinksList <> nil) and (LinksList.Count > idx) then if (LinksList <> nil) and (LinksList.Count > idx) then
@ -816,7 +821,7 @@ begin
end; end;
end; end;
function TOpenDirDialogEx.LinkPresent(const s: String): Boolean; function TOpenDirDialogEx.LinkPresent(const s: KOLString): Boolean;
begin begin
Result := (LinksList <> nil) and Result := (LinksList <> nil) and
(LinksList.IndexOf_NoCase( (LinksList.IndexOf_NoCase(
@ -909,7 +914,7 @@ begin
end; end;
{$IFDEF DIRDLGEX_LINKSPANEL} {$IFDEF DIRDLGEX_LINKSPANEL}
procedure TOpenDirDialogEx.RemoveLink(const s: String); procedure TOpenDirDialogEx.RemoveLink(const s: KOLString);
var i: Integer; var i: Integer;
Pn: PControl; Pn: PControl;
begin begin
@ -950,7 +955,7 @@ procedure TOpenDirDialogEx.RescanNode(node: Integer);
{ (����)������������ ������������� � �������� ����� node ������������ �����. { (����)������������ ������������� � �������� ����� node ������������ �����.
���� node = 0, �� ����������� ������ ������ �� ������ ����� ������. ���� node = 0, �� ����������� ������ ������ �� ������ ����� ������.
} }
var p, s: String; var p, s: KOLString;
DL: PDirList; DL: PDirList;
i, j, n, d, m, ii: Integer; i, j, n, d, m, ii: Integer;
Find32: TWin32FindData; Find32: TWin32FindData;
@ -987,7 +992,7 @@ begin
if WinVer >= wvNT then // ������������ ����� ������� ������� - ��� NT/2K/XP if WinVer >= wvNT then // ������������ ����� ������� ������� - ��� NT/2K/XP
begin begin
_FindFirstFileEx; _FindFirstFileEx;
F := FFindFirstFileEx( PChar( p + '*.*' ), FindExInfoStandard, @ Find32, F := FFindFirstFileEx( PKOLChar( p + '*.*' ), FindExInfoStandard, @ Find32,
FindExSearchLimitToDirectories, nil, 0 ); FindExSearchLimitToDirectories, nil, 0 );
if F <> INVALID_HANDLE_VALUE then if F <> INVALID_HANDLE_VALUE then
begin begin
@ -1153,7 +1158,7 @@ begin
DirTree.TVItemSelImg[ node ] := ii; DirTree.TVItemSelImg[ node ] := ii;
if (Length( n ) = 2) and (n[ 2 ] = ':') then if (Length( n ) = 2) and (n[ 2 ] = ':') then
begin begin
if not IntIn( GetDriveTypeA( PChar( n + '\' ) ), if not IntIn( GetDriveType( PKOLChar( n + '\' ) ),
[ DRIVE_REMOVABLE, DRIVE_REMOTE, DRIVE_CDROM ] ) then [ DRIVE_REMOVABLE, DRIVE_REMOTE, DRIVE_CDROM ] ) then
RescanNode( node ); RescanNode( node );
end end
@ -1171,7 +1176,7 @@ begin
end; end;
{$IFDEF DIRDLGEX_LINKSPANEL} {$IFDEF DIRDLGEX_LINKSPANEL}
procedure TOpenDirDialogEx.SetLinks(idx: Integer; const Value: String); procedure TOpenDirDialogEx.SetLinks(idx: Integer; const Value: KOLString);
var Bar, Pn: PControl; var Bar, Pn: PControl;
Bmp: PBitmap; Bmp: PBitmap;
Ico: PIcon; Ico: PIcon;
@ -1245,7 +1250,7 @@ begin
end; end;
{$ENDIF DIRDLGEX_LINKSPANEL} {$ENDIF DIRDLGEX_LINKSPANEL}
procedure TOpenDirDialogEx.SetPath(const Value: String); procedure TOpenDirDialogEx.SetPath(const Value: KOLString);
begin begin
FPath := Value; FPath := Value;
if FPath <> '' then if FPath <> '' then

42
KOL_ASM.inc
View File

@ -1,6 +1,6 @@
//------------------------------------------------------------------------------ //------------------------------------------------------------------------------
// KOL_ASM.inc ()to be inlude in KOL.pas) // KOL_ASM.inc ()to be inlude in KOL.pas)
// v 2.91 // v 2.93
function MsgBox( const S: KOLString; Flags: DWORD ): DWORD; function MsgBox( const S: KOLString; Flags: DWORD ): DWORD;
asm asm
PUSH EDX PUSH EDX
@ -327,12 +327,16 @@ end;
procedure TList.SetCapacity( Value: Integer ); procedure TList.SetCapacity( Value: Integer );
asm asm
{$IFDEF TLIST_FAST} {$IFDEF TLIST_FAST}
XOR ECX, ECX
MOV CH, 1
CMP EDX, ECX
JLE @@256
MOV EDX, ECX
@@256:
CMP [EAX].fUseBlocks, 0 CMP [EAX].fUseBlocks, 0
JZ @@old JZ @@old
CMP [EAX].fBlockList, 0 CMP [EAX].fBlockList, 0
JNZ @@just_set JZ @@old
CMP EDX, 256
JLE @@old
@@just_set: @@just_set:
MOV [EAX].fCapacity, EDX MOV [EAX].fCapacity, EDX
RET RET
@ -2087,30 +2091,6 @@ asm
POP EBX POP EBX
end; end;
procedure TCanvas.TextOut(X, Y: Integer; const Text: AnsiString); stdcall;
asm
PUSH EBX
MOV EBX, [EBP+8]
MOV EAX, [Text]
PUSH EAX
CALL System.@LStrLen
XCHG EAX, [ESP] // prepare Length(Text)
//CALL System.@LStrToPChar // string does not need to be null-terminated !
PUSH EAX // prepare PChar(Text)
PUSH [Y] // prepare Y
PUSH [X] // prepare X
PUSH HandleValid or FontValid or BrushValid or ChangingCanvas
PUSH EBX
CALL RequiredState
PUSH EAX // prepare fHandle
CALL Windows.TextOutA // KOL_ANSI
POP EBX
end;
procedure TCanvas.TextRect(const Rect: TRect; X, Y: Integer; const Text: Ansistring); procedure TCanvas.TextRect(const Rect: TRect; X, Y: Integer; const Text: Ansistring);
asm asm
PUSH EBX PUSH EBX
@ -3800,6 +3780,7 @@ asm
end; end;
{$ENDIF BITBTN_ASM} {$ENDIF BITBTN_ASM}
function NewCheckbox( AParent: PControl; const Caption: KOLString ): PControl; function NewCheckbox( AParent: PControl; const Caption: KOLString ): PControl;
asm asm
CALL NewButton CALL NewButton
@ -6292,7 +6273,6 @@ asm
{$ENDIF} {$ENDIF}
end; end;
{$IFDEF ASM_VERSION}
function TControl.GetBoundsRect: TRect; function TControl.GetBoundsRect: TRect;
asm asm
PUSH ESI PUSH ESI
@ -6356,7 +6336,6 @@ asm
POP EDI POP EDI
POP ESI POP ESI
end; end;
{$ENDIF}
procedure HelpGetBoundsRect; procedure HelpGetBoundsRect;
asm asm
@ -12941,7 +12920,6 @@ asm //cmd //opd
end; end;
{$IFNDEF OLD_ALIGN} {$IFNDEF OLD_ALIGN}
{$IFDEF ASM_VERSION}
procedure AlignChildrenProc(Sender: PObj); procedure AlignChildrenProc(Sender: PObj);
const AlignModes = (1 shl byte(caBottom))+(1 shl byte(caTop))+ const AlignModes = (1 shl byte(caBottom))+(1 shl byte(caTop))+
(((1 shl byte(caRight)) +(1 shl byte(caLeft)))shl 8)+ (((1 shl byte(caRight)) +(1 shl byte(caLeft)))shl 8)+
@ -13136,7 +13114,6 @@ asm //cmd //opd
POP EBX POP EBX
POP EBP POP EBP
end; end;
{$ENDIF ASM_VERSION}
{$ENDIF OLD_ALIGN} {$ENDIF OLD_ALIGN}
function WndProcUpdate( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; function WndProcUpdate( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
@ -13265,4 +13242,5 @@ asm
@@exit: @@exit:
end; end;
//======================================== THE END OF FILE KOL_ASM.inc //======================================== THE END OF FILE KOL_ASM.inc

18
KOL_unicode.inc
View File

@ -752,6 +752,24 @@ const
IDC_HAND = MakeIntResource(32649); IDC_HAND = MakeIntResource(32649);
IDC_APPSTARTING = MakeIntResource(32650); IDC_APPSTARTING = MakeIntResource(32650);
IDC_HELP = MakeIntResource(32651); IDC_HELP = MakeIntResource(32651);
RT_CURSOR = PKOLChar(1);
RT_BITMAP = PKOLChar(2);
RT_ICON = PKOLChar(3);
RT_MENU = PKOLChar(4);
RT_DIALOG = PKOLChar(5);
RT_STRING = PKOLChar(6);
RT_FONTDIR = PKOLChar(7);
RT_FONT = PKOLChar(8);
RT_ACCELERATOR = PKOLChar(9);
RT_RCDATA = PKOLChar(10);
RT_MESSAGETABLE = PKOLChar(11);
RT_VERSION = PKOLChar(16);
RT_DLGINCLUDE = PKOLChar(17);
RT_PLUGPLAY = PKOLChar(19);
RT_VXD = PKOLChar(20);
RT_ANICURSOR = PKOLChar(21);
RT_ANIICON = PKOLChar(22);
{$ENDIF interface_part} //////////////////////////////////////////////////////// {$ENDIF interface_part} ////////////////////////////////////////////////////////
{$IFDEF implementation_part} /////////////////////////////////////////////////// {$IFDEF implementation_part} ///////////////////////////////////////////////////

7
KOLadd.pas
View File

@ -461,7 +461,8 @@ type
//[NewDirChangeNotifier DECLARATION] //[NewDirChangeNotifier DECLARATION]
function NewDirChangeNotifier( const Path: KOLString; Filter: TFileChangeFilter; function NewDirChangeNotifier( const Path: KOLString; Filter: TFileChangeFilter;
WatchSubtree: Boolean; ChangeProc: TOnDirChange ): PDirChange; WatchSubtree: Boolean; ChangeProc: TOnDirChange )
: PDirChange;
{* Creates notification object TDirChange. If something wrong (e.g., {* Creates notification object TDirChange. If something wrong (e.g.,
passed directory does not exist), nil is returned as a result. When change passed directory does not exist), nil is returned as a result. When change
is notified, ChangeProc is called always in main thread context. is notified, ChangeProc is called always in main thread context.
@ -2223,13 +2224,13 @@ const FilterFlags: array[ TFileChangeFilters ] of Integer = (
$40 {FILE_NOTIFY_CHANGE_CREATION}, FILE_NOTIFY_CHANGE_SECURITY ); $40 {FILE_NOTIFY_CHANGE_CREATION}, FILE_NOTIFY_CHANGE_SECURITY );
//[FUNCTION _NewDirChgNotifier] //[FUNCTION _NewDirChgNotifier]
{$IFDEF ASM_VERSION} {$IFDEF ASM_UNICODE}
function _NewDirChgNotifier: PDirChange; function _NewDirChgNotifier: PDirChange;
begin begin
New( Result, Create ); New( Result, Create );
end; end;
//[function NewDirChangeNotifier] //[function NewDirChangeNotifier]
function NewDirChangeNotifier( const Path: AnsiString; Filter: TFileChangeFilter; function NewDirChangeNotifier( const Path: KOLString; Filter: TFileChangeFilter;
WatchSubtree: Boolean; ChangeProc: TOnDirChange ) WatchSubtree: Boolean; ChangeProc: TOnDirChange )
: PDirChange; : PDirChange;
const Dflt_Flags = FILE_NOTIFY_CHANGE_FILE_NAME or FILE_NOTIFY_CHANGE_DIR_NAME or const Dflt_Flags = FILE_NOTIFY_CHANGE_FILE_NAME or FILE_NOTIFY_CHANGE_DIR_NAME or

5
mckCtrls.pas
View File

@ -7035,6 +7035,11 @@ begin
SL.Add( Prefix + AName + '.LVColOrder[ ' + IntToStr( I ) + ' ] := ' + SL.Add( Prefix + AName + '.LVColOrder[ ' + IntToStr( I ) + ' ] := ' +
IntToStr( Col.LVColOrder ) + ';' ); IntToStr( Col.LVColOrder ) + ';' );
end; end;
//+++++++++++++++++++++++++++++ 2.93
if (lvoEditLabel in Options) and not Assigned( OnEndEditLVItem ) then
begin
SL.Add( Prefix + AName + '.OnEndEditLVItem := nil;' );
end;
end; end;
procedure TKOLListView.SetupLast(SL: TStringList; const AName, AParent, procedure TKOLListView.SetupLast(SL: TStringList; const AName, AParent,