diff options
Diffstat (limited to 'src/gui')
-rw-r--r-- | src/gui/colordialog.inc | 286 | ||||
-rw-r--r-- | src/gui/fpg_basegrid.pas | 242 | ||||
-rw-r--r-- | src/gui/fpg_checkbox.pas | 7 | ||||
-rw-r--r-- | src/gui/fpg_customgrid.pas | 15 | ||||
-rw-r--r-- | src/gui/fpg_dialogs.pas | 43 | ||||
-rw-r--r-- | src/gui/fpg_editcombo.pas | 20 | ||||
-rw-r--r-- | src/gui/fpg_form.pas | 5 | ||||
-rw-r--r-- | src/gui/fpg_grid.pas | 3 | ||||
-rw-r--r-- | src/gui/fpg_listbox.pas | 46 | ||||
-rw-r--r-- | src/gui/fpg_listview.pas | 18 | ||||
-rw-r--r-- | src/gui/fpg_memo.pas | 11 | ||||
-rw-r--r-- | src/gui/fpg_menu.pas | 1 | ||||
-rw-r--r-- | src/gui/fpg_panel.pas | 5 | ||||
-rw-r--r-- | src/gui/fpg_scrollbar.pas | 13 | ||||
-rw-r--r-- | src/gui/fpg_scrollframe.pas | 530 | ||||
-rw-r--r-- | src/gui/fpg_stringgridbuilder.pas | 178 | ||||
-rw-r--r-- | src/gui/fpg_style_win8.pas | 2 | ||||
-rw-r--r-- | src/gui/fpg_tab.pas | 11 | ||||
-rw-r--r-- | src/gui/fpg_toggle.pas | 282 | ||||
-rw-r--r-- | src/gui/fpg_tree.pas | 23 | ||||
-rw-r--r-- | src/gui/inputintegerdialog.inc | 157 | ||||
-rw-r--r-- | src/gui/inputquerydialog.inc | 2 | ||||
-rw-r--r-- | src/gui/selectdirdialog.inc | 5 |
23 files changed, 1762 insertions, 143 deletions
diff --git a/src/gui/colordialog.inc b/src/gui/colordialog.inc index 93d8d731..0ef8c3bb 100644 --- a/src/gui/colordialog.inc +++ b/src/gui/colordialog.inc @@ -1,7 +1,7 @@ { fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2014 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -22,6 +22,28 @@ type + TColorPickedEvent = procedure(Sender: TObject; const AMousePos: TPoint; const AColor: TfpgColor) of object; + + TPickerButton = class(TfpgButton) + private + FContinuousResults: Boolean; + FOnColorPicked: TColorPickedEvent; + FColorPos: TPoint; + FColor: TfpgColor; + FColorPicking: Boolean; + private + procedure DoColorPicked; + protected + 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; + public + constructor Create(AOwner: TComponent); override; + published + property ContinuousResults: Boolean read FContinuousResults write FContinuousResults; + property OnColorPicked: TColorPickedEvent read FOnColorPicked write FOnColorPicked; + end; + TfpgColorSelectDialog = class(TfpgBaseDialog) private {@VFD_HEAD_BEGIN: ColorSelectDialog} @@ -37,19 +59,29 @@ type edR: TfpgSpinEdit; edG: TfpgSpinEdit; edB: TfpgSpinEdit; - Label3: TfpgLabel; - Label4: TfpgLabel; - Label5: TfpgLabel; - pnlColorPreview: TfpgBevel; + lblRed: TfpgLabel; + lblGreen: TfpgLabel; + lblBlue: TfpgLabel; + btnPicker: TPickerButton; + chkContinuous: TfpgCheckBox; + lblHex: TfpgLabel; + edHex: TfpgEdit; {@VFD_HEAD_END: ColorSelectDialog} FViaRGB: Boolean; // to prevent recursive changes + FColorPicking: Boolean; + procedure btnColorPicked(Sender: TObject; const AMousePos: TPoint; const AColor: TfpgColor); + procedure chkContinuousChanged(Sender: TObject); function GetSelectedColor: TfpgColor; procedure SetSelectedColor(const AValue: TfpgColor); procedure ColorChanged(Sender: TObject); + procedure NamedColorChanged(Sender: TObject); procedure RGBChanged(Sender: TObject); procedure UpdateRGBComponents; procedure PopulatePaletteColorCombo; procedure cbColorPaletteChange(Sender: TObject); + procedure OnTabChange(Sender: TObject; tab:TfpgTabSheet); + protected + procedure SetupCaptions; override; public constructor Create(AOwner: TComponent); override; procedure AfterCreate; override; @@ -79,8 +111,120 @@ begin end; end; + +function ConvertToHex(Value: integer): string; +var + ValH, ValL: integer; +begin + ValH := Value div 16; + ValL := Value mod 16; + case ValH of + 15: + Result := 'F'; + 14: + Result := 'E'; + 13: + Result := 'D'; + 12: + Result := 'C'; + 11: + Result := 'B'; + 10: + Result := 'A'; + else + Result := IntToStr(ValH); + end; + case ValL of + 15: + Result := Result + 'F'; + 14: + Result := Result + 'E'; + 13: + Result := Result + 'D'; + 12: + Result := Result + 'C'; + 11: + Result := Result + 'B'; + 10: + Result := Result + 'A'; + else + Result := Result + IntToStr(ValL); + end; +end; + +function Hex(Red, Green, Blue: integer): string; +begin + Result := '$' + ConvertToHex(Red) + ConvertToHex(Green) + ConvertToHex(Blue); +end; + +{ TPickerButton } + +procedure TPickerButton.DoColorPicked; +var + pt: TPoint; +begin + pt := WindowToScreen(self, FColorPos); + FColor := fpgApplication.GetScreenPixelColor(pt); + if Assigned(FOnColorPicked) then + FOnColorPicked(self, FColorPos, FColor); +end; + +procedure TPickerButton.HandleLMouseDown(X, Y: integer; ShiftState: TShiftState); +begin + inherited HandleLMouseDown(X, Y, ShiftState); + MouseCursor := mcCross; + FColorPicking := True; + CaptureMouse; +end; + +procedure TPickerButton.HandleLMouseUp(x, y: integer; shiftstate: TShiftState); +begin + inherited HandleLMouseUp(x, y, shiftstate); + ReleaseMouse; + FColorPicking := False; + MouseCursor := mcDefault; + DoColorPicked; +end; + +procedure TPickerButton.HandleMouseMove(x, y: integer; btnstate: word; + shiftstate: TShiftState); +begin + //inherited HandleMouseMove(x, y, btnstate, shiftstate); + if not FColorPicking then + Exit; + FColorPos.x := x; + FColorPos.y := y; + if FContinuousResults then + DoColorPicked; +end; + +constructor TPickerButton.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FColorPicking := False; + FContinuousResults := False; +end; + { TfpgColorSelectDialog } +procedure TfpgColorSelectDialog.OnTabChange(Sender: TObject; tab:TfpgTabSheet); +begin + if pcColorSelect.ActivePageIndex = 0 then + RGBChanged(sender) + else + NamedColorChanged(sender) ; +end; + +procedure TfpgColorSelectDialog.btnColorPicked(Sender: TObject; const AMousePos: TPoint; const AColor: TfpgColor); +begin + ColorWheel.SetSelectedColor(AColor); +end; + +procedure TfpgColorSelectDialog.chkContinuousChanged(Sender: TObject); +begin + btnPicker.ContinuousResults := chkContinuous.Checked; +end; + function TfpgColorSelectDialog.GetSelectedColor: TfpgColor; begin if pcColorSelect.ActivePageIndex = 0 then @@ -99,7 +243,24 @@ begin // UpdateHSVComponents; if not FViaRGB then UpdateRGBComponents; - pnlColorPreview.BackgroundColor := ValueBar.SelectedColor; +end; + +procedure TfpgColorSelectDialog.NamedColorChanged(Sender: TObject); +var + tred, tgreen, tblue: Byte; +begin + tred := fpgGetRed(ColorListBox1.Color); + tgreen := fpgGetGreen(ColorListBox1.Color); + tblue := fpgGetBlue(ColorListBox1.Color); + + // keep text readable based on background color + if (tred + tgreen + tblue) / (256*3) >0.60 then + edHex.TextColor := clBlack + else + edHex.TextColor := clWhite ; + + edHex.BackgroundColor:=ColorListBox1.Color; + edHex.Text := Hex(tred,tgreen,tblue); end; procedure TfpgColorSelectDialog.RGBChanged(Sender: TObject); @@ -114,6 +275,13 @@ begin c := FPColorTofpgColor(rgb); ColorWheel.SetSelectedColor(c); // This will trigger ColorWheel and ValueBar OnChange event FViaRGB := False; + // keep text readable based on background color + if ValueBar.Value > 0.75 then + edHex.TextColor := clBlack + else + edHex.TextColor := clWhite; + edHex.BackgroundColor := c; + edHex.Text := Hex(rgb.Red, rgb.Green, rgb.Blue); end; procedure TfpgColorSelectDialog.UpdateRGBComponents; @@ -126,6 +294,13 @@ begin edR.Value := rgb.Red; edG.Value := rgb.Green; edB.Value := rgb.Blue; + // keep text readable based on background color + if ValueBar.Value > 0.75 then + edHex.TextColor := clBlack + else + edHex.TextColor := clWhite; + edHex.BackgroundColor := c; + edHex.Text := Hex(rgb.Red, rgb.Green, rgb.Blue); end; procedure TfpgColorSelectDialog.PopulatePaletteColorCombo; @@ -149,21 +324,34 @@ begin ColorListBox1.SetFocus; end; +procedure TfpgColorSelectDialog.SetupCaptions; +begin + inherited SetupCaptions; + tsColorWheel.Text := rsTabsheetColorWheel; + tsColorNames.Text := rsTabPredefined; + lblRed.Text := rsColorRed; + lblGreen.Text := rsColorGreen; + lblBlue.Text := rsColorBlue; + chkContinuous.Text := rsContinuous; + btnPicker.Hint := rsColorPickerHint; + lblHex.Text := rsHexadecimal; +end; + constructor TfpgColorSelectDialog.Create(AOwner: TComponent); begin inherited Create(AOwner); FViaRGB := false; end; - procedure TfpgColorSelectDialog.AfterCreate; begin {%region 'Auto-generated GUI code' -fold} {@VFD_BODY_BEGIN: ColorSelectDialog} Name := 'ColorSelectDialog'; - SetPosition(340, 164, 328, 375); + SetPosition(340, 164, 328, 385); WindowTitle := 'Color Select Dialog'; Hint := ''; + IconName := ''; WindowPosition := wpOneThirdDown; pcColorSelect := TfpgPageControl.Create(self); @@ -172,9 +360,9 @@ begin Name := 'pcColorSelect'; SetPosition(4, 4, 320, 332); Anchors := [anLeft,anRight,anTop,anBottom]; - ActivePageIndex := 0; Hint := ''; TabOrder := 1; + OnChange := @OnTabChange; end; tsColorWheel := TfpgTabSheet.Create(pcColorSelect); @@ -182,6 +370,7 @@ begin begin Name := 'tsColorWheel'; SetPosition(3, 24, 314, 305); + Anchors := [anLeft,anRight,anTop,anBottom]; Text := 'Color Wheel'; end; @@ -190,7 +379,8 @@ begin begin Name := 'tsColorNames'; SetPosition(3, 24, 314, 305); - Text := 'Predefined'; + Anchors := [anLeft,anRight,anTop,anBottom]; + Text := rsTabPredefined; end; cbColorPalette := TfpgComboBox.Create(tsColorNames); @@ -199,9 +389,12 @@ begin Name := 'cbColorPalette'; SetPosition(8, 24, 299, 22); Anchors := [anLeft,anRight,anTop]; + ExtraHint := ''; FontDesc := '#List'; Hint := ''; + FocusItem := -1; TabOrder := 1; + OnChange:= @NamedColorChanged; end; ColorListBox1 := TfpgColorListBox.Create(tsColorNames); @@ -210,10 +403,11 @@ begin Name := 'ColorListBox1'; SetPosition(8, 72, 299, 224); Anchors := [anLeft,anRight,anTop,anBottom]; - Color := TfpgColor($00FFFF); + Color := TfpgColor($FF00FFFF); FontDesc := '#List'; Hint := ''; TabOrder := 2; + OnChange:= @NamedColorChanged; end; Label1 := TfpgLabel.Create(tsColorNames); @@ -282,10 +476,10 @@ begin OnChange := @RGBChanged; end; - Label3 := TfpgLabel.Create(tsColorWheel); - with Label3 do + lblRed := TfpgLabel.Create(tsColorWheel); + with lblRed do begin - Name := 'Label3'; + Name := 'lblRed'; SetPosition(8, 220, 80, 16); Alignment := taRightJustify; FontDesc := '#Label1'; @@ -293,10 +487,10 @@ begin Text := 'Red'; end; - Label4 := TfpgLabel.Create(tsColorWheel); - with Label4 do + lblGreen := TfpgLabel.Create(tsColorWheel); + with lblGreen do begin - Name := 'Label4'; + Name := 'lblGreen'; SetPosition(8, 248, 80, 16); Alignment := taRightJustify; FontDesc := '#Label1'; @@ -304,10 +498,10 @@ begin Text := 'Green'; end; - Label5 := TfpgLabel.Create(tsColorWheel); - with Label5 do + lblBlue := TfpgLabel.Create(tsColorWheel); + with lblBlue do begin - Name := 'Label5'; + Name := 'lblBlue'; SetPosition(8, 276, 80, 16); Alignment := taRightJustify; FontDesc := '#Label1'; @@ -315,17 +509,61 @@ begin Text := 'Blue'; end; - pnlColorPreview := TfpgBevel.Create(tsColorWheel); - with pnlColorPreview do + btnPicker := TPickerButton.Create(tsColorWheel); + with btnPicker do + begin + Name := 'btnPicker'; + SetPosition(167, 230, 23, 23); + Text := ''; + FontDesc := '#Label1'; + Hint := ''; + ImageMargin := -1; + ImageName := 'stdimg.colpicker'; + FShowHint := True; + TabOrder := 24; + OnColorPicked := @btnColorPicked; + end; + + chkContinuous := TfpgCheckBox.Create(tsColorWheel); + with chkContinuous do begin - Name := 'pnlColorPreview'; - SetPosition(248, 232, 52, 52); + Name := 'chkContinuous'; + SetPosition(167, 258, 130, 20); + FontDesc := '#Label1'; + Hint := ''; + TabOrder := 25; + Text := 'Continuous'; + OnChange := @chkContinuousChanged; + end; + + lblHex := TfpgLabel.Create(self); + with lblHex do + begin + Name := 'lblHex'; + SetPosition(25, 340, 100, 15); + Alignment := taCenter; + FontDesc := '#Label1'; + Hint := ''; + Text := 'Hexadecimal'; + end; + + edHex := TfpgEdit.Create(self); + with edHex do + begin + Name := 'edHex'; + SetPosition(25, 356, 100, 23); + ExtraHint := ''; + FontDesc := '#Label1'; Hint := ''; + TabOrder := 3; + Text := ''; + MaxLength:= 7; end; {@VFD_BODY_END: ColorSelectDialog} {%endregion} + FColorPicking := False; // link colorwheel and valuebar ColorWheel.ValueBar := ValueBar; diff --git a/src/gui/fpg_basegrid.pas b/src/gui/fpg_basegrid.pas index 146887b9..2df7b414 100644 --- a/src/gui/fpg_basegrid.pas +++ b/src/gui/fpg_basegrid.pas @@ -32,7 +32,7 @@ uses fpg_widget, fpg_scrollbar, fpg_menu; - + type TfpgGridDrawState = set of (gdSelected, gdFocused, gdFixed); @@ -51,7 +51,7 @@ type // Column 2 is special just for testing purposes. Descendant classes will // override that special behavior anyway. - + TfpgBaseGrid = class(TfpgWidget) private FColResizing: boolean; @@ -79,6 +79,7 @@ type FScrollBarStyle: TfpgScrollStyle; FShowGrid: boolean; FShowHeader: boolean; + FAutoHeight: boolean; FTemp: integer; FVScrollBar: TfpgScrollBar; FHScrollBar: TfpgScrollBar; @@ -89,14 +90,19 @@ type FBorderStyle: TfpgEditBorderStyle; function GetFontDesc: string; function GetHeaderFontDesc: string; + function GetScrollBarWidth: Integer; function GetTotalColumnWidth: integer; function GetAdjustedBorderSizes: TRect; procedure HScrollBarMove(Sender: TObject; position: integer); procedure SetFontDesc(const AValue: string); procedure SetHeaderFontDesc(const AValue: string); + procedure SetHeaderHeight(const AValue: integer); procedure SetHeaderStyle(const AValue: TfpgGridHeaderStyle); procedure SetRowSelect(const AValue: boolean); procedure SetScrollBarStyle(const AValue: TfpgScrollStyle); + function GetScrollBarPage: integer; + procedure SetScrollBarPage(const AValue: integer); + procedure SetScrollBarWidth(const AValue: integer); procedure VScrollBarMove(Sender: TObject; position: integer); procedure SetDefaultColWidth(const AValue: integer); procedure SetDefaultRowHeight(const AValue: integer); @@ -105,10 +111,12 @@ type procedure CheckFocusChange; procedure SetShowGrid(const AValue: boolean); procedure SetShowHeader(const AValue: boolean); + procedure SetAutoHeight(const AValue: boolean); function VisibleLines: Integer; procedure SetFirstRow(const AValue: Integer); procedure SetAlternativeBGColor(const AValue: TfpgColor); procedure SetBorderStyle(AValue: TfpgEditBorderStyle); + function AdjustHeight: Integer; protected property UpdateCount: integer read FUpdateCount; procedure UpdateScrollBars; virtual; @@ -133,6 +141,7 @@ type procedure HandleResize(awidth, aheight: TfpgCoord); override; procedure HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: boolean); override; procedure HandleMouseScroll(x, y: integer; shiftstate: TShiftState; delta: smallint); override; + procedure HandleMouseHorizScroll(x, y: integer; shiftstate: TShiftState; delta: smallint); override; procedure HandleMouseMove(x, y: integer; btnstate: word; shiftstate: TShiftState); override; procedure HandleLMouseUp(x, y: integer; shiftstate: TShiftState); override; procedure HandleLMouseDown(x, y: integer; shiftstate: TShiftState); override; @@ -156,8 +165,11 @@ type property RowCount: Integer read GetRowCount; property ShowHeader: boolean read FShowHeader write SetShowHeader default True; property ShowGrid: boolean read FShowGrid write SetShowGrid default True; + property AutoHeight: boolean read FAutoHeight write SetAutoHeight default False; property ScrollBarStyle: TfpgScrollStyle read FScrollBarStyle write SetScrollBarStyle default ssAutoBoth; - property HeaderHeight: integer read FHeaderHeight; + property ScrollBarPage: Integer read GetScrollBarPage write SetScrollBarPage; + property ScrollBarWidth: Integer read GetScrollBarWidth write SetScrollBarWidth; + property HeaderHeight: integer read FHeaderHeight write SetHeaderHeight; property TotalColumnWidth: integer read GetTotalColumnWidth; // property ColResizing: boolean read FColResizing write FColResizing; property ColumnWidth[ACol: Integer]: integer read GetColumnWidth write SetColumnWidth; @@ -223,6 +235,11 @@ begin Result := FHeaderFont.FontDesc; end; +function TfpgBaseGrid.GetScrollBarWidth: Integer; +begin + Result := FVScrollBar.Width; +end; + function TfpgBaseGrid.GetTotalColumnWidth: integer; var i: integer; @@ -276,6 +293,13 @@ begin RePaint; end; +procedure TfpgBaseGrid.SetHeaderHeight(const AValue: integer); +begin + if AValue >= FHeaderFont.Height + 2 then + FHeaderHeight := AValue; + Repaint; +end; + procedure TfpgBaseGrid.SetHeaderStyle(const AValue: TfpgGridHeaderStyle); begin if FHeaderStyle = AValue then @@ -299,6 +323,28 @@ begin FScrollBarStyle := AValue; end; +function TfpgBaseGrid.GetScrollBarPage: integer; +begin + Result:= FVScrollBar.PageSize; +end; + +procedure TfpgBaseGrid.SetScrollBarPage(const AValue: integer); +begin + if AValue= FVScrollBar.PageSize then + Exit; //==> + FVScrollBar.PageSize:= AValue; +end; + +procedure TfpgBaseGrid.SetScrollBarWidth(const AValue: integer); +begin + if FVScrollBar.Width = AValue then + Exit; //==> + FVScrollBar.Width := AValue; + FHScrollBar.Height:= AValue; + if FAutoHeight then + Height := AdjustHeight; +end; + procedure TfpgBaseGrid.VScrollBarMove(Sender: TObject; position: integer); begin if FFirstRow <> position then @@ -549,6 +595,15 @@ begin RePaint; end; +procedure TfpgBaseGrid.SetAutoHeight(const AValue: boolean); +begin + if FAutoHeight= AValue then + Exit; //==> + FAutoHeight := AValue; + if FAutoHeight then + Height := AdjustHeight; +end; + // Return the fully visible lines only. Partial lines not counted function TfpgBaseGrid.VisibleLines: Integer; var @@ -611,6 +666,28 @@ begin Repaint; end; +function TfpgBaseGrid.AdjustHeight: Integer; +var + r: TRect; +begin + if FAutoHeight then + begin + r := GetAdjustedBorderSizes; + if FShowHeader then + if (FScrollBarStyle = ssHorizontal) or (FScrollBarStyle = ssAutoBoth) then + Result := Succ(((Height - r.Bottom * 2 - HeaderHeight - FHScrollBar.Height) div DefaultRowHeight) * DefaultRowHeight + HeaderHeight + FHScrollBar.Height + r.Bottom * 2) + else + Result := Succ(((Height - r.Bottom * 2 - HeaderHeight) div DefaultRowHeight) * DefaultRowHeight + HeaderHeight + r.Bottom * 2) + else + if (FScrollBarStyle = ssHorizontal) or (FScrollBarStyle = ssAutoBoth) then + Result := Succ(((Height - r.Bottom * 2 - FHScrollBar.Height) div DefaultRowHeight) * DefaultRowHeight + FHScrollBar.Height + r.Bottom * 2) + else + Result := Succ(((Height - r.Bottom * 2) div DefaultRowHeight) * DefaultRowHeight + r.Bottom * 2); + if Align = alBottom then + Top := Top + Height - result; + end; +end; + procedure TfpgBaseGrid.UpdateScrollBars; var HWidth: integer; @@ -620,8 +697,10 @@ var vl: integer; i: integer; x: integer; - Hfits, showH: boolean; - Vfits, showV: boolean; + hmax: integer; + vmax: integer; + Hfits, showH : boolean; + Vfits, showV : boolean; crect: TfpgRect; borders: TRect; @@ -634,7 +713,7 @@ var UpdateWindowPosition; end; end; - + procedure getVisWidth; begin if showV then @@ -657,6 +736,22 @@ var Vfits := vl >= RowCount; end; + function ColMax: integer; + var + i: integer; + w: integer; + begin + w := 0; + Result := 0; + for i := 0 to ColumnCount-1 do + begin + w := w + ColumnWidth[i]; + if w > Width then + inc(Result); + end; + inc(Result); + end; + begin // if we don't want any scrollbars, hide them and exit if FScrollBarStyle = ssNone then @@ -678,7 +773,7 @@ begin showH := False; getVisWidth; getVisLines; - + // determine whether to show scrollbars for different configurations case FScrollBarStyle of ssHorizontal: @@ -722,6 +817,25 @@ begin getVisLines; end; end; + ssHorizVisible: + begin + hideScrollbar (FVScrollBar); + showH := true; + getVisLines; + end; + ssVertiVisible: + begin + hideScrollbar (FHScrollBar); + showV := true; + getVisWidth; + end; + ssBothVisible: + begin + showV := true; + showH := true; + getVisLines; + getVisWidth; + end; end; // set the scrollbar width/height space @@ -740,7 +854,10 @@ begin FVScrollBar.SliderSize := VisibleLines / RowCount else FVScrollBar.SliderSize := 0; - FVScrollBar.Max := RowCount-VisibleLines; + vmax := RowCount - VisibleLines; + if FFirstRow > vmax then + FFirstRow := vmax; + FVScrollBar.Max := vmax; FVScrollBar.Position := FFirstRow; FVScrollBar.RepaintSlider; FVScrollBar.Top := borders.Top; @@ -761,18 +878,20 @@ begin FHScrollBar.Min := 0; if go_SmoothScroll in FOptions then begin - FHScrollBar.Max := cw - vw; + hmax := cw - vw; + FHScrollBar.Max := hmax; + if FXOffset>hmax then + FXOffset:=hmax; FHScrollBar.Position := FXOffset; - FHScrollBar.SliderSize := HWidth / TotalColumnWidth; FHScrollBar.PageSize := 5; end else begin - FHScrollBar.Max := ColumnCount-1; + FHScrollBar.Max := ColMax; FHScrollBar.Position := FFirstCol; - FHScrollBar.SliderSize := 1 / ColumnCount; FHScrollBar.PageSize := 1; end; + FHScrollBar.SliderSize := HWidth / TotalColumnWidth; FHScrollBar.RepaintSlider; FHScrollBar.Top := Height - FHScrollBar.Height - borders.Bottom; FHScrollBar.Left := borders.Left; @@ -982,7 +1101,7 @@ begin Canvas.SetClipRect(clipr); Canvas.SetColor(FBackgroundColor); - + // clearing after the last column if r.Left <= clipr.Right then begin @@ -1133,7 +1252,7 @@ begin end; consumed := True; end; - + keyHome: begin if FRowSelect then @@ -1159,7 +1278,7 @@ begin end; consumed := True; end; - + keyEnd: begin if FRowSelect then @@ -1185,7 +1304,7 @@ begin consumed := True; end; end; { case } - + if consumed then CheckFocusChange; @@ -1195,49 +1314,66 @@ end; procedure TfpgBaseGrid.HandleMouseScroll(x, y: integer; shiftstate: TShiftState; delta: smallint); var lRow: Integer; - lCol: Integer; begin inherited HandleMouseScroll(x, y, shiftstate, delta); lRow := FFirstRow; - lCol := FFirstCol; - if delta > 0 then // scroll down - inc(FFirstRow, abs(delta)*3) - else // scroll up - if FFirstRow > 0 then - dec(FFirstRow, abs(delta)*3); + // If vertical scrollbar is not visible, but + // horizontal is, Mouse wheel will scroll horizontally. :) + if FHScrollBar.Visible and (not FVScrollBar.Visible) then + begin + HandleMouseHorizScroll(x, y, shiftstate, delta); + Exit; + end; + + inc(FFirstRow, delta*3); // apply limits if FFirstRow > RowCount - VisibleLines then FFirstRow := RowCount - VisibleLines; if FFirstRow < 0 then FFirstRow := 0; - - // scroll left/right - // If vertical scrollbar is not visible, but - // horizontal is. Mouse wheel will scroll horizontally. :) - if FHScrollBar.Visible and (not FVScrollBar.Visible) then - begin - if delta > 0 then // scroll right - begin - if FFirstCol < (ColumnCount-1) then - inc(FFirstCol); - end - else - begin - if FFirstCol > 0 then - dec(FFirstCol); - end; - end; - if (lRow <> FFirstRow) or (lCol <> FFirstCol) then + if lRow <> FFirstRow then begin UpdateScrollBars; RePaint; end; end; +procedure TfpgBaseGrid.HandleMouseHorizScroll(x, y: integer; shiftstate: TShiftState; delta: smallint); +var + old_val: Integer; +begin + inherited HandleMouseHorizScroll(x, y, shiftstate, delta); + + if go_SmoothScroll in Options then + begin + old_val := FXOffset; + inc(FXOffset, delta*FHScrollBar.ScrollStep); + if (FXOffset<0) then + FXOffset:=0; + // finding the maximum Xoffset is tricky, let updatescrollbars do it. + if (FXOffset=old_val) then + Exit; + end + else + begin + old_val := FFirstCol; + inc(FFirstCol, delta); + if FFirstCol<0 then + FFirstCol:=0 + else if FFirstCol > ColumnCount-1 then + FFirstCol:=ColumnCount-1; + if FFirstCol=old_val then + Exit; + end; + + UpdateScrollBars; + RePaint; +end; + procedure TfpgBaseGrid.HandleMouseMove(x, y: integer; btnstate: word; shiftstate: TShiftState); var hh: integer; @@ -1249,7 +1385,7 @@ var borders: TRect; begin inherited HandleMouseMove(x, y, btnstate, shiftstate); - + if (ColumnCount = 0) or (RowCount = 0) then Exit; //==> @@ -1434,7 +1570,7 @@ begin begin // Selecting a Cell via mouse MouseToCell(x, y, FFocusCol, FFocusRow); end; { if/else } - + if not CanSelectCell(FFocusRow, FFocusCol) then begin // restore previous values @@ -1478,6 +1614,7 @@ procedure TfpgBaseGrid.FollowFocus; var n: Integer; w: TfpgCoord; + lmin, lmax: TfpgCoord; begin if (RowCount > 0) and (FFocusRow < 0) then FFocusRow := 0; @@ -1520,6 +1657,19 @@ begin end; end; { for } end; { if/else } + + // If smoothscroll, convert FFirstCol to X Offset value + if go_SmoothScroll in FOptions then + begin + w := 0; + for n := 0 to FFocusCol-1 do + w := w + ColumnWidth[n]; + lmin := FXOffset; + lmax := FXOffset + VisibleWidth; + if (w > lmax) or (w < lmin) then + FXOffset := w; + end; + CheckFocusChange; UpdateScrollBars; end; @@ -1557,7 +1707,7 @@ begin FFont := fpgGetFont('#Grid'); FHeaderFont := fpgGetFont('#GridHeader'); - + FTemp := 50; // Just to prove that ColumnWidth does adjust. FDefaultColWidth := 64; FDefaultRowHeight := FFont.Height + 2; @@ -1568,7 +1718,7 @@ begin MinHeight := HeaderHeight + DefaultRowHeight + borders.Top + borders.Bottom; MinWidth := DefaultColWidth + borders.Left + borders.Right; - + FVScrollBar := TfpgScrollBar.Create(self); FVScrollBar.Orientation := orVertical; FVScrollBar.Visible := False; @@ -1578,7 +1728,7 @@ begin FHScrollBar.Orientation := orHorizontal; FHScrollBar.Visible := False; FHScrollBar.OnScroll := @HScrollBarMove; - FHScrollBar.ScrollStep := 5; + FHScrollBar.ScrollStep := 20; end; destructor TfpgBaseGrid.Destroy; diff --git a/src/gui/fpg_checkbox.pas b/src/gui/fpg_checkbox.pas index 2b4b11d8..cd0e9920 100644 --- a/src/gui/fpg_checkbox.pas +++ b/src/gui/fpg_checkbox.pas @@ -50,6 +50,7 @@ type procedure SetText(const AValue: string); procedure DoOnChange; protected + procedure HandleCheckChanged; virtual; procedure HandlePaint; override; procedure HandleLMouseDown(x, y: integer; shiftstate: TShiftState); override; procedure HandleLMouseUp(x, y: integer; shiftstate: TShiftState); override; @@ -121,6 +122,7 @@ begin if FChecked = AValue then Exit; //==> FChecked := AValue; + HandleCheckChanged; RePaint; if not (csDesigning in ComponentState) then DoOnChange; @@ -173,6 +175,11 @@ begin FOnChange(self); end; +procedure TfpgBaseCheckBox.HandleCheckChanged; +begin + // nothing here for us +end; + procedure TfpgBaseCheckBox.HandlePaint; var r: TfpgRect; diff --git a/src/gui/fpg_customgrid.pas b/src/gui/fpg_customgrid.pas index 83d35aa7..923bed91 100644 --- a/src/gui/fpg_customgrid.pas +++ b/src/gui/fpg_customgrid.pas @@ -1,7 +1,7 @@ { fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2014 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -65,6 +65,7 @@ type FColumns: TFPList; procedure HandleSetFocus; override; procedure SetTextColor(const AValue: TfpgColor); override; + procedure SetBackgroundColor(const AValue: TfpgColor); override; function GetColumns(AIndex: integer): TfpgGridColumn; virtual; procedure DoDeleteColumn(ACol: integer); virtual; procedure DoSetRowCount(AValue: integer); virtual; @@ -140,6 +141,18 @@ begin Update; end; +procedure TfpgCustomGrid.SetBackgroundColor(const AValue: TfpgColor); +var + i: integer; +begin + inherited SetBackgroundColor(AValue); + for i := 0 to ColumnCount-1 do + begin + TfpgGridColumn(FColumns.Items[i]).BackgroundColor := AValue; + end; + RePaint; +end; + function TfpgCustomGrid.GetColumns(AIndex: integer): TfpgGridColumn; begin if (AIndex < 0) or (AIndex > FColumns.Count-1) then diff --git a/src/gui/fpg_dialogs.pas b/src/gui/fpg_dialogs.pas index 99c5b208..7cb1ee20 100644 --- a/src/gui/fpg_dialogs.pas +++ b/src/gui/fpg_dialogs.pas @@ -1,7 +1,7 @@ { fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2012 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2014 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -58,10 +58,10 @@ uses type TfpgMsgDlgType = (mtAbout, mtWarning, mtError, mtInformation, mtConfirmation, mtCustom); - + TfpgMsgDlgBtn = (mbNoButton, mbOK, mbCancel, mbYes, mbNo, mbAbort, mbRetry, mbIgnore, mbAll, mbNoToAll, mbYesToAll, mbHelp, mbClose); - + TfpgMsgDlgButtons = set of TfpgMsgDlgBtn; const @@ -104,7 +104,7 @@ type property CentreText: Boolean read FCentreText write FCentreText default False; property FontDesc: string read GetFontDesc write SetFontDesc; end; - + TfpgBaseDialog = class(TfpgForm) protected @@ -152,8 +152,8 @@ type constructor Create(AOwner: TComponent); override; procedure SetSampleText(AText: string); end; - - + + TfpgFileDialog = class(TfpgBaseDialog) private chlDir: TfpgComboBox; @@ -227,6 +227,7 @@ type {$I charmapdialog.inc} {$I colordialog.inc} {$I inputquerydialog.inc} +{$I inputintegerdialog.inc} {$I managebookmarksdialog.inc} @@ -240,6 +241,7 @@ function SelectDirDialog(const AStartDir: TfpgString = ''): TfpgString; function fpgShowCharMap: TfpgString; function fpgSelectColorDialog(APresetColor: TfpgColor = clBlack): TfpgColor; function fpgInputQuery(const ACaption, APrompt: TfpgString; var Value: TfpgString): Boolean; +function fpgIntegerQuery(const ACaption, APrompt: TfpgString; var Value: Integer; const MaxValue: Integer; const MinValue: Integer = 0): Boolean; implementation @@ -253,8 +255,8 @@ uses {$ENDIF} ,DateUtils ; - - + + procedure WrapText(const AText: String; ALines: TStrings; AFont: TfpgFont; const ALineWidth: Integer; out AWidth: Integer); var @@ -396,7 +398,7 @@ begin dres := dlg.RunOpenFile else dres := dlg.RunSaveFile; - + if dres then Result := dlg.FileName else @@ -532,7 +534,7 @@ var outw: integer; begin WrapText(AMessage, FLines, FFont, FMaxLineWidth, outw); - + // dialog width with 10 pixel border on both sides Width := outw + 2*10; @@ -746,7 +748,7 @@ var NextC; end; end; - + procedure ProcessAliasFont; var i: integer; @@ -787,7 +789,7 @@ begin NextToken; lbFaces.FocusItem := lbFaces.Items.IndexOf(token); - + if c = '-' then begin NextC; @@ -848,7 +850,7 @@ begin MinHeight := Height; FSampleText := 'The quick brown fox jumps over the lazy dog. 0123456789 [oO0,ilLI]'; FMode := 1; // normal fonts - + btnCancel.Left := Width - FDefaultButtonWidth - FSpacing; btnOK.Left := btnCancel.Left - FDefaultButtonWidth - FSpacing; @@ -1002,7 +1004,7 @@ begin Exit; //==> if AText = '' then Exit; //==> - + FSampleText := AText; memSample.Text := FSampleText; end; @@ -1173,7 +1175,7 @@ begin end; { Create lower Panel details } - + pnlFileInfo := TfpgPanel.Create(self); with pnlFileInfo do begin @@ -1196,7 +1198,7 @@ begin OnChange := @edFilenameChanged; OnKeyPress := @edFilenameKeyPressed; end; - + { Filter section } chlFilter := TfpgComboBox.Create(self); @@ -1400,7 +1402,7 @@ begin ExcludeTrailingPathDelimiter(grid.FileList.DirectoryName)) else fsel := ''; - + grid.FileList.FileMask := GetFileFilter; grid.FileList.ShowHidden := ShowHidden; @@ -1409,7 +1411,7 @@ begin ShowMessage(Format(rsErrCouldNotOpenDir, [ADir]), rsError); Exit; //==> end; - + grid.FileList.Sort(soFileName); // we don't want chlDir to call DirChange while populating items @@ -1422,7 +1424,7 @@ begin HighlightFile(fsel) else grid.FocusRow := 0; - + grid.Update; grid.SetFocus; @@ -1585,7 +1587,7 @@ begin if not HighlightFile(fname) then edFilename.Text := fname; - + WindowTitle := rsOpenAFile; btnOK.ImageName := 'stdimg.open'; // Do NOT localize btnOK.Text := rsOpen; @@ -1634,6 +1636,7 @@ end; {$I charmapdialog.inc} {$I colordialog.inc} {$I inputquerydialog.inc} +{$I inputintegerdialog.inc} {$I managebookmarksdialog.inc} diff --git a/src/gui/fpg_editcombo.pas b/src/gui/fpg_editcombo.pas index 5b011b4d..12773d9b 100644 --- a/src/gui/fpg_editcombo.pas +++ b/src/gui/fpg_editcombo.pas @@ -367,7 +367,7 @@ begin begin if Items[i]= TDropDownWindow(FDropDown).ListBox.Items[TDropDownWindow(FDropDown).ListBox.FocusItem] then begin - FocusItem := i; + FNewItem := False; FSelectedItem:= i; FText:= Items[i]; Break; @@ -734,17 +734,17 @@ var // paint selection rectangle procedure DrawSelection; var - lcolor: TfpgColor; + lcolor,ltxtcolor: TfpgColor; begin if Focused then begin lcolor := clSelection; - Canvas.SetTextColor(clSelectionText); + ltxtcolor := clSelectionText; end else begin lcolor := clInactiveSel; - Canvas.SetTextColor(clText1); + ltxtcolor := clText1; end; len := FSelOffset; @@ -759,16 +759,16 @@ var // XOR on Anti-aliased text doesn't look to good. Lets try standard // Blue & White like what was doen in TfpgEdit. -{ Canvas.SetColor(lcolor); + Canvas.SetColor(lcolor); Canvas.FillRectangle(-FDrawOffset + FMargin + tw, 3, tw2 - tw, Font.Height); r.SetRect(-FDrawOffset + FMargin + tw, 3, tw2 - tw, Font.Height); Canvas.AddClipRect(r); - Canvas.SetTextColor(clWhite); - fpgStyle.DrawString(Canvas, -FDrawOffset + FMargin, 3, Text, Enabled); + Canvas.SetTextColor(ltxtcolor); + fpgStyle.DrawString(Canvas, -FDrawOffset + FMargin + tw, 3, UTF8Copy(Items[FSelectedItem], Succ(st), Pred(len)), Enabled); Canvas.ClearClipRect; -} - Canvas.XORFillRectangle(fpgColorToRGB(lcolor) xor $FFFFFF, - -FDrawOffset + FMargin + tw, 3, tw2 - tw, Font.Height); + + //Canvas.XORFillRectangle(fpgColorToRGB(lcolor) xor $FFFFFF, + // -FDrawOffset + FMargin + tw, 3, tw2 - tw, Font.Height); end; begin diff --git a/src/gui/fpg_form.pas b/src/gui/fpg_form.pas index c80a1e53..3f1f2558 100644 --- a/src/gui/fpg_form.pas +++ b/src/gui/fpg_form.pas @@ -1,7 +1,7 @@ { fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2011 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2014 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -44,6 +44,7 @@ type TfpgBaseForm = class(TfpgWidget) private FFullScreen: boolean; + FIconName: TfpgString; FOnActivate: TNotifyEvent; FOnClose: TFormCloseEvent; FOnCloseQuery: TFormCloseQueryEvent; @@ -76,6 +77,7 @@ type procedure DoKeyShortcut(const AOrigin: TfpgWidget; const keycode: word; const shiftstate: TShiftState; var consumed: boolean; const IsChildOfOrigin: boolean = False); override; { -- properties -- } property DNDEnabled: boolean read FDNDEnabled write SetDNDEnabled default False; + property IconName: string read FIconName write FIconName; property Sizeable: boolean read FSizeable write FSizeable; property ModalResult: TfpgModalResult read FModalResult write FModalResult; property FullScreen: boolean read FFullScreen write FFullScreen default False; @@ -115,6 +117,7 @@ type property FullScreen; property Height; property Hint; + property IconName; property Left; property MaxHeight; property MaxWidth; diff --git a/src/gui/fpg_grid.pas b/src/gui/fpg_grid.pas index 3f8b52fb..1f7e0f54 100644 --- a/src/gui/fpg_grid.pas +++ b/src/gui/fpg_grid.pas @@ -136,6 +136,7 @@ type published property Align; property AlternateBGColor; + property AutoHeight; property BackgroundColor; property BorderStyle; // property ColResizing; @@ -158,6 +159,8 @@ type property RowCount; property RowSelect; property ScrollBarStyle; + property ScrollBarPage; + property ScrollBarWidth; property ShowGrid; property ShowHeader; property ShowHint; diff --git a/src/gui/fpg_listbox.pas b/src/gui/fpg_listbox.pas index ce1480dc..11baed01 100644 --- a/src/gui/fpg_listbox.pas +++ b/src/gui/fpg_listbox.pas @@ -63,6 +63,10 @@ type procedure SetPopupFrame(const AValue: boolean); procedure UpdateScrollbarCoords; procedure SetAutoHeight(const AValue: boolean); + function GetScrollBarPage: integer; + procedure SetScrollBarPage(const AValue: integer); + function GetScrollBarWidth: integer; + procedure SetScrollBarWidth(const AValue: integer); protected FFont: TfpgFont; FScrollBar: TfpgScrollBar; @@ -74,7 +78,6 @@ type procedure UpdateScrollBar; procedure FollowFocus; function ListHeight: TfpgCoord; - function ScrollBarWidth: TfpgCoord; function PageLength: integer; procedure ScrollBarMove(Sender: TObject; APosition: integer); procedure DrawItem(num: integer; rect: TfpgRect; flags: integer); virtual; @@ -90,6 +93,8 @@ type procedure HandleShow; override; procedure HandlePaint; override; property AutoHeight: boolean read FAutoHeight write SetAutoHeight default False; + property ScrollBarPage: Integer read GetScrollBarPage write SetScrollBarPage; + property ScrollBarWidth: Integer read GetScrollBarWidth write SetScrollBarWidth; property FocusItem: integer read FFocusItem write SetFocusItem; property FontDesc: string read GetFontDesc write SetFontDesc; property HotTrack: boolean read FHotTrack write FHotTrack default False; @@ -105,6 +110,7 @@ type function RowHeight: integer; virtual; procedure SetFirstItem(item: integer); property Font: TfpgFont read FFont; + property VisibleItems: integer read PageLength; property OnChange: TNotifyEvent read FOnChange write FOnChange; property OnKeyPress; // to allow to detect return or tab key has been pressed property OnScroll: TNotifyEvent read FOnScroll write FOnScroll; @@ -147,6 +153,8 @@ type property Items; property ParentShowHint; property PopupFrame; + property ScrollBarPage; + property ScrollBarWidth; property ShowHint; property TabOrder; property Text; @@ -416,6 +424,33 @@ begin Height := (Succ(PageLength) * RowHeight) + (2 * FMargin); end; +function TfpgBaseListBox.GetScrollBarPage: integer; +begin + Result:= FScrollBar.PageSize; +end; + +procedure TfpgBaseListBox.SetScrollBarPage(const AValue: integer); +begin + if AValue= FScrollBar.PageSize then + Exit; //==> + FScrollBar.PageSize:= AValue; +end; + +function TfpgBaseListBox.GetScrollBarWidth: integer; +begin + if FScrollBar.Visible then + result := FScrollBar.Width + else + result := 0; +end; + +procedure TfpgBaseListBox.SetScrollBarWidth(const AValue: integer); +begin + if AValue = FScrollBar.Width then + Exit; //==> + FScrollBar.Width := AValue; +end; + procedure TfpgBaseListBox.MsgPaint(var msg: TfpgMessageRec); begin // Optimising painting and preventing OnPaint from firing if not needed @@ -482,14 +517,6 @@ begin result := height - (2*FMargin); end; -function TfpgBaseListBox.ScrollBarWidth: TfpgCoord; -begin - if FScrollBar.Visible then - result := FScrollBar.Width - else - result := 0; -end; - function TfpgBaseListBox.PageLength: integer; begin result := (ListHeight div RowHeight)-1; // component height minus 1 line @@ -1280,4 +1307,3 @@ begin end; end. - diff --git a/src/gui/fpg_listview.pas b/src/gui/fpg_listview.pas index 511295e0..0278c952 100644 --- a/src/gui/fpg_listview.pas +++ b/src/gui/fpg_listview.pas @@ -1,7 +1,7 @@ { fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2013 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2014 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -209,8 +209,6 @@ type TfpgListView = class(TfpgWidget, IfpgLVItemViewer) private - procedure SetShiftIsPressed(const AValue: Boolean); - private FImages: array[TfpgLVItemStates] of TfpgImageList; FSubitemImages: array[TfpgLVItemStates] of TfpgImageList; FItemIndex: Integer; @@ -225,6 +223,7 @@ type FUpdateCount: Integer; FVScrollBar: TfpgScrollBar; FHScrollBar: TfpgScrollBar; + FScrollBarWidth: integer; FColumns: TfpgLVColumns; FItems: TfpgLVItems; FOnPaintItem: TfpgLVPaintItemEvent; @@ -241,7 +240,9 @@ type procedure SetItems(const AValue: TfpgLVItems); procedure SetMultiSelect(const AValue: Boolean); procedure SetOnColumnClick(const AValue: TfpgLVColumnClickEvent); + procedure SetScrollBarWidth(const AValue: integer); procedure SetShowHeaders(const AValue: Boolean); + procedure SetShiftIsPressed(const AValue: Boolean); function SubItemGetImages(AIndex: integer): TfpgImageList; procedure SubItemSetImages(AIndex: integer; const AValue: TfpgImageList); procedure VScrollChange(Sender: TObject; Position: Integer); @@ -308,6 +309,7 @@ type property Hint; property MultiSelect: Boolean read FMultiSelect write SetMultiSelect; property ParentShowHint; + property ScrollBarWidth: Integer read FScrollBarWidth write SetScrollBarWidth; property SelectionFollowsFocus: Boolean read FSelectionFollowsFocus write FSelectionFollowsFocus; property SubItemImages: TfpgImageList index Ord(lisNoState) read SubItemGetImages write SubItemSetImages; property SubItemImagesSelected: TfpgImageList index Ord(lisSelected) read SubItemGetImages write SubItemSetImages; @@ -738,6 +740,15 @@ begin FOnColumnClick:=AValue; end; +procedure TfpgListView.SetScrollBarWidth(const AValue: integer); +begin + if AValue = FScrollBarWidth then + Exit; //==> + FScrollBarWidth := AValue; + FVScrollBar.Width := FScrollBarWidth; + FHScrollBar.Height:= FScrollBarWidth; +end; + procedure TfpgListView.SetShiftIsPressed(const AValue: Boolean); begin if AValue = FShiftIsPressed then @@ -1792,6 +1803,7 @@ begin FSelectionFollowsFocus := True; FItemIndex := -1; FScrollBarNeedsUpdate := True; + FScrollBarWidth := FVScrollBar.Width; end; destructor TfpgListView.Destroy; diff --git a/src/gui/fpg_memo.pas b/src/gui/fpg_memo.pas index 374c8d47..672e7126 100644 --- a/src/gui/fpg_memo.pas +++ b/src/gui/fpg_memo.pas @@ -308,12 +308,12 @@ var begin VHeight := Height - 4; HWidth := Width - 4; - + if FVScrollBar.Visible then Dec(HWidth, FVScrollBar.Width); if FHScrollBar.Visible then Dec(VHeight, FHScrollBar.Height); - + FHScrollBar.Top := Height -FHScrollBar.Height - 2; FHScrollBar.Left := 2; FHScrollBar.Width := HWidth; @@ -1048,7 +1048,7 @@ begin if not Focused then fpgCaret.UnSetCaret(Canvas); - + // The little square in the bottom right corner if FHScrollBar.Visible and FVScrollBar.Visible then begin @@ -1348,7 +1348,7 @@ begin RePaint else inherited; - + if hasChanged then if Assigned(FOnChange) then FOnChange(self); @@ -1675,7 +1675,8 @@ end; procedure TfpgMemo.EndUpdate; begin - Dec(FUpdateCount); + if FUpdateCount > 0 then + Dec(FUpdateCount); if FUpdateCount <= 0 then begin Invalidate; diff --git a/src/gui/fpg_menu.pas b/src/gui/fpg_menu.pas index 3310db48..7b93be06 100644 --- a/src/gui/fpg_menu.pas +++ b/src/gui/fpg_menu.pas @@ -590,6 +590,7 @@ begin FHeight := fpgStyle.MenuFont.Height + 6; // 3px margin top and bottom FMenuOptions := []; FMouseIsOver := False; + FIsContainer := True; end; destructor TfpgMenuBar.Destroy; diff --git a/src/gui/fpg_panel.pas b/src/gui/fpg_panel.pas index 2054959d..aedb7ace 100644 --- a/src/gui/fpg_panel.pas +++ b/src/gui/fpg_panel.pas @@ -308,8 +308,8 @@ type constructor Create(AOwner: TComponent); override; destructor Destroy; override; property Image: TfpgImage read FImage write SetImage; - property OwnsImage: Boolean read FOwnsImage write FOwnsImage; - property ScaleImage: Boolean read FScaleImage write SetScaleImage; + property OwnsImage: Boolean read FOwnsImage write FOwnsImage default False; + property ScaleImage: Boolean read FScaleImage write SetScaleImage default False; end; @@ -1110,6 +1110,7 @@ begin inherited Create(AOwner); FImage := nil; FOwnsImage := False; + FScaleImage := False; end; destructor TfpgImagePanel.Destroy; diff --git a/src/gui/fpg_scrollbar.pas b/src/gui/fpg_scrollbar.pas index 7fd5de64..fbe20006 100644 --- a/src/gui/fpg_scrollbar.pas +++ b/src/gui/fpg_scrollbar.pas @@ -36,7 +36,7 @@ uses type TScrollNotifyEvent = procedure(Sender: TObject; position: integer) of object; - TfpgScrollStyle = (ssNone, ssHorizontal, ssVertical, ssAutoBoth); + TfpgScrollStyle = (ssNone, ssHorizontal, ssVertical, ssAutoBoth, ssHorizVisible, ssVertiVisible, ssBothVisible); TfpgScrollBarPart = (sbpNone, sbpUpBack, sbpPageUpBack, sbpSlider, sbpDownForward, sbpPageDownForward); @@ -134,7 +134,6 @@ end; procedure TfpgScrollBar.HandlePaint; 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) and (FPosition <> FMin), (FPosition <> FMin) and (Parent.Enabled)); @@ -145,9 +144,7 @@ begin 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); - Canvas.EndDraw; // Do not remove - Scrollbars do painting outside HandlePaint as well! FRecalc := False; end; @@ -162,7 +159,7 @@ begin if not HasHandle then Exit; //==> FRecalc := True; - Invalidate;// DrawSlider(True); + Invalidate; end; procedure TfpgScrollBar.LineUp; @@ -219,7 +216,7 @@ begin FPosition := AValue; if HasHandle then - Invalidate;// DrawSlider(False); + Invalidate; end; procedure TfpgScrollBar.Step(ASteps: Integer); @@ -576,7 +573,7 @@ begin FSliderPos := area; if ppos <> FSliderPos then - Invalidate; // DrawSlider(False); + Invalidate; if area <> 0 then newp := FMin + Trunc((FMax - FMin) * (FSliderPos / area)) @@ -609,7 +606,7 @@ begin if Visible then begin FRecalc := True; - Invalidate; // DrawSlider(True); + Invalidate; end; if Assigned(FOnScroll) then diff --git a/src/gui/fpg_scrollframe.pas b/src/gui/fpg_scrollframe.pas new file mode 100644 index 00000000..008832ce --- /dev/null +++ b/src/gui/fpg_scrollframe.pas @@ -0,0 +1,530 @@ +{ + fpGUI - Free Pascal GUI Toolkit + + Copyright (C) 2006 - 2014 See the file AUTHORS.txt, included in this + distribution, for details of the copyright. + + See the file COPYING.modifiedLGPL, included in this distribution, + for details about redistributing fpGUI. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + Description: + Defines a scrollable frame widget. + + This unit was originally written by David Emerson <dle3ab@angelbase.com> +} +unit fpg_scrollframe; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, + SysUtils, + fpg_base, + fpg_main, + fpg_widget, + fpg_panel, + fpg_scrollbar; + +type + + TfpgScrollFrame = class; + + + TfpgEmbeddingFrame = class (TfpgFrame) + // The purpose of the EmbeddingFrame is to pass scroll events to the ParentScrollFrame + private + FParentScrollFrame : TfpgScrollFrame; + protected + procedure HandleMouseScroll(x, y: integer; shiftstate: TShiftState; + delta: smallint); override; + procedure HandleMouseHorizScroll(x, y: integer; shiftstate: TShiftState; + delta: smallint); override; + public + property ParentScrollFrame : TfpgScrollFrame read FParentScrollFrame write FParentScrollFrame; + end; + + + TfpgAutoSizingFrame = class (TfpgEmbeddingFrame) + private + FMarginBR : integer; + procedure SetMarginBR (AValue: integer); + public + procedure AfterConstruction; override; + procedure AdjustDimsFor (w : TfpgWidget; updatewp: boolean = true); + procedure AdjustDimsWithout (w : TfpgWidget); + procedure RecalcFrameSize; + property MarginBR : integer read FMarginBR write SetMarginBR; // bottom-right margin + end; + + TfpgASFrameClass = class of TfpgAutoSizingFrame; + + + TfpgScrollFrame = class(TfpgFrame) + private + FContentFrame: TfpgAutoSizingFrame; + FVisibleArea: TfpgEmbeddingFrame; + FHScrollBar: TfpgScrollBar; + FVScrollBar: TfpgScrollBar; + FScrollBarStyle: TfpgScrollStyle; + function GetXOffset: integer; + function GetYOffset: integer; + procedure SetXOffset(x: integer); + procedure SetYOffset(y: integer); + protected + procedure HandleMouseScroll(x, y: integer; shiftstate: TShiftState; delta: smallint); override; + procedure HandleMouseHorizScroll(x, y: integer; shiftstate: TShiftState; delta: smallint); override; + procedure HandleResize(awidth, aheight: TfpgCoord); override; + procedure HandleShow; override; + procedure HandlePaint; override; + procedure HScrollBarMove(Sender: TObject; position: integer); + procedure VScrollBarMove(Sender: TObject; position: integer); + procedure UpdateScrollbars; virtual; + property XOffset: integer read GetXOffset write SetXOffset; // these do not... + property YOffset: integer read GetYOffset write SetYOffset; // ...updatewindowposition + public + constructor Create (AOwner: TComponent); override; + constructor Create (AOwner: TComponent; ContentFrameType: TfpgASFrameClass); virtual; + procedure AfterCreate; override; + procedure SetContentFrameType(AContentFrameType: TfpgASFrameClass); + property ContentFrame: TfpgAutoSizingFrame read FContentFrame write FContentFrame; + end; + + +implementation + + +{ TfpgEmbeddingFrame } + +procedure TfpgEmbeddingFrame.HandleMouseScroll(x, y: integer; + shiftstate: TShiftState; delta: smallint); +begin + ParentScrollFrame.HandleMouseScroll(x, y, shiftstate, delta); +end; + +procedure TfpgEmbeddingFrame.HandleMouseHorizScroll(x, y: integer; + shiftstate: TShiftState; delta: smallint); +begin + ParentScrollFrame.HandleMouseHorizScroll(x, y, shiftstate, delta); +end; + + +{ TfpgAutoSizingFrame } + +procedure TfpgAutoSizingFrame.SetMarginBR(AValue: integer); +begin + if FMarginBR=AValue then Exit; + FMarginBR:=AValue; + RecalcFrameSize; +end; + +procedure TfpgAutoSizingFrame.AfterConstruction; +begin + inherited AfterConstruction; + RecalcFrameSize; +end; + +procedure TfpgAutoSizingFrame.AdjustDimsFor (w: TfpgWidget; updatewp: boolean = true); +var + new_w, new_h: integer; +begin + if not w.Visible then + Exit; + new_w := w.Right+MarginBR+1; + new_h := w.Bottom+MarginBR+1; + if (Width < new_w) or (Height < new_h) then + begin + HandleResize(new_w, new_h); + if updatewp then + if ParentScrollFrame is TfpgScrollFrame then + ParentScrollFrame.UpdateScrollbars + else + UpdateWindowPosition; + end; +end; + +procedure TfpgAutoSizingFrame.AdjustDimsWithout (w: TfpgWidget); +begin + if (Width = w.Right+MarginBR+1) + or (Height = w.Bottom+MarginBR+1) then + RecalcFrameSize; +end; + +procedure TfpgAutoSizingFrame.RecalcFrameSize; +var + i : integer; + c : TComponent; + max_w, max_h : integer; + this_need : integer; + par : TfpgWidget; +begin + if ComponentCount=0 then + Exit; + max_w := 1; + max_h := 1; + for i := 0 to ComponentCount-1 do begin + c := Components[i]; + if c is TfpgWidget then + begin + if not TfpgWidget(c).Visible then + continue; + this_need := TfpgWidget(c).right+MarginBR+1; + if (this_need>max_w) then + max_w := this_need; + this_need := TfpgWidget(c).bottom+MarginBR+1; + if (this_need>max_h) then + max_h := this_need; + end; + end; + HandleResize(max_w, max_h); + if ParentScrollFrame is TfpgScrollFrame then + ParentScrollFrame.UpdateScrollbars + else + UpdateWindowPosition; +end; + + +{ TfpgScrollFrame } + +function TfpgScrollFrame.GetXOffset: integer; +begin + result := -FContentFrame.Left; +end; + +function TfpgScrollFrame.GetYOffset: integer; +begin + result := -FContentFrame.Top; +end; + +procedure TfpgScrollFrame.SetXOffset (x: integer); +begin + if ContentFrame.Left = -x then + Exit; + FContentFrame.Left := -x; +end; + +procedure TfpgScrollFrame.SetYOffset (y: integer); +begin + if ContentFrame.Top = -y then + Exit; + FContentFrame.Top := -y; +end; + +procedure TfpgScrollFrame.HandleMouseScroll(x, y: integer; + shiftstate: TShiftState; delta: smallint); +var + old_val, new_val : integer; +begin + inherited HandleMouseScroll(x, y, shiftstate, delta); + with FVScrollBar do + begin + if not Visible then + Exit; + Position:=Position+delta*ScrollStep; + if YOffset=Position then + Exit; + YOffset:=Position; + end; + UpdateScrollbars; +end; + +procedure TfpgScrollFrame.HandleMouseHorizScroll(x, y: integer; + shiftstate: TShiftState; delta: smallint); +begin + inherited HandleMouseHorizScroll(x, y, shiftstate, delta); + with FHScrollBar do + begin + if not Visible then + Exit; + Position:=Position+delta*ScrollStep; + if XOffset=Position then + Exit; + XOffset:=Position; + end; + UpdateScrollbars; +end; + +procedure TfpgScrollFrame.HandleResize(awidth, aheight: TfpgCoord); +begin + inherited HandleResize(awidth, aheight); + if (csLoading in ComponentState) or (csUpdating in ComponentState) then + Exit; //==> + if HasHandle then + UpdateScrollBars; +end; + +procedure TfpgScrollFrame.HandleShow; +begin + inherited HandleShow; + if (csLoading in ComponentState) then + Exit; + UpdateScrollBars; +end; + +procedure TfpgScrollFrame.HandlePaint; +begin + if csDesigning in ComponentState then + begin + // clear background rectangle + Canvas.Clear(clDarkGray); + // When designing, don't draw colors + // but draw an outline + Canvas.SetLineStyle(1, lsDash); + Canvas.DrawRectangle(GetClientRect); + Canvas.SetLineStyle(1, lsSolid); + Canvas.Color := clUIDesignerGreen; + Canvas.DrawLine(0, 0, Width, Height); + Canvas.DrawLine(Width, 0, 0, Height); + Canvas.TextColor := clShadow1; + Canvas.DrawText(5, 5, Name + ': ' + ClassName); + Exit; //==> + end; + + inherited HandlePaint; +end; + +procedure TfpgScrollFrame.HScrollBarMove (Sender: TObject; position: integer); +begin + if position = XOffset then + Exit; + XOffset := position; + FContentFrame.UpdateWindowPosition; +end; + +procedure TfpgScrollFrame.VScrollBarMove (Sender: TObject; position: integer); +begin + if position = YOffset then + Exit; + YOffset := position; + FContentFrame.UpdateWindowPosition; +end; + +procedure TfpgScrollFrame.UpdateScrollbars; +var + contentWidth, contentHeight: integer; + visWidth, visHeight: integer; + Hfits, Vfits : boolean; + showHsb, showVsb : boolean; + prevHideHsb, prevHideVsb : boolean; + + procedure hideScrollbar (sb : TfpgScrollBar); + begin + with sb do + if Visible then + begin + Visible := False; + UpdateWindowPosition; + end; + end; + + procedure getVisWidth; + begin + if showVsb then + visWidth := Width - (FVScrollBar.Width-1) + else + visWidth := Width; + Hfits := visWidth >= contentWidth + end; + + procedure getVisHeight; + begin + if showHsb then + visHeight := Height - (FHScrollBar.Height-1) + else + visHeight := Height; + Vfits := visHeight >= contentHeight; + end; + +begin + if (csLoading in ComponentState) or (csUpdating in ComponentState) then + Exit; //==> + + // if we don't want any scrollbars, hide them and exit + if FScrollBarStyle = ssNone then + begin + hideScrollbar (FHScrollBar); + hideScrollbar (FVScrollBar); + exit; + end; + + // preliminary width/height calculations + prevHideHsb := not FHScrollBar.Visible; + prevHideVsb := not FVScrollBar.Visible; + showVsb := (FScrollBarStyle = ssBothVisible); + showHsb := showVsb; + contentWidth := ContentFrame.Width; + contentHeight := ContentFrame.Height; + getVisWidth; + getVisHeight; + + // determine whether to show scrollbars for different configurations + case FScrollBarStyle of + ssHorizontal: + begin + hideScrollbar (FVScrollBar); + if not Hfits then + begin + showHsb := true; + getVisHeight; + end; + end; + ssVertical: + begin + hideScrollbar (FHScrollBar); + if not Vfits then + begin + showVsb := true; + getVisWidth; + end; + end; + ssAutoBoth: + if not Vfits then + begin + showVsb := true; + getVisWidth; + if not Hfits then + begin + showHsb := true; + getVisHeight; + getVisWidth; + end; + end + else if not Hfits then + begin + showHsb := true; + getVisHeight; + if not Vfits then + begin + showVsb := true; + getVisWidth; + getVisHeight; + end; + end; + end; + + // show or hide the scrollbars + + if showVsb then with FVScrollBar do + begin + if prevHideVsb then + Position := 0; + Visible := true; + Min := 0; + Max := contentHeight - visHeight; // may set position! + YOffset := Position; + if contentHeight > 0 then + SliderSize := visHeight / contentHeight + else + SliderSize := 0; + RepaintSlider; + Top := 0; + Left := visWidth; + Height := visHeight; + PageSize:= visHeight; + end + else + begin + FVScrollBar.Visible := false; + if Vfits then // if vertical doesn't fit and no scrollbar, do not change offset + YOffset := 0; + end; + + if showHsb then with FHScrollBar do + begin + if prevHideHsb then + Position := 0; + Visible := true; + Min := 0; + Max := contentWidth - visWidth; // may set position! + XOffset := Position; + if contentWidth > 0 then + SliderSize := visWidth / contentWidth + else + SliderSize := 0; + RepaintSlider; + Top := visHeight; + Left := 0; + Width := visWidth; + PageSize:= visWidth; + end + else + begin + FHScrollBar.Visible := false; + if Hfits then // if horizontal doesn't fit and no scrollbar, do not change offset + XOffset := 0; + end; + + FVScrollBar.UpdateWindowPosition; + FHScrollBar.UpdateWindowPosition; + + FVisibleArea.SetPosition(0, 0, visWidth, visHeight); + FVisibleArea.UpdateWindowPosition; + + FContentFrame.UpdateWindowPosition; +end; + +constructor TfpgScrollFrame.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + + FVisibleArea := TfpgEmbeddingFrame.Create(self); + FVisibleArea.HandleMove(0, 0); + FVisibleArea.ParentScrollFrame := self; + + FContentFrame := TfpgAutoSizingFrame.Create(FVisibleArea); + FContentFrame.HandleMove(0, 0); + FContentFrame.ParentScrollFrame := self; +end; + +constructor TfpgScrollFrame.Create(AOwner: TComponent; ContentFrameType: TfpgASFrameClass); +begin + inherited Create(AOwner); + + FVisibleArea := TfpgEmbeddingFrame.Create(self); + FVisibleArea.HandleMove(0, 0); + FVisibleArea.ParentScrollFrame := self; + + FContentFrame := ContentFrameType.Create(FVisibleArea); + FContentFrame.HandleMove(0, 0); + FContentFrame.ParentScrollFrame := self; +end; + +procedure TfpgScrollFrame.AfterCreate; +begin + inherited AfterCreate; + + FVScrollBar := TfpgScrollBar.Create(self); + with FVScrollBar do begin + Orientation := orVertical; + OnScroll := @VScrollBarMove; + Position := 0; + ScrollStep := 10; + end; + + FHScrollBar := TfpgScrollBar.Create(self); + with FHScrollBar do begin + Orientation := orHorizontal; + OnScroll := @HScrollBarMove; + Position := 0; + ScrollStep := 10; + end; + + FScrollBarStyle := ssAutoBoth; +end; + +procedure TfpgScrollFrame.SetContentFrameType(AContentFrameType: TfpgASFrameClass); +begin + if Assigned(FContentFrame) then + FContentFrame.Free; + FContentFrame := AContentFrameType.Create(FVisibleArea); + FContentFrame.HandleMove(0, 0); + FContentFrame.ParentScrollFrame := self; +end; + + +end. diff --git a/src/gui/fpg_stringgridbuilder.pas b/src/gui/fpg_stringgridbuilder.pas new file mode 100644 index 00000000..fd3fe3b8 --- /dev/null +++ b/src/gui/fpg_stringgridbuilder.pas @@ -0,0 +1,178 @@ +{ + fpGUI - Free Pascal GUI Toolkit + + Copyright (C) 2006 - 2014 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 defines a helper class that can populate a StringGrid + from a CSV file. In future this could be expaned to other file + types or even data structures. +} +unit fpg_StringGridBuilder; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, + SysUtils, + fpg_base, + fpg_grid; + +type + TStringGridBuilder = class(TObject) + private + FData: TStringList; + FGrid: TfpgStringGrid; + FCSVFile: TfpgString; + FHasHeader: boolean; + protected + procedure InternalSetupColumns; virtual; + procedure InternalSetupData; virtual; + procedure InternalRepaintRow(const AData: TfpgString; const ARow: integer); virtual; + public + constructor Create; + constructor CreateCustom(const AGrid: TfpgStringGrid; const ACSVFile: TfpgString; const AWithHeader: boolean = True); virtual; + destructor Destroy; override; + procedure Run; + property Grid: TfpgStringGrid read FGrid; + end; + +implementation + +uses + fpg_main, + fpg_utils, + fpg_CSVParser; + +{ TStringGridBuilder } + +procedure TStringGridBuilder.InternalSetupColumns; +var + x: integer; + fields: TStringList; +begin + fields := TStringList.Create; + try + gCsvParser.ExtractFields(FData[0], fields); + // setup correct column count + FGrid.ColumnCount := fields.Count; + // initialize columns + if FHasHeader then + begin + for x := 0 to fields.Count-1 do + begin + FGrid.ColumnTitle[x] := fields[x]; +// FGrid.ColumnWidth[x] := StrToInt(FColumns.ValueFromIndex[x]); + end; + end; + finally + fields.Free; + end; +end; + +procedure TStringGridBuilder.InternalSetupData; +var + y: integer; +begin + FGrid.BeginUpdate; + FGrid.MouseCursor := mcHourGlass; + try + try + // set correct row count. Columns have already been handled. + if FHasHeader then + begin + FGrid.RowCount := FData.Count-1; + for y := 1 to FData.Count-1 do // rows + begin + // writeln(' Row: ', y, ' Data: ', FData.Strings[y-1]); + InternalRepaintRow(FData.Strings[y], y-1); + end; + end + else + begin + FGrid.RowCount := FData.Count; + for y := 0 to FData.Count-1 do // rows + begin + // writeln(' Row: ', y, ' Data: ', FData.Strings[y-1]); + InternalRepaintRow(FData.Strings[y], y); + end; + end; + except + fpgApplication.HandleException(self); + end; + finally + if FGrid.RowCount > 0 then + FGrid.FocusRow := 0; + FGrid.EndUpdate; + FGrid.MouseCursor := mcDefault; + end; +end; + +procedure TStringGridBuilder.InternalRepaintRow(const AData: TfpgString; const ARow: integer); +var + x: integer; + fields: TStrings; + value: string; +begin + fields := TStringList.Create; + try + gCsvParser.ExtractFields(AData, fields); + for x := 0 to FGrid.ColumnCount-1 do + begin + if x < fields.Count then + value := fields.Strings[x] + else + value := ''; + FGrid.Cells[x, ARow] := value + end; + finally + fields.Free; + end; +end; + +constructor TStringGridBuilder.Create; +begin + FData := TStringList.Create; +end; + +constructor TStringGridBuilder.CreateCustom(const AGrid: TfpgStringGrid; const ACSVFile: TfpgString; const AWithHeader: boolean); +begin + Create; + FGrid := AGrid; + FCSVFile := ACSVFile; + FGrid.Clear; + FHasHeader := AWithHeader; + FGrid.ShowHeader := AWithHeader; +end; + +destructor TStringGridBuilder.Destroy; +begin + FGrid := nil; + FData.Free; + inherited Destroy; +end; + +procedure TStringGridBuilder.Run; +begin + if FCSVFile = '' then + raise Exception.Create('TStringGridBuilder: CSV filename is empty!'); + if not fpgFileExists(FCSVFile) then + raise Exception.CreateFmt('TStringGridBuilder: The CSV file <%s> does not exist.', [FCSVFile]); + FData.LoadFromFile(fpgToOSEncoding(FCSVFile)); + InternalSetupColumns; + InternalSetupData; +end; + + +end. + diff --git a/src/gui/fpg_style_win8.pas b/src/gui/fpg_style_win8.pas index 69bad2cb..f3d99705 100644 --- a/src/gui/fpg_style_win8.pas +++ b/src/gui/fpg_style_win8.pas @@ -72,6 +72,7 @@ const $FF27546A, $FFE5E5E5); +{%region 'Byte arrays of images' -fold} const win8_checkboxes: array[0..2601] of byte = ( 66, 77, 42, 10, 0, 0, 0, 0, 0, 0, 54, 0, 0, 0, 40, 0, 0, @@ -387,6 +388,7 @@ const 199,199,214,214,214,233,233,233,255,255,255,255,255,255,255,255,255, 0); +{%endregion} { TfpgWin8Style } diff --git a/src/gui/fpg_tab.pas b/src/gui/fpg_tab.pas index 29addb12..5ef516bb 100644 --- a/src/gui/fpg_tab.pas +++ b/src/gui/fpg_tab.pas @@ -1,7 +1,7 @@ { fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2012 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2014 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -1291,10 +1291,7 @@ var begin Result := nil; h := TfpgTabSheet(FPages.First); - lp := FMargin; - if MaxButtonWidthSum > (Width-(FMargin*2)) then - h := FFirstTabButton; case TabPosition of tpTop: @@ -1324,6 +1321,8 @@ begin if TabPosition in [tpTop, tpBottom] then begin + if MaxButtonWidthSum > (Width-(FMargin*2)) then + h := FFirstTabButton; if (y > p1) and (y < p2) then begin while h <> nil do @@ -1346,11 +1345,13 @@ begin if TabPosition in [tpLeft, tpRight] then begin + bh := ButtonHeight; // initialize button height + if MaxButtonHeightSum > (Height-(FMargin*2)) then + h := FFirstTabButton; 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 diff --git a/src/gui/fpg_toggle.pas b/src/gui/fpg_toggle.pas new file mode 100644 index 00000000..b35ca661 --- /dev/null +++ b/src/gui/fpg_toggle.pas @@ -0,0 +1,282 @@ +{ + fpGUI - Free Pascal GUI Toolkit + + Copyright (C) 2006 - 2014 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. + + Original author: Andrew Haines + + Description: + Defines a ToggleBox control. A Checkbox like control that has an + animated bar that slides side to side when toggled. +} +unit fpg_toggle; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, + SysUtils, + fpg_base, + fpg_main, + fpg_stylemanager, + fpg_checkbox; + +type + + TfpgToggle = class(TfpgCheckBox) + private + FCheckedTextColor: TfpgColor; + FToggleWidth: TfpgCoord; + FToggleButtonWidth: TfpgCoord; + FAnimateTimer: TfpgTimer; + FCheckedCaption: TfpgString; + FCheckedColor: TfpgColor; + FSliderPosition: TfpgCoord; + FPaintedSliderPosition: TfpgCoord; + FUnCheckedCaption: TfpgString; + FUnCheckedColor: TfpgColor; + FUnCheckedTextColor: TfpgColor; + FUseAnimation: Boolean; + procedure SetCheckedCaption(AValue: TfpgString); + procedure SetCheckedColor(AValue: TfpgColor); + procedure SetCheckedTextColor(AValue: TfpgColor); + procedure SetToggleWidth(AValue: TfpgCoord); + procedure SetUnCheckedCaption(AValue: TfpgString); + procedure SetUnCheckedColor(AValue: TfpgColor); + procedure AnimateTimer(Sender: TObject); + procedure SetUnCheckedTextColor(AValue: TfpgColor); + function ToggleLeft: TfpgCoord; inline; + protected + procedure HandlePaint; override; + procedure HandleCheckChanged; override; + procedure HandleLMouseUp(x, y: integer; shiftstate: TShiftState); override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + published + property UseAnimation: Boolean read FUseAnimation write FUseAnimation; + property ToggleWidth: TfpgCoord read FToggleWidth write SetToggleWidth default 45; + property CheckedCaption : TfpgString read FCheckedCaption write SetCheckedCaption; + property CheckedColor: TfpgColor read FCheckedColor write SetCheckedColor default clLime; + property CheckedTextColor: TfpgColor read FCheckedTextColor write SetCheckedTextColor default clHilite2; + property UnCheckedCaption: TfpgString read FUnCheckedCaption write SetUnCheckedCaption; + property UnCheckedColor: TfpgColor read FUnCheckedColor write SetUnCheckedColor default clWindowBackground; + property UnCheckedTextColor: TfpgColor read FUnCheckedTextColor write SetUnCheckedTextColor default clText1; + end; + +implementation + +{ TfpgToggle } + +procedure TfpgToggle.SetCheckedColor(AValue: TfpgColor); +begin + if FCheckedColor=AValue then Exit; + FCheckedColor:=AValue; + Invalidate; +end; + +procedure TfpgToggle.SetCheckedTextColor(AValue: TfpgColor); +begin + if FCheckedTextColor=AValue then Exit; + FCheckedTextColor:=AValue; + Invalidate; +end; + +procedure TfpgToggle.SetToggleWidth(AValue: TfpgCoord); +begin + if FToggleWidth=AValue then Exit; + FToggleWidth:=AValue; + FToggleButtonWidth:=AValue - 10; + Invalidate; +end; + +procedure TfpgToggle.SetCheckedCaption(AValue: TfpgString); +begin + if FCheckedCaption=AValue then Exit; + FCheckedCaption:=AValue; + Invalidate; +end; + +procedure TfpgToggle.SetUnCheckedCaption(AValue: TfpgString); +begin + if FUnCheckedCaption=AValue then Exit; + FUnCheckedCaption:=AValue; + Invalidate; +end; + +procedure TfpgToggle.SetUnCheckedColor(AValue: TfpgColor); +begin + if FUnCheckedColor=AValue then Exit; + FUnCheckedColor:=AValue; + Invalidate; +end; + +procedure TfpgToggle.AnimateTimer(Sender: TObject); +begin + if csDestroying in ComponentState then + Exit; + if not Checked then + begin // not checked + Dec(FSliderPosition, 1); + if FSliderPosition < 1 then + FSliderPosition:=0; + end + else // checked + begin + Inc(FSliderPosition); + if FSliderPosition >= FToggleWidth - FToggleButtonWidth -2then + FSliderPosition := FToggleWidth - FToggleButtonWidth -2; + end; + Invalidate; +end; + +procedure TfpgToggle.SetUnCheckedTextColor(AValue: TfpgColor); +begin + if FUnCheckedTextColor=AValue then Exit; + FUnCheckedTextColor:=AValue; + Invalidate; +end; + +function TfpgToggle.ToggleLeft: TfpgCoord; +begin + if BoxLayout = tbLeftBox then + Result := 1 + else + Result := Width - FToggleWidth; +end; + +procedure TfpgToggle.HandlePaint; +var + ToggleText: TfpgString; + PaintColor: TFPColor; + TextEnabled: TfpgTextFlags; + BvlWdth: TfpgCoord; + ButtonRect: TfpgRect; +begin + Canvas.Clear(BackgroundColor); + + // Text + Canvas.SetFont(Font); + if Enabled then + TextEnabled := [] + else + TextEnabled := [txtDisabled]; + + BvlWdth := fpgStyleManager.Style.GetBevelWidth; + + if BoxLayout = tbRightBox then + Canvas.DrawText(fpgRect(0,0,FWidth-FToggleWidth, FHeight), Text, [txtLeft, txtVCenter] + TextEnabled) { internally this still calls fpgStyle.DrawString(), so theming will be applied } + else + Canvas.DrawText(fpgRect(ToggleWidth,0,FWidth-ToggleWidth, FHeight), Text, [txtRight, txtVCenter] + TextEnabled); { internally this still calls fpgStyle.DrawString(), so theming will be applied } + + // Toggle Stuff + + // Toggle area bevel + fpgStyleManager.Style.DrawBevel(Canvas,ToggleLeft,0,FToggleWidth, Height, False); + + // Toggle Button + ButtonRect := fpgRect(ToggleLeft+FSliderPosition+BvlWdth,BvlWdth,FToggleButtonWidth, Height -(BvlWdth*2)); + fpgStyleManager.Style.DrawBevel(Canvas,ButtonRect.Left, ButtonRect.Top, ButtonRect.Width, ButtonRect.Height, True); + + + // unchecked text + if FSliderPosition < (FToggleWidth - FToggleButtonWidth) div 2 then + begin + ToggleText := FUnCheckedCaption; + Canvas.SetTextColor(FUnCheckedTextColor); + end + // checked text + else + begin + ToggleText := FCheckedCaption; + Canvas.SetTextColor(FCheckedTextColor); + end; + + // Toggle Text (inside 2 bevels) + Canvas.DrawText(fpgRect(ToggleLeft+FSliderPosition+BvlWdth*2,BvlWdth*2,FToggleButtonWidth-BvlWdth*4, Height-BvlWdth*4),ToggleText, [txtVCenter, txtHCenter] + TextEnabled); + + // Paint on either side of the button part of the toggle + if FSliderPosition > 0 then + begin + Canvas.SetColor(CheckedColor); + Canvas.FillRectangle(fpgRect(ToggleLeft+1,1, FSliderPosition, FHeight - BvlWdth*2)); + end; + + if FSliderPosition < FToggleWidth - FToggleButtonWidth -2 then + begin + Canvas.SetColor(UnCheckedColor); + Canvas.FillRectangle(fpgRect(ToggleLeft + FSliderPosition + FToggleButtonWidth+BvlWdth, BvlWdth, FToggleWidth - FToggleButtonWidth - FSliderPosition -(BvlWdth*2), FHeight - BvlWdth*2)); + end; + + // lastly draw focus + if FFocusable and FFocused then + begin + InflateRect(ButtonRect, -1,-1); + fpgStyleManager.Style.DrawFocusRect(Canvas, ButtonRect); + end; + + + if FPaintedSliderPosition = FSliderPosition then + FAnimateTimer.Enabled:=False; + + FPaintedSliderPosition := FSliderPosition; +end; + +procedure TfpgToggle.HandleCheckChanged; +begin + if FUseAnimation then + FAnimateTimer.Enabled := True + else + begin + if Checked then + FSliderPosition := FToggleWidth - FToggleButtonWidth -2 + else + FSliderPosition := 0; + end; + FPaintedSliderPosition := -1; +end; + +procedure TfpgToggle.HandleLMouseUp(x, y: integer; shiftstate: TShiftState); +begin + if ((BoxLayout = tbRightBox) and (x > Width - FToggleWidth)) + or ((BoxLayout = tbLeftBox) and (x <= FToggleWidth)) + then + inherited HandleLMouseUp(x, y, shiftstate); +end; + +constructor TfpgToggle.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + Text := 'ToggleBox'; + ToggleWidth := 45; + BoxLayout := tbRightBox; + FUseAnimation := True; + FUnCheckedCaption := 'OFF'; + FCheckedCaption := 'ON'; + FUnCheckedColor := FBackgroundColor; + FCheckedColor := clLime; + FUnCheckedTextColor := clText1; + FCheckedTextColor := clHilite2; + FAnimateTimer := TfpgTimer.Create(12); + FAnimateTimer.Enabled := False; + FAnimateTimer.OnTimer := @AnimateTimer; +end; + +destructor TfpgToggle.Destroy; +begin + FAnimateTimer.Free; + inherited Destroy; +end; + +end. + diff --git a/src/gui/fpg_tree.pas b/src/gui/fpg_tree.pas index 5e1008c2..6c929b5e 100644 --- a/src/gui/fpg_tree.pas +++ b/src/gui/fpg_tree.pas @@ -1,7 +1,7 @@ { fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2011 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2014 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -84,7 +84,6 @@ type FText: TfpgString; FTextColor: TfpgColor; FHasChildren: Boolean; - FTree: TfpgTreeView; procedure SetCollapsed(const AValue: boolean); procedure SetInactSelColor(const AValue: TfpgColor); procedure SetInactSelTextColor(const AValue: TfpgColor); @@ -97,8 +96,11 @@ type procedure SetHasChildren(const AValue: Boolean); procedure DoTreeCheck(ANode: TfpgTreeNode); procedure SetStateImageIndex(const AValue: integer); + protected + FTree: TfpgTreeView; public - constructor Create; + constructor Create; overload; + constructor Create(ATreeView: TfpgTreeView; AText: TfpgString); overload; destructor Destroy; override; // node related function AppendText(AText: TfpgString): TfpgTreeNode; @@ -133,6 +135,7 @@ type property Parent: TfpgTreeNode read FParent write SetParent; property Prev: TfpgTreeNode read FPrev write FPrev; property Text: TfpgString read FText write SetText; + property TreeView: TfpgTreeView read FTree; { determines the + or - image in the treeview } property HasChildren: Boolean read FHasChildren write SetHasChildren; // color settings @@ -264,8 +267,10 @@ type property TreeLineColor: TfpgColor read FTreeLineColor write SetTreeLineColor default clShadow1; property TreeLineStyle: TfpgLineStyle read FTreeLineStyle write SetTreeLineStyle default lsDot; property OnChange: TNotifyEvent read FOnChange write FOnChange; - property OnExpand: TfpgTreeExpandEvent read FOnExpand write FOnExpand; property OnDoubleClick; + property OnExpand: TfpgTreeExpandEvent read FOnExpand write FOnExpand; + property OnKeyChar; + property OnKeyPress; property OnShowHint; property OnStateImageClicked: TfpgStateImageClickedEvent read FOnStateImageClicked write FOnStateImageClicked; end; @@ -394,7 +399,8 @@ begin FData := nil; FFirstSubNode := nil; FLastSubNode := nil; - FText := ''; + FText := ''; + FTree := nil; FImageIndex := -1; FStateImageIndex := -1; FCollapsed := True; @@ -411,6 +417,13 @@ begin FInactSelTextColor := clUnset; end; +constructor TfpgTreeNode.Create(ATreeView: TfpgTreeView; AText: TfpgString); +begin + Create; + FText := AText; + FTree := ATreeView; +end; + destructor TfpgTreeNode.Destroy; begin if FParent <> nil then diff --git a/src/gui/inputintegerdialog.inc b/src/gui/inputintegerdialog.inc new file mode 100644 index 00000000..237fb549 --- /dev/null +++ b/src/gui/inputintegerdialog.inc @@ -0,0 +1,157 @@ +{ + fpGUI - Free Pascal GUI Toolkit + + Copyright (C) 2006 - 2014 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 Input Query dialogs. +} + +{%mainunit fpg_dialogs.pas} + +{$IFDEF read_interface} + +type + + TfpgIntegerDialog = class(TfpgForm) + private + {@VFD_HEAD_BEGIN: fpgIntegerDialog} + lblText: TfpgLabel; + edtInteger: TfpgEditInteger; + btnOK: TfpgButton; + btnCancel: TfpgButton; + {@VFD_HEAD_END: fpgIntegerDialog} + procedure SetupCaptions; + procedure edtIntegerKeyPressed(Sender: TObject; var KeyCode: word; var ShiftState: TShiftState; var Consumed: boolean); + protected + procedure HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: boolean); override; + public + procedure AfterCreate; override; + end; + + +{$ENDIF read_interface} + +{$IFDEF read_implementation} + +function fpgIntegerQuery(const ACaption, APrompt: TfpgString; var Value: Integer; const MaxValue: Integer; const MinValue: Integer): Boolean; +var + dlg: TfpgIntegerDialog; +begin + dlg := TfpgIntegerDialog.Create(nil); + try + dlg.WindowTitle := ACaption; + dlg.lblText.Text := APrompt; + dlg.edtInteger.MaxValue:= MaxValue; + dlg.edtinteger.MinValue:= MinValue; + dlg.edtInteger.Value := Value; + Result := dlg.ShowModal = mrOK; + if Result then + Value := dlg.edtInteger.Value; + finally + dlg.Free; + end; +end; + +{ TfpgIntegerDialog } + +procedure TfpgIntegerDialog.SetupCaptions; +begin + btnOK.Text := rsOK; + btnCancel.Text := rsCancel; +end; + +procedure TfpgIntegerDialog.edtIntegerKeyPressed(Sender: TObject; var KeyCode: word; var ShiftState: TShiftState; var Consumed: boolean); +begin + if KeyCode = keyEnter then + btnOK.Click; +end; + +procedure TfpgIntegerDialog.HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: boolean); +begin + if KeyCode = keyEscape then + begin + consumed := True; + ModalResult := mrCancel; + end; +end; + +procedure TfpgIntegerDialog.AfterCreate; +begin + {%region 'Auto-generated GUI code' -fold} + {@VFD_BODY_BEGIN: fpgIntegerDialog} + Name := 'fpgIntegerDialog'; + SetPosition(100, 150, 208, 97); + WindowTitle := 'IntegerDialog'; + Hint := ''; + WindowPosition := wpOneThirdDown; + + lblText := TfpgLabel.Create(self); + with lblText do + begin + Name := 'lblText'; + SetPosition(8, 8, 208, 16); + Anchors := [anLeft,anRight,anTop]; + FontDesc := '#Label1'; + Hint := ''; + Text := 'lblText'; + end; + + edtInteger := TfpgEditInteger.Create(self); + with edtInteger do + begin + Name := 'edtInteger'; + SetPosition(8, 26, 100, 24); + Anchors := [anLeft,anRight,anTop]; + Hint := ''; + TabOrder := 2; + Text := ''; + FontDesc := '#Edit1'; + Value := 0; + OnKeyPress := @edtIntegerKeyPressed; + end; + + btnOK := TfpgButton.Create(self); + with btnOK do + begin + Name := 'btnOK'; + SetPosition(8, 64, 92, 24); + Anchors := [anRight,anBottom]; + Text := 'OK'; + FontDesc := '#Label1'; + Hint := ''; + ImageName := ''; + ModalResult := mrOK; + TabOrder := 3; + end; + + btnCancel := TfpgButton.Create(self); + with btnCancel do + begin + Name := 'btnCancel'; + SetPosition(108, 64, 92, 24); + Anchors := [anRight,anBottom]; + Text := 'Cancel'; + FontDesc := '#Label1'; + Hint := ''; + ImageName := ''; + ModalResult := mrCancel; + TabOrder := 4; + end; + + {@VFD_BODY_END: fpgIntegerDialog} + {%endregion} + + SetupCaptions; +end; + +{$ENDIF read_implementation} + diff --git a/src/gui/inputquerydialog.inc b/src/gui/inputquerydialog.inc index 6330d02c..b41af217 100644 --- a/src/gui/inputquerydialog.inc +++ b/src/gui/inputquerydialog.inc @@ -1,7 +1,7 @@ { fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2014 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, diff --git a/src/gui/selectdirdialog.inc b/src/gui/selectdirdialog.inc index 6a96d046..063c7972 100644 --- a/src/gui/selectdirdialog.inc +++ b/src/gui/selectdirdialog.inc @@ -135,7 +135,6 @@ begin begin try SortList := TStringList.Create; - SortList.Sorted := True; repeat // check if special file if (FileInfo.Name = '.') or (FileInfo.Name = '..') or (FileInfo.Name = '') then @@ -153,10 +152,12 @@ begin hidden files then do not add it to the list. } //if ((faHidden and FileInfo.Attr) > 0) and not FShowHidden then //continue; - SortList.Add(FileInfo.Name); end; until fpgFindNext(FileInfo) <> 0; + + SortList.Sort; + for i := 0 to SortList.Count - 1 do begin NewNode := Node.AppendText(SortList[i]); |