~ubuntu-branches/ubuntu/saucy/lazarus/saucy

« back to all changes in this revision

Viewing changes to lcl/interfaces/qt/qtprivate.pp

  • Committer: Package Import Robot
  • Author(s): Paul Gevers, Abou Al Montacir, Bart Martens, Paul Gevers
  • Date: 2013-06-08 14:12:17 UTC
  • mfrom: (1.1.9)
  • Revision ID: package-import@ubuntu.com-20130608141217-7k0cy9id8ifcnutc
Tags: 1.0.8+dfsg-1
[ Abou Al Montacir ]
* New upstream major release and multiple maintenace release offering many
  fixes and new features marking a new milestone for the Lazarus development
  and its stability level.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_fixes_branch
* LCL changes:
  - LCL is now a normal package.
      + Platform independent parts of the LCL are now in the package LCLBase
      + LCL is automatically recompiled when switching the target platform,
        unless pre-compiled binaries for this target are already installed.
      + No impact on existing projects.
      + Linker options needed by LCL are no more added to projects that do
        not use the LCL package.
  - Minor changes in LCL basic classes behaviour
      + TCustomForm.Create raises an exception if a form resource is not
        found.
      + TNotebook and TPage: a new implementation of these classes was added.
      + TDBNavigator: It is now possible to have focusable buttons by setting
        Options = [navFocusableButtons] and TabStop = True, useful for
        accessibility and for devices with neither mouse nor touch screen.
      + Names of TControlBorderSpacing.GetSideSpace and GetSpace were swapped
        and are now consistent. GetSideSpace = Around + GetSpace.
      + TForm.WindowState=wsFullscreen was added
      + TCanvas.TextFitInfo was added to calculate how many characters will
        fit into a specified Width. Useful for word-wrapping calculations.
      + TControl.GetColorResolvingParent and
        TControl.GetRGBColorResolvingParent were added, simplifying the work
        to obtain the final color of the control while resolving clDefault
        and the ParentColor.
      + LCLIntf.GetTextExtentExPoint now has a good default implementation
        which works in any platform not providing a specific implementation.
        However, Widgetset specific implementation is better, when available.
      + TTabControl was reorganized. Now it has the correct class hierarchy
        and inherits from TCustomTabControl as it should.
  - New unit in the LCL:
      + lazdialogs.pas: adds non-native versions of various native dialogs,
        for example TLazOpenDialog, TLazSaveDialog, TLazSelectDirectoryDialog.
        It is used by widgetsets which either do not have a native dialog, or
        do not wish to use it because it is limited. These dialogs can also be
        used by user applications directly.
      + lazdeviceapis.pas: offers an interface to more hardware devices such
        as the accelerometer, GPS, etc. See LazDeviceAPIs
      + lazcanvas.pas: provides a TFPImageCanvas descendent implementing
        drawing in a LCL-compatible way, but 100% in Pascal.
      + lazregions.pas. LazRegions is a wholly Pascal implementation of
        regions for canvas clipping, event clipping, finding in which control
        of a region tree one an event should reach, for drawing polygons, etc.
      + customdrawncontrols.pas, customdrawndrawers.pas,
        customdrawn_common.pas, customdrawn_android.pas and
        customdrawn_winxp.pas: are the Lazarus Custom Drawn Controls -controls
        which imitate the standard LCL ones, but with the difference that they
        are non-native and support skinning.
  - New APIs added to the LCL to improve support of accessibility software
    such as screen readers.
* IDE changes:
  - Many improvments.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/New_IDE_features_since#v1.0_.282012-08-29.29
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes#IDE_Changes
* Debugger / Editor changes:
  - Added pascal sources and breakpoints to the disassembler
  - Added threads dialog.
* Components changes:
  - TAChart: many fixes and new features
  - CodeTool: support Delphi style generics and new syntax extensions.
  - AggPas: removed to honor free licencing. (Closes: Bug#708695)
[Bart Martens]
* New debian/watch file fixing issues with upstream RC release.
[Abou Al Montacir]
* Avoid changing files in .pc hidden directory, these are used by quilt for
  internal purpose and could lead to surprises during build.
[Paul Gevers]
* Updated get-orig-source target and it compinion script orig-tar.sh so that they
  repack the source file, allowing bug 708695 to be fixed.

Show diffs side-by-side

added added

removed removed

Lines of Context:
31
31
  // Bindings
32
32
  qt4,
33
33
  // Free Pascal
34
 
  Classes, SysUtils, Types,
 
34
  Classes, SysUtils,
35
35
  // LCL
36
 
  LMessages, Forms, Controls, LCLType, LCLProc, ExtCtrls, StdCtrls, Menus,
37
 
  CheckLst,
 
36
  Forms, Controls, LCLType, LCLProc, ExtCtrls, StdCtrls,
38
37
  //Widgetset
39
38
  QtWidgets, qtproc;
40
39
 
79
78
    procedure Assign(Source: TPersistent); override;
80
79
    procedure Clear; override;
81
80
    procedure Delete(Index: Integer); override;
 
81
    procedure Move(CurIndex, NewIndex: Integer); override;
82
82
    procedure Sort; override;
83
83
    procedure Exchange(AIndex1, AIndex2: Integer); override;
84
84
  public
91
91
  private
92
92
    FTextChanged: Boolean; // Inform TQtMemoStrings about change in TextChange event
93
93
    FStringList: TStringList; // Holds the lines to show
 
94
    FHasTrailingLineBreak: Boolean; // Indicates whether lines have trailing line break
94
95
    FOwner: TWinControl;      // Lazarus Control Owning MemoStrings
95
96
    procedure InternalUpdate;
96
97
    procedure ExternalUpdate(var AStr: WideString;
140
141
  if W <> '' then
141
142
    SetInternalText(UTF16ToUTF8(W))
142
143
  else
143
 
    FStringList.Text := '';
 
144
    SetInternalText('');
144
145
  FTextChanged := False;
145
146
end;
146
147
 
191
192
begin
192
193
  Result := FStringList.Text;
193
194
 
194
 
  // remove trailing line break
195
 
  TextLen := Length(Result);
196
 
  if (TextLen > 0) and (Result[TextLen] = #10) then
197
 
    Dec(TextLen);
198
 
  if (TextLen > 0) and (Result[TextLen] = #13) then
199
 
    Dec(TextLen);
200
 
  SetLength(Result, TextLen);
 
195
  // Since TStringList.Text automatically adds line break to the last line,
 
196
  // we should remove it if original text does not contain it
 
197
  if not FHasTrailingLineBreak then
 
198
  begin
 
199
    TextLen := Length(Result);
 
200
    if (TextLen > 0) and (Result[TextLen] = #10) then
 
201
      Dec(TextLen);
 
202
    if (TextLen > 0) and (Result[TextLen] = #13) then
 
203
      Dec(TextLen);
 
204
    SetLength(Result, TextLen);
 
205
  end;
201
206
end;
202
207
 
203
208
procedure TQtMemoStrings.SetInternalText(const Value: string);
 
209
var
 
210
  TextLen: Integer;
204
211
begin
205
 
  FStringList.Text := Value + LineEnding;
 
212
  TextLen := Length(Value);
 
213
  FHasTrailingLineBreak := (TextLen > 0) and (Value[TextLen] in [#13, #10]);
 
214
  FStringList.Text := Value;
206
215
end;
207
216
 
208
217
{------------------------------------------------------------------------------
297
306
    WriteLn('TQtMemoStrings.Create Unspecified owner');
298
307
  {$endif}
299
308
  FStringList := TStringList.Create;
 
309
  FHasTrailingLineBreak := False;
300
310
  FOwner := TheOwner;
301
311
end;
302
312
 
402
412
procedure TQtMemoStrings.Insert(Index: integer; const S: string);
403
413
var
404
414
  W: WideString;
 
415
  QtCursor: QTextCursorH;
 
416
 
 
417
 
 
418
  function WorkaroundNeeded: Boolean;
 
419
  var
 
420
    HaveLt: Boolean;
 
421
    HaveGt: Boolean;
 
422
    S1: String;
 
423
  begin
 
424
    HaveLt := System.Pos('<', S) > 0;
 
425
    HaveGt := System.Pos('>', S) > 0;
 
426
    Result := HaveLt or HaveGt;
 
427
  end;
 
428
 
405
429
begin
406
430
  if FTextChanged then InternalUpdate;
407
431
  if Index < 0 then Index := 0;
413
437
  if Index <= FStringList.Count then
414
438
  begin
415
439
    FStringList.Insert(Index, S);
416
 
    if TQtTextEdit(FOwner.Handle).getBlockCount - Index <= 1 then
 
440
    if (TQtTextEdit(FOwner.Handle).getBlockCount - Index <= 1) then
417
441
    begin
418
 
      if (UTF8Pos('<', S) > 0) or (UTF8Pos('>',S) > 0) then
 
442
      // workaround for qt richtext parser bug. issues #17170 and #22715
 
443
      if WorkaroundNeeded then
419
444
      begin
420
 
        // workaround for qt richtext parser bug
421
445
        W := GetUTF8String(S);
422
 
        TQtTextEdit(FOwner.Handle).insertLine(Index, W);
 
446
        if (Index >= FStringList.Count - 1) then
 
447
          TQtTextEdit(FOwner.Handle).appendLine(W)
 
448
        else
 
449
          TQtTextEdit(FOwner.Handle).insertLine(Index, W);
423
450
      end else
424
451
      begin
425
452
        // append is much faster in case when we add strings
564
591
begin
565
592
  inherited Put(Index, S);
566
593
  if Assigned(FWinControl) and (FWinControl.HandleAllocated) then
 
594
  begin
 
595
    FOwner.BeginUpdate;
567
596
    FOwner.setItemText(Index, S);
 
597
    if FOwner is TQtCheckListBox then
 
598
    begin
 
599
      FOwner.ItemFlags[Index] := FOwner.ItemFlags[Index] or QtItemIsUserCheckable;
 
600
      if TQtCheckListBox(FOwner).AllowGrayed then
 
601
        FOwner.ItemFlags[Index] := FOwner.ItemFlags[Index] or QtItemIsTristate
 
602
      else
 
603
        FOwner.ItemFlags[Index] := FOwner.ItemFlags[Index] and not QtItemIsTristate;
 
604
    end;
 
605
    FOwner.EndUpdate;
 
606
  end;
568
607
end;
569
608
 
570
609
procedure TQtListStrings.InsertItem(Index: Integer; const S: string);
571
610
begin
572
611
  inherited InsertItem(Index, S);
573
612
  if Assigned(FWinControl) and (FWinControl.HandleAllocated) then
 
613
  begin
 
614
    FOwner.BeginUpdate;
574
615
    FOwner.insertItem(Index, S);
 
616
    if FOwner is TQtCheckListBox then
 
617
    begin
 
618
      FOwner.ItemFlags[Index] := FOwner.ItemFlags[Index] or QtItemIsUserCheckable;
 
619
      if TQtCheckListBox(FOwner).AllowGrayed then
 
620
        FOwner.ItemFlags[Index] := FOwner.ItemFlags[Index] or QtItemIsTristate
 
621
      else
 
622
        FOwner.ItemFlags[Index] := FOwner.ItemFlags[Index] and not QtItemIsTristate;
 
623
    end;
 
624
    FOwner.EndUpdate;
 
625
  end;
575
626
end;
576
627
 
577
628
procedure TQtListStrings.InsertItem(Index: Integer; const S: string; O: TObject);
578
629
begin
579
630
  inherited InsertItem(Index, S, O);
580
631
  if Assigned(FWinControl) and (FWinControl.HandleAllocated) then
 
632
  begin
 
633
    FOwner.BeginUpdate;
581
634
    FOwner.insertItem(Index, S);
 
635
 
 
636
    if FOwner is TQtCheckListBox then
 
637
    begin
 
638
      FOwner.ItemFlags[Index] := FOwner.ItemFlags[Index] or QtItemIsUserCheckable;
 
639
      if TQtCheckListBox(FOwner).AllowGrayed then
 
640
        FOwner.ItemFlags[Index] := FOwner.ItemFlags[Index] or QtItemIsTristate
 
641
      else
 
642
        FOwner.ItemFlags[Index] := FOwner.ItemFlags[Index] and not QtItemIsTristate;
 
643
    end;
 
644
    FOwner.EndUpdate;
 
645
  end;
582
646
end;
583
647
 
584
648
constructor TQtListStrings.Create(AWinControl: TWinControl;
596
660
end;
597
661
 
598
662
procedure TQtListStrings.Assign(Source: TPersistent);
 
663
var
 
664
  i: Integer;
599
665
begin
600
666
  if Assigned(FWinControl) and (FWinControl.HandleAllocated) then
601
667
  begin
602
668
    FOwner.BeginUpdate;
603
669
    inherited Assign(Source);
 
670
    if FOwner is TQtCheckListBox then
 
671
    begin
 
672
      for i := 0 to TQtCheckListBox(FOwner).ItemCount - 1 do
 
673
      begin
 
674
        FOwner.ItemFlags[i] := FOwner.ItemFlags[i] or QtItemIsUserCheckable;
 
675
        if TQtCheckListBox(FOwner).AllowGrayed then
 
676
          FOwner.ItemFlags[i] := FOwner.ItemFlags[i] or QtItemIsTristate
 
677
        else
 
678
          FOwner.ItemFlags[i] := FOwner.ItemFlags[i] and not QtItemIsTristate;
 
679
      end;
 
680
    end;
604
681
    FOwner.EndUpdate;
605
682
  end;
606
683
end;
621
698
begin
622
699
  inherited Delete(Index);
623
700
  if Assigned(FWinControl) and (FWinControl.HandleAllocated) then
 
701
  begin
 
702
    FOwner.BeginUpdate;
624
703
    FOwner.removeItem(Index);
 
704
    FOwner.EndUpdate;
 
705
  end;
 
706
end;
 
707
 
 
708
procedure TQtListStrings.Move(CurIndex, NewIndex: Integer);
 
709
var
 
710
  CheckState: QtCheckState;
 
711
  Selected: Boolean;
 
712
begin
 
713
  {move is calling delete, and then insert.
 
714
   we must save our item checkstate and selection}
 
715
  if Assigned(FWinControl) and (FWinControl.HandleAllocated) and
 
716
    (FOwner is TQtCheckListBox) then
 
717
  begin
 
718
    CheckState := TQtCheckListBox(FOwner).ItemCheckState[CurIndex];
 
719
    Selected := TQtCheckListBox(FOwner).Selected[CurIndex];
 
720
  end;
 
721
 
 
722
  inherited Move(CurIndex, NewIndex);
 
723
 
 
724
  {return check state to newindex}
 
725
  if Assigned(FWinControl) and (FWinControl.HandleAllocated) and
 
726
    (FOwner is TQtCheckListBox) then
 
727
  begin
 
728
    FOwner.BeginUpdate;
 
729
    TQtCheckListBox(FOwner).ItemCheckState[NewIndex] := CheckState;
 
730
    FOwner.Selected[NewIndex] := Selected;
 
731
    FOwner.EndUpdate;
 
732
  end;
625
733
end;
626
734
 
627
735
procedure TQtListStrings.Sort;
631
739
  inherited Sort;
632
740
  if Assigned(FWinControl) and (FWinControl.HandleAllocated) then
633
741
  begin
 
742
    FOwner.BeginUpdate;
634
743
    for I := 0 to Count - 1 do
635
744
      FOwner.setItemText(I, Strings[I]);
 
745
    FOwner.EndUpdate;
636
746
  end;
637
747
end;
638
748
 
639
749
procedure TQtListStrings.Exchange(AIndex1, AIndex2: Integer);
 
750
var
 
751
  ARow: Integer;
640
752
begin
641
753
  inherited Exchange(AIndex1, AIndex2);
642
754
  if Assigned(FWinControl) and (FWinControl.HandleAllocated) then
643
 
    FOwner.exchangeItems(AIndex1, AIndex2);
 
755
  begin
 
756
    ARow := FOwner.currentRow;
 
757
    FOwner.BeginUpdate;
 
758
    FOwner.ExchangeItems(AIndex1, AIndex2);
 
759
    FOwner.setCurrentRow(ARow);
 
760
    FOwner.EndUpdate;
 
761
  end;
644
762
end;
645
763
 
646
764
end.