← Back to branch summary

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

« back to all changes in this revision

Viewing changes to ide/viewunit_dlg.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
http://bugs.debian.org/708695
[ 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:
ide/viewunit_dlg.pp
1
 
{  $Id: viewunit_dlg.pp 26828 2010-07-25 12:40:33Z maxim $  }
2
1
{
3
2
 /***************************************************************************
4
3
                          ViewUnit_dlg.pp
40
39
 
41
40
uses
42
41
  SysUtils, Classes, Math, Controls, Forms, Dialogs, Buttons, StdCtrls,
43
 
  LazarusIdeStrConsts, LCLType, LCLIntf, LMessages, IDEWindowIntf, IDEContextHelpEdit,
44
 
  ExtCtrls, ButtonPanel, Menus, StrUtils;
 
42
  LazarusIdeStrConsts, LCLType, LCLIntf, LMessages,
 
43
  ExtCtrls, ButtonPanel, Menus, StrUtils, ImgList,
 
44
  IDEWindowIntf, IDEHelpIntf, IDEImagesIntf, ListFilterEdit;
45
45
 
46
46
type
 
47
  TIDEProjectItem = (
 
48
    piUnit,
 
49
    piComponent,
 
50
    piFrame
 
51
  );
 
52
 
47
53
  TViewUnitsEntry = class
48
54
  public
49
55
    Name: string;
55
61
  { TViewUnitDialog }
56
62
 
57
63
  TViewUnitDialog = class(TForm)
 
64
    BtnPanel: TPanel;
58
65
    ButtonPanel: TButtonPanel;
59
 
    Edit: TEdit;
 
66
    DummySpeedButton: TSpeedButton;
 
67
    FilterEdit: TListFilterEdit;
60
68
    ListBox: TListBox;
61
69
    mniMultiSelect: TMenuItem;
62
 
    mniSort: TMenuItem;
 
70
    OptionsBitBtn: TSpeedButton;
63
71
    popListBox: TPopupMenu;
64
 
    procedure EditChange(Sender: TObject);
65
 
    procedure EditEnter(Sender: TObject);
66
 
    procedure EditKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
 
72
    RemoveBitBtn: TSpeedButton;
 
73
    SortAlphabeticallySpeedButton: TSpeedButton;
 
74
    procedure ListboxDrawItem(Control: TWinControl; Index: Integer;
 
75
      ARect: TRect; State: TOwnerDrawState);
 
76
    procedure SortAlphabeticallySpeedButtonClick(Sender: TObject);
 
77
    procedure OKButtonClick(Sender :TObject);
67
78
    procedure HelpButtonClick(Sender: TObject);
68
 
    procedure mniSortClick(Sender: TObject);
69
 
    Procedure OKButtonClick(Sender :TObject);
70
 
    Procedure CancelButtonClick(Sender :TObject);
71
 
    procedure ListboxClick(Sender: TObject);
 
79
    procedure CancelButtonClick(Sender :TObject);
72
80
    procedure ListboxKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
73
81
    procedure MultiselectCheckBoxClick(Sender :TObject);
74
82
  private
75
 
    FBlockListBoxChange: boolean;
76
 
    procedure FocusEdit;
77
 
    procedure SearchList(StartIndex: Integer = -1);
 
83
    FSortAlphabetically: boolean;
 
84
    FImageIndex: Integer;
 
85
    procedure SetSortAlphabetically(const AValue: boolean);
78
86
  public
79
87
    constructor Create(TheOwner: TComponent); override;
 
88
    property SortAlphabetically: boolean read FSortAlphabetically write SetSortAlphabetically;
80
89
  end;
81
90
 
82
 
function ShowViewUnitsDlg(Entries: TStringList; AllowMultiSelect: boolean;
83
 
  var CheckMultiSelect: Boolean; const Caption: string): TModalResult;
84
 
  // Entries is a list of TViewUnitsEntry(s)
 
91
// Entries is a list of TViewUnitsEntry(s)
 
92
function ShowViewUnitsDlg(Entries: TStringList; AllowMultiSelect: boolean;
 
93
  var CheckMultiSelect: Boolean; const aCaption: string; aImageIndex: Integer): TModalResult;
 
94
function ShowViewUnitsDlg(Entries: TStringList; AllowMultiSelect: boolean;
 
95
  var CheckMultiSelect: Boolean; const aCaption: string; ItemType: TIDEProjectItem): TModalResult;
85
96
 
86
97
implementation
87
98
 
88
99
{$R *.lfm}
89
100
 
90
101
function ShowViewUnitsDlg(Entries: TStringList; AllowMultiSelect: boolean;
91
 
  var CheckMultiSelect: Boolean; const Caption: string): TModalResult;
 
102
  var CheckMultiSelect: Boolean; const aCaption: string; aImageIndex: Integer): TModalResult;
92
103
var
93
104
  ViewUnitDialog: TViewUnitDialog;
 
105
  UEntry: TViewUnitsEntry;
94
106
  i: integer;
95
107
begin
96
108
  ViewUnitDialog:=TViewUnitDialog.Create(nil);
 
109
  with ViewUnitDialog do
97
110
  try
98
 
    ViewUnitDialog.Caption:=Caption;
99
 
    ViewUnitDialog.mniMultiselect.Enabled := AllowMultiSelect;
100
 
    ViewUnitDialog.mniMultiselect.Checked := CheckMultiSelect;
101
 
    ViewUnitDialog.ListBox.MultiSelect := ViewUnitDialog.mniMultiselect.Enabled;
102
 
    with ViewUnitDialog.ListBox.Items do begin
103
 
      BeginUpdate;
104
 
      Clear;
105
 
      for i:=0 to Entries.Count-1 do
106
 
        Add(TViewUnitsEntry(Entries.Objects[i]).Name);
107
 
      EndUpdate;
108
 
    end;
109
 
    for i:=0 to Entries.Count-1 do
110
 
      ViewUnitDialog.ListBox.Selected[i]:=TViewUnitsEntry(Entries.Objects[i]).Selected;
111
 
    Result:=ViewUnitDialog.ShowModal;
 
111
    Caption:=aCaption;
 
112
    mniMultiselect.Enabled := AllowMultiSelect;
 
113
    mniMultiselect.Checked := CheckMultiSelect;
 
114
    ListBox.MultiSelect := mniMultiselect.Enabled;
 
115
    if aImageIndex > -1 then FImageIndex:=aImageIndex; // otherwise FImageIndex will stay "0"
 
116
    // Data items
 
117
    for i:=0 to Entries.Count-1 do begin
 
118
      UEntry:=TViewUnitsEntry(Entries.Objects[i]);
 
119
      FilterEdit.Data.Add(UEntry.Name);
 
120
    end;
 
121
    FilterEdit.InvalidateFilter;
 
122
    // Initial selection
 
123
    for i:=0 to Entries.Count-1 do begin
 
124
      UEntry:=TViewUnitsEntry(Entries.Objects[i]);
 
125
      if UEntry.Selected then
 
126
        FilterEdit.SelectionList.Add(UEntry.Name);
 
127
    end;
 
128
    // Show the dialog
 
129
    Result:=ShowModal;
112
130
    if Result=mrOk then begin
 
131
      // Return new selections from the dialog
 
132
      FilterEdit.StoreSelection;
113
133
      for i:=0 to Entries.Count-1 do begin
114
 
        TViewUnitsEntry(Entries.Objects[i]).Selected:=ViewUnitDialog.ListBox.Selected[i];
 
134
        UEntry:=TViewUnitsEntry(Entries.Objects[i]);
 
135
        UEntry.Selected:=FilterEdit.SelectionList.IndexOf(UEntry.Name)>-1;
115
136
      end;
116
 
      CheckMultiSelect := ViewUnitDialog.mniMultiselect.Checked;
 
137
      CheckMultiSelect := mniMultiselect.Checked;
117
138
    end;
118
139
  finally
119
 
    ViewUnitDialog.Free;
 
140
    Free;
120
141
  end;
121
142
end;
122
143
 
123
 
function SearchItem(Items: TStrings; Text: String; StartIndex: Integer = -1): Integer;
 
144
function ShowViewUnitsDlg(Entries: TStringList; AllowMultiSelect: boolean;
 
145
  var CheckMultiSelect: Boolean; const aCaption: string;
 
146
  ItemType: TIDEProjectItem): TModalResult;
124
147
var
125
 
  i: integer;
 
148
  i: Integer;
126
149
begin
127
 
  // Items can be unsorted => use simple traverse
128
 
  Result := -1;
129
 
  Text := AnsiLowerCase(Text);
130
 
  for i := StartIndex +1 to Items.Count - 1 do
131
 
    if AnsiContainsText(Items[i], Text) then
132
 
    begin
133
 
      Result := i;
134
 
      break;
135
 
    end;
 
150
  case ItemType of
 
151
    piComponent: i := IDEImages.LoadImage(16, 'item_form');
 
152
    piFrame:    i := IDEImages.LoadImage(16, 'tpanel');
 
153
  else i:=IDEImages.LoadImage(16, 'item_unit');
 
154
  end;
 
155
  Result:=ShowViewUnitsDlg(Entries,AllowMultiSelect,CheckMultiSelect,aCaption,i);
136
156
end;
137
157
 
138
158
{ TViewUnitsEntry }
152
172
begin
153
173
  inherited Create(TheOwner);
154
174
  IDEDialogLayoutList.ApplyLayout(Self,450,300);
 
175
  //ActiveControl:=FilterEdit;
155
176
  mniMultiSelect.Caption := dlgMultiSelect;
156
 
 
157
 
  ButtonPanel.OKButton.Caption:=lisOk;
 
177
  ButtonPanel.OKButton.Caption:=lisMenuOk;
158
178
  ButtonPanel.HelpButton.Caption:=lisMenuHelp;
159
 
  ButtonPanel.CancelButton.Caption:=dlgCancel;
160
 
end;
161
 
 
162
 
Procedure TViewUnitDialog.OKButtonClick(Sender : TOBject);
 
179
  ButtonPanel.CancelButton.Caption:=lisCancel;
 
180
  SortAlphabeticallySpeedButton.Hint:=lisPESortFilesAlphabetically;
 
181
  SortAlphabeticallySpeedButton.LoadGlyphFromLazarusResource('pkg_sortalphabetically');
 
182
end;
 
183
 
 
184
procedure TViewUnitDialog.SortAlphabeticallySpeedButtonClick(Sender: TObject);
 
185
begin
 
186
  SortAlphabetically:=SortAlphabeticallySpeedButton.Down;
 
187
end;
 
188
 
 
189
procedure TViewUnitDialog.ListboxDrawItem(Control: TWinControl; Index: Integer;
 
190
  ARect: TRect; State: TOwnerDrawState);
 
191
begin
 
192
  if Index < 0 then Exit;
 
193
  with ListBox do
 
194
  begin
 
195
    Canvas.FillRect(ARect);
 
196
    IDEImages.Images_16.Draw(Canvas, 1, ARect.Top, FImageIndex);
 
197
    Canvas.TextRect(ARect, ARect.Left + 20, ARect.Top, Items[Index]);
 
198
  end;
 
199
end;
 
200
 
 
201
procedure TViewUnitDialog.OKButtonClick(Sender: TObject);
163
202
Begin
164
203
  IDEDialogLayoutList.SaveLayout(Self);
165
204
  ModalResult := mrOK;
167
206
 
168
207
procedure TViewUnitDialog.HelpButtonClick(Sender: TObject);
169
208
begin
170
 
  ShowContextHelpForIDE(Self);
171
 
end;
172
 
 
173
 
procedure TViewUnitDialog.mniSortClick(Sender: TObject);
174
 
var
175
 
  TmpList: TStringList;
176
 
  i: Integer;
177
 
  SelName: String;
178
 
begin
179
 
  TmpList := TStringList.Create;
180
 
  try
181
 
    TmpList.Assign(ListBox.Items);
182
 
    if ListBox.MultiSelect then
183
 
    begin
184
 
      for i := 0 to ListBox.Count -1 do
185
 
        if ListBox.Selected[i] then
186
 
          TmpList.Objects[i] := TObject(-1);
187
 
    end;
188
 
    TmpList.Sort;
189
 
    if ListBox.ItemIndex >= 0 then
190
 
      SelName := ListBox.Items[ListBox.ItemIndex]
191
 
    else
192
 
      SelName := '';
193
 
    ListBox.Items := TmpList;
194
 
    if SelName <> '' then
195
 
    begin
196
 
      ListBox.ItemIndex := TmpList.IndexOf(SelName);
197
 
      ListBox.MakeCurrentVisible;
198
 
    end;
199
 
    if ListBox.MultiSelect then
200
 
    begin
201
 
      ListBox.ClearSelection;
202
 
      for i := 0 to TmpList.Count -1 do
203
 
        if TmpList.Objects[i] <> nil then
204
 
          ListBox.Selected[i] := True;
205
 
    end;
206
 
  finally
207
 
    TmpList.Free;
208
 
  end;
209
 
end;
210
 
 
211
 
procedure TViewUnitDialog.EditKeyDown(Sender: TObject; var Key: Word;
212
 
  Shift: TShiftState);
213
 
  
214
 
  procedure MoveItemIndex(d: integer); inline;
215
 
  var
216
 
    NewIndex: Integer;
217
 
  begin
218
 
    NewIndex := Min(ListBox.Items.Count - 1, Max(0, ListBox.ItemIndex + D));
219
 
    ListBox.ItemIndex := NewIndex;
220
 
    ListBoxClick(nil);
221
 
  end;
222
 
 
223
 
  function PageCount: Integer;
224
 
  begin
225
 
    if ListBox.ItemHeight > 0 then
226
 
      Result := ListBox.Height div ListBox.ItemHeight
227
 
    else
228
 
      Result := 0;
229
 
  end;
230
 
  
231
 
begin
232
 
  case Key of
233
 
    VK_UP: MoveItemIndex(-1);
234
 
    VK_DOWN:
235
 
      begin
236
 
        MoveItemIndex(1);
237
 
        // Avoid switching to next control in TabOrder in gtk2
238
 
        Key := 0;
239
 
      end;
240
 
    VK_NEXT: MoveItemIndex(PageCount);
241
 
    VK_PRIOR: MoveItemIndex(-PageCount);
242
 
    VK_RETURN: OKButtonClick(nil);
243
 
    VK_RIGHT: SearchList(ListBox.ItemIndex);
244
 
  end;
245
 
end;
246
 
 
247
 
procedure TViewUnitDialog.EditChange(Sender: TObject);
248
 
begin
249
 
  // the change was initiated by the listbox,
250
 
  // so don't make any changes to the listbox
251
 
  if FBlockListBoxChange then exit;
252
 
  
253
 
  SearchList();
254
 
end;
255
 
 
256
 
procedure TViewUnitDialog.EditEnter(Sender: TObject);
257
 
begin
258
 
  FocusEdit;
259
 
end;
260
 
 
261
 
Procedure TViewUnitDialog.CancelButtonClick(Sender : TOBject);
 
209
  LazarusHelp.ShowHelpForIDEControl(Self);
 
210
end;
 
211
 
 
212
procedure TViewUnitDialog.CancelButtonClick(Sender: TObject);
262
213
Begin
263
214
  IDEDialogLayoutList.SaveLayout(Self);
264
215
  ModalResult := mrCancel;
265
216
end;
266
217
 
267
 
procedure TViewUnitDialog.ListboxClick(Sender: TObject);
268
 
begin
269
 
  FBlockListBoxChange := true;
270
 
  
271
 
  if ListBox.ItemIndex <> -1 then
272
 
    Edit.Text := ListBox.Items[ListBox.ItemIndex];
273
 
  
274
 
  FBlockListBoxChange := false;
275
 
end;
276
 
 
277
218
procedure TViewUnitDialog.ListboxKeyDown(Sender: TObject; var Key: Word;
278
219
  Shift: TShiftState);
279
220
begin
280
221
  if Key = VK_RETURN then
281
 
    OKButtonClick(nil);
 
222
    OKButtonClick(nil)
 
223
  // A hack to prevent 'O' working as shortcut for OK-button.
 
224
  // Should be removed when issue #20599 is resolved.
 
225
  else if (Key = VK_O) and (Shift = []) then
 
226
    Key:=VK_UNKNOWN;
282
227
end;
283
228
 
284
229
procedure TViewUnitDialog.MultiselectCheckBoxClick(Sender :TObject);
286
231
  ListBox.Multiselect := mniMultiSelect.Checked;
287
232
end;
288
233
 
289
 
procedure TViewUnitDialog.FocusEdit;
290
 
begin
291
 
  Edit.SelectAll;
292
 
  Edit.SetFocus;
293
 
end;
294
 
 
295
 
procedure TViewUnitDialog.SearchList(StartIndex: Integer);
296
 
var
297
 
  Index: Integer;
298
 
begin
299
 
  Index := SearchItem(ListBox.Items, Edit.Text, StartIndex);
300
 
  if Index >= 0 then
301
 
  begin
302
 
    ListBox.ItemIndex := Index;
303
 
    ListBox.MakeCurrentVisible;
304
 
    if ListBox.MultiSelect then
305
 
    begin
306
 
      ListBox.ClearSelection;
307
 
      ListBox.Selected[Index] := True;
308
 
    end;
309
 
  end;
 
234
procedure TViewUnitDialog.SetSortAlphabetically(const AValue: boolean);
 
235
begin
 
236
  if FSortAlphabetically=AValue then exit;
 
237
  FSortAlphabetically:=AValue;
 
238
  SortAlphabeticallySpeedButton.Down:=SortAlphabetically;
 
239
  FilterEdit.SortData:=SortAlphabetically;
 
240
  FilterEdit.InvalidateFilter;
310
241
end;
311
242
 
312
243
end.