Changeset 32 for trunk


Ignore:
Timestamp:
Nov 25, 2021, 11:32:55 AM (3 years ago)
Author:
chronos
Message:
  • Added: Bottom column filter bar in contacts list.
  • Added: Allow to sort columns in contacts list.
Location:
trunk
Files:
4 edited

Legend:

Unmodified
Added
Removed

  • trunk/Forms/UFormContact.pas

    r31 r32  
    182182      Photo := PhotoProperty.GetDecodedValue;
    183183      Stream := TMemoryStream.Create;
    184       Stream.Write(Photo[1], Length(Photo));
    185       Stream.Position := 0;
    186       JpegImage := TJPEGImage.Create;
    187       JpegImage.LoadFromStream(Stream);
    188       ImagePhoto.Picture.Bitmap.SetSize(JpegImage.Width, JpegImage.Height);
    189       ImagePhoto.Picture.Bitmap.Canvas.Draw(0, 0, JpegImage);
    190       JpegImage.Free;
    191       Stream.Free;
     184      try
     185        Stream.Write(Photo[1], Length(Photo));
     186        Stream.Position := 0;
     187        if PhotoProperty.Attributes.IndexOf('JPEG') <> -1 then begin
     188          JpegImage := TJPEGImage.Create;
     189          try
     190            JpegImage.LoadFromStream(Stream);
     191            ImagePhoto.Picture.Bitmap.SetSize(JpegImage.Width, JpegImage.Height);
     192            ImagePhoto.Picture.Bitmap.Canvas.Draw(0, 0, JpegImage);
     193          finally
     194            JpegImage.Free;
     195          end;
     196        end else begin
     197          ImagePhoto.Picture.Bitmap.LoadFromStream(Stream);
     198        end;
     199      finally
     200        Stream.Free;
     201      end;
    192202    end;
    193203  end;

  • trunk/Forms/UFormContacts.lfm

    r23 r32  
    1414  object ListView1: TListView
    1515    Left = 0
    16     Height = 869
     16    Height = 837
    1717    Top = 0
    1818    Width = 1210
    … …  
    8080    end
    8181  end
     82  object ListViewFilter1: TListViewFilter
     83    Left = 0
     84    Height = 32
     85    Top = 837
     86    Width = 1210
     87    OnChange = ListViewFilter1Change
     88    Align = alBottom
     89  end
    8290  object PopupMenuContact: TPopupMenu
    8391    Images = Core.ImageList1
    … …  
    125133    end
    126134  end
     135  object ListViewSort1: TListViewSort
     136    ListView = ListView1
     137    OnCompareItem = ListViewSort1CompareItem
     138    OnFilter = ListViewSort1Filter
     139    OnColumnWidthChanged = ListViewSort1ColumnWidthChanged
     140    Column = 0
     141    Order = soNone
     142    Left = 528
     143    Top = 428
     144  end
    127145end

  • trunk/Forms/UFormContacts.pas

    r31 r32  
    77uses
    88  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
    9   ComCtrls, Menus, ActnList, UContact;
     9  ComCtrls, Menus, ActnList, UContact, UListViewSort, fgl, LazUTF8;
    1010
    1111type
    … …  
    2020    ActionList1: TActionList;
    2121    ListView1: TListView;
     22    ListViewFilter1: TListViewFilter;
     23    ListViewSort1: TListViewSort;
    2224    MenuItem1: TMenuItem;
    2325    MenuItem2: TMenuItem;
    … …  
    4042    procedure ListView1SelectItem(Sender: TObject; Item: TListItem;
    4143      Selected: Boolean);
     44    procedure ListViewFilter1Change(Sender: TObject);
     45    procedure ListViewSort1ColumnWidthChanged(Sender: TObject);
     46    function ListViewSort1CompareItem(Item1, Item2: TObject): Integer;
     47    procedure ListViewSort1Filter(ListViewSort: TListViewSort);
    4248  private
    4349    FContacts: TContacts;
     50    procedure FilterList(List: TFPGObjectList<TObject>);
    4451    procedure SetContacts(AValue: TContacts);
    4552  public
    … …  
    6875procedure TFormContacts.ListView1Data(Sender: TObject; Item: TListItem);
    6976begin
    70   if Assigned(Contacts) and (Item.Index < Contacts.Count) then
    71   with TContact(Contacts[Item.Index]) do begin
     77  if Item.Index < ListViewSort1.List.Count then
     78  with TContact(ListViewSort1.List[Item.Index]) do begin
    7279    Item.Caption := Fields[cfFullName];
    7380    Item.SubItems.Add(Fields[cfFirstName]);
    … …  
    9198end;
    9299
     100procedure TFormContacts.ListViewFilter1Change(Sender: TObject);
     101begin
     102  ReloadList;
     103end;
     104
     105procedure TFormContacts.ListViewSort1ColumnWidthChanged(Sender: TObject);
     106begin
     107  ListViewFilter1.UpdateFromListView(ListView1);
     108end;
     109
     110function TFormContacts.ListViewSort1CompareItem(Item1, Item2: TObject): Integer;
     111begin
     112  Result := 0;
     113  if Assigned(Item1) and Assigned(Item2) and (ListViewSort1.Order <> soNone) then begin
     114    with ListViewSort1 do
     115    case Column of
     116      0: Result := CompareString(TContact(Item1).Fields[cfFullName], TContact(Item2).Fields[cfFullName]);
     117      1: Result := CompareString(TContact(Item1).Fields[cfFirstName], TContact(Item2).Fields[cfFirstName]);
     118      2: Result := CompareString(TContact(Item1).Fields[cfMiddleName], TContact(Item2).Fields[cfMiddleName]);
     119      3: Result := CompareString(TContact(Item1).Fields[cfLastName], TContact(Item2).Fields[cfLastName]);
     120      4: Result := CompareString(TContact(Item1).Fields[cfTelCell], TContact(Item2).Fields[cfTelCell]);
     121      5: Result := CompareString(TContact(Item1).Fields[cfTelHome], TContact(Item2).Fields[cfTelHome]);
     122    end;
     123    if ListViewSort1.Order = soDown then Result := -Result;
     124  end else Result := 0;
     125end;
     126
     127procedure TFormContacts.ListViewSort1Filter(ListViewSort: TListViewSort);
     128begin
     129  if Assigned(Contacts) then Contacts.AssignToList(ListViewSort1.List)
     130    else ListViewSort1.List.Clear;
     131  FilterList(ListViewSort1.List);
     132end;
     133
     134procedure TFormContacts.FilterList(List: TFPGObjectList<TObject>);
     135var
     136  I: Integer;
     137  FoundCount: Integer;
     138  EnteredCount: Integer;
     139begin
     140  EnteredCount := ListViewFilter1.TextEnteredCount;
     141  for I := List.Count - 1 downto 0 do begin
     142    if List.Items[I] is TContact then begin
     143      with TContact(List.Items[I]) do begin
     144         with ListViewFilter1 do
     145         if Visible and (EnteredCount > 0) then begin
     146           FoundCount := 0;
     147           if Pos(UTF8LowerCase(StringGrid.Cells[0, 0]),
     148             UTF8LowerCase(TContact(List.Items[I]).Fields[cfFullName])) > 0 then Inc(FoundCount);
     149           if Pos(UTF8LowerCase(StringGrid.Cells[1, 0]),
     150             UTF8LowerCase(TContact(List.Items[I]).Fields[cfFirstName])) > 0 then Inc(FoundCount);
     151           if Pos(UTF8LowerCase(StringGrid.Cells[2, 0]),
     152             UTF8LowerCase(TContact(List.Items[I]).Fields[cfMiddleName])) > 0 then Inc(FoundCount);
     153           if Pos(UTF8LowerCase(StringGrid.Cells[3, 0]),
     154             UTF8LowerCase(TContact(List.Items[I]).Fields[cfLastName])) > 0 then Inc(FoundCount);
     155           if Pos(UTF8LowerCase(StringGrid.Cells[4, 0]),
     156             UTF8LowerCase(TContact(List.Items[I]).Fields[cfTelCell])) > 0 then Inc(FoundCount);
     157           if Pos(UTF8LowerCase(StringGrid.Cells[5, 0]),
     158             UTF8LowerCase(TContact(List.Items[I]).Fields[cfTelHome])) > 0 then Inc(FoundCount);
     159           if FoundCount <> EnteredCount then List.Delete(I);
     160         end;
     161      end;
     162    end else
     163    if TContact(List.Items[I]) is TContact then begin
     164      List.Delete(I);
     165    end;
     166  end;
     167end;
     168
    93169procedure TFormContacts.SetContacts(AValue: TContacts);
    94170begin
    … …  
    106182  ReloadList;
    107183  UpdateInterface;
     184  ListViewFilter1.UpdateFromListView(ListView1);
    108185end;
    109186
    … …  
    182259procedure TFormContacts.ReloadList;
    183260begin
    184   if Assigned(Contacts) then
    185     ListView1.Items.Count := Contacts.Count
    186     else ListView1.Items.Count := 0;
    187   ListView1.Refresh;
     261  ListViewSort1.Refresh;
    188262end;
    189263

  • trunk/UContact.pas

    r31 r32  
    8787  TContacts = class(TFPGObjectList<TContact>)
    8888    ContactsFile: TContactsFile;
     89    procedure AssignToList(List: TFPGObjectList<TObject>);
    8990    function AddNew: TContact;
    9091    function Search(FullName: string): TContact;
    … …  
    185186procedure TContactProperty.EvaluateAttributes;
    186187begin
     188  if Attributes.IndexOf('BASE64') <> -1 then
     189    Encoding := 'BASE64'
     190  else
    187191  if Attributes.IndexOfName('ENCODING') <> -1 then
    188192    Encoding := Attributes.Values['ENCODING']
    189193    else Encoding := '';
     194
    190195  if Attributes.IndexOfName('CHARSET') <> -1 then
    191196    Charset := Attributes.Values['CHARSET']
    … …  
    245250
    246251{ TContacts }
     252
     253procedure TContacts.AssignToList(List: TFPGObjectList<TObject>);
     254var
     255  I: Integer;
     256begin
     257  List.Clear;
     258  for I := 0 to Count - 1 do
     259    List.Add(Items[I]);
     260end;
    247261
    248262function TContacts.AddNew: TContact;
    … …  
    419433    AddNew('TITLE', [], 'Title', cfTitle, dtString);
    420434    AddNew('CATEGORIES', [], 'Categories', cfCategories, dtString);
    421     AddNew('ORG', [], 'Organization', cfOrganization, dtString);
     435    AddNew('ORG', [], 'Organization', cfOrganization, dtString, 0);
     436    AddNew('ORG', [], 'Division', cfOrganization, dtString, 1);
    422437    AddNew('ADR', ['HOME'], 'Home Address', cfAdrHome, dtString);
    423438    AddNew('ADR', ['HOME'], 'Home Address Street', cfHomeAddressStreet, dtString, 1);
Note: See TracChangeset for help on using the changeset viewer.