lazarus/ide/restrictionbrowser.pas
mattias 26635ba63b IDE: clean up
git-svn-id: trunk@48204 -
2015-03-10 12:50:12 +00:00

214 lines
6.4 KiB
ObjectPascal

{
***************************************************************************
* *
* This source is free software; you can redistribute it and/or modify *
* it under the terms of the GNU General Public License as published by *
* the Free Software Foundation; either version 2 of the License, or *
* (at your option) any later version. *
* *
* This code is distributed in the hope that it will be useful, but *
* WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
* General Public License for more details. *
* *
* A copy of the GNU General Public License is available on the World *
* Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
* obtain it by writing to the Free Software Foundation, *
* Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
* *
***************************************************************************
Author: Tomas Gregorovic
Abstract:
Browser for widget set restricted properties.
}
unit RestrictionBrowser;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, InterfaceBase, LCLProc, Contnrs, Forms, Controls, Graphics,
Dialogs, StdCtrls, ComCtrls, TreeFilterEdit, ExtCtrls, Buttons,
IDEImagesIntf, ObjectInspector,
CompatibilityRestrictions, IDEOptionDefs, LazarusIDEStrConsts,
EnvironmentOpts, LazConf;
type
{ TRestrictionBrowserView }
TRestrictionBrowserView = class(TForm)
FilterEdit: TTreeFilterEdit;
IssueFilterGroupBox: TGroupBox;
IssueMemo: TMemo;
IssueTreeView: TTreeView;
NameLabel: TLabel;
Panel1: TPanel;
Splitter1: TSplitter;
procedure FormCreate(Sender: TObject);
procedure IssueTreeViewSelectionChanged(Sender: TObject);
procedure NameFilterEditChange(Sender: TObject);
private
FIssueList: TRestrictedList;
FClasses: TClassList;
procedure SelectFirstVisible(Sender: TObject);
procedure GetComponentClass(const AClass: TComponentClass);
procedure UpdateIssueList;
public
procedure SetIssueName(const AIssueName: String);
end;
var
RestrictionBrowserView: TRestrictionBrowserView = nil;
implementation
{$R *.lfm}
{ TRestrictionBrowserView }
procedure TRestrictionBrowserView.FormCreate(Sender: TObject);
var
P: TLCLPlatform;
X: Integer;
begin
FIssueList := GetRestrictedList;
Name := NonModalIDEWindowNames[nmiwIssueBrowser];
Caption := lisMenuViewRestrictionBrowser;
IssueFilterGroupBox.Caption := lisIssues;
NameLabel.Caption := lisCodeToolsDefsName;
IssueTreeView.Images := IDEImages.Images_16;
X := 10;
// create widget set filter buttons
for P := Low(TLCLPlatform) to High(TLCLPlatform) do
begin
with TSpeedButton.Create(Self) do
begin
Name := 'SpeedButton' + LCLPlatformDirNames[P];
Left := X;
Top := 4;
Width := 24;
Height := 24;
GroupIndex := Integer(P) + 1;
Down := True;
AllowAllUp := True;
try
IDEImages.Images_16.GetBitmap(
IDEImages.LoadImage(16, 'issue_'+LCLPlatformDirNames[P]), Glyph);
except
DebugLn('Restriction Browser: Unable to load image for ' + LCLPlatformDirNames[P] + '!');
end;
ShowHint := True;
Hint := LCLPlatformDisplayNames[P];
OnClick := @NameFilterEditChange;
Parent := IssueFilterGroupBox;
Inc(X, Width);
end;
end;
FilterEdit.OnAfterFilter := @SelectFirstVisible;
UpdateIssueList;
end;
procedure TRestrictionBrowserView.SelectFirstVisible(Sender: TObject);
var
nd: TTreeNode;
begin
nd := IssueTreeView.Items.GetFirstVisibleNode;
if Assigned(nd) then
IssueTreeView.Selected := nd
else
IssueMemo.Clear;
end;
procedure TRestrictionBrowserView.IssueTreeViewSelectionChanged(Sender: TObject);
var
Issue: TRestriction;
begin
if Assigned(IssueTreeView.Selected) then
begin
Issue := PRestriction(IssueTreeView.Selected.Data)^;
IssueMemo.Text := Issue.Short + LineEnding + LineEnding + Issue.Description;
end
else
IssueMemo.Clear;
end;
procedure TRestrictionBrowserView.NameFilterEditChange(Sender: TObject);
begin
UpdateIssueList;
end;
procedure TRestrictionBrowserView.GetComponentClass(const AClass: TComponentClass);
begin
FClasses.Add(AClass);
end;
procedure TRestrictionBrowserView.UpdateIssueList;
var
I, ID: PtrInt;
Issues: TStringList;
P: TLCLPlatform;
WidgetSetFilter: TLCLPlatforms;
Component: TComponent;
begin
WidgetSetFilter := [];
for P := Low(TLCLPlatform) to High(TLCLPlatform) do
begin
Component := FindComponent('SpeedButton' + LCLPlatformDirNames[P]);
Assert(Component is TSpeedButton, 'Component '+Component.Name+' is not TSpeedButton');
if (Component as TSpeedButton).Down then
Include(WidgetSetFilter, P);
end;
Issues := TStringList.Create;
try
for I := 0 to High(FIssueList) do
if FIssueList[I].WidgetSet in WidgetSetFilter then
Issues.AddObject(FIssueList[I].Name, TObject(I));
Issues.Sort;
IssueTreeView.BeginUpdate;
try
IssueTreeView.Items.Clear;
for I := 0 to Issues.Count - 1 do
begin
with IssueTreeView.Items.AddChild(nil, Issues[I]) do
begin
ID := PtrInt(Issues.Objects[I]);
ImageIndex := IDEImages.LoadImage(16,
'issue_'+LCLPlatformDirNames[FIssueList[ID].WidgetSet]);
StateIndex := ImageIndex;
SelectedIndex := ImageIndex;
Data := @FIssueList[ID];
end;
end;
finally
IssueTreeView.EndUpdate;
end;
finally
Issues.Free;
end;
FilterEdit.InvalidateFilter;
end;
procedure TRestrictionBrowserView.SetIssueName(const AIssueName: String);
var
P: TLCLPlatform;
Component: TComponent;
begin
FilterEdit.Text := AIssueName;
if AIssueName <> '' then
begin
for P := Low(TLCLPlatform) to High(TLCLPlatform) do
begin
Component := FindComponent('SpeedButton' + LCLPlatformDirNames[P]);
Assert(Component is TSpeedButton, 'Component '+Component.Name+' is not TSpeedButton');
(Component as TSpeedButton).Down := True;
end;
end;
UpdateIssueList;
end;
end.