From c74a9d112f38ded37c8f76808bd8ad80e107a553 Mon Sep 17 00:00:00 2001 From: graemeg Date: Fri, 27 Mar 2009 08:37:36 +0000 Subject: * Applied DragToReorder patch from David Emerson. * Minor changes to his patch by publishing the property when needed. * Updated the ListBox and ColorListBox demos to show the feature. --- examples/gui/colorlistbox/colorlistboxtest.lpi | 1 - examples/gui/colorlistbox/frmMain.pas | 29 ++++++++++++++++++-- examples/gui/listbox/frm_main.pas | 37 +++++++++++++++++++++----- examples/gui/listbox/listboxtest.lpi | 1 - src/gui/fpg_listbox.pas | 22 ++++++++++++++- 5 files changed, 79 insertions(+), 11 deletions(-) diff --git a/examples/gui/colorlistbox/colorlistboxtest.lpi b/examples/gui/colorlistbox/colorlistboxtest.lpi index 61d9d21e..b5129898 100644 --- a/examples/gui/colorlistbox/colorlistboxtest.lpi +++ b/examples/gui/colorlistbox/colorlistboxtest.lpi @@ -9,7 +9,6 @@ - </General> diff --git a/examples/gui/colorlistbox/frmMain.pas b/examples/gui/colorlistbox/frmMain.pas index 6903e1eb..0392be1d 100644 --- a/examples/gui/colorlistbox/frmMain.pas +++ b/examples/gui/colorlistbox/frmMain.pas @@ -14,6 +14,7 @@ type TMainForm = class(TfpgForm) private procedure chkColorNameChange(Sender: TObject); + procedure ckdReorderChanged(Sender: TObject); procedure cbName1Change(Sender: TObject); procedure btnName1Clicked(Sender: TObject); procedure SetBGColor(Sender: TObject); @@ -29,6 +30,7 @@ type btnName4: TfpgButton; lblName1: TfpgLabel; chkColorName: TfpgCheckBox; + chkReorder: TfpgCheckBox; {@VFD_HEAD_END: MainForm} procedure AfterCreate; override; end; @@ -49,6 +51,11 @@ begin lbColorPick.ShowColorNames := chkColorName.Checked; end; +procedure TMainForm.ckdReorderChanged(Sender: TObject); +begin + lbColorPick.DragToReorder := not lbColorPick.DragToReorder; +end; + procedure TMainForm.cbName1Change(Sender: TObject); begin if cbName1.Text = 'cpStandardColors' then @@ -94,6 +101,7 @@ begin Name := 'cbName1'; SetPosition(12, 36, 172, 22); FontDesc := '#List'; + TabOrder := 0; end; lblName4 := TfpgLabel.Create(self); @@ -102,6 +110,7 @@ begin Name := 'lblName4'; SetPosition(12, 16, 168, 16); FontDesc := '#Label1'; + Hint := ''; Text := 'Predefined Color Palettes'; end; @@ -109,9 +118,10 @@ begin with btnName1 do begin Name := 'btnName1'; - SetPosition(12, 180, 171, 24); + SetPosition(12, 192, 171, 24); Text := 'Set Form.Background'; FontDesc := '#Label1'; + Hint := ''; ImageName := ''; TabOrder := 7; OnClick := @btnName1Clicked; @@ -132,6 +142,7 @@ begin Text := ''; Embedded := True; FontDesc := '#Label1'; + Hint := ''; ImageName := ''; TabOrder := 9; BackgroundColor := clBlue; @@ -146,6 +157,7 @@ begin Text := ''; Embedded := True; FontDesc := '#Label1'; + Hint := ''; ImageName := ''; TabOrder := 10; BackgroundColor := clPurple; @@ -160,6 +172,7 @@ begin Text := ''; Embedded := True; FontDesc := '#Label1'; + Hint := ''; ImageName := ''; TabOrder := 11; BackgroundColor := clSteelBlue; @@ -172,6 +185,7 @@ begin Name := 'lblName1'; SetPosition(12, 76, 164, 16); FontDesc := '#Label1'; + Hint := ''; Text := 'Set FocusItem Color'; end; @@ -179,7 +193,7 @@ begin with chkColorName do begin Name := 'chkColorName'; - SetPosition(12, 140, 164, 20); + SetPosition(12, 140, 180, 20); Checked := True; FontDesc := '#Label1'; TabOrder := 8; @@ -187,6 +201,17 @@ begin OnChange := @chkColorNameChange; end; + chkReorder := TfpgCheckBox.Create(self); + with chkReorder do + begin + Name := 'chkReorder'; + SetPosition(12, 160, 180, 20); + FontDesc := '#Label1'; + TabOrder := 9; + Text := 'Drag to reorder'; + OnChange := @ckdReorderChanged; + end; + {@VFD_BODY_END: MainForm} PopulatePaletteColorCombo; diff --git a/examples/gui/listbox/frm_main.pas b/examples/gui/listbox/frm_main.pas index 38b06d92..1c858112 100644 --- a/examples/gui/listbox/frm_main.pas +++ b/examples/gui/listbox/frm_main.pas @@ -18,6 +18,7 @@ type TMainForm = class(TfpgForm) private procedure cbHotTrackChanged(Sender: TObject); + procedure ckhReorderChanged(Sender: TObject); procedure btnAdd1Clicked(Sender: TObject); procedure btnFocusClicked(Sender: TObject); procedure btnClearClicked(Sender: TObject); @@ -31,6 +32,7 @@ type btnAdd1: TfpgButton; memName1: TfpgMemo; cbHotTrack: TfpgCheckBox; + chkReorder: TfpgCheckBox; {@VFD_HEAD_END: MainForm} procedure AfterCreate; override; end; @@ -46,6 +48,11 @@ begin lstName1.HotTrack := cbHotTrack.Checked; end; +procedure TMainForm.ckhReorderChanged(Sender: TObject); +begin + lstName1.DragToReorder := not lstName1.DragToReorder; +end; + procedure TMainForm.btnAdd1Clicked(Sender: TObject); begin lstName1.Items.Add(Format('Item %2d', [lstName1.ItemCount])); @@ -82,17 +89,21 @@ begin with lstName1 do begin Name := 'lstName1'; - SetPosition(12, 12, 128, 168); + SetPosition(12, 12, 140, 168); FontDesc := '#List'; + HotTrack := False; + PopupFrame := False; + TabOrder := 0; end; btnAdd10 := TfpgButton.Create(self); with btnAdd10 do begin Name := 'btnAdd10'; - SetPosition(204, 28, 92, 23); + SetPosition(172, 28, 92, 23); Text := 'Add 10 items'; FontDesc := '#Label1'; + Hint := ''; ImageName := ''; TabOrder := 1; OnClick := @btnAdd10Clicked; @@ -102,9 +113,10 @@ begin with btnClear do begin Name := 'btnClear'; - SetPosition(204, 56, 92, 23); + SetPosition(172, 56, 92, 23); Text := 'Clear Items'; FontDesc := '#Label1'; + Hint := ''; ImageName := ''; TabOrder := 2; OnClick := @btnClearClicked; @@ -114,9 +126,10 @@ begin with btnFocus do begin Name := 'btnFocus'; - SetPosition(204, 84, 92, 23); + SetPosition(172, 84, 92, 23); Text := 'FocusItem = 2'; FontDesc := '#Label1'; + Hint := ''; ImageName := ''; TabOrder := 3; OnClick := @btnFocusClicked; @@ -126,9 +139,10 @@ begin with btnAdd1 do begin Name := 'btnAdd1'; - SetPosition(204, 112, 92, 23); + SetPosition(172, 112, 92, 23); Text := 'Add 1 item'; FontDesc := '#Label1'; + Hint := ''; ImageName := ''; TabOrder := 4; OnClick := @btnAdd1Clicked; @@ -147,13 +161,24 @@ begin with cbHotTrack do begin Name := 'cbHotTrack'; - SetPosition(204, 140, 120, 19); + SetPosition(172, 140, 120, 19); FontDesc := '#Label1'; TabOrder := 6; Text := 'Track Focus'; OnChange := @cbHotTrackChanged; end; + chkReorder := TfpgCheckBox.Create(self); + with chkReorder do + begin + Name := 'chkReorder'; + SetPosition(172, 160, 120, 20); + FontDesc := '#Label1'; + TabOrder := 7; + Text := 'Drag to reorder'; + OnChange := @ckhReorderChanged; + end; + {@VFD_BODY_END: MainForm} end; diff --git a/examples/gui/listbox/listboxtest.lpi b/examples/gui/listbox/listboxtest.lpi index c7b0b465..e745c4da 100644 --- a/examples/gui/listbox/listboxtest.lpi +++ b/examples/gui/listbox/listboxtest.lpi @@ -9,7 +9,6 @@ </Flags> <SessionStorage Value="InProjectDir"/> <MainUnit Value="0"/> - <IconPath Value="./"/> <TargetFileExt Value=""/> </General> <VersionInfo> diff --git a/src/gui/fpg_listbox.pas b/src/gui/fpg_listbox.pas index 8465987f..8e9af727 100644 --- a/src/gui/fpg_listbox.pas +++ b/src/gui/fpg_listbox.pas @@ -50,6 +50,7 @@ type TfpgBaseListBox = class(TfpgWidget) private FHotTrack: boolean; + FDragToReorder: boolean; FOnChange: TNotifyEvent; FOnScroll: TNotifyEvent; FOnSelect: TNotifyEvent; @@ -79,6 +80,7 @@ type procedure DrawItem(num: integer; rect: TfpgRect; flags: integer); virtual; procedure DoChange; procedure DoSelect; + procedure Exchange(Index1, Index2: Integer); virtual; abstract; procedure HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed : boolean); override; procedure HandleLMouseDown(x, y: integer; shiftstate: TShiftState); override; procedure HandleLMouseUp(x, y: integer; shiftstate: TShiftState); override; @@ -92,6 +94,7 @@ type property FontDesc: string read GetFontDesc write SetFontDesc; property HotTrack: boolean read FHotTrack write FHotTrack; property PopupFrame: boolean read FPopupFrame write SetPopupFrame; + property DragToReorder: boolean read FDragToReorder write FDragToReorder default False; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; @@ -115,6 +118,7 @@ type protected FItems: TStringList; procedure DrawItem(num: integer; rect: TfpgRect; flags: integer); override; + procedure Exchange(Index1, Index2: Integer); override; procedure HandleKeyChar(var AText: TfpgChar; var shiftstate: TShiftState; var consumed: boolean); override; property Items: TStringList read FItems; public @@ -130,6 +134,7 @@ type published property AutoHeight; property BackgroundColor default clListBox; + property DragToReorder; property FocusItem; property FontDesc; property HotTrack; @@ -169,6 +174,7 @@ type protected FItems: TList; procedure DrawItem(num: integer; rect: TfpgRect; flags: integer); override; + procedure Exchange(Index1, Index2: Integer); override; // procedure HandleKeyChar(var AText: TfpgChar; var shiftstate: TShiftState; var consumed: boolean); override; property Items: TList read FItems; property Color: TfpgColor read GetColor write SetColor; @@ -178,7 +184,6 @@ type constructor Create(AOwner: TComponent); override; destructor Destroy; override; function ItemCount: integer; override; - end; @@ -188,6 +193,7 @@ type property BackgroundColor default clListBox; property Color; property ColorPalette; + property DragToReorder; property FocusItem; property FontDesc; property HotTrack; @@ -555,6 +561,9 @@ begin if NewFocus < 0 then NewFocus := 0; + if FDragToReorder and FMouseDragging and (NewFocus<ItemCount) then + Exchange(FocusItem, NewFocus); + FocusItem := NewFocus; end; @@ -745,6 +754,7 @@ begin FPopupFrame := False; FHotTrack := False; FAutoHeight := False; + FDragToReorder := False; FScrollBar := TfpgScrollBar.Create(self); FScrollBar.Name := '_BaseListBoxScrollBar'; @@ -812,6 +822,11 @@ begin fpgStyle.DrawString(Canvas, rect.left+2, rect.top+1, FItems.Strings[num], Enabled); end; +procedure TfpgTextListBox.Exchange (Index1, Index2: Integer); +begin + Items.Exchange(Index1, Index2); +end; + procedure TfpgTextListBox.HandleKeyChar(var AText: TfpgChar; var shiftstate: TShiftState; var consumed: boolean); var @@ -1143,6 +1158,11 @@ begin fpgStyle.DrawString(Canvas, FColorboxWidth + 8 + rect.left, rect.top+1, itm.ColorName, Enabled); end; +procedure TfpgBaseColorListBox.Exchange (Index1, Index2: Integer); +begin + Items.Exchange(Index1, Index2); +end; + constructor TfpgBaseColorListBox.Create(AOwner: TComponent); begin inherited Create (AOwner ); -- cgit v1.2.3-70-g09d2