* Implemented a new fpgGetNamedFontList() function

* Enabled Font Collections support in the Font Select Dialog. Currently only
  the All Fonts and Alias Fonts collections are active.
* TfpgMemo now has a custom internal StringList that will notify the memo of
  text changes.
* Made many code improvements to gui_listbox unit. Lots of redundant code 
  was removed.
* Fixed a bug in gui_listbox where the OnChange event did not fire for all
  instances of FocusItem changing.
* Fixed a bug in gui_listbox KeyPress event where it did not take into 
  account that FocusItem is 1-based.

4 files changed, 271 insertions, 130 deletions

diff --git a/src/corelib/fpgfx.pas b/src/corelib/fpgfx.pas
index 8447e5f4..e9da7422 100644
--- a/src/corelib/fpgfx.pas
+++ b/src/corelib/fpgfx.pas
@@ -271,12 +271,13 @@ procedure fpgDeliverMessages;
 function  fpgGetFirstMessage: PfpgMessageRec;
 procedure fpgDeleteFirstMessage;
 
-// Color routines
+// Color & Font routines
 function  fpgColorToRGB(col: TfpgColor): TfpgColor;
 function  fpgGetNamedColor(col: TfpgColor): TfpgColor;
 procedure fpgSetNamedColor(colorid, rgbvalue: longword);
 function  fpgGetNamedFontDesc(afontid: string): string;
 procedure fpgSetNamedFont(afontid, afontdesc: string);
+function  fpgGetNamedFontList: TStringlist;
 
 // Timers rountines
 procedure fpgInitTimers;
@@ -668,6 +669,23 @@ begin
     fpgNamedFonts.Add(TNamedFontItem.Create(afontid, afontdesc));
 end;
 
+function fpgGetNamedFontList: TStringlist;
+var
+  n: integer;
+  oFont: TNamedFontItem;
+begin
+  if fpgNamedFonts.Count > 0 then
+    Result := TStringList.Create
+  else
+    Exit; //==>
+  
+  for n := 0 to fpgNamedFonts.Count-1 do
+  begin
+    oFont := TNamedFontItem(fpgNamedFonts[n]);
+    Result.Add(Format('#%s=%s', [oFont.FontID, oFont.FontDesc]));
+  end;
+end;
+
 procedure fpgWaitWindowMessage;
 begin
   fpgApplication.WaitWindowMessage(0);
diff --git a/src/gui/gui_dialogs.pas b/src/gui/gui_dialogs.pas
index 3c4bc214..2e50b963 100644
--- a/src/gui/gui_dialogs.pas
+++ b/src/gui/gui_dialogs.pas
@@ -45,7 +45,8 @@ uses
   gui_edit,
   gui_grid,
   gui_combobox,
-  gui_bevel;
+  gui_bevel,
+  gui_memo;
 
 type
   TfpgMsgDlgType = (mtAbout, mtWarning, mtError, mtInformation, mtConfirmation,
@@ -108,9 +109,10 @@ type
   TfpgFontSelectDialog = class(TfpgBaseDialog)
   private
     FSampleText: string;
+    FMode: Byte;    // 1 - Normal Fonts;  2 - Alias Fonts
     lblLabel1: TfpgLabel;
-    lblLabel2: TfpgLabel;
-    lblLabel3: TfpgLabel;
+    lblTypeface: TfpgLabel;
+    lblSize: TfpgLabel;
     lblLabel4: TfpgLabel;
     lblLabel5: TfpgLabel;
     lbCollection: TfpgListBox;
@@ -120,9 +122,12 @@ type
     cbItalic: TfpgCheckBox;
     cbUnderline: TfpgCheckBox;
     cbAntiAlias: TfpgCheckBox;
-    edSample: TfpgEdit;
+    memSample: TfpgMemo;
+    procedure   OnCollectionChanged(Sender: TObject);
     procedure   OnParamChange(Sender: TObject);
     procedure   CreateFontList;
+    procedure   CreateFontAliasList;
+    procedure   SetupUI(AMode: Byte);
   protected
     function    GetFontDesc: string;
     procedure   SetFontDesc(Desc: string);
@@ -320,7 +325,7 @@ begin
   Result := False;
   frm := TfpgFontSelectDialog.Create(nil);
   frm.SetFontDesc(FontDesc);
-  if frm.ShowModal > 0 then
+  if frm.ShowModal = 1 then
   begin
     FontDesc := frm.GetFontDesc;
     Result := True;
@@ -471,13 +476,31 @@ end;
 
 { TfpgFontSelectDialog }
 
+procedure TfpgFontSelectDialog.OnCollectionChanged(Sender: TObject);
+begin
+  if lbCollection.Text = rsCollectionFontAliases then
+  begin
+    CreateFontAliasList;
+    SetupUI(2);
+  end
+  else
+  begin
+    CreateFontList;
+    SetupUI(1);
+  end;
+  OnParamChange(nil);
+end;
+
 procedure TfpgFontSelectDialog.OnParamChange(Sender: TObject);
 var
   fdesc: string;
 begin
   fdesc := GetFontDesc;
   {$IFDEF DEBUG} Writeln(fdesc); {$ENDIF}
-  edSample.FontDesc := fdesc;
+  memSample.FontDesc := fdesc;
+  memSample.Text := FSampleText;
+  if FMode = 2 then
+    memSample.Lines.Add(fpgGetNamedFontDesc(UTF8Copy(fdesc, 2, UTF8Length(fdesc)-1)));
 end;
 
 procedure TfpgFontSelectDialog.CreateFontList;
@@ -488,30 +511,75 @@ begin
   lbFaces.Items.Clear;
   fl := fpgApplication.GetFontFaceList;
   for i := 0 to fl.Count-1 do
-    lbFaces.Items.Add(fl.Strings[i]);
+    lbFaces.Items.Add(fl[i]);
   fl.Free;
+  lbFaces.FocusItem := 1;
 end;
 
-function TfpgFontSelectDialog.GetFontDesc: string;
+procedure TfpgFontSelectDialog.CreateFontAliasList;
 var
-  s: string;
+  fl: TStringList;
+  i: integer;
 begin
-  s := lbFaces.Text + '-' + lbSize.Text;
-  // Do NOT localize these!
-  if cbBold.Checked then
-    s := s + ':bold';
+  lbFaces.Items.Clear;
+  fl := fpgGetNamedFontList;
+  for i := 0 to fl.Count-1 do
+    lbFaces.Items.Add(fl.Names[i]);
+  fl.Free;
+  lbFaces.FocusItem := 1
+end;
 
-  if cbItalic.Checked then
-    s := s + ':italic';
+procedure TfpgFontSelectDialog.SetupUI(AMode: Byte);
+begin
+  FMode := AMode;
+  case FMode of
+    1:  // Normal Fonts
+      begin
+        lblSize.Enabled := True;
+        lblTypeFace.Enabled := True;
+        lbSize.Enabled := True;
+        cbBold.Enabled := True;
+        cbItalic.Enabled := True;
+        cbUnderline.Enabled := True;
+        cbAntiAlias.Enabled := True;
+      end;
+    2:  // Font Aliases
+      begin
+        lblSize.Enabled := False;
+        lblTypeFace.Enabled := False;
+        lbSize.Enabled := False;
+        cbBold.Enabled := False;
+        cbItalic.Enabled := False;
+        cbUnderline.Enabled := False;
+        cbAntiAlias.Enabled := False;
+      end;
+  end;
+end;
 
-  if cbAntiAlias.Checked then
-    s := s + ':antialias=true'
+function TfpgFontSelectDialog.GetFontDesc: string;
+var
+  s: string;
+begin
+  if FMode = 2 then
+    s := lbFaces.Text
   else
-    s := s + ':antialias=false';
+  begin
+    s := lbFaces.Text + '-' + lbSize.Text;
+    // Do NOT localize these!
+    if cbBold.Checked then
+      s := s + ':bold';
+
+    if cbItalic.Checked then
+      s := s + ':italic';
 
-  if cbUnderline.Checked then
-    s := s + ':underline';
+    if cbAntiAlias.Checked then
+      s := s + ':antialias=true'
+    else
+      s := s + ':antialias=false';
 
+    if cbUnderline.Checked then
+      s := s + ':underline';
+  end;
   result := s;
 end;
 
@@ -543,11 +611,38 @@ var
       NextC;
     end;
   end;
+  
+  procedure ProcessAliasFont;
+  var
+    i: integer;
+  begin
+    lbCollection.FocusItem := lbCollection.ItemCount;
+    for i := 1 to lbFaces.ItemCount do
+    begin
+      if SameText(lbFaces.Items[i-1], Desc) then
+      begin
+        lbFaces.FocusItem := i;
+        Exit; //==>
+      end;
+    end;
+  end;
 
 begin
   cp := 1;
   c  := Desc[1];
 
+  if Desc[1] = '#' then
+    FMode := 2
+  else
+    FMode := 1;
+  SetupUI(FMode);
+
+  if FMode = 2 then
+  begin
+    ProcessAliasFont;
+    Exit; //==>
+  end;
+
   cbBold.Checked      := False;
   cbItalic.Checked    := False;
   cbUnderline.Checked := False;
@@ -613,13 +708,13 @@ end;
 constructor TfpgFontSelectDialog.Create(AOwner: TComponent);
 begin
   inherited Create(AOwner);
-  {TODO: We need to localize this dialog }
   WindowTitle := rsSelectAFont;
   Width       := 600;
   MinWidth    := Width;
   MinHeight   := Height;
   FSampleText := 'The quick brown fox jumps over the lazy dog. 0123456789 [oO0,ilLI]';
-
+  FMode       := 1; // normal fonts
+  
   btnCancel.Left := Width - FDefaultButtonWidth - FSpacing;
   btnOK.Left     := btnCancel.Left - FDefaultButtonWidth - FSpacing;
 
@@ -634,6 +729,7 @@ begin
   lbCollection := TfpgListBox.Create(self);
   with lbCollection do
   begin
+    Name := 'lbCollection';
     SetPosition(8, 28, 145, 236);
     Items.Add(rsCollectionAllFonts);
     // These should be stored in <users config path>/fpgui directory
@@ -644,9 +740,9 @@ begin
     Items.Add(rsCollectionSans);
     Items.Add(rsCollectionSerif);
     Items.Add(rsCollectionFontAliases);
-//    OnChange := @OnParamChange;
     FocusItem := 1;
-    Enabled := False;
+    OnChange := @OnCollectionChanged;
+//    Enabled := False;
   end;
 
   lblLabel1 := TfpgLabel.Create(self);
@@ -659,14 +755,16 @@ begin
   lbFaces := TfpgListBox.Create(self);
   with lbFaces do
   begin
+    Name := 'lbFaces';
     SetPosition(161, 28, 232, 236);
     Items.Add(' ');
     OnChange := @OnParamChange;
   end;
 
-  lblLabel3 := TfpgLabel.Create(self);
-  with lblLabel3 do
+  lblSize := TfpgLabel.Create(self);
+  with lblSize do
   begin
+    Name := 'lblSize';
     SetPosition(401, 8, 54, 16);
     Text := fpgAddColon(rsSize);
   end;
@@ -674,6 +772,7 @@ begin
   lbSize := TfpgListBox.Create(self);
   with lbSize do
   begin
+    Name := 'lbSize';
     SetPosition(401, 28, 52, 236);
     { We need to improve this! }
     Items.Add('6');
@@ -696,12 +795,12 @@ begin
     Items.Add('64');
     Items.Add('72');
     OnChange  := @OnParamChange;
-    FocusItem := 5;
   end;
 
-  lblLabel2 := TfpgLabel.Create(self);
-  with lblLabel2 do
+  lblTypeface := TfpgLabel.Create(self);
+  with lblTypeface do
   begin
+    Name := 'lblTypeface';
     SetPosition(461, 8, 54, 16);
     Text := fpgAddColon(rsTypeface);
   end;
@@ -746,8 +845,8 @@ begin
     Text := fpgAddColon(rsExampleText);
   end;
 
-  edSample := TfpgEdit.Create(self);
-  with edSample do
+  memSample := TfpgMemo.Create(self);
+  with memSample do
   begin
     SetPosition(8, 288, 584, 65);
     Text := FSampleText;
@@ -765,7 +864,7 @@ begin
     Exit; //==>
     
   FSampleText := AText;
-  edSample.Text := FSampleText;
+  memSample.Text := FSampleText;
 end;
 
 
diff --git a/src/gui/gui_listbox.pas b/src/gui/gui_listbox.pas
index 3b48f999..e85629dc 100644
--- a/src/gui/gui_listbox.pas
+++ b/src/gui/gui_listbox.pas
@@ -149,6 +149,7 @@ type
     destructor  Destroy; override;
     function    Add(const s: String): Integer; override;
     procedure   Delete(Index: Integer); override;
+    procedure   Clear; override;
   end;
 
 
@@ -197,6 +198,12 @@ begin
     ListBox.UpdateScrollBar;
 end;
 
+procedure TfpgListBoxStrings.Clear;
+begin
+  inherited Clear;
+  ListBox.FocusItem := 0;
+end;
+
 
 { TfpgBaseListBox }
 
@@ -206,13 +213,31 @@ begin
 end;
 
 procedure TfpgBaseListBox.SetFocusItem(const AValue: integer);
+var
+  old: integer;
 begin
   if FFocusItem = AValue then
     Exit; //==>
-  FFocusItem := AValue;
+
+  old := FFocusItem;
+  // do some sanity checks
+  if AValue < 0 then  // zero is a valid focusitem (no selection)
+    FFocusItem := 1
+  else if AValue > ItemCount then
+    FFocusItem := ItemCount
+  else
+    FFocusItem := AValue;
+    
+  if FFocusItem = old then
+    Exit; //==>
+    
+  if FFocusItem <= 1 then
+    FFirstItem := 1;
+
   FollowFocus;
   UpdateScrollbar;
   RePaint;
+  DoChange;
 end;
 
 procedure TfpgBaseListBox.SetFontDesc(const AValue: string);
@@ -337,13 +362,16 @@ end;
 
 procedure TfpgBaseListBox.DoChange;
 begin
-  if Assigned(FOnChange) then
+  {$IFDEF DEBUG}
+  writeln(Name + '.OnChange assigned');
+  {$ENDIF}
+  if Assigned(OnChange) then
     FOnChange(self);
 end;
 
 procedure TfpgBaseListBox.DoSelect;
 begin
-  if Assigned(FOnSelect) then
+  if Assigned(OnSelect) then
     FOnSelect(self);
 end;
 
@@ -354,66 +382,42 @@ begin
 
   case keycode of
     keyUp:
-           begin
-             if FFocusItem > 1 then
-             begin
-               dec(FFocusItem);
-               FollowFocus;
-               RePaint;
-               DoChange;
-             end;
-           end;
+        begin
+          if FFocusItem > 1 then
+            FocusItem := FFocusItem - 1;
+        end;
            
     keyDown:
-           begin
-             if FFocusItem < ItemCount then
-             begin
-               inc(FFocusItem);
-               FollowFocus;
-               RePaint;
-               DoChange;
-             end;
-           end;
+        begin
+          if FFocusItem < ItemCount then
+            FocusItem := FFocusItem + 1;
+        end;
 
     keyPageUp:
-           begin
-             dec(FFocusItem,PageLength);
-             if FFocusItem < 1 then FFocusItem := 1;
-             FollowFocus;
-             RePaint;
-             DoChange;
-           end;
+        begin
+          FocusItem := FFocusItem - PageLength;
+        end;
 
     keyPageDown:
-           begin
-             inc(FFocusItem,PageLength);
-             if FFocusItem > ItemCount then FFocusItem := ItemCount;
-             FollowFocus;
-             RePaint;
-             DoChange;
-           end;
+        begin
+          FocusItem := FFocusItem + PageLength;
+        end;
 
     keyHome:
-           begin
-             FFocusItem := 1;
-             FollowFocus;
-             RePaint;
-             DoChange;
-           end;
+        begin
+          FocusItem := 1;
+        end;
 
     keyEnd:
-           begin
-             FFocusItem := ItemCount;
-             FollowFocus;
-             RePaint;
-             DoChange;
-           end;
+        begin
+          FocusItem := ItemCount;
+        end;
 
     keyReturn:
-           begin
-             DoSelect;
-             consumed := false; // to allow the forms to detect it
-           end;
+        begin
+          DoSelect;
+          consumed := false; // to allow the forms to detect it
+        end;
   else
     begin
       consumed := false;
@@ -429,14 +433,8 @@ begin
   if ItemCount < 1 then
     Exit; //==>
     
-  FFocusItem := FFirstItem + Trunc((y - FMargin) / RowHeight);
-  if FFocusItem > ItemCount then
-    FFocusItem := ItemCount;
-
-  FollowFocus;
-  FMouseDragging := true;
-  Repaint;
-  DoChange;
+  FocusItem := FFirstItem + Trunc((y - FMargin) / RowHeight);
+  FMouseDragging := True;
 end;
 
 procedure TfpgBaseListBox.HandleLMouseUp(x, y: integer; shiftstate: TShiftState);
@@ -449,16 +447,10 @@ begin
     Exit; //==>
     
   FMouseDragging := False;
-
-  FollowFocus;
-  Repaint;
-  DoChange;
   DoSelect;
 end;
 
 procedure TfpgBaseListBox.HandleMouseMove(x, y: integer; btnstate: word; shiftstate: TShiftState);
-var
-  oldf: integer;
 begin
   inherited HandleMouseMove(x, y, btnstate, shiftstate);
 
@@ -468,17 +460,7 @@ begin
   if ((not FMouseDragging) or (btnstate and 1 = 0)) and (not HotTrack) then
     Exit; //==>
 
-  oldf := FFocusItem;
-
-  FFocusItem := FFirstItem + Trunc((y - FMargin) / RowHeight);
-  if FFocusItem > ItemCount then
-    FFocusItem := ItemCount;
-
-  if oldf <> FFocusItem then
-  begin
-    FollowFocus;
-    Repaint;
-  end;
+  FocusItem := FFirstItem + Trunc((y - FMargin) / RowHeight);
 end;
 
 procedure TfpgBaseListBox.HandleMouseScroll(x, y: integer; shiftstate: TShiftState; delta: smallint);
@@ -618,12 +600,8 @@ begin
   FBackgroundColor    := clListBox;
   FTextColor          := Parent.TextColor;
 
-  FScrollBar          := TfpgScrollBar.Create(self);
-  FScrollBar.OnScroll := @ScrollBarMove;
-//  FScrollBar.Visible  := False;
-
   FFocusable      := True;
-  FFocusItem      := 1;
+  FFocusItem      := 0;
   FFirstItem      := 1;
   FWidth          := 80;
   FHeight         := 80;
@@ -633,6 +611,9 @@ begin
   FHotTrack       := False;
   FAutoHeight     := False;
 
+  FScrollBar          := TfpgScrollBar.Create(self);
+  FScrollBar.OnScroll := @ScrollBarMove;
+
   FOnChange := nil;
   FOnSelect := nil;
   FOnScroll := nil;
@@ -689,18 +670,15 @@ begin
   // if user press a key then it will search the stringlist for a word
   // beginning with such as letter
   if (Ord(AText[1]) > 31) and (Ord(AText[1]) < 127) or (Length(AText) > 1 ) then
-    for i := FFocusItem to FItems.Count - 1 do
+    for i := FFocusItem to FItems.Count do
     begin
-      if SameText(LeftStr(FItems.Strings[i], Length(AText)), AText) then
+      if SameText(LeftStr(FItems.Strings[i-1], Length(AText)), AText) then
       begin
-        FFocusItem := i + 1;
-        FollowFocus;
-        RePaint;
-        DoChange;
+        FocusItem := i;
         Consumed := True;
         break;
       end;
-    end;
+    end;  { for }
   inherited HandleKeyChar(AText, shiftstate, consumed);
 end;
 
@@ -724,8 +702,8 @@ end;
 
 function TfpgTextListBox.Text: string;
 begin
-  if (FocusItem > 0) and (FocusItem <= FItems.Count) then
-    result := FItems.Strings[FocusItem-1]
+  if (ItemCount > 0) and (FocusItem <> 0) then
+    result := FItems[FocusItem-1]
   else
     result := '';
 end;
diff --git a/src/gui/gui_memo.pas b/src/gui/gui_memo.pas
index 99fa6211..6b0a3559 100644
--- a/src/gui/gui_memo.pas
+++ b/src/gui/gui_memo.pas
@@ -19,11 +19,7 @@ unit gui_memo;
 
 {$mode objfpc}{$H+}
 
-{
-  TODO:
-    * Started a implementation for Tab support. It is still very experimental
-      and should not be used yet.
-}
+  { TODO : Started a implementation for Tab support. It is still very experimental and should not be used yet. }
 
 interface
 
@@ -125,6 +121,56 @@ implementation
 
 uses
   gfx_UTF8utils;
+  
+  
+type
+  // custom stringlist that will notify the memo of item changes
+  TfpgMemoStrings = class(TStringList)
+  protected
+    Memo: TfpgMemo;
+  public
+    constructor Create(AMemo: TfpgMemo); reintroduce;
+    destructor  Destroy; override;
+    function    Add(const s: String): Integer; override;
+    procedure   Delete(Index: Integer); override;
+    procedure   Clear; override;
+  end;
+
+{ TfpgMemoStrings }
+
+constructor TfpgMemoStrings.Create(AMemo: TfpgMemo);
+begin
+  inherited Create;
+  Memo := AMemo;
+end;
+
+destructor TfpgMemoStrings.Destroy;
+begin
+  Memo := nil;
+  inherited Destroy;
+end;
+
+function TfpgMemoStrings.Add(const s: String): Integer;
+begin
+  Result := inherited Add(s);
+  if Assigned(Memo) and (Memo.HasHandle) then
+    Memo.Invalidate;
+end;
+
+procedure TfpgMemoStrings.Delete(Index: Integer);
+begin
+  inherited Delete(Index);
+  if Assigned(Memo) and (Memo.HasHandle) then
+    Memo.Invalidate;
+end;
+
+procedure TfpgMemoStrings.Clear;
+begin
+  inherited Clear;
+  if Assigned(Memo) and (Memo.HasHandle) then
+    Memo.Invalidate;
+end;
+
 
 { TfpgMemo }
 
@@ -227,7 +273,7 @@ begin
   FUseTabs    := False;
   FTabWidth   := 4;
 
-  FLines      := TStringList.Create;
+  FLines      := TfpgMemoStrings.Create(self);
   FFirstLine  := 1;
   FCursorLine := 1;
 
@@ -254,7 +300,7 @@ end;
 
 destructor TfpgMemo.Destroy;
 begin
-  FLines.Free;
+  TfpgMemoStrings(FLines).Free;
   FFont.Free;
   inherited Destroy;
 end;