diff options
Diffstat (limited to 'src/gui')
33 files changed, 1866 insertions, 514 deletions
diff --git a/src/gui/colordialog.inc b/src/gui/colordialog.inc index 6914257e..93d8d731 100644 --- a/src/gui/colordialog.inc +++ b/src/gui/colordialog.inc @@ -25,10 +25,10 @@ type TfpgColorSelectDialog = class(TfpgBaseDialog) private {@VFD_HEAD_BEGIN: ColorSelectDialog} - PageControl1: TfpgPageControl; - TabSheet1: TfpgTabSheet; - TabSheet2: TfpgTabSheet; - ComboBox1: TfpgComboBox; + pcColorSelect: TfpgPageControl; + tsColorWheel: TfpgTabSheet; + tsColorNames: TfpgTabSheet; + cbColorPalette: TfpgComboBox; ColorListBox1: TfpgColorListBox; Label1: TfpgLabel; Label2: TfpgLabel; @@ -43,11 +43,13 @@ type pnlColorPreview: TfpgBevel; {@VFD_HEAD_END: ColorSelectDialog} FViaRGB: Boolean; // to prevent recursive changes - function GetSelectedColor: TfpgColor; - procedure SetSelectedColor(const AValue: TfpgColor); - procedure ColorChanged(Sender: TObject); - procedure RGBChanged(Sender: TObject); - procedure UpdateRGBComponents; + function GetSelectedColor: TfpgColor; + procedure SetSelectedColor(const AValue: TfpgColor); + procedure ColorChanged(Sender: TObject); + procedure RGBChanged(Sender: TObject); + procedure UpdateRGBComponents; + procedure PopulatePaletteColorCombo; + procedure cbColorPaletteChange(Sender: TObject); public constructor Create(AOwner: TComponent); override; procedure AfterCreate; override; @@ -71,7 +73,7 @@ begin try frm.ColorWheel.SetSelectedColor(APresetColor); if frm.ShowModal = mrOK then - Result := frm.ValueBar.SelectedColor; + Result := frm.SelectedColor; finally frm.Free; end; @@ -81,12 +83,15 @@ end; function TfpgColorSelectDialog.GetSelectedColor: TfpgColor; begin - // + if pcColorSelect.ActivePageIndex = 0 then + Result := ValueBar.SelectedColor + else + Result := ColorListBox1.Color; end; procedure TfpgColorSelectDialog.SetSelectedColor(const AValue: TfpgColor); begin - // + ColorWheel.SetSelectedColor(AValue); end; procedure TfpgColorSelectDialog.ColorChanged(Sender: TObject); @@ -123,6 +128,27 @@ begin edB.Value := rgb.Blue; end; +procedure TfpgColorSelectDialog.PopulatePaletteColorCombo; +begin + cbColorPalette.Items.Clear; + cbColorPalette.Items.Add('cpStandardColors'); + cbColorPalette.Items.Add('cpSystemColors'); + cbColorPalette.Items.Add('cpWebColors'); + cbColorPalette.FocusItem := 0; + cbColorPalette.OnChange := @cbColorPaletteChange; +end; + +procedure TfpgColorSelectDialog.cbColorPaletteChange(Sender: TObject); +begin + if cbColorPalette.Text = 'cpStandardColors' then + ColorListBox1.ColorPalette := cpStandardColors + else if cbColorPalette.Text = 'cpSystemColors' then + ColorListBox1.ColorPalette := cpSystemColors + else + ColorListBox1.ColorPalette := cpWebColors; + ColorListBox1.SetFocus; +end; + constructor TfpgColorSelectDialog.Create(AOwner: TComponent); begin inherited Create(AOwner); @@ -135,15 +161,15 @@ begin {%region 'Auto-generated GUI code' -fold} {@VFD_BODY_BEGIN: ColorSelectDialog} Name := 'ColorSelectDialog'; - SetPosition(316, 186, 328, 375); + SetPosition(340, 164, 328, 375); WindowTitle := 'Color Select Dialog'; Hint := ''; WindowPosition := wpOneThirdDown; - PageControl1 := TfpgPageControl.Create(self); - with PageControl1 do + pcColorSelect := TfpgPageControl.Create(self); + with pcColorSelect do begin - Name := 'PageControl1'; + Name := 'pcColorSelect'; SetPosition(4, 4, 320, 332); Anchors := [anLeft,anRight,anTop,anBottom]; ActivePageIndex := 0; @@ -151,26 +177,26 @@ begin TabOrder := 1; end; - TabSheet1 := TfpgTabSheet.Create(PageControl1); - with TabSheet1 do + tsColorWheel := TfpgTabSheet.Create(pcColorSelect); + with tsColorWheel do begin - Name := 'TabSheet1'; + Name := 'tsColorWheel'; SetPosition(3, 24, 314, 305); Text := 'Color Wheel'; end; - TabSheet2 := TfpgTabSheet.Create(PageControl1); - with TabSheet2 do + tsColorNames := TfpgTabSheet.Create(pcColorSelect); + with tsColorNames do begin - Name := 'TabSheet2'; + Name := 'tsColorNames'; SetPosition(3, 24, 314, 305); Text := 'Predefined'; end; - ComboBox1 := TfpgComboBox.Create(TabSheet2); - with ComboBox1 do + cbColorPalette := TfpgComboBox.Create(tsColorNames); + with cbColorPalette do begin - Name := 'ComboBox1'; + Name := 'cbColorPalette'; SetPosition(8, 24, 299, 22); Anchors := [anLeft,anRight,anTop]; FontDesc := '#List'; @@ -178,21 +204,19 @@ begin TabOrder := 1; end; - ColorListBox1 := TfpgColorListBox.Create(TabSheet2); + ColorListBox1 := TfpgColorListBox.Create(tsColorNames); with ColorListBox1 do begin Name := 'ColorListBox1'; SetPosition(8, 72, 299, 224); Anchors := [anLeft,anRight,anTop,anBottom]; - ColorPalette := cpStandardColors; + Color := TfpgColor($00FFFF); FontDesc := '#List'; Hint := ''; - HotTrack := False; - PopupFrame := False; TabOrder := 2; end; - Label1 := TfpgLabel.Create(TabSheet2); + Label1 := TfpgLabel.Create(tsColorNames); with Label1 do begin Name := 'Label1'; @@ -202,7 +226,7 @@ begin Text := 'Select a color palette'; end; - Label2 := TfpgLabel.Create(TabSheet2); + Label2 := TfpgLabel.Create(tsColorNames); with Label2 do begin Name := 'Label2'; @@ -212,22 +236,23 @@ begin Text := 'Available colors:'; end; - ColorWheel := TfpgColorWheel.Create(TabSheet1); + ColorWheel := TfpgColorWheel.Create(tsColorWheel); with ColorWheel do begin Name := 'ColorWheel'; SetPosition(8, 8, 204, 204); end; - ValueBar := TfpgValueBar.Create(TabSheet1); + ValueBar := TfpgValueBar.Create(tsColorWheel); with ValueBar do begin Name := 'ValueBar'; SetPosition(240, 8, 64, 204); + Value := 1; OnChange := @ColorChanged; end; - edR := TfpgSpinEdit.Create(TabSheet1); + edR := TfpgSpinEdit.Create(tsColorWheel); with edR do begin Name := 'edR'; @@ -237,7 +262,7 @@ begin OnChange := @RGBChanged; end; - edG := TfpgSpinEdit.Create(TabSheet1); + edG := TfpgSpinEdit.Create(tsColorWheel); with edG do begin Name := 'edG'; @@ -247,7 +272,7 @@ begin OnChange := @RGBChanged; end; - edB := TfpgSpinEdit.Create(TabSheet1); + edB := TfpgSpinEdit.Create(tsColorWheel); with edB do begin Name := 'edB'; @@ -257,7 +282,7 @@ begin OnChange := @RGBChanged; end; - Label3 := TfpgLabel.Create(TabSheet1); + Label3 := TfpgLabel.Create(tsColorWheel); with Label3 do begin Name := 'Label3'; @@ -268,7 +293,7 @@ begin Text := 'Red'; end; - Label4 := TfpgLabel.Create(TabSheet1); + Label4 := TfpgLabel.Create(tsColorWheel); with Label4 do begin Name := 'Label4'; @@ -279,7 +304,7 @@ begin Text := 'Green'; end; - Label5 := TfpgLabel.Create(TabSheet1); + Label5 := TfpgLabel.Create(tsColorWheel); with Label5 do begin Name := 'Label5'; @@ -290,7 +315,7 @@ begin Text := 'Blue'; end; - pnlColorPreview := TfpgBevel.Create(TabSheet1); + pnlColorPreview := TfpgBevel.Create(tsColorWheel); with pnlColorPreview do begin Name := 'pnlColorPreview'; @@ -309,6 +334,8 @@ begin btnCancel.Top := Height - btnCancel.Height - FSpacing; btnOK.Left := btnCancel.Left - FDefaultButtonWidth - 6; btnOK.Top := btnCancel.Top; + + PopulatePaletteColorCombo; end; diff --git a/src/gui/fpg_animation.pas b/src/gui/fpg_animation.pas index fedfa545..36972877 100644 --- a/src/gui/fpg_animation.pas +++ b/src/gui/fpg_animation.pas @@ -65,6 +65,7 @@ type public property Position; published + property Align; property Enabled; property Interval; property ImageFileName; diff --git a/src/gui/fpg_basegrid.pas b/src/gui/fpg_basegrid.pas index 9a29e004..ae6584b8 100644 --- a/src/gui/fpg_basegrid.pas +++ b/src/gui/fpg_basegrid.pas @@ -37,6 +37,8 @@ type TfpgGridDrawState = set of (gdSelected, gdFocused, gdFixed); + TfpgGridHeaderStyle = (ghsButton, ghsThin, ghsFlat); + TfpgFocusChangeNotify = procedure(Sender: TObject; ARow, ACol: Integer) of object; TfpgRowChangeNotify = procedure(Sender: TObject; ARow: Integer) of object; TfpgCanSelectCellEvent = procedure(Sender: TObject; const ARow, ACol: Integer; var ACanSelect: boolean) of object; @@ -52,6 +54,7 @@ type private FColResizing: boolean; FDragPos: integer; // used for column resizing + FHeaderStyle: TfpgGridHeaderStyle; FOnDrawCell: TfpgDrawCellEvent; FResizedCol: integer; // used for column resizing FDefaultColWidth: integer; @@ -83,9 +86,11 @@ type FAlternativeBGColor: TfpgColor; function GetFontDesc: string; function GetHeaderFontDesc: string; + function GetTotalColumnWidth: integer; procedure HScrollBarMove(Sender: TObject; position: integer); procedure SetFontDesc(const AValue: string); procedure SetHeaderFontDesc(const AValue: string); + procedure SetHeaderStyle(const AValue: TfpgGridHeaderStyle); procedure SetRowSelect(const AValue: boolean); procedure SetScrollBarStyle(const AValue: TfpgScrollStyle); procedure VScrollBarMove(Sender: TObject; position: integer); @@ -139,6 +144,7 @@ type property HeaderFontDesc: string read GetHeaderFontDesc write SetHeaderFontDesc; property FocusCol: Integer read FFocusCol write SetFocusCol default -1; property FocusRow: Integer read FFocusRow write SetFocusRow default -1; + property HeaderStyle: TfpgGridHeaderStyle read FHeaderStyle write SetHeaderStyle default ghsButton; property RowSelect: boolean read FRowSelect write SetRowSelect; property ColumnCount: Integer read GetColumnCount; property PopupMenu: TfpgPopupMenu read FPopupMenu write FPopupMenu; @@ -147,6 +153,7 @@ type property ShowGrid: boolean read FShowGrid write SetShowGrid default True; property ScrollBarStyle: TfpgScrollStyle read FScrollBarStyle write SetScrollBarStyle default ssAutoBoth; property HeaderHeight: integer read FHeaderHeight; + property TotalColumnWidth: integer read GetTotalColumnWidth; // property ColResizing: boolean read FColResizing write FColResizing; property ColumnWidth[ACol: Integer]: integer read GetColumnWidth write SetColumnWidth; property ColumnBackgroundColor[ACol: Integer]: TfpgColor read GetColumnBackgroundColor write SetColumnBackgroundColor; @@ -207,6 +214,15 @@ begin Result := FHeaderFont.FontDesc; end; +function TfpgBaseGrid.GetTotalColumnWidth: integer; +var + i: integer; +begin + Result := 0; + for i := 0 to ColumnCount-1 do + Result := Result + ColumnWidth[i]; +end; + procedure TfpgBaseGrid.SetFontDesc(const AValue: string); begin FFont.Free; @@ -225,6 +241,14 @@ begin RePaint; end; +procedure TfpgBaseGrid.SetHeaderStyle(const AValue: TfpgGridHeaderStyle); +begin + if FHeaderStyle = AValue then + exit; + FHeaderStyle := AValue; + Repaint; +end; + procedure TfpgBaseGrid.SetRowSelect(const AValue: boolean); begin if FRowSelect = AValue then @@ -370,10 +394,27 @@ var r: TfpgRect; x: integer; begin - // Here we can implement a head style check - Canvas.DrawButtonFace(ARect, [btfIsEmbedded]); r := ARect; - InflateRect(r, -2, -2); + // Here we can implement a head style check + case FHeaderStyle of + ghsButton: + begin + Canvas.DrawButtonFace(ARect, [btfIsEmbedded]); + InflateRect(r, -2, -2); + end; + ghsThin: + begin + Canvas.DrawBevel(ARect); + end; + ghsFlat: + begin + Canvas.Color:= clGridHeader; + Canvas.FillRectangle(r); + Canvas.Color:= clShadow2; + Canvas.DrawLine(r.Left, r.Bottom, r.Right, r.Bottom); { bottom line } + Canvas.DrawLine(r.Right, r.Bottom, r.Right, r.Top-1); { right line } + end; + end; Canvas.AddClipRect(r); // text may not overshoot header border (* // drawing grid lines @@ -579,16 +620,17 @@ begin begin Dec(VHeight, FHScrollBar.Height); FHScrollBar.Min := 0; - FHScrollBar.SliderSize := 0.2; if go_SmoothScroll in FOptions then begin FHScrollBar.Max := cw - vw; FHScrollBar.Position := FXOffset; + FHScrollBar.SliderSize := TotalColumnWidth / Width; end else begin FHScrollBar.Max := ColumnCount-1; FHScrollBar.Position := FFirstCol; + FHScrollBar.SliderSize := 1 / ColumnCount; end; FHScrollBar.RepaintSlider; end; @@ -931,10 +973,10 @@ begin lCol := FFirstCol; if delta > 0 then // scroll down - inc(FFirstRow, abs(delta)) + inc(FFirstRow, abs(delta)*3) else // scroll up if FFirstRow > 0 then - dec(FFirstRow, abs(delta)); + dec(FFirstRow, abs(delta)*3); // apply limits if FFirstRow > RowCount - VisibleLines then @@ -1231,6 +1273,7 @@ begin FScrollBarStyle := ssAutoBoth; FUpdateCount := 0; FOptions := []; + FHeaderStyle := ghsButton; FFont := fpgGetFont('#Grid'); FHeaderFont := fpgGetFont('#GridHeader'); diff --git a/src/gui/fpg_button.pas b/src/gui/fpg_button.pas index 19b31049..52a17486 100644 --- a/src/gui/fpg_button.pas +++ b/src/gui/fpg_button.pas @@ -13,6 +13,9 @@ Description: Defines a push button control. + + TODO: + * multi-line button text. It must take into account image position as well. } unit fpg_button; @@ -42,7 +45,7 @@ type FImageName: string; FClicked: Boolean; FShowImage: Boolean; - FClickOnPush: Boolean; + FClickOnPush: Boolean; { Used for group buttons where click happens on "down" state. Normal buttons, the click happens on "release" state } FGroupIndex: integer; FAllowAllUp: boolean; FModalResult: TfpgModalResult; @@ -62,6 +65,7 @@ type procedure SetAllowAllUp(const Value: boolean); procedure DoPush; procedure DoRelease(x, y: integer); + procedure SetAllowMultiLineText(const AValue: boolean); protected FImageMargin: integer; FImageSpacing: integer; @@ -72,6 +76,7 @@ type FFont: TfpgFont; FDefault: boolean; FState: integer; // 0 - normal // 1 - hover + FAllowMultiLineText: boolean; procedure SetShowImage(AValue: Boolean); procedure HandlePaint; override; procedure HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: boolean); override; @@ -85,8 +90,9 @@ type property AllowAllUp: boolean read FAllowAllUp write SetAllowAllUp default False; { Buttons behave like toggle buttons. This is an alias for GroupIndex > 0 } property AllowDown: Boolean read GetAllowDown write SetAllowDown; + property AllowMultiLineText: boolean read FAllowMultiLineText write SetAllowMultiLineText default False; property Default: boolean read FDefault write SetDefault default False; - property Down: Boolean read FDown write SetDown; + property Down: Boolean read FDown write SetDown default False; { The button will not show focus. It might also have a different down state (look). This is similar to Focusable = False, but the appearance of the down state might differ. } property Embedded: Boolean read FEmbedded write SetEmbedded default False; @@ -127,12 +133,15 @@ type together. } TfpgButton = class(TfpgBaseButton) published + property Align; property AllowAllUp; property AllowDown; + property AllowMultiLineText; property BackgroundColor default clButtonFace; property Default; property Down; property Embedded; + property Enabled; property Flat; property FontDesc; property GroupIndex; @@ -157,6 +166,10 @@ type property Top; property Width; property OnClick; + property OnDragEnter; + property OnDragLeave; + property OnDragDrop; + property OnDragStartDetected; property OnMouseDown; property OnMouseExit; property OnMouseEnter; @@ -302,6 +315,7 @@ begin FDefault := False; FAllowAllUp := False; FState := 0; + FAllowMultiLineText := False; end; destructor TfpgBaseButton.Destroy; @@ -509,6 +523,7 @@ var lBtnFlags: TFButtonFlags; clr: TfpgColor; img: TfpgImage; + lTextFlags: TFTextFlags; begin // inherited HandlePaint; Canvas.ClearClipRect; @@ -532,6 +547,12 @@ begin Include(lBtnFlags, btfHover) else if FFlat then Include(lBtnFlags, btfFlat); + end + else + begin + { while in the designer we want hover effect all the time } + if FFlat then + Include(lBtnFlags, btfHover); end; if not FFlat and FDefault then @@ -577,8 +598,33 @@ begin Canvas.DrawImage(ix + pofs, iy + pofs, img); img.Free; end; + end; - fpgStyle.DrawString(Canvas, tx+pofs, ty+pofs, Text, Enabled); + + { EXPERIMENTAL: multi-line button text + Only in this condition do we support multi-line text } + if AllowMultiLineText and (FImageLayout = ilImageLeft) then + begin + r.SetRect(0, 0, Width, Height); + InflateRect(r, -3, -3); { same as focus rectangle } + if FShowImage and Assigned(FImage) then + begin + ix := FImageMargin + FImage.Width; + if FImageSpacing > 0 then + ix += FImageSpacing; + OffsetRect(r, ix, 0); + r.Width -= ix; + end; + if FDown then + OffsetRect(r, pofs, pofs); + + lTextFlags := [txtHCenter, txtVCenter{, txtWrap}]; + if not Enabled then + lTextFlags += [txtDisabled]; + Canvas.DrawText(r, Text, lTextFlags); + end + else + fpgStyle.DrawString(Canvas, tx+pofs, ty+pofs, Text, Enabled); end; procedure TfpgBaseButton.DoPush; @@ -618,7 +664,7 @@ begin FDown := False; RePaint; fpgApplication.ProcessMessages; - if PtInRect(r, Point(x, y)) then + if PtInRect(r, Point(x, y)) and FOnClickPending then Click; end; end @@ -629,7 +675,7 @@ begin FDown := False; RePaint; fpgApplication.ProcessMessages; - if PtInRect(r, Point(x, y)) then + if PtInRect(r, Point(x, y)) and FOnClickPending then Click; end; end; @@ -638,10 +684,18 @@ begin FClicked := False; end; +procedure TfpgBaseButton.SetAllowMultiLineText(const AValue: boolean); +begin + if FAllowMultiLineText = AValue then exit; + FAllowMultiLineText := AValue; + Repaint; +end; + procedure TfpgBaseButton.HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: boolean); begin if (keycode = keyReturn) or (keycode = keySpace) or (keycode = keyPEnter) then begin + FOnClickPending := True; DoPush; Consumed := True; end @@ -653,8 +707,9 @@ procedure TfpgBaseButton.HandleKeyRelease(var keycode: word; var shiftstate: TSh begin if (keycode = keyReturn) or (keycode = keySpace) or (keycode = keyPEnter) then begin - DoRelease(1, 1); // fake co-ordinates to it executes the Click + DoRelease(1, 1); // fake co-ordinates so it executes the Click Consumed := True; + FOnClickPending := False; end else inherited; @@ -732,8 +787,11 @@ begin if Assigned(FCommand) then // ICommand takes preference to OnClick FCommand.Execute - else if Assigned(OnClick) then - OnClick(self); + else + begin + if Assigned(OnClick) then + OnClick(self); + end; end; function TfpgBaseButton.GetCommand: ICommand; diff --git a/src/gui/fpg_checkbox.pas b/src/gui/fpg_checkbox.pas index a075a4cd..e6d5c35b 100644 --- a/src/gui/fpg_checkbox.pas +++ b/src/gui/fpg_checkbox.pas @@ -65,9 +65,11 @@ type TfpgCheckBox = class(TfpgBaseCheckBox) published + property Align; property BackgroundColor; property BoxLayout; property Checked; + property Enabled; property FontDesc; property Height; property Hint; diff --git a/src/gui/fpg_colorwheel.pas b/src/gui/fpg_colorwheel.pas index 43ebb8a9..a6b3795b 100644 --- a/src/gui/fpg_colorwheel.pas +++ b/src/gui/fpg_colorwheel.pas @@ -62,7 +62,9 @@ type property Saturation: double Read FSaturation; procedure SetSelectedColor(const NewColor: TfpgColor); published + property Align; property BackgroundColor; + property Enabled; property ValueBar: TfpgValueBar Read FValueBar Write SetValueBar; property MarginWidth: longint Read FMarginWidth Write SetMarginWidth default 5; property CursorSize: longint Read FCursorSize Write SetCursorSize default 5; @@ -98,11 +100,13 @@ type constructor Create(AOwner: TComponent); override; procedure SetHS(Hue: longint; Sat: double); published + property Align; property BackgroundColor; + property Enabled; property Value: double Read FValue Write SetValue; property SelectedColor: TfpgColor Read GetSelectedColor; - property MarginWidth: longint Read FMarginWidth Write SetMarginWidth; - property CursorHeight: longint Read FCursorHeight Write SetCursorHeight; + property MarginWidth: longint Read FMarginWidth Write SetMarginWidth default 5; + property CursorHeight: longint Read FCursorHeight Write SetCursorHeight default 10; property OnChange: TNotifyEvent Read FOnChange Write FOnChange; end; @@ -197,12 +201,16 @@ begin // but draw an outline Canvas.SetLineStyle(1, lsDash); Canvas.DrawRectangle(GetClientRect); + Canvas.SetLineStyle(1, lsSolid); + Canvas.Color := clUIDesignerGreen; + Canvas.FillArc(FMarginWidth, FMarginWidth, DrawWidth, DrawHeight, 0, 360); Canvas.Color := clHilite1; - Canvas.DrawArc(Width div 2, Height div 2, DrawWidth div 2 + 1, - DrawHeight div 2 + 1, 45, 180); + Canvas.DrawArc(FMarginWidth, FMarginWidth, DrawWidth, DrawHeight, 45, 180); Canvas.Color := clShadow1; - Canvas.DrawArc(Width div 2, Height div 2, DrawWidth div 2 + 1, - DrawHeight div 2 + 1, 225, 180); + Canvas.DrawArc(FMarginWidth, FMarginWidth, DrawWidth, DrawHeight, 225, 180); + Canvas.TextColor := clShadow1; + Canvas.DrawText(5, 5, Name + ': ' + ClassName); + DrawCursor; Exit; //==> end; @@ -427,13 +435,19 @@ begin begin // when designing just draw // a rectangle to indicate + Canvas.Color := clBlack; Canvas.SetLineStyle(1, lsDash); Canvas.DrawRectangle(GetClientRect); if (Width < MarginWidth * 2) or (Height < MarginWidth * 2) then Exit; //==> r := GetClientRect; - InflateRect(r, FMarginWidth, FMarginWidth); + InflateRect(r, -FMarginWidth, -FMarginWidth); + Canvas.Color := clShadow1; + Canvas.SetLineStyle(1, lsSolid); Canvas.DrawRectangle(r); + Canvas.TextColor := clShadow1; + Canvas.DrawText(5, 5, Width, Height, Name + ': ' + ClassName, TextFlagsDflt + [txtWrap]); + DrawCursor; exit; end; @@ -494,7 +508,7 @@ begin inherited Create(AOwner); FMarginWidth := 5; FValue := 1.0; - Width := 100; + Width := 80; Height := 100; Name := 'ValueBar'; FCursorHeight := 10; diff --git a/src/gui/fpg_combobox.pas b/src/gui/fpg_combobox.pas index 632a4918..5afbf326 100644 --- a/src/gui/fpg_combobox.pas +++ b/src/gui/fpg_combobox.pas @@ -135,8 +135,11 @@ type TfpgComboBox = class(TfpgBaseStaticCombo) published + property AcceptDrops; + property Align; property BackgroundColor default clBoxColor; property DropDownCount; + property Enabled; property ExtraHint; property FocusItem; property FontDesc; @@ -153,6 +156,10 @@ type property Width; property OnChange; property OnCloseUp; + property OnDragDrop; + property OnDragEnter; + property OnDragLeave; + property OnDragStartDetected; property OnDropDown; property OnEnter; property OnExit; diff --git a/src/gui/fpg_dialogs.pas b/src/gui/fpg_dialogs.pas index 73c668c3..a190cf43 100644 --- a/src/gui/fpg_dialogs.pas +++ b/src/gui/fpg_dialogs.pas @@ -50,7 +50,10 @@ uses fpg_tree, fpg_ColorWheel, fpg_spinedit, - fpg_tab; + fpg_tab, + fpg_menu, + fpg_iniutils, + fpg_imagelist; type TfpgMsgDlgType = (mtAbout, mtWarning, mtError, mtInformation, mtConfirmation, @@ -79,22 +82,27 @@ type TfpgMessageBox = class(TfpgForm) private + {@VFD_HEAD_BEGIN: MessageBox} + FButton: TfpgButton; + {@VFD_HEAD_END: MessageBox} FLines: TStringList; FFont: TfpgFont; FTextY: integer; FLineHeight: integer; FMaxLineWidth: integer; - FButton: TfpgButton; FCentreText: Boolean; - protected - procedure HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: boolean); override; - procedure HandlePaint; override; - procedure HandleShow; override; + procedure FormPaint(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure FormKeyPressed(Sender: TObject; var KeyCode: word; var ShiftState: TShiftState; var Consumed: boolean); + function GetFontDesc: string; + procedure SetFontDesc(const AValue: string); public constructor Create(AOwner: TComponent); override; destructor Destroy; override; + procedure AfterCreate; override; procedure SetMessage(AMessage: string); property CentreText: Boolean read FCentreText write FCentreText default False; + property FontDesc: string read GetFontDesc write SetFontDesc; end; @@ -153,6 +161,8 @@ type btnUpDir: TfpgButton; btnDirNew: TfpgButton; btnShowHidden: TfpgButton; + btnGoHome: TfpgButton; + btnBookmark: TfpgButton; pnlFileInfo: TfpgPanel; edFilename: TfpgEdit; chlFilter: TfpgComboBox; @@ -162,6 +172,8 @@ type FFilterList: TStringList; FFilter: string; FInitialDir: string; + FBookmarkMenu: TfpgPopupMenu; + FIni: TfpgIniFile; procedure SetFilter(const Value: string); function GetFontDesc: string; function GetShowHidden: boolean; @@ -177,9 +189,14 @@ type procedure DirChange(Sender: TObject); procedure UpDirClick(Sender: TObject); procedure btnDirNewClicked(Sender: TObject); + procedure btnGoHomeClicked(Sender: TObject); + procedure btnBookmarkClicked(Sender: TObject); procedure edFilenameChanged(Sender: TObject); procedure UpdateButtonState; function HighlightFile(const AFilename: string): boolean; + function CreatePopupMenu: TfpgPopupMenu; + procedure BookmarkItemClicked(Sender: TObject); + procedure ShowConfigureBookmarks; protected procedure HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: boolean); override; procedure btnOKClick(Sender: TObject); override; @@ -195,7 +212,6 @@ type property InitialDir: string read FInitialDir write SetInitialDir; property ShowHidden: boolean read GetShowHidden write SetShowHidden; end; - { This lets us use a single include file for both the Interface and Implementation sections. } @@ -210,6 +226,7 @@ type {$I charmapdialog.inc} {$I colordialog.inc} {$I inputquerydialog.inc} +{$I managebookmarksdialog.inc} @@ -403,21 +420,11 @@ end; { TfpgMessageBox } -procedure TfpgMessageBox.HandleKeyPress(var keycode: word; - var shiftstate: TShiftState; var consumed: boolean); -begin - inherited HandleKeyPress(keycode, shiftstate, consumed); - if keycode = keyEscape then - Close; -end; - -procedure TfpgMessageBox.HandlePaint; +procedure TfpgMessageBox.FormPaint(Sender: TObject); var n, y: integer; tw: integer; begin - inherited HandlePaint; - Canvas.SetFont(FFont); y := FTextY; for n := 0 to FLines.Count-1 do @@ -431,30 +438,42 @@ begin end; end; -procedure TfpgMessageBox.HandleShow; +procedure TfpgMessageBox.FormShow(Sender: TObject); +begin + FButton.Text := cMsgDlgBtnText[mbOK] +end; + +procedure TfpgMessageBox.FormKeyPressed(Sender: TObject; var KeyCode: word; + var ShiftState: TShiftState; var Consumed: boolean); +begin + if KeyCode = keyEscape then + begin + Consumed := False; + Close; + end; +end; + +function TfpgMessageBox.GetFontDesc: string; +begin + Result := FFont.FontDesc; +end; + +procedure TfpgMessageBox.SetFontDesc(const AValue: string); begin - inherited HandleShow; - FButton.SetFocus; + FFont.Free; + FFont := fpgGetFont(AValue); + RePaint; end; constructor TfpgMessageBox.Create(AOwner: TComponent); begin inherited Create(AOwner); - WindowPosition := wpOneThirdDown; - Sizeable := False; - FLines := TStringList.Create; FFont := fpgGetFont('#Label1'); FTextY := 10; FLineHeight := FFont.Height + 4; - MinWidth := 200; FMaxLineWidth := 500; FCentreText := False; - - FButton := TfpgButton.Create(self); - FButton.Text := cMsgDlgBtnText[mbOK]; - FButton.Width := 75; - FButton.ModalResult := mrOK; end; destructor TfpgMessageBox.Destroy; @@ -464,6 +483,38 @@ begin inherited Destroy; end; +procedure TfpgMessageBox.AfterCreate; +begin + inherited AfterCreate; + {@VFD_BODY_BEGIN: MessageBox} + Name := 'MessageBox'; + SetPosition(330, 199, 419, 138); + WindowTitle := 'Message'; + Hint := ''; + WindowPosition := wpOneThirdDown; + MinWidth := 200; + Sizeable := False; + OnShow := @FormShow; + OnPaint := @FormPaint; + OnKeyPress := @FormKeyPressed; + + FButton := TfpgButton.Create(self); + with FButton do + begin + Name := 'FButton'; + SetPosition(8, 8, 75, 23); + Text := 'OK'; + FontDesc := '#Label1'; + Hint := ''; + ImageName := ''; + ModalResult := mrOK; + TabOrder := 1; + OnKeyPress := @FormKeyPressed; + end; + + {@VFD_BODY_END: MessageBox} +end; + procedure TfpgMessageBox.SetMessage(AMessage: string); var outw: integer; @@ -698,6 +749,8 @@ var end; begin + if Desc = '' then + exit; cp := 1; c := Desc[1]; @@ -863,6 +916,7 @@ begin Items.Add('48'); Items.Add('64'); Items.Add('72'); + FocusItem := 4; // 10 point font OnChange := @OnParamChange; end; @@ -1016,7 +1070,7 @@ begin chlDir := TfpgComboBox.Create(self); with chlDir do begin - SetPosition(8, 12, 526, 22); + SetPosition(8, 12, 484, 24); Anchors := [anLeft, anRight, anTop]; FontDesc := '#List'; OnChange := @DirChange; @@ -1027,6 +1081,7 @@ begin begin SetPosition(8, 44, 622, 200); Anchors := [anLeft, anRight, anTop, anBottom]; + Options := [go_AlternativeColor, go_SmoothScroll]; OnRowChange := @ListChanged; OnDoubleClick := @GridDblClicked; end; @@ -1034,44 +1089,75 @@ begin btnUpDir := TfpgButton.Create(self); with btnUpDir do begin - SetPosition(540, 11, 26, 24); + SetPosition(500, 11, 24, 24); Anchors := [anRight, anTop]; Text := ''; FontDesc := '#Label1'; ImageName := 'stdimg.folderup'; // Do NOT localize - ModalResult := mrNone; Focusable := False; + ImageSpacing := 0; + ImageMargin := -1; OnClick := @UpDirClick; end; btnDirNew := TfpgButton.Create(self); with btnDirNew do begin - SetPosition(572, 11, 26, 24); + SetPosition(526, 11, 24, 24); Anchors := [anRight, anTop]; Text := ''; FontDesc := '#Label1'; ImageName := 'stdimg.foldernew'; // Do NOT localize - ModalResult := mrNone; Focusable := False; + ImageSpacing := 0; + ImageMargin := -1; OnClick := @btnDirNewClicked; end; btnShowHidden := TfpgButton.Create(self); with btnShowHidden do begin - SetPosition(604, 11, 26, 24); + SetPosition(552, 11, 24, 24); Anchors := [anRight, anTop]; Text := ''; FontDesc := '#Label1'; ImageName := 'stdimg.hidden'; // Do NOT localize - ModalResult := mrNone; Focusable := False; GroupIndex := 1; AllowAllUp := True; + ImageSpacing := 0; + ImageMargin := -1; OnClick := @DirChange; end; + btnGoHome := TfpgButton.Create(self); + with btnGoHome do + begin + SetPosition(578, 11, 24, 24); + Anchors := [anRight, anTop]; + Text := ''; + FontDesc := '#Label1'; + ImageName := 'stdimg.folderhome'; // Do NOT localize + Focusable := False; + ImageSpacing := 0; + ImageMargin := -1; + OnClick := @btnGoHomeClicked; + end; + + btnBookmark := TfpgButton.Create(self); + with btnBookmark do + begin + SetPosition(604, 11, 24, 24); + Anchors := [anRight, anTop]; + Text := ''; + FontDesc := '#Label1'; + ImageName := 'stdimg.bookmark'; // Do NOT localize + Focusable := False; + ImageSpacing := 0; + ImageMargin := -1; + OnClick := @btnBookmarkClicked; + end; + { Create lower Panel details } pnlFileInfo := TfpgPanel.Create(self); @@ -1210,6 +1296,8 @@ end; destructor TfpgFileDialog.Destroy; begin + FIni.Free; + FBookmarkMenu.Free; FFilterList.Free; inherited Destroy; end; @@ -1252,6 +1340,19 @@ begin end; end; +procedure TfpgFileDialog.btnGoHomeClicked(Sender: TObject); +begin + SetCurrentDirectory(GetUserDir); +end; + +procedure TfpgFileDialog.btnBookmarkClicked(Sender: TObject); +begin + if Assigned(FBookmarkMenu) then + FBookmarkMenu.Free; + FBookmarkMenu := CreatePopupMenu; + FBookmarkMenu.ShowAt(self, btnBookmark.Left, btnBookmark.Bottom); +end; + procedure TfpgFileDialog.edFilenameChanged(Sender: TObject); begin UpdateButtonState; @@ -1299,6 +1400,9 @@ begin grid.Update; grid.SetFocus; + + if FOpenMode then // when saving file, we want to keep file name + edFilename.Clear; end; function TfpgFileDialog.HighlightFile(const AFilename: string): boolean; @@ -1317,6 +1421,75 @@ begin Result := False; end; +function TfpgFileDialog.CreatePopupMenu: TfpgPopupMenu; +var + i: integer; + s: TfpgString; + lst: TStringList; + mi: TfpgMenuItem; +begin + Result := TfpgPopupMenu.Create(nil); + with Result do + begin + lst := TStringList.Create; + try + if not Assigned(FIni) then + FIni := TfpgINIFile.CreateExt(fpgGetToolkitConfigDir + FPG_BOOKMARKS_FILE); + FIni.ReadSection(FPG_BOOKMARK_SECTION, lst); + // add previous bookmarks to menu + for i := 0 to lst.Count-1 do + begin + mi := AddMenuItem(lst[i], '', @BookmarkItemClicked); + end; + // Now add static items + if lst.Count > 0 then + AddMenuItem('-', '', nil); + finally + lst.Free; + end; + mi := AddMenuItem(rsAddCurrentDirectory, '', @BookmarkItemClicked); + mi.Tag := 1; + mi := AddMenuItem(rsConfigureBookmarks + '...', '', @BookmarkItemClicked); + mi.Tag := 2; + end; +end; + +procedure TfpgFileDialog.BookmarkItemClicked(Sender: TObject); +var + mi: TfpgMenuItem; + s: TfpgString; +begin + if Sender is TfpgMenuItem then + mi := TfpgMenuItem(Sender); + if mi = nil then + Exit; + if mi.Tag = 1 then // Add current directory + begin + FIni.WriteString(FPG_BOOKMARK_SECTION, grid.FileList.DirectoryName, grid.FileList.DirectoryName); + end + else if mi.Tag = 2 then // configure bookmarks + begin + ShowConfigureBookmarks; + end + else + begin // bookmark has been clicked + s := FIni.ReadString(FPG_BOOKMARK_SECTION, mi.Text, '.'); + SetCurrentDirectory(s); + end; +end; + +procedure TfpgFileDialog.ShowConfigureBookmarks; +var + frm: TConfigureBookmarksForm; +begin + frm := TConfigureBookmarksForm.Create(FIni); + try + frm.ShowModal; + finally + frm.Free; + end; +end; + procedure TfpgFileDialog.ProcessFilterString; var p: integer; @@ -1369,7 +1542,7 @@ begin if (i >= 0) and (i < FFilterList.Count) then Result := FFilterList[i] else - Result := '*'; + Result := AllFilesMask; end; function TfpgFileDialog.RunOpenFile: boolean; @@ -1378,12 +1551,12 @@ var fname: string; begin FOpenMode := True; - sdir := ExtractFileDir(FileName); + sdir := fpgExtractFileDir(FileName); if sdir = '' then sdir := '.'; SetCurrentDirectory(sdir); - fname := ExtractFileName(FileName); + fname := fpgExtractFileName(FileName); if not HighlightFile(fname) then edFilename.Text := fname; @@ -1436,6 +1609,7 @@ end; {$I charmapdialog.inc} {$I colordialog.inc} {$I inputquerydialog.inc} +{$I managebookmarksdialog.inc} end. diff --git a/src/gui/fpg_edit.pas b/src/gui/fpg_edit.pas index 5dd25fb0..dd7958ab 100644 --- a/src/gui/fpg_edit.pas +++ b/src/gui/fpg_edit.pas @@ -159,10 +159,13 @@ type public property PopupMenu; // UI Designer doesn't fully support it yet published + property AcceptDrops; + property Align; property AutoSelect; property AutoSize; property BackgroundColor default clBoxColor; property BorderStyle; + property Enabled; property ExtraHint; property FontDesc; property HeightMargin; @@ -179,6 +182,10 @@ type property Text; property TextColor; property OnChange; + property OnDragEnter; + property OnDragLeave; + property OnDragDrop; + property OnDragStartDetected; property OnEnter; property OnExit; property OnKeyPress; @@ -220,20 +227,11 @@ type Still to implement !!} property CustomDecimalSeparator: TfpgChar read FDecimalseparator write SetDecimalSeparator; property CustomThousandSeparator: TfpgChar read FThousandSeparator write SetThousandSeparator; - property NegativeColor: TfpgColor read FNegativeColor write SetNegativeColor; + property NegativeColor: TfpgColor read FNegativeColor write SetNegativeColor default clRed; property HideSelection; // property MaxLength; { probably MaxValue and MinValue } property TabOrder; - property TextColor; property ShowThousand: boolean read FShowThousand write FShowThousand default False; - property OnChange; - property OnEnter; - property OnExit; - property OnKeyPress; - property OnMouseEnter; - property OnMouseExit; - property OnPaint; - property OnShowHint; public constructor Create(AOwner: TComponent); override; published @@ -254,7 +252,9 @@ type property OldColor; property Text; published + property Align; property CustomThousandSeparator; + property Enabled; property Hint; property NegativeColor; property ParentShowHint; @@ -292,9 +292,11 @@ type property OldColor; property Text; published + property Align; property CustomDecimalSeparator; property CustomThousandSeparator; property Decimals: integer read FDecimals write SetDecimals default -1; + property Enabled; property FixedDecimals: boolean read FFixedDecimals write SetFixedDecimals default False; property Hint; property NegativeColor; @@ -331,9 +333,11 @@ type property OldColor; property Text; published + property Align; property CustomDecimalSeparator; property CustomThousandSeparator; property Decimals: integer read FDecimals write SetDecimals default 2; + property Enabled; property Hint; property NegativeColor; property ParentShowHint; @@ -341,6 +345,7 @@ type property ShowHint; property ShowThousand default True; property TabOrder; + property TextColor; property Value: Currency read GetValue write SetValue; property OnChange; property OnEnter; @@ -1178,7 +1183,7 @@ procedure TfpgBaseEdit.DefaultPopupPaste(Sender: TObject); begin if ReadOnly then Exit; - PasteFromClipboard + PasteFromClipboard; end; procedure TfpgBaseEdit.DefaultPopupClearAll(Sender: TObject); @@ -1643,6 +1648,7 @@ procedure TfpgBaseNumericEdit.SetNegativeColor(const AValue: TfpgColor); begin if FNegativeColor=AValue then exit; FNegativeColor:=AValue; + FormatEdit; end; procedure TfpgBaseNumericEdit.SetThousandSeparator(const AValue: TfpgChar); @@ -1799,8 +1805,8 @@ begin FAlignment := taRightJustify; FDecimalSeparator := DecimalSeparator; FThousandSeparator := ThousandSeparator; - NegativeColor := clRed; - OldColor := TextColor; + FNegativeColor := clRed; + FOldColor := TextColor; end; { TfpgEditInteger } diff --git a/src/gui/fpg_editbtn.pas b/src/gui/fpg_editbtn.pas index 70c6da00..0cba4f18 100644 --- a/src/gui/fpg_editbtn.pas +++ b/src/gui/fpg_editbtn.pas @@ -70,14 +70,16 @@ type public constructor Create(AOwner: TComponent); override; published - property ExtraHint; - property FileName: TfpgString read GetFileName write SetFileName; - property InitialDir: TfpgString read FInitialDir write FInitialDir; - property Filter: TfpgString read FFilter write SetFilter; - property ReadOnly; - property TabOrder; - property OnButtonClick; - property OnShowHint; + property Align; + property Enabled; + property ExtraHint; + property FileName: TfpgString read GetFileName write SetFileName; + property InitialDir: TfpgString read FInitialDir write FInitialDir; + property Filter: TfpgString read FFilter write SetFilter; + property ReadOnly; + property TabOrder; + property OnButtonClick; + property OnShowHint; end; @@ -92,13 +94,15 @@ type public constructor Create(AOwner: TComponent); override; published - property Directory: TfpgString read GetDirectory write SetDirectory; - property ExtraHint; - property RootDirectory: TfpgString read FRootDirectory write FRootDirectory; - property ReadOnly; - property TabOrder; - property OnButtonClick; - property OnShowHint; + property Align; + property Directory: TfpgString read GetDirectory write SetDirectory; + property Enabled; + property ExtraHint; + property RootDirectory: TfpgString read FRootDirectory write FRootDirectory; + property ReadOnly; + property TabOrder; + property OnButtonClick; + property OnShowHint; end; @@ -111,11 +115,14 @@ type public constructor Create(AOwner: TComponent); override; published - property FontDesc: TfpgString read GetFontDesc write SetFontDesc; - property ReadOnly; - property TabOrder; - property OnButtonClick; - property OnShowHint; + property Align; + property Enabled; + property ExtraHint; + property FontDesc: TfpgString read GetFontDesc write SetFontDesc; + property ReadOnly; + property TabOrder; + property OnButtonClick; + property OnShowHint; end; diff --git a/src/gui/fpg_editcombo.pas b/src/gui/fpg_editcombo.pas index 20b6ee8d..4dd011d0 100644 --- a/src/gui/fpg_editcombo.pas +++ b/src/gui/fpg_editcombo.pas @@ -58,6 +58,7 @@ uses fpg_main, fpg_widget, fpg_popupwindow, + fpg_menu, fpg_combobox; type @@ -72,10 +73,14 @@ type FSelectedItem: integer; FMaxLength: integer; FNewItem: boolean; + FDefaultPopupMenu: TfpgPopupMenu; 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); + procedure DefaultPopupInsertFromCharmap(Sender: TObject); + procedure DoPaste(const AText: TfpgString); + procedure SetDefaultPopupMenuItemsState; protected FDropDown: TfpgPopupWindow; FDrawOffset: integer; @@ -86,11 +91,14 @@ type function GetText: string; virtual; function HasText: boolean; virtual; procedure SetText(const AValue: string); virtual; + procedure ShowDefaultPopupMenu(const x, y: integer; const shiftstate: TShiftState); 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 HandleRMouseDown(x, y: integer; shiftstate: TShiftState); override; + procedure HandleRMouseUp(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; @@ -109,6 +117,7 @@ type TfpgEditCombo = class(TfpgBaseEditCombo) published + property Align; property AllowNew; property AutoCompletion; property BackgroundColor; @@ -145,6 +154,14 @@ uses fpg_listbox, fpg_dialogs; +const + // internal popupmenu item names + //ipmCut = 'miDefaultCut'; + //ipmCopy = 'miDefaultCopy'; + //ipmPaste = 'miDefaultPaste'; + //ipmClearAll = 'miDefaultClearAll'; + ipmCharmap = 'miDefaultCharmap'; + var OriginalFocusRoot: TfpgWidget; @@ -372,6 +389,74 @@ begin Repaint; end; +procedure TfpgBaseEditCombo.DefaultPopupInsertFromCharmap(Sender: TObject); +var + s: TfpgString; +begin + if FAllowNew= anNo then + Exit; + s := fpgShowCharMap; + if s <> '' then + //SetText(s); + DoPaste(s); +end; + +procedure TfpgBaseEditCombo.DoPaste(const AText: TfpgString); +var + s: string; + prevval: TfpgString; + i: integer; +begin + prevval := FText; + s := AText; + 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 + FNewItem:= True; + end; + Repaint; + if prevval <> Text then + DoOnChange; +end; + +procedure TfpgBaseEditCombo.SetDefaultPopupMenuItemsState; +var + i: integer; + itm: TfpgMenuItem; +begin + //for i := 0 to FDefaultPopupMenu.ComponentCount-1 do + //begin + // if FDefaultPopupMenu.Components[i] is TfpgMenuItem then + // begin + // itm := TfpgMenuItem(FDefaultPopupMenu.Components[i]); + // // enabled/disable menu items + // if itm.Name = ipmCut then + // itm.Enabled := (not ReadOnly) and (FSelOffset <> 0) + // else if itm.Name = ipmCopy then + // itm.Enabled := FSelOffset <> 0 + // else if itm.Name = ipmPaste then + // itm.Enabled := (not ReadOnly) and (fpgClipboard.Text <> '') + // else if itm.Name = ipmClearAll then + // itm.Enabled := (not ReadOnly) and (Text <> '') + // else if itm.Name = ipmCharmap then + // itm.Enabled := (not ReadOnly); + // end; + //end; +end; + procedure TfpgBaseEditCombo.SetText(const AValue: string); var i: integer; @@ -398,6 +483,32 @@ begin end; end; +procedure TfpgBaseEditCombo.ShowDefaultPopupMenu(const x, y: integer; + const shiftstate: TShiftState); +var + itm: TfpgMenuItem; +begin + if not Assigned(FDefaultPopupMenu) then + begin + FDefaultPopupMenu := TfpgPopupMenu.Create(nil); + //itm := FDefaultPopupMenu.AddMenuItem(rsCut, '', @DefaultPopupCut); + //itm.Name := ipmCut; + //itm := FDefaultPopupMenu.AddMenuItem(rsCopy, '', @DefaultPopupCopy); + //itm.Name := ipmCopy; + //itm := FDefaultPopupMenu.AddMenuItem(rsPaste, '', @DefaultPopupPaste); + //itm.Name := ipmPaste; + //itm := FDefaultPopupMenu.AddMenuItem(rsDelete, '', @DefaultPopupClearAll); + //itm.Name := ipmClearAll; + //itm := FDefaultPopupMenu.AddMenuItem('-', '', nil); + //itm.Name := 'N1'; + itm := FDefaultPopupMenu.AddMenuItem(rsInsertFromCharacterMap, '', @DefaultPopupInsertFromCharmap); + itm.Name := ipmCharmap; + end; + + SetDefaultPopupMenuItemsState; + FDefaultPopupMenu.ShowAt(self, x, y); +end; + procedure TfpgBaseEditCombo.HandleResize(AWidth, AHeight: TfpgCoord); begin inherited HandleResize(AWidth, AHeight); @@ -595,6 +706,25 @@ begin PaintInternalButton; end; +procedure TfpgBaseEditCombo.HandleRMouseDown(x, y: integer; + shiftstate: TShiftState); +begin + // keyMenu was pressed + if shiftstate = [ssExtra1] then + HandleRMouseUp(x, y, []) + else + inherited HandleRMouseDown(x, y, shiftstate); +end; + +procedure TfpgBaseEditCombo.HandleRMouseUp(x, y: integer; shiftstate: TShiftState); +begin + inherited HandleRMouseUp(x, y, shiftstate); + //if Assigned(PopupMenu) then + // PopupMenu.ShowAt(self, x, y) + //else + ShowDefaultPopupMenu(x, y, ShiftState); +end; + procedure TfpgBaseEditCombo.HandlePaint; var r: TfpgRect; @@ -770,7 +900,8 @@ end; destructor TfpgBaseEditCombo.Destroy; begin - FDropDown.Free; + if not Assigned(FDropDown) then + FDropDown.Free; inherited Destroy; end; diff --git a/src/gui/fpg_form.pas b/src/gui/fpg_form.pas index 57c156a6..2eb6e899 100644 --- a/src/gui/fpg_form.pas +++ b/src/gui/fpg_form.pas @@ -51,6 +51,8 @@ type FOnHide: TNotifyEvent; FOnShow: TNotifyEvent; FOnHelp: TfpgHelpEvent; + FDNDEnabled: boolean; + procedure SetDNDEnabled(const AValue: boolean); protected FModalResult: TfpgModalResult; FParentForm: TfpgBaseForm; @@ -71,6 +73,7 @@ type procedure DoOnClose(var CloseAction: TCloseAction); virtual; function DoOnHelp(AHelpType: THelpType; AHelpContext: THelpContext; const AHelpKeyword: String; const AHelpFile: String; var AHandled: Boolean): Boolean; virtual; // properties + property DNDEnabled: boolean read FDNDEnabled write SetDNDEnabled default False; property Sizeable: boolean read FSizeable write FSizeable; property ModalResult: TfpgModalResult read FModalResult write FModalResult; property FullScreen: boolean read FFullScreen write FFullScreen default False; @@ -106,6 +109,7 @@ type TfpgForm = class(TfpgBaseForm) published property BackgroundColor; + property DNDEnabled; property FullScreen; property Height; property Hint; @@ -133,6 +137,7 @@ type property OnEnter; property OnExit; property OnHide; + property OnKeyPress; property OnMouseDown; property OnMouseEnter; property OnMouseExit; @@ -153,7 +158,11 @@ implementation uses fpg_main, fpg_popupwindow, - fpg_menu; + fpg_menu + {$IFDEF DEBUG} + ,dbugintf + {$ENDIF} + ; type // to access protected methods @@ -180,6 +189,13 @@ end; { TfpgBaseForm } +procedure TfpgBaseForm.SetDNDEnabled(const AValue: boolean); +begin + if FDNDEnabled = AValue then exit; + FDNDEnabled := AValue; + DoDNDEnabled(AValue); +end; + procedure TfpgBaseForm.SetWindowTitle(const ATitle: string); begin FWindowTitle := ATitle; @@ -188,9 +204,14 @@ end; procedure TfpgBaseForm.MsgActivate(var msg: TfpgMessageRec); begin -// writeln('BaseForm - MsgActivate'); + {$IFDEF DEBUG} + SendDebug(Classname + ' ' + Name + '.BaseForm - MsgActivate'); + {$ENDIF} if (fpgApplication.TopModalForm = nil) or (fpgApplication.TopModalForm = self) then begin + {$IFDEF DEBUG} + SendDebug('Inside if block'); + {$ENDIF} FocusRootWidget := self; if FFormDesigner <> nil then @@ -275,6 +296,7 @@ begin FModalResult := mrNone; FFullScreen := False; FIsContainer := True; + FDNDEnabled := False; end; destructor TfpgBaseForm.Destroy; @@ -386,7 +408,9 @@ var i: integer; wg: TfpgWidget; begin -// writeln(Classname, '.Keypress'); + {$IFDEF DEBUG} + SendDebug(Classname + '.Keypress'); + {$ENDIF} // find the TfpgMenuBar if not consumed then begin diff --git a/src/gui/fpg_grid.pas b/src/gui/fpg_grid.pas index 112a1f33..320c2408 100644 --- a/src/gui/fpg_grid.pas +++ b/src/gui/fpg_grid.pas @@ -56,6 +56,7 @@ type property Font; property HeaderFont; published + property Align; property ColumnCount; property Columns; property FocusRow; @@ -125,6 +126,7 @@ type public property Font; published + property Align; property AlternateBGColor; property BackgroundColor; // property ColResizing; @@ -133,11 +135,13 @@ type property ColumnWidth; property DefaultColWidth; property DefaultRowHeight; + property Enabled; property FocusCol; property FocusRow; property FontDesc; property HeaderFontDesc; property HeaderHeight; + property HeaderStyle; property Hint; property Options; property ParentShowHint; diff --git a/src/gui/fpg_hyperlink.pas b/src/gui/fpg_hyperlink.pas index 2c850a97..5d84c718 100644 --- a/src/gui/fpg_hyperlink.pas +++ b/src/gui/fpg_hyperlink.pas @@ -50,6 +50,7 @@ type constructor Create(AOwner: TComponent); override; procedure GoHyperLink; published + property Align; property Alignment; property Autosize; property FontDesc; diff --git a/src/gui/fpg_iniutils.pas b/src/gui/fpg_iniutils.pas index 1c8fe45a..857ccf63 100644 --- a/src/gui/fpg_iniutils.pas +++ b/src/gui/fpg_iniutils.pas @@ -52,6 +52,7 @@ function gINI(const AFileName: string = ''): TfpgINIFile; implementation uses + fpg_base, fpg_main, fpg_constants, fpg_utils; @@ -71,12 +72,12 @@ end; constructor TfpgINIFile.CreateExt(const AFileName: string; AReadOnly: Boolean); var - lDir: string; - lFileName: string; + lDir: TfpgString; + lFileName: TfpgString; begin FReadOnly := AReadOnly; - lDir := ExtractFileDir(AFileName); - lFileName := ExtractFileName(AFileName); + lDir := fpgExtractFileDir(AFileName); + lFileName := fpgExtractFileName(AFileName); if lDir = '' then lDir := GetAppConfigDir(False); @@ -84,7 +85,7 @@ begin lDir := lDir + PathDelim; { We used a non-Global config dir, so should be able to create the dir } - if not ForceDirectories(lDir) then + if not fpgForceDirectories(lDir) then raise Exception.CreateFmt(rsErrFailedToCreateDir, [lDir]); diff --git a/src/gui/fpg_label.pas b/src/gui/fpg_label.pas index 409116b9..0f9c8b4b 100644 --- a/src/gui/fpg_label.pas +++ b/src/gui/fpg_label.pas @@ -68,9 +68,12 @@ type TfpgLabel = class(TfpgCustomLabel) published + property AcceptDrops; + property Align; property Alignment; property AutoSize; property BackgroundColor; + property Enabled; property FontDesc; property Height; property Hint; @@ -90,6 +93,10 @@ type property Width; property WrapText; property OnClick; + property OnDragEnter; + property OnDragLeave; + property OnDragDrop; + property OnDragStartDetected; property OnDoubleClick; property OnMouseDown; property OnMouseEnter; diff --git a/src/gui/fpg_listbox.pas b/src/gui/fpg_listbox.pas index 4b6d162e..a0cb8e93 100644 --- a/src/gui/fpg_listbox.pas +++ b/src/gui/fpg_listbox.pas @@ -92,8 +92,8 @@ type property AutoHeight: boolean read FAutoHeight write SetAutoHeight default False; property FocusItem: integer read FFocusItem write SetFocusItem; property FontDesc: string read GetFontDesc write SetFontDesc; - property HotTrack: boolean read FHotTrack write FHotTrack; - property PopupFrame: boolean read FPopupFrame write SetPopupFrame; + property HotTrack: boolean read FHotTrack write FHotTrack default False; + property PopupFrame: boolean read FPopupFrame write SetPopupFrame default False; property DragToReorder: boolean read FDragToReorder write FDragToReorder default False; public constructor Create(AOwner: TComponent); override; @@ -117,6 +117,8 @@ type TfpgTextListBox = class(TfpgBaseListBox) protected FItems: TStringList; + function GetText: string; virtual; + procedure SetText(const AValue: string); virtual; 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; @@ -125,16 +127,19 @@ type constructor Create(AOwner: TComponent); override; destructor Destroy; override; function ItemCount: integer; override; - function Text: string; + property Text: string read GetText write SetText stored False; end; // The standard strings listbox we will actually use in a GUI. TfpgListBox = class(TfpgTextListBox) published + property AcceptDrops; + property Align; property AutoHeight; property BackgroundColor default clListBox; property DragToReorder; + property Enabled; property FocusItem; property FontDesc; property Hint; @@ -144,8 +149,19 @@ type property PopupFrame; property ShowHint; property TabOrder; + property Text; property TextColor; + property OnChange; property OnDoubleClick; + property OnDragDrop; + property OnDragEnter; + property OnDragLeave; + property OnDragStartDetected; + property OnEnter; + property OnExit; + property OnKeyPress; + property OnScroll; + property OnSelect; property OnShowHint; end; @@ -181,7 +197,7 @@ type // procedure HandleKeyChar(var AText: TfpgChar; var shiftstate: TShiftState; var consumed: boolean); override; property Items: TList read FItems; property Color: TfpgColor read GetColor write SetColor; - property ColorPalette: TfpgColorPalette read FColorPalette write SetColorPalette; + property ColorPalette: TfpgColorPalette read FColorPalette write SetColorPalette default cpStandardColors; property ShowColorNames: Boolean read FShowColorNames write SetShowColorNames default True; public constructor Create(AOwner: TComponent); override; @@ -192,11 +208,14 @@ type TfpgColorListBox = class(TfpgBaseColorListBox) published + property AcceptDrops; + property Align; property AutoHeight; property BackgroundColor default clListBox; property Color; property ColorPalette; property DragToReorder; + property Enabled; property FocusItem; property FontDesc; property Hint; @@ -208,6 +227,10 @@ type property ShowHint; property TabOrder; property TextColor; + property OnDragEnter; + property OnDragLeave; + property OnDragDrop; + property OnDragStartDetected; end; @@ -855,6 +878,35 @@ end; { TfpgTextListBox } +function TfpgTextListBox.GetText: string; +begin + if (ItemCount > 0) and (FocusItem <> -1) then + result := FItems[FocusItem] + else + result := ''; +end; + +procedure TfpgTextListBox.SetText(const AValue: string); +var + i: integer; +begin + if AValue = '' then + SetFocusItem(-1) // nothing selected + else + begin + for i := 0 to FItems.Count-1 do + begin + if SameText(Items.Strings[i], AValue) then + begin + SetFocusItem(i); + Exit; //==> + end; + end; + // if we get here, we didn't find a match + SetFocusItem(-1); + end; +end; + procedure TfpgTextListBox.DrawItem(num: integer; rect: TfpgRect; flags: integer); begin //if num < 0 then @@ -905,14 +957,6 @@ begin result := FItems.Count; end; -function TfpgTextListBox.Text: string; -begin - if (ItemCount > 0) and (FocusItem <> -1) then - result := FItems[FocusItem] - else - result := ''; -end; - { TColorItem } constructor TColorItem.Create (const AColorName: string; const AColorValue: TfpgColor); diff --git a/src/gui/fpg_listview.pas b/src/gui/fpg_listview.pas index 12ed4364..cd9268f4 100644 --- a/src/gui/fpg_listview.pas +++ b/src/gui/fpg_listview.pas @@ -249,7 +249,9 @@ type function AddItem: TfpgLVItem; function NewItem: TfpgLVItem; published + property Align; property Columns: TfpgLVColumns read FColumns; + property Enabled; property HScrollBar: TfpgScrollBar read FHScrollBar; property ItemHeight: Integer read GetItemHeight; property ItemIndex: Integer read FItemIndex write SetItemIndex; diff --git a/src/gui/fpg_memo.pas b/src/gui/fpg_memo.pas index 37f21a42..789da3c3 100644 --- a/src/gui/fpg_memo.pas +++ b/src/gui/fpg_memo.pas @@ -60,12 +60,15 @@ type FWrapping: boolean; FLongestLineWidth: TfpgCoord; FPopupMenu: TfpgPopupMenu; + FDefaultPopupMenu: TfpgPopupMenu; + FReadOnly: Boolean; + FUpdateCount: integer; function GetFontDesc: string; procedure SetFontDesc(const AValue: string); procedure RecalcLongestLine; procedure DeleteSelection; procedure DoCopy; - procedure DoPaste; + procedure DoPaste(const AText: TfpgString); procedure AdjustCursor; function LineCount: integer; function GetLineText(linenum: integer): string; @@ -81,10 +84,21 @@ type function GetText: TfpgString; procedure SetCursorLine(aValue: integer); procedure UpdateScrollBarCoords; + procedure DefaultPopupCut(Sender: TObject); + procedure DefaultPopupCopy(Sender: TObject); + procedure DefaultPopupPaste(Sender: TObject); + procedure DefaultPopupClearAll(Sender: TObject); + procedure DefaultPopupInsertFromCharmap(Sender: TObject); + procedure SetDefaultPopupMenuItemsState; + procedure ShowDefaultPopupMenu(const x, y: integer; const shiftstate: TShiftState); virtual; + procedure SetReadOnly(const AValue: Boolean); + procedure ResetSelectionVariables; + procedure SetCursorPos(const AValue: integer); protected 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 HandleRMouseDown(x, y: integer; shiftstate: TShiftState); override; procedure HandleRMouseUp(x, y: integer; shiftstate: TShiftState); override; procedure HandleMouseMove(x, y: integer; btnstate: word; shiftstate: TShiftState); override; procedure HandleResize(dwidth, dheight: integer); override; @@ -94,11 +108,19 @@ type procedure HandleMouseEnter; override; procedure HandleMouseExit; override; procedure HandleHide; override; + procedure RePaint; override; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure UpdateScrollBars; - function SelectionText: string; + function SelectionText: TfpgString; + procedure CopyToClipboard; + procedure CutToClipboard; + procedure PasteFromClipboard; + procedure Clear; + procedure BeginUpdate; + procedure EndUpdate; + property CursorPos: integer read FCursorPos write SetCursorPos; property CursorLine: integer read FCursorLine write SetCursorLine; property Font: TfpgFont read FFont; property LineHeight: integer read FLineHeight; @@ -108,11 +130,14 @@ type property UseTabs: boolean read FUseTabs write FUseTabs default False; property PopupMenu: TfpgPopupMenu read FPopupMenu write FPopupMenu; published + property Align; property BackgroundColor default clBoxColor; + property Enabled; property FontDesc: string read GetFontDesc write SetFontDesc; property Hint; property Lines: TStringList read FLines; property ParentShowHint; + property ReadOnly: Boolean read FReadOnly write SetReadOnly default False; property ShowHint; property TabOrder; property TextColor; @@ -130,14 +155,25 @@ function CreateMemo(AOwner: TComponent; x, y, w, h: TfpgCoord): TfpgMemo; implementation uses - fpg_stringutils; + fpg_stringutils + ,fpg_constants + ,fpg_dialogs + ; + +const + // internal popupmenu item names + ipmCut = 'miDefaultCut'; + ipmCopy = 'miDefaultCopy'; + ipmPaste = 'miDefaultPaste'; + ipmClearAll = 'miDefaultClearAll'; + ipmCharmap = 'miDefaultCharmap'; + type // custom stringlist that will notify the memo of item changes TfpgMemoStrings = class(TStringList) protected Memo: TfpgMemo; - procedure RefreshMemo; public constructor Create(AMemo: TfpgMemo); reintroduce; destructor Destroy; override; @@ -149,15 +185,6 @@ type { TfpgMemoStrings } -procedure TfpgMemoStrings.RefreshMemo; -begin - if Assigned(Memo) and (Memo.HasHandle) then - begin - Memo.Invalidate; - Memo.UpdateScrollBars; - end; -end; - constructor TfpgMemoStrings.Create(AMemo: TfpgMemo); begin inherited Create; @@ -172,28 +199,30 @@ end; function TfpgMemoStrings.Add(const s: String): Integer; begin + Memo.BeginUpdate; Result := inherited Add(s); - RefreshMemo; + Memo.EndUpdate; end; procedure TfpgMemoStrings.Delete(Index: Integer); begin -// writeln('Delete''s Index = ', Index); + Memo.BeginUpdate; inherited Delete(Index); - RefreshMemo; + Memo.EndUpdate; end; procedure TfpgMemoStrings.Insert(Index: Integer; const S: string); begin -// writeln('Insert''s Index = ', Index); + Memo.BeginUpdate; inherited Insert(Index, S); - RefreshMemo; + Memo.EndUpdate; end; procedure TfpgMemoStrings.Clear; begin + Memo.BeginUpdate; inherited Clear; - RefreshMemo; + Memo.EndUpdate; end; @@ -217,13 +246,18 @@ var MaxLine: integer; yp: integer; begin - if (aValue < 0) or (aValue = FCursorLine) then + if (aValue < 0) or (aValue = FCursorLine) or (AValue > FLines.Count-1) then Exit; // wrong value + if aValue < FFirstLine then begin FFirstLine := aValue; // moves the selected line to the top of the displayed rectangle FCursorLine := aValue; FCursorPos := 0; + FSelStartPos := FCursorPos; + FSelStartLine := FCursorLine; + FSelEndLine := -1; + AdjustCursor; RePaint; Exit; end; @@ -243,15 +277,21 @@ begin FFirstLine := aValue; FCursorLine := aValue; FCursorPos := 0; + FSelStartPos := FCursorPos; + FSelStartLine := FCursorLine; + FSelEndLine := -1; + AdjustCursor; RePaint; - Exit; end else begin FCursorLine := aValue; FCursorPos := 0; + FSelStartPos := FCursorPos; + FSelStartLine := FCursorLine; + FSelEndLine := -1; + AdjustCursor; RePaint; - Exit; end; end; @@ -280,6 +320,144 @@ begin FHScrollBar.UpdateWindowPosition; end; +procedure TfpgMemo.DefaultPopupCut(Sender: TObject); +begin + if ReadOnly then + Exit; + CutToClipboard; +end; + +procedure TfpgMemo.DefaultPopupCopy(Sender: TObject); +begin + if ReadOnly then + Exit; + CopyToClipboard; +end; + +procedure TfpgMemo.DefaultPopupPaste(Sender: TObject); +begin + if ReadOnly then + Exit; + PasteFromClipboard; +end; + +procedure TfpgMemo.DefaultPopupClearAll(Sender: TObject); +begin + if ReadOnly then + Exit; + Clear; +end; + +procedure TfpgMemo.DefaultPopupInsertFromCharmap(Sender: TObject); +var + s: TfpgString; +begin + if ReadOnly then + Exit; + s := fpgShowCharMap; + if s <> '' then + DoPaste(s); +end; + +procedure TfpgMemo.SetDefaultPopupMenuItemsState; +var + i: integer; + itm: TfpgMenuItem; + b: boolean; + + function SomethingSelected: boolean; + begin + Result := SelectionText <> ''; + end; + +begin + b := SomethingSelected; + for i := 0 to FDefaultPopupMenu.ComponentCount-1 do + begin + if FDefaultPopupMenu.Components[i] is TfpgMenuItem then + begin + itm := TfpgMenuItem(FDefaultPopupMenu.Components[i]); + // enabled/disable menu items + if itm.Name = ipmCut then + itm.Enabled := (not ReadOnly) and b + else if itm.Name = ipmCopy then + itm.Enabled := b + else if itm.Name = ipmPaste then + itm.Enabled := (not ReadOnly) and (fpgClipboard.Text <> '') + else if itm.Name = ipmClearAll then + itm.Enabled := (not ReadOnly) and (Text <> '') + else if itm.Name = ipmCharmap then + itm.Enabled := (not ReadOnly); + end; + end; +end; + +procedure TfpgMemo.ShowDefaultPopupMenu(const x, y: integer; + const shiftstate: TShiftState); +var + itm: TfpgMenuItem; +begin + if not Assigned(FDefaultPopupMenu) then + begin + FDefaultPopupMenu := TfpgPopupMenu.Create(nil); + itm := FDefaultPopupMenu.AddMenuItem(rsCut, '', @DefaultPopupCut); + itm.Name := ipmCut; + itm := FDefaultPopupMenu.AddMenuItem(rsCopy, '', @DefaultPopupCopy); + itm.Name := ipmCopy; + itm := FDefaultPopupMenu.AddMenuItem(rsPaste, '', @DefaultPopupPaste); + itm.Name := ipmPaste; + itm := FDefaultPopupMenu.AddMenuItem(rsDelete, '', @DefaultPopupClearAll); + itm.Name := ipmClearAll; + itm := FDefaultPopupMenu.AddMenuItem('-', '', nil); + itm.Name := 'N1'; + itm := FDefaultPopupMenu.AddMenuItem(rsInsertFromCharacterMap, '', @DefaultPopupInsertFromCharmap); + itm.Name := ipmCharmap; + end; + + SetDefaultPopupMenuItemsState; + FDefaultPopupMenu.ShowAt(self, x, y); +end; + +procedure TfpgMemo.SetReadOnly(const AValue: Boolean); +begin + if FReadOnly = AValue then exit; + FReadOnly := AValue; + RePaint; +end; + +procedure TfpgMemo.ResetSelectionVariables; +begin + FSelecting := False; + FSelStartPos := FCursorPos; + FSelEndPos := FCursorPos; + FSelStartLine := FCursorLine; + FSelEndLine := FCursorLine; + FMouseDragging := False; +end; + +procedure TfpgMemo.SetCursorPos(const AValue: integer); +var + x: integer; +begin + if FCursorPos = AValue then + exit; + + if AValue = 0 then + FCursorPos := AValue + else + begin + x := UTF8Length(FLines[CursorLine]); + if AValue > x then { can't set Cursorpos greater than number of characters on that line } + FCursorPos := x + else + FCursorPos := AValue; + end; + FSelStartPos := FCursorPos; + FSelEndPos := FCursorPos; + AdjustCursor; + Repaint; +end; + constructor TfpgMemo.Create(AOwner: TComponent); begin inherited Create(AOwner); @@ -288,7 +466,6 @@ begin FHeight := FFont.Height * 3 + 4; FWidth := 120; FLineHeight := FFont.Height + 2; - FSelecting := False; FSideMargin := 3; FMaxLength := 0; FWrapping := False; @@ -299,19 +476,18 @@ begin FTabWidth := 4; FMinWidth := 20; FMinHeight := 30; + FPopupMenu := nil; + FDefaultPopupMenu := nil; + FReadOnly := False; + FUpdateCount := 0; FLines := TfpgMemoStrings.Create(self); FFirstLine := 0; FCursorLine := 0; - FCursorPos := 0; - FSelStartPos := FCursorPos; - FSelEndPos := 0; - FSelStartLine := -1; - FSelEndLine := -1; + ResetSelectionVariables; FDrawOffset := 0; - FMouseDragging := False; FVScrollBar := TfpgScrollBar.Create(self); FVScrollBar.Orientation := orVertical; @@ -327,6 +503,8 @@ end; destructor TfpgMemo.Destroy; begin + if Assigned(FDefaultPopupMenu) then + FDefaultPopupMenu.Free; TfpgMemoStrings(FLines).Free; FFont.Free; inherited Destroy; @@ -362,6 +540,8 @@ var len: integer; st: integer; begin + if ReadOnly then + Exit; if FSelEndLine < 0 then Exit; @@ -410,84 +590,42 @@ begin FCursorPos := selsp; FCursorLine := selsl; + FSelStartPos := FCursorPos; + FSelEndPos := FCursorPos; + FSelStartLine := selsl; FSelEndLine := -1; end; procedure TfpgMemo.DoCopy; -var - n: integer; - selsl: integer; - selsp: integer; - selel: integer; - selep: integer; - ls: string; - len: integer; - st: integer; - s: string; begin if FSelEndLine < 0 then Exit; - if (FSelStartLine shl 16) + FSelStartPos <= (FSelEndLine shl 16) + FSelEndPos then - begin - selsl := FSelStartLine; - selsp := FSelStartPos; - selel := FSelEndLine; - selep := FSelEndPos; - end - else - begin - selel := FSelStartLine; - selep := FSelStartPos; - selsl := FSelEndLine; - selsp := FSelEndPos; - end; - - s := ''; - - for n := selsl to selel do - begin - if n > selsl then - s := s + #13#10; - - ls := GetLineText(n); - - if selsl < n then - st := 0 - else - st := selsp; - - if selel > n then - len := UTF8Length(ls) - else - len := selep - st; - - s := s + UTF8Copy(ls, st + 1, len); - end; - - //SetClipboardText(s); + fpgClipboard.Text := SelectionText; end; -procedure TfpgMemo.DoPaste; -{ +procedure TfpgMemo.DoPaste(const AText: TfpgString); var - s: string; - si: string; - si8: string; - lineend: string; + s: TfpgString; + si: TfpgString; { beginning of line to cursor } + si8: TfpgString; + lineend: TfpgString; { from cursor to end of line } n: integer; l: integer; lcnt: integer; -} begin - Exit; - (* + if ReadOnly then + Exit; DeleteSelection; - s := GetClipboardText; + s := AText; si := UTF8Copy(CurrentLine,1,FCursorPos); lineend := UTF8Copy(CurrentLine,FCursorPos+1, UTF8Length(CurrentLine)); - l := FCursorLine; + if FCursorLine = -1 then { first time in, FLines has no data yet } + l := 0 + else + l := FCursorLine; + n := 1; lcnt := 0; si8 := ''; @@ -495,8 +633,10 @@ begin begin if (s[n] = #13) or (s[n] = #10) then begin - if lcnt = 0 then SetLineText(l, si + si8) - else FLines.Insert(l-1, si + si8); + if lcnt = 0 then + SetLineText(l, si + si8) + else + FLines.Insert(l, si + si8); si := ''; si8 := ''; @@ -524,13 +664,13 @@ begin end else begin - FLines.Insert(l-1, si); + FLines.Insert(l, si); FCursorLine := l; end; AdjustCursor; + ResetSelectionVariables; Repaint; -*) end; procedure TfpgMemo.AdjustCursor; @@ -747,6 +887,12 @@ begin inherited; end; +procedure TfpgMemo.RePaint; +begin + if FUpdateCount <= 0 then + inherited RePaint; +end; + procedure TfpgMemo.VScrollBarMove(Sender: TObject; position: integer); begin if FFirstLine <> position then @@ -783,7 +929,7 @@ begin InflateRect(r, -2, -2); Canvas.SetClipRect(r); - if Enabled then + if Enabled and not ReadOnly then Canvas.SetColor(FBackgroundColor) else Canvas.SetColor(clWindowBackground); @@ -895,31 +1041,35 @@ begin prevval := Text; s := AText; - // Printable characters only - // Note: This is now UTF-8 compliant! - if (Ord(AText[1]) > 31) and (Ord(AText[1]) < 127) or (Length(AText) > 1) then + if (not consumed) and (not ReadOnly) then begin - if (FMaxLength <= 0) or (UTF8Length(FLines.Text) < FMaxLength) then + // Printable characters only + // Note: This is now UTF-8 compliant! + if (Ord(AText[1]) > 31) and (Ord(AText[1]) < 127) or (Length(AText) > 1) then begin - if FCursorLine < 0 then - FCursorLine := 0; - DeleteSelection; - ls := GetLineText(FCursorLine); - UTF8Insert(s, ls, FCursorPos + 1); - SetLineText(FCursorLine, ls); - Inc(FCursorPos); - FSelStartPos := FCursorPos; - FSelStartLine := FCursorLine; - FSelEndLine := -1; - AdjustCursor; + if (FMaxLength <= 0) or (UTF8Length(FLines.Text) < FMaxLength) then + begin + if FCursorLine < 0 then + FCursorLine := 0; + DeleteSelection; + ls := GetLineText(FCursorLine); + UTF8Insert(s, ls, FCursorPos + 1); + SetLineText(FCursorLine, ls); + Inc(FCursorPos); + FSelStartPos := FCursorPos; + FSelStartLine := FCursorLine; + FSelEndLine := -1; + AdjustCursor; + end; + + consumed := True; end; - consumed := True; + if prevval <> Text then + if Assigned(FOnChange) then + FOnChange(self); end; - if prevval <> Text then - if Assigned(FOnChange) then - FOnChange(self); if consumed then RePaint; @@ -932,15 +1082,8 @@ var ls: string; ls2: string; hasChanged: boolean; - - procedure StopSelection; - begin - FSelStartLine := FCursorLine; - FSelStartPos := FCursorPos; - FSelEndLine := -1; - end; - begin + fpgApplication.HideHint; Consumed := True; hasChanged := False; case CheckClipBoardKey(keycode, shiftstate) of @@ -950,14 +1093,19 @@ begin end; ckPaste: begin - DoPaste; - hasChanged := True; + DoPaste(fpgClipboard.Text); + if not ReadOnly then + hasChanged := True; end; ckCut: begin DoCopy; DeleteSelection; - hasChanged := True; + if not ReadOnly then + begin + AdjustCursor; + hasChanged := True; + end; end; else Consumed := False; @@ -974,7 +1122,6 @@ begin if FCursorPos > 0 then begin Dec(FCursorPos); - if (ssCtrl in shiftstate) then // word search... (* @@ -984,14 +1131,12 @@ begin while (FCursorPos > 0) and pgfIsAlphaNum(copy(CurrentLine,FCursorPos,1)) do Dec(FCursorPos); *); - end;// left keyRight: if FCursorPos < UTF8Length(CurrentLine) then begin Inc(FCursorPos); - if (ssCtrl in shiftstate) then // word search... (* @@ -1001,7 +1146,6 @@ begin while (FCursorPos < length(CurrentLine)) and not pgfIsAlphaNum(copy(CurrentLine,FCursorPos+1,1)) do Inc(FCursorPos); *); - end;// right keyUp: @@ -1074,11 +1218,11 @@ begin FSelEndLine := FCursorLine; end else - StopSelection; + ResetSelectionVariables; end; end; - if not Consumed then + if (not Consumed) and (not ReadOnly) then begin consumed := True; @@ -1118,7 +1262,7 @@ begin keyDelete: begin ls := GetLineText(FCursorLine); - if FSelEndLine > -1 then + if SelectionText <> '' then DeleteSelection else if FCursorPos < UTF8Length(ls) then begin @@ -1165,8 +1309,8 @@ begin if Consumed then begin - StopSelection; AdjustCursor; + ResetSelectionVariables; end; end; @@ -1190,6 +1334,7 @@ var ls: string; begin inherited HandleLMouseDown(x, y, shiftstate); + ResetSelectionVariables; // searching the appropriate character position lnum := FFirstLine + (y - FSideMargin) div LineHeight; @@ -1219,9 +1364,11 @@ begin begin FSelEndLine := lnum; FSelEndpos := cp; + FSelecting := True; end else begin + FSelecting := False; FSelStartLine := lnum; FSelStartPos := cp; FSelEndLine := -1; @@ -1229,11 +1376,22 @@ begin Repaint; end; +procedure TfpgMemo.HandleRMouseDown(x, y: integer; shiftstate: TShiftState); +begin + // keyMenu was pressed + if shiftstate = [ssExtra1] then + HandleRMouseUp(x, y, []) + else + inherited HandleRMouseDown(x, y, shiftstate); +end; + procedure TfpgMemo.HandleRMouseUp(x, y: integer; shiftstate: TShiftState); begin inherited HandleRMouseUp(x, y, shiftstate); if Assigned(PopupMenu) then - PopupMenu.ShowAt(self, x, y); + PopupMenu.ShowAt(self, x, y) + else + ShowDefaultPopupMenu(x, y, ShiftState); end; procedure TfpgMemo.HandleMouseMove(x, y: integer; btnstate: word; shiftstate: TShiftState); @@ -1276,6 +1434,7 @@ begin FSelEndLine := lnum; FSelEndPos := cp; FCursorPos := cp; + FSelecting := True; Repaint; end; @@ -1396,23 +1555,105 @@ begin end; end; -function TfpgMemo.SelectionText: string; +function TfpgMemo.SelectionText: TfpgString; +var + n: integer; + selsl: integer; + selsp: integer; + selel: integer; + selep: integer; + ls: string; + len: integer; + st: integer; + s: TfpgString; begin - { - if FSelOffset <> 0 then + if (FSelStartLine shl 16) + FSelStartPos <= (FSelEndLine shl 16) + FSelEndPos then begin - if FSelOffset < 0 then - begin - Result := Copy(FText,1+FSelStart + FSelOffset,-FSelOffset); - end - else - begin - result := Copy(FText,1+FSelStart,FSelOffset); - end; + selsl := FSelStartLine; + selsp := FSelStartPos; + selel := FSelEndLine; + selep := FSelEndPos; end else -} - Result := ''; + begin + selel := FSelStartLine; + selep := FSelStartPos; + selsl := FSelEndLine; + selsp := FSelEndPos; + end; + + s := ''; + for n := selsl to selel do + begin + if n > selsl then + s := s + LineEnding; + + ls := GetLineText(n); + + if selsl < n then + st := 0 + else + st := selsp; + + if selel > n then + len := UTF8Length(ls) + else + len := selep - st; + + s := s + UTF8Copy(ls, st + 1, len); + end; + + Result := s; +end; + +procedure TfpgMemo.CopyToClipboard; +begin + DoCopy; +end; + +procedure TfpgMemo.CutToClipboard; +begin + DoCopy; + DeleteSelection; + AdjustCursor; + ResetSelectionVariables; + RePaint; +end; + +procedure TfpgMemo.PasteFromClipboard; +begin + DoPaste(fpgClipboard.Text); +end; + +procedure TfpgMemo.Clear; +begin + FLines.Clear; + { not sure if all of these are required } + FFirstLine := 0; + FCursorLine := 0; + FCursorPos := 0; + FSelStartPos := FCursorPos; + FSelEndPos := 0; + FSelStartLine := -1; + FSelEndLine := -1; + FDrawOffset := 0; + + Repaint; +end; + +procedure TfpgMemo.BeginUpdate; +begin + Inc(FUpdateCount); +end; + +procedure TfpgMemo.EndUpdate; +begin + Dec(FUpdateCount); + if FUpdateCount <= 0 then + begin + Invalidate; + UpdateScrollBars; + end; end; function TfpgMemo.GetText: TfpgString; diff --git a/src/gui/fpg_menu.pas b/src/gui/fpg_menu.pas index 06e64b6f..dbe3a90a 100644 --- a/src/gui/fpg_menu.pas +++ b/src/gui/fpg_menu.pas @@ -123,7 +123,7 @@ type procedure HandlePaint; override; procedure HandleShow; override; procedure HandleClose; override; - procedure DrawItem(mi: TfpgMenuItem; rect: TfpgRect; const AItemFocused: boolean); virtual; + procedure DrawItem(mi: TfpgMenuItem; rect: TfpgRect; AFlags: TfpgMenuItemFlags); virtual; procedure DrawRow(line: integer; const AItemFocused: boolean); virtual; function ItemHeight(mi: TfpgMenuItem): integer; virtual; procedure PrepareToShow; @@ -150,10 +150,13 @@ type FMenuOptions: TfpgMenuOptions; FPrevFocusItem: integer; FFocusItem: integer; + FClicked: Boolean; + FLastItemClicked: integer; procedure SetFocusItem(const AValue: integer); procedure DoSelect; procedure CloseSubmenus; function ItemWidth(mi: TfpgMenuItem): integer; + procedure InternalReset; protected FItems: TList; // stores visible items only property FocusItem: integer read FFocusItem write SetFocusItem; @@ -407,6 +410,8 @@ var begin inherited HandleMouseMove(x, y, btnstate, shiftstate); + newf := CalcMouseCol(x); + // process menu options if mnuo_nofollowingmouse in FMenuOptions then begin @@ -415,17 +420,19 @@ begin end else if mnuo_autoopen in FMenuOptions then begin - if not Focused then - ActivateMenu; +// if not Focused then + FLastItemClicked := newf; + FClicked := True; + ActivateMenu; end else begin - if not Focused then - Exit; + if not FClicked then + exit + else + FLastItemClicked := newf; end; - - newf := CalcMouseCol(x); if not VisibleItem(newf).Selectable then Exit; //==> @@ -452,17 +459,31 @@ begin if ComponentCount = 0 then Exit; // We have no menu items in MainMenu. + + newf := CalcMouseCol(x); + if (FLastItemClicked <> -1) and (FLastItemClicked <> newf) then + begin + // do nothing + //FClicked := not FClicked + end + else + begin + if VisibleItem(newf).Selectable then + FClicked := not FClicked; + end; - if not Focused then + if FClicked then + begin ActivateMenu; - //else - //begin - //CloseSubmenus; - //DeActivateMenu; - //Exit; //==> - //end; - - newf := CalcMouseCol(x); + FLastItemClicked := newf; + end + else + begin + CloseSubmenus; + DeActivateMenu; + FLastItemClicked := -1; + exit; //==> + end; if not VisibleItem(newf).Selectable then Exit; //==> @@ -531,7 +552,9 @@ begin FBeforeShow := nil; FFocusItem := -1; FPrevFocusItem := -1; + FLastItemClicked := -1; FFocusable := False; + FClicked := False; FBackgroundColor := Parent.BackgroundColor; FTextColor := Parent.TextColor; // calculate the best height based on font @@ -554,6 +577,12 @@ begin Result := fpgStyle.MenuFont.TextWidth(mi.Text) + (2*6); end; +procedure TfpgMenuBar.InternalReset; +begin + FClicked := False; + FLastItemClicked := -1; +end; + procedure TfpgMenuBar.DrawColumn(col: integer; focus: boolean); var n: integer; @@ -736,6 +765,7 @@ begin Result:= TfpgMenuItem(Components[AMenuPos]); end; + { TfpgPopupMenu } procedure TfpgPopupMenu.DoSelect; @@ -765,7 +795,11 @@ begin op.Close; op := op.OpenerPopup; end; + // notify menubar that we clicked a menu item + if Assigned(OpenerMenuBar) then + OpenerMenuBar.InternalReset; VisibleItem(FFocusItem).Click; + FFocusItem := -1; end; { if/else } // if OpenerMenuBar <> nil then @@ -1017,35 +1051,32 @@ begin Result := TfpgMenuItem(FItems.Items[ind]); end; -procedure TfpgPopupMenu.DrawItem(mi: TfpgMenuItem; rect: TfpgRect; const AItemFocused: boolean); +procedure TfpgPopupMenu.DrawItem(mi: TfpgMenuItem; rect: TfpgRect; AFlags: TfpgMenuItemFlags); var s: string; x: integer; img: TfpgImage; + lFlags: TfpgMenuItemFlags; begin + lFlags := AFlags; if mi.Separator then begin - Canvas.SetColor(clShadow1); - Canvas.DrawLine(rect.Left+1, rect.Top+2, rect.Right, rect.Top+2); - Canvas.SetColor(clHilite2); - Canvas.DrawLine(rect.Left+1, rect.Top+3, rect.Right, rect.Top+3); + fpgStyle.DrawMenuItemSeparator(Canvas, rect); end else begin // process Check mark if needed if mi.Checked then begin - img := fpgImages.GetImage('stdimg.check'); // Do NOT localize - if AItemFocused then - img.Invert; - Canvas.DrawImage(rect.Left, rect.Top, img); - if AItemFocused then - img.Invert; // restore image to original state + lFlags := lFlags + [mifChecked]; + fpgStyle.DrawMenuItemImage(Canvas, rect.Left, rect.Top, rect, lFlags); + lFlags := lFlags - [mifChecked]; end; // process menu item Text x := rect.Left + FSymbolWidth + FTextMargin; mi.DrawText(Canvas, x+cImgWidth, rect.top, cImgWidth); + Canvas.SetColor(Canvas.TextColor); // reset text default color // process menu item Hot Key text if mi.HotKeyDef <> '' then @@ -1057,10 +1088,9 @@ begin // process menu item submenu arrow image if mi.SubMenu <> nil then begin - Canvas.SetColor(Canvas.TextColor); - x := (rect.height div 2) - 3; - img := fpgImages.GetImage('sys.sb.right'); // Do NOT localize - Canvas.DrawImage(rect.right-x-2, rect.Top + ((rect.Height-img.Height) div 2), img); + lFlags := lFlags + [mifSubMenu]; + fpgStyle.DrawMenuItemImage(Canvas, rect.Left, rect.Top, rect, lFlags); + lFlags := lFlags - [mifSubMenu]; end; end; end; @@ -1070,25 +1100,33 @@ var n: integer; r: TfpgRect; mi: TfpgMenuItem; + lFlags: TfpgMenuItemFlags; begin - Canvas.BeginDraw; r.SetRect(FMargin, FMargin, FWidth-(2*FMargin), FHeight-(2*FMargin)); for n := 0 to VisibleCount-1 do begin mi := VisibleItem(n); - + lFlags := []; r.height := ItemHeight(mi); if line = n then begin + if AItemFocused then + lFlags := [mifSelected]; // refering to menu item in active popup menu + if mi.Separator then + lFlags := lFlags + [mifSeparator]; if AItemFocused and (not mi.Separator) then begin - if MenuFocused then + if MenuFocused then // refering to popup menu window begin + lFlags := lFlags + [mifHasFocus]; Canvas.SetColor(clSelection); if mi.Selectable then - Canvas.SetTextColor(clSelectionText) + begin + lFlags := lFlags + [mifEnabled]; + Canvas.SetTextColor(clSelectionText); + end else Canvas.SetTextColor(clMenuDisabled); end @@ -1102,6 +1140,7 @@ begin begin if mi.Enabled then begin + lFlags := lFlags + [mifEnabled]; Canvas.SetColor(BackgroundColor); Canvas.SetTextColor(clMenuText); end @@ -1111,9 +1150,9 @@ begin Canvas.SetTextColor(clMenuDisabled); end; end; - Canvas.FillRectangle(r); - DrawItem(mi, r, AItemFocused); - Canvas.EndDraw(r.Left, r.Top, r.Width, r.Height); + fpgStyle.DrawMenuRow(Canvas, r, lFlags); + DrawItem(mi, r, lFlags); + Exit; //==> end; inc(r.Top, ItemHeight(mi) ); diff --git a/src/gui/fpg_panel.pas b/src/gui/fpg_panel.pas index b58b516d..66ed5778 100644 --- a/src/gui/fpg_panel.pas +++ b/src/gui/fpg_panel.pas @@ -73,8 +73,11 @@ type protected procedure HandlePaint; override; published + property AcceptDrops; + property Align; property BackgroundColor; property BorderStyle; + property Enabled; property Height; property Hint; property Left; @@ -91,6 +94,10 @@ type property Width; property OnClick; property OnDoubleClick; + property OnDragDrop; + property OnDragEnter; + property OnDragLeave; + property OnDragStartDetected; property OnMouseDown; property OnMouseMove; property OnMouseUp; @@ -129,9 +136,12 @@ type destructor Destroy; override; property Font: TfpgFont read FFont; published + property AcceptDrops; + property Align; property Alignment: TAlignment read GetAlignment write SetAlignment default taCenter; property BackgroundColor; property BorderStyle; + property Enabled; property FontDesc: string read GetFontDesc write SetFontDesc; property Height; property Hint; @@ -154,6 +164,11 @@ type property WrapText: boolean read GetWrapText write SetWrapText default False; property OnClick; property OnDoubleClick; + property OnDragDrop; + property OnDragEnter; + property OnDragLeave; + property OnDragStartDetected; + property OnPaint; property OnShowHint; end; @@ -180,9 +195,12 @@ type function GetClientRect: TfpgRect; override; property Font: TfpgFont read FFont; published + property AcceptDrops; + property Align; property Alignment: TAlignment read GetAlignment write SetAlignment default taLeftJustify; property BackgroundColor; property BorderStyle; + property Enabled; property FontDesc: string read GetFontDesc write SetFontDesc; property Height; property Hint; @@ -201,6 +219,11 @@ type property Width; property OnClick; property OnDoubleClick; + property OnDragDrop; + property OnDragEnter; + property OnDragLeave; + property OnDragStartDetected; + property OnPaint; property OnShowHint; end; @@ -209,7 +232,7 @@ function CreateBevel(AOwner: TComponent; ALeft, ATop, AWidth, AHeight: TfpgCoord AStyle: TPanelStyle): TfpgBevel; function CreatePanel(AOwner: TComponent; ALeft, ATop, AWidth, AHeight: TfpgCoord; AText: string; - AStyle: TPanelStyle; AALignment: TAlignment= taCenter; ALayout: TLayout= tlCenter; + AStyle: TPanelStyle = bsRaised; AALignment: TAlignment= taCenter; ALayout: TLayout= tlCenter; AMargin: integer= 2; ALineSpace: integer= 2): TfpgPanel; function CreateGroupBox(AOwner: TComponent; ALeft, ATop, AWidth, AHeight: TfpgCoord; AText: string; @@ -333,21 +356,24 @@ begin else Canvas.SetLineStyle(2, lsSolid); + { top } if FPanelBorder = bsSingle then Canvas.DrawLine(0, 0, Width - 1, 0) else Canvas.DrawLine(0, 1, Width - 1, 1); + { left } if FPanelBorder = bsSingle then Canvas.DrawLine(0, 1, 0, Height - 1) else Canvas.DrawLine(1, 1, 1, Height - 1); if Style = bsRaised then - Canvas.SetColor(clShadow2) + Canvas.SetColor(clShadow1) else Canvas.SetColor(clHilite2); + { right, then bottom } Canvas.DrawLine(Width - 1, 0, Width - 1, Height - 1); Canvas.DrawLine(0, Height - 1, Width, Height - 1); end; @@ -597,7 +623,7 @@ begin if Style = bsRaised then Canvas.SetColor(clHilite2) else - Canvas.SetColor(clShadow2); + Canvas.SetColor(clShadow1); if FPanelBorder = bsSingle then begin @@ -611,7 +637,7 @@ begin end; if Style = bsRaised then - Canvas.SetColor(clShadow2) + Canvas.SetColor(clShadow1) else Canvas.SetColor(clHilite2); diff --git a/src/gui/fpg_popupcalendar.pas b/src/gui/fpg_popupcalendar.pas index af27568b..ea6eb617 100644 --- a/src/gui/fpg_popupcalendar.pas +++ b/src/gui/fpg_popupcalendar.pas @@ -221,12 +221,14 @@ type public constructor Create(AOwner: TComponent); override; published + property Align; property BackgroundColor; { Clicking on calendar Today button will close the popup calendar by default } property CloseOnSelect: boolean read FCloseOnSelect write SetCloseOnSelect default True; property DateFormat: string read FDateFormat write SetDateFormat; property DateValue: TDateTime read FDate write SetDateValue; property DayColor: TfpgColor read FDayColor write SetDayColor; + property Enabled; property FontDesc; property Hint; property HolidayColor: TfpgColor read FHolidayColor write SetHolidayColor; diff --git a/src/gui/fpg_progressbar.pas b/src/gui/fpg_progressbar.pas index ee6b2405..e106577c 100644 --- a/src/gui/fpg_progressbar.pas +++ b/src/gui/fpg_progressbar.pas @@ -60,7 +60,9 @@ type TfpgProgressBar = class(TfpgCustomProgressBar) published + property Align; property BackgroundColor default $c4c4c4; + property Enabled; property Hint; property ShowCaption; property Max; diff --git a/src/gui/fpg_radiobutton.pas b/src/gui/fpg_radiobutton.pas index 9410a000..e04a2b2c 100644 --- a/src/gui/fpg_radiobutton.pas +++ b/src/gui/fpg_radiobutton.pas @@ -61,9 +61,11 @@ type destructor Destroy; override; property Font: TfpgFont read FFont; published + property Align; property AutoSize: boolean read FAutoSize write SetAutoSize default False; property BackgroundColor; property Checked: boolean read FChecked write SetChecked default False; + property Enabled; property FontDesc: string read GetFontDesc write SetFontDesc; property Hint; property BoxLayout: TBoxLayout read GetBoxLayout write SetBoxLayout default tbLeftBox; diff --git a/src/gui/fpg_scrollbar.pas b/src/gui/fpg_scrollbar.pas index 55db9f59..dd0a4c7c 100644 --- a/src/gui/fpg_scrollbar.pas +++ b/src/gui/fpg_scrollbar.pas @@ -43,7 +43,6 @@ type TfpgScrollBarPart = (sbpNone, sbpUpBack, sbpPageUpBack, sbpSlider, sbpDownForward, sbpPageDownForward); - { TfpgScrollBar } TfpgScrollBar = class(TfpgWidget) private @@ -72,7 +71,7 @@ type FMousePosition: TPoint; FOnScroll: TScrollNotifyEvent; procedure ScrollTimer(Sender: TObject); - procedure DrawButton(x, y, w, h: TfpgCoord; const imgname: string; Pressed: Boolean = False); virtual; + procedure DrawButton(x, y, w, h: TfpgCoord; const imgname: string; Pressed: Boolean = False; const ButtonEnabled: Boolean= True); virtual; procedure DrawSlider(recalc: boolean); virtual; procedure HandleLMouseDown(x, y: integer; shiftstate: TShiftState); override; procedure HandleLMouseUp(x, y: integer; shiftstate: TShiftState); override; @@ -98,6 +97,8 @@ type property Min: integer read FMin write SetMin default 0; property Max: integer read FMax write SetMax default 100; property OnScroll: TScrollNotifyEvent read FOnScroll write FOnScroll; + published + property Align; end; @@ -139,13 +140,13 @@ begin Canvas.BeginDraw; // Do not remove - Scrollbars do painting outside HandlePaint as well! if Orientation = orVertical then begin - DrawButton(0, 0, Width, Width, 'sys.sb.up', FScrollbarDownPart = sbpUpBack); - DrawButton(0, Height-Width, Width, Width, 'sys.sb.down', FScrollbarDownPart = sbpDownForward); + DrawButton(0, 0, Width, Width, 'sys.sb.up', (FScrollbarDownPart = sbpUpBack) and (FPosition <> FMin), (FPosition <> FMin) and (Parent.Enabled)); + DrawButton(0, Height-Width, Width, Width, 'sys.sb.down', (FScrollbarDownPart = sbpDownForward) and (FPosition <> FMax), (FPosition <> FMax) and (Parent.Enabled)); end else begin - DrawButton(0, 0, Height, Height, 'sys.sb.left', FScrollbarDownPart = sbpUpBack); - DrawButton(Width-Height, 0, Height, Height, 'sys.sb.right', FScrollbarDownPart = sbpDownForward); + DrawButton(0, 0, Height, Height, 'sys.sb.left', (FScrollbarDownPart = sbpUpBack) and (FPosition <> FMin), (FPosition <> FMin) and (Parent.Enabled)); + DrawButton(Width-Height, 0, Height, Height, 'sys.sb.right', (FScrollbarDownPart = sbpDownForward) and (FPosition <> FMax), (FPosition <> FMax) and (Parent.Enabled)); end; DrawSlider(FRecalc); @@ -323,9 +324,9 @@ begin end; // only called from inside HandlePaint so no need for BeginDraw..EndDraw calls -procedure TfpgScrollBar.DrawButton(x, y, w, h: TfpgCoord; const imgname: string; Pressed: Boolean = False); +procedure TfpgScrollBar.DrawButton(x, y, w, h: TfpgCoord; const imgname: string; Pressed: Boolean = False; const ButtonEnabled: Boolean= True); var - img: TfpgImage; + img, imgdisabled: TfpgImage; dx: integer; dy: integer; begin @@ -344,7 +345,16 @@ begin Canvas.SetColor(clText1); img := fpgImages.GetImage(imgname); if img <> nil then - Canvas.DrawImage(x + w div 2 - (img.Width div 2) + dx, y + h div 2 - (img.Height div 2) + dy, img); + begin + if ButtonEnabled then + Canvas.DrawImage(x + w div 2 - (img.Width div 2) + dx, y + h div 2 - (img.Height div 2) + dy, img) + else + begin + imgdisabled := img.CreateDisabledImage; + Canvas.DrawImage(x + w div 2 - (img.Width div 2) + dx, y + h div 2 - (img.Height div 2) + dy, imgdisabled); + imgdisabled.Free; + end; + end; end; // only called from inside HandlePaint so no need for BeginDraw..EndDraw calls @@ -516,14 +526,13 @@ begin if FScrollbarDownPart = sbpSlider then begin FSliderDragStart := FSliderPos; - Invalidate; //DrawSlider(False); + Invalidate; end else if not (FScrollbarDownPart in [sbpNone, sbpSlider]) then begin FScrollTimer.Interval := 300; FScrollTimer.Enabled := True; - - Invalidate; //HandlePaint; + Invalidate; end; end; @@ -540,7 +549,7 @@ begin FScrollbarDownPart := sbpNone; if WasPressed then - Invalidate; //HandlePaint; + Invalidate; end; procedure TfpgScrollBar.HandleMouseMove(x, y: integer; btnstate: word; shiftstate: TShiftState); diff --git a/src/gui/fpg_spinedit.pas b/src/gui/fpg_spinedit.pas index 21548f97..99c4e697 100644 --- a/src/gui/fpg_spinedit.pas +++ b/src/gui/fpg_spinedit.pas @@ -327,10 +327,7 @@ end; procedure TfpgAbstractSpinEdit.HandlePaint; begin - Canvas.Clear(BackgroundColor); - if FButtonUp.HasHandle then - fpgPostMessage(self, FButtonUp, FPGM_PAINT); -// FButtonDown.Invalidate; + Canvas.Clear(BackgroundColor); end; procedure TfpgAbstractSpinEdit.HandleResize(AWidth, AHeight: TfpgCoord); @@ -385,15 +382,11 @@ var begin r := AButton.GetClientRect; - InflateRect(r, -1, -1); // button borders + InflateRect(r, -2, -2); // button borders if AButton.Down then OffsetRect(r, 1, 1); - // TfpgRect to TRect - Result.Left := r.Left; - Result.Top := r.Top; - Result.Right := r.Right; - Result.Bottom := r.Bottom; + Result := fpgRectToRect(r); end; procedure TfpgAbstractSpinEdit.ButtonUpPaint(Sender: TObject); @@ -707,6 +700,11 @@ begin begin FValue := FValue + FIncrement; FEdit.Value := FValue; + end + else if not IsMaxLimitReached then + begin + FValue := FMaxValue; + FEdit.Value := FValue; end; if KeyCode = KeyDown then @@ -714,6 +712,11 @@ begin begin FValue := FValue - FIncrement; FEdit.Value := FValue; + end + else if not IsMinLimitReached then + begin + FValue := FMinValue; + FEdit.Value := FValue; end; if KeyCode = KeyPageUp then @@ -1110,9 +1113,13 @@ begin begin FValue := 0; FEdit.Value := FValue; + DoOnChange; end else if (StrToInt(FEdit.Text) <= FMaxValue) and (StrToInt(FEdit.Text) >= FMinValue) then - FValue := FEdit.Value + begin + FValue := FEdit.Value; + DoOnChange; + end else FEdit.Value := FValue; @@ -1121,6 +1128,13 @@ begin begin Inc(FValue, FIncrement); FEdit.Value := FValue; + DoOnChange; + end + else if not IsMaxLimitReached then + begin + FValue := FMaxValue; + FEdit.Value := FValue; + DoOnChange; end; if KeyCode = KeyDown then @@ -1128,18 +1142,27 @@ begin begin Dec(FValue, FIncrement); FEdit.Value := FValue; + DoOnChange; + end + else if not IsMinLimitReached then + begin + FValue := FMinValue; + FEdit.Value := FValue; + DoOnChange; end; if KeyCode = KeyPageUp then begin FValue := FMaxValue; FEdit.Value := FValue; + DoOnChange; end; if KeyCode = KeyPageDown then begin FValue := FMinValue; FEdit.Value := FValue; + DoOnChange; end; EnableButtons; diff --git a/src/gui/fpg_splitter.pas b/src/gui/fpg_splitter.pas index 6094656b..8790b58e 100644 --- a/src/gui/fpg_splitter.pas +++ b/src/gui/fpg_splitter.pas @@ -28,14 +28,11 @@ uses fpg_main, fpg_widget; -const - clColorGrabBar = $839EFE; // Pale navy blue - cSplitterWidth = 8; type - NaturalNumber = 1..High(Integer); + TfpgSnapEvent = procedure(Sender: TObject; const AClosed: boolean) of object; TfpgSplitter = class(TfpgWidget) private @@ -49,18 +46,21 @@ type FOldSize: Integer; FSplit: Integer; FMouseOver: Boolean; + FOnSnap: TfpgSnapEvent; procedure CalcSplitSize(X, Y: Integer; out NewSize, Split: Integer); function FindControl: TfpgWidget; procedure SetColorGrabBar(const AValue: TfpgColor); procedure UpdateControlSize; procedure UpdateSize(const X, Y: Integer); protected + procedure DoOnSnap(const AClosed: Boolean); function DoCanResize(var NewSize: Integer): Boolean; virtual; procedure HandleLMouseDown(x, y: integer; shiftstate: TShiftState); override; procedure HandleLMouseUp(x, y: integer; shiftstate: TShiftState); override; procedure HandleMouseMove(x, y: integer; btnstate: word; shiftstate: TShiftState); override; procedure HandleMouseEnter; override; procedure HandleMouseExit; override; + procedure HandleDoubleClick(x, y: integer; button: word; shiftstate: TShiftState); override; procedure HandlePaint; override; procedure StopSizing; dynamic; Procedure DrawGrabBar(ARect: TfpgRect); virtual; @@ -68,7 +68,10 @@ type constructor Create(AOwner: TComponent); override; destructor Destroy; override; published - property ColorGrabBar: TfpgColor read FColorGrabBar write SetColorGrabBar default clColorGrabBar; + property Align; + property AutoSnap: boolean read FAutoSnap write FAutoSnap default True; + property ColorGrabBar: TfpgColor read FColorGrabBar write SetColorGrabBar default clSplitterGrabBar; + property OnSnap: TfpgSnapEvent read FOnSnap write FOnSnap; end; function CreateSplitter(AOwner: TComponent; ALeft, ATop, AWidth, AHeight: TfpgCoord; @@ -76,6 +79,10 @@ function CreateSplitter(AOwner: TComponent; ALeft, ATop, AWidth, AHeight: TfpgCo implementation +const + cSplitterWidth = 8; + + function CreateSplitter(AOwner: TComponent; ALeft, ATop, AWidth, AHeight: TfpgCoord; AnAlign: TAlign): TfpgSplitter; begin @@ -127,12 +134,11 @@ var r: TfpgRect; begin Result := nil; - p := Point(Left, Top); case Align of - alLeft: Dec(p.X); - alRight: Inc(p.X, Width); - alTop: Dec(p.Y); - alBottom: Inc(p.Y, Height); + alLeft: p := Point(Left-2, Top + (Height div 2)); + alRight: p := Point(Right+2, Top + (Height div 2)); + alTop: p := Point(Left + (Width div 2), Top-2); + alBottom: p := Point(Left + (Width div 2), Bottom+2); else Exit; end; @@ -174,16 +180,10 @@ begin begin case Align of alLeft, alRight: -// FControl.Width := FNewSize; // (1) - FControl.SetPosition(FControl.Left, FControl.Top, FNewSize, FControl.Height); // (2) + FControl.SetPosition(FControl.Left, FControl.Top, FNewSize, FControl.Height); alTop, alBottom: -// FControl.Height := FNewSize; // (1) - FControl.SetPosition(FControl.Left, FControl.Top, FControl.Width, FNewSize); // (2) + FControl.SetPosition(FControl.Left, FControl.Top, FControl.Width, FNewSize); end; -// FControl.UpdateWindowPosition; // (1) - // vvzh: - // Lines marked with (1) work wrong under Linux (e.g. folding/unfolding Memo1) - // Lines marked with (2) work OK under both platforms. Why? Parent.Realign; // if Assigned(FOnMoved) then FOnMoved(Self); FOldSize := FNewSize; @@ -195,12 +195,21 @@ begin CalcSplitSize(X, Y, FNewSize, FSplit); end; +procedure TfpgSplitter.DoOnSnap(const AClosed: Boolean); +begin + if Assigned(FOnSnap) then + FOnSnap(self, AClosed); +end; + function TfpgSplitter.DoCanResize(var NewSize: Integer): Boolean; begin // Result := CanResize(NewSize); // omit onCanResize call Result := True; if Result and (NewSize <= FMinSize) and FAutoSnap then + begin NewSize := 0; + DoOnSnap(NewSize = 0); + end; end; procedure TfpgSplitter.HandleLMouseDown(x, y: integer; shiftstate: TShiftState); @@ -238,7 +247,9 @@ begin Inc(FMaxSize, FControl.Height); end; UpdateSize(X, Y); + CaptureMouse; + {AllocateLineDC; with ValidParentForm(Self) do if ActiveControl <> nil then @@ -304,13 +315,40 @@ begin Repaint; end; +procedure TfpgSplitter.HandleDoubleClick(x, y: integer; button: word; + shiftstate: TShiftState); +begin + inherited HandleDoubleClick(x, y, button, shiftstate); + if FAutoSnap then + begin + if FNewSize = 0 then + begin + FNewSize := FMinSize+1; + DoCanResize(FNewSize); + end + else + begin + FNewSize := 0; + DoCanResize(FNewSize); + end; + end; +end; + procedure TfpgSplitter.HandlePaint; var lRect: TfpgRect; begin Canvas.SetColor(clWindowBackground); Canvas.FillRectangle(GetClientRect); - + + { just to make it's borders more visible in the designer } + if csDesigning in ComponentState then + begin + Canvas.SetColor(clInactiveWgFrame); + Canvas.SetLineStyle(1, lsDash); + Canvas.DrawRectangle(0, 0, Width, Height); + end; + case Align of alRight, alLeft: @@ -459,7 +497,7 @@ begin // FResizeStyle := rsPattern; FOldSize := -1; FMouseOver := False; - FColorGrabBar := clColorGrabBar; + FColorGrabBar := clSplitterGrabBar; end; destructor TfpgSplitter.Destroy; diff --git a/src/gui/fpg_tab.pas b/src/gui/fpg_tab.pas index 9999fa83..66f73d2d 100644 --- a/src/gui/fpg_tab.pas +++ b/src/gui/fpg_tab.pas @@ -71,6 +71,8 @@ type property PageControl: TfpgPageControl read FPageControl write SetPageControl; property TabVisible: boolean read FTabVisible write FTabVisible; published + property BackgroundColor; + property Enabled; property Text: string read GetText write SetText; property OnPaint; end; @@ -99,6 +101,7 @@ type FTabPosition: TfpgTabPosition; FPopupMenu: TfpgPopupMenu; FTabOptions: TfpgTabOptions; + FLastRClickPos: TfpgPoint; function GetActivePageIndex: integer; function GetPage(AIndex: integer): TfpgTabSheet; function GetPageCount: Integer; @@ -135,6 +138,7 @@ type public constructor Create(AOwner: TComponent); override; destructor Destroy; override; + function TabSheetAtPos(const x, y: integer): TfpgTabSheet; function AppendTabSheet(ATitle: string): TfpgTabSheet; procedure RemoveTabSheet(ATabSheet: TfpgTabSheet); property PageCount: Integer read GetPageCount; @@ -144,7 +148,9 @@ type property OnClosingTabSheet: TTabSheetClosing read FOnClosingTabSheet write FOnClosingTabSheet; published property ActivePageIndex: integer read GetActivePageIndex write SetActivePageIndex; + property Align; property BackgroundColor; + property Enabled; property FixedTabWidth: integer read FFixedTabWidth write SetFixedTabWidth default 0; property FixedTabHeight: integer read FFixedTabHeight write SetFixedTabHeight default 21; property Hint; @@ -636,9 +642,11 @@ procedure TfpgPageControl.pmCloseTab(Sender: TObject); var ts: TfpgTabSheet; begin - ts := ActivePage; + ts := TabSheetAtPos(FLastRClickPos.x, FLastRClickPos.y); + if not Assigned(ts) then + ts := ActivePage; if ts = nil then - Exit; + exit; RemovePage(ts); DoTabSheetClosing(ts); ts.Free; @@ -978,104 +986,48 @@ end; procedure TfpgPageControl.HandleLMouseUp(x, y: integer; shiftstate: TShiftState); var - h: TfpgTabSheet; - lp: integer; // left position - bw: integer; // button width - bh: integer; // button height - p1, p2: integer; // tab boundaries for mouse click to take affect + ts: TfpgTabSheet; begin // debugln('>> TfpgPageControl.HandleLMouseUp'); - h := TfpgTabSheet(FPages.First); - if h = nil then - Exit; //==> - - lp := FMargin; - if MaxButtonWidthSum > (Width-(FMargin*2)) then - h := FFirstTabButton; - - case TabPosition of - tpTop: - begin - p1 := FMargin; - p2 := ButtonHeight; - end; - - tpBottom: - begin - p1 := Height - FMargin - ButtonHeight; - p2 := Height - FMargin; - end; - - tpRight: - begin - p1 := Width - MaxButtonWidth; - p2 := Width; - end; - - tpLeft: - begin - p1 := FMargin; - p2 := FMargin + MaxButtonWidth; - end; - end; - - if TabPosition in [tpTop, tpBottom] then - begin - if (y > p1) and (y < p2) then - begin - while h <> nil do - begin - bw := ButtonWidth(h.Text); // initialize button width - if (x > lp) and (x < lp + bw) then - begin - if h <> ActivePage then - ActivePage := h; - exit; - end; { if } - lp := lp + bw; - if h <> TfpgTabSheet(FPages.Last) then - h := TfpgTabSheet(FPages[FPages.IndexOf(h)+1]) - else - h := nil; - end; { while } - end; { if } - end; - - if TabPosition in [tpLeft, tpRight] then - begin - if (x > p1) and (x < p2) then - begin - while h <> nil do - begin - bh := ButtonHeight; // initialize button height - if (y > lp) and (y < lp + bh) then - begin - if h <> ActivePage then - ActivePage := h; - exit; - end; { if } - lp := lp + bh; - if h <> TfpgTabSheet(FPages.Last) then - h := TfpgTabSheet(FPages[FPages.IndexOf(h)+1]) - else - h := nil; - end; { while } - end; { if } - end; + ts := TfpgTabSheet(FPages.First); + if ts = nil then + exit; //==> { This means there are no tabs } + + ts := TabSheetAtPos(x, y); + + if Assigned(ts) then + ActivePage := ts; inherited HandleLMouseUp(x, y, shiftstate); end; procedure TfpgPageControl.HandleRMouseUp(x, y: integer; shiftstate: TShiftState); +var + ts: TfpgTabSheet; + s: TfpgString; begin inherited HandleRMouseUp(x, y, shiftstate); -// ShowDefaultPopupMenu(x, y, ShiftState); + + { store the position for later usage } + FLastRClickPos := fpgPoint(x,y); + if to_PMenuClose in FTabOptions then begin + ts := TabSheetAtPos(x, y); + {$NOTE TODO: This text needs to become a resource string } + if Assigned(ts) then + s := Format('Close "%s" Tab', [ts.Text]) + else + s := 'Close Tab'; + if not Assigned(FPopupMenu) then begin FPopupMenu := TfpgPopupMenu.Create(self); - FPopupMenu.AddMenuItem('Close Tab', '', @pmCloseTab); + FPopupMenu.AddMenuItem(s, '', @pmCloseTab); + end + else + begin + FPopupMenu.MenuItem(0).Text := s; { This is dangerous but works for now } end; FPopupMenu.ShowAt(self, x, y); end; @@ -1160,6 +1112,92 @@ begin inherited Destroy; end; +function TfpgPageControl.TabSheetAtPos(const x, y: integer): TfpgTabSheet; +var + h: TfpgTabSheet; + lp: integer; // left position + bw: integer; // button width + bh: integer; // button height + p1, p2: integer; // tab boundaries for mouse click to take affect +begin + Result := nil; + h := TfpgTabSheet(FPages.First); + + lp := FMargin; + if MaxButtonWidthSum > (Width-(FMargin*2)) then + h := FFirstTabButton; + + case TabPosition of + tpTop: + begin + p1 := FMargin; + p2 := ButtonHeight; + end; + + tpBottom: + begin + p1 := Height - FMargin - ButtonHeight; + p2 := Height - FMargin; + end; + + tpRight: + begin + p1 := Width - MaxButtonWidth; + p2 := Width; + end; + + tpLeft: + begin + p1 := FMargin; + p2 := FMargin + MaxButtonWidth; + end; + end; + + if TabPosition in [tpTop, tpBottom] then + begin + if (y > p1) and (y < p2) then + begin + while h <> nil do + begin + bw := ButtonWidth(h.Text); // initialize button width + if (x > lp) and (x < lp + bw) then + begin + if h <> ActivePage then + Result := h; + exit; + end; { if } + lp := lp + bw; + if h <> TfpgTabSheet(FPages.Last) then + h := TfpgTabSheet(FPages[FPages.IndexOf(h)+1]) + else + h := nil; + end; { while } + end; { if } + end; + + if TabPosition in [tpLeft, tpRight] then + begin + if (x > p1) and (x < p2) then + begin + while h <> nil do + begin + bh := ButtonHeight; // initialize button height + if (y > lp) and (y < lp + bh) then + begin + if h <> ActivePage then + Result := h; + exit; + end; { if } + lp := lp + bh; + if h <> TfpgTabSheet(FPages.Last) then + h := TfpgTabSheet(FPages[FPages.IndexOf(h)+1]) + else + h := nil; + end; { while } + end; { if } + end; +end; + function TfpgPageControl.AppendTabSheet(ATitle: string): TfpgTabSheet; begin Result := TfpgTabSheet.Create(self); diff --git a/src/gui/fpg_trackbar.pas b/src/gui/fpg_trackbar.pas index 524a4c4c..9134a96d 100644 --- a/src/gui/fpg_trackbar.pas +++ b/src/gui/fpg_trackbar.pas @@ -68,6 +68,7 @@ type public constructor Create(AOwner: TComponent); override; published + property Align; property BackgroundColor; property Hint; property Min: integer read FMin write SetMin default 0; @@ -115,7 +116,9 @@ type constructor Create(AOwner: TComponent); override; destructor Destroy; override; published + property Align; property BackgroundColor; + property Enabled; property Position: integer read FPosition write SetTBPosition default 0; property ScrollStep: integer read FScrollStep write FScrollStep default 1; property Min: integer read FMin write SetMin default 0; diff --git a/src/gui/fpg_tree.pas b/src/gui/fpg_tree.pas index b61b0c29..570e1011 100644 --- a/src/gui/fpg_tree.pas +++ b/src/gui/fpg_tree.pas @@ -48,6 +48,8 @@ uses type + TfpgNodeAttachMode = (naAdd, naAddFirst, naAddChild, naAddChildFirst, naInsert); + PfpgTreeColumnWidth = ^TfpgTreeColumnWidth; TfpgTreeColumnWidth = record next: PfpgTreeColumnWidth; @@ -55,6 +57,7 @@ type end; // forward declaration + TfpgTreeView = class; TfpgTreeNode = class; TfpgTreeNodeFindMethod = procedure(ANode: TfpgTreeNode; var AFound: boolean) of object; @@ -77,6 +80,7 @@ type FText: TfpgString; FTextColor: TfpgColor; FHasChildren: Boolean; + FTree: TfpgTreeView; procedure SetCollapsed(const AValue: boolean); procedure SetInactSelColor(const AValue: TfpgColor); procedure SetInactSelTextColor(const AValue: TfpgColor); @@ -87,6 +91,7 @@ type procedure SetTextColor(const AValue: TfpgColor); procedure DoRePaint; procedure SetHasChildren(const AValue: Boolean); + procedure DoTreeCheck(ANode: TfpgTreeNode); public constructor Create; destructor Destroy; override; @@ -99,11 +104,12 @@ type function FindSubNode(AData: TObject; ARecursive: Boolean): TfpgTreeNode; overload; function GetMaxDepth: integer; function GetMaxVisibleDepth: integer; - procedure Append(var aValue: TfpgTreeNode); + procedure Append(var ANode: TfpgTreeNode); procedure Clear; // remove all nodes recursively procedure Collapse; procedure Expand; procedure Remove(var aNode: TfpgTreeNode); + procedure MoveTo(Destination: TfpgTreeNode; Mode: TfpgNodeAttachMode); procedure UnregisterSubNode(aNode: TfpgTreeNode); // parent color settings function ParentInactSelColor: TfpgColor; @@ -203,12 +209,6 @@ type procedure DrawHeader(ACol: integer; ARect: TfpgRect; AFlags: integer); virtual; procedure DoChange; virtual; procedure DoExpand(ANode: TfpgTreeNode); virtual; - // only visual (visible) nodes - function NextVisualNode(ANode: TfpgTreeNode): TfpgTreeNode; - function PrevVisualNode(ANode: TfpgTreeNode): TfpgTreeNode; - // any next node, even if node is collapsed - function NextNode(ANode: TfpgTreeNode): TfpgTreeNode; - function PrevNode(ANode: TfpgTreeNode): TfpgTreeNode; // the nodes between the given node and the direct next node function SpaceToVisibleNext(aNode: TfpgTreeNode): integer; function StepToRoot(aNode: TfpgTreeNode): integer; @@ -220,6 +220,14 @@ type function GetColumnWidth(AIndex: word): word; procedure GotoNextNodeUp; procedure GotoNextNodeDown; + procedure FullCollapse; + procedure FullExpand; + // any next node, even if node is collapsed + function NextNode(ANode: TfpgTreeNode): TfpgTreeNode; + function PrevNode(ANode: TfpgTreeNode): TfpgTreeNode; + // only visual (visible) nodes + function NextVisualNode(ANode: TfpgTreeNode): TfpgTreeNode; + function PrevVisualNode(ANode: TfpgTreeNode): TfpgTreeNode; property Font: TfpgFont read FFont; // Invisible node that starts the tree property RootNode: TfpgTreeNode read GetRootNode; @@ -227,7 +235,9 @@ type property ImageList: TfpgImageList read FImageList write FImageList; property PopupMenu: TfpgPopupMenu read FPopupMenu write FPopupMenu; published + property Align; property DefaultColumnWidth: word read FDefaultColumnWidth write SetDefaultColumnWidth default 15; + property Enabled; property FontDesc: string read GetFontDesc write SetFontDesc; property IndentNodeWithNoImage: boolean read FIndentNodeWithNoImage write SetIndentNodeWithNoImage default True; property NoImageIndent: integer read FNoImageIndent write FNoImageIndent default 16; @@ -346,6 +356,12 @@ begin end; end; +procedure TfpgTreeNode.DoTreeCheck(ANode: TfpgTreeNode); +begin + if ANode.FTree <> FTree then + raise Exception.Create('Nodes must be of the same tree'); +end; + constructor TfpgTreeNode.Create; begin FData := nil; @@ -404,20 +420,21 @@ begin end; end; -procedure TfpgTreeNode.Append(var aValue: TfpgTreeNode); +procedure TfpgTreeNode.Append(var ANode: TfpgTreeNode); begin - aValue.Parent := self; - aValue.Next := nil; + DoTreeCheck(ANode); + ANode.Parent := self; + ANode.Next := nil; if FFirstSubNode = nil then - FFirstSubNode := aValue; + FFirstSubNode := ANode; - aValue.prev := FLastSubNode; + ANode.Prev := FLastSubNode; if FLastSubNode <> nil then - FLastSubNode.Next := aValue; + FLastSubNode.Next := ANode; - FLastSubNode := aValue; + FLastSubNode := ANode; end; function TfpgTreeNode.FindSubNode(AText: string; ARecursive: Boolean): TfpgTreeNode; @@ -536,6 +553,7 @@ begin writeln('TfpgTreeNode.AppendText'); {$ENDIF} h := TfpgTreeNode.Create; + h.FTree := FTree; h.Text := AText; Append(h); result := h; @@ -659,6 +677,53 @@ begin aNode.parent := nil; end; +procedure TfpgTreeNode.MoveTo(Destination: TfpgTreeNode; Mode: TfpgNodeAttachMode); +begin + if Destination = nil then + Exit; + DoTreeCheck(Destination); + + Parent.Remove(self); + case Mode of + naAdd: + begin + Destination.Parent.Append(self); + end; + naAddFirst: + begin + Next := Destination.Parent.FirstSubNode; + Next.Prev := self; + Destination.Parent.FFirstSubNode := self; + Parent := Destination.Parent; + end; + naAddChild: + begin + Destination.Append(self); + end; + naAddChildFirst: + begin + Next := Destination.FirstSubNode; + if Assigned(Destination.FirstSubNode) then + Destination.FirstSubNode.Prev := self; + Destination.FFirstSubNode := self; + Parent := Destination; + if Destination.LastSubNode = nil then + Destination.FLastSubNode := self; + end; + naInsert: + begin + Prev := Destination.Prev; + Next := Destination; + Parent := Destination.Parent; + Destination.Prev := self; + if Prev = nil then + Parent.FFirstSubNode := self + else + Prev.Next := self; + end; + end; { case } +end; + procedure TfpgTreeNode.Clear; var n: TfpgTreeNode; @@ -758,7 +823,10 @@ end; function TfpgTreeview.GetRootNode: TfpgTreeNode; begin if FRootNode = nil then + begin FRootNode := TfpgTreeNode.Create; + FRootNode.FTree := self; + end; FRootNode.TextColor := clText1; FRootnode.SelTextColor := clSelectionText; FRootnode.SelColor := clSelection; @@ -796,10 +864,14 @@ begin n := AValue.Parent; while n <> nil do begin - n.Expand; - DoExpand(n); + if n.Collapsed then + begin + n.Expand; + DoExpand(n); + end; n := n.parent; end; + UpdateScrollbars; end; dy := GetAbsoluteNodeTop(FSelection); @@ -809,7 +881,7 @@ begin begin if FVScrollBar.Max = 0 then // the first time and no expansion happened before. FVScrollBar.Max := dy + Height; - FVScrollbar.Position := dy + nh - vh; + FVScrollbar.Position := dy + nh - (vh div 2); FYOffset := FVScrollbar.Position; UpdateScrollBars; if FHScrollbar.Visible then // HScrollbar appeared so we need to adjust position again @@ -1082,10 +1154,45 @@ begin end; procedure TfpgTreeView.GotoNextNodeDown; +var + lNode: TfpgTreeNode; begin - if Selection = RootNode.LastSubNode then + if (Selection = RootNode.LastSubNode) and (RootNode.LastSubNode.CountRecursive = 0) then Exit; - Selection := NextNode(Selection); + + lNode := NextNode(Selection); + if lNode <> nil then + Selection := lNode; +end; + +procedure TfpgTreeView.FullCollapse; +var + n: TfpgTreeNode; +begin + n := NextNode(RootNode); + repeat + if n <> nil then + begin + n.Collapse; + end; + n := NextNode(n); + until n = nil; + Repaint; +end; + +procedure TfpgTreeView.FullExpand; +var + n: TfpgTreeNode; +begin + n := NextNode(RootNode); + repeat + if n <> nil then + begin + n.Expand; + end; + n := NextNode(n); + until n = nil; + Repaint; end; procedure TfpgTreeview.PreCalcColumnLeft; @@ -1126,8 +1233,11 @@ begin FVScrollbar.Visible := VisibleHeight < (GetNodeHeightSum * GetNodeHeight); FVScrollbar.Min := 0; FVScrollbar.Max := (GetNodeHeightSum * GetNodeHeight) - VisibleHeight + FHScrollbar.Height; + FVScrollbar.PageSize := (VisibleHeight div 4) * 3; // three quarters of the height + FVScrollbar.ScrollStep := GetNodeHeight; // up/down buttons move the height of the font FHScrollbar.Min := 0; FHScrollbar.Max := MaxNodeWidth - VisibleWidth + FVScrollbar.Width; + FHScrollbar.PageSize := (VisibleWidth div 4) * 3; // three quarters of the height FHScrollbar.Visible := MaxNodeWidth > Width - 2; if not FVScrollbar.Visible then begin @@ -1224,7 +1334,7 @@ begin x := x + FXOffset; cancel := False; last := RootNode; - while not (((i - 1) * GetNodeHeight - 2 <= y) and ((i) * GetNodeHeight + 2 >= y)) do + while not ((((i - 1) * GetNodeHeight) <= y) and ((i * GetNodeHeight) >= y)) do begin node := NextVisualNode(last); if node = nil then @@ -1430,25 +1540,26 @@ begin Canvas.SetColor(h.ParentInactSelColor); Canvas.SetTextColor(h.ParentInActSelTextColor); end; - Canvas.FillRectangle(w - FXOffset, YPos - FYOffset + col - GetNodeHeight + FFont.Ascent div 2 - 2, GetNodeWidth(h), GetNodeHeight); + // draw selection rectangle + Canvas.FillRectangle(w - FXOffset, ACenterPos - (GetNodeHeight div 2), GetNodeWidth(h), GetNodeHeight); if (ImageList <> nil) and ShowImages then begin AImageItem := ImageList.Item[h.ImageIndex]; if AImageItem <> nil then begin - Canvas.DrawImagePart(w - FXOffset + 1, ACenterPos - 4, AImageItem.Image, 0, 0, 16, 16); - Canvas.DrawString(w - FXOffset + 1 + AImageItem.Image.Width + 2, ACenterPos - FFont.Ascent div 2, h.text); + Canvas.DrawImagePart(w - FXOffset + 1, ACenterPos - 8, AImageItem.Image, 0, 0, 16, 16); + Canvas.DrawString(w - FXOffset + 1 + AImageItem.Image.Width + 2, ACenterPos - (GetNodeHeight div 2), h.text); end else begin if FIndentNodeWithNoImage then - Canvas.DrawString(w - FXOffset + 1 + FNoImageIndent + 2 {spacer}, ACenterPos - FFont.Ascent div 2, h.text) + Canvas.DrawString(w - FXOffset + 1 + FNoImageIndent + 2 {spacer}, ACenterPos - (GetNodeHeight div 2), h.text) else - Canvas.DrawString(w - FXOffset + 1, ACenterPos - FFont.Ascent div 2, h.text); + Canvas.DrawString(w - FXOffset + 1, ACenterPos - (GetNodeHeight div 2), h.text); end; end else - Canvas.DrawString(w - FXOffset + 1, ACenterPos - FFont.Ascent div 2, h.text); + Canvas.DrawString(w - FXOffset + 1, ACenterPos - (GetNodeHeight div 2), h.text); Canvas.SetTextColor(h.ParentTextColor); end else @@ -1458,19 +1569,19 @@ begin AImageItem := ImageList.Item[h.ImageIndex]; if AImageItem <> nil then begin - Canvas.DrawImagePart(w - FXOffset + 1, ACenterPos - 4, AImageItem.Image, 0, 0, 16, 16); - Canvas.DrawString(w - FXOffset + 1 + AImageItem.Image.Width + 2, ACenterPos - FFont.Ascent div 2, h.text); + Canvas.DrawImagePart(w - FXOffset + 1, ACenterPos - 8, AImageItem.Image, 0, 0, 16, 16); + Canvas.DrawString(w - FXOffset + 1 + AImageItem.Image.Width + 2, ACenterPos - (GetNodeHeight div 2), h.text); end else begin if FIndentNodeWithNoImage then - Canvas.DrawString(w - FXOffset + 1 + FNoImageIndent + 2 {spacer}, ACenterPos - FFont.Ascent div 2, h.text) + Canvas.DrawString(w - FXOffset + 1 + FNoImageIndent + 2 {spacer}, ACenterPos - (GetNodeHeight div 2), h.text) else - Canvas.DrawString(w - FXOffset + 1, ACenterPos - FFont.Ascent div 2, h.text); + Canvas.DrawString(w - FXOffset + 1, ACenterPos - (GetNodeHeight div 2), h.text); end end else - Canvas.DrawString(w - FXOffset + 1, ACenterPos - FFont.Ascent div 2, h.text); + Canvas.DrawString(w - FXOffset + 1, ACenterPos - (GetNodeHeight div 2), h.text); end; { if/else } Canvas.SetLineStyle(1, FTreeLineStyle); @@ -1680,7 +1791,16 @@ begin Selection := RootNode.FirstSubNode; end; end; - + + keyPageUp: + begin + FVScrollbar.PageUp; + end; + + keyPageDown: + begin + FVScrollbar.PageDown; + end; else Consumed := False; end; @@ -1699,23 +1819,25 @@ procedure TfpgTreeview.HandleMouseScroll(x, y: integer; shiftstate: TShiftState; delta: smallint); var i: integer; + dy: integer; begin inherited HandleMouseScroll(x, y, shiftstate, delta); - if delta > 0 then + dy := (VisibleHeight div 3); // mouse scrolling is 1/3 of the height + if delta > 0 then // scrolling down begin - inc(FYOffset, FScrollWheelDelta); + inc(FYOffset, dy); //FScrollWheelDelta); i := (GetNodeHeightSum * GetNodeHeight) - VisibleHeight + FHScrollbar.Height; if FYOffset > i then FYOffset := i; - i := FVScrollbar.Position + FScrollWheelDelta; + i := FVScrollbar.Position + dy; FVScrollbar.Position := i; end else - begin - dec(FYOffset, FScrollWheelDelta); + begin // scrolling up + dec(FYOffset, dy); //FScrollWheelDelta); if FYOffset < 0 then FYOffset := 0; - i := FVScrollbar.Position - FScrollWheelDelta; + i := FVScrollbar.Position - dy; FVScrollbar.Position := i; end; UpdateScrollbars; @@ -1807,7 +1929,7 @@ function TfpgTreeView.NextNode(ANode: TfpgTreeNode): TfpgTreeNode; begin while ANode.Next = nil do begin - ANode := ANode.Parent; + ANode := ANode.Parent; // back out one level depth if ANode = nil then exit; //==> end; diff --git a/src/gui/inputquerydialog.inc b/src/gui/inputquerydialog.inc index 5b063233..094a58e2 100644 --- a/src/gui/inputquerydialog.inc +++ b/src/gui/inputquerydialog.inc @@ -30,6 +30,7 @@ type btnCancel: TfpgButton; {@VFD_HEAD_END: fpgQueryDialog} procedure SetupCaptions; + procedure edtTextKeyPressed(Sender: TObject; var KeyCode: word; var ShiftState: TShiftState; var Consumed: boolean); public procedure AfterCreate; override; end; @@ -47,8 +48,10 @@ begin try dlg.WindowTitle := ACaption; dlg.lblText.Text := APrompt; + dlg.edtText.Text := Value; Result := dlg.ShowModal = mrOK; - Value := dlg.edtText.Text; + if Result then + Value := dlg.edtText.Text; finally dlg.Free; end; @@ -62,6 +65,12 @@ begin btnCancel.Text := rsCancel; end; +procedure TfpgQueryDialog.edtTextKeyPressed(Sender: TObject; var KeyCode: word; var ShiftState: TShiftState; var Consumed: boolean); +begin + if KeyCode = keyEnter then + btnOK.Click; +end; + procedure TfpgQueryDialog.AfterCreate; begin {%region 'Auto-generated GUI code' -fold} @@ -94,6 +103,7 @@ begin TabOrder := 2; Text := ''; FontDesc := '#Edit1'; + OnKeyPress := @edtTextKeyPressed; end; btnOK := TfpgButton.Create(self); diff --git a/src/gui/managebookmarksdialog.inc b/src/gui/managebookmarksdialog.inc new file mode 100644 index 00000000..ceef4cba --- /dev/null +++ b/src/gui/managebookmarksdialog.inc @@ -0,0 +1,227 @@ +{ + fpGUI - Free Pascal GUI Toolkit + + Copyright (C) 2006 - 2010 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: + This unit contains the dialog to manage bookmarks from the + File Open/Save dialog. +} + +{%mainunit fpg_dialogs.pas} + +{$IFDEF read_interface} + + TConfigureBookmarksForm = class(TfpgForm) + private + {@VFD_HEAD_BEGIN: ConfigureBookmarksForm} + grdBookmarks: TfpgStringGrid; + btnChangeTitle: TfpgButton; + btnDelete: TfpgButton; + btnClose: TfpgButton; + btnMoveUp: TfpgButton; + btnMoveDown: TfpgButton; + {@VFD_HEAD_END: ConfigureBookmarksForm} + FIni: TfpgIniFile; + procedure SetupCaptions; + procedure PopulateGrid; + procedure UpdateINIFile; + procedure btnChangeTitleClicked(Sender: TObject); + procedure btnDeleteClicked(Sender: TObject); + public + constructor Create(var AIniFile: TfpgIniFile); reintroduce; + destructor Destroy; override; + procedure AfterCreate; override; + end; + + +{$ENDIF read_interface} + +{$IFDEF read_implementation} + +procedure TConfigureBookmarksForm.SetupCaptions; +begin + WindowTitle := rsConfigureBookmarks; + btnClose.Text := rsClose; + btnMoveUp.Text := rsMoveUp; + btnMoveDown.Text := rsMoveDown; + btnChangeTitle.Text := rsChangeTitle; + btnDelete.Text := rsDelete; + grdBookmarks.ColumnTitle[0] := rsName; + grdBookmarks.ColumnTitle[1] := rsDirectory; +end; + +procedure TConfigureBookmarksForm.PopulateGrid; +var + i: integer; + lst: TStringList; +begin + lst := TStringList.Create; + FIni.ReadSection(FPG_BOOKMARK_SECTION, lst); + grdBookmarks.RowCount := lst.Count; + grdBookmarks.BeginUpdate; + for i := 0 to lst.Count-1 do + begin + grdBookmarks.Cells[0, i] := lst[i]; + grdBookmarks.Cells[1, i] := FIni.ReadString(FPG_BOOKMARK_SECTION, lst[i], ''); + end; + grdBookmarks.EndUpdate; + lst.Free; +end; + +procedure TConfigureBookmarksForm.UpdateINIFile; +var + i: integer; +begin + FIni.EraseSection(FPG_BOOKMARK_SECTION); + for i := 0 to grdBookmarks.RowCount-1 do + begin + FIni.WriteString(FPG_BOOKMARK_SECTION, grdBookmarks.Cells[0, i], grdBookmarks.Cells[1, i]); + end; +end; + +procedure TConfigureBookmarksForm.btnChangeTitleClicked(Sender: TObject); +var + s: TfpgString; +begin + if (grdBookmarks.RowCount = 0) or (grdBookmarks.FocusRow = -1) then + Exit; + s := grdBookmarks.Cells[0, grdBookmarks.FocusRow]; + if fpgInputQuery('Bookmark', 'Enter new bookmark name', s) then + begin + s := StringReplace(s, '=', '-', [rfReplaceAll]); // don't allow '=' sign in name (ini file requirement) + grdBookmarks.Cells[0, grdBookmarks.FocusRow] := s; + end; +end; + +procedure TConfigureBookmarksForm.btnDeleteClicked(Sender: TObject); +begin + if (grdBookmarks.RowCount = 0) or (grdBookmarks.FocusRow = -1) then + Exit; + grdBookmarks.DeleteRow(grdBookmarks.FocusRow); +end; + +constructor TConfigureBookmarksForm.Create(var AIniFile: TfpgIniFile); +begin + inherited Create(nil); + FIni := AIniFile; +end; + +destructor TConfigureBookmarksForm.Destroy; +begin + UpdateINIFile; + inherited Destroy; +end; + +procedure TConfigureBookmarksForm.AfterCreate; +begin + {%region 'Auto-generated GUI code' -fold} + {@VFD_BODY_BEGIN: ConfigureBookmarksForm} + Name := 'ConfigureBookmarksForm'; + SetPosition(331, 184, 596, 237); + WindowTitle := 'Configure Bookmarks'; + Hint := ''; + ShowHint := True; + WindowPosition := wpOneThirdDown; + + grdBookmarks := TfpgStringGrid.Create(self); + with grdBookmarks do + begin + Name := 'grdBookmarks'; + SetPosition(8, 8, 473, 218); + Anchors := [anLeft,anRight,anTop,anBottom]; + AddColumn('Title', 150, taLeftJustify); + AddColumn('Directory', 300, taLeftJustify); + FontDesc := '#Grid'; + HeaderFontDesc := '#GridHeader'; + Hint := ''; + RowCount := 0; + RowSelect := True; + TabOrder := 1; + Options := [go_SmoothScroll, go_AlternativeColor] + end; + + btnChangeTitle := TfpgButton.Create(self); + with btnChangeTitle do + begin + Name := 'btnChangeTitle'; + SetPosition(489, 8, 100, 24); + Anchors := [anRight,anTop]; + Text := 'btnChangeTitle'; + FontDesc := '#Label1'; + Hint := ''; + ImageName := ''; + TabOrder := 2; + OnClick := @btnChangeTitleClicked; + end; + + btnDelete := TfpgButton.Create(self); + with btnDelete do + begin + Name := 'btnDelete'; + SetPosition(489, 36, 100, 24); + Anchors := [anRight,anTop]; + Text := 'btnDelete'; + FontDesc := '#Label1'; + Hint := ''; + ImageName := ''; + TabOrder := 3; + OnClick := @btnDeleteClicked; + end; + + btnMoveUp := TfpgButton.Create(self); + with btnMoveUp do + begin + Name := 'btnMoveUp'; + SetPosition(489, 80, 100, 24); + Anchors := [anRight,anTop]; + Text := 'btnMoveUp'; + FontDesc := '#Label1'; + Hint := ''; + ImageName := 'sys.sb.up'; + TabOrder := 4; + end; + + btnMoveDown := TfpgButton.Create(self); + with btnMoveDown do + begin + Name := 'btnMoveDown'; + SetPosition(489, 108, 100, 24); + Anchors := [anRight,anTop]; + Text := 'btnMoveDown'; + FontDesc := '#Label1'; + Hint := ''; + ImageName := 'sys.sb.down'; + TabOrder := 5; + end; + + btnClose := TfpgButton.Create(self); + with btnClose do + begin + Name := 'btnClose'; + SetPosition(489, 204, 100, 24); + Anchors := [anRight,anBottom]; + Text := 'btnClose'; + FontDesc := '#Label1'; + Hint := ''; + ImageName := 'stdimg.close'; + ModalResult := mrOK; + TabOrder := 6; + end; + + {@VFD_BODY_END: ConfigureBookmarksForm} + {%endregion} + + SetupCaptions; + PopulateGrid; +end; +{$ENDIF read_implementation} + diff --git a/src/gui/selectdirdialog.inc b/src/gui/selectdirdialog.inc index d09f11c8..6a96d046 100644 --- a/src/gui/selectdirdialog.inc +++ b/src/gui/selectdirdialog.inc @@ -7,6 +7,7 @@ tv: TfpgTreeView; FRootDir: TfpgString; FShowHidden: Boolean; + FImagelist: TfpgImageList; function GetAbsolutePath(Node: TfpgTreeNode): TfpgString; procedure InitializeTreeview; procedure SetRootDir(const AValue: TfpgString); @@ -19,6 +20,7 @@ {$ENDIF} public constructor Create(AOwner: TComponent); override; + destructor Destroy; override; procedure AfterCreate; override; { return the selected directory or set initial selected dir } property SelectedDir: TfpgString read GetSelectedDir write SetSelectedDir; @@ -158,6 +160,7 @@ begin for i := 0 to SortList.Count - 1 do begin NewNode := Node.AppendText(SortList[i]); + NewNode.ImageIndex := 0; // NewNode := TV.Items.AddChild(Node, SortList[i]); // if subdirectories then indicate so. { Todo: Fix this by adding HasChildren to Treeview } @@ -245,9 +248,20 @@ end; {$ENDIF} constructor TfpgSelectDirDialog.Create(AOwner: TComponent); +var + img: TfpgImage; begin inherited Create(AOwner); FShowHidden := False; + FImagelist := TfpgImageList.Create; + img := fpgImages.GetImage('stdimg.folder').ImageFromSource; + FImageList.AddImage(img); +end; + +destructor TfpgSelectDirDialog.Destroy; +begin + FImagelist.Free; + inherited Destroy; end; procedure TfpgSelectDirDialog.AfterCreate; @@ -263,7 +277,10 @@ begin begin Name := 'tv'; SetPosition(FSpacing, FSpacing, 288, 322); - OnExpand :=@NodeExpanded; + Anchors := [anTop, anLeft, anRight, anBottom]; + ImageList := FImageList; + ShowImages := True; + OnExpand := @NodeExpanded; end; // reposition buttons |