lazarus/lcl/interfaces/qt5/qtprivate.pp

{
 *****************************************************************************
 *                              QtPrivate.pp                                 *
 *                              --------------                               *
 *                                                                           *
 *                                                                           *
 *****************************************************************************

 *****************************************************************************
  This file is part of the Lazarus Component Library (LCL)

  See the file COPYING.modifiedLGPL.txt, included in this distribution,
  for details about the license.
 *****************************************************************************
}
unit qtprivate;

{$mode objfpc}{$H+}

interface

{$I qtdefines.inc}

uses
  // Bindings
  qt5,
  // Free Pascal
  Classes, SysUtils,
  // LCL
  Forms, Controls, LCLType, LazUTF8, ExtCtrls, StdCtrls,
  //Widgetset
  QtWidgets, qtproc;

type

  { TQtComboStrings }

  TQtComboStrings = class(TStringList)
  private
    FSorted: Boolean;
    FWinControl: TWinControl;
    FOwner: TQtComboBox;
    FChanging: boolean;
    procedure SetSorted(AValue: Boolean);
  protected
    procedure Put(Index: Integer; const S: string); override;
    procedure InsertItem(Index: Integer; const S: string; O: TObject); override;
  public
    constructor Create(AWinControl: TWinControl; AOwner: TQtComboBox);
    destructor Destroy; override;
    function Add(const S: String): Integer; override;
    procedure Assign(Source: TPersistent); override;
    procedure Clear; override;
    procedure Delete(Index: Integer); override;
    function Find(const S: String; out Index: Integer): Boolean;
    function IndexOf(const S: String): Integer; override;
    procedure Insert(Index: Integer; const S: String); override;
    procedure Sort; override;
    procedure Exchange(AIndex1, AIndex2: Integer); override;
  public
    property Owner: TQtComboBox read FOwner;
    property Sorted: Boolean read FSorted write SetSorted;
  end;


  { TQtListStrings }

  TQtListStrings = class(TStringList)
  private
    FWinControl: TWinControl;
    FOwner: TQtListWidget;
  protected
    procedure Put(Index: Integer; const S: string); override;
    procedure InsertItem(Index: Integer; const S: string; O: TObject); override;
  public
    constructor Create(AWinControl: TWinControl; AOwner: TQtListWidget);
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    procedure Clear; override;
    procedure Delete(Index: Integer); override;
    procedure Move(CurIndex, NewIndex: Integer); override;
    procedure Sort; override;
    procedure Exchange(AIndex1, AIndex2: Integer); override;
  public
    property Owner: TQtListWidget read FOwner;
  end;

  { TQtMemoStrings }

  TQtMemoStrings = class(TStrings)
  private
    FUpdating: boolean;
    FTextChanged: Boolean; // Inform TQtMemoStrings about change in TextChange event
    FStringList: TStringList; // Holds the lines to show
    FHasTrailingLineBreak: Boolean; // Indicates whether lines have trailing line break
    FOwner: TWinControl;      // Lazarus Control Owning MemoStrings
    procedure InternalUpdate;
    procedure ExternalUpdate(var AStr: WideString;
      AClear, ABlockSignals: Boolean);
    function GetInternalText: string;
    procedure SetInternalText(const Value: string);
  protected
    function GetTextStr: string; override;
    function GetCount: integer; override;
    function Get(Index : Integer) : string; override;
    procedure Put(Index: Integer; const S: string); override;
    procedure SetTextStr(const Value: string); override;
    procedure SetUpdateState(Updating: Boolean); override;
  public
    constructor Create(TheOwner: TWinControl);
    destructor Destroy; override;
    function InUpdate: boolean;
    procedure Assign(Source : TPersistent); override;
    procedure Clear; override;
    procedure Delete(Index : integer); override;
    procedure Insert(Index : integer; const S: string); override;
    procedure LoadFromFile(const FileName: string); override;
    procedure SaveToFile(const FileName: string); override;
  public
    property Owner: TWinControl read FOwner;
    property TextChanged: Boolean read FTextChanged write FTextChanged;
  end;

implementation

{ TQtMemoStrings }

{------------------------------------------------------------------------------
  Private Method: TQtMemoStrings.InternalUpdate
  Params:  None
  Returns: Nothing

  Updates internal StringList from Qt Widget
 ------------------------------------------------------------------------------}
procedure TQtMemoStrings.InternalUpdate;
var
  W: WideString;
  TextEdit: TQtTextEdit;
begin
  W := '';
  if FOwner.HandleAllocated then
  begin
    TextEdit := TQtTextEdit(FOwner.Handle);
    W := TextEdit.getText;
  end;
  if W <> '' then
    SetInternalText(UTF16ToUTF8(W))
  else
    SetInternalText('');
  FTextChanged := False;
end;

{------------------------------------------------------------------------------
  Private Method: TQtMemoStrings.ExternalUpdate
  Params:  AStr: Text for Qt Widget; Clear: if we must clear first
           ABlockSignals: block SignalTextChanged() so it does not send an
           message to LCL.
  Returns: Nothing

  Updates Qt Widget from text - If DelphiOnChange, generates OnChange Event
 ------------------------------------------------------------------------------}
procedure TQtMemoStrings.ExternalUpdate(var AStr: WideString;
  AClear, ABlockSignals: Boolean);
var
  W: WideString;
  TextEdit: TQtTextEdit;
begin
  if not FOwner.HandleAllocated then
    exit;
  {$ifdef VerboseQtMemoStrings}
  writeln('TQtMemoStrings.ExternalUpdate');
  {$endif}
  TextEdit := TQtTextEdit(FOwner.Handle);
  if ABlockSignals then
    TextEdit.BeginUpdate;
  W := AStr;
  if AClear then
  begin
    // never trigger changed signal when clearing text here.
    // we must clear text since QTextEdit can contain html text.
    TextEdit.BeginUpdate;
    TextEdit.ClearText;
    TextEdit.EndUpdate;
    TextEdit.setText(W);
  end else
    TextEdit.Append(W);

  if TextEdit.getAlignment <> AlignmentMap[TCustomMemo(FOwner).Alignment] then
    TextEdit.setAlignment(AlignmentMap[TCustomMemo(FOwner).Alignment]);
  if ABlockSignals then
    TextEdit.EndUpdate;
end;

function TQtMemoStrings.GetInternalText: string;
var
  TextLen: Integer;
begin
  Result := FStringList.Text;

  // Since TStringList.Text automatically adds line break to the last line,
  // we should remove it if original text does not contain it
  if not FHasTrailingLineBreak then
  begin
    TextLen := Length(Result);
    if (TextLen > 0) and (Result[TextLen] = #10) then
      Dec(TextLen);
    if (TextLen > 0) and (Result[TextLen] = #13) then
      Dec(TextLen);
    SetLength(Result, TextLen);
  end;
end;

procedure TQtMemoStrings.SetInternalText(const Value: string);
var
  TextLen: Integer;
begin
  TextLen := Length(Value);
  FHasTrailingLineBreak := (TextLen > 0) and (Value[TextLen] in [#13, #10]);
  FStringList.Text := Value;
end;

{------------------------------------------------------------------------------
  Method: TQtMemoStrings.GetTextStr
  Params:  None
  Returns: a string

  Return the whole StringList content as a single string
 ------------------------------------------------------------------------------}
function TQtMemoStrings.GetTextStr: string;
begin
  {$ifdef VerboseQtMemoStrings}
  WriteLn('TQtMemoStrings.GetTextStr');
  {$endif}
  if FTextChanged and not InUpdate then InternalUpdate;
  Result := GetInternalText;
end;

{------------------------------------------------------------------------------
  Method: TQtMemoStrings.GetCount
  Params:  None
  Returns: an integer

  Return the current number of strings
 ------------------------------------------------------------------------------}
function TQtMemoStrings.GetCount: integer;
begin
  {$ifdef VerboseQtMemoStrings}
  WriteLn('TQtMemoStrings.GetCount');
  {$endif}
  if FTextChanged and not InUpdate then InternalUpdate;
  Result := FStringList.Count;
end;

{------------------------------------------------------------------------------
  Method: TQtMemoStrings.Get
  Params:  String Index
  Returns: a string

  Return the string[Index], or an empty string of out of bounds.
 ------------------------------------------------------------------------------}
function TQtMemoStrings.Get(Index: Integer): string;
begin
  {$ifdef VerboseQtMemoStrings}
  WriteLn('TQtMemoStrings.Get Index=',Index,' TextChanged ? ',TextChanged);
  {$endif}
  if FTextChanged and not InUpdate then InternalUpdate;
  if Index < FStringList.Count then
    Result := FStringList.Strings[Index]
  else
    Result := '';
end;

procedure TQtMemoStrings.Put(Index: Integer; const S: string);
var
  W: WideString;
begin
  {$ifdef VerboseQtMemoStrings}
  WriteLn('TQtMemoStrings.Put Index=',Index,' S=',S);
  {$endif}
  if FTextChanged and not InUpdate then InternalUpdate;
  FStringList[Index] := S;
  if not InUpdate then
  begin
    W := UTF8ToUTF16(S);
    TQtTextEdit(FOwner.Handle).setLineText(Index, W);
  end;
  FTextChanged := False;
end;

procedure TQtMemoStrings.SetTextStr(const Value: string);
var
  W: WideString;
begin
  {$ifdef VerboseQtMemoStrings}
  WriteLn('TQtMemoStrings.SetTextStr Value=',Value);
  {$endif}
  SetInternalText(Value);
  W := {%H-}GetInternalText;
  if not InUpdate then
    ExternalUpdate(W, True, False);
  FTextChanged := False;
end;

{------------------------------------------------------------------------------
  Method: TQtMemoStrings.Create
  Params:  Qt Widget Handle and Lazarus WinControl Parent Object
  Returns: Nothing

  Constructor for the class.
 ------------------------------------------------------------------------------}
constructor TQtMemoStrings.Create(TheOwner: TWinControl);
begin
  inherited Create;
  {$ifdef VerboseQt}
  if (TheOwner = nil) then
    WriteLn('TQtMemoStrings.Create Unspecified owner');
  {$endif}
  FUpdating := False;
  FStringList := TStringList.Create;
  FHasTrailingLineBreak := False;
  FOwner := TheOwner;
end;

{------------------------------------------------------------------------------
  Method: TQtMemoStrings.Destroy
  Params:  None
  Returns: Nothing

  Destructor for the class.
 ------------------------------------------------------------------------------}
destructor TQtMemoStrings.Destroy;
begin
  FStringList.Free;
  FOwner := nil;
  inherited Destroy;
end;

procedure TQtMemoStrings.SetUpdateState(Updating: Boolean);
var
  S: String;
  W: WideString;
begin
  if not Updating then
  begin
    S := FStringList.Text;
    if Assigned(FOwner) and FOwner.HandleAllocated then
    begin
      W := UTF8ToUTF16(S);
      TQtTextEdit(FOwner.Handle).setText(W);
    end;
  end;
  inherited SetUpdateState(Updating);
  FUpdating := Updating;
end;

function TQtMemoStrings.InUpdate: boolean;
begin
  Result := FUpdating;
end;

{------------------------------------------------------------------------------
  Method: TQtMemoStrings.Assign
  Params:  None
  Returns: Nothing

  Assigns from a TStrings.
 ------------------------------------------------------------------------------}
procedure TQtMemoStrings.Assign(Source: TPersistent);
var
  W: WideString;
begin
  if (Source=Self) or (Source=nil) then
    exit;
  if not FOwner.HandleAllocated then
    exit;

  if Source is TStrings then
  begin
    {$ifdef VerboseQtMemoStrings}
    writeln('TQtMemoStrings.Assign - handle ? ', FOwner.HandleAllocated);
    {$endif}
    FStringList.Clear;
    SetInternalText(TStrings(Source).Text);
    W := {%H-}GetInternalText;
    if not InUpdate then
      ExternalUpdate(W, True, False);
    FTextChanged := False;
    exit;
  end;
  inherited Assign(Source);
end;

{------------------------------------------------------------------------------
  Method: TQtMemoStrings.Clear
  Params:  None
  Returns: Nothing

  Clears all.
 ------------------------------------------------------------------------------}
procedure TQtMemoStrings.Clear;
begin
  if not Assigned(FOwner) then
    exit;
  if Assigned(FStringList) then
    FStringList.Clear;
  if not InUpdate and not (csDestroying in FOwner.ComponentState) and
    not (csFreeNotification in FOwner.ComponentState) and
    FOwner.HandleAllocated then
  begin
    {$ifdef VerboseQtMemoStrings}
    writeln('TQtMemoStrings.Clear');
    {$endif}
    TQtTextEdit(FOwner.Handle).BeginUpdate;
    TQtTextEdit(FOwner.Handle).ClearText;
    TQtTextEdit(FOwner.Handle).EndUpdate;
    FTextChanged := False;
  end;
end;

{------------------------------------------------------------------------------
  Method: TQtMemoStrings.Delete
  Params:  Index
  Returns: Nothing

  Deletes line at Index.
 ------------------------------------------------------------------------------}
procedure TQtMemoStrings.Delete(Index: integer);
begin
  if FTextChanged and not InUpdate then InternalUpdate;
  if (Index >= 0) and (Index < FStringList.Count) then
  begin
    {$ifdef VerboseQtMemoStrings}
    writeln('TQtMemoStrings.Delete');
    {$endif}
    FStringList.Delete(Index);
    if not InUpdate then
      TQtTextEdit(FOwner.Handle).RemoveLine(Index);
    FTextChanged := False;
  end;
end;

{------------------------------------------------------------------------------
  Method: TQtMemoStrings.Insert
  Params:  Index, string
  Returns: Nothing

  Inserts line at Index.
 ------------------------------------------------------------------------------}
procedure TQtMemoStrings.Insert(Index: integer; const S: string);
var
  W: WideString;
  ATextEdit: QTextEditH;
  ADoc: QTextDocumentH;
  ABlock: QTextBlockH;
  ACursor: QTextCursorH;
begin
  if FTextChanged and not InUpdate then InternalUpdate;
  if Index < 0 then Index := 0;

  {$ifdef VerboseQtMemoStrings}
  writeln('TQtMemoStrings.Insert Index=',Index,' COUNT=',FStringList.Count,' InUpdate=',InUpdate);
  {$endif}

  // simplified because of issue #29670
  // allow insert invalid index like others do
  if Index >= FStringList.Count then
  begin
    Index := FStringList.Add(S);
    if not InUpdate then
    begin
      if FHasTrailingLineBreak then
        W := UTF8ToUTF16(S + LineBreak)
      else
        W := UTF8ToUTF16(S);
      if FHasTrailingLineBreak then
      begin
        //issue #39444
        ATextEdit := QTextEditH(TQtTextEdit(FOwner.Handle).Widget);
        ADoc := QTextEdit_document(ATextEdit);
        ABlock := QTextBlock_Create;
        QTextDocument_lastBlock(ADoc, ABlock);
        ACursor := QTextCursor_Create(ABlock);
        QTextCursor_movePosition(ACursor, QTextCursorEnd);
        QTextCursor_deletePreviousChar(ACursor);
        QTextBlock_Destroy(ABlock);
        QTextCursor_destroy(ACursor);
      end;
      TQtTextEdit(FOwner.Handle).Append(W);
    end;
  end else
  begin
    FStringList.Insert(Index, S);
    if not InUpdate then
    begin
      W := UTF8ToUTF16(S);
      TQtTextEdit(FOwner.Handle).insertLine(Index, W);
    end;
  end;
  FTextChanged := False; // FStringList is already updated, no need to update from WS.
end;

procedure TQtMemoStrings.LoadFromFile(const FileName: string);
var
  TheStream: TFileStream;
begin
  TheStream:=TFileStream.Create(FileName,fmOpenRead or fmShareDenyWrite);
  try
    LoadFromStream(TheStream);
  finally
    TheStream.Free;
  end;
end;

procedure TQtMemoStrings.SaveToFile(const FileName: string);
var
  TheStream: TFileStream;
begin
  TheStream:=TFileStream.Create(FileName,fmCreate);
  try
    SaveToStream(TheStream);
  finally
    TheStream.Free;
  end;
end;

{ TQtComboStrings }

procedure TQtComboStrings.SetSorted(AValue: Boolean);
begin
  if FSorted=AValue then Exit;
  FSorted:=AValue;
  inherited Sorted:=FSorted;
end;

procedure TQtComboStrings.Put(Index: Integer; const S: string);
begin
  inherited Put(Index, S);
  FOwner.BeginUpdate;
  FOwner.setItemText(Index, S);
  FOwner.EndUpdate;
end;

procedure TQtComboStrings.InsertItem(Index: Integer; const S: string; O: TObject);
var
  FSavedIndex: Integer;
  FSavedText: WideString;
begin
  inherited InsertItem(Index, S, O);
  FOwner.BeginUpdate;
  FSavedText := FOwner.getText;
  FSavedIndex := FOwner.currentIndex;
  FOwner.insertItem(Index, S);
  if FOwner.getEditable then
  begin
    if (FSavedIndex <> FOwner.currentIndex) then
      FOwner.setCurrentIndex(FSavedIndex);
    FOwner.setText(FSavedText);
  end else
    FOwner.setCurrentIndex(FSavedIndex);
  FOwner.EndUpdate;
end;

constructor TQtComboStrings.Create(AWinControl: TWinControl;
    AOwner: TQtComboBox);
begin
  inherited Create;
  FWinControl := AWinControl;
  FOwner := AOwner;
  FSorted := TComboBox(AOwner.LCLObject).Sorted;
  FChanging := False;
end;

destructor TQtComboStrings.Destroy;
begin
  FWinControl := nil;
  inherited Destroy;
end;

function TQtComboStrings.Add(const S: String): Integer;
var
  I: Integer;
begin
  Result := inherited Add(S);
  if FSorted and Assigned(FWinControl) and (FWinControl.HandleAllocated) then
  begin
    FOwner.BeginUpdate;
    for I := 0 to Count - 1 do
      FOwner.setItemText(I, Strings[I]);
    FOwner.EndUpdate;
  end;
end;

procedure TQtComboStrings.Assign(Source: TPersistent);
var
  AList: TStringListUTF8Fast;
begin
  if (Source = Self) or (Source = nil) then Exit;
  if Assigned(FWinControl) and (FWinControl.HandleAllocated) then
  begin
    FOwner.BeginUpdate;
    if Sorted then
    begin
      AList := TStringListUTF8Fast.Create;
      try
        AList.Assign(Source);
        AList.Sort;
        inherited Assign(AList);
      finally
        AList.Free;
      end;
    end else
      inherited Assign(Source);
    FOwner.EndUpdate;
  end;
end;

procedure TQtComboStrings.Clear;
var
  AText: WideString;
begin
  inherited Clear;

  if Assigned(FWinControl) and (FWinControl.HandleAllocated) then
  begin
    FOwner.BeginUpdate;
    if FOwner.getEditable then
      AText := FOwner.LineEdit.getText
    else
      AText := '';
    FOwner.ClearItems;
    if (AText <> '') then
      FOwner.setText(AText);
    FOwner.EndUpdate;
  end;
end;

procedure TQtComboStrings.Delete(Index: Integer);
begin
  inherited Delete(Index);
  if Assigned(FWinControl) and (FWinControl.HandleAllocated) then
  begin
    FOwner.BeginUpdate;
    FOwner.removeItem(Index);
    FOwner.EndUpdate;
  end;
end;

function TQtComboStrings.Find(const S: String; out Index: Integer): Boolean;
var
  L, R, I: Integer;
  CompareRes: PtrInt;
begin
  Result := False;
  // Use binary search.
  L := 0;
  R := Count - 1;
  while (L <= R) do
  begin
    I := L + (R - L) div 2;
    CompareRes := AnsiCompareText(S, Strings[I]);
    if (CompareRes > 0) then
      L := I + 1
    else
    begin
      R := I - 1;
      if (CompareRes = 0) then
      begin
        Result := True;
        L := I; // forces end of while loop
      end;
    end;
  end;
  Index := L;
end;

function TQtComboStrings.IndexOf(const S: String): Integer;
begin
  Result := -1;
  if FSorted then
  begin
    //Binary Search
    if not Find(S, Result) then
      Result := -1;
  end else
    Result := inherited IndexOf(S);
end;

procedure TQtComboStrings.Insert(Index: Integer; const S: String);
begin
  if FSorted and not FChanging then
  begin
    inherited Insert(Index, S);
    Sort;
  end else
    inherited Insert(Index, S);
end;

procedure TQtComboStrings.Sort;
var
  I: Integer;
begin
  inherited Sort;
  if Assigned(FWinControl) and (FWinControl.HandleAllocated) then
  begin
    FOwner.BeginUpdate;
    for I := 0 to Count - 1 do
      FOwner.setItemText(I, Strings[I]);
    FOwner.EndUpdate;
  end;
end;

procedure TQtComboStrings.Exchange(AIndex1, AIndex2: Integer);
var
  i: Integer;
begin
  inherited Exchange(AIndex1, AIndex2);
  if Assigned(FWinControl) and (FWinControl.HandleAllocated) then
  begin
    FOwner.BeginUpdate;
    for I := 0 to Count - 1 do
      FOwner.setItemText(I, Strings[I]);
    FOwner.EndUpdate;
  end;
end;

{ TQtListStrings }

procedure TQtListStrings.Put(Index: Integer; const S: string);
begin
  inherited Put(Index, S);
  if Assigned(FWinControl) and (FWinControl.HandleAllocated) then
  begin
    FOwner.BeginUpdate;
    FOwner.setItemText(Index, S);
    if FOwner is TQtCheckListBox then
    begin
      FOwner.ItemFlags[Index] := FOwner.ItemFlags[Index] or QtItemIsUserCheckable;
      if TQtCheckListBox(FOwner).AllowGrayed then
        FOwner.ItemFlags[Index] := FOwner.ItemFlags[Index] or QtItemIsTristate
      else
        FOwner.ItemFlags[Index] := FOwner.ItemFlags[Index] and not QtItemIsTristate;
    end;
    FOwner.EndUpdate;
  end;
end;

procedure TQtListStrings.InsertItem(Index: Integer; const S: string; O: TObject);
begin
  inherited InsertItem(Index, S, O);
  if Assigned(FWinControl) and (FWinControl.HandleAllocated) then
  begin
    FOwner.BeginUpdate;
    FOwner.insertItem(Index, S);

    if FOwner is TQtCheckListBox then
    begin
      FOwner.ItemFlags[Index] := FOwner.ItemFlags[Index] or QtItemIsUserCheckable;
      if TQtCheckListBox(FOwner).AllowGrayed then
        FOwner.ItemFlags[Index] := FOwner.ItemFlags[Index] or QtItemIsTristate
      else
        FOwner.ItemFlags[Index] := FOwner.ItemFlags[Index] and not QtItemIsTristate;
    end;
    FOwner.EndUpdate;
  end;
end;

constructor TQtListStrings.Create(AWinControl: TWinControl;
  AOwner: TQtListWidget);
begin
  inherited Create;
  FWinControl := AWinControl;
  FOwner := AOwner;
end;

destructor TQtListStrings.Destroy;
begin
  FWinControl := nil;
  inherited Destroy;
end;

procedure TQtListStrings.Assign(Source: TPersistent);
var
  i: Integer;
begin
  if Assigned(FWinControl) and (FWinControl.HandleAllocated) then
  begin
    FOwner.BeginUpdate;
    inherited Assign(Source);
    if FOwner is TQtCheckListBox then
    begin
      for i := 0 to TQtCheckListBox(FOwner).ItemCount - 1 do
      begin
        FOwner.ItemFlags[i] := FOwner.ItemFlags[i] or QtItemIsUserCheckable;
        if TQtCheckListBox(FOwner).AllowGrayed then
          FOwner.ItemFlags[i] := FOwner.ItemFlags[i] or QtItemIsTristate
        else
          FOwner.ItemFlags[i] := FOwner.ItemFlags[i] and not QtItemIsTristate;
      end;
    end;
    FOwner.EndUpdate;
  end;
end;

procedure TQtListStrings.Clear;
begin
  inherited Clear;

  if Assigned(FWinControl) and (FWinControl.HandleAllocated) then
  begin
    FOwner.BeginUpdate;
    FOwner.ClearItems;
    FOwner.EndUpdate;
  end;
end;

procedure TQtListStrings.Delete(Index: Integer);
begin
  inherited Delete(Index);
  if Assigned(FWinControl) and (FWinControl.HandleAllocated) then
  begin
    FOwner.BeginUpdate;
    FOwner.removeItem(Index);
    FOwner.EndUpdate;
  end;
end;

procedure TQtListStrings.Move(CurIndex, NewIndex: Integer);
var
  CheckState: QtCheckState;
  Selected: Boolean;
begin
  {move is calling delete, and then insert.
   we must save our item checkstate and selection}
  if Assigned(FWinControl) and (FWinControl.HandleAllocated) and
    (FOwner is TQtCheckListBox) then
  begin
    CheckState := TQtCheckListBox(FOwner).ItemCheckState[CurIndex];
    Selected := TQtCheckListBox(FOwner).Selected[CurIndex];
  end;

  inherited Move(CurIndex, NewIndex);

  {return check state to newindex}
  if Assigned(FWinControl) and (FWinControl.HandleAllocated) and
    (FOwner is TQtCheckListBox) then
  begin
    FOwner.BeginUpdate;
    TQtCheckListBox(FOwner).ItemCheckState[NewIndex] := CheckState;
    FOwner.Selected[NewIndex] := Selected;
    FOwner.EndUpdate;
  end;
end;

procedure TQtListStrings.Sort;
var
  I: Integer;
begin
  inherited Sort;
  if Assigned(FWinControl) and (FWinControl.HandleAllocated) then
  begin
    FOwner.BeginUpdate;
    for I := 0 to Count - 1 do
      FOwner.setItemText(I, Strings[I]);
    FOwner.EndUpdate;
  end;
end;

procedure TQtListStrings.Exchange(AIndex1, AIndex2: Integer);
var
  ARow: Integer;
begin
  inherited Exchange(AIndex1, AIndex2);
  if Assigned(FWinControl) and (FWinControl.HandleAllocated) then
  begin
    ARow := FOwner.currentRow;
    FOwner.BeginUpdate;
    FOwner.ExchangeItems(AIndex1, AIndex2);
    FOwner.setCurrentRow(ARow);
    FOwner.EndUpdate;
  end;
end;

end.