summaryrefslogtreecommitdiff
path: root/src/gui
diff options
context:
space:
mode:
Diffstat (limited to 'src/gui')
-rw-r--r--src/gui/colordialog.inc286
-rw-r--r--src/gui/fpg_basegrid.pas242
-rw-r--r--src/gui/fpg_checkbox.pas7
-rw-r--r--src/gui/fpg_customgrid.pas15
-rw-r--r--src/gui/fpg_dialogs.pas43
-rw-r--r--src/gui/fpg_editcombo.pas20
-rw-r--r--src/gui/fpg_form.pas5
-rw-r--r--src/gui/fpg_grid.pas3
-rw-r--r--src/gui/fpg_listbox.pas46
-rw-r--r--src/gui/fpg_listview.pas18
-rw-r--r--src/gui/fpg_memo.pas11
-rw-r--r--src/gui/fpg_menu.pas1
-rw-r--r--src/gui/fpg_panel.pas5
-rw-r--r--src/gui/fpg_scrollbar.pas13
-rw-r--r--src/gui/fpg_scrollframe.pas530
-rw-r--r--src/gui/fpg_stringgridbuilder.pas178
-rw-r--r--src/gui/fpg_style_win8.pas2
-rw-r--r--src/gui/fpg_tab.pas11
-rw-r--r--src/gui/fpg_toggle.pas282
-rw-r--r--src/gui/fpg_tree.pas23
-rw-r--r--src/gui/inputintegerdialog.inc157
-rw-r--r--src/gui/inputquerydialog.inc2
-rw-r--r--src/gui/selectdirdialog.inc5
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]);
generated by cgit v1.2.3-70-g09d2 (git 2.47.0) at 2024-10-27 11:17:20 +0000