Index: qtcaret.pas
===================================================================
--- qtcaret.pas	(revision 0)
+++ qtcaret.pas	(revision 0)
@@ -0,0 +1,369 @@
+unit QtCaret;
+{$mode delphi}{$H+}
+
+interface
+
+uses
+  // Bindings
+{$ifdef USE_QT_4_3}
+  qt43,
+{$else}
+  qt4,
+{$endif}
+  // Free Pascal
+  Classes, SysUtils, Types,
+  // Widgetset
+  QtObjects, QtWidgets,
+  // LCL
+  LCLType, LCLIntf, Graphics, ExtCtrls;
+
+type
+  TEmulatedCaret = class(TComponent)
+  private
+    FTimer: TTimer;
+    FWndId: Cardinal;
+    FWidget: TQtWidget;
+    FPixmap: QPixmapH;
+    FWidth, FHeight: Integer;
+    FPos: TQtPoint;
+    FVisible: Boolean;
+    FVisibleState: Boolean;
+    FCritSect: TCriticalSection;
+    procedure SetPos(const Value: TQtPoint);
+  protected
+    procedure DoTimer(Sender: TObject);
+    procedure DrawCaret; virtual;
+    function CreateColorPixmap(Color: Cardinal): QPixmapH;
+    procedure SetWidget(AWidget: TQtWidget);
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+
+    procedure Lock;
+    procedure Unlock;
+
+    function CreateCaret(AWidget: TQtWidget; Pixmap: QPixmapH; Width, Height: Integer): Boolean;
+    function DestroyCaret: Boolean;
+
+    function IsValid: Boolean;
+
+    function Show(AWidget: TQtWidget): Boolean;
+    function Hide: Boolean;
+
+    property Timer: TTimer read FTimer;
+    property Pos: TQtPoint read FPos write SetPos;
+  end;
+
+function CreateCaret(Widget: TQtWidget; Pixmap: QPixmapH; Width, Height: Integer): Boolean; overload;
+function CreateCaret(Widget: TQtWidget; ColorCaret: Cardinal; Width, Height: Integer): Boolean; overload;
+function HideCaret(Widget: TQtWidget): Boolean;
+function ShowCaret(Widget: TQtWidget): Boolean;
+function SetCaretPos(X, Y: Integer): Boolean;
+function GetCaretPos(var Pt: TPoint): Boolean;
+function DestroyCaret: Boolean;
+procedure DrawCaret;
+
+implementation
+
+var
+  GlobalCaret: TEmulatedCaret = nil;
+  
+procedure GlobalCaretNeeded;
+begin
+  if GlobalCaret = nil then
+    GlobalCaret := TEmulatedCaret.Create(nil);
+end;
+
+function QtPoint(X, Y: Integer): TQtPoint;
+begin
+  Result.X := X;
+  Result.Y := Y;
+end;
+
+procedure DrawCaret;
+begin
+  GlobalCaretNeeded;
+  if Assigned(GlobalCaret) then
+  begin
+    GlobalCaret.Lock;
+    try
+      GlobalCaret.DrawCaret;
+    finally
+      GlobalCaret.Unlock;
+    end;
+  end;
+end;
+
+function CreateCaret(Widget: TQtWidget; Pixmap: QPixmapH; Width, Height: Integer): Boolean;
+begin
+  GlobalCaretNeeded;
+  GlobalCaret.Lock;
+  try
+    Result := GlobalCaret.CreateCaret(Widget, Pixmap, Width, Height);
+  finally
+    GlobalCaret.Unlock;
+  end;
+end;
+
+function CreateCaret(Widget: TQtWidget; ColorCaret: Cardinal; Width, Height: Integer): Boolean;
+begin
+  Result := CreateCaret(Widget, QPixmapH(ColorCaret), Width, Height);
+end;
+
+function GetCaretBlinkTime: Cardinal;
+begin
+  Result := QApplication_cursorFlashTime;
+end;
+
+function SetCaretBlinkTime(uMSeconds: Cardinal): LongBool;
+begin
+  Result := True;
+  try
+    QApplication_setCursorFlashTime(uMSeconds);
+    if assigned(GlobalCaret) then
+    begin
+      GlobalCaret.Lock;
+      try
+        GlobalCaret.Timer.Interval := GetCaretBlinkTime;
+      finally
+        GlobalCaret.Unlock;
+      end;
+    end;
+  except
+    Result := False;
+  end;
+end;
+
+function HideCaret(Widget: TQtWidget): Boolean;
+begin
+  GlobalCaretNeeded;
+  if Assigned(GlobalCaret) then
+  begin
+    GlobalCaret.Lock;
+    try
+      Result := GlobalCaret.Hide;
+    finally
+      GlobalCaret.Unlock;
+    end;
+  end
+  else
+    Result := false;
+end;
+
+function ShowCaret(Widget: TQtWidget): Boolean;
+begin
+  GlobalCaretNeeded;
+  GlobalCaret.Lock;
+  try
+    Result := GlobalCaret.Show(Widget);
+  finally
+    GlobalCaret.Unlock;
+  end;
+end;
+
+function SetCaretPos(X, Y: Integer): Boolean;
+begin
+  Result := True;
+  GlobalCaretNeeded;
+  GlobalCaret.Lock;
+  try
+    GlobalCaret.Pos := QtPoint(X, Y);
+  finally
+    GlobalCaret.Unlock;
+  end;
+end;
+
+function GetCaretPos(var Pt: TPoint): Boolean;
+begin
+  Result := True;
+  GlobalCaretNeeded;
+  GlobalCaret.Lock;
+  try
+    with GlobalCaret.Pos do
+    begin
+      Pt.x := X;
+      Pt.y := Y;
+    end;
+  finally
+    GlobalCaret.Unlock;
+  end;
+end;
+
+function DestroyCaret: Boolean;
+begin
+  if Assigned(GlobalCaret) then
+  begin
+    GlobalCaret.Lock;
+    try
+      Result := GlobalCaret.DestroyCaret;
+    finally
+      GlobalCaret.Unlock;
+    end;
+  end
+  else
+    Result := False;
+end;
+
+{ TEmulatedCaret }
+
+constructor TEmulatedCaret.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  InitializeCriticalSection(FCritSect);
+
+  FTimer := TTimer.Create(self);
+  FTimer.Enabled := False;
+  FTimer.Interval := GetCaretBlinkTime;
+  FTimer.OnTimer := DoTimer;
+end;
+
+destructor TEmulatedCaret.Destroy;
+begin
+  DestroyCaret;
+  DeleteCriticalSection(FCritSect);
+  inherited Destroy;
+end;
+
+function TEmulatedCaret.CreateCaret(AWidget: TQtWidget; Pixmap: QPixmapH;
+  Width, Height: Integer): Boolean;
+begin
+  DestroyCaret;
+  SetWidget(AWidget);
+  FWidth := Width;
+  FHeight := Height;
+  if Cardinal(Pixmap) > $FFFF then
+    FPixmap := QPixmap_create(Pixmap)
+  else
+    FPixmap := CreateColorPixmap(Integer(Pixmap));
+
+  Result := IsValid;
+  FTimer.Enabled := True;
+end;
+
+function TEmulatedCaret.DestroyCaret: Boolean;
+begin
+  FTimer.Enabled := False;
+  Hide;
+  if Assigned(FPixmap) then
+    QPixmap_destroy(FPixmap);
+  FWidget := nil;
+  FPixmap := nil;
+  FWidth := 0;
+  FHeight := 0;
+  Result := not IsValid;
+end;
+
+procedure TEmulatedCaret.DrawCaret;
+var
+  DestDev: QPaintDeviceH;
+  Painter: QPainterH;
+  R: TRect;
+begin
+  if IsValid and FVisible and FVisibleState then
+  begin
+    DestDev := QWidget_to_QPaintDevice(FWidget.Widget);
+    Painter := QPainter_create(DestDev);
+    R := Rect(0, 0, QPixmap_width(FPixmap), QPixmap_height(FPixmap));
+    QPainter_drawPixmap(Painter, PQtPoint(@FPos), FPixmap, PRect(@R));
+    QPainter_destroy(Painter);
+  end;
+end;
+
+function TEmulatedCaret.Show(AWidget: TQtWidget): Boolean;
+begin
+  if FWidget <> AWidget then
+  begin
+    Hide;
+    SetWidget(AWidget);
+  end;
+  Result := IsValid;
+  if Result then
+    FVisible := True;
+end;
+
+function TEmulatedCaret.Hide: Boolean;
+begin
+  Result := IsValid;
+  if Result and FVisible then
+    FVisible := False;
+end;
+
+procedure TEmulatedCaret.SetPos(const Value: TQtPoint);
+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;
+
+procedure TEmulatedCaret.DoTimer(Sender: TObject);
+begin
+  FVisibleState := not FVisibleState;
+  if FVisible and (FWidget <> nil) and not FWidget.InPaint then
+    FWidget.Repaint;
+end;
+
+procedure TEmulatedCaret.Lock;
+begin
+  EnterCriticalSection(FCritSect);
+end;
+
+procedure TEmulatedCaret.Unlock;
+begin
+  LeaveCriticalSection(FCritSect);
+end;
+
+function TEmulatedCaret.CreateColorPixmap(Color: Cardinal): QPixmapH;
+var
+  QC: TQColor;
+begin
+  if (FWidth <= 0) or (FHeight <= 0) then
+    Result := nil
+  else
+  begin
+    case Color of
+      0: ColorRefToTQColor(clBlack, QC);
+      1: ColorRefToTQColor(clGray, QC);
+    else
+      Result := nil;
+      Exit;
+    end;
+    Result := QPixmap_create(FWidth, FHeight);
+    try
+      QPixmap_fill(Result, @QC);
+    except
+      QPixmap_destroy(Result);
+      Result := nil;
+    end;
+  end;
+end;
+
+function TEmulatedCaret.IsValid: Boolean;
+begin
+  Result := (FWidget <> nil) and (FPixmap <> nil) and
+    (QWidget_find(FWndId) <> nil);
+end;
+
+procedure TEmulatedCaret.SetWidget(AWidget: TQtWidget);
+begin
+  if FWidget <> nil then
+    FWidget.HasCaret := False;
+
+  FWidget := AWidget;
+  if FWidget <> nil then
+  begin
+    FWndId := QWidget_winId(FWidget.Widget);
+    FWidget.HasCaret := True;
+  end
+  else
+    FWndId := 0;
+end;
+
+end.

