From 64721019859c52c10e0d2d5ad8e4ce56985088cd Mon Sep 17 00:00:00 2001 From: graemeg Date: Mon, 17 Sep 2007 14:02:43 +0000 Subject: * Experimental: started a implementation where the TfpgMemo can handle and render text containing Tab characters. * GUI: Implemented a new MRU (Most Recently Used) component. * Designer: Modifiend the designer to have a new MRU menu. * Designer: Extended the designer setup screen so the user can adjust more options. The designer also saves and restores those options. * Designer: The designer now defaults to saving the Name property of components as well. This might end up being a user selectable option in the setup screen. --- src/gui/fpgui_package.lpk | 14 ++- src/gui/fpgui_package.pas | 2 +- src/gui/gui_memo.pas | 61 ++++++++++- src/gui/gui_mru.pas | 273 ++++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 342 insertions(+), 8 deletions(-) create mode 100644 src/gui/gui_mru.pas (limited to 'src') diff --git a/src/gui/fpgui_package.lpk b/src/gui/fpgui_package.lpk index 45d475ca..901eacc9 100644 --- a/src/gui/fpgui_package.lpk +++ b/src/gui/fpgui_package.lpk @@ -26,7 +26,7 @@ - + @@ -119,15 +119,19 @@ + + + + - - - - + + + + diff --git a/src/gui/fpgui_package.pas b/src/gui/fpgui_package.pas index f9599fe7..662408ba 100644 --- a/src/gui/fpgui_package.pas +++ b/src/gui/fpgui_package.pas @@ -11,7 +11,7 @@ uses gui_listbox, gui_memo, gui_scrollbar, gui_bevel, gui_checkbox, gui_radiobutton, gui_trackbar, gui_tab, gui_basegrid, gui_listview, gui_customgrid, gui_progressbar, gui_menu, gui_style, gui_grid, gui_tree, - gui_iniutils; + gui_iniutils, gui_mru; implementation diff --git a/src/gui/gui_memo.pas b/src/gui/gui_memo.pas index b424a523..7339ab23 100644 --- a/src/gui/gui_memo.pas +++ b/src/gui/gui_memo.pas @@ -2,6 +2,12 @@ unit gui_memo; {$mode objfpc}{$H+} +{ + TODO: + * Started a implementation for Tab support. It is still very experimental + and should not be used yet. +} + interface uses @@ -36,6 +42,8 @@ type FDrawOffset: integer; FLineHeight: integer; FFirstLine: integer; + FTabWidth: integer; + FUseTabs: boolean; FVScrollBar: TfpgScrollBar; FHScrollBar: TfpgScrollBar; FWrapping: boolean; @@ -82,6 +90,8 @@ type property Text: string read GetText write SetText; property Font: TfpgFont read FFont; property OnChange: TNotifyEvent read FOnChange write FOnChange; + property UseTabs: boolean read FUseTabs write FUseTabs; + property TabWidth: integer read FTabWidth write FTabWidth; published property Lines: TStringList read FLines; property FontDesc: string read GetFontDesc write SetFontDesc; @@ -178,6 +188,8 @@ begin FWrapping := False; FOnChange := nil; FBackgroundColor := clBoxColor; + FUseTabs := False; + FTabWidth := 4; FLines := TStringList.Create; FFirstLine := 1; @@ -633,10 +645,12 @@ procedure TfpgMemo.HandlePaint; var n: integer; tw, tw2, st, len: integer; - yp: integer; + yp, xp: integer; ls: string; r: TfpgRect; selsl, selsp, selel, selep: integer; + c: integer; + s: string; begin Canvas.BeginDraw; Canvas.ClearClipRect; @@ -673,7 +687,27 @@ begin for n := FFirstline to LineCount do begin ls := GetLineText(n); - Canvas.DrawString(-FDrawOffset + FSideMargin, yp, ls); + if FUseTabs then + begin + xp := 0; + s := ''; + for c := 1 to Length(ls) do + begin + if ls[c] = #9 then + begin + if s <> '' then + Canvas.DrawString(-FDrawOffset + FSideMargin + xp, yp, s); + xp := xp + Canvas.Font.TextWidth(' ') * FTabWidth; + s := ''; + end + else + s := s + ls[c]; + end; + if s <> '' then + Canvas.DrawString(-FDrawOffset + FSideMargin + xp, yp, s); + end + else + Canvas.DrawString(-FDrawOffset + FSideMargin, yp, ls); if Focused then begin @@ -972,6 +1006,29 @@ begin end; hasChanged := True; end; + keyTab: + begin + if FUseTabs then + begin + ls := GetLineText(FCursorLine); +{ if FSelEndLine > 0 then + DeleteSelection + else} if FCursorPos < UTF8Length(ls) then + begin + Insert(#9, ls, FCursorPos); + SetLineText(FCursorLine, ls); + end; +{ + else if FCursorLine < LineCount then + begin + ls2 := FLines.Strings[FCursorLine]; + FLines.Delete(FCursorLine); + FLines.Strings[FCursorLine - 1] := ls + ls2; + end; +} + hasChanged := True; + end; + end; else consumed := False; end; diff --git a/src/gui/gui_mru.pas b/src/gui/gui_mru.pas new file mode 100644 index 00000000..353a2d03 --- /dev/null +++ b/src/gui/gui_mru.pas @@ -0,0 +1,273 @@ +{ + fpGUI - Free Pascal GUI Library + + Copyright (C) 2006 - 2007 See the file AUTHORS.txt, included in this + distribution, for details of the copyright. + + See the file COPYING.modifiedLGPL, included in this distribution, + for details about redistributing fpGUI. + + This program 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. + + Description: + A component implementing a 'Most Recently Used' feature normally + inserted in the File menu. +} + +unit gui_mru; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, gui_menu; + +type + + TMRUClickEvent = procedure(Sender: TObject; const FileName: String) of object; + + TfpgMRU = class(TComponent) + private + FItems: TStringList; + FMaxItems: cardinal; + FShowFullPath: boolean; + FParentMenuItem: TfpgPopupMenu; + FIniFilePath: string; + FOnClick: TMRUClickEvent; + procedure SetMaxItems(const AValue: cardinal); +// procedure SetIniFilePath(const AValue: string); + procedure SetParentMenuItem(const AValue: TfpgPopupMenu); + procedure SetShowFullPath(const AValue: boolean); + procedure SaveMRU; + procedure ItemsChange(Sender: TObject); + procedure ClearParentMenu; + protected + // this never gets called without a Form Streaming class, which fpGUI doesn't use + procedure Loaded; override; + procedure Notification(AComponent: TComponent; Operation: TOperation); override; + procedure DoClick(Sender: TObject); + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure AddItem(const FileName: string); + function RemoveItem(const FileName : string) : boolean; + procedure LoadMRU; + published + property MaxItems: cardinal read FMaxItems write SetMaxItems default 4; +// property IniFilePath: string read FIniFilePath write SetIniFilePath; + property ShowFullPath: boolean read FShowFullPath write SetShowFullPath default True; + property ParentMenuItem: TfpgPopupMenu read FParentMenuItem write SetParentMenuItem; + property OnClick: TMRUClickEvent read FOnClick write FOnClick; + end; + + +implementation + +uses + gui_iniutils; + +type + //to be able to recognize MRU menu item when deleting + TMRUMenuItem = class(TfpgMenuItem); + + +{ TfpgMRU } + +procedure TfpgMRU.SetMaxItems(const AValue: cardinal); +begin + if AValue <> FMaxItems then + begin + if AValue < 1 then FMaxItems := 1 + else + if AValue > MaxInt then + FMaxItems := MaxInt - 1 + else + begin + FMaxItems := AValue; + FItems.BeginUpdate; + try + while FItems.Count > MaxItems do + FItems.Delete(FItems.Count - 1); + finally + FItems.EndUpdate; + end; + end; + end; +end; + +{ +procedure TfpgMRU.SetIniFilePath(const AValue: string); +begin + if FIniFilePath=AValue then exit; + FIniFilePath:=AValue; +end; +} + +procedure TfpgMRU.SetParentMenuItem(const AValue: TfpgPopupMenu); +begin + if AValue = FParentMenuItem then + Exit; + FParentMenuItem := AValue; +end; + +procedure TfpgMRU.SetShowFullPath(const AValue: boolean); +begin + if FShowFullPath <> AValue then + begin + FShowFullPath := AValue; + ItemsChange(Self); + end; +end; + +procedure TfpgMRU.LoadMRU; +var + i: cardinal; +begin + FItems.BeginUpdate; + FItems.Clear; + try + for i := 1 to FMaxItems do + if gINI.ValueExists('MRU', 'MRU'+IntToStr(i)) then + FItems.Add(gINI.ReadString('MRU', 'MRU'+IntToStr(i), '')); + finally + FItems.EndUpdate; + end; +end; + +procedure TfpgMRU.SaveMRU; +var + i: integer; +begin + if FItems.Count = 0 then + Exit; + + //delete old mru + i := 1; + while gINI.ValueExists('MRU', 'MRU'+IntToStr(i)) do + begin + gINI.DeleteKey('MRU', 'MRU'+IntToStr(i)); + Inc(i); + end; + + //write new mru + for i := 0 to FItems.Count-1 do + gINI.WriteString('MRU', 'MRU'+IntToStr(i+1), FItems[i]); +end; + +procedure TfpgMRU.ItemsChange(Sender: TObject); +var + i: Integer; + NewMenuItem: TfpgMenuItem; + FileName: String; +begin +// writeln('TfpgMRU.ItemsChange'); + if ParentMenuItem <> nil then + begin + ClearParentMenu; + if FItems.Count = 0 then + ParentMenuItem.AddMenuItem('-', '', nil); // add something if we have no previous MRU's + for i := 0 to -1 + FItems.Count do + begin + if ShowFullPath then + FileName := StringReplace(FItems[I], '&', '&&', [rfReplaceAll, rfIgnoreCase]) + else + FileName := StringReplace(ExtractFileName(FItems[i]), '&', '&&', [rfReplaceAll, rfIgnoreCase]); + +// NewMenuItem := ParentMenuItem.AddMenuItem(Format('%s', [FileName]), '', @DoClick); +// NewMenuItem.Tag := i; + NewMenuItem := TMRUMenuItem.Create(ParentMenuItem); + NewMenuItem.Text := Format('%s', [FileName]); + NewMenuItem.Tag := i; + NewMenuItem.OnClick := @DoClick; + end; + end; +end; + +procedure TfpgMRU.ClearParentMenu; +//var +// i:integer; +begin + if Assigned(ParentMenuItem) then + ParentMenuItem.DestroyComponents; +{ + for i := ParentMenuItem.ComponentCount-1 downto 0 do + if ParentMenuItem.Components[i] is TMRUMenuItem then + ParentMenuItem.Delete(i); +} +end; + +procedure TfpgMRU.Loaded; +begin + inherited Loaded; + if not (csDesigning in ComponentState) then +// if FIniFilePath <> '' then + LoadMRU; +end; + +procedure TfpgMRU.Notification(AComponent: TComponent; Operation: TOperation); +begin + inherited Notification(AComponent, Operation); + if (Operation = opRemove) and (AComponent = FParentMenuItem) then + FParentMenuItem := nil; +end; + +procedure TfpgMRU.DoClick(Sender: TObject); +begin + if Assigned(FOnClick) and (Sender is TMRUMenuItem) then + FOnClick(Self, FItems[TMRUMenuItem(Sender).Tag]); +end; + +constructor TfpgMRU.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FParentMenuItem := nil; + FItems := TStringList.Create; + FItems.OnChange := @ItemsChange; + FMaxItems := 4; + FShowFullPath := True; +// Loaded; +end; + +destructor TfpgMRU.Destroy; +begin + if not (csDesigning in ComponentState) then + SaveMRU; + FItems.OnChange := nil; + FItems.Free; + inherited Destroy; +end; + +procedure TfpgMRU.AddItem(const FileName: string); +begin + if FileName <> '' then + begin + FItems.BeginUpdate; + try + if FItems.IndexOf(FileName) > -1 then + FItems.Delete(FItems.IndexOf(FileName)); + FItems.Insert(0, FileName); + + while FItems.Count > MaxItems do + FItems.Delete(MaxItems); + finally + FItems.EndUpdate; + end; + end; +end; + +function TfpgMRU.RemoveItem(const FileName: string): boolean; +begin + if FItems.IndexOf(FileName) > -1 then + begin + FItems.Delete(FItems.IndexOf(FileName)); + Result := True; + end + else + Result := False; +end; + +end. + -- cgit v1.2.3-70-g09d2