summaryrefslogtreecommitdiff
path: root/src/gui
diff options
context:
space:
mode:
Diffstat (limited to 'src/gui')
-rw-r--r--src/gui/colordialog.inc294
-rw-r--r--src/gui/fpg_basegrid.pas156
-rw-r--r--src/gui/fpg_checkbox.pas12
-rw-r--r--src/gui/fpg_colormapping.pas10
-rw-r--r--src/gui/fpg_combobox.pas5
-rw-r--r--src/gui/fpg_customgrid.pas2
-rw-r--r--src/gui/fpg_dialogs.pas22
-rw-r--r--src/gui/fpg_edit.pas5
-rw-r--r--src/gui/fpg_editbtn.pas36
-rw-r--r--src/gui/fpg_editcombo.pas20
-rw-r--r--src/gui/fpg_form.pas7
-rw-r--r--src/gui/fpg_grid.pas3
-rw-r--r--src/gui/fpg_listbox.pas5
-rw-r--r--src/gui/fpg_listview.pas93
-rw-r--r--src/gui/fpg_memo.pas16
-rw-r--r--src/gui/fpg_menu.pas20
-rw-r--r--src/gui/fpg_scrollbar.pas2
-rw-r--r--src/gui/fpg_stringgridbuilder.pas178
-rw-r--r--src/gui/fpg_tab.pas25
-rw-r--r--src/gui/fpg_toggle.pas281
-rw-r--r--src/gui/fpg_tree.pas6
-rw-r--r--src/gui/selectdirdialog.inc5
22 files changed, 1088 insertions, 115 deletions
diff --git a/src/gui/colordialog.inc b/src/gui/colordialog.inc
index 93d8d731..91ebdf0a 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 - 2015 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,33 +243,64 @@ 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);
var
- rgb: TFPColor;
+ rgb: fpg_base.TRGBTriple;
c: TfpgColor;
begin
FViaRGB := True; // prevent recursive updates
rgb.Red := edR.Value;
rgb.Green := edG.Value;
rgb.Blue := edB.Value;
- c := FPColorTofpgColor(rgb);
+ c := RGBTripleTofpgColor(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;
var
- rgb: TFPColor;
+ rgb: fpg_base.TRGBTriple;
c: TfpgColor;
begin
c := ValueBar.SelectedColor;
- rgb := fpgColorToFPColor(c);
+ rgb := fpgColorToRGBTriple(c);
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 cbce739f..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;
@@ -157,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;
@@ -224,6 +235,11 @@ begin
Result := FHeaderFont.FontDesc;
end;
+function TfpgBaseGrid.GetScrollBarWidth: Integer;
+begin
+ Result := FVScrollBar.Width;
+end;
+
function TfpgBaseGrid.GetTotalColumnWidth: integer;
var
i: integer;
@@ -277,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
@@ -300,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
@@ -550,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
@@ -612,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;
@@ -637,7 +713,7 @@ var
UpdateWindowPosition;
end;
end;
-
+
procedure getVisWidth;
begin
if showV then
@@ -660,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
@@ -681,7 +773,7 @@ begin
showH := False;
getVisWidth;
getVisLines;
-
+
// determine whether to show scrollbars for different configurations
case FScrollBarStyle of
ssHorizontal:
@@ -725,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
@@ -772,16 +883,15 @@ begin
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;
@@ -991,7 +1101,7 @@ begin
Canvas.SetClipRect(clipr);
Canvas.SetColor(FBackgroundColor);
-
+
// clearing after the last column
if r.Left <= clipr.Right then
begin
@@ -1142,7 +1252,7 @@ begin
end;
consumed := True;
end;
-
+
keyHome:
begin
if FRowSelect then
@@ -1168,7 +1278,7 @@ begin
end;
consumed := True;
end;
-
+
keyEnd:
begin
if FRowSelect then
@@ -1194,7 +1304,7 @@ begin
consumed := True;
end;
end; { case }
-
+
if consumed then
CheckFocusChange;
@@ -1275,7 +1385,7 @@ var
borders: TRect;
begin
inherited HandleMouseMove(x, y, btnstate, shiftstate);
-
+
if (ColumnCount = 0) or (RowCount = 0) then
Exit; //==>
@@ -1460,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
@@ -1504,6 +1614,7 @@ procedure TfpgBaseGrid.FollowFocus;
var
n: Integer;
w: TfpgCoord;
+ lmin, lmax: TfpgCoord;
begin
if (RowCount > 0) and (FFocusRow < 0) then
FFocusRow := 0;
@@ -1546,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;
@@ -1583,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;
@@ -1594,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;
diff --git a/src/gui/fpg_checkbox.pas b/src/gui/fpg_checkbox.pas
index 2b4b11d8..a2946c3c 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;
@@ -93,6 +94,11 @@ type
property OnChange;
property OnEnter;
property OnExit;
+ property OnMouseDown;
+ property OnMouseExit;
+ property OnMouseEnter;
+ property OnMouseMove;
+ property OnMouseUp;
property OnShowHint;
end;
@@ -121,6 +127,7 @@ begin
if FChecked = AValue then
Exit; //==>
FChecked := AValue;
+ HandleCheckChanged;
RePaint;
if not (csDesigning in ComponentState) then
DoOnChange;
@@ -173,6 +180,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_colormapping.pas b/src/gui/fpg_colormapping.pas
index b915bd93..a22b949e 100644
--- a/src/gui/fpg_colormapping.pas
+++ b/src/gui/fpg_colormapping.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 - 2015 See the file AUTHORS.txt, included in this
distribution, for details of the copyright.
See the file COPYING.modifiedLGPL, included in this distribution,
@@ -45,9 +45,9 @@ var
r, g, b: longint;
hi, lo: longint;
d: longint;
- rgb: TFPColor;
+ rgb: TRGBTriple;
begin
- rgb := fpgColorToFPColor(C);
+ rgb := fpgColorToRGBTriple(C);
r := rgb.Red;
g := rgb.Green;
b := rgb.Blue;
@@ -78,7 +78,7 @@ end;
function HSVToRGB(const H: longint; const S, V: double): TfpgColor;
var
r, g, b: longint;
- rgb: TFPColor;
+ rgb: TRGBTriple;
begin
if (h < 0) or (h > 1535) or (S < 0) or (S > 1) or (V < 0) or (V > 1) then
begin
@@ -130,7 +130,7 @@ begin
rgb.Red := r;
rgb.Green := g;
rgb.Blue := b;
- Result := FPColorTofpgColor(rgb);
+ Result := RGBTripleTofpgColor(rgb);
end;
diff --git a/src/gui/fpg_combobox.pas b/src/gui/fpg_combobox.pas
index bb26ada6..d67b1b62 100644
--- a/src/gui/fpg_combobox.pas
+++ b/src/gui/fpg_combobox.pas
@@ -176,6 +176,11 @@ type
property OnDropDown;
property OnEnter;
property OnExit;
+ property OnMouseDown;
+ property OnMouseExit;
+ property OnMouseEnter;
+ property OnMouseMove;
+ property OnMouseUp;
property OnShowHint;
end;
diff --git a/src/gui/fpg_customgrid.pas b/src/gui/fpg_customgrid.pas
index 98040374..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,
diff --git a/src/gui/fpg_dialogs.pas b/src/gui/fpg_dialogs.pas
index 781c0745..42f4752c 100644
--- a/src/gui/fpg_dialogs.pas
+++ b/src/gui/fpg_dialogs.pas
@@ -579,6 +579,8 @@ end;
constructor TfpgBaseDialog.Create(AOwner: TComponent);
begin
+ // WindowType must be set before inherited or our parent property will be set
+ WindowType:=wtModalForm;
inherited Create(AOwner);
Width := 500;
Height := 400;
@@ -737,13 +739,31 @@ var
result := c;
end;
+ function LookAhead: char;
+ var
+ i: integer;
+ lc: char;
+ begin
+ i := cp+1;
+ if i > length(desc) then
+ lc := #0
+ else
+ lc := desc[i];
+ result := lc;
+ end;
+
procedure NextToken;
begin
token := '';
- while (c <> #0) and (c in [' ','a'..'z','A'..'Z','_','0'..'9']) do
+ while (c <> #0) and (c in [' ', 'a'..'z', 'A'..'Z', '_', '@', '0'..'9']) do
begin
token := token + c;
NextC;
+ if (c = '-') and (LookAhead in [' ', 'a'..'z', 'A'..'Z', '_']) then
+ begin
+ token := token + c;
+ NextC;
+ end;
end;
end;
diff --git a/src/gui/fpg_edit.pas b/src/gui/fpg_edit.pas
index 0ed17bfd..6bc3cc7c 100644
--- a/src/gui/fpg_edit.pas
+++ b/src/gui/fpg_edit.pas
@@ -189,8 +189,11 @@ type
property OnExit;
property OnKeyChar;
property OnKeyPress;
- property OnMouseEnter;
+ property OnMouseDown;
property OnMouseExit;
+ property OnMouseEnter;
+ property OnMouseMove;
+ property OnMouseUp;
property OnPaint;
property OnShowHint;
end;
diff --git a/src/gui/fpg_editbtn.pas b/src/gui/fpg_editbtn.pas
index 65417efd..d63aaee3 100644
--- a/src/gui/fpg_editbtn.pas
+++ b/src/gui/fpg_editbtn.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 - 2015 See the file AUTHORS.txt, included in this
distribution, for details of the copyright.
See the file COPYING.modifiedLGPL, included in this distribution,
@@ -83,6 +83,11 @@ type
property ReadOnly;
property TabOrder;
property OnButtonClick;
+ property OnMouseDown;
+ property OnMouseExit;
+ property OnMouseEnter;
+ property OnMouseMove;
+ property OnMouseUp;
property OnShowHint;
property OnFilenameSet: TFilenameSetEvent read FOnFilenameSet write FOnFilenameSet;
end;
@@ -91,11 +96,11 @@ type
TfpgDirectoryEdit = class(TfpgBaseEditButton)
private
FRootDirectory: TfpgString;
- function GetDirectory: TfpgString;
- procedure SetDirectory(const AValue: TfpgString);
+ function GetDirectory: TfpgString;
+ procedure SetDirectory(const AValue: TfpgString);
protected
- procedure HandlePaint; override;
- procedure InternalButtonClick(Sender: TObject); override;
+ procedure HandlePaint; override;
+ procedure InternalButtonClick(Sender: TObject); override;
public
constructor Create(AOwner: TComponent); override;
published
@@ -107,16 +112,21 @@ type
property ReadOnly;
property TabOrder;
property OnButtonClick;
+ property OnMouseDown;
+ property OnMouseExit;
+ property OnMouseEnter;
+ property OnMouseMove;
+ property OnMouseUp;
property OnShowHint;
end;
TfpgFontEdit = class(TfpgBaseEditButton)
protected
- function GetFontDesc: TfpgString; virtual;
- procedure SetFontDesc(const AValue: TfpgString); virtual;
- procedure HandlePaint; override;
- procedure InternalButtonClick(Sender: TObject); override;
+ function GetFontDesc: TfpgString; virtual;
+ procedure SetFontDesc(const AValue: TfpgString); virtual;
+ procedure HandlePaint; override;
+ procedure InternalButtonClick(Sender: TObject); override;
public
constructor Create(AOwner: TComponent); override;
published
@@ -183,7 +193,7 @@ begin
Canvas.Clear(clBoxColor);
fpgStyle.DrawControlFrame(Canvas, 0, 0, Width - Height, Height);
fpgStyle.DrawButtonFace(Canvas, Width - Height, 0, Height, Height, [btfIsEmbedded]);
- Canvas.SetFont(fpgApplication.DefaultFont);
+ Canvas.SetFont(fpgStyle.DefaultFont);
if Text <> '' then
begin
Canvas.TextColor := clText3;
@@ -354,7 +364,7 @@ begin
Canvas.Clear(clBoxColor);
fpgStyle.DrawControlFrame(Canvas, 0, 0, Width - Height, Height);
fpgStyle.DrawButtonFace(Canvas, Width - Height, 0, Height, Height, [btfIsEmbedded]);
- Canvas.SetFont(fpgApplication.DefaultFont);
+ Canvas.SetFont(fpgStyle.DefaultFont);
if Filename <> '' then
begin
Canvas.TextColor := clText3;
@@ -439,7 +449,7 @@ begin
Canvas.Clear(clBoxColor);
fpgStyle.DrawControlFrame(Canvas, 0, 0, Width - Height, Height);
fpgStyle.DrawButtonFace(Canvas, Width - Height, 0, Height, Height, [btfIsEmbedded]);
- Canvas.SetFont(fpgApplication.DefaultFont);
+ Canvas.SetFont(fpgStyle.DefaultFont);
if Directory <> '' then
begin
Canvas.TextColor := clText3;
@@ -502,7 +512,7 @@ begin
fpgStyle.DrawControlFrame(Canvas, 0, 0, Width - Height, Height);
fpgStyle.DrawButtonFace(Canvas, Width - Height, 0, Height, Height, [btfIsEmbedded]);
Canvas.TextColor := clShadow1;
- Canvas.SetFont(fpgApplication.DefaultFont);
+ Canvas.SetFont(fpgStyle.DefaultFont);
Canvas.DrawText(0, 0, Width - Height, Height, ClassName, [txtHCenter, txtVCenter]);
img := fpgImages.GetImage('stdimg.font'); // don't free the img instance - we only got a reference
if img <> nil then
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 7d5fe042..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;
@@ -342,6 +345,8 @@ function TfpgBaseForm.ShowModal: TfpgModalResult;
var
lCloseAction: TCloseAction;
begin
+ if HasHandle and (FWindowType <> wtModalForm) then
+ HandleHide;
FWindowType := wtModalForm;
fpgApplication.PushModalForm(self);
ModalResult := mrNone;
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 11baed01..d876a222 100644
--- a/src/gui/fpg_listbox.pas
+++ b/src/gui/fpg_listbox.pas
@@ -168,6 +168,11 @@ type
property OnEnter;
property OnExit;
property OnKeyPress;
+ property OnMouseDown;
+ property OnMouseExit;
+ property OnMouseEnter;
+ property OnMouseMove;
+ property OnMouseUp;
property OnScroll;
property OnSelect;
property OnShowHint;
diff --git a/src/gui/fpg_listview.pas b/src/gui/fpg_listview.pas
index 0278c952..cf06e5bf 100644
--- a/src/gui/fpg_listview.pas
+++ b/src/gui/fpg_listview.pas
@@ -41,9 +41,12 @@ type
TfpgLVColumnClickEvent = procedure(Listview: TfpgListView; Column: TfpgLVColumn; Button: Integer) of object;
+ { TfpgLVColumn }
+
TfpgLVColumn = class(TComponent)
private
FAlignment: TAlignment;
+ FAutoExpand: Boolean;
FCaptionAlignment: TAlignment;
FDown: Boolean;
FAutoSize: Boolean;
@@ -56,7 +59,9 @@ type
FVisible: Boolean;
FWidth: Integer;
Ref: Integer;
+ function GetWidth: Integer;
procedure SetAlignment(const AValue: TAlignment);
+ procedure SetAutoExpand(AValue: Boolean);
procedure SetAutoSize(const AValue: Boolean);
procedure SetCaption(const AValue: String);
procedure SetCaptionAlignment(const AValue: TAlignment);
@@ -72,7 +77,8 @@ type
property CaptionAlignment: TAlignment read FCaptionAlignment write SetCaptionAlignment;
property Alignment: TAlignment read FAlignment write SetAlignment;
property AutoSize: Boolean read FAutoSize write SetAutoSize;
- property Width: Integer read FWidth write SetWidth;
+ property AutoExpand: Boolean read FAutoExpand write SetAutoExpand;
+ property Width: Integer read GetWidth write SetWidth;
property Height: Integer read FHeight write SetHeight;
property Visible: Boolean read FVisible write SetVisible;
property ColumnIndex: Integer read FColumnIndex write SetColumnIndex;
@@ -81,12 +87,16 @@ type
end;
+ { TfpgLVColumns }
+
TfpgLVColumns = class(TPersistent)
private
FListView: TfpgListView;
FColumns: TObjectList;
function GetColumn(AIndex: Integer): TfpgLVColumn;
procedure SetColumn(AIndex: Integer; const AValue: TfpgLVColumn);
+ procedure SetColumnFillRow(AValue: TfpgLVColumn);
+ function GetTotalColumsWidth(AIgnoreColumn: TfpgLVColumn): Integer;
public
constructor Create(AListView: TfpgListView);
destructor Destroy; override;
@@ -108,6 +118,7 @@ type
ColumnIndex: Integer; Area: TfpgRect; var PaintPart: TfpgLVItemPaintPart) of object;
TfpgLVPaintItemEvent = procedure(ListView: TfpgListView; Canvas: TfpgCanvas; Item: TfpgLVItem;
ItemIndex: Integer; Area:TfpgRect; var PaintPart: TfpgLVItemPaintPart) of object;
+ TfpgLVItemActivateEvent = procedure(ListView: TfpgListView; Item: TfpgLVItem) of object;
TfpgLVItemSelectEvent = procedure(ListView: TfpgListView; Item: TfpgLVItem;
ItemIndex: Integer; Selected: Boolean) of object;
@@ -210,6 +221,8 @@ type
TfpgListView = class(TfpgWidget, IfpgLVItemViewer)
private
FImages: array[TfpgLVItemStates] of TfpgImageList;
+ FOnItemActivate: TfpgLVItemActivateEvent;
+ FShowFocusRect: Boolean;
FSubitemImages: array[TfpgLVItemStates] of TfpgImageList;
FItemIndex: Integer;
FMultiSelect: Boolean;
@@ -241,6 +254,7 @@ type
procedure SetMultiSelect(const AValue: Boolean);
procedure SetOnColumnClick(const AValue: TfpgLVColumnClickEvent);
procedure SetScrollBarWidth(const AValue: integer);
+ procedure SetShowFocusRect(AValue: Boolean);
procedure SetShowHeaders(const AValue: Boolean);
procedure SetShiftIsPressed(const AValue: Boolean);
function SubItemGetImages(AIndex: integer): TfpgImageList;
@@ -266,6 +280,7 @@ type
function ItemIndexFromY(Y: Integer): Integer;
function HeaderHeight: Integer;
procedure DoRepaint;
+ procedure DoItemActivate(AItem: TfpgLVItem);
procedure DoColumnClick(Column: TfpgLVColumn; Button: Integer);
procedure HandleHeaderMouseMove(x, y: Integer; btnstate: word; Shiftstate: TShiftState);
property ShiftIsPressed: Boolean read FShiftIsPressed write SetShiftIsPressed;
@@ -276,6 +291,7 @@ type
procedure HandleRMouseDown(x, y: integer; shiftstate: TShiftState); override;
procedure HandleLMouseUp(x, y: integer; shiftstate: TShiftState); override;
procedure HandleRMouseUp(x, y: integer; shiftstate: TShiftState); override;
+ procedure HandleDoubleClick(x, y: integer; button: word; shiftstate: TShiftState); override;
procedure HandleMouseMove(x, y: integer; btnstate: word; shiftstate: TShiftState); override;
procedure HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: boolean); override;
procedure HandleKeyRelease(var keycode: word; var shiftstate: TShiftState; var consumed: boolean); override;
@@ -317,10 +333,12 @@ type
property SubItemImagesHotTrack: TfpgImageList index Ord(lisHotTrack) read SubItemGetImages write SubItemSetImages;
property ShowHeaders: Boolean read FShowHeaders write SetShowHeaders;
+ property ShowFocusRect: Boolean read FShowFocusRect write SetShowFocusRect;
property ShowHint;
property TabOrder;
property VScrollBar: TfpgScrollBar read FVScrollBar;
property OnColumnClick: TfpgLVColumnClickEvent read FOnColumnClick write SetOnColumnClick;
+ property OnItemActivate: TfpgLVItemActivateEvent read FOnItemActivate write FOnItemActivate;
property OnPaintColumn: TfpgLVPaintColumnEvent read FOnPaintColumn write FOnPaintColumn;
property OnPaintItem: TfpgLVPaintItemEvent read FOnPaintItem write FOnPaintItem;
property OnSelectionChanged: TfpgLVItemSelectEvent read FOnSelectionChanged write FOnSelectionChanged;
@@ -749,6 +767,13 @@ begin
FHScrollBar.Height:= FScrollBarWidth;
end;
+procedure TfpgListView.SetShowFocusRect(AValue: Boolean);
+begin
+ if FShowFocusRect=AValue then Exit;
+ FShowFocusRect:=AValue;
+ Invalidate;
+end;
+
procedure TfpgListView.SetShiftIsPressed(const AValue: Boolean);
begin
if AValue = FShiftIsPressed then
@@ -1014,6 +1039,12 @@ begin
RePaint;
end;
+procedure TfpgListView.DoItemActivate(AItem: TfpgLVItem);
+begin
+ if Assigned(FOnItemActivate) then
+ FOnItemActivate(Self, AItem);
+end;
+
procedure TfpgListView.DoColumnClick(Column: TfpgLVColumn; Button: Integer);
begin
if not Column.Clickable then
@@ -1271,6 +1302,17 @@ begin
DoRepaint;
end;
+procedure TfpgListView.HandleDoubleClick(x, y: integer; button: word;
+ shiftstate: TShiftState);
+var
+ Item: TfpgLVItem;
+begin
+ inherited HandleDoubleClick(x, y, button, shiftstate);
+ Item := ItemGetFromPoint(x,y);
+ if Assigned(Item) then
+ DoItemActivate(Item);
+end;
+
procedure TfpgListView.HandleMouseMove(x, y: integer; btnstate: word;
shiftstate: TShiftState);
var
@@ -1390,6 +1432,14 @@ begin
CheckSelectionFocus;
CheckMultiSelect
end;
+ keyEnter:
+ begin
+ if shiftstate = [] then
+ begin
+ if FItemIndex <> -1 then
+ DoItemActivate(Items.Item[FItemIndex]);
+ end;
+ end
else
consumed := False;
inherited HandleKeyPress(keycode, shiftstate, consumed);
@@ -1596,7 +1646,7 @@ begin
if Assigned(FOnPaintItem) then
FOnPaintItem(Self, Canvas, Item, I, ItemRect, PaintPart);
- if lvppFocused in PaintPart then
+ if (lvppFocused in PaintPart) and (FShowFocusRect) then
begin
if lisSelected in ItemState then
Canvas.Color := TfpgColor(not clSelection)
@@ -1781,6 +1831,7 @@ begin
FHeight := 80;
Focusable := True;
FShowHeaders := True;
+ FShowFocusRect := True;
FVScrollBar := TfpgScrollBar.Create(Self);
FVScrollBar.Orientation := orVertical;
@@ -1885,6 +1936,27 @@ begin
FColumns.Items[AIndex] := AValue;
end;
+procedure TfpgLVColumns.SetColumnFillRow(AValue: TfpgLVColumn);
+var
+ P: Pointer;
+ C: TfpgLVColumn absolute P;
+begin
+ for P in FColumns do
+ if C <> AValue then
+ C.AutoExpand:=False;
+end;
+
+function TfpgLVColumns.GetTotalColumsWidth(AIgnoreColumn: TfpgLVColumn): Integer;
+var
+ P: Pointer;
+ C: TfpgLVColumn absolute P;
+begin
+ Result := 0;
+ for P in FColumns do
+ if (C <> AIgnoreColumn) and (C.Visible) then
+ Inc(Result, C.FWidth);
+end;
+
constructor TfpgLVColumns.Create(AListView: TfpgListView);
begin
FListView := AListView;
@@ -1988,6 +2060,23 @@ begin
FColumns.FListView.DoRepaint;
end;
+function TfpgLVColumn.GetWidth: Integer;
+begin
+ Result := 0;
+ if AutoExpand then
+ Result := FColumns.FListView.Width - FColumns.GetTotalColumsWidth(Self);
+ if Result < FWidth then
+ Result := FWidth;
+end;
+
+procedure TfpgLVColumn.SetAutoExpand(AValue: Boolean);
+begin
+ if FAutoExpand=AValue then Exit;
+ FAutoExpand:=AValue;
+ if AValue then
+ FColumns.SetColumnFillRow(Self);
+end;
+
procedure TfpgLVColumn.SetWidth(const AValue: Integer);
begin
if FWidth=AValue then exit;
diff --git a/src/gui/fpg_memo.pas b/src/gui/fpg_memo.pas
index 374c8d47..d02e6ec4 100644
--- a/src/gui/fpg_memo.pas
+++ b/src/gui/fpg_memo.pas
@@ -153,8 +153,11 @@ type
property OnExit;
property OnKeyChar;
property OnKeyPress;
- property OnMouseEnter;
+ property OnMouseDown;
property OnMouseExit;
+ property OnMouseEnter;
+ property OnMouseMove;
+ property OnMouseUp;
property OnPaint;
property OnShowHint;
end;
@@ -308,12 +311,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 +1051,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 +1351,7 @@ begin
RePaint
else
inherited;
-
+
if hasChanged then
if Assigned(FOnChange) then
FOnChange(self);
@@ -1675,7 +1678,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 3f634c02..4779fe40 100644
--- a/src/gui/fpg_menu.pas
+++ b/src/gui/fpg_menu.pas
@@ -108,9 +108,6 @@ type
function MenuFocused: boolean;
function SearchItemByAccel(s: string): integer;
protected
- FMenuFont: TfpgFont;
- FMenuAccelFont: TfpgFont;
- FMenuDisabledFont: TfpgFont;
FSymbolWidth: integer;
FItems: TList;
FFocusItem: integer;
@@ -1100,7 +1097,7 @@ begin
if mi.HotKeyDef <> '' then
begin
s := mi.HotKeyDef;
- fpgStyle.DrawString(Canvas, rect.Right-FMenuFont.TextWidth(s)-FTextMargin, rect.Top, s, mi.Enabled);
+ fpgStyle.DrawString(Canvas, rect.Right-fpgStyle.MenuFont.TextWidth(s)-FTextMargin, rect.Top, s, mi.Enabled);
end;
// process menu item submenu arrow image
@@ -1182,7 +1179,7 @@ begin
if mi.Separator then
Result := 5
else
- Result := FMenuFont.Height + 2;
+ Result := fpgStyle.MenuFont.Height + 2;
end;
function TfpgPopupMenu.MenuFocused: boolean;
@@ -1263,14 +1260,14 @@ begin
mi := VisibleItem(n);
x := ItemHeight(mi);
inc(h, x);
- x := FMenuFont.TextWidth(mi.Text);
+ x := fpgStyle.MenuFont.TextWidth(mi.Text);
if tw < x then
tw := x;
if mi.SubMenu <> nil then
- x := FMenuFont.Height
+ x := fpgStyle.MenuFont.Height
else
- x := FMenuFont.TextWidth(mi.HotKeyDef);
+ x := fpgStyle.MenuFont.TextWidth(mi.HotKeyDef);
if hkw < x then
hkw := x;
end;
@@ -1342,16 +1339,13 @@ end;
constructor TfpgPopupMenu.Create(AOwner: TComponent);
begin
+ FWindowType:=wtPopup;
inherited Create(AOwner);
FMargin := 3;
FTextMargin := 3;
FItems := TList.Create;
- // fonts
- FMenuFont := fpgStyle.MenuFont;
- FMenuAccelFont := fpgStyle.MenuAccelFont;
- FMenuDisabledFont := fpgStyle.MenuDisabledFont;
- FSymbolWidth := FMenuFont.Height+2;
+ FSymbolWidth := fpgStyle.MenuFont.Height+2;
FBeforeShow := nil;
FFocusItem := -1;
diff --git a/src/gui/fpg_scrollbar.pas b/src/gui/fpg_scrollbar.pas
index 1ec78952..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, ssBothVisible);
+ TfpgScrollStyle = (ssNone, ssHorizontal, ssVertical, ssAutoBoth, ssHorizVisible, ssVertiVisible, ssBothVisible);
TfpgScrollBarPart = (sbpNone, sbpUpBack, sbpPageUpBack, sbpSlider, sbpDownForward, sbpPageDownForward);
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_tab.pas b/src/gui/fpg_tab.pas
index 29addb12..8846a7e1 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,
@@ -86,7 +86,6 @@ type
TfpgPageControl = class(TfpgWidget)
private
- FFont: TfpgFont;
FActivePage: TfpgTabSheet;
FMargin: integer;
FFixedTabWidth: integer;
@@ -521,7 +520,7 @@ begin
if FFixedTabHeight > 0 then
result := FFixedTabHeight
else
- result := FFont.Height + 10; { TODO: correct this }
+ result := fpgStyle.DefaultFont.Height + 10; { TODO: correct this }
end;
function TfpgPageControl.ButtonWidth(AText: string): integer;
@@ -529,7 +528,7 @@ begin
if FFixedTabWidth > 0 then
result := FFixedTabWidth
else
- result := FFont.TextWidth(AText) + 10;
+ result := fpgStyle.DefaultFont.TextWidth(AText) + 10;
end;
procedure TfpgPageControl.SetFixedTabWidth(const AValue: integer);
@@ -566,14 +565,14 @@ begin
i := 1;
if FFixedTabWidth > 0 then
begin
- while FFont.TextWidth(s1) < (FFixedTabWidth-10) do
+ while fpgStyle.DefaultFont.TextWidth(s1) < (FFixedTabWidth-10) do
begin
if Length(s1) = Length(s) then
Break;
s1 := UTF8Copy(s, 1, i);
inc(i);
end;
- if FFont.TextWidth(s1) > (FFixedTabWidth-10) then
+ if fpgStyle.DefaultFont.TextWidth(s1) > (FFixedTabWidth-10) then
UTF8Delete(s1, UTF8Length(s1), 1);
if Length(s1) > 0 then
s1 := Trim(s1);
@@ -948,7 +947,7 @@ begin
r3 := DrawTab(r2, h = ActivePage);
// paint text on non-active tabs
if h <> ActivePage then
- Canvas.DrawText(lp + (ButtonWidth(h.Text) div 2) - FFont.TextWidth(GetTabText(h.Text)) div 2,
+ Canvas.DrawText(lp + (ButtonWidth(h.Text) div 2) - fpgStyle.DefaultFont.TextWidth(GetTabText(h.Text)) div 2,
Height-TabH+toffset, GetTabText(h.Text), lTxtFlags);
r2.Left := r2.Left + r2.Width;
@@ -992,7 +991,7 @@ begin
r3 := DrawTab(r2, h = ActivePage);
// paint text on non-active tabs
if h <> ActivePage then
- Canvas.DrawText(lp + (ButtonWidth(h.Text) div 2) - FFont.TextWidth(GetTabText(h.Text)) div 2,
+ Canvas.DrawText(lp + (ButtonWidth(h.Text) div 2) - fpgStyle.DefaultFont.TextWidth(GetTabText(h.Text)) div 2,
FMargin+toffset, GetTabText(h.Text), lTxtFlags);
r2.Left := r2.Left + r2.Width;
lp := lp + ButtonWidth(h.Text);
@@ -1223,7 +1222,6 @@ end;
constructor TfpgPageControl.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
- FFont := fpgStyle.DefaultFont;
FPages := TList.Create;
Width := 150;
Height := 100;
@@ -1291,10 +1289,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 +1319,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 +1343,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..9cdfe3af
--- /dev/null
+++ b/src/gui/fpg_toggle.pas
@@ -0,0 +1,281 @@
+{
+ fpGUI - Free Pascal GUI Toolkit
+
+ Copyright (C) 2006 - 2015 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;
+ 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 7da5205c..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,
@@ -267,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;
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 15:19:36 +0000