mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-22 05:59:28 +02:00
LCL now handles for non win32 CN_CHAR
git-svn-id: trunk@5724 -
This commit is contained in:
mattias
parent
040f964ed5
commit
6da58dc740
@ -1395,6 +1395,7 @@ type
|
||||
procedure WMSize(var Message: TLMSize); message LM_SIZE;
|
||||
procedure CNKeyDown(var Message: TLMKeyDown); message CN_KEYDOWN;
|
||||
procedure CNKeyUp(var Message: TLMKeyUp); message CN_KEYUP;
|
||||
procedure CNChar(var Message: TLMKeyUp); message CN_CHAR;
|
||||
protected
|
||||
// drag and drop
|
||||
procedure DoAddDockClient(Client: TControl; const ARect: TRect); dynamic;
|
||||
@ -2388,6 +2389,9 @@ end.
|
||||
{ =============================================================================
|
||||
|
||||
$Log$
|
||||
Revision 1.231 2004/08/03 09:01:54 mattias
|
||||
LCL now handles for non win32 CN_CHAR
|
||||
|
||||
Revision 1.230 2004/07/25 22:54:38 mattias
|
||||
fixed fpc 1.0.10 compilation
|
||||
|
||||
|
||||
@ -3052,6 +3052,21 @@ begin
|
||||
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TWinControl.CNChar
|
||||
Params: Msg: The message
|
||||
Returns: nothing
|
||||
|
||||
event handler.
|
||||
WMChar is sent by the interface befor it has handled the keypress by itself.
|
||||
------------------------------------------------------------------------------}
|
||||
procedure TWinControl.CNChar(var Message: TLMKeyUp);
|
||||
begin
|
||||
{$IFNDEF Win32}
|
||||
if not DoKeyPress(Message) then {inherited}; // there is nothing to inherit
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TWinControl.WMNofity
|
||||
Params: Msg: The message
|
||||
@ -3145,11 +3160,14 @@ end;
|
||||
Returns: nothing
|
||||
|
||||
event handler.
|
||||
WMChar is sent by the interface it has handled the keypress by itself.
|
||||
------------------------------------------------------------------------------}
|
||||
procedure TWinControl.WMChar(var Message: TLMChar);
|
||||
begin
|
||||
Assert(False, Format('Trace:[TWinControl.WMChar] %s', [ClassName]));
|
||||
{$IFDEF Win32}
|
||||
if not DoKeyPress(Message) then {inherited}; // there is nothing to inherit
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -3778,6 +3796,9 @@ end;
|
||||
{ =============================================================================
|
||||
|
||||
$Log$
|
||||
Revision 1.258 2004/08/03 09:01:54 mattias
|
||||
LCL now handles for non win32 CN_CHAR
|
||||
|
||||
Revision 1.257 2004/07/17 15:08:36 mattias
|
||||
fixed tab for TPanel and TPage
|
||||
|
||||
|
||||
@ -83,11 +83,13 @@ begin
|
||||
{$Else}
|
||||
OldString := Pointer(Event^.TheString);
|
||||
{$EndIF}
|
||||
if (OldString<>nil) then
|
||||
// MG: should we set Event^.length := 0; or is this used for mem allocation?
|
||||
if (OldString<>nil) then begin
|
||||
if (NewString<>nil) then
|
||||
OldString[0]:=NewString[0]
|
||||
else
|
||||
OldString[0]:=#0;
|
||||
end;
|
||||
end;
|
||||
|
||||
function gdk_event_get_type(Event : Pointer) : guint;
|
||||
@ -1831,7 +1833,7 @@ var
|
||||
procedure StopKeyEvent(const AnEventName: PChar);
|
||||
begin
|
||||
{$IFDEF VerboseKeyboard}
|
||||
DebugLn('StopKeyEvent AnEventName="',AnEventName,'"');
|
||||
DebugLn('StopKeyEvent AnEventName="',AnEventName,'" BeforeEvent=',dbgs(BeforeEvent));
|
||||
{$ENDIF}
|
||||
if not EventStopped
|
||||
then begin
|
||||
@ -1843,9 +1845,8 @@ var
|
||||
{MWE:.$IfNDef Win32}
|
||||
if EventString <> nil
|
||||
then begin
|
||||
EventString^ := #0;
|
||||
// MG: should we set Event^.length := 0; or is this used for mem allocation?
|
||||
gdk_event_key_set_string(Event,EventString);
|
||||
gdk_event_key_set_string(Event,#0);
|
||||
Event^.length:=0;
|
||||
end;
|
||||
{MWE:.$EndIf}
|
||||
|
||||
@ -1886,7 +1887,6 @@ var
|
||||
CommonKeyData: Integer;
|
||||
Flags: Integer;
|
||||
SysKey: Boolean;
|
||||
//TopLevel: PGtkWidget;
|
||||
FocusedWidget: PGtkWidget;
|
||||
LCLObject: TObject;
|
||||
FocusedWinControl: TWinControl;
|
||||
@ -2042,7 +2042,7 @@ begin
|
||||
if BeforeEvent then begin
|
||||
if SysKey
|
||||
then Msg.msg := CN_SYSCHAR
|
||||
else Msg.msg := CN_CHAR;
|
||||
else Msg.msg := CN_CHAR
|
||||
end else begin
|
||||
if SysKey
|
||||
then Msg.msg := LM_SYSCHAR
|
||||
@ -7102,6 +7102,9 @@ end;
|
||||
{ =============================================================================
|
||||
|
||||
$Log$
|
||||
Revision 1.290 2004/08/03 09:01:54 mattias
|
||||
LCL now handles for non win32 CN_CHAR
|
||||
|
||||
Revision 1.289 2004/07/30 14:26:11 mazen
|
||||
* move HandleGtkKeyUpDown to gtkProc.inc make it visible to gtk2
|
||||
this allow saving a call in a hevely called callback
|
||||
|
||||
106
lcl/maskedit.pp
106
lcl/maskedit.pp
@ -61,14 +61,15 @@ type
|
||||
|
||||
TMbcsByteType = (mbSingleByte, mbLeadByte, mbTrailByte);
|
||||
|
||||
|
||||
{ TCustomMaskEdit }
|
||||
|
||||
TMaskCharType = (mcNone, mcLiteral, mcIntlLiteral, mcDirective, mcMask,
|
||||
mcMaskOpt, mcFieldSeparator, mcField);
|
||||
TMaskDirectives = set of (mdReverseDir, mdUpperCase, mdLowerCase,
|
||||
mdLiteralChar);
|
||||
TMaskedState = set of (msMasked, msReEnter, msDBSetText);
|
||||
|
||||
{ TCustomMaskEdit }
|
||||
|
||||
TCustomMaskEdit = class(TCustomEdit)
|
||||
private
|
||||
FEditMask: string;
|
||||
@ -104,11 +105,6 @@ type
|
||||
procedure CursorInc(CursorPos: Integer; Incr: Integer);
|
||||
procedure CursorDec(CursorPos: Integer);
|
||||
procedure ArrowKeys(CharCode: Word; Shift: TShiftState);
|
||||
procedure WMLButtonDown(var Message: TLMLButtonDown); message LM_LBUTTONDOWN;
|
||||
procedure WMLButtonUp(var Message: TLMLButtonUp); message LM_LBUTTONUP;
|
||||
procedure WMSetFocus(var Message: TLMSetFocus); message LM_SETFOCUS;
|
||||
procedure CMEnter(var Message: TLMEnter); message LM_ENTER;
|
||||
procedure CMExit(var Message: TLMExit); message LM_EXIT;
|
||||
procedure CMTextChanged(var Message: TLMessage); message CM_TEXTCHANGED;
|
||||
protected
|
||||
procedure ReformatText(const NewMask: string);
|
||||
@ -117,6 +113,10 @@ type
|
||||
procedure KeyUp(var Key: Word; Shift: TShiftState); override;
|
||||
procedure KeyPress(var Key: Char); override;
|
||||
function EditCanModify: Boolean; virtual;
|
||||
procedure MouseDown(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override;
|
||||
procedure MouseUp(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override;
|
||||
procedure DoEnter; override;
|
||||
procedure DoExit; override;
|
||||
procedure Reset; virtual;
|
||||
function GetFirstEditChar: Integer;
|
||||
function GetLastEditChar: Integer;
|
||||
@ -138,6 +138,7 @@ type
|
||||
property Text: string read GetMaskText write SetMaskText;
|
||||
end;
|
||||
|
||||
|
||||
{ TMaskEdit }
|
||||
|
||||
TMaskEdit = class(TCustomMaskEdit)
|
||||
@ -631,31 +632,6 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCustomMaskEdit.WMLButtonDown(var Message: TLMLButtonDown);
|
||||
begin
|
||||
inherited;
|
||||
FBtnDownX := Message.XPos;
|
||||
end;
|
||||
|
||||
procedure TCustomMaskEdit.WMLButtonUp(var Message: TLMLButtonUp);
|
||||
begin
|
||||
inherited;
|
||||
if (IsMasked) then
|
||||
begin
|
||||
FCaretPos := SelStart;
|
||||
if (SelLength < 1) and (Message.XPos > FBtnDownX) then
|
||||
FCaretPos := SelStart;
|
||||
CheckCursor;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCustomMaskEdit.WMSetFocus(var Message: TLMSetFocus);
|
||||
begin
|
||||
inherited;
|
||||
if (IsMasked) then
|
||||
CheckCursor;
|
||||
end;
|
||||
|
||||
procedure TCustomMaskEdit.SetEditText(const Value: string);
|
||||
begin
|
||||
if GetEditText <> Value then begin
|
||||
@ -814,6 +790,50 @@ begin
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
procedure TCustomMaskEdit.MouseDown(Button: TMouseButton; Shift: TShiftState;
|
||||
X, Y: Integer);
|
||||
begin
|
||||
inherited MouseDown(Button, Shift, X, Y);
|
||||
if (Button=mbLeft) then
|
||||
FBtnDownX := X;
|
||||
end;
|
||||
|
||||
procedure TCustomMaskEdit.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
|
||||
Y: Integer);
|
||||
begin
|
||||
inherited MouseUp(Button, Shift, X, Y);
|
||||
if IsMasked and (Button=mbLeft) then begin
|
||||
FCaretPos := SelStart;
|
||||
if (SelLength < 1) and (X > FBtnDownX) then
|
||||
FCaretPos := SelStart;
|
||||
CheckCursor;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCustomMaskEdit.DoEnter;
|
||||
begin
|
||||
inherited DoEnter;
|
||||
if IsMasked and not (csDesigning in ComponentState) then
|
||||
begin
|
||||
if not (msReEnter in FMaskState) then
|
||||
begin
|
||||
FOldValue := EditText;
|
||||
end;
|
||||
Exclude(FMaskState, msReEnter);
|
||||
CheckCursor;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCustomMaskEdit.DoExit;
|
||||
begin
|
||||
inherited DoExit;
|
||||
if IsMasked and not (csDesigning in ComponentState) then
|
||||
begin
|
||||
ValidateEdit;
|
||||
CheckCursor;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCustomMaskEdit.Reset;
|
||||
begin
|
||||
if Modified then
|
||||
@ -1059,19 +1079,6 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCustomMaskEdit.CMEnter(var Message: TLMEnter);
|
||||
begin
|
||||
if IsMasked and not (csDesigning in ComponentState) then
|
||||
begin
|
||||
if not (msReEnter in FMaskState) then
|
||||
begin
|
||||
FOldValue := EditText;
|
||||
end;
|
||||
Exclude(FMaskState, msReEnter);
|
||||
CheckCursor;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCustomMaskEdit.CMTextChanged(var Message: TLMessage);
|
||||
var
|
||||
Temp: Integer;
|
||||
@ -1087,15 +1094,6 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
procedure TCustomMaskEdit.CMExit(var Message: TLMExit);
|
||||
begin
|
||||
if IsMasked and not (csDesigning in ComponentState) then
|
||||
begin
|
||||
ValidateEdit;
|
||||
CheckCursor;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCustomMaskEdit.ValidateEdit;
|
||||
var
|
||||
Str: string;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user