mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-26 12:03:51 +02:00
made key handling more flexible
git-svn-id: trunk@5628 -
This commit is contained in:
mattias
parent
5ed811d1ac
commit
d1af34e444
@ -41,7 +41,6 @@ Known Issues:
|
||||
-DoubleBuffered
|
||||
-Font.CharSet
|
||||
-DropFiles
|
||||
-WMGetDlgCode
|
||||
-THintWindow
|
||||
-DragAcceptFiles
|
||||
-Font DBCS / MBCS double, multi byte character set
|
||||
@ -4280,10 +4279,7 @@ end;
|
||||
|
||||
procedure TCustomSynEdit.WMGetDlgCode(var Msg: TWMGetDlgCode);
|
||||
begin
|
||||
{$IFNDEF SYN_LAZARUS}
|
||||
// ToDo WMGetDlgCode
|
||||
inherited;
|
||||
{$ENDIF}
|
||||
Msg.Result := DLGC_WANTARROWS or DLGC_WANTCHARS or DLGC_WANTALLKEYS;
|
||||
if fWantTabs and (GetKeyState(VK_CONTROL) >= 0) then
|
||||
Msg.Result := Msg.Result or DLGC_WANTTAB;
|
||||
|
||||
@ -1269,14 +1269,9 @@ begin
|
||||
SourceNotebook.OnInitIdentCompletion :=@OnSrcNotebookInitIdentCompletion;
|
||||
SourceNotebook.OnJumpToHistoryPoint := @OnSrcNotebookJumpToHistoryPoint;
|
||||
SourceNotebook.OnMovingPage := @OnSrcNotebookMovingPage;
|
||||
SourceNotebook.OnNewClicked := @OnSrcNotebookFileNew;
|
||||
SourceNotebook.OnOpenClicked := @OnSrcNotebookFileOpen;
|
||||
SourceNotebook.OnOpenFileAtCursorClicked := @OnSrcNotebookFileOpenAtCursor;
|
||||
SourceNotebook.OnProcessUserCommand := @OnProcessIDECommand;
|
||||
SourceNotebook.OnReadOnlyChanged := @OnSrcNotebookReadOnlyChanged;
|
||||
SourceNotebook.OnSaveClicked := @OnSrcNotebookFileSave;
|
||||
SourceNotebook.OnSaveAsClicked := @OnSrcNotebookFileSaveAs;
|
||||
SourceNotebook.OnSaveAllClicked := @OnSrcNotebookSaveAll;
|
||||
SourceNotebook.OnShowHintForSource :=@OnSrcNotebookShowHintForSource;
|
||||
SourceNotebook.OnShowUnitInfo := @OnSrcNoteBookShowUnitInfo;
|
||||
SourceNotebook.OnToggleFormUnitClicked := @OnSrcNotebookToggleFormUnit;
|
||||
@ -10445,6 +10440,9 @@ end.
|
||||
|
||||
{ =============================================================================
|
||||
$Log$
|
||||
Revision 1.732 2004/07/01 10:08:31 mattias
|
||||
made key handling more flexible
|
||||
|
||||
Revision 1.731 2004/06/25 00:30:15 mattias
|
||||
fixed FileMask for FPCSrc scan
|
||||
|
||||
|
||||
@ -378,14 +378,9 @@ type
|
||||
FOnInitIdentCompletion: TOnInitIdentCompletion;
|
||||
FOnJumpToHistoryPoint: TOnJumpToHistoryPoint;
|
||||
FOnMovingPage: TOnMovingPage;
|
||||
FOnNewClicked: TNotifyEvent;
|
||||
FOnOpenClicked: TNotifyEvent;
|
||||
FOnOpenFileAtCursorClicked: TNotifyEvent;
|
||||
FOnProcessUserCommand: TOnProcessUserCommand;
|
||||
fOnReadOnlyChanged: TNotifyEvent;
|
||||
FOnSaveAsClicked: TNotifyEvent;
|
||||
FOnSaveAllClicked: TNotifyEvent;
|
||||
FOnSaveClicked: TNotifyEvent;
|
||||
FOnShowHintForSource: TOnShowHintForSource;
|
||||
FOnShowUnitInfo: TNotifyEvent;
|
||||
FOnToggleFormUnitClicked: TNotifyEvent;
|
||||
@ -470,7 +465,7 @@ type
|
||||
|
||||
function GetEditors(Index:integer): TSourceEditor;
|
||||
|
||||
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
|
||||
procedure KeyDownBeforeInterface(var Key: Word; Shift: TShiftState); override;
|
||||
|
||||
procedure BeginAutoFocusLock;
|
||||
procedure EndAutoFocusLock;
|
||||
@ -507,11 +502,6 @@ type
|
||||
procedure ClearErrorLines;
|
||||
procedure ClearExecutionLines;
|
||||
|
||||
Procedure NewClicked(Sender: TObject);
|
||||
procedure OpenClicked(Sender: TObject);
|
||||
procedure SaveClicked(Sender: TObject);
|
||||
procedure SaveAllClicked(Sender: TObject);
|
||||
procedure SaveAsClicked(Sender: TObject);
|
||||
procedure CloseClicked(Sender: TObject);
|
||||
procedure ToggleFormUnitClicked(Sender: TObject);
|
||||
procedure ToggleObjectInspClicked(Sender: TObject);
|
||||
@ -599,19 +589,10 @@ type
|
||||
property OnJumpToHistoryPoint: TOnJumpToHistoryPoint
|
||||
read FOnJumpToHistoryPoint write FOnJumpToHistoryPoint;
|
||||
property OnMovingPage: TOnMovingPage read FOnMovingPage write FOnMovingPage;
|
||||
property OnNewClicked: TNotifyEvent read FOnNewClicked write FOnNewClicked;
|
||||
property OnOpenClicked: TNotifyEvent
|
||||
read FOnOPenClicked write FOnOpenClicked;
|
||||
property OnOpenFileAtCursorClicked: TNotifyEvent
|
||||
read FOnOpenFileAtCursorClicked write FOnOpenFileAtCursorClicked;
|
||||
property OnReadOnlyChanged: TNotifyEvent
|
||||
read fOnReadOnlyChanged write fOnReadOnlyChanged;
|
||||
property OnSaveAsClicked: TNotifyEvent
|
||||
read FOnSaveAsClicked write FOnSaveAsClicked;
|
||||
property OnSaveAllClicked: TNotifyEvent
|
||||
read FOnSaveAllClicked write FOnSaveAllClicked;
|
||||
property OnSaveClicked: TNotifyEvent
|
||||
read FOnSaveClicked write FOnSaveClicked;
|
||||
property OnShowHintForSource: TOnShowHintForSource
|
||||
read FOnShowHintForSource write FOnShowHintForSource;
|
||||
property OnShowUnitInfo: TNotifyEvent
|
||||
@ -1894,6 +1875,7 @@ end;
|
||||
Procedure TSourceEditor.EditorKeyDown(Sender: TObject; var Key: Word; Shift :
|
||||
TShiftState);
|
||||
begin
|
||||
writeln('TSourceEditor.EditorKeyDown A ',TComponent(Sender).Name,':',ClassName,' ',Key);
|
||||
if Assigned(OnKeyDown) then
|
||||
OnKeyDown(Sender, Key, Shift);
|
||||
end;
|
||||
@ -1909,10 +1891,10 @@ begin
|
||||
TopLine := FEditor.TopLine;
|
||||
LineHeight := FEditor.LineHeight;
|
||||
if CursorPos.Y > 1 then
|
||||
LineNum := CursorPos.Y div LineHeight
|
||||
else
|
||||
LineNum := 1;
|
||||
LineNum := LineNUm + (TopLine);
|
||||
LineNum := CursorPos.Y div LineHeight
|
||||
else
|
||||
LineNum := 1;
|
||||
LineNum := LineNum + (TopLine);
|
||||
XLine := CursorPos.X div FEditor.CharWidth;
|
||||
if XLine = 0 then inc(XLine);
|
||||
|
||||
@ -3948,21 +3930,6 @@ begin
|
||||
SrcEdit.FocusEditor;
|
||||
end;
|
||||
|
||||
Procedure TSourceNotebook.NewClicked(Sender: TObject);
|
||||
Begin
|
||||
if Assigned(FOnNewClicked) then FOnNewClicked(Sender);
|
||||
End;
|
||||
|
||||
Procedure TSourceNotebook.OpenClicked(Sender: TObject);
|
||||
Begin
|
||||
if Assigned(FOnOpenClicked) then FOnOpenClicked(Sender);
|
||||
end;
|
||||
|
||||
Procedure TSourceNotebook.SaveClicked(Sender: TObject);
|
||||
Begin
|
||||
if Assigned(FOnSaveClicked) then FOnSaveClicked(Sender);
|
||||
end;
|
||||
|
||||
Function TSourceNotebook.ActiveFileName: AnsiString;
|
||||
Begin
|
||||
Result := GetActiveSE.FileName;
|
||||
@ -4025,16 +3992,6 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
Procedure TSourceNotebook.SaveAsClicked(Sender: TObject);
|
||||
Begin
|
||||
if Assigned(FOnSaveAsClicked) then FOnSaveAsClicked(Sender);
|
||||
end;
|
||||
|
||||
Procedure TSourceNotebook.SaveAllClicked(Sender: TObject);
|
||||
Begin
|
||||
if Assigned(FOnSaveAllClicked) then FOnSaveAllClicked(Sender);
|
||||
end;
|
||||
|
||||
procedure TSourceNotebook.ToggleFormUnitClicked(Sender: TObject);
|
||||
begin
|
||||
if Assigned(FOnToggleFormUnitClicked) then FOnToggleFormUnitClicked(Sender);
|
||||
@ -4302,7 +4259,8 @@ Begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TSourceNotebook.KeyDown(var Key: Word; Shift: TShiftState);
|
||||
procedure TSourceNotebook.KeyDownBeforeInterface(var Key: Word;
|
||||
Shift: TShiftState);
|
||||
var i, Command: integer;
|
||||
Begin
|
||||
inherited KeyDown(Key,Shift);
|
||||
@ -4313,13 +4271,13 @@ Begin
|
||||
|
||||
ecGotoMarker0..ecGotoMarker9:
|
||||
begin
|
||||
BookMarkGoto(Command - ecGotoMarker0);
|
||||
BookMarkGoto(Command - ecGotoMarker0);
|
||||
Key:=0;
|
||||
end;
|
||||
|
||||
ecSetMarker0..ecSetMarker9:
|
||||
begin
|
||||
BookMarkSet(Command - ecSetMarker0);
|
||||
BookMarkSet(Command - ecSetMarker0);
|
||||
Key:=0;
|
||||
end;
|
||||
|
||||
|
||||
@ -1255,7 +1255,7 @@ type
|
||||
|
||||
|
||||
{ TWinControl }
|
||||
|
||||
|
||||
TWinControlFlag = (
|
||||
wcfClientRectNeedsUpdate,
|
||||
wcfColorChanged,
|
||||
@ -1326,7 +1326,7 @@ type
|
||||
procedure SetParentCtl3D(Value : Boolean);
|
||||
procedure SetUseDockManager(const AValue: Boolean);
|
||||
procedure UpdateTabOrder(NewTabValue: TTabOrder);
|
||||
function WantsKey(CharCode: word): dword;
|
||||
function WantsKeyBeforeInterface(Key: word; Shift: TShiftState): boolean;
|
||||
protected
|
||||
procedure AssignTo(Dest: TPersistent); override;
|
||||
procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
|
||||
@ -1404,6 +1404,12 @@ type
|
||||
function DoKeyDown(var Message: TLMKey): Boolean;
|
||||
function DoKeyPress(var Message: TLMKey): Boolean;
|
||||
function DoKeyUp(var Message: TLMKey): Boolean;
|
||||
procedure ControlKeyDown(var Key: Word; Shift : TShiftState); dynamic;
|
||||
procedure KeyDown(var Key: Word; Shift: TShiftState); dynamic;
|
||||
procedure KeyDownBeforeInterface(var Key: Word; Shift: TShiftState); dynamic;
|
||||
procedure KeyDownAfterInterface(var Key: Word; Shift: TShiftState); dynamic;
|
||||
procedure KeyPress(var Key: Char); dynamic;
|
||||
procedure KeyUp(var Key: Word; Shift : TShiftState); dynamic;
|
||||
protected
|
||||
Function FindNextControl(CurrentControl: TControl; GoForward,
|
||||
CheckTabStop, CheckParent, OnlyWinControls
|
||||
@ -1419,7 +1425,6 @@ type
|
||||
function GetDeviceContext(var WindowHandle: HWnd): HDC; override;
|
||||
function IsControlMouseMsg(var TheMessage : TLMMouse): Boolean;
|
||||
function ParentHandlesAllocated: boolean; override;
|
||||
procedure ControlKeyDown(var Key: Word; Shift : TShiftState); dynamic;
|
||||
procedure CreateHandle; virtual;
|
||||
procedure CreateParams(var Params: TCreateParams); virtual;
|
||||
procedure CreateWnd; virtual; //creates the window
|
||||
@ -1429,9 +1434,6 @@ type
|
||||
procedure FixupTabList;
|
||||
procedure FontChanged(Sender: TObject); override;
|
||||
procedure InitializeWnd; virtual; //gets called after the window is created
|
||||
procedure KeyDown(var Key: Word; Shift : TShiftState); dynamic;
|
||||
procedure KeyPress(var Key: Char); dynamic;
|
||||
procedure KeyUp(var Key: Word; Shift : TShiftState); dynamic;
|
||||
procedure Loaded; override;
|
||||
procedure MainWndProc(var Message : TLMessage);
|
||||
procedure ParentFormInitializeWnd; virtual; //gets called by InitializeWnd of parent form
|
||||
@ -2324,6 +2326,9 @@ end.
|
||||
{ =============================================================================
|
||||
|
||||
$Log$
|
||||
Revision 1.218 2004/07/01 10:08:31 mattias
|
||||
made key handling more flexible
|
||||
|
||||
Revision 1.217 2004/06/30 11:07:20 micha
|
||||
implement return key clicks default button; escape key clicks cancel button
|
||||
|
||||
|
||||
@ -2051,17 +2051,36 @@ Begin
|
||||
if Assigned(FOnKeyDown) then FOnKeyDown(Self, Key, Shift);
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------}
|
||||
{ TWinControl KeyUp }
|
||||
{------------------------------------------------------------------------------}
|
||||
{------------------------------------------------------------------------------
|
||||
TWinControl KeyDownBeforeInterface
|
||||
------------------------------------------------------------------------------}
|
||||
procedure TWinControl.KeyDownBeforeInterface(var Key: Word; Shift: TShiftState
|
||||
);
|
||||
begin
|
||||
if WantsKeyBeforeInterface(Key,Shift) then
|
||||
KeyDown(Key,Shift);
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
TWinControl KeyDownAfterInterface
|
||||
------------------------------------------------------------------------------}
|
||||
procedure TWinControl.KeyDownAfterInterface(var Key: Word; Shift: TShiftState);
|
||||
begin
|
||||
if not WantsKeyBeforeInterface(Key,Shift) then
|
||||
KeyDown(Key,Shift);
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
TWinControl KeyUp
|
||||
------------------------------------------------------------------------------}
|
||||
Procedure TWinControl.KeyUp(var Key: Word; shift : TShiftState);
|
||||
begin
|
||||
if Assigned(FOnKeyUp) then FOnKeyUp(Self, Key, Shift);
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------}
|
||||
{ TWinControl ControlKeyUp }
|
||||
{------------------------------------------------------------------------------}
|
||||
{------------------------------------------------------------------------------
|
||||
TWinControl ControlKeyUp
|
||||
------------------------------------------------------------------------------}
|
||||
procedure TWinControl.ControlKeyDown(var Key: Word; Shift: TShiftState);
|
||||
var
|
||||
Form: TCustomForm;
|
||||
@ -2101,36 +2120,41 @@ end;
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TWinControl.WantsKey
|
||||
Params: CharCode - the key to inspect whether it is wanted
|
||||
Returns: 0 - if not wanted
|
||||
Returns: true if key is wanted before the interface handles it.
|
||||
|
||||
Checks if control wants the passed key to handle before the interface.
|
||||
------------------------------------------------------------------------------}
|
||||
function TWinControl.WantsKeyBeforeInterface(Key: word; Shift: TShiftState
|
||||
): boolean;
|
||||
var
|
||||
lWantKeys: dword;
|
||||
{ values for lWantKeys
|
||||
0 - if not wanted
|
||||
1 - if wanted, but is special (arrow)
|
||||
2 - if wanted, but is special (tab)
|
||||
4 - if wanted, but is special (all)
|
||||
8 - if wanted, is normal key
|
||||
|
||||
Checks if the passed key is a special key, and if so, returns non zero
|
||||
Also determines type of special key, see return values
|
||||
------------------------------------------------------------------------------}
|
||||
function TWinControl.WantsKey(CharCode: word): dword;
|
||||
var
|
||||
lWantKeys: dword;
|
||||
}
|
||||
begin
|
||||
// we don't know what keys are special, different widgetsets may have
|
||||
// different set of special keys; send message to control asking
|
||||
// if it wants to handle it, if not, set lWantKeys to zero, so that
|
||||
// KeyDown will not be called
|
||||
// For Delphi compatibility we send a LM_GETDLGCODE message to the control
|
||||
// asking if it wants to handle the key.
|
||||
// We don't define a default handler for LM_GETDLGCODE,
|
||||
// so the default return is 0.
|
||||
// Note: Contrary to Delphi/win32api, we don't know what keys are special,
|
||||
// different widgetsets may have different sets of special keys;
|
||||
lWantKeys := Perform(LM_GETDLGCODE, 0, 0);
|
||||
if (lWantKeys and DLGC_WANTALLKEYS) <> 0 then
|
||||
begin
|
||||
lWantKeys := DLGC_WANTALLKEYS;
|
||||
end else begin
|
||||
case CharCode of
|
||||
case Key of
|
||||
VK_TAB:
|
||||
lWantKeys := lWantKeys and DLGC_WANTTAB;
|
||||
VK_UP, VK_LEFT, VK_DOWN, VK_RIGHT:
|
||||
lWantKeys := lWantKeys and DLGC_WANTARROWS;
|
||||
end;
|
||||
end;
|
||||
Result := lWantKeys;
|
||||
Result := (lWantKeys<>0);
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------}
|
||||
@ -2140,8 +2164,9 @@ function TWinControl.DoKeyDown(Var Message: TLMKey): Boolean;
|
||||
var
|
||||
F: TCustomForm;
|
||||
ShiftState: TShiftState;
|
||||
lWantsKey: dword;
|
||||
begin
|
||||
//debugln('TWinControl.DoKeyDown ',Name,':',ClassName,' ');
|
||||
|
||||
Result := True;
|
||||
F := GetParentForm(Self);
|
||||
if (F <> nil)
|
||||
@ -2164,12 +2189,8 @@ begin
|
||||
// let user handle the key
|
||||
if not (csNoStdEvents in ControlStyle) then
|
||||
begin
|
||||
lWantsKey := WantsKey(CharCode);
|
||||
if (lWantsKey > 0) and (lWantsKey <= DLGC_WANTALLKEYS) then
|
||||
begin
|
||||
KeyDown(CharCode, ShiftState);
|
||||
if CharCode = VK_UNKNOWN then Exit;
|
||||
end;
|
||||
KeyDownBeforeInterface(CharCode, ShiftState);
|
||||
if CharCode = VK_UNKNOWN then Exit;
|
||||
end;
|
||||
|
||||
// let application handle the key
|
||||
@ -3110,17 +3131,18 @@ end;
|
||||
Params: Msg: The message
|
||||
Returns: nothing
|
||||
|
||||
event handler.
|
||||
Event handler for keys not handled by the interface
|
||||
------------------------------------------------------------------------------}
|
||||
Procedure TWinControl.WMKeyDown(Var Message : TLMKeyDown);
|
||||
Procedure TWinControl.WMKeyDown(Var Message: TLMKeyDown);
|
||||
var
|
||||
ShiftState: TShiftState;
|
||||
begin
|
||||
//DebugLn('TWinControl.WMKeyDown ',Name,':',ClassName);
|
||||
if WantsKey(Message.CharCode) = 8 then
|
||||
if not (csNoStdEvents in ControlStyle) then
|
||||
begin
|
||||
ShiftState := KeyDataToShiftState(Message.KeyData);
|
||||
KeyDown(Message.CharCode, ShiftState);
|
||||
KeyDownAfterInterface(Message.CharCode, ShiftState);
|
||||
// Note: Message.CharCode can now be different or even 0
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -3131,7 +3153,7 @@ end;
|
||||
|
||||
event handler.
|
||||
------------------------------------------------------------------------------}
|
||||
Procedure TWinControl.WMKeyUp(Var Message : TLMKeyUp);
|
||||
Procedure TWinControl.WMKeyUp(Var Message: TLMKeyUp);
|
||||
Begin
|
||||
Assert(False, Format('Trace:[TWinControl.WMKeyUp] %s', [ClassName]));
|
||||
if not DoKeyUp(Message) then {inherited}; // there is nothing to inherit
|
||||
@ -3725,6 +3747,9 @@ end;
|
||||
{ =============================================================================
|
||||
|
||||
$Log$
|
||||
Revision 1.246 2004/07/01 10:08:31 mattias
|
||||
made key handling more flexible
|
||||
|
||||
Revision 1.245 2004/06/30 11:07:20 micha
|
||||
implement return key clicks default button; escape key clicks cancel button
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user