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

605
KOL.pas
View File

@ -14,7 +14,7 @@
Key Objects Library (C) 2000 by Kladov Vladimir. 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 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. {* This event is called on reading each item while scanning directory.
To use it, first create PDirList object with empty path to scan, then To use it, first create PDirList object with empty path to scan, then
assign OnItem event and call ScanDirectory with correct path. } 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; end;
function NewDirList( const DirPath, Filter: KOLString; Attr: DWORD ): PDirList; function NewDirList( const DirPath, Filter: KOLString; Attr: DWORD ): PDirList;
@ -25738,9 +25742,52 @@ begin
end; end;
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 -- } { -- registry -- }
@ -34755,7 +34802,7 @@ begin
Result := TRUE; Result := TRUE;
{$IFDEF NIL_EVENTS} {$IFDEF NIL_EVENTS}
if assigned( Self_.EV.fOnChar ) then if assigned( Sender.EV.fOnChar ) then
{$ENDIF} {$ENDIF}
begin begin
C := KOLChar( Msg.wParam ); C := KOLChar( Msg.wParam );
@ -53946,7 +53993,10 @@ var BFH : TBitmapFileHeader;
end else end else
while n > 0 do while n > 0 do
begin 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 ); Strm.WriteVal( P[i] shl 4 or P[i+1], 1 );
inc( i, 2 ); inc( i, 2 );
dec( n, 2 ); dec( n, 2 );
@ -63084,10 +63134,7 @@ begin
Result := FALSE; Result := FALSE;
if (Msg.message = WM_PAINT) {or (Msg.message = WM_PRINT)} then if (Msg.message = WM_PAINT) {or (Msg.message = WM_PRINT)} then
begin begin WasOnPaint := Self_.EV.fOnPaint;
//if not Result then
begin
WasOnPaint := Self_.EV.fOnPaint;
Self_.{$IFDEF EVENTS_DYNAMIC} ProvideUniqueEvents {$ELSE} EV {$ENDIF} Self_.{$IFDEF EVENTS_DYNAMIC} ProvideUniqueEvents {$ELSE} EV {$ENDIF}
.fOnPaint2 := Self_.EV.fOnPaint; .fOnPaint2 := Self_.EV.fOnPaint;
//Self_.fPaintMsg := Msg; //Self_.fPaintMsg := Msg;
@ -63119,10 +63166,8 @@ begin
if not Result then if not Result then
{Result :=} WndProcPaint( Self_, Msg, Rslt ); {Result :=} WndProcPaint( Self_, Msg, Rslt );
Self_.EV.fOnPaint := WasOnPaint; Self_.EV.fOnPaint := WasOnPaint;
end; Result := TRUE;
Result := TRUE; end else
end
else
if (Msg.message >= WM_MOUSEFIRST) and (Msg.message <= WM_MOUSELAST) then if (Msg.message >= WM_MOUSEFIRST) and (Msg.message <= WM_MOUSELAST) then
begin begin
Pt.X := SmallInt( LoWord( Msg.lParam ) ); Pt.X := SmallInt( LoWord( Msg.lParam ) );
@ -63297,46 +63342,35 @@ begin
C.EV.fLeave := C.LeaveGraphButton; C.EV.fLeave := C.LeaveGraphButton;
C.RefDec; C.RefDec;
end; end;
end; end;////////////////////////////////////////////////////////////////////////////
function WndProc_FormHavingGraphCtl( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; function WndProc_FormHavingGraphCtl( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
var Msg2: TMsg; var Msg2: TMsg;
begin begin Result := FALSE;
Result := FALSE;
if Msg.message = WM_ACTIVATE then if Msg.message = WM_ACTIVATE then
begin begin if Self_.DF.fCurrentControl <> nil then
if Self_.DF.fCurrentControl <> nil then
Self_.DF.fCurrentControl.Invalidate; Self_.DF.fCurrentControl.Invalidate;
end end else
else
if (Msg.message >= WM_KEYFIRST) and (Msg.message <= WM_KEYLAST) then if (Msg.message >= WM_KEYFIRST) and (Msg.message <= WM_KEYLAST) then
begin begin if (Self_.DF.fCurrentControl <> nil)
if (Self_.DF.fCurrentControl <> nil) and {$IFDEF USE_FLAGS} (G6_GraphicCtl in Self_.DF.fCurrentControl.fFlagsG6)
and {$IFDEF USE_FLAGS} (G6_GraphicCtl in Self_.DF.fCurrentControl.fFlagsG6)
{$ELSE} not Self_.DF.fCurrentControl.fWindowed {$ENDIF} then {$ELSE} not Self_.DF.fCurrentControl.fWindowed {$ENDIF} then
begin begin if (Msg.message = WM_KEYDOWN) and ((Msg.wParam = 32) or (Msg.wParam = 13)) then
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 )
begin or (Msg2.wParam <> Msg.wParam) then
if not PeekMessage( Msg2, Msg.hwnd, WM_CHAR, WM_CHAR, pm_noRemove ) or Msg.message := WM_CHAR;
(Msg2.wParam <> Msg.wParam) then end else
Msg.message := WM_CHAR; if (Msg.message = WM_SYSKEYDOWN) and ((Msg.wParam = 32) or (Msg.wParam = 13)) then
end begin if not PeekMessage( Msg2, Msg.hwnd, WM_SYSCHAR, WM_SYSCHAR, pm_noRemove ) or
else (Msg2.wParam <> Msg.wParam) then
if (Msg.message = WM_SYSKEYDOWN) and ((Msg.wParam = 32) or (Msg.wParam = 13)) then Msg.message := WM_SYSCHAR;
begin end;
if not PeekMessage( Msg2, Msg.hwnd, WM_SYSCHAR, WM_SYSCHAR, pm_noRemove ) or if Assigned( Self_.DF.fCurrentControl.fKeyboardProcess ) and
(Msg2.wParam <> Msg.wParam) then Self_.DF.fCurrentControl.fKeyboardProcess( Msg, Rslt ) then
Msg.message := WM_SYSCHAR; else Rslt := Self_.DF.fCurrentControl.WndProc( Msg );
end; Result := TRUE;
if Assigned( Self_.DF.fCurrentControl.fKeyboardProcess ) and end;
Self_.DF.fCurrentControl.fKeyboardProcess( Msg, Rslt ) then
else
Rslt := Self_.DF.fCurrentControl.WndProc( Msg );
Result := TRUE;
end;
end; end;
end; end;////////////////////////////////////////////////////////////////////////////
{$IFDEF GRAPHCTL_HOTTRACK} {$IFDEF GRAPHCTL_HOTTRACK}
procedure TControl.MouseLeaveFromParentOfGraphCtl(Sender: PObj); procedure TControl.MouseLeaveFromParentOfGraphCtl(Sender: PObj);
var C: PControl; var C: PControl;
@ -63371,295 +63405,244 @@ end;
function _NewGraphCtl( AParent: PControl; ATabStop: Boolean; function _NewGraphCtl( AParent: PControl; ATabStop: Boolean;
ACommandActions: TCommandActionsParam ): PControl; ACommandActions: TCommandActionsParam ): PControl;
var IdxActions: Integer; var IdxActions: Integer;
begin begin new( Result, Create );
new( Result, Create ); {$IFDEF DEBUG_OBJKIND} Result.fObjKind := 'TControl:GraphicControl';
{$IFDEF DEBUG_OBJKIND} {$ENDIF}
Result.fObjKind := 'TControl:GraphicControl'; {$IFDEF COMMANDACTIONS_OBJ}
{$ENDIF} IdxActions := Integer( ACommandActions );
{$IFDEF COMMANDACTIONS_OBJ} if IdxActions >= 120 then
IdxActions := Integer( ACommandActions ); IdxActions := PByte( ACommandActions )^;
if IdxActions >= 120 then if AllActions_Objs[IdxActions] <> nil then
IdxActions := PByte( ACommandActions )^; begin Result.fCommandActions := AllActions_Objs[IdxActions];
if AllActions_Objs[IdxActions] <> nil then Result.fCommandActions.RefInc;
begin end else
Result.fCommandActions := AllActions_Objs[IdxActions]; begin new( Result.fCommandActions, Create );
Result.fCommandActions.RefInc; {$IFDEF DEBUG_OBJKIND}
end Result.fCommandActions.fObjKind := 'TCommandActionsObj';
else {$ENDIF}
begin AllActions_Objs[IdxActions] := Result.fCommandActions;
new( Result.fCommandActions, Create ); {$IFDEF SAFE_CODE}
{$IFDEF DEBUG_OBJKIND} if ACommandActions <> nil then
Result.fCommandActions.fObjKind := 'TCommandActionsObj'; {$ENDIF}
{$ENDIF} Move( ACommandActions^, Result.fCommandActions.aClear, Sizeof( TCommandActions ) );
AllActions_Objs[IdxActions] := Result.fCommandActions; end;
{$IFDEF SAFE_CODE} Result.Add2AutoFree( Result.fCommandActions );
{$ELSE} {$IFDEF SAFE_CODE}
if ACommandActions <> nil then if ACommandActions <> nil then
{$ENDIF} {$ENDIF}
Move( ACommandActions^, Result.fCommandActions.aClear, Sizeof( TCommandActions ) ); Result.fCommandActions := ACommandActions^;
end;
Result.Add2AutoFree( Result.fCommandActions );
{$ELSE}
{$IFDEF SAFE_CODE}
if ACommandActions <> nil then
{$ENDIF} {$ENDIF}
Result.fCommandActions := ACommandActions^; Result.PP.fDoInvalidate := InvalidateNonWindowed;
{$ENDIF} {$IFDEF USE_FLAGS} include( Result.fFlagsG6, G6_GraphicCtl );
Result.PP.fDoInvalidate := InvalidateNonWindowed; {$ELSE} Result.fWindowed := FALSE; {$ENDIF}
{$IFDEF USE_FLAGS} include( Result.fFlagsG6, G6_GraphicCtl ); {$IFDEF USE_FLAGS}
{$ELSE} Result.fWindowed := FALSE; {$ENDIF} include( Result.fFlagsG3, G3_IsControl );
{$IFDEF USE_FLAGS} include( Result.fFlagsG4, G4_CreateVisible );
include( Result.fFlagsG3, G3_IsControl ); if ATabStop then
include( Result.fFlagsG4, G4_CreateVisible ); include( Result.fStyle.f2_Style, F2_TabStop );
if ATabStop then {$ELSE} Result.fCreateVisible := TRUE;
include( Result.fStyle.f2_Style, F2_TabStop ); Result.fVisible := TRUE;
{$ELSE} Result.fCreateVisible := TRUE; Result.fIsControl := TRUE;
Result.fVisible := TRUE; Result.fTabstop := ATabStop;
Result.fIsControl := TRUE; {$ENDIF}
Result.fTabstop := ATabStop; Result.fMenu := CtlIdCount;
{$ENDIF} Inc( CtlIdCount );
Result.fMenu := CtlIdCount; Result.DF.fBitBtnOptions := [ bboFixed ]; // to return Checked = fChecked w/o window handle
Inc( CtlIdCount ); {$IFDEF USE_FLAGS}
Result.DF.fBitBtnOptions := [ bboFixed ]; // to return Checked = fChecked w/o window handle Result.fFlagsG1 := Result.fFlagsG1 + [ G1_IgnoreWndCaption, G1_SizeRedraw ];
{$IFDEF USE_FLAGS} {$ELSE} Result.fIgnoreWndCaption := TRUE;
Result.fFlagsG1 := Result.fFlagsG1 + [ G1_IgnoreWndCaption, G1_SizeRedraw ]; Result.fSizeRedraw := TRUE;
{$ELSE} Result.fIgnoreWndCaption := TRUE; {$ENDIF}
Result.fSizeRedraw := TRUE; Result.PP.fNotifyChild := @ NotifyGraphCtlAboutNewParent;
{$ENDIF} if ATabStop then
Result.PP.fNotifyChild := @ NotifyGraphCtlAboutNewParent; Result.fLookTabKeys := [ tkTab, tkLeftRight, tkUpDown, tkPageUpPageDn ];
if ATabStop then if AParent <> nil then
Result.fLookTabKeys := [ tkTab, tkLeftRight, tkUpDown, tkPageUpPageDn ]; begin Result.Parent := AParent;
if AParent <> nil then Result.Border := AParent.Border;
begin AParent.AttachProc( WndProc_ParentOfGraphicCtl );
Result.Parent := AParent; if ATabStop then
Result.Border := AParent.Border; begin Inc( AParent.ParentForm.fTabOrder );
AParent.AttachProc( WndProc_ParentOfGraphicCtl ); Result.fTabOrder := AParent.ParentForm.fTabOrder;
if ATabStop then end;
begin if {$IFDEF USE_FLAGS} G3_IsControl in AParent.fFlagsG3
Inc( AParent.ParentForm.fTabOrder ); {$ELSE} AParent.fIsControl {$ENDIF} then
Result.fTabOrder := AParent.ParentForm.fTabOrder; AParent.ParentForm.AttachProc( WndProc_FormHavingGraphCtl );
end; if {$IFDEF USE_FLAGS} G5_IsGroupbox in APArent.fFlagsG5
if {$IFDEF USE_FLAGS} G3_IsControl in AParent.fFlagsG3 {$ELSE} AParent.fIsGroupBox {$ENDIF} then
{$ELSE} AParent.fIsControl {$ENDIF} then begin AParent.Style := AParent.Style and
AParent.ParentForm.AttachProc( WndProc_FormHavingGraphCtl ); not BS_GROUPBOX; // otherwise the groupbox is flickering A LOT!
if {$IFDEF USE_FLAGS} G5_IsGroupbox in APArent.fFlagsG5 AParent.Parent.AttachProc( WndProc_ParentOfGraphicCtl );
{$ELSE} AParent.fIsGroupBox {$ENDIF} then end;
begin
AParent.Style := AParent.Style and Result.fFont := Result.fFont.Assign( AParent.fFont );
not BS_GROUPBOX; // otherwise the groupbox is flickering A LOT! if Result.fFont <> nil then
AParent.Parent.AttachProc( WndProc_ParentOfGraphicCtl ); begin Result.fFont.fParentGDITool := AParent.fFont;
Result.fFont.fOnChange := Result.FontChanged;
Result.FontChanged( Result.fFont );
end;
end; end;
Result.fBoundsRect.Right := Result.fBoundsRect.Left + 64;
Result.fBoundsRect.Bottom := Result.fBoundsRect.Top + 22;
Result.EV.fOnPaint := nil;
Result.fFont := Result.fFont.Assign( AParent.fFont ); {$IFDEF GRAPHCTL_XPSTYLES}
if Result.fFont <> nil then if WinVer < wvXP then
begin DoNotDrawGraphCtlsUsingXPStyles := TRUE;
Result.fFont.fParentGDITool := AParent.fFont; {$ENDIF}
Result.fFont.fOnChange := Result.FontChanged; end;////////////////////////////////////////////////////////////////////////////
Result.FontChanged( Result.fFont );
end;
end;
Result.fBoundsRect.Right := Result.fBoundsRect.Left + 64;
Result.fBoundsRect.Bottom := Result.fBoundsRect.Top + 22;
Result.EV.fOnPaint := nil;
{$IFDEF GRAPHCTL_XPSTYLES}
if WinVer < wvXP then
DoNotDrawGraphCtlsUsingXPStyles := TRUE;
{$ENDIF}
end;
function NewGraphLabel( AParent: PControl; const ACaption: AnsiString ): PControl; function NewGraphLabel( AParent: PControl; const ACaption: AnsiString ): PControl;
begin begin {$IFDEF INPACKAGE} Result := NewLabel( AParent, ACaption );
{$IFDEF INPACKAGE} {$ELSE} Result := _NewGraphCtl( AParent, FALSE,
Result := NewLabel( AParent, ACaption ); {$IFDEF PACK_COMMANDACTIONS} LabelActions_Packed
{$ELSE} {$ELSE} @LabelActions {$ENDIF} );
Result := _NewGraphCtl( AParent, FALSE, Result.aAutoSzX := 1;
{$IFDEF PACK_COMMANDACTIONS} LabelActions_Packed Result.aAutoSzY := 1;
{$ELSE} @LabelActions {$ENDIF} ); Result.EV.fPaintProc := Result.GraphicLabelPaint;
Result.aAutoSzX := 1; Result.Caption := ACaption;
Result.aAutoSzY := 1; {$ENDIF}
Result.EV.fPaintProc := Result.GraphicLabelPaint; end;////////////////////////////////////////////////////////////////////////////
Result.Caption := ACaption;
{$ENDIF}
end;
function NewWordWrapGraphLabel( AParent: PControl; const ACaption: KOLString ): PControl; function NewWordWrapGraphLabel( AParent: PControl; const ACaption: KOLString ): PControl;
begin begin {$IFDEF INPACKAGE} Result := NewWordWrapLabel( AParent, ACaption );
{$IFDEF INPACKAGE} {$ELSE} Result := NewGraphLabel( AParent, ACaption );
Result := NewWordWrapLabel( AParent, ACaption ); {$IFDEF USE_FLAGS} include( Result.fFlagsG1, G1_WordWrap );
{$ELSE} {$ELSE} Result.fWordWrap := TRUE; {$ENDIF}
Result := NewGraphLabel( AParent, ACaption ); {$ENDIF}
{$IFDEF USE_FLAGS} include( Result.fFlagsG1, G1_WordWrap ); end;////////////////////////////////////////////////////////////////////////////
{$ELSE} Result.fWordWrap := TRUE; {$ENDIF}
{$ENDIF}
end;
function NewGraphPaintBox( AParent: PControl ): PControl; function NewGraphPaintBox( AParent: PControl ): PControl;
begin begin {$IFDEF INPACKAGE} Result := NewPaintbox( AParent );
{$IFDEF INPACKAGE} {$ELSE} Result := NewGraphLabel( AParent, '' ); {$ENDIF}
Result := NewPaintbox( AParent ); end;////////////////////////////////////////////////////////////////////////////
{$ELSE}
Result := NewGraphLabel( AParent, '' );
{$ENDIF}
end;
procedure ClickGraphCheck(Sender: PObj); procedure ClickGraphCheck(Sender: PObj);
var Ctl: PControl; var Ctl: PControl;
begin begin Ctl := Pointer( Sender );
Ctl := Pointer( Sender ); if not Ctl.Enabled then Exit;
if not Ctl.Enabled then Exit; Ctl.Focused := TRUE;
Ctl.Focused := TRUE; if Assigned( Ctl.OnEnter ) then
if Assigned( Ctl.OnEnter ) then Ctl.OnEnter( Ctl );
Ctl.OnEnter( Ctl ); {$IFDEF USE_FLAGS}
{$IFDEF USE_FLAGS} if G4_Checked in Ctl.fFlagsG4 then
if G4_Checked in Ctl.fFlagsG4 then exclude( Ctl.fFlagsG4, G4_Checked )
exclude( Ctl.fFlagsG4, G4_Checked ) else include( Ctl.fFlagsG4, G4_Checked );
else include( Ctl.fFlagsG4, G4_Checked ); {$ELSE} Ctl.fChecked := not Ctl.fChecked; {$ENDIF}
{$ELSE} Ctl.fChecked := not Ctl.fChecked; {$ENDIF} Ctl.Invalidate;
Ctl.Invalidate; if Assigned( Ctl.OnClick ) then
if Assigned( Ctl.OnClick ) then Ctl.OnClick( Ctl );
Ctl.OnClick( Ctl ); end;////////////////////////////////////////////////////////////////////////////
end;
function NewGraphCheckBox( AParent: PControl; const ACaption: KOLString ): PControl; function NewGraphCheckBox( AParent: PControl; const ACaption: KOLString ): PControl;
begin begin {$IFDEF INPACKAGE} Result := NewCheckbox( AParent, ACaption );
{$IFDEF INPACKAGE} {$ELSE} Result := NewGraphButton( AParent, ACaption );
Result := NewCheckbox( AParent, ACaption ); Result.TextAlign := taLeft;
{$ELSE} Result.aAutoSzX := GetSystemMetrics( SM_CXMENUCHECK ) + 4;
Result := NewGraphButton( AParent, ACaption ); Result.EV.fPaintProc := Result.GraphicCheckBoxPaint;
Result.TextAlign := taLeft; Result.EV.fGraphCtlMouseEvent := Result.GraphicCheckBoxMouse;
Result.aAutoSzX := GetSystemMetrics( SM_CXMENUCHECK ) + 4; Result.PP.fControlClick := @ ClickGraphCheck;
Result.EV.fPaintProc := Result.GraphicCheckBoxPaint; {$ENDIF}
Result.EV.fGraphCtlMouseEvent := Result.GraphicCheckBoxMouse; end;////////////////////////////////////////////////////////////////////////////
Result.PP.fControlClick := @ ClickGraphCheck;
{$ENDIF}
end;
procedure ClickGraphRadio(Sender: PObj); procedure ClickGraphRadio(Sender: PObj);
var Ctl, C: PControl; var Ctl, C: PControl;
i: Integer; i: Integer;
begin begin Ctl := Pointer( Sender );
Ctl := Pointer( Sender ); if not Ctl.Enabled then Exit;
if not Ctl.Enabled then Exit; Ctl.Focused := TRUE;
Ctl.Focused := TRUE; Ctl.Checked := TRUE;
Ctl.Checked := TRUE; if Ctl.Parent <> nil then
if Ctl.Parent <> nil then for i := 0 to Ctl.Parent.ChildCount-1 do
for i := 0 to Ctl.Parent.ChildCount-1 do begin C := Ctl.Parent.Children[ i ];
begin if (C <> Ctl) and (@ C.PP.fControlClick = @ ClickGraphRadio) then
C := Ctl.Parent.Children[ i ]; C.Checked := FALSE;
if (C <> Ctl) and (@ C.PP.fControlClick = @ ClickGraphRadio) then end;
C.Checked := FALSE; end;////////////////////////////////////////////////////////////////////////////
end;
end;
function NewGraphRadioBox( AParent: PControl; const ACaption: KOLString ): PControl; function NewGraphRadioBox( AParent: PControl; const ACaption: KOLString ): PControl;
begin begin {$IFDEF INPACKAGE} Result := NewRadiobox( AParent, ACaption );
{$IFDEF INPACKAGE} if (@ ClickGraphRadio) <> nil then;
Result := NewRadiobox( AParent, ACaption ); {$ELSE} Result := NewGraphButton( AParent, ACaption );
if (@ ClickGraphRadio) <> nil then; Result.TextAlign := taLeft;
{$ELSE} Result.aAutoSzX := GetSystemMetrics( SM_CXMENUCHECK ) + 4;
Result := NewGraphButton( AParent, ACaption ); Result.EV.fPaintProc := Result.GraphicRadioBoxPaint;
Result.TextAlign := taLeft; Result.PP.fControlClick := @ ClickGraphRadio;
Result.aAutoSzX := GetSystemMetrics( SM_CXMENUCHECK ) + 4; if AParent <> nil then
Result.EV.fPaintProc := Result.GraphicRadioBoxPaint; begin AParent.PropInt[ RADIO_LAST ] := Result.fMenu;
Result.PP.fControlClick := @ ClickGraphRadio; if AParent.PropInt[ RADIO_1ST ] = 0 then
if AParent <> nil then begin AParent.PropInt[ RADIO_1ST ] := Result.fMenu;
begin Result.SetRadioChecked;
//AParent.fRadioLast := Result.fMenu; end;
AParent.PropInt[ RADIO_LAST ] := Result.fMenu; end;
//if AParent.fRadio1st = 0 then {$ENDIF}
if AParent.PropInt[ RADIO_1ST ] = 0 then end;////////////////////////////////////////////////////////////////////////////
begin
//AParent.fRadio1st := Result.fMenu;
AParent.PropInt[ RADIO_1ST ] := Result.fMenu;
Result.SetRadioChecked;
end;
end;
{$ENDIF}
end;
procedure GraphButtonSetFocus(Ctl: PControl); procedure GraphButtonSetFocus(Ctl: PControl);
var PF, CC: PControl; var PF, CC: PControl;
W: HWnd; W: HWnd;
begin begin if {$IFDEF USE_FLAGS} not(F2_Tabstop in Ctl.fStyle.f2_Style)
if {$IFDEF USE_FLAGS} not(F2_Tabstop in Ctl.fStyle.f2_Style)
{$ELSE} not Ctl.fTabStop {$ENDIF} then Exit; {$ELSE} not Ctl.fTabStop {$ENDIF} then Exit;
PF := Ctl.ParentForm; PF := Ctl.ParentForm;
if (PF.DF.fCurrentControl <> nil) and (PF.DF.fCurrentControl <> Ctl) and if (PF.DF.fCurrentControl <> nil) and (PF.DF.fCurrentControl <> Ctl) and
(PF.DF.fCurrentControl <> Ctl.fParent) then (PF.DF.fCurrentControl <> Ctl.fParent) then
begin begin CC := PF.DF.fCurrentControl;
CC := PF.DF.fCurrentControl; CC.RefInc;
CC.RefInc;
Ctl.fParent.Focused := TRUE;
if Assigned( CC.EV.fLeave ) then
CC.EV.fLeave( PF.DF.fCurrentControl )
else
Windows.SetFocus( 0 );
CC.RefDec;
end else
begin
W := GetFocus;
if (W <> Ctl.Parent.fHandle) and (W <> 0) then
begin
Windows.SetFocus( 0 );
Ctl.fParent.Focused := TRUE; Ctl.fParent.Focused := TRUE;
if Assigned( CC.EV.fLeave ) then
CC.EV.fLeave( PF.DF.fCurrentControl )
else
Windows.SetFocus( 0 );
CC.RefDec;
end else
begin W := GetFocus;
if (W <> Ctl.Parent.fHandle) and (W <> 0) then
begin Windows.SetFocus( 0 );
Ctl.fParent.Focused := TRUE;
end;
end; end;
end; if Ctl.fParent.fHandle <> 0 then
if Ctl.fParent.fHandle <> 0 then begin {$IFDEF USE_FLAGS} include( Ctl.fFlagsG6, G6_Focused );
begin {$ELSE} Ctl.fFocused := TRUE; {$ENDIF}
{$IFDEF USE_FLAGS} include( Ctl.fFlagsG6, G6_Focused ); Ctl.fParent.Postmsg( CM_FOCUSGRAPHCTL, Integer( Ctl ), 0 );
{$ELSE} Ctl.fFocused := TRUE; {$ENDIF} Ctl.RefInc;
Ctl.fParent.Postmsg( CM_FOCUSGRAPHCTL, Integer( Ctl ), 0 ); end;
Ctl.RefInc; if Assigned( Ctl.EV.fOnEnter ) then
end; Ctl.EV.fOnEnter( Ctl );
if Assigned( Ctl.EV.fOnEnter ) then end;////////////////////////////////////////////////////////////////////////////
Ctl.EV.fOnEnter( Ctl );
end;
function NewGraphButton( AParent: PControl; const ACaption: KOLString ): PControl; function NewGraphButton( AParent: PControl; const ACaption: KOLString ): PControl;
begin begin {$IFDEF INPACKAGE}
{$IFDEF INPACKAGE} Result := NewButton( AParent, ACaption );
Result := NewButton( AParent, ACaption ); {$ELSE}
{$ELSE} Result := _NewGraphCtl( AParent, TRUE,
Result := _NewGraphCtl( AParent, TRUE, {$IFDEF PACK_COMMANDACTIONS} ButtonActions_Packed
{$IFDEF PACK_COMMANDACTIONS} ButtonActions_Packed {$ELSE} @ButtonActions {$ENDIF} );
{$ELSE} @ButtonActions {$ENDIF} ); Result.EV.fPaintProc := Result.GraphicButtonPaint;
Result.EV.fPaintProc := Result.GraphicButtonPaint; Result.Caption := ACaption;
Result.Caption := ACaption; Result.TextAlign := taCenter;
Result.TextAlign := taCenter; Result.VerticalAlign := vaCenter;
Result.VerticalAlign := vaCenter; Result.EV.fGraphCtlMouseEvent := Result.GraphicButtonMouse;
Result.EV.fGraphCtlMouseEvent := Result.GraphicButtonMouse; Result.fSetFocus := @GraphButtonSetFocus;
Result.fSetFocus := @GraphButtonSetFocus; Result.fKeyboardProcess := Result.GraphButtonKeyboardProcess;
Result.fKeyboardProcess := Result.GraphButtonKeyboardProcess; {$ENDIF}
{$ENDIF} end;////////////////////////////////////////////////////////////////////////////
end;
function EditGraphEdit(Ctl: PControl): PControl; function EditGraphEdit(Ctl: PControl): PControl;
var E: PControl; var E: PControl;
begin begin E := NewEditBox( Ctl.fParent, Ctl.DF.fEditOptions );
E := NewEditBox( Ctl.fParent, Ctl.DF.fEditOptions ); E.SetBoundsRect( Ctl.BoundsRect );
E.SetBoundsRect( Ctl.BoundsRect ); E.SetAlign( Ctl.Align );
E.SetAlign( Ctl.Align ); E.fTabOrder := Ctl.fTabOrder;
E.fTabOrder := Ctl.fTabOrder; E.Text := Ctl.Text;
E.Text := Ctl.Text; E.OnChange := Ctl.ChangeGraphEdit;
E.OnChange := Ctl.ChangeGraphEdit; E.Color := Ctl.Color;
E.Color := Ctl.Color; E.fCursor := Ctl.fCursor;
E.fCursor := Ctl.fCursor; E.CreateWindow;
E.CreateWindow; E.OnLeave := Ctl.LeaveGraphEdit;
E.OnLeave := Ctl.LeaveGraphEdit; E.EV.fLeave := Ctl.LeaveGraphEdit;
E.EV.fLeave := Ctl.LeaveGraphEdit; E.Focused := TRUE;
E.Focused := TRUE; E.OnChar := Ctl.OnChar;
E.OnChar := Ctl.OnChar; E.OnKeyDown := Ctl.OnKeyDown;
E.OnKeyDown := Ctl.OnKeyDown; E.OnKeyUp := Ctl.OnKeyUp;
E.OnKeyUp := Ctl.OnKeyUp; E.OnDestroy := Ctl.DestroyGraphEdit;
E.OnDestroy := Ctl.DestroyGraphEdit; //E.Font.Assign( Font );
//E.Font.Assign( Font ); Result := E;
Result := E; Ctl.Visible := FALSE;
Ctl.Visible := FALSE; Ctl.DF.fEditCtl := E;
Ctl.DF.fEditCtl := E; {$IFDEF NIL_EVENTS}
{$IFDEF NIL_EVENTS} if Assigned( Ctl.EV.fOnEnter ) then
if Assigned( Ctl.EV.fOnEnter ) then {$ENDIF}
{$ENDIF} Ctl.EV.fOnEnter( Ctl );
Ctl.EV.fOnEnter( Ctl );
end;//////////////////////////////////////////////////////////////////////////// end;////////////////////////////////////////////////////////////////////////////
function NewGraphEditbox( AParent: PControl; Options: TEditOptions ): PControl; function NewGraphEditbox( AParent: PControl; Options: TEditOptions ): PControl;
begin {$IFDEF INPACKAGE} begin {$IFDEF INPACKAGE}

112
KOL_ASM.inc
View File

@ -7482,33 +7482,33 @@ asm //cmd //opd
{$ENDIF} {$ENDIF}
{$IFDEF KEY_PREVIEW} {$IFDEF KEY_PREVIEW}
MOV EAX, EBX MOV EAX, EBX
CALL TControl.ParentForm CALL TControl.ParentForm
CMP EAX, EBX CMP EAX, EBX
JE @@kp_end JE @@kp_end
{$IFDEF USE_FLAGS} {$IFDEF USE_FLAGS}
TEST [EAX].TControl.fFlagsG6, 1 shl G6_KeyPreview TEST [EAX].TControl.fFlagsG6, 1 shl G6_KeyPreview
{$ELSE} {$ELSE}
CMP [EAX].TControl.fKeyPreview, 0 CMP [EAX].TControl.fKeyPreview, 0
{$ENDIF} {$ENDIF}
JZ @@kp_end JZ @@kp_end
{$IFDEF USE_FLAGS} {$IFDEF USE_FLAGS}
OR [EAX].TControl.fFlagsG4, 1 shl G4_Pushed OR [EAX].TControl.fFlagsG4, 1 shl G4_Pushed
{$ELSE} {$ELSE}
MOV [EAX].TControl.fKeyPreviewing, 1 MOV [EAX].TControl.fKeyPreviewing, 1
{$ENDIF} {$ENDIF}
INC [EAX].TControl.DF.fKeyPreviewCount INC [EAX].TControl.DF.fKeyPreviewCount
PUSH EAX PUSH EAX
PUSH [EDI].TMsg.lParam PUSH [EDI].TMsg.lParam
PUSH [EDI].TMsg.wParam PUSH [EDI].TMsg.wParam
PUSH WM_KEYDOWN PUSH WM_KEYDOWN
PUSH EAX PUSH EAX
CALL TControl.Perform CALL TControl.Perform
POP EAX POP EAX
DEC [EAX].TControl.DF.fKeyPreviewCount DEC [EAX].TControl.DF.fKeyPreviewCount
@@kp_end: @@kp_end:
{$ENDIF} {$ENDIF}
@ -7530,34 +7530,42 @@ asm //cmd //opd
@@ret0: @@ret0:
XOR EAX, EAX XOR EAX, EAX
{$IFDEF KEY_PREVIEW} {$IFDEF KEY_PREVIEW}
JMP @@ret_EAX JMP @@ret_EAX
@@chk_other_KEYMSGS: @@chk_other_KEYMSGS:
MOVZX EAX, word ptr [EDI].TMsg.message MOVZX EAX, word ptr [EDI].TMsg.message
SUB AX, WM_KEYDOWN SUB AX, WM_KEYDOWN
JB @@ret0 JB @@ret0
CMP AX, 6 CMP AX, 6
JA @@ret0 JA @@ret0
// all WM_KEYUP=$101, WM_CHAR=$102, WM_DEADCHAR=$103, WM_SYSKEYDOWN=$104, // all WM_KEYUP=$101, WM_CHAR=$102, WM_DEADCHAR=$103, WM_SYSKEYDOWN=$104,
// WM_SYSKEYUP=$105, WM_SYSCHAR=$106, WM_SYSDEADCHAR=$107 // WM_SYSKEYUP=$105, WM_SYSCHAR=$106, WM_SYSDEADCHAR=$107
MOV EAX, EBX MOV EAX, EBX
CALL TControl.ParentForm CALL TControl.ParentForm
CMP EAX, EBX CMP EAX, EBX
JE @@ret0 JE @@ret0
{$IFDEF USE_FLAGS}
OR [EAX].TControl.fFlagsG4, 1 shl G4_Pushed {$IFDEF USE_FLAGS}
{$ELSE} TEST [EAX].fFlagsG6, 1 shl G6_KeyPreview
MOV [EAX].TControl.fKeyPreviewing, 1 {$ELSE}
{$ENDIF} CMP [EAX].fKeyPreview, 0
INC [EAX].TControl.DF.fKeyPreviewCount {$ENDIF}
PUSH EAX JZ @@ret0
PUSH [EDI].TMsg.lParam
PUSH [EDI].TMsg.wParam {$IFDEF USE_FLAGS}
PUSH [EDI].TMsg.message OR [EAX].TControl.fFlagsG4, 1 shl G4_Pushed
PUSH EAX {$ELSE}
CALL TControl.Perform MOV [EAX].TControl.fKeyPreviewing, 1
POP EAX {$ENDIF}
DEC [EAX].TControl.DF.fKeyPreviewCount INC [EAX].TControl.DF.fKeyPreviewCount
XOR EAX, EAX PUSH EAX
PUSH [EDI].TMsg.lParam
PUSH [EDI].TMsg.wParam
PUSH [EDI].TMsg.message
PUSH EAX
CALL TControl.Perform
POP EAX
DEC [EAX].TControl.DF.fKeyPreviewCount
XOR EAX, EAX
{$ENDIF KEY_PREVIEW} {$ENDIF KEY_PREVIEW}
{$ENDIF KEY_PREVIEW_OR_ESC_CLOSE_DIALOGS} {$ENDIF KEY_PREVIEW_OR_ESC_CLOSE_DIALOGS}
@ -14821,6 +14829,6 @@ asm
POP EDI POP EDI
end; end;
//{$ENDIF} {$ENDIF}
//======================================== THE END OF FILE KOL_ASM.inc //======================================== THE END OF FILE KOL_ASM.inc