pascal/kolmck
1
0
Fork 0
Code Issues Releases Activity

3z8

Browse Source 
git-svn-id: https://svn.code.sf.net/p/kolmck/code@93 91bb2d04-0c0c-4d2d-88a5-bbb6f4c1fa07
This commit is contained in:
dkolmck
2010-12-03 15:28:22 +00:00
parent e8ca1a22b8
commit 60caec3b22
2 changed files with 354 additions and 363 deletions
Download Patch File Download Diff File Expand all files Collapse all files

239
KOL.pas
View File

@ -14,7 +14,7 @@
Key Objects Library (C) 2000 by Kladov Vladimir.
****************************************************************
* VERSION 3.00.Z7
* VERSION 3.00.Z8
****************************************************************
K.O.L. - is a set of objects to create small programs
@ -12415,6 +12415,10 @@ type
{* This event is called on reading each item while scanning directory.
To use it, first create PDirList object with empty path to scan, then
assign OnItem event and call ScanDirectory with correct path. }
procedure DeleteItem( Idx: Integer );
{* Allows to delete an item from the directory list (not from the disk!) }
procedure AddItem( FindData: PFindFileData );
{* Allows to add arbitrary item to the list. }
end;
function NewDirList( const DirPath, Filter: KOLString; Attr: DWORD ): PDirList;
@ -25738,9 +25742,52 @@ begin
end;
end;
{$IFDEF WIN_GDI} //vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
procedure TDirList.DeleteItem(Idx: Integer);
begin
FListPositions.Delete( Idx );
end;
procedure TDirList.AddItem(FindData: PFindFileData);
begin
if fStoreFiles = nil then
begin
{$IFDEF DIRLIST_FASTER}
fStoreFiles := NewMemBlkStream_WriteOnly( 32 * Sizeof( FindData ) );
{$ELSE}
fStoreFiles := NewMemoryStream( );
fStoreFiles.Capacity := 64 * Sizeof( FindData );
{$ENDIF}
FListPositions := NewList;
end;
{$IFDEF DIRLIST_FASTER}{$ELSE}
FListPositions.Add( Pointer( fStoreFiles.Position ) );
{$ENDIF}
{$IFDEF UNICODE_CTRLS}
{$IFDEF SPEED_FASTER}
{$IFDEF DIRLIST_OPTIMIZE_ASCII}
FindData.dwReserved0 := 0;
P := @ FindData.cFileName[0];
while P^ <> #0 do
begin
if PWord( P )^ > 255 then
begin
inc( FindData.dwReserved0 );
break;
end;
inc( P );
end;
{$ENDIF}
{$ENDIF}
{$ENDIF}
fStoreFiles.Write( FindData^, Sizeof( FindData^ ) );
{$IFDEF DIRLIST_FASTER}
FListPositions.Add( fStoreFiles.fData.fJustWrittenBlkAddress );
{$ENDIF}
end;
{$IFDEF WIN_GDI} //vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
////////////////////////////////////////////////////////////////////////
// R E G I S T R Y
// R E G I S T R Y //
////////////////////////////////////////////////////////////////////////
{ -- registry -- }
@ -34755,7 +34802,7 @@ begin
Result := TRUE;
{$IFDEF NIL_EVENTS}
if assigned( Self_.EV.fOnChar ) then
if assigned( Sender.EV.fOnChar ) then
{$ENDIF}
begin
C := KOLChar( Msg.wParam );
@ -53946,7 +53993,10 @@ var BFH : TBitmapFileHeader;
end else
while n > 0 do
begin
Strm.WriteVal( 1, 1 );
if n = 1 then
Strm.WriteVal( 01, 1 )
else
Strm.WriteVal( 02, 1 );
Strm.WriteVal( P[i] shl 4 or P[i+1], 1 );
inc( i, 2 );
dec( n, 2 );
@ -63084,10 +63134,7 @@ begin
Result := FALSE;
if (Msg.message = WM_PAINT) {or (Msg.message = WM_PRINT)} then
begin
//if not Result then
begin
WasOnPaint := Self_.EV.fOnPaint;
begin WasOnPaint := Self_.EV.fOnPaint;
Self_.{$IFDEF EVENTS_DYNAMIC} ProvideUniqueEvents {$ELSE} EV {$ENDIF}
.fOnPaint2 := Self_.EV.fOnPaint;
//Self_.fPaintMsg := Msg;
@ -63119,10 +63166,8 @@ begin
if not Result then
{Result :=} WndProcPaint( Self_, Msg, Rslt );
Self_.EV.fOnPaint := WasOnPaint;
end;
Result := TRUE;
end
else
end else
if (Msg.message >= WM_MOUSEFIRST) and (Msg.message <= WM_MOUSELAST) then
begin
Pt.X := SmallInt( LoWord( Msg.lParam ) );
@ -63297,46 +63342,35 @@ begin
C.EV.fLeave := C.LeaveGraphButton;
C.RefDec;
end;
end;
end;////////////////////////////////////////////////////////////////////////////
function WndProc_FormHavingGraphCtl( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
var Msg2: TMsg;
begin
Result := FALSE;
begin Result := FALSE;
if Msg.message = WM_ACTIVATE then
begin
if Self_.DF.fCurrentControl <> nil then
begin if Self_.DF.fCurrentControl <> nil then
Self_.DF.fCurrentControl.Invalidate;
end
else
end else
if (Msg.message >= WM_KEYFIRST) and (Msg.message <= WM_KEYLAST) then
begin
if (Self_.DF.fCurrentControl <> nil)
begin if (Self_.DF.fCurrentControl <> nil)
and {$IFDEF USE_FLAGS} (G6_GraphicCtl in Self_.DF.fCurrentControl.fFlagsG6)
{$ELSE} not Self_.DF.fCurrentControl.fWindowed {$ENDIF} then
begin
if (Msg.message = WM_KEYDOWN) and ((Msg.wParam = 32) or (Msg.wParam = 13)) then
begin
if not PeekMessage( Msg2, Msg.hwnd, WM_CHAR, WM_CHAR, pm_noRemove ) or
(Msg2.wParam <> Msg.wParam) then
begin if (Msg.message = WM_KEYDOWN) and ((Msg.wParam = 32) or (Msg.wParam = 13)) then
begin if not PeekMessage( Msg2, Msg.hwnd, WM_CHAR, WM_CHAR, pm_noRemove )
or (Msg2.wParam <> Msg.wParam) then
Msg.message := WM_CHAR;
end
else
end else
if (Msg.message = WM_SYSKEYDOWN) and ((Msg.wParam = 32) or (Msg.wParam = 13)) then
begin
if not PeekMessage( Msg2, Msg.hwnd, WM_SYSCHAR, WM_SYSCHAR, pm_noRemove ) or
begin if not PeekMessage( Msg2, Msg.hwnd, WM_SYSCHAR, WM_SYSCHAR, pm_noRemove ) or
(Msg2.wParam <> Msg.wParam) then
Msg.message := WM_SYSCHAR;
end;
if Assigned( Self_.DF.fCurrentControl.fKeyboardProcess ) and
Self_.DF.fCurrentControl.fKeyboardProcess( Msg, Rslt ) then
else
Rslt := Self_.DF.fCurrentControl.WndProc( Msg );
else Rslt := Self_.DF.fCurrentControl.WndProc( Msg );
Result := TRUE;
end;
end;
end;
end;////////////////////////////////////////////////////////////////////////////
{$IFDEF GRAPHCTL_HOTTRACK}
procedure TControl.MouseLeaveFromParentOfGraphCtl(Sender: PObj);
var C: PControl;
@ -63371,23 +63405,18 @@ end;
function _NewGraphCtl( AParent: PControl; ATabStop: Boolean;
ACommandActions: TCommandActionsParam ): PControl;
var IdxActions: Integer;
begin
new( Result, Create );
{$IFDEF DEBUG_OBJKIND}
Result.fObjKind := 'TControl:GraphicControl';
begin new( Result, Create );
{$IFDEF DEBUG_OBJKIND} Result.fObjKind := 'TControl:GraphicControl';
{$ENDIF}
{$IFDEF COMMANDACTIONS_OBJ}
IdxActions := Integer( ACommandActions );
if IdxActions >= 120 then
IdxActions := PByte( ACommandActions )^;
if AllActions_Objs[IdxActions] <> nil then
begin
Result.fCommandActions := AllActions_Objs[IdxActions];
begin Result.fCommandActions := AllActions_Objs[IdxActions];
Result.fCommandActions.RefInc;
end
else
begin
new( Result.fCommandActions, Create );
end else
begin new( Result.fCommandActions, Create );
{$IFDEF DEBUG_OBJKIND}
Result.fCommandActions.fObjKind := 'TCommandActionsObj';
{$ENDIF}
@ -63398,8 +63427,7 @@ begin
Move( ACommandActions^, Result.fCommandActions.aClear, Sizeof( TCommandActions ) );
end;
Result.Add2AutoFree( Result.fCommandActions );
{$ELSE}
{$IFDEF SAFE_CODE}
{$ELSE} {$IFDEF SAFE_CODE}
if ACommandActions <> nil then
{$ENDIF}
Result.fCommandActions := ACommandActions^;
@ -63429,13 +63457,11 @@ begin
if ATabStop then
Result.fLookTabKeys := [ tkTab, tkLeftRight, tkUpDown, tkPageUpPageDn ];
if AParent <> nil then
begin
Result.Parent := AParent;
begin Result.Parent := AParent;
Result.Border := AParent.Border;
AParent.AttachProc( WndProc_ParentOfGraphicCtl );
if ATabStop then
begin
Inc( AParent.ParentForm.fTabOrder );
begin Inc( AParent.ParentForm.fTabOrder );
Result.fTabOrder := AParent.ParentForm.fTabOrder;
end;
if {$IFDEF USE_FLAGS} G3_IsControl in AParent.fFlagsG3
@ -63443,16 +63469,14 @@ begin
AParent.ParentForm.AttachProc( WndProc_FormHavingGraphCtl );
if {$IFDEF USE_FLAGS} G5_IsGroupbox in APArent.fFlagsG5
{$ELSE} AParent.fIsGroupBox {$ENDIF} then
begin
AParent.Style := AParent.Style and
begin AParent.Style := AParent.Style and
not BS_GROUPBOX; // otherwise the groupbox is flickering A LOT!
AParent.Parent.AttachProc( WndProc_ParentOfGraphicCtl );
end;
Result.fFont := Result.fFont.Assign( AParent.fFont );
if Result.fFont <> nil then
begin
Result.fFont.fParentGDITool := AParent.fFont;
begin Result.fFont.fParentGDITool := AParent.fFont;
Result.fFont.fOnChange := Result.FontChanged;
Result.FontChanged( Result.fFont );
end;
@ -63465,14 +63489,10 @@ begin
if WinVer < wvXP then
DoNotDrawGraphCtlsUsingXPStyles := TRUE;
{$ENDIF}
end;
end;////////////////////////////////////////////////////////////////////////////
function NewGraphLabel( AParent: PControl; const ACaption: AnsiString ): PControl;
begin
{$IFDEF INPACKAGE}
Result := NewLabel( AParent, ACaption );
{$ELSE}
Result := _NewGraphCtl( AParent, FALSE,
begin {$IFDEF INPACKAGE} Result := NewLabel( AParent, ACaption );
{$ELSE} Result := _NewGraphCtl( AParent, FALSE,
{$IFDEF PACK_COMMANDACTIONS} LabelActions_Packed
{$ELSE} @LabelActions {$ENDIF} );
Result.aAutoSzX := 1;
@ -63480,32 +63500,21 @@ begin
Result.EV.fPaintProc := Result.GraphicLabelPaint;
Result.Caption := ACaption;
{$ENDIF}
end;
end;////////////////////////////////////////////////////////////////////////////
function NewWordWrapGraphLabel( AParent: PControl; const ACaption: KOLString ): PControl;
begin
{$IFDEF INPACKAGE}
Result := NewWordWrapLabel( AParent, ACaption );
{$ELSE}
Result := NewGraphLabel( AParent, ACaption );
begin {$IFDEF INPACKAGE} Result := NewWordWrapLabel( AParent, ACaption );
{$ELSE} Result := NewGraphLabel( AParent, ACaption );
{$IFDEF USE_FLAGS} include( Result.fFlagsG1, G1_WordWrap );
{$ELSE} Result.fWordWrap := TRUE; {$ENDIF}
{$ENDIF}
end;
end;////////////////////////////////////////////////////////////////////////////
function NewGraphPaintBox( AParent: PControl ): PControl;
begin
{$IFDEF INPACKAGE}
Result := NewPaintbox( AParent );
{$ELSE}
Result := NewGraphLabel( AParent, '' );
{$ENDIF}
end;
begin {$IFDEF INPACKAGE} Result := NewPaintbox( AParent );
{$ELSE} Result := NewGraphLabel( AParent, '' ); {$ENDIF}
end;////////////////////////////////////////////////////////////////////////////
procedure ClickGraphCheck(Sender: PObj);
var Ctl: PControl;
begin
Ctl := Pointer( Sender );
begin Ctl := Pointer( Sender );
if not Ctl.Enabled then Exit;
Ctl.Focused := TRUE;
if Assigned( Ctl.OnEnter ) then
@ -63518,76 +63527,57 @@ begin
Ctl.Invalidate;
if Assigned( Ctl.OnClick ) then
Ctl.OnClick( Ctl );
end;
end;////////////////////////////////////////////////////////////////////////////
function NewGraphCheckBox( AParent: PControl; const ACaption: KOLString ): PControl;
begin
{$IFDEF INPACKAGE}
Result := NewCheckbox( AParent, ACaption );
{$ELSE}
Result := NewGraphButton( AParent, ACaption );
begin {$IFDEF INPACKAGE} Result := NewCheckbox( AParent, ACaption );
{$ELSE} Result := NewGraphButton( AParent, ACaption );
Result.TextAlign := taLeft;
Result.aAutoSzX := GetSystemMetrics( SM_CXMENUCHECK ) + 4;
Result.EV.fPaintProc := Result.GraphicCheckBoxPaint;
Result.EV.fGraphCtlMouseEvent := Result.GraphicCheckBoxMouse;
Result.PP.fControlClick := @ ClickGraphCheck;
{$ENDIF}
end;
end;////////////////////////////////////////////////////////////////////////////
procedure ClickGraphRadio(Sender: PObj);
var Ctl, C: PControl;
i: Integer;
begin
Ctl := Pointer( Sender );
begin Ctl := Pointer( Sender );
if not Ctl.Enabled then Exit;
Ctl.Focused := TRUE;
Ctl.Checked := TRUE;
if Ctl.Parent <> nil then
for i := 0 to Ctl.Parent.ChildCount-1 do
begin
C := Ctl.Parent.Children[ i ];
begin C := Ctl.Parent.Children[ i ];
if (C <> Ctl) and (@ C.PP.fControlClick = @ ClickGraphRadio) then
C.Checked := FALSE;
end;
end;
end;////////////////////////////////////////////////////////////////////////////
function NewGraphRadioBox( AParent: PControl; const ACaption: KOLString ): PControl;
begin
{$IFDEF INPACKAGE}
Result := NewRadiobox( AParent, ACaption );
begin {$IFDEF INPACKAGE} Result := NewRadiobox( AParent, ACaption );
if (@ ClickGraphRadio) <> nil then;
{$ELSE}
Result := NewGraphButton( AParent, ACaption );
{$ELSE} Result := NewGraphButton( AParent, ACaption );
Result.TextAlign := taLeft;
Result.aAutoSzX := GetSystemMetrics( SM_CXMENUCHECK ) + 4;
Result.EV.fPaintProc := Result.GraphicRadioBoxPaint;
Result.PP.fControlClick := @ ClickGraphRadio;
if AParent <> nil then
begin
//AParent.fRadioLast := Result.fMenu;
AParent.PropInt[ RADIO_LAST ] := Result.fMenu;
//if AParent.fRadio1st = 0 then
begin AParent.PropInt[ RADIO_LAST ] := Result.fMenu;
if AParent.PropInt[ RADIO_1ST ] = 0 then
begin
//AParent.fRadio1st := Result.fMenu;
AParent.PropInt[ RADIO_1ST ] := Result.fMenu;
begin AParent.PropInt[ RADIO_1ST ] := Result.fMenu;
Result.SetRadioChecked;
end;
end;
{$ENDIF}
end;
end;////////////////////////////////////////////////////////////////////////////
procedure GraphButtonSetFocus(Ctl: PControl);
var PF, CC: PControl;
W: HWnd;
begin
if {$IFDEF USE_FLAGS} not(F2_Tabstop in Ctl.fStyle.f2_Style)
begin if {$IFDEF USE_FLAGS} not(F2_Tabstop in Ctl.fStyle.f2_Style)
{$ELSE} not Ctl.fTabStop {$ENDIF} then Exit;
PF := Ctl.ParentForm;
if (PF.DF.fCurrentControl <> nil) and (PF.DF.fCurrentControl <> Ctl) and
(PF.DF.fCurrentControl <> Ctl.fParent) then
begin
CC := PF.DF.fCurrentControl;
begin CC := PF.DF.fCurrentControl;
CC.RefInc;
Ctl.fParent.Focused := TRUE;
if Assigned( CC.EV.fLeave ) then
@ -63596,28 +63586,23 @@ begin
Windows.SetFocus( 0 );
CC.RefDec;
end else
begin
W := GetFocus;
begin W := GetFocus;
if (W <> Ctl.Parent.fHandle) and (W <> 0) then
begin
Windows.SetFocus( 0 );
begin Windows.SetFocus( 0 );
Ctl.fParent.Focused := TRUE;
end;
end;
if Ctl.fParent.fHandle <> 0 then
begin
{$IFDEF USE_FLAGS} include( Ctl.fFlagsG6, G6_Focused );
begin {$IFDEF USE_FLAGS} include( Ctl.fFlagsG6, G6_Focused );
{$ELSE} Ctl.fFocused := TRUE; {$ENDIF}
Ctl.fParent.Postmsg( CM_FOCUSGRAPHCTL, Integer( Ctl ), 0 );
Ctl.RefInc;
end;
if Assigned( Ctl.EV.fOnEnter ) then
Ctl.EV.fOnEnter( Ctl );
end;
end;////////////////////////////////////////////////////////////////////////////
function NewGraphButton( AParent: PControl; const ACaption: KOLString ): PControl;
begin
{$IFDEF INPACKAGE}
begin {$IFDEF INPACKAGE}
Result := NewButton( AParent, ACaption );
{$ELSE}
Result := _NewGraphCtl( AParent, TRUE,
@ -63631,12 +63616,10 @@ begin
Result.fSetFocus := @GraphButtonSetFocus;
Result.fKeyboardProcess := Result.GraphButtonKeyboardProcess;
{$ENDIF}
end;
end;////////////////////////////////////////////////////////////////////////////
function EditGraphEdit(Ctl: PControl): PControl;
var E: PControl;
begin
E := NewEditBox( Ctl.fParent, Ctl.DF.fEditOptions );
begin E := NewEditBox( Ctl.fParent, Ctl.DF.fEditOptions );
E.SetBoundsRect( Ctl.BoundsRect );
E.SetAlign( Ctl.Align );
E.fTabOrder := Ctl.fTabOrder;

10
KOL_ASM.inc
View File

@ -7543,6 +7543,14 @@ asm //cmd //opd
CALL TControl.ParentForm
CMP EAX, EBX
JE @@ret0
{$IFDEF USE_FLAGS}
TEST [EAX].fFlagsG6, 1 shl G6_KeyPreview
{$ELSE}
CMP [EAX].fKeyPreview, 0
{$ENDIF}
JZ @@ret0
{$IFDEF USE_FLAGS}
OR [EAX].TControl.fFlagsG4, 1 shl G4_Pushed
{$ELSE}
@ -14821,6 +14829,6 @@ asm
POP EDI
end;
//{$ENDIF}
{$ENDIF}
//======================================== THE END OF FILE KOL_ASM.inc