Property changes on: qtcaret.pas
___________________________________________________________________
Name: svn:mime-type
   + text/pascal
Name: svn:eol-style
   + native

Index: qtint.pp
===================================================================
--- qtint.pp	(revision 11459)
+++ qtint.pp	(working copy)
@@ -147,6 +147,7 @@
  QtWSSpin,
  QtWSStdCtrls,
 // QtWSToolwin,
+ QtCaret,
  QtThemes,
 ////////////////////////////////////////////////////
   Graphics, buttons, Menus,
Index: qtwidgets.pas
===================================================================
--- qtwidgets.pas	(revision 11459)
+++ qtwidgets.pas	(working copy)
@@ -63,6 +63,8 @@
     AVariant: QVariantH;
     Widget: QWidgetH;
     LCLObject: TWinControl;
+    HasCaret: Boolean;
+    InPaint: Boolean;
   public
     constructor Create(const AWinControl: TWinControl; const AParams: TCreateParams); virtual;
     constructor CreatePage(const AWinControl: TWinControl; const AParams: TCreateParams);
@@ -91,7 +93,8 @@
     procedure WindowTitle(Str: PWideString);
     procedure Hide;
     procedure Show;
-    function getVisible: boolean;
+    function getVisible: Boolean;
+    function hasFocus: Boolean;
     procedure setEnabled(p1: Boolean);
     procedure setVisible(visible: Boolean);
     function windowModality: QtWindowModality;
@@ -606,6 +609,9 @@
   end;
   
 implementation
+uses
+  qtCaret;
+  
 const
   AlignmentMap: array[TAlignment] of QtAlignment =
   (
@@ -649,6 +655,8 @@
 
   // Set mouse move messages policy
   QWidget_setMouseTracking(Widget, True);
+  
+  HasCaret := False;
 end;
 
 {------------------------------------------------------------------------------
@@ -968,8 +976,10 @@
 
   FillChar(Msg, SizeOf(Msg), #0);
 
-  if FocusIn then Msg.Msg := LM_SETFOCUS
-  else Msg.Msg := LM_KILLFOCUS;
+  if FocusIn then
+    Msg.Msg := LM_SETFOCUS
+  else
+    Msg.Msg := LM_KILLFOCUS;
 
   DeliverMessage(Msg);
 
@@ -1208,7 +1218,7 @@
   {$ifdef VerboseQt}
     WriteLn('TQtWidget.SlotPaint');
   {$endif}
-
+  InPaint := True;
   if (LCLObject is TWinControl) then
   begin
     FillChar(Msg, SizeOf(Msg), #0);
@@ -1230,6 +1240,8 @@
 
       try
         LCLObject.WindowProc(TLMessage(Msg));
+        if HasCaret then
+          QtCaret.DrawCaret;
       finally
         Dispose(PaintData.ClipRect);
         Fillchar(FPaintData, SizeOf(FPaintData), 0);
@@ -1238,6 +1250,7 @@
       Application.HandleException(nil);
     end;
   end;
+  InPaint := False;
 end;
 
 {------------------------------------------------------------------------------
@@ -1376,6 +1389,11 @@
   Result := QWidget_isVisible(Widget);
 end;
 
+function TQtWidget.hasFocus: Boolean;
+begin
+  Result := QWidget_hasFocus(Widget);
+end;
+
 procedure TQtWidget.setEnabled(p1: Boolean);
 begin
   QWidget_setEnabled(Widget, p1);
Index: qtwinapi.inc
===================================================================
--- qtwinapi.inc	(revision 11459)
+++ qtwinapi.inc	(working copy)
@@ -335,6 +335,12 @@
   {$endif}
 end;
 
+function TQtWidgetSet.CreateCaret(Handle: HWND; Bitmap: hBitmap; Width, Height: Integer): Boolean;
+begin
+  Result := (Handle <> 0) and
+    QtCaret.CreateCaret(TQtWidget(Handle), Bitmap, Width, Height);
+end;
+
 {------------------------------------------------------------------------------
   Function: CreateCompatibleDC
   Params:  DC - handle to memory device context
@@ -647,6 +653,11 @@
   {$endif}
 end;
 
+function TQtWidgetSet.DestroyCaret(Handle: HWND): Boolean;
+begin
+  Result := (Handle <> 0) and QtCaret.DestroyCaret;
+end;
+
 {------------------------------------------------------------------------------
   Method:  DestroyCursor
   Params:  Handle
@@ -951,6 +962,17 @@
 //  Desc^.LineEnd := rileDWordBoundary;
 end;
 
+function TQtWidgetSet.GetCaretPos(var lpPoint: TPoint): Boolean;
+begin
+  Result := QtCaret.GetCaretPos(lpPoint);
+end;
+
+function TQtWidgetSet.GetCaretRespondToFocus(handle: HWND; var ShowHideOnFocus: boolean): Boolean;
+begin
+  {$note implement}
+  Result := False;
+end;
+
 {------------------------------------------------------------------------------
   Function: GetClientBounds
   Params: handle:
@@ -2229,6 +2251,11 @@
     AdjustForBuddySize;}
 end;
 
+function TQtWidgetSet.HideCaret(hWnd: HWND): Boolean;
+begin
+  Result := (hWnd <> 0) and QtCaret.HideCaret(TQtWidget(hWnd));
+end;
+
 {------------------------------------------------------------------------------
   Procedure: InitializeCriticalSection
   Params: var CritSection: TCriticalSection
@@ -2670,6 +2697,23 @@
   result := TQtDeviceContext(DC).SetBkMode(bkMode);
 end;
 
+function TQtWidgetSet.SetCaretPos(X, Y: Integer): Boolean;
+begin
+  Result := QtCaret.SetCaretPos(X, Y);
+end;
+
+function TQtWidgetSet.SetCaretPosEx(Handle: HWnd; X, Y: Integer): Boolean;
+begin
+  Result := QtCaret.SetCaretPos(X, Y);
+end;
+
+function TQtWidgetSet.SetCaretRespondToFocus(handle: HWND;
+  ShowHideOnFocus: boolean): Boolean;
+begin
+  {$note implement}
+  Result := False;
+end;
+
 {------------------------------------------------------------------------------
   Function: SetCursor
   Params: ACursor - HCursor (QCursorH)
@@ -2759,6 +2803,11 @@
   Result := True;
 end;
 
+function TQtWidgetSet.ShowCaret(hWnd: HWND): Boolean;
+begin
+  Result := (hWnd <> 0) and (QtCaret.ShowCaret(TQtWidget(hWnd)));
+end;
+
 {------------------------------------------------------------------------------
   Method:  SetProp
   Params:  Handle -
Index: qtwinapih.inc
===================================================================
--- qtwinapih.inc	(revision 11459)
+++ qtwinapih.inc	(working copy)
@@ -34,6 +34,7 @@
 function CreateBitmap(Width, Height: Integer; Planes, BitCount: Longint; BitmapBits: Pointer): HBITMAP; override;
 function CreateBitmapFromRawImage(const RawImage: TRawImage; var Bitmap, MaskBitmap: HBitmap; AlwaysCreateMask: boolean): boolean; override;
 function CreateBrushIndirect(const LogBrush: TLogBrush): HBRUSH; override;
+function CreateCaret(Handle : HWND; Bitmap : hBitmap; Width, Height : Integer) : Boolean; override;
 function CreateCompatibleDC(DC: HDC): HDC; override;
 function CreateCursor(ACursorInfo: PIconInfo): hCursor; override;
 function CreateFontIndirect(const LogFont: TLogFont): HFONT; override;
@@ -43,6 +44,7 @@
 
 procedure DeleteCriticalSection(var CritSection: TCriticalSection); override;
 function DeleteObject(GDIObject: HGDIOBJ): Boolean; override;
+function DestroyCaret(Handle : HWND): Boolean; override;
 function DestroyCursor(Handle: hCursor): Boolean; override;
 function DrawText(DC: HDC; Str: PChar; Count: Integer; var Rect: TRect; Flags: Cardinal): Integer; override;
 
@@ -57,6 +59,8 @@
 function FrameRect(DC: HDC; const ARect: TRect; hBr: HBRUSH): Integer; override;
 
 function GetBitmapRawImageDescription(Bitmap: HBITMAP; Desc: PRawImageDescription): Boolean; override;
+function GetCaretPos(var lpPoint: TPoint): Boolean; override;
+function GetCaretRespondToFocus(handle: HWND; var ShowHideOnFocus: boolean): Boolean; override;
 function GetClientBounds(handle : HWND; var ARect : TRect) : Boolean; override;
 function GetClientRect(handle : HWND; var ARect : TRect) : Boolean; override;
 function GetClipBox(DC : hDC; lpRect : PRect) : Longint; override;
@@ -81,6 +85,8 @@
 function GetWindowRelativePosition(Handle: hwnd; var Left, Top: Integer): boolean; override;
 function GetWindowSize(Handle: hwnd; var Width, Height: Integer): boolean; override;
 
+function HideCaret(hWnd: HWND): Boolean; override;
+
 function InvalidateRect(aHandle : HWND; Rect : pRect; bErase : Boolean) : Boolean; override;
 procedure InitializeCriticalSection(var CritSection: TCriticalSection); override;
 
@@ -99,6 +105,9 @@
 function SelectObject(DC: HDC; GDIObj: HGDIOBJ): HGDIOBJ; override;
 function SetBKColor(DC: HDC; Color: TColorRef): TColorRef; override;
 function SetBkMode(DC: HDC; bkMode : Integer) : Integer; override;
+function SetCaretPos(X, Y: Integer): Boolean; override;
+function SetCaretPosEx(Handle: HWnd; X, Y: Integer): Boolean; override;
+function SetCaretRespondToFocus(handle: HWND; ShowHideOnFocus: boolean): Boolean; override;
 function SetCursor(ACursor: HCURSOR): HCURSOR; override;
 function SetCursorPos(X, Y: Integer): Boolean; override;
 function SetFocus(hWnd: HWND): HWND; override;
@@ -106,6 +115,7 @@
 function SetScrollInfo(Handle : HWND; SBStyle : Integer; ScrollInfo: TScrollInfo; bRedraw : Boolean): Integer; override;
 function SetTextColor(DC: HDC; Color: TColorRef): TColorRef; override;
 function SetWindowOrgEx(DC : HDC; NewX, NewY : Integer; OldPoint: PPoint) : Boolean; override;
+function ShowCaret(hWnd: HWND): Boolean; override;
 function ShowWindow(hWnd: HWND; nCmdShow: Integer): Boolean; override;
 function StretchBlt(DestDC: HDC; X, Y, Width, Height: Integer;
   SrcDC: HDC; XSrc, YSrc, SrcWidth, SrcHeight: Integer; ROp: Cardinal): Boolean; override;
