pascal/kolmck
1
0
Fork 0
Code Issues Releases Activity

3.08

Browse Source 
git-svn-id: https://svn.code.sf.net/p/kolmck/code@103 91bb2d04-0c0c-4d2d-88a5-bbb6f4c1fa07
This commit is contained in:
dkolmck
2011-02-05 14:52:05 +00:00
parent 02035890a5
commit f06b874897
6 changed files with 968 additions and 1179 deletions
Download Patch File Download Diff File Expand all files Collapse all files

835
KOL.pas
View File

File diff suppressed because it is too large Load Diff

4
KOLDEF.inc
View File

@ -256,7 +256,7 @@ That is all to have full compatibility.
//{$DEFINE TEST_VERSION}
{$IFNDEF _D6orHigher}
{$DEFINE PARANOIA} //seems not needed under D6 !!! Inprise fixed this, finally...
{$DEFINE PARANOIA} //seems not needed from D6 !!! Inprise fixed this, finally...
{$ENDIF}
@ -264,6 +264,7 @@ That is all to have full compatibility.
{$DEFINE USE_FLAGS}
{$ELSE} {$UNDEF USE_FLAGS}
{$ENDIF}
{$IFnDEF EVENTS_STATIC}
{$DEFINE EVENTS_DYNAMIC}
{$ENDIF}
@ -275,4 +276,5 @@ That is all to have full compatibility.
{$ENDIF}
{$ENDIF}
{$DEFINE KOL3XX}
{$DEFINE DIBPixels32bitWithAlpha}

33
KOLDirDlgEx.pas
View File

@ -111,6 +111,7 @@ type
procedure CreateDialogForm;
property _FindFirstFileEx: TFindFirstFileEx read GetFindFirstFileEx;
function _FindFirstFileExW: Boolean;
procedure SelChanged( Sender: PObj );
procedure DeleteNode( node: Integer );
procedure DestroyingForm( Sender: PObj );
public
@ -449,9 +450,6 @@ begin
BtnPanel.Border := 2;
DTSubPanel.SetAlign( caClient );
DirTree := NewTreeView( DTSubPanel, [ tvoLinesRoot ], Sysimages, nil );
{$IFNDEF DIRDLGEX_NO_DBLCLK_ON_NODE_OK}
DirTree.OnMouseDblClk := DoubleClick;
{$ENDIF}
DirTree.Color := clWindow;
DirTree.OnTVExpanding := DoExpanding;
DirTree.SetAlign( caClient );
@ -483,7 +481,11 @@ begin
DirTree.SetAlign( caClient );
MsgPanel := DlgClient;
{$ENDIF}
{$IFNDEF DIRDLGEX_NO_DBLCLK_ON_NODE_OK}
DirTree.OnMouseDblClk := DoubleClick;
{$ENDIF}
MsgPanel.OnMessage := DoMsg;
DirTree.OnSelChange := SelChanged;
DlgClient := DTSubPanel; // !!!
s := CancelCaption; if s = '' then s := 'Cancel';
BtCancel := NewButton( BtnPanel, s );
@ -862,6 +864,11 @@ var s, CurPath: String;
begin
s := IncludeTrailingPathDelimiter(
PChar( PControl( Sender ).CustomData ) );
if PControl( Sender ).RightClick then
begin
RemoveLink( s );
end else
begin
if DirectoryExists( s ) then
begin
CurPath := IncludeTrailingPathDelimiter(
@ -870,6 +877,7 @@ begin
Form.ModalResult := 1
else Path := s;
end;
end;
end;
function TOpenDirDialogEx.LinkPresent(const s: KOLString): Boolean;
@ -976,7 +984,8 @@ begin
Pn.Free;
LinksList.Delete( i );
end;
Global_Align( LinksTape );
//LinksTape.Height := LinksTape.Height + 1;
//LinksTape.Height := LinksTape.Height - 1;
SetupLinksTapeHeight;
end;
@ -1232,6 +1241,13 @@ begin
end;
{$IFDEF DIRDLGEX_LINKSPANEL}
procedure TOpenDirDialogEx.SelChanged(Sender: PObj);
var n: Integer;
begin
n := PControl(Sender).TVSelected;
RescanNode( n );
end;
procedure TOpenDirDialogEx.SetLinks(idx: Integer; const Value: KOLString);
var Bar, Pn: PControl;
Bmp: PBitmap;
@ -1278,7 +1294,7 @@ begin
{$ENDIF USE_GRUSH}
{$ENDIF DIRDLGEX_BIGGERPANEL}
NewPanelWithSingleButtonToolbar( LinksTape, LinksBox.Width-8,
H, caTop, Bmp,
H, caNone, Bmp,
ExtractFileName( s ), s, Pn, Bar, LinkClick, nil, nil, LinksBtnDnEvt, LinksPopupMenu );
Pn.CreateWindow;
@ -1317,13 +1333,18 @@ end;
procedure TOpenDirDialogEx.SetupLinksTapeHeight;
var H: Integer;
Pn: PControl;
i: Integer;
begin
H := 0;
if (LinksList <> nil) and (LinksList.Count > 0) then
begin
Pn := Pointer( LinksList.Objects[ LinksList.Count-1 ] );
for i := 0 to LinksList.Count-1 do
begin
Pn := Pointer( LinksList.Objects[ i ] );
Pn.Top := H;
H := Pn.Top + Pn.Height;
end;
end;
LinksTape.Height := H + 4;
end;

66
KOL_ASM.inc
View File

@ -1,6 +1,6 @@
//------------------------------------------------------------------------------
// KOL_ASM.inc ()to be inlude in KOL.pas)
// v 3.05
// v 3.08
function MsgBox( const S: KOLString; Flags: DWORD ): DWORD;
asm
@ -1675,16 +1675,17 @@ end;
procedure TCanvas.SetHandle(Value: HDC);
asm
PUSH EBX
MOV EBX, EAX
MOV ECX, [EBX].fHandle
CMP ECX, EDX
JZ @@exit
JECXZ @@chk_val
PUSH ESI
MOV ESI, EDX // ESI = Value
MOV EBX, EAX // EAX = @ Self
MOV ECX, [EBX].fHandle // ECX = fHandle (before)
CMP ECX, ESI // compare with new Value in EDX
JZ @@exit // equal? -> nothing to do
JECXZ @@chk_val // fHandle = 0? -> check new value in EDX
PUSH EDX
PUSH ECX
PUSH ECX // fHandle
CALL DeselectHandles
POP EDX
POP EDX // fHandle
MOV ECX, [EBX].fOwnerControl
JECXZ @@chk_Release
@ -1692,13 +1693,16 @@ asm
JE @@clr_Handle
@@chk_Release:
PUSH EDX
CMP [EBX].fOnGetHandle.TMethod.Code, offset[TControl.DC2Canvas]
JNE @@deldc
PUSH EDX // fHandle
PUSH [ECX].TControl.fHandle
CALL ReleaseDC
JMP @@clr_Handle
@@deldc:
CMP WORD PTR [EBX].fIsPaintDC, 0
JNZ @@clr_Handle
PUSH EDX // fHandle
CALL DeleteDC
@@clr_Handle:
@ -1707,18 +1711,18 @@ asm
MOV [EBX].TCanvas.fIsPaintDC, CL
AND [EBX].TCanvas.fState, not HandleValid
POP EDX
@@chk_val:
TEST EDX, EDX
TEST ESI, ESI
JZ @@exit
OR [EBX].TCanvas.fState, HandleValid
MOV [EBX].TCanvas.fHandle, EDX
MOV [EBX].TCanvas.fHandle, ESI
LEA EDX, [EBX].TCanvas.fPenPos
MOV EAX, EBX
CALL SetPenPos
@@exit: POP EBX
@@exit: POP ESI
POP EBX
end;
procedure TCanvas.SetPenPos(const Value: TPoint);
@ -2854,6 +2858,10 @@ end;
function TDirList.GetCount: Integer;
asm
{CMP EAX, 0
JNZ @@1
NOP
@@1: }
MOV ECX, [EAX].FListPositions
JECXZ @@retECX
MOV ECX, [ECX].TList.fCount
@ -5419,7 +5427,7 @@ asm //cmd //opd
@@callonmes:
{$IFDEF NIL_EVENTS}
TEST EBX, EBX
JZ @@exit // @@dynmes1
JZ @@ret
{$ENDIF}
@@onmess1:
PUSH 0
@ -5914,7 +5922,8 @@ end;
function TControl.GetVisible: Boolean;
asm
MOV ECX, [EAX].fHandle
//CALL UpdateWndStyles
{MOV ECX, [EAX].fHandle
JECXZ @@check_fStyle
PUSH EAX
PUSH ECX
@ -5922,9 +5931,9 @@ asm
TEST EAX, EAX
POP EAX
JMP @@checked // Z if not visible
}
@@check_fStyle:
TEST byte ptr [EAX].fStyle.f3_Style, F3_Visible // WS_VISIBLE shr 3
TEST byte ptr [EAX].fStyle.f3_Style, 1 shl F3_Visible // WS_VISIBLE shr 3
@@checked:
{$IFDEF USE_FLAGS}
SETNZ AL
@ -6548,6 +6557,7 @@ asm
MOV ESI, EAX
CALL GetEnabled
(*
{$IFDEF USE_FLAGS}
MOV DL, byte ptr [ESI].TControl.fStyle.f2_Style
// F2_Tabstop = 0 !
@ -6556,6 +6566,8 @@ asm
OR DL, [ESI].TControl.fTabstop
{$ENDIF USE_FLAGS}
AND AL, DL
*)
TEST AL, AL
JZ @@exit
INC [ESI].TControl.fClickDisabled
@ -9392,6 +9404,8 @@ asm
{$ENDIF}
@@01:
MOV EAX, [EAX].fList
TEST EAX, EAX
JZ @@exit
MOV EDX, [EAX].TList.fCount
CMP EDX, 1
JLE @@02
@ -9407,6 +9421,7 @@ asm
@1: MOV EDX, [EAX].fCount
CALL SortData
{$ENDIF}
@@exit:
end;
procedure TStrList.MergeFromFile(const FileName: KOLString);
@ -11370,10 +11385,12 @@ asm
LOOP @@ret_Canvas
MOV [EBX].fApplyBkColor2Canvas, offset[ApplyBitmapBkColor2Canvas]
PUSH 0
CALL CreateCompatibleDC
//CALL CreateCompatibleDC
XOR EAX, EAX
//PUSH EAX
CALL NewCanvas
MOV [EBX].fCanvas, EAX
//MOV [EAX].TCanvas.fIsAlienDC, 0
MOV [EAX].TCanvas.fOnChangeCanvas.TMethod.Code, offset[CanvasChanged]
MOV [EAX].TCanvas.fOnChangeCanvas.TMethod.Data, EBX
CALL TCanvas.GetBrush
@ -13912,6 +13929,15 @@ asm
MOV [EAX].TControl.fWordWrap, 1
{$ENDIF}
AND byte ptr[EAX].TControl.fStyle.f0_Style, not SS_LEFTNOWORDWRAP
{$IFDEF USE_FLAGS}
TEST [EAX].TControl.fFlagsG5, 1 shl G5_IsButton
{$ELSE}
CMP [EAX].TControl.fIsButton, 0
{$ENDIF}
JZ @@1
OR [EAX].TControl.fStyle.f1_Style, $20 // BS_MULTILINE >> 8
@@1:
PUSH EAX
MOV EDX, [EAX].TControl.fStyle
CALL TControl.SetStyle

81
KOLadd.pas
View File

@ -15,7 +15,7 @@
//[VERSION]
****************************************************************
* VERSION 3.05
* VERSION 3.05+
****************************************************************
//[END OF VERSION]
@ -433,11 +433,16 @@ type
TDirChange = object(TObj)
{* Object type to monitor changes in certain folder. }
protected
{$IFDEF DIRCHG_ONEXECUTE}
FOnExecute: TOnEvent;
{$ENDIF}
FOnChange: TOnDirChange;
FHandle, FinEvent: THandle;
FPath: KOLString;
FMonitor: PThread;
FWatchSubtree: Boolean;
FDestroying: Boolean;
FFlags: DWORD;
function Execute( Sender: PThread ): Integer;
procedure Changed;
protected
@ -450,10 +455,15 @@ type
{* Path to monitored folder (to a root, if tree of folders
is under monitoring). }
property OnChange: TOnDirChange read FOnChange write FOnChange;
{$IFDEF DIRCHG_ONEXECUTE}
property OnExecute: TOnEvent read FOnExecute write FOnExecute;
{$ENDIF}
end;
function NewDirChangeNotifier( const Path: KOLString; Filter: TFileChangeFilter;
WatchSubtree: Boolean; ChangeProc: TOnDirChange )
WatchSubtree: Boolean; ChangeProc: TOnDirChange
{$IFDEF DIRCHG_ONEXECUTE} ; OnExecuteProc: TOnEvent
{$ENDIF} )
: PDirChange;
{* Creates notification object TDirChange. If something wrong (e.g.,
passed directory does not exist), nil is returned as a result. When change
@ -1006,7 +1016,7 @@ begin
if FromIdx + N > FromBits.Count then
N := FromBits.Count - FromIdx;
Capacity := (ToIdx + N + 8) div 8;
NewCount := Max( Count, ToIdx + N - 1 );
NewCount := Max( Count, ToIdx + N );
fCount := Max( NewCount, fCount );
PBitsList( fList ).fCount := (Capacity + 3) div 4;
while ToIdx and $1F <> 0 do
@ -1186,6 +1196,8 @@ begin
MOV D, EAX
end {$IFDEF F_P} [ 'EAX' ] {$ENDIF};
Result := I * 32 + Integer( D );
if Result >= fCount then
Result := -1;
break;
end;
end;
@ -1271,7 +1283,7 @@ begin
end;
//[procedure TBits.SetBit]
{$IFDEF ASM_VERSION}
{$IFDEF ASM_noVERSION}
procedure TBits.SetBit(Idx: Integer; const Value: Boolean);
asm
PUSH EBX
@ -1296,6 +1308,7 @@ asm
PUSH EDX
INC EDX
PUSH EAX
MOV EAX, EBX
CALL SetCapacity
POP EAX
POP EDX
@ -1319,12 +1332,14 @@ procedure TBits.SetBit(Idx: Integer; const Value: Boolean);
var Msk: DWORD;
MinListCount: Integer;
begin
MinListCount := (Idx + 31) shr 5 + 1;
MinListCount := //(Idx + 31) shr 5 + 1;
(Idx + 32) shr 5;
if PBitsList( fList ).fCount < MinListCount then
begin
PBitsList( fList ).fCount := MinListCount;
if Idx >= Capacity then
Capacity := Idx + 1;
Capacity := //Idx + 1;
MinListCount shl 5;
end;
Msk := 1 shl (Idx and $1F);
if Value then
@ -2260,30 +2275,26 @@ asm
end;
{$ELSE ASM_VERSION} //Pascal
function NewDirChangeNotifier( const Path: KOLString; Filter: TFileChangeFilter;
WatchSubtree: Boolean; ChangeProc: TOnDirChange )
WatchSubtree: Boolean; ChangeProc: TOnDirChange
{$IFDEF DIRCHG_ONEXECUTE}; OnExecuteProc: TOnEvent
{$ENDIF} )
: PDirChange;
var Flags: DWORD;
begin
New( Result, Create );
{$IFDEF DIRCHG_ONEXECUTE}
Result.OnExecute := OnExecuteProc;
{$ENDIF}
Result.FPath := Path;
Result.FWatchSubtree := WatchSubtree;
Result.FOnChange := ChangeProc;
if Filter = [ ] then
Flags := FILE_NOTIFY_CHANGE_FILE_NAME or FILE_NOTIFY_CHANGE_DIR_NAME or
Result.FFlags := FILE_NOTIFY_CHANGE_FILE_NAME or FILE_NOTIFY_CHANGE_DIR_NAME or
FILE_NOTIFY_CHANGE_ATTRIBUTES or FILE_NOTIFY_CHANGE_SIZE or
FILE_NOTIFY_CHANGE_LAST_WRITE
else
Flags := MakeFlags( @Filter, FilterFlags );
Result.FinEvent := CreateEvent( nil, TRUE, FALSE, nil );
Result.FHandle := FindFirstChangeNotification(PKOLChar(Result.FPath),
Bool( Integer( WatchSubtree ) ), Flags);
if Result.FHandle <> INVALID_HANDLE_VALUE then
Result.FFlags := MakeFlags( @Filter, FilterFlags );
Result.FMonitor := NewThreadEx( Result.Execute )
else //MsgOK( 'Can not monitor ' + Result.FPath + #13'Error ' + Int2Str( GetLastError ) );
begin
Result.Free;
Result := nil;
end;
end;
{$ENDIF ASM_VERSION}
//[END _NewDirChgNotifier]
@ -2342,12 +2353,15 @@ begin
OnChange := nil;
SetEvent( FinEvent );
end;
if FMonitor <> nil then
while FinEvent <> 0 do
begin
FMonitor.WaitFor;
FMonitor.Free;
if Applet <> nil then
Applet.ProcessMessages; // otherwise deadlock is possible !!!
Sleep( 1 ); // otherwise processor load can be too high !!!
if AppletTerminated then
break;
end;
CloseHandle( FinEvent );
FMonitor.Free;
FPath := '';
inherited;
end;
@ -2394,6 +2408,13 @@ function TDirChange.Execute(Sender: PThread): Integer;
var Handles: array[ 0..1 ] of THandle;
//i: Integer;
begin
{$IFDEF DIRCHG_ONEXECUTE}
if Assigned( OnExecute ) then
OnExecute( @ Self );
{$ENDIF}
FinEvent := CreateEvent( nil, TRUE, FALSE, nil );
FHandle := FindFirstChangeNotification(PKOLChar(FPath),
Bool( Integer( FWatchSubtree ) ), FFlags);
Handles[ 0 ] := FHandle;
Handles[ 1 ] := FinEvent;
while not AppletTerminated do
@ -2401,7 +2422,6 @@ begin
WAIT_OBJECT_0:
begin
if AppletTerminated or FDestroying then break;
//Applet.GetWindowHandle;
Sender.Synchronize( Changed );
FindNextChangeNotification(Handles[ 0 ]);
end;
@ -2411,7 +2431,9 @@ begin
TRY
{$ENDIF}
FindCloseChangeNotification( Handles[ 0 ] );
//CloseHandle( Handles[ 1 ] );
FHandle := 0;
CloseHandle( FinEvent );
FinEvent := 0;
{$IFDEF SAFE_CODE}
EXCEPT
END;
@ -3506,8 +3528,8 @@ begin
end;
W := Btn.BoundsRect.Right;
end;
DlgPrnt.Width := Max(
Max( DlgPrnt.Width, Lab.Left + Lab.Width + 4 ), W + 8 );
DlgPrnt.ClientWidth := Max(
Max( DlgPrnt.ClientWidth, Lab.Left + Lab.Width + 4 ), W + 8 );
X := (DlgPrnt.ClientWidth - W) div 2;
for I := 0 to Buttons.Count-1 do
begin
@ -3536,7 +3558,7 @@ begin
{$ENDIF TOGRUSH_OPTIONAL}
begin
DlgPrnt.ResizeParent;
DlgPrnt.Width := Max( DlgPrnt.Width, Dialog.Width - 14 );
DlgPrnt.ClientWidth := Max( DlgPrnt.ClientWidth, Dialog.Width - 14 );
end;
Bmp.Free;
{$ENDIF USE_GRUSH}
@ -3561,8 +3583,7 @@ begin
Dialog.ShowModal;
Result := Dialog.ModalResult;
Dialog.Free;
end
else
end else
begin
DlgWnd := Dialog.Handle;
while IsWindow( DlgWnd ) and (Dialog.ModalResult = 0) do

16
mirror.pas
View File

@ -8228,6 +8228,8 @@ begin
if (KF <> nil) and KF.FormCompact then
begin
KF.FormAddCtlCommand( Name, 'TControl.SetDefaultBtn' );
KF.FormAddNumParameter( 13 );
KF.FormAddNumParameter( 1 );
// param = 1
end else
SL.Add( Prefix + AName + '.DefaultBtn := TRUE;' );
@ -8235,7 +8237,9 @@ begin
if fCancelBtn then
if (KF <> nil) and KF.FormCompact then
begin
KF.FormAddCtlCommand( Name, 'TControl.SetCancelBtn' );
KF.FormAddCtlCommand( Name, 'TControl.SetDefaultBtn' );
KF.FormAddNumParameter( 27 );
KF.FormAddNumParameter( 1 );
// param = 1
end else
SL.Add( Prefix + AName + '.CancelBtn := TRUE;' );
@ -8247,11 +8251,13 @@ begin
Integer( AnchorTop ) shl 1 +
Integer( AnchorRight ) shl 2 +
Integer( AnchorBottom ) shl 3;
if (i = 1) or (i = 2) or (i = 4) or (i = 8) then
KF.FormAddCtlCommand( Name, 'TControl.SetAnchor' );
CASE i OF
1: KF.FormAddCtlCommand( Name, 'TControl.SetAnchorLeft' );
2: KF.FormAddCtlCommand( Name, 'TControl.SetAnchorTop' );
4: KF.FormAddCtlCommand( Name, 'TControl.SetAnchorRight' );
8: KF.FormAddCtlCommand( Name, 'TControl.SetAnchorBottom' );
1: KF.FormAddNumParameter( ANCHOR_LEFT );
2: KF.FormAddNumParameter( ANCHOR_TOP );
4: KF.FormAddNumParameter( ANCHOR_RIGHT );
8: KF.FormAddNumParameter( ANCHOR_BOTTOM );
else
KF.FormAddCtlCommand( Name, 'FormSetAnchor' );
KF.FormAddNumParameter( i );