paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-11-20 16:59:28 +01:00
Code Issues Packages Projects Releases Wiki Activity

(Qt): Implemented GetCaretRespondToFocus(), SetCaretRespondToFocus(). Improved qtCaret response.

Browse Source 
git-svn-id: trunk@12050 -
This commit is contained in:
zeljko 2007-09-17 07:36:44 +00:00
parent 98dc3ac6bd
commit c3bcc5db17
2 changed files with 41 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
lcl/interfaces/qt/qtcaret.pas
View File

@ -56,6 +56,7 @@ type
FPos: TQtPoint;
FVisible: Boolean;
FVisibleState: Boolean;
FRespondToFocus: Boolean;
FCritSect: TCriticalSection;
procedure SetPos(const Value: TQtPoint);
protected
@ -81,6 +82,7 @@ type
property Timer: TTimer read FTimer;
property Pos: TQtPoint read FPos write SetPos;
property RespondToFocus: Boolean read FRespondToFocus write FRespondToFocus;
end;
function CreateCaret(Widget: TQtWidget; Pixmap: QPixmapH; Width, Height: Integer): Boolean; overload;
@ -89,6 +91,8 @@ function HideCaret(Widget: TQtWidget): Boolean;
function ShowCaret(Widget: TQtWidget): Boolean;
function SetCaretPos(X, Y: Integer): Boolean;
function GetCaretPos(var Pt: TPoint): Boolean;
function GetQtCaretRespondToFocus: Boolean;
procedure SetQtCaretRespondToFocus(Value: Boolean);
function DestroyCaret: Boolean;
procedure DrawCaret;
procedure DestroyGlobalCaret;
@ -224,6 +228,16 @@ begin
end;
end;
function GetQtCaretRespondToFocus: Boolean;
begin
Result := GlobalCaret.RespondToFocus;
end;
procedure SetQtCaretRespondToFocus(Value: Boolean);
begin
GlobalCaret.RespondToFocus := Value;
end;
function DestroyCaret: Boolean;
begin
if Assigned(GlobalCaret) then
@ -250,6 +264,8 @@ begin
FTimer.Enabled := False;
FTimer.Interval := GetCaretBlinkTime;
FTimer.OnTimer := @DoTimer;
FRespondToFocus := False;
end;
destructor TEmulatedCaret.Destroy;
@ -328,17 +344,33 @@ end;
procedure TEmulatedCaret.SetPos(const Value: TQtPoint);
begin
if FVisible and ((FPos.x <> Value.x) or (FPos.y <> Value.y)) then
if RespondToFocus and
((FPos.x <> Value.x) or (FPos.y <> Value.y)) then
begin
Timer.Enabled := False;
Hide;
try
FPos := Value;
FVisible := True;
FVisibleState := False;
DoTimer(Timer);
finally
Show(FWidget);
Timer.Enabled := True;
end;
end
else
FPos := Value;
end else
begin
if FVisible and ((FPos.x <> Value.x) or (FPos.y <> Value.y)) then
begin
Hide;
try
FPos := Value;
finally
Show(FWidget);
end;
end
else
FPos := Value;
end;
end;
procedure TEmulatedCaret.DoTimer(Sender: TObject);

14
lcl/interfaces/qt/qtwinapi.inc
View File

@ -1688,11 +1688,8 @@ end;
function TQtWidgetSet.GetCaretRespondToFocus(handle: HWND; var ShowHideOnFocus: boolean): Boolean;
begin
{$note implement}
{$ifdef VerboseQtWinAPI_MISSING_IMPLEMENTATION}
WriteLn('***** [WinAPI TQtWidgetSet.GetCaretRespondToFocus] missing implementation ');
{$endif}
Result := False;
ShowHideOnFocus := QtCaret.GetQtCaretRespondToFocus;
Result := True;
end;
{------------------------------------------------------------------------------
@ -3764,11 +3761,8 @@ end;
function TQtWidgetSet.SetCaretRespondToFocus(handle: HWND;
ShowHideOnFocus: boolean): Boolean;
begin
{$note implement}
Result := False;
{$ifdef VerboseQtWinAPI_MISSING_IMPLEMENTATION}
WriteLn('***** [WinAPI TQtWidgetSet.SetCaretRespondToFocus] missing implementation ');
{$endif}
Result := True;
QtCaret.SetQtCaretRespondToFocus(ShowHideOnFocus);
end;
{------------------------------------------------------------------------------