diff options
author | graemeg <graemeg@ae50a9b5-8222-0410-bf8d-8a13f76226bf> | 2008-09-27 21:30:19 +0000 |
---|---|---|
committer | graemeg <graemeg@ae50a9b5-8222-0410-bf8d-8a13f76226bf> | 2008-09-27 21:30:19 +0000 |
commit | ea69f79199e862e1d7f298202d9130415145cf31 (patch) | |
tree | e489739892486333c6015656720661a80bf07801 /src/gui/gui_editcombo.pas | |
parent | e662c3d0202fc23ded7b8ff81b6bc35e554de485 (diff) | |
download | fpGUI-ea69f79199e862e1d7f298202d9130415145cf31.tar.xz |
* Phase 2 of the unit rename is complete. The gui units have now been renamed.
* UI Designer has been updated to reflect the new gui unit names.
Diffstat (limited to 'src/gui/gui_editcombo.pas')
-rw-r--r-- | src/gui/gui_editcombo.pas | 776 |
1 files changed, 0 insertions, 776 deletions
diff --git a/src/gui/gui_editcombo.pas b/src/gui/gui_editcombo.pas deleted file mode 100644 index d8f182ef..00000000 --- a/src/gui/gui_editcombo.pas +++ /dev/null @@ -1,776 +0,0 @@ -{ - fpGUI - Free Pascal GUI Toolkit - - Copyright (C) 2006 - 2008 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: - Defines a edit ComboBox control with auto-complete feature. -} - -unit gui_editcombo; - -{$mode objfpc}{$H+} - -{.$Define DEBUG} - -{ - *********************************************************** - ********** This is still under development! *********** - *********************************************************** - - It needs lots of testing and debugging. -} - - -{ TODO: Needs a lot of refactoring to get rid of code duplication. } - -{ -This is an example of what we can aim for: -You need a mono font to see the correct layout. - - - TfpgBaseComboBox - _________|______________ - | | - TfpgBaseStaticCombo TfpgBaseEditCombo - ______|_________ | - | | TfpgEditCombo - | | - TfpgComboBox TfpgBaseColorCombo - | - TfpgColorComboBox -} - -interface - -uses - Classes, - SysUtils, - fpg_base, - fpg_main, - fpg_widget, - fpg_popupwindow, - gui_combobox; - -type - TAllowNew = (anNo, anYes, anAsk); - - - { TfpgBaseEditCombo } - - TfpgBaseEditCombo = class(TfpgBaseComboBox) - private - FAutoCompletion: Boolean; - FAllowNew: TAllowNew; - FText: string; - FSelectedItem: integer; - FMaxLength: integer; - FNewItem: boolean; - procedure SetAllowNew(const AValue: TAllowNew); - procedure InternalBtnClick(Sender: TObject); - procedure InternalListBoxSelect(Sender: TObject); - procedure InternalListBoxKeyPress(Sender: TObject; var keycode: word; var shiftstate: TShiftState; - var consumed: Boolean); - protected - FMargin: integer; - FDropDown: TfpgPopupWindow; - FDrawOffset: integer; - FSelStart: integer; - FSelOffset: integer; - FCursorPos: integer; - procedure DoDropDown; override; - function GetText: string; virtual; - function HasText: boolean; virtual; - procedure SetText(const AValue: string); virtual; - procedure HandleResize(AWidth, AHeight: TfpgCoord); override; - procedure HandleKeyChar(var AText: TfpgChar; var shiftstate: TShiftState; var consumed: Boolean); override; - 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; - procedure HandlePaint; override; - property AutoCompletion: Boolean read FAutocompletion write FAutoCompletion default False; - property AllowNew: TAllowNew read FAllowNew write SetAllowNew default anNo; - property BackgroundColor default clBoxColor; - property TextColor default clText1; - property Text: string read GetText write SetText; - public - constructor Create(AOwner: TComponent); override; - destructor Destroy; override; - procedure Update; - property NewText: boolean read FNewItem; - end; - - - TfpgEditCombo = class(TfpgBaseEditCombo) - published - property AutoCompletion; - property AllowNew; - property BackgroundColor; - property DropDownCount; - property FocusItem; - property FontDesc; - property Height; - property Items; - property Text; - property TextColor; - property Width; - property OnChange; - property OnCloseUp; - property OnDropDown; - property OnEnter; - property OnExit; - property OnKeyPress; - end; - - -function CreateEditCombo(AOwner: TComponent; x, y, w: TfpgCoord; AList:TStringList; ACompletion: boolean = False; - ANew: TAllowNew = anNo; h: TfpgCoord = 0): TfpgEditCombo; - - -implementation - -uses - fpg_stringutils, - fpg_constants, - gui_listbox, - gui_dialogs, - math; - -var - OriginalFocusRoot: TfpgWidget; - -type - { This is the class representing the dropdown window of the combo box. } - TDropDownWindow = class(TfpgPopupWindow) - private - FCallerWidget: TfpgWidget; - ListBox: TfpgListBox; - protected - procedure HandlePaint; override; - procedure HandleKeyChar(var AText: TfpgChar; var shiftstate: TShiftState; var consumed: Boolean); override; - procedure HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: boolean); override; - procedure HandleShow; override; - procedure HandleHide; override; - public - constructor Create(AOwner: TComponent); override; - property CallerWidget: TfpgWidget read FCallerWidget write FCallerWidget; - end; - - -{ TDropDownWindow } - -procedure TDropDownWindow.HandlePaint; -begin - Canvas.BeginDraw; -// inherited HandlePaint; - Canvas.Clear(clWhite); - Canvas.EndDraw; -end; - -procedure TDropDownWindow.HandleKeyChar(var AText: TfpgChar; - var shiftstate: TShiftState; var consumed: Boolean); -begin - if TfpgEditCombo(FCallerWidget).FAutoCompletion then - TfpgEditCombo(FCallerWidget).HandleKeyChar(AText,shiftstate,consumed); -end; - -procedure TDropDownWindow.HandleKeyPress(var keycode: word; - var shiftstate: TShiftState; var consumed: boolean); -begin - if TfpgEditCombo(FCallerWidget).FAutoCompletion then - begin - TfpgEditCombo(FCallerWidget).HandleKeyPress(keycode,shiftstate,consumed); -// consumed:= True; - end - else - begin - inherited HandleKeyPress(keycode, shiftstate, consumed); - if keycode = keyEscape then - begin - consumed := True; - Close; - end; - end; -end; - -procedure TDropDownWindow.HandleShow; -begin - ListBox.SetPosition(0, 0, Width, Height); - inherited HandleShow; - ActiveWidget := ListBox; -end; - -procedure TDropDownWindow.HandleHide; -begin - // HandleHide also gets called in TfpgWidget.Destroy so we need a few - // if Assigned() tests here. This should be improved on. -// if Assigned(FocusRootWidget) then -// FocusRootWidget.ReleaseMouse; // for internal ListBox - - if Assigned(CallerWidget) then - CallerWidget.SetFocus; - inherited HandleHide; -end; - -constructor TDropDownWindow.Create(AOwner: TComponent); -begin - inherited Create(AOwner); - ListBox := TfpgListBox.Create(self); - ListBox.PopupFrame := True; -end; - -function CreateEditCombo(AOwner: TComponent; x, y, w: TfpgCoord; AList:TStringList; ACompletion: boolean = False; - ANew: TAllowNew = anNo; h: TfpgCoord = 0): TfpgEditCombo; -begin - Result := TfpgEditCombo.Create(AOwner); - Result.Left := x; - Result.Top := y; - Result.Width := w; - Result.Focusable := True; - Result.AutoCompletion := ACompletion; - Result.AllowNew := ANew; - if h < TfpgEditCombo(Result).Font.Height + 6 then - Result.Height:= TfpgEditCombo(Result).Font.Height + 6 - else - Result.Height:= h; - - if Assigned(AList) then - Result.Items.Assign(AList); -end; - -{ TfpgBaseEditCombo } - -procedure TfpgBaseEditCombo.SetAllowNew(const AValue: TAllowNew); -begin - if FAllowNew <> AValue then - FAllowNew := AValue; -end; - -function TfpgBaseEditCombo.GetText: string; -var - i: integer; -begin - if FAutoCompletion then - Result := FText - else - if (FocusItem >= 0) and (FocusItem <= FItems.Count-1) then - Result := FItems.Strings[FocusItem] - else - Result := ''; -end; - -function TfpgBaseEditCombo.HasText: boolean; -begin - Result := FFocusItem >= 0; -end; - -procedure TfpgBaseEditCombo.DoDropDown; -var - ddw: TDropDownWindow; - rowcount, i: integer; - r: TfpgRect; -begin - if (not Assigned(FDropDown)) or (not FDropDown.HasHandle) then - begin - FreeAndNil(FDropDown); - OriginalFocusRoot := FocusRootWidget; - FDropDown := TDropDownWindow.Create(nil); - ddw := TDropDownWindow(FDropDown); - ddw.Width := Width; - ddw.CallerWidget := self; - ddw.ListBox.OnSelect := @InternalListBoxSelect; - ddw.ListBox.OnKeyPress := @InternalListBoxKeyPress; - - // Assign combobox text items to internal listbox - if FAutoCompletion then - begin - for i := 0 to FItems.Count-1 do - if SameText(UTF8Copy(FItems.Strings[i], 1, UTF8Length(FText)), FText) then - ddw.ListBox.Items.Add(FItems.Strings[i]); - end - else - ddw.ListBox.Items.Assign(FItems); - - // adjust the height of the dropdown - rowcount := ddw.ListBox.Items.Count; - if rowcount > DropDownCount then - rowcount := DropDownCount; - if rowcount < 1 then - rowcount := 1; - ddw.Height := (ddw.ListBox.RowHeight * rowcount) + 4; - ddw.ListBox.Height := ddw.Height; // needed in follow focus, otherwise, the default value (80) is used - - // set default focusitem - ddw.ListBox.FocusItem := FFocusItem; - - ddw.DontCloseWidget := self; // now we can control when the popup window closes - r := GetDropDownPos(Parent, self, ddw); - ddw.Height := r.Height; - - if (FItems.Count > 0) then - DoOnDropDown; - ddw.OnClose := @InternalOnClose; - - ddw.ShowAt(Parent, r.Left, r.Top); - end - else - begin - FBtnPressed := False; - ddw := TDropDownWindow(FDropDown); - ddw.Close; - FreeAndNil(FDropDown); - end; -end; - -procedure TfpgBaseEditCombo.InternalBtnClick(Sender: TObject); -begin - DoDropDown; -end; - -procedure TfpgBaseEditCombo.InternalListBoxSelect(Sender: TObject); -var - i: Integer; -begin - for i := 0 to Items.Count-1 do - begin - if Items[i]= TDropDownWindow(FDropDown).ListBox.Items[TDropDownWindow(FDropDown).ListBox.FocusItem] then - begin - FocusItem := i; - FSelectedItem:= i; - FText:= Items[i]; - Break; - end; - end; - FDropDown.Close; - //Repaint will check if Handle is created - Repaint; -end; - -procedure TfpgBaseEditCombo.InternalListBoxKeyPress(Sender: TObject; var keycode: word; - var shiftstate: TShiftState; var consumed: Boolean); -var - i: Integer; -begin - if ((keycode = keyUp) or (keycode = keyDown)) and (TDropDownWindow(FDropDown).ListBox.FocusItem > -1) then - for i := 0 to Items.Count-1 do - begin - if Items[i]= TDropDownWindow(FDropDown).ListBox.Items[TDropDownWindow(FDropDown).ListBox.FocusItem] then - begin - FSelectedItem:= i; - Break; - end; - end; - - //Repaint will check if Handle is created - Repaint; -end; - -procedure TfpgBaseEditCombo.SetText(const AValue: string); -var - i: integer; -begin - if AValue = '' then - begin - FText:= ''; - FocusItem := -1; // nothing selected - end - else - begin - for i := 0 to Items.Count-1 do - begin - if SameText(UTF8Copy(Items.Strings[i], 1, UTF8Length(AVAlue)), AValue) then - begin - FocusItem := i; - FText:= AValue; - Repaint; - Exit; //==> - end; - end; - // if we get here, we didn't find a match - FocusItem := -1; - end; -end; - -procedure TfpgBaseEditCombo.HandleResize(AWidth, AHeight: TfpgCoord); -begin - inherited HandleResize(AWidth, AHeight); - if FSizeIsDirty then - CalculateInternalButtonRect; -end; - -procedure TfpgBaseEditCombo.HandleKeyChar(var AText: TfpgChar; - var shiftstate: TShiftState; var consumed: Boolean); -var - s: TfpgChar; - prevval: string; - i: integer; -begin - prevval := FText; - s := AText; - consumed := False; - if FText = '' then - FNewItem := False; - - // Handle only printable characters - // Note: This is now UTF-8 compliant! - if Enabled and (Ord(AText[1]) > 31) and (Ord(AText[1]) < 127) or (Length(AText) > 1) then - begin - if (FMaxLength <= 0) or (UTF8Length(FText) < FMaxLength) then - begin - UTF8Insert(s, FText, FCursorPos + UTF8Length(s)); - Inc(FCursorPos); - FSelStart := FCursorPos; - if Assigned(FDropDown) then - FDropDown.Close; - FSelectedItem := -1; - for i := 0 to FItems.Count-1 do - if SameText(UTF8Copy(FItems.Strings[i], 1, UTF8Length(FText)), FText) then - begin - FSelectedItem:= i; - DoDropDown; - Break; - end; - if FSelectedItem = -1 then - if FAllowNew = anNo then - begin - UTF8Delete(FText, FCursorPos, 1); - Dec(FCursorPos); - FSelStart := FCursorPos; - for i := 0 to FItems.Count-1 do - if SameText(UTF8Copy(FItems.Strings[i], 1, UTF8Length(FText)), FText) then - begin - FSelectedItem:= i; - DoDropDown; - Break; - end; - end - else - FNewItem:= True; - end; - consumed := True; - end; - - if prevval <> FText then - DoOnChange; - - if consumed then - RePaint; -// else - inherited HandleKeyChar(AText, shiftstate, consumed); -end; - -procedure TfpgBaseEditCombo.HandleKeyPress(var keycode: word; - var shiftstate: TShiftState; var consumed: boolean); -var - hasChanged: boolean; - i: integer; -begin - hasChanged := False; - - if not Enabled then - consumed := False - else - begin - consumed := True; - - case keycode of - keyBackSpace: - begin - if FCursorPos > 0 then - begin - UTF8Delete(FText, FCursorPos, 1); - Dec(FCursorPos); - FSelStart := FCursorPos; - if Assigned(FDropDown) then - FDropDown.Close; - FSelectedItem := -1; - for i := 0 to FItems.Count-1 do - if SameText(UTF8Copy(FItems.Strings[i], 1, UTF8Length(FText)), FText) then - begin - FSelectedItem:= i; - if FNewItem then - FNewItem:= False; - DoDropDown; - Break; - end; - hasChanged := True; - end; - end; - keyDelete: - begin - if FAllowNew <> anNo then - begin - FocusItem := -1; - FSelectedItem := -1; - FNewItem:= True; - hasChanged := True; - end; - end; - - keyReturn, - keyPEnter: - begin - if FSelectedItem > -1 then - SetText(Items[FSelectedItem]) - else - FocusItem:= -1; - if FNewItem then - case FAllowNew of - anYes: - FItems.Add(FText); - anAsk: - begin - if TfpgMessageDialog.Question(rsNewItemDetected, Format(rsAddNewItem, [FText])) = mbYes then - begin - FItems.Add(FText); - FocusItem := Pred(FItems.Count); - end - else - begin - FNewItem:= False; - FocusItem := -1; - FText:= ''; - end; { if/else } - Parent.ActivateWindow; - end; - end; - hasChanged := True; - if Assigned(FDropDown) then - FDropDown.Close; - end; - else - begin - Consumed := False; - end; - end; - end; - - if Consumed then - begin - FSelStart := FCursorPos; - FSelOffset := 0; - end; - - if consumed and hasChanged then - RePaint; - - if hasChanged then - DoOnChange; - inherited HandleKeyPress(keycode, shiftstate, consumed); -end; - -procedure TfpgBaseEditCombo.HandleLMouseDown(x, y: integer; - shiftstate: TShiftState); -begin - inherited HandleLMouseDown(x, y, shiftstate); - // button state is down only if user clicked in the button rectangle. - FBtnPressed := PtInRect(FInternalBtnRect, Point(x, y)); - if not FAutoCompletion then - begin - PaintInternalButton; - DoDropDown; - end - else if FBtnPressed then - begin - PaintInternalButton; - DoDropDown; - end; -end; - -procedure TfpgBaseEditCombo.HandleLMouseUp(x, y: integer; - shiftstate: TShiftState); -begin - inherited HandleLMouseUp(x, y, shiftstate); - FBtnPressed := False; - PaintInternalButton; -end; - -procedure TfpgBaseEditCombo.HandlePaint; -var - r: TfpgRect; - tw, tw2, st, len: integer; - Texte: string; - - // paint selection rectangle - procedure DrawSelection; - var - lcolor: TfpgColor; - begin - if Focused then - begin - lcolor := clSelection; - Canvas.SetTextColor(clSelectionText); - end - else - begin - lcolor := clInactiveSel; - Canvas.SetTextColor(clText1); - end; - - len := FSelOffset; - st := FSelStart; - if len < 0 then - begin - st := st + len; - len := -len; - end; - tw := Font.TextWidth(UTF8Copy(Items[FSelectedItem], 1, st)); - tw2 := Font.TextWidth(UTF8Copy(Items[FSelectedItem], 1, st + len)); - - // XOR on Anti-aliased text doesn't look to good. Lets try standard - // Blue & White like what was doen in TfpgEdit. -{ Canvas.SetColor(lcolor); - Canvas.FillRectangle(-FDrawOffset + FMargin + tw, 3, tw2 - tw, Font.Height); - r.SetRect(-FDrawOffset + FMargin + tw, 3, tw2 - tw, Font.Height); - Canvas.AddClipRect(r); - Canvas.SetTextColor(clWhite); - fpgStyle.DrawString(Canvas, -FDrawOffset + FMargin, 3, Text, Enabled); - Canvas.ClearClipRect; -} - Canvas.XORFillRectangle(fpgColorToRGB(lcolor) xor $FFFFFF, - -FDrawOffset + FMargin + tw, 3, tw2 - tw, Font.Height); - end; - -begin - Canvas.BeginDraw; -// inherited HandlePaint; - Canvas.ClearClipRect; - r.SetRect(0, 0, Width, Height); - Canvas.DrawControlFrame(r); - - // internal background rectangle (without frame) - InflateRect(r, -2, -2); - Canvas.SetClipRect(r); - - if Enabled then - Canvas.SetColor(FBackgroundColor) - else - Canvas.SetColor(clWindowBackground); - - Canvas.FillRectangle(r); - - // paint the fake dropdown button - PaintInternalButton; - - Dec(r.Width, FInternalBtnRect.Width); - Canvas.SetClipRect(r); - Canvas.SetFont(Font); - - if not AutoCompletion then - if Focused then - begin - Canvas.SetColor(clSelection); - Canvas.SetTextColor(clSelectionText); - InflateRect(r, -1, -1); - end - else - begin - if Enabled then - Canvas.SetColor(FBackgroundColor) - else - Canvas.SetColor(clWindowBackground); - Canvas.SetTextColor(FTextColor); - end - else - begin - if Enabled then - Canvas.SetColor(FBackgroundColor) - else - Canvas.SetColor(clWindowBackground); - Canvas.SetTextColor(FTextColor); - end; - Canvas.FillRectangle(r); - - // Draw select item's text - if not AutoCompletion then - begin - if HasText then - fpgStyle.DrawString(Canvas, FMargin+1, FMargin, Text, Enabled); - end - else - begin - if HasText then - begin - FSelOffset := 0; - fpgStyle.DrawString(Canvas, FMargin+1, FMargin, Text, Enabled); - end - else - begin - Texte := Text; - if Texte <> '' then - if FSelectedItem > -1 then - begin - FSelOffset := Font.TextWidth(UTF8Copy(Items[FSelectedItem], UTF8Length(FText) + 1, - UTF8Length(Items[FSelectedItem]) - UTF8Length(FText))); - fpgStyle.DrawString(Canvas, FMargin+1, FMargin, FText + UTF8Copy(Items[FSelectedItem], - UTF8Length(FText) + 1, UTF8Length(Items[FSelectedItem]) - UTF8Length(FText)), Enabled); - end - else - begin - FSelOffset := 0; - fpgStyle.DrawString(Canvas, FMargin+1, FMargin, FText, Enabled); - end; - end; - - if Focused then - begin - // drawing selection - if FSelOffset <> 0 then - DrawSelection; - - // drawing cursor - FCursorPos:= UTF8Length(FText); - tw := Font.TextWidth(UTF8Copy(FText, 1, FCursorPos)); - fpgCaret.SetCaret(Canvas, -FDrawOffset + FMargin + tw, 3, fpgCaret.Width, Font.Height); - end - else - fpgCaret.UnSetCaret(Canvas); - end; - - Canvas.EndDraw; -end; - -constructor TfpgBaseEditCombo.Create(AOwner: TComponent); -begin - inherited Create(AOwner); - FBackgroundColor := clBoxColor; - FTextColor := Parent.TextColor; - FWidth := 120; - FHeight := Font.Height + 6; - FMargin := 3; - FFocusable := True; - FAutocompletion := False; - FAllowNew := anNo; - - FText := ''; - FCursorPos := UTF8Length(FText); - FSelStart := FCursorPos; - FSelOffset := 0; - FDrawOffset := 0; - FSelectedItem := -1; // to allow typing if list is empty - FNewItem := False; - - CalculateInternalButtonRect; -end; - -destructor TfpgBaseEditCombo.Destroy; -begin - FDropDown.Free; - inherited Destroy; -end; - -procedure TfpgBaseEditCombo.Update; -begin - FFocusItem := -1; - Repaint; -end; - -end. |