initial commit from lost SVN repo
This commit is contained in:
fatalerrors
293
spackgui/frmsearch.pas
Normal file
293
spackgui/frmsearch.pas
Normal file
@@ -0,0 +1,293 @@
|
||||
{
|
||||
********************************************************************************
|
||||
|
||||
SPackGui
|
||||
Copyright (C) 2012-2013 Geoffray Levasseur <geoffray.levasseurbrandin@numericable.fr>.
|
||||
Copyright (C) <date> <add your name and mail address here>
|
||||
|
||||
http://www.geoffray-levasseur.org/
|
||||
http://0.tuxfamilly.org/
|
||||
|
||||
This software is governed by the CeCILL license under French law and
|
||||
abiding by the rules of distribution of free software. You can use,
|
||||
modify and/ or redistribute the software under the terms of the CeCILL
|
||||
license as circulated by CEA, CNRS and INRIA at the following URL
|
||||
"http://www.cecill.info".
|
||||
|
||||
As a counterpart to the access to the source code and rights to copy,
|
||||
modify and redistribute granted by the license, users are provided only
|
||||
with a limited warranty and the software's author, the holder of the
|
||||
economic rights, and the successive licensors have only limited
|
||||
liability.
|
||||
|
||||
In this respect, the user's attention is drawn to the risks associated
|
||||
with loading, using, modifying and/or developing or reproducing the
|
||||
software by the user in light of its specific status of free software,
|
||||
that may mean that it is complicated to manipulate, and that also
|
||||
therefore means that it is reserved for developers and experienced
|
||||
professionals having in-depth computer knowledge. Users are therefore
|
||||
encouraged to load and test the software's suitability as regards their
|
||||
requirements in conditions enabling the security of their systems and/or
|
||||
data to be ensured and, more generally, to use and operate it in the
|
||||
same conditions as regards security.
|
||||
|
||||
The fact that you are presently reading this means that you have had
|
||||
knowledge of the CeCILL license and that you accept its terms.
|
||||
|
||||
********************************************************************************
|
||||
|
||||
Description:
|
||||
search dialog
|
||||
|
||||
}
|
||||
unit frmSearch;
|
||||
|
||||
{$mode objfpc}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
|
||||
Buttons, ComCtrls, uCommon, uSpackPackage;
|
||||
|
||||
type
|
||||
|
||||
{ TfSearch }
|
||||
|
||||
TfSearch = class(TForm)
|
||||
btnClose: TBitBtn;
|
||||
btnSearch: TBitBtn;
|
||||
btnRegExprHelp: TButton;
|
||||
cbxSearch: TComboBox;
|
||||
ckbToUpgrade: TCheckBox;
|
||||
ckbNotInstalle: TCheckBox;
|
||||
ckbInstalled: TCheckBox;
|
||||
ckbDescription: TCheckBox;
|
||||
ckbPackageName: TCheckBox;
|
||||
ckbWholeWord: TCheckBox;
|
||||
ckbCaseSensitive: TCheckBox;
|
||||
ckbRegExpr: TCheckBox;
|
||||
gbOptions: TGroupBox;
|
||||
gbWhere: TGroupBox;
|
||||
lbSearch: TLabel;
|
||||
procedure btnCloseClick(Sender: TObject);
|
||||
procedure btnRegExprHelpClick(Sender: TObject);
|
||||
procedure btnSearchClick(Sender: TObject);
|
||||
procedure cbxSearchChange(Sender: TObject);
|
||||
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure FormDestroy(Sender: TObject);
|
||||
procedure lvSearchResultChange(Sender: TObject; Item: TListItem; Change: TItemChange);
|
||||
procedure lvSearchResultColumnClick(Sender: TObject; Column: TListColumn);
|
||||
procedure lvSearchResultCompare(Sender: TObject; Item1, Item2: TListItem; Data: Integer; var Compare: Integer);
|
||||
private
|
||||
{ private declarations }
|
||||
FSearchTerms: TStringList;
|
||||
FLastSortedColumn: Integer;
|
||||
FAscending: Boolean;
|
||||
procedure ParseString(const Str: string);
|
||||
procedure SearchTerm(const Pkg: TSPackPackage);
|
||||
function TestField(const ASearch, AField: string): Boolean;
|
||||
public
|
||||
{ public declarations }
|
||||
end;
|
||||
|
||||
var
|
||||
fSearch: TfSearch;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
LCLType, uStrings, frmMain, uIconManager, uDebug;
|
||||
|
||||
{$R *.lfm}
|
||||
|
||||
{ TfSearch }
|
||||
|
||||
procedure TfSearch.ParseString(const Str: string);
|
||||
var
|
||||
I, N: Integer;
|
||||
InBrace: Boolean;
|
||||
begin
|
||||
if Length(Str) < 1 then
|
||||
Exit; //cannot parse an empty string
|
||||
FSearchTerms.Clear;
|
||||
N := FSearchTerms.Add('');
|
||||
InBrace := False;
|
||||
for I := 1 to Length(Str) do
|
||||
begin
|
||||
if (Str[I] = '"') and ckbRegExpr.Checked then
|
||||
begin
|
||||
InBrace := not InBrace;
|
||||
Continue;
|
||||
end;
|
||||
if (Str[I] = ' ') and (not InBrace) then
|
||||
if FSearchTerms[N] <> '' then //in case of several successive spaces
|
||||
N := FSearchTerms.Add('')
|
||||
else
|
||||
else
|
||||
FSearchTerms[N] := FSearchTerms[N] + Str[I];
|
||||
end;
|
||||
end;
|
||||
|
||||
function TfSearch.TestField(const ASearch, AField: string): Boolean;
|
||||
var
|
||||
N: Integer;
|
||||
begin
|
||||
N := Pos(ASearch, AField);
|
||||
if N <> 0 then
|
||||
begin //many if so begin is put to clarify even if it's not needed
|
||||
if ckbWholeWord.Checked then
|
||||
begin
|
||||
//we use if here as in those statement the second term is not evaluated
|
||||
//when the first one is set to false : we can't have a range check error
|
||||
//as the second test is done only if the first one return true
|
||||
//if we use Result := test1 and test2 both tests are alwais evaluated and
|
||||
//will result in range checking error in some cases (match at end or
|
||||
//beginning of a string)
|
||||
if (N + Length(ASearch) <= Length(AField)) and
|
||||
(AField[N + Length(ASearch)] <> ' ') then
|
||||
Result := False
|
||||
else
|
||||
if (N > 1) and (AField[N - 1] <> ' ') then
|
||||
Result := False
|
||||
else
|
||||
Result := True;
|
||||
end else
|
||||
Result := True;
|
||||
end else
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
procedure TfSearch.SearchTerm(const Pkg: TSPackPackage);
|
||||
begin
|
||||
//do it
|
||||
end;
|
||||
|
||||
procedure TfSearch.btnRegExprHelpClick(Sender: TObject);
|
||||
begin
|
||||
Application.MessageBox(PChar(rsRegExprHelp), PChar(rsHelp),
|
||||
MB_ICONINFORMATION + MB_OK);
|
||||
end;
|
||||
|
||||
procedure TfSearch.btnSearchClick(Sender: TObject);
|
||||
var
|
||||
I: integer;
|
||||
begin
|
||||
cbxSearch.Items.Add(cbxSearch.Text);
|
||||
if Trim(cbxSearch.Text) = '' then
|
||||
Exit;
|
||||
Cursor := crHourGlass;
|
||||
ParseString(Trim(cbxSearch.Text)); //put each term in a stringlist
|
||||
if ckbRegExpr.Checked and ((Trim(FSearchTerms[0])[1] in RegExprOperator) or
|
||||
(Trim(FSearchTerms[FSearchTerms.Count - 1])[1] in RegExprOperator)) then
|
||||
begin
|
||||
MessageDlg(rsErrorSearchSynthax, mtError, [MBOK], 0);
|
||||
Exit;
|
||||
end;
|
||||
try
|
||||
for I := 0 to fMain.PackageList.Count - 1 do
|
||||
begin
|
||||
Application.ProcessMessages;
|
||||
SearchTerm(fMain.PackageList.Packages[I]);
|
||||
end;
|
||||
//Sort(lvSearchResult, 0, False);
|
||||
finally
|
||||
Cursor := crArrow;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TfSearch.cbxSearchChange(Sender: TObject);
|
||||
begin
|
||||
btnSearch.Enabled := (ckbPackageName.Checked or ckbDescription.Checked) and
|
||||
(Trim(cbxSearch.Text) <> '');
|
||||
end;
|
||||
|
||||
procedure TfSearch.FormClose(Sender: TObject; var CloseAction: TCloseAction);
|
||||
var
|
||||
I: Integer;
|
||||
begin
|
||||
try
|
||||
SaveWindowGeometry(Self);
|
||||
IniWriteStrings(iniMain, Self.Name, rsConfNameFindHistory, cbxSearch.Items);
|
||||
except
|
||||
PrintLnDbg(rsErrorCannotSaveConf, vlLow);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TfSearch.FormCreate(Sender: TObject);
|
||||
begin
|
||||
FSearchTerms := TStringList.Create;
|
||||
btnSearch.Enabled := False;
|
||||
//next line is needed because of different metrics with fonts and/or widget sets
|
||||
{$IFDEF LCLGTK2 OR $IFDEF LCLGTK3}
|
||||
btnRegExprHelp.Left := ckbRegExpr.Left + ckbRegExpr.Width + 1;
|
||||
btnRegExprHelp.Top := ckbRegExpr.Top;
|
||||
btnRegExprHelp.Height := ckbRegExpr.Height;
|
||||
{$ENDIF}
|
||||
{$IFDEF LCLQT OR $IFDEF LCLQT5}
|
||||
btnRegExprHelp.Left := ckbRegExpr.Left + ckbRegExpr.Width + 21;
|
||||
btnRegExprHelp.Top := ckbRegExpr.Top + 1;
|
||||
btnRegExprHelp.Height := ckbRegExpr.Height + 1;
|
||||
{$ENDIF} //other widget sets not tested so left as designed
|
||||
btnRegExprHelp.Width := ckbRegExpr.Height;
|
||||
btnSearch.Tag := icSearch;
|
||||
btnClose.Tag := icClose;
|
||||
InitBtnGlyphs(Self);
|
||||
cbxSearch.Text := '';
|
||||
LoadWindowGeometry(Self);
|
||||
IniReadStrings(iniMain, Self.Name, rsConfNameFindHistory, cbxSearch.Items);
|
||||
ckbPackageName.Checked := True;
|
||||
ckbDescription.Checked := True;
|
||||
ckbInstalled.Checked := True;
|
||||
ckbNotInstalle.Checked := True;
|
||||
ckbToUpgrade.Checked := True;
|
||||
end;
|
||||
|
||||
procedure TfSearch.FormDestroy(Sender: TObject);
|
||||
begin
|
||||
try
|
||||
FSearchTerms.Free;
|
||||
finally
|
||||
inherited;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TfSearch.lvSearchResultChange(Sender: TObject; Item: TListItem; Change: TItemChange);
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure TfSearch.lvSearchResultColumnClick(Sender: TObject;
|
||||
Column: TListColumn);
|
||||
begin
|
||||
TListView(Sender).SortType := stNone;
|
||||
if Column.Index = FLastSortedColumn then
|
||||
FAscending := not FAscending
|
||||
else
|
||||
FLastSortedColumn := Column.Index;
|
||||
TListView(Sender).SortColumn := Column.Index;
|
||||
TListView(Sender).SortType := stData;
|
||||
end;
|
||||
|
||||
procedure TfSearch.lvSearchResultCompare(Sender: TObject;
|
||||
Item1, Item2: TListItem; Data: Integer; var Compare: Integer);
|
||||
begin
|
||||
case FLastSortedColumn of
|
||||
0: Compare := AnsiCompareText(Item1.Caption, Item2.Caption);
|
||||
1: Compare := CompareVersion(Item1.SubItems[0], Item2.SubItems[0]);
|
||||
2: Compare := CompareVersion(Item1.SubItems[1], Item2.SubItems[1]);
|
||||
3: Compare := fMain.CompareSize(Item1.SubItems[2], Item2.SubItems[2]);
|
||||
4: Compare := fMain.CompareSize(Item1.SubItems[3], Item2.SubItems[3]);
|
||||
5: Compare := AnsiCompareText(Item1.SubItems[4], Item2.SubItems[4]);
|
||||
end;
|
||||
if not FAscending then
|
||||
Compare := -Compare;
|
||||
end;
|
||||
|
||||
procedure TfSearch.btnCloseClick(Sender: TObject);
|
||||
begin
|
||||
Close;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
Reference in New Issue
Block a user