summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/3rdparty/libvlc/vlc.pas6
-rw-r--r--src/VERSION_FILE.inc2
-rw-r--r--src/build.bat2
-rwxr-xr-xsrc/build.sh8
-rw-r--r--src/corelib/fpg_base.pas80
-rw-r--r--src/corelib/fpg_csvparser.pas320
-rw-r--r--src/corelib/fpg_imgutils.pas8
-rw-r--r--src/corelib/fpg_main.pas149
-rw-r--r--src/corelib/fpg_stdimages.pas7
-rw-r--r--src/corelib/fpg_utils.pas37
-rw-r--r--src/corelib/fpg_widget.pas6
-rw-r--r--src/corelib/gdi/fpg_gdi.pas44
-rw-r--r--src/corelib/gdi/fpgui_toolkit.lpk16
-rw-r--r--src/corelib/gdi/fpgui_toolkit.pas3
-rw-r--r--src/corelib/lang_af.inc36
-rw-r--r--src/corelib/lang_de.inc8
-rw-r--r--src/corelib/lang_en.inc8
-rw-r--r--src/corelib/lang_es.inc8
-rw-r--r--src/corelib/lang_fr.inc24
-rw-r--r--src/corelib/lang_it.inc8
-rw-r--r--src/corelib/lang_pt.inc8
-rw-r--r--src/corelib/lang_ru.inc24
-rw-r--r--src/corelib/render/software/Agg2D.pas12
-rw-r--r--src/corelib/render/software/agg-demos/extrafpc.cfg21
-rw-r--r--src/corelib/render/software/agg_2D.pas60
-rw-r--r--src/corelib/render/software/agg_blur.pas2
-rw-r--r--src/corelib/render/software/agg_platform_gdi.inc13
-rw-r--r--src/corelib/stdimages.inc22
-rw-r--r--src/corelib/x11/fpg_x11.pas95
-rw-r--r--src/corelib/x11/fpgui_toolkit.lpk16
-rw-r--r--src/corelib/x11/fpgui_toolkit.pas5
-rw-r--r--src/extrafpc.cfg7
-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
-rw-r--r--src/reportengine/u_command.pas2
-rw-r--r--src/reportengine/u_pdf.pas2
-rw-r--r--src/reportengine/u_report.pas4
57 files changed, 1971 insertions, 305 deletions
diff --git a/src/3rdparty/libvlc/vlc.pas b/src/3rdparty/libvlc/vlc.pas
index 0f82b9c0..4b1ca563 100644
--- a/src/3rdparty/libvlc/vlc.pas
+++ b/src/3rdparty/libvlc/vlc.pas
@@ -322,8 +322,8 @@ Type
Property VideoPosition ;
Property VideoFractionalPosition ;
Property VideoFramesPerSecond;
- Property VideoScale : Double;
- Property AspectRatio : String;
+ Property VideoScale;
+ Property AspectRatio;
Published
Property AudioDelay ;
Property AudioVolume ;
@@ -391,7 +391,7 @@ Type
TVLCMediaListPlayer = Class(TCustomVLCMediaListPlayer)
Public
- Property VLC : TVLCLibrary;
+ Property VLC;
Published
Property Player;
Property PlayMode;
diff --git a/src/VERSION_FILE.inc b/src/VERSION_FILE.inc
index b0593919..bac1d842 100644
--- a/src/VERSION_FILE.inc
+++ b/src/VERSION_FILE.inc
@@ -1 +1 @@
-FPGUI_VERSION = '1.2';
+FPGUI_VERSION = '1.4';
diff --git a/src/build.bat b/src/build.bat
index 6928adfe..741048db 100644
--- a/src/build.bat
+++ b/src/build.bat
@@ -18,5 +18,5 @@ echo "You've got the correct output lib directory"
:end
-fpc -dRELEASE -dGDI @extrafpc.cfg corelib\gdi\fpgui_toolkit.pas
+fpc -dDEBUG -dGDI @extrafpc.cfg corelib\gdi\fpgui_toolkit.pas
diff --git a/src/build.sh b/src/build.sh
index 8f90fdae..8a180ceb 100755
--- a/src/build.sh
+++ b/src/build.sh
@@ -1,6 +1,7 @@
#!/bin/bash
-fpctarget=`fpc -iTP`-`fpc -iTO`
+fpcbin=fpc
+fpctarget=`$fpcbin -iTP`-`$fpcbin -iTO`
#echo $fpctarget
libpath='../lib/'$fpctarget
@@ -12,7 +13,8 @@ if [ ! -d $libpath ]; then
fi
# Default build
-fpc -dRELEASE -dX11 @extrafpc.cfg corelib/x11/fpgui_toolkit.pas
+$fpcbin -dDEBUG -dX11 @extrafpc.cfg corelib/x11/fpgui_toolkit.pas
+
# experimental AggPas-enabled Canvas under X11
-#fpc -dRELEASE -dX11 -dAGGCanvas @extrafpc.cfg corelib/x11/fpgui_toolkit.pas
+#$fpcbin -dDEBUG -dX11 -dAGGCanvas @extrafpc.cfg corelib/x11/fpgui_toolkit.pas
diff --git a/src/corelib/fpg_base.pas b/src/corelib/fpg_base.pas
index cb615569..b615f764 100644
--- a/src/corelib/fpg_base.pas
+++ b/src/corelib/fpg_base.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 - 2015 See the file AUTHORS.txt, included in this
distribution, for details of the copyright.
See the file COPYING.modifiedLGPL, included in this distribution,
@@ -49,14 +49,6 @@ type
Alpha: byte;
end;
- // Same declaration as in FPImage unit, but we don't use FPImage yet, so declare it here
- TFPColor = record
- Red: byte;
- Green: byte;
- Blue: byte;
- Alpha: byte;
- end deprecated;
-
TWindowType = (wtChild, wtWindow, wtModalForm, wtPopup);
TWindowAttribute = (waSizeable, waAutoPos, waScreenCenterPos, waStayOnTop,
@@ -121,7 +113,8 @@ const
FPGM_FREEME = 19;
FPGM_DROPENTER = 20;
FPGM_DROPEXIT = 21;
- FPGM_HSCROLL = 22;
+ FPGM_HSCROLL = 22;
+ FPGM_ABOUT = 23;
FPGM_USER = 50000;
FPGM_KILLME = MaxInt;
@@ -138,6 +131,7 @@ var
FPG_DEFAULT_FONT_DESC: string = 'Liberation Sans-10:antialias=true';
FPG_DEFAULT_SANS: string = 'Liberation Sans';
{$ENDIF}
+ FPG_DEFAULT_FIXED_FONT_DESC: string = 'Courier New-10';
const
UserNamedColorStart = 128;
@@ -573,8 +567,11 @@ type
function PrevModalForm: TfpgWindowBase;
function RemoveWindowFromModalStack(AForm: TfpgWindowBase): Integer;
procedure CreateForm(InstanceClass: TComponentClass; out Reference);
+ function GetFormByClassName(const AClassName: string): TfpgWindowBase;
+ function GetFormByName(const AName: string): TfpgWindowBase;
function GetScreenWidth: TfpgCoord; virtual; abstract;
function GetScreenHeight: TfpgCoord; virtual; abstract;
+ function GetScreenPixelColor(APos: TPoint): TfpgColor; virtual; abstract;
function Screen_dpi_x: integer; virtual; abstract;
function Screen_dpi_y: integer; virtual; abstract;
function Screen_dpi: integer; virtual; abstract;
@@ -727,8 +724,8 @@ type
destructor Destroy; override;
function Execute(const ADropActions: TfpgDropActions; const ADefaultAction: TfpgDropAction = daCopy): TfpgDropAction; virtual; abstract;
end;
-
-
+
+
{ TfpgBaseTimer }
TfpgBaseTimer = class(TObject)
@@ -763,9 +760,7 @@ function CheckClipboardKey(AKey: Word; AShiftstate: TShiftState): TClipboardKe
{ Color }
function fpgColorToRGBTriple(const AColor: TfpgColor): TRGBTriple;
-function fpgColorToFPColor(const AColor: TfpgColor): TFPColor; deprecated;
function RGBTripleTofpgColor(const AColor: TRGBTriple): TfpgColor;
-function FPColorTofpgColor(const AColor: TFPColor): TfpgColor; deprecated;
function fpgGetRed(const AColor: TfpgColor): byte;
function fpgGetGreen(const AColor: TfpgColor): byte;
function fpgGetBlue(const AColor: TfpgColor): byte;
@@ -994,27 +989,11 @@ begin
end
end;
-function fpgColorToFPColor(const AColor: TfpgColor): TFPColor; deprecated;
-begin
- with Result do
- begin
- Red := fpgGetRed(AColor);
- Green := fpgGetGreen(AColor);
- Blue := fpgGetBlue(AColor);
- Alpha := fpgGetAlpha(AColor);
- end
-end;
-
function RGBTripleTofpgColor(const AColor: TRGBTriple): TfpgColor;
begin
Result := AColor.Blue or (AColor.Green shl 8) or (AColor.Red shl 16) or (AColor.Alpha shl 24);
end;
-function FPColorTofpgColor(const AColor: TFPColor): TfpgColor; deprecated;
-begin
- Result := AColor.Blue or (AColor.Green shl 8) or (AColor.Red shl 16) or (AColor.Alpha shl 24);
-end;
-
function fpgGetRed(const AColor: TfpgColor): byte;
var
c: TfpgColor;
@@ -1741,9 +1720,12 @@ begin
RGBStop := fpgColorToRGBTriple(AStop);
if ADirection = gdVertical then
- count := ARect.Height
+ count := ARect.Bottom - ARect.Top
else
- count := ARect.Width;
+ count := ARect.Right - ARect.Left;
+
+ if count < 1 then
+ Exit; // there is nothing to paint
RDiff := RGBStop.Red - RGBStart.Red;
GDiff := RGBStop.Green - RGBStart.Green;
@@ -1858,7 +1840,7 @@ begin
SetColor(clText1);
SetTextColor(clText1);
- SetFont(fpgApplication.DefaultFont);
+ SetFont(fpgStyle.DefaultFont);
SetLineStyle(0, lsSolid);
FBeginDrawCount := 0;
@@ -2181,7 +2163,7 @@ begin
p := FImageData;
Inc(p, (FWidth * y) + x);
p^ := AValue;
-// write(IntToHex(AValue, 6) + ' ');
+// write(IntToHex(AValue, 8) + ' ');
end;
constructor TfpgImageBase.Create;
@@ -2517,6 +2499,36 @@ begin
end;
end;
+function TfpgApplicationBase.GetFormByClassName(const AClassName: string): TfpgWindowBase;
+var
+ i: integer;
+begin
+ Result := nil;
+ for i := 0 to FormCount-1 do
+ begin
+ if Forms[i].ClassName = AClassName then
+ begin
+ Result := Forms[i];
+ break;
+ end;
+ end;
+end;
+
+function TfpgApplicationBase.GetFormByName(const AName: string): TfpgWindowBase;
+var
+ i: integer;
+begin
+ Result := nil;
+ for i := 0 to FormCount-1 do
+ begin
+ if Forms[i].Name = AName then
+ begin
+ Result := Forms[i];
+ break;
+ end;
+ end;
+end;
+
procedure TfpgApplicationBase.Terminate;
var
i: integer;
diff --git a/src/corelib/fpg_csvparser.pas b/src/corelib/fpg_csvparser.pas
new file mode 100644
index 00000000..f5c0d0ed
--- /dev/null
+++ b/src/corelib/fpg_csvparser.pas
@@ -0,0 +1,320 @@
+{
+ 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:
+ Uses a Finite State Machine to parse CSV files.
+ Graeme Geldenhuys <graemeg@gmail.com>
+
+ This unit shows how one could use the State Design Pattern to implement a
+ FSM (Finite State Machine) to create a CSV Parser. It handles invalid
+ CSV as well and will raise an appropriate exception. In the State pattern,
+ each of the states becomes a subclass of the base class. Each subclass must
+ implement the abstract method which will handle the input character and
+ decide on the next state.
+}
+
+unit fpg_CSVParser;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes;
+
+type
+ { forward declarations }
+ TCSVParser = class;
+ TParserStateClass = class of TCSVParserState;
+
+
+ { Abstract State object }
+ TCSVParserState = class(TObject)
+ private
+ FParser: TCSVParser;
+ procedure ChangeState(NewState: TParserStateClass);
+ procedure AddCharToCurrField(Ch: char);
+ procedure AddCurrFieldToList;
+ public
+ constructor Create(AParser: TCSVParser);
+ { Must be implemented in the concrete classes to handle the input character
+ and decide on the next state. }
+ procedure ProcessChar(Ch: AnsiChar; Pos: integer); virtual; abstract;
+ end;
+
+
+ { A concrete state object - used when starting a new field }
+ TCSVParserFieldStartState = class(TCSVParserState)
+ public
+ procedure ProcessChar(Ch: AnsiChar; Pos: integer); override;
+ end;
+
+
+ { A concrete state object - used while scanning a field }
+ TCSVParserScanFieldState = class(TCSVParserState)
+ public
+ procedure ProcessChar(Ch: AnsiChar; Pos: integer); override;
+ end;
+
+
+ { A concrete state object - used while scanning double quoted fields }
+ TCSVParserScanQuotedState = class(TCSVParserState)
+ public
+ procedure ProcessChar(Ch: AnsiChar; Pos: integer); override;
+ end;
+
+
+ { A concrete state object - used when found the ending double quote }
+ TCSVParserEndQuotedState = class(TCSVParserState)
+ public
+ procedure ProcessChar(Ch: AnsiChar; Pos: integer); override;
+ end;
+
+
+ { A concrete state object - some error occured / invalid CSV structure }
+ TCSVParserGotErrorState = class(TCSVParserState)
+ public
+ procedure ProcessChar(Ch: AnsiChar; Pos: integer); override;
+ end;
+
+
+ { The actual state machine - CSV parser }
+ TCSVParser = class(TObject)
+ private
+ FCurrentLine: string;
+ FState: TCSVParserState;
+ { Cache state objects for greater performance. This comes in handy when
+ parsing a large CSV file. For smaller files you might want to create them
+ on the fly. }
+ FFieldStartState: TCSVParserFieldStartState;
+ FScanFieldState: TCSVParserScanFieldState;
+ FScanQuotedState: TCSVParserScanQuotedState;
+ FEndQuotedState: TCSVParserEndQuotedState;
+ FGotErrorState: TCSVParserGotErrorState;
+ { Fields used during parsing }
+ FCurrField: string;
+ FFieldList: TStrings;
+ function GetState: TParserStateClass;
+ procedure SetState(const Value: TParserStateClass);
+ protected
+ procedure AddCharToCurrField(Ch: char);
+ procedure AddCurrFieldToList;
+ { An example of Self Encapsulating Field refactoring }
+ property State: TParserStateClass read GetState write SetState;
+ public
+ constructor Create;
+ destructor Destroy; override;
+ { prodecure to call, to start the parsing process }
+ procedure ExtractFields(const S: string; const pFieldList: TStrings);
+ property CurrentLine: string read FCurrentLine;
+ end;
+
+
+// global singleton function
+function gCSVParser: TCSVParser;
+
+
+implementation
+
+uses
+ SysUtils;
+
+var
+ uCSVParser: TCSVParser;
+
+
+// Lazy mans singleton
+function gCSVParser: TCSVParser;
+begin
+ if uCSVParser = nil then
+ uCSVParser := TCSVParser.Create;
+ Result := uCSVParser;
+end;
+
+{ TCSVParser }
+
+constructor TCSVParser.Create;
+begin
+ inherited Create;
+ FCurrentLine := '';
+ FFieldStartState := TCSVParserFieldStartState.Create(Self);
+ FScanFieldState := TCSVParserScanFieldState.Create(Self);
+ FScanQuotedState := TCSVParserScanQuotedState.Create(Self);
+ FEndQuotedState := TCSVParserEndQuotedState.Create(Self);
+ FGotErrorState := TCSVParserGotErrorState.Create(Self);
+end;
+
+destructor TCSVParser.Destroy;
+begin
+ FFieldStartState.Free;
+ FScanFieldState.Free;
+ FScanQuotedState.Free;
+ FEndQuotedState.Free;
+ FGotErrorState.Free;
+ inherited;
+end;
+
+function TCSVParser.GetState: TParserStateClass;
+begin
+ Result := TParserStateClass(FState.ClassType);
+end;
+
+procedure TCSVParser.SetState(const Value: TParserStateClass);
+begin
+ if Value = TCSVParserFieldStartState then
+ FState := FFieldStartState
+ else if Value = TCSVParserScanFieldState then
+ FState := FScanFieldState
+ else if Value = TCSVParserScanQuotedState then
+ FState := FScanQuotedState
+ else if Value = TCSVParserEndQuotedState then
+ FState := FEndQuotedState
+ else if Value = TCSVParserGotErrorState then
+ FState := FGotErrorState;
+end;
+
+procedure TCSVParser.ExtractFields(const S: string; const pFieldList: TStrings);
+var
+ i: integer;
+ Ch: AnsiChar;
+begin
+ FCurrentLine := S;
+ FFieldList := pFieldList;
+ Assert(Assigned(FFieldList), 'FieldList not assigned');
+ { Initialize by clearing the string list, and starting in FieldStart state }
+ FFieldList.Clear;
+ State := TCSVParserFieldStartState;
+ FCurrField := '';
+
+ { Read through all the characters in the string }
+ for i := 1 to Length(s) do
+ begin
+ { Get the next character }
+ Ch := s[i];
+ FState.ProcessChar(Ch, i);
+ end;
+
+ { If we are in the ScanQuoted or GotError state at the end of the string,
+ there was a problem with a closing quote. You can add the second if test
+ for an extra failsafe! }
+ if (State = TCSVParserScanQuotedState) then
+ // or (State = TCSVParserGotErrorState) then
+ raise Exception.Create('Missing closing quote');
+
+ { If the current field is not empty, add it to the list }
+ if (FCurrField <> '') then
+ AddCurrFieldToList;
+end;
+
+procedure TCSVParser.AddCharToCurrField(Ch: char);
+begin
+ FCurrField := FCurrField + Ch;
+end;
+
+procedure TCSVParser.AddCurrFieldToList;
+begin
+ FFieldList.Add(FCurrField);
+ // Clear the field in preparation for collecting the next one
+ FCurrField := '';
+end;
+
+{ TCSVParserState }
+
+constructor TCSVParserState.Create(AParser: TCSVParser);
+begin
+ inherited Create;
+ FParser := AParser;
+end;
+
+procedure TCSVParserState.ChangeState(NewState: TParserStateClass);
+begin
+ FParser.State := NewState;
+end;
+
+procedure TCSVParserState.AddCharToCurrField(Ch: char);
+begin
+ FParser.AddCharToCurrField(Ch);
+end;
+
+procedure TCSVParserState.AddCurrFieldToList;
+begin
+ FParser.AddCurrFieldToList;
+end;
+
+{ TCSVParserFieldStartState }
+
+procedure TCSVParserFieldStartState.ProcessChar(Ch: AnsiChar; Pos: integer);
+begin
+ case Ch of
+ '"': ChangeState(TCSVParserScanQuotedState);
+ ',': AddCurrFieldToList;
+ else
+ AddCharToCurrField(Ch);
+ ChangeState(TCSVParserScanFieldState);
+ end;
+end;
+
+{ TCSVParserScanFieldState }
+
+procedure TCSVParserScanFieldState.ProcessChar(Ch: AnsiChar; Pos: integer);
+begin
+ if (Ch = ',') then
+ begin
+ AddCurrFieldToList;
+ ChangeState(TCSVParserFieldStartState);
+ end
+ else
+ AddCharToCurrField(Ch);
+end;
+
+{ TCSVParserScanQuotedState }
+
+procedure TCSVParserScanQuotedState.ProcessChar(Ch: AnsiChar; Pos: integer);
+begin
+ if (Ch = '"') then
+ ChangeState(TCSVParserEndQuotedState)
+ else
+ AddCharToCurrField(Ch);
+end;
+
+{ TCSVParserEndQuotedState }
+
+procedure TCSVParserEndQuotedState.ProcessChar(Ch: AnsiChar; Pos: integer);
+begin
+ if (Ch = ',') then
+ begin
+ AddCurrFieldToList;
+ ChangeState(TCSVParserFieldStartState);
+ end
+ else
+ ChangeState(TCSVParserGotErrorState);
+end;
+
+{ TCSVParserGotErrorState }
+
+procedure TCSVParserGotErrorState.ProcessChar(Ch: AnsiChar; Pos: integer);
+begin
+ raise Exception.Create(Format('Error in line at position %d: ' + #10 +
+ '<%s>', [Pos, FParser.CurrentLine]));
+end;
+
+
+initialization
+ uCSVParser := nil;
+
+finalization
+ if uCSVParser <> nil then
+ uCSVParser.Free;
+
+end.
+
diff --git a/src/corelib/fpg_imgutils.pas b/src/corelib/fpg_imgutils.pas
index 97f33fb7..79892f5b 100644
--- a/src/corelib/fpg_imgutils.pas
+++ b/src/corelib/fpg_imgutils.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,
@@ -78,11 +78,11 @@ end;
function fpgCalculateGray(const AFrom: TfpgColor; const ABrighter: boolean = False; const APercent: integer = 0): TfpgColor;
var
g: integer;
- rgb: TFPColor;
+ rgb: TRGBTriple;
begin
with GrayConvMatrix do
begin
- rgb := fpgColorToFPColor(AFrom);
+ rgb := fpgColorToRGBTriple(AFrom);
g := round(red*rgb.red + green*rgb.green + blue*rgb.blue);
if ABrighter then
@@ -97,7 +97,7 @@ begin
rgb.Green := g;
rgb.Blue := g;
end;
- Result := FPColorTofpgColor(rgb);
+ Result := RGBTripleTofpgColor(rgb);
end;
diff --git a/src/corelib/fpg_main.pas b/src/corelib/fpg_main.pas
index c7275b14..1f063cb5 100644
--- a/src/corelib/fpg_main.pas
+++ b/src/corelib/fpg_main.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 - 2015 See the file AUTHORS.txt, included in this
distribution, for details of the copyright.
See the file COPYING.modifiedLGPL, included in this distribution,
@@ -51,7 +51,7 @@ type
TfpgMenuItemFlags = set of (mifSelected, mifHasFocus, mifSeparator,
mifEnabled, mifChecked, mifSubMenu);
-
+
TfpgTextFlags = set of (txtLeft, txtHCenter, txtRight, txtTop, txtVCenter,
txtBottom, txtWrap, txtDisabled, txtAutoSize);
@@ -62,7 +62,7 @@ type
const
AllAnchors = [anLeft, anRight, anTop, anBottom];
TextFlagsDflt = [txtLeft, txtTop];
-
+
type
{ *******************************************
@@ -183,6 +183,7 @@ type
function DrawText(x, y, w, h: TfpgCoord; const AText: TfpgString; AFlags: TfpgTextFlags = TextFlagsDflt; ALineSpace: integer = 2): integer; overload;
function DrawText(x, y: TfpgCoord; const AText: TfpgString; AFlags: TfpgTextFlags = TextFlagsDflt; ALineSpace: integer = 2): integer; overload;
function DrawText(r: TfpgRect; const AText: TfpgString; AFlags: TfpgTextFlags = TextFlagsDflt; ALineSpace: integer = 2): integer; overload;
+ property Window: TfpgWindowBase read FWindow;
end;
@@ -190,19 +191,32 @@ type
will rework this to use a Style Manager like the previous fpGUI.
Also support Bitmap based styles for easier theme implementations. }
TfpgStyle = class(TObject)
+ protected
+ FDefaultFont: TfpgFont;
+ FFixedFont: TfpgFont;
+ FMenuAccelFont: TfpgFont;
+ FMenuDisabledFont: TfpgFont;
+ FMenuFont: TfpgFont;
+ procedure SetDefaultFont(AValue: TfpgFont);
+ procedure SetFixedFont(AValue: TfpgFont);
+ procedure SetMenuAccelFont(AValue: TfpgFont);
+ procedure SetMenuDisabledFont(AValue: TfpgFont);
+ procedure SetMenuFont(AValue: TfpgFont);
public
- DefaultFont: TfpgFont;
- FixedFont: TfpgFont;
- MenuFont: TfpgFont;
- MenuAccelFont: TfpgFont;
- MenuDisabledFont: TfpgFont;
constructor Create; virtual;
destructor Destroy; override;
+ { font objects }
+ property DefaultFont: TfpgFont read FDefaultFont write SetDefaultFont;
+ property FixedFont: TfpgFont read FFixedFont write SetFixedFont;
+ property MenuFont: TfpgFont read FMenuFont write SetMenuFont;
+ property MenuAccelFont: TfpgFont read FMenuAccelFont write SetMenuAccelFont;
+ property MenuDisabledFont: TfpgFont read FMenuDisabledFont write SetMenuDisabledFont;
{ General }
procedure DrawControlFrame(ACanvas: TfpgCanvas; x, y, w, h: TfpgCoord); virtual; overload;
procedure DrawControlFrame(ACanvas: TfpgCanvas; r: TfpgRect); overload;
function GetControlFrameBorders: TRect; virtual;
procedure DrawBevel(ACanvas: TfpgCanvas; x, y, w, h: TfpgCoord; ARaised: Boolean = True); virtual;
+ function GetBevelWidth: TfpgCoord; virtual;
procedure DrawDirectionArrow(ACanvas: TfpgCanvas; x, y, w, h: TfpgCoord; direction: TArrowDirection); virtual;
procedure DrawString(ACanvas: TfpgCanvas; x, y: TfpgCoord; AText: string; AEnabled: boolean = True); virtual;
procedure DrawFocusRect(ACanvas: TfpgCanvas; r: TfpgRect); virtual;
@@ -228,7 +242,7 @@ type
function GetCheckBoxSize: integer; virtual;
procedure DrawCheckbox(ACanvas: TfpgCanvas; x, y: TfpgCoord; ix, iy: TfpgCoord); virtual;
end;
-
+
TMsgHookItem = class
Dest: TObject;
@@ -261,7 +275,6 @@ type
FDisplayParams: string;
FScreenWidth: integer;
FScreenHeight: integer;
- FDefaultFont: TfpgFont;
FFontResList: TList;
FMessageHookList: TFPList;
procedure FreeFontRes(afontres: TfpgFontResource);
@@ -283,7 +296,6 @@ type
procedure SetMessageHook(AWidget: TObject; const AMsgCode: integer; AListener: TObject);
procedure ShowException(E: Exception);
procedure UnsetMessageHook(AWidget: TObject; const AMsgCode: integer; AListener: TObject);
- property DefaultFont: TfpgFont read FDefaultFont;
property HintPause: Integer read FHintPause write SetHintPause;
property HintWindow: TfpgWindow read FHintWindow;
property ScreenWidth: integer read FScreenWidth;
@@ -326,12 +338,12 @@ type
property Width: integer read FWidth;
property Height: integer read FHeight;
end;
-
-
+
+
TfpgClipboard = class(TfpgClipboardImpl)
end;
-
+
TfpgFileList = class(TfpgFileListImpl)
end;
@@ -455,7 +467,6 @@ operator - (const APoint: TfpgPoint; i: Integer) p: TfpgPoint;
operator - (const ASize: TfpgSize; const APoint: TPoint) s: TfpgSize;
operator - (const ASize: TfpgSize; const APoint: TfpgPoint) s: TfpgSize;
operator - (const ASize: TfpgSize; i: Integer) s: TfpgSize;
-operator = (const AColor1, AColor2: TFPColor) b: Boolean; deprecated;
operator = (const AColor1, AColor2: TRGBTriple) b: Boolean;
@@ -508,7 +519,7 @@ type
end;
- TNamedFontItem = class
+ TNamedFontItem = class(TObject)
public
FontID: string;
FontDesc: string;
@@ -1169,14 +1180,6 @@ begin
s.h := ASize.h - i;
end;
-operator = (const AColor1, AColor2: TFPColor) b: Boolean;
-begin
- b := (AColor1.Red = AColor2.Red)
- and (AColor1.Green = AColor2.Green)
- and (AColor1.Blue = AColor2.Blue)
- and (AColor1.Alpha = AColor2.Alpha);
-end;
-
operator = (const AColor1, AColor2: TRGBTriple) b: Boolean;
begin
b := (AColor1.Red = AColor2.Red)
@@ -1295,7 +1298,7 @@ begin
Result := TStringList.Create
else
Exit; //==>
-
+
for n := 0 to fpgNamedFonts.Count-1 do
begin
oFont := TNamedFontItem(fpgNamedFonts[n]);
@@ -1364,14 +1367,12 @@ begin
fpgStyleManager.FreeStyleInstance;
fpgStyle := nil;
fpgCaret.Free;
-
+
for i := fpgTimers.Count-1 downto 0 do
if fpgTimers[i] <> nil then
TfpgTimer(fpgTimers[i]).Free;
fpgTimers.Free;
- FDefaultFont.Free;
-
for i := FFontResList.Count-1 downto 0 do
begin
TfpgFontResource(FFontResList[i]).Free;
@@ -1380,7 +1381,7 @@ begin
FFontResList.Free;
FreeAndNil(FModalFormStack);
-
+
for i := 0 to FMessageHookList.Count-1 do
TMsgHookItem(FMessageHookList[i]).Free;
FreeAndNil(FMessageHookList);
@@ -1391,7 +1392,7 @@ begin
uMsgQueueList.Delete(i);
end;
uMsgQueueList.Free;
-
+
inherited Destroy;
end;
@@ -1502,7 +1503,7 @@ begin
ShortDayNames[5] := rsShortThu;
ShortDayNames[6] := rsShortFri;
ShortDayNames[7] := rsShortSat;
-
+
LongDayNames[1] := rsLongSun;
LongDayNames[2] := rsLongMon;
LongDayNames[3] := rsLongTue;
@@ -1657,7 +1658,6 @@ end;
procedure TfpgApplication.InternalInit;
begin
- FDefaultFont := GetFont(FPG_DEFAULT_FONT_DESC);
fpgInitTimers;
fpgNamedFonts := TList.Create;
@@ -1936,10 +1936,10 @@ begin
end;
end;
nw := Max(wtxt, w);
-
+
wraplst := TStringList.Create;
wraplst.Text := AText;
-
+
if (txtWrap in AFlags) then
begin
for i := 0 to wraplst.Count-1 do
@@ -1949,7 +1949,7 @@ begin
end;
htxt := (Font.Height * wraplst.Count) + (ALineSpace * Pred(wraplst.Count));
-
+
// Now paint the actual text
for i := 0 to wraplst.Count-1 do
begin
@@ -1964,7 +1964,7 @@ begin
nx := x + (w - wtxt) div 2
else // txtLeft is default
nx := x;
-
+
// vertical alignment
if (txtBottom in AFlags) then
ny := y + l + h - htxt
@@ -1975,7 +1975,7 @@ begin
fpgStyle.DrawString(self, nx, ny, wraplst[i], lEnabled);
end;
-
+
wraplst.Free;
Result := htxt;
end;
@@ -2015,10 +2015,13 @@ begin
FModalForWin := nil;
- if (AOwner <> nil) and (AOwner is TfpgWindow) then
- FWindowType := wtChild
- else
- FWindowType := wtWindow;
+ if not (FWindowType in [wtModalForm, wtPopup]) then
+ begin
+ if (AOwner <> nil) and (AOwner is TfpgWindow) then
+ FWindowType := wtChild
+ else
+ FWindowType := wtWindow;
+ end;
FCanvas := CreateCanvas;
end;
@@ -2047,13 +2050,48 @@ end;
{ TfpgStyle }
+procedure TfpgStyle.SetDefaultFont(AValue: TfpgFont);
+begin
+ if FDefaultFont = AValue then Exit;
+ FDefaultFont.Free;
+ FDefaultFont := AValue;
+end;
+
+procedure TfpgStyle.SetFixedFont(AValue: TfpgFont);
+begin
+ if FFixedFont = AValue then Exit;
+ FFixedFont.Free;
+ FFixedFont := AValue;
+end;
+
+procedure TfpgStyle.SetMenuAccelFont(AValue: TfpgFont);
+begin
+ if FMenuAccelFont = AValue then Exit;
+ FMenuAccelFont.Free;
+ FMenuAccelFont := AValue;
+end;
+
+procedure TfpgStyle.SetMenuDisabledFont(AValue: TfpgFont);
+begin
+ if FMenuDisabledFont = AValue then Exit;
+ FMenuDisabledFont.Free;
+ FMenuDisabledFont := AValue;
+end;
+
+procedure TfpgStyle.SetMenuFont(AValue: TfpgFont);
+begin
+ if FMenuFont = AValue then Exit;
+ FMenuFont.Free;
+ FMenuFont := AValue;
+end;
+
constructor TfpgStyle.Create;
begin
// Setup font aliases
fpgSetNamedFont('Label1', FPG_DEFAULT_FONT_DESC);
fpgSetNamedFont('Label2', FPG_DEFAULT_FONT_DESC + ':bold');
fpgSetNamedFont('Edit1', FPG_DEFAULT_FONT_DESC);
- fpgSetNamedFont('Edit2', 'Courier New-10');
+ fpgSetNamedFont('Edit2', FPG_DEFAULT_FIXED_FONT_DESC);
fpgSetNamedFont('List', FPG_DEFAULT_FONT_DESC);
fpgSetNamedFont('Grid', FPG_DEFAULT_SANS + '-9');
fpgSetNamedFont('GridHeader', FPG_DEFAULT_SANS + '-9:bold');
@@ -2099,20 +2137,20 @@ begin
// Global Font Objects
- DefaultFont := fpgGetFont(fpgGetNamedFontDesc('Label1'));
- FixedFont := fpgGetFont(fpgGetNamedFontDesc('Edit2'));
- MenuFont := fpgGetFont(fpgGetNamedFontDesc('Menu'));
- MenuAccelFont := fpgGetFont(fpgGetNamedFontDesc('MenuAccel'));
- MenuDisabledFont := fpgGetFont(fpgGetNamedFontDesc('MenuDisabled'));
+ FDefaultFont := fpgGetFont(fpgGetNamedFontDesc('Label1'));
+ FFixedFont := fpgGetFont(fpgGetNamedFontDesc('Edit2'));
+ FMenuFont := fpgGetFont(fpgGetNamedFontDesc('Menu'));
+ FMenuAccelFont := fpgGetFont(fpgGetNamedFontDesc('MenuAccel'));
+ FMenuDisabledFont := fpgGetFont(fpgGetNamedFontDesc('MenuDisabled'));
end;
destructor TfpgStyle.Destroy;
begin
- DefaultFont.Free;
- FixedFont.Free;
- MenuFont.Free;
- MenuAccelFont.Free;
- MenuDisabledFont.Free;
+ FDefaultFont.Free;
+ FFixedFont.Free;
+ FMenuFont.Free;
+ FMenuAccelFont.Free;
+ FMenuDisabledFont.Free;
inherited Destroy;
end;
@@ -2253,7 +2291,7 @@ begin
ACanvas.SetColor(clWindowBackground);
ACanvas.SetLineStyle(1, lsSolid);
ACanvas.FillRectangle(x, y, w, h);
-
+
if ARaised then
ACanvas.SetColor(clHilite2)
else
@@ -2275,6 +2313,11 @@ begin
ACanvas.DrawLine(r.Right, r.Bottom, r.Left-1, r.Bottom);
end;
+function TfpgStyle.GetBevelWidth: TfpgCoord;
+begin
+ Result := 1;
+end;
+
procedure TfpgStyle.DrawDirectionArrow(ACanvas: TfpgCanvas; x, y, w, h: TfpgCoord; direction: TArrowDirection);
var
{
diff --git a/src/corelib/fpg_stdimages.pas b/src/corelib/fpg_stdimages.pas
index b02331aa..a641fa32 100644
--- a/src/corelib/fpg_stdimages.pas
+++ b/src/corelib/fpg_stdimages.pas
@@ -288,7 +288,12 @@ begin
'stdimg.executable',
@stdimg_executable_16,
sizeof(stdimg_executable_16), 0,0);
-
+
+ fpgImages.AddMaskedBMP(
+ 'stdimg.colpicker',
+ @stdimg_colpicker,
+ sizeof(stdimg_colpicker), 0,0);
+
// Dialog icons
fpgImages.AddMaskedBMP(
diff --git a/src/corelib/fpg_utils.pas b/src/corelib/fpg_utils.pas
index 9a135d73..df68a050 100644
--- a/src/corelib/fpg_utils.pas
+++ b/src/corelib/fpg_utils.pas
@@ -39,13 +39,14 @@ function fpgFileSize(const AFilename: TfpgString): integer;
function fpgAddTrailingValue(const ALine, AValue: TfpgString; ADuplicates: Boolean = True): TfpgString;
function fpgAppendPathDelim(const Path: TfpgString): TfpgString;
function fpgHasSubDirs(const Dir: TfpgString; AShowHidden: Boolean): Boolean;
-function fpgAllFilesMask: TfpgString;
+function fpgAllFilesMask: TfpgString; deprecated;
function fpgConvertLineEndings(const s: TfpgString): TfpgString;
function fpgGetToolkitConfigDir: TfpgString;
-{ This is so that when we support LTR and RTL languages, the colon will be
- added at the correct place. }
function fpgAddColon(const AText: TfpgString): TfpgString;
-function fpgIsBitSet(const AData: integer; const AIndex: integer): boolean;
+function fpgIsBitSet(const AData: integer; const AIndex: integer): boolean; deprecated;
+function fpgGetBit(const AData: LongInt; ABit: Longint): boolean; inline;
+procedure fpgSetBit(var AData: Longint; ABit: Longint; const AValue: boolean); inline;
+function fpgIntToBin(AValue: uint64; ADigits: byte=64): string;
// RTL wrapper filesystem functions with platform independant encoding
@@ -214,7 +215,6 @@ begin
Result := Path;
end;
-{function fpgHasSubDirs returns True if the directory passed has subdirectories}
function fpgHasSubDirs(const Dir: TfpgString; AShowHidden: Boolean): Boolean;
var
FileInfo: TSearchRec;
@@ -225,7 +225,7 @@ begin
if Dir <> '' then
begin
FCurrentDir := fpgAppendPathDelim(Dir);
- FCurrentDir := FCurrentDir + fpgAllFilesMask;
+ FCurrentDir := FCurrentDir + AllFilesMask;
try
if fpgFindFirst(FCurrentDir, faAnyFile or $00000080, FileInfo) = 0 then
repeat
@@ -299,6 +299,31 @@ begin
Result := (AData and (1 shl AIndex) <> 0);
end;
+function fpgGetBit(const AData: LongInt; ABit: Longint): boolean;
+begin
+ Result := (AData and (1 shl ABit) <> 0);
+end;
+
+procedure fpgSetBit(var AData: Longint; ABit: Longint; const AValue: boolean);
+begin
+ if AValue <> fpgGetBit(AData, ABit) then
+ AData := AData xor (1 shl ABit);
+end;
+
+function fpgIntToBin(AValue: uint64; ADigits: byte=64): string;
+begin
+ SetLength(Result, ADigits);
+ while ADigits > 0 do
+ begin
+ if odd(AValue) then
+ Result[ADigits] := '1'
+ else
+ Result[ADigits] := '0';
+ AValue := AValue shr 1;
+ dec(ADigits);
+ end;
+end;
+
end.
diff --git a/src/corelib/fpg_widget.pas b/src/corelib/fpg_widget.pas
index 527e2987..150a8284 100644
--- a/src/corelib/fpg_widget.pas
+++ b/src/corelib/fpg_widget.pas
@@ -39,8 +39,6 @@ type
TfpgDragDropEvent = procedure(Sender, Source: TObject; X, Y: integer; AData: variant) of object;
- { TfpgWidget }
-
TfpgWidget = class(TfpgWindow)
private
FAcceptDrops: boolean;
@@ -176,7 +174,7 @@ type
procedure KillFocus;
procedure MoveAndResizeBy(const dx, dy, dw, dh: TfpgCoord);
procedure SetPosition(aleft, atop, awidth, aheight: TfpgCoord); virtual;
- procedure Invalidate; // double check this works as developers expect????
+ procedure Invalidate;
property FormDesigner: TObject read FFormDesigner write SetFormDesigner;
property Parent: TfpgWidget read GetParent write SetParent;
property AcceptDrops: boolean read FAcceptDrops write SetAcceptDrops default False;
@@ -509,7 +507,7 @@ begin
inherited Create(AOwner);
- if (AOwner <> nil) and (AOwner is TfpgWidget) then
+ if (AOwner <> nil) and (AOwner is TfpgWidget) and (not (WindowType in [wtModalForm, wtPopup])) {and not InheritsFrom(TfpgForm)} then
begin
Parent := TfpgWidget(AOwner);
FTabOrder := AOwner.ComponentCount;
diff --git a/src/corelib/gdi/fpg_gdi.pas b/src/corelib/gdi/fpg_gdi.pas
index f1372928..a1d314f6 100644
--- a/src/corelib/gdi/fpg_gdi.pas
+++ b/src/corelib/gdi/fpg_gdi.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,
@@ -246,6 +246,7 @@ type
procedure DoFlush;
function GetScreenWidth: TfpgCoord; override;
function GetScreenHeight: TfpgCoord; override;
+ function GetScreenPixelColor(APos: TPoint): TfpgColor; override;
function Screen_dpi_x: integer; override;
function Screen_dpi_y: integer; override;
function Screen_dpi: integer; override;
@@ -347,6 +348,10 @@ var
OldMousePos: TPoint; // used to detect fake MouseMove events
NeedToUnitialize: Boolean;
+
+const
+ ID_ABOUT = 200001;
+
// some required keyboard functions
{$INCLUDE fpg_keys_gdi.inc}
@@ -1204,6 +1209,13 @@ begin
Windows.EndPaint(w.WinHandle, @PaintStruct);
end;
+ WM_SYSCOMMAND:
+ begin
+ if wParam = ID_ABOUT then
+ fpgSendMessage(nil, w, FPGM_ABOUT, msgp)
+ else
+ Windows.DefWindowProc(hwnd, uMsg, wParam, lParam);
+ end
else
Result := Windows.DefWindowProc(hwnd, uMsg, wParam, lParam);
end;
@@ -1279,7 +1291,7 @@ begin
if MainForm <> nil then
lHandle := TfpgGDIWindow(MainForm).FWinHandle
else
- lHandle := -1;
+ lHandle := 0;
FHiddenWindow := CreateWindow('FPGHIDDEN', '',
DWORD(WS_POPUP), 0, 0, 0, 0, lHandle, 0, MainInstance, nil);
end;
@@ -1405,6 +1417,14 @@ begin
// Result := Windows.GetSystemMetrics(SM_CYSCREEN);
end;
+function TfpgGDIApplication.GetScreenPixelColor(APos: TPoint): TfpgColor;
+var
+ c: longword;
+begin
+ c := Windows.GetPixel(FDisplay, APos.X, APos.Y);
+ Result := WinColorTofpgColor(c);
+end;
+
function TfpgGDIApplication.Screen_dpi_x: integer;
begin
Result := GetDeviceCaps(wapplication.display, LOGPIXELSX)
@@ -2601,13 +2621,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/corelib/gdi/fpgui_toolkit.lpk b/src/corelib/gdi/fpgui_toolkit.lpk
index dfe56c14..3566dc09 100644
--- a/src/corelib/gdi/fpgui_toolkit.lpk
+++ b/src/corelib/gdi/fpgui_toolkit.lpk
@@ -30,8 +30,8 @@
</CompilerOptions>
<Description Value="fpGUI Toolkit"/>
<License Value="LGPL 2 with static linking exception."/>
- <Version Major="1" Minor="2"/>
- <Files Count="104">
+ <Version Major="1" Minor="4"/>
+ <Files Count="107">
<Item1>
<Filename Value="..\stdimages.inc"/>
<Type Value="Include"/>
@@ -448,6 +448,18 @@
<Filename Value="..\..\gui\inputquerydialog.inc"/>
<Type Value="Include"/>
</Item104>
+ <Item105>
+ <Filename Value="..\..\gui\fpg_toggle.pas"/>
+ <UnitName Value="fpg_toggle"/>
+ </Item105>
+ <Item106>
+ <Filename Value="..\..\gui\fpg_stringgridbuilder.pas"/>
+ <UnitName Value="fpg_StringGridBuilder"/>
+ </Item106>
+ <Item107>
+ <Filename Value="..\fpg_csvparser.pas"/>
+ <UnitName Value="fpg_CSVParser"/>
+ </Item107>
</Files>
<LazDoc Paths="..\..\..\docs\xml\corelib;..\..\..\docs\xml\corelib\x11;..\..\..\docs\xml\corelib\gdi;..\..\..\docs\xml\gui"/>
<RequiredPkgs Count="1">
diff --git a/src/corelib/gdi/fpgui_toolkit.pas b/src/corelib/gdi/fpgui_toolkit.pas
index 12ac41b9..4704d56a 100644
--- a/src/corelib/gdi/fpgui_toolkit.pas
+++ b/src/corelib/gdi/fpgui_toolkit.pas
@@ -22,7 +22,8 @@ uses
fpg_style_win2k, fpg_style_motif, fpg_style_clearlooks, fpg_style_bluecurve,
fpg_style_bitmap, fpg_readonly, fpg_imgfmt_png, U_Command, U_Pdf, U_Report,
U_ReportImages, U_Visu, fpg_trayicon, Agg2D, fpg_dbugintf, fpg_dbugmsg,
- fpg_style_carbon, fpg_style_plastic, fpg_style_win8;
+ fpg_style_carbon, fpg_style_plastic, fpg_style_win8, fpg_toggle,
+ fpg_StringGridBuilder, fpg_CSVParser;
implementation
diff --git a/src/corelib/lang_af.inc b/src/corelib/lang_af.inc
index bd15fe69..173dd6b2 100644
--- a/src/corelib/lang_af.inc
+++ b/src/corelib/lang_af.inc
@@ -19,17 +19,21 @@ rsfileattributes = 'Eienskape';
rsshortaug = 'Aug';
rslongaug = 'Augustus';
rskeybksp = 'BkSp';
+rscolorblue = 'Blue';
rsbold = 'Vetdruk';
rscancel = 'Kanselleer';
rscannotcreatedir = 'Kan nie die lêergids skep nie';
rschange = 'Verander';
-rschangetitle = 'Change Title';
+rschangetitle = 'Verander Titel';
rscharactermap = 'Karakter Kaart';
+rscolorpickerhint = 'Click on Picker and maintain click => release to get the color';
rsclose = 'Sluit';
rscollection = 'Versameling';
-rsconfigurebookmarks = 'Configure Bookmarks';
+rstabsheetcolorwheel = 'Color Wheel';
+rsconfigurebookmarks = 'Instel Boekmerke';
rsconfirm = 'Bevestig';
rsconfirmation = 'Bevestiging';
+rscontinuous = 'Continuous';
rscopy = 'Kopieer';
rserrcouldnotopendir = 'Kon nie die lêergids <%s> oop maak nie';
rscreate = 'Skep';
@@ -43,7 +47,7 @@ rslongdec = 'Desember';
rskeydel = 'Del';
rsdelete = 'Skrap';
rsdirectories = 'Lêergidse';
-rsdirectory = 'Directory';
+rsdirectory = 'Lêergids';
rskeydown = 'Down';
rsdrive = 'Dryf';
rsedit = 'Redigeer';
@@ -56,7 +60,7 @@ rskeyesc = 'Esc';
rsexampletext = 'Teks Voorbeeld';
rsexit = 'Staak';
rserrfailedtocreatedir = 'Kon nie die lêergids <%s> skep nie';
-rsfailedtofindhelpviewer = 'Failed to find the help viewer.';
+rsfailedtofindhelpviewer = 'Kon nie die help program find nie.';
rsfalse = 'Onwaar';
rscollectionfavourites = 'Gunstelinge';
rsshortfeb = 'Feb';
@@ -67,14 +71,16 @@ rsfiles = 'Lêers';
rsfind = 'Vind';
rscollectionfixedwidth = 'Vaste wydte';
rscollectionfontaliases = 'Font Kenname';
-rserrreportfontfilemissing = 'Font file <%s.fnt> not found';
+rserrreportfontfilemissing = 'Font lêer" <%s.fnt> is nie gevind nie';
rsshortfri = 'Vr';
rslongfri = 'Vrydag';
+rscolorgreen = 'Green';
rsfilegroup = 'Groep';
rshelp = 'Help';
+rshexadecimal = 'Hexadecimal';
rskeyhome = 'Home';
rsignore = 'Ignoreer';
-rserrreportimagefilemissing = 'Image <%s> is missing';
+rserrreportimagefilemissing = 'Beeld-lêer <%s> is vermis';
rsinformation = 'Informasie';
rskeyins = 'Ins';
rsinsert = 'Invoeg';
@@ -98,8 +104,8 @@ rskeymeta = 'Meta+';
rsfilemodifiedtime = 'Wysigings Tyd';
rsshortmon = 'Ma';
rslongmon = 'Maandag';
-rsmovedown = 'Move Down';
-rsmoveup = 'Move Up';
+rsmovedown = 'Skyf Af';
+rsmoveup = 'Skyf Op';
rsname = 'Naam';
rsno = 'Nee';
rsnotoall = 'Nee vir Alles';
@@ -111,14 +117,16 @@ rslongoct = 'Oktober';
rsopen = 'Open';
rsopenafile = 'Maak ''n leêr op';
rsfileowner = 'Eienaar';
-rsfiletypepdf = 'PDF Documents';
-rsreportpage = 'Page';
+rsfiletypepdf = 'PDF Dokumente';
+rsreportpage = 'Bladsy';
rspassword = 'Wagwoord';
rspaste = 'Plak';
rskeypgdn = 'PgDn';
rskeypgup = 'PgUp';
-rsreportpreview = 'Preview';
+rstabpredefined = 'Predefined';
+rsreportpreview = 'Voorskou';
rscollectionrecentlyused = 'Onlangs gebruik';
+rscolorred = 'Red';
rsreplace = 'Vervang';
rsretry = 'Herprobeer';
rskeyright = 'Right';
@@ -129,7 +137,7 @@ rslongsat = 'Saterdag';
rssave = 'Stoor';
rssaveafile = 'Stoor ''n lêer as';
rssearch = 'Soek';
-rsreportsection = 'Section';
+rsreportsection = 'Seksie';
rsselect = 'Kies';
rsselectadirectory = 'Kies ''n lêergids';
rsselectafont = 'Kies ''n lettertipe';
@@ -145,7 +153,7 @@ rsshortsun = 'So';
rslongsun = 'Sondag';
rskeytab = 'Tab';
rstexttoinsert = 'Teks om in te voeg';
-rserrreportnopagestoprint = 'There are no pages to print';
+rserrreportnopagestoprint = 'Daar is geen bladsye om te druk nie';
rsshortthu = 'Do';
rslongthu = 'Donderdag';
rstoday = 'Vandag';
@@ -163,4 +171,4 @@ rslongwed = 'Woensdag';
rsaddnewitem = 'Wil jy die nuwe item <%s> in die lys bylas?';
rsyes = 'Ja';
rsyestoall = 'Ja vir Alles';
-rsreportpageof = 'of';
+rsreportpageof = 'van';
diff --git a/src/corelib/lang_de.inc b/src/corelib/lang_de.inc
index e8fe0a9a..a261926f 100644
--- a/src/corelib/lang_de.inc
+++ b/src/corelib/lang_de.inc
@@ -19,17 +19,21 @@ rsfileattributes = 'Attribute';
rsshortaug = 'Aug';
rslongaug = 'August';
rskeybksp = 'BkSp';
+rscolorblue = 'Blue';
rsbold = 'Fett';
rscancel = 'Abbrechen';
rscannotcreatedir = 'Kann Verzeichnis nicht anlegen';
rschange = 'Ändern';
rschangetitle = 'Change Title';
rscharactermap = 'Character Map';
+rscolorpickerhint = 'Click on Picker and maintain click => release to get the color';
rsclose = 'Schließen';
rscollection = 'Sammlung';
+rstabsheetcolorwheel = 'Color Wheel';
rsconfigurebookmarks = 'Configure Bookmarks';
rsconfirm = 'Bestätigen';
rsconfirmation = 'Bestätigung';
+rscontinuous = 'Continuous';
rscopy = 'Kopieren';
rserrcouldnotopendir = 'Konnte Verzeichnis <%> nicht anlegen';
rscreate = 'Anlegen';
@@ -70,8 +74,10 @@ rscollectionfontaliases = 'Font-Aliase';
rserrreportfontfilemissing = 'Font file <%s.fnt> not found';
rsshortfri = 'Fre';
rslongfri = 'Freitag';
+rscolorgreen = 'Green';
rsfilegroup = 'Gruppe';
rshelp = 'Hilfe';
+rshexadecimal = 'Hexadecimal';
rskeyhome = 'Home';
rsignore = 'Übergehen';
rserrreportimagefilemissing = 'Image <%s> is missing';
@@ -117,8 +123,10 @@ rspassword = 'Passwort';
rspaste = 'Einfügen';
rskeypgdn = 'PgDn';
rskeypgup = 'PgUp';
+rstabpredefined = 'Predefined';
rsreportpreview = 'Preview';
rscollectionrecentlyused = 'Zuletzt verwendet';
+rscolorred = 'Red';
rsreplace = 'Ersetzen';
rsretry = 'Wiederholen';
rskeyright = 'Right';
diff --git a/src/corelib/lang_en.inc b/src/corelib/lang_en.inc
index 6a681932..aec26b22 100644
--- a/src/corelib/lang_en.inc
+++ b/src/corelib/lang_en.inc
@@ -19,17 +19,21 @@ rsfileattributes = 'Attributes';
rsshortaug = 'Aug';
rslongaug = 'August';
rskeybksp = 'BkSp';
+rscolorblue = 'Blue';
rsbold = 'Bold';
rscancel = 'Cancel';
rscannotcreatedir = 'Cannot create directory';
rschange = 'Change';
rschangetitle = 'Change Title';
rscharactermap = 'Character Map';
+rscolorpickerhint = 'Click on Picker and maintain click => release to get the color';
rsclose = 'Close';
rscollection = 'Collection';
+rstabsheetcolorwheel = 'Color Wheel';
rsconfigurebookmarks = 'Configure Bookmarks';
rsconfirm = 'Confirm';
rsconfirmation = 'Confirmation';
+rscontinuous = 'Continuous';
rscopy = 'Copy';
rserrcouldnotopendir = 'Could not open the directory <%s>';
rscreate = 'Create';
@@ -70,8 +74,10 @@ rscollectionfontaliases = 'Font Aliases';
rserrreportfontfilemissing = 'Font file <%s.fnt> not found';
rsshortfri = 'Fri';
rslongfri = 'Friday';
+rscolorgreen = 'Green';
rsfilegroup = 'Group';
rshelp = 'Help';
+rshexadecimal = 'Hexadecimal';
rskeyhome = 'Home';
rsignore = 'Ignore';
rserrreportimagefilemissing = 'Image <%s> is missing';
@@ -117,8 +123,10 @@ rspassword = 'Password';
rspaste = 'Paste';
rskeypgdn = 'PgDn';
rskeypgup = 'PgUp';
+rstabpredefined = 'Predefined';
rsreportpreview = 'Preview';
rscollectionrecentlyused = 'Recently Used';
+rscolorred = 'Red';
rsreplace = 'Replace';
rsretry = 'Retry';
rskeyright = 'Right';
diff --git a/src/corelib/lang_es.inc b/src/corelib/lang_es.inc
index 780af188..f53ccb76 100644
--- a/src/corelib/lang_es.inc
+++ b/src/corelib/lang_es.inc
@@ -19,17 +19,21 @@ rsfileattributes = 'Atributos';
rsshortaug = 'Aug';
rslongaug = 'August';
rskeybksp = 'BkSp';
+rscolorblue = 'Blue';
rsbold = 'Negrita';
rscancel = 'Cancelar';
rscannotcreatedir = 'No se puede crear la carpeta';
rschange = 'Cambiar';
rschangetitle = 'Change Title';
rscharactermap = 'Character Map';
+rscolorpickerhint = 'Click on Picker and maintain click => release to get the color';
rsclose = 'Cerrar';
rscollection = 'Colección';
+rstabsheetcolorwheel = 'Color Wheel';
rsconfigurebookmarks = 'Configure Bookmarks';
rsconfirm = 'Confirmar';
rsconfirmation = 'Confirmación';
+rscontinuous = 'Continuous';
rscopy = 'Copiar';
rserrcouldnotopendir = 'No se puede abrir la carpeta <%s>';
rscreate = 'Create';
@@ -70,8 +74,10 @@ rscollectionfontaliases = 'Aliases de Fuentes';
rserrreportfontfilemissing = 'Font file <%s.fnt> not found';
rsshortfri = 'Vie';
rslongfri = 'Viernes';
+rscolorgreen = 'Green';
rsfilegroup = 'Grupo';
rshelp = 'Ayuda';
+rshexadecimal = 'Hexadecimal';
rskeyhome = 'Home';
rsignore = 'Ignorar';
rserrreportimagefilemissing = 'Image <%s> is missing';
@@ -117,8 +123,10 @@ rspassword = 'Contraseña';
rspaste = 'Pegar';
rskeypgdn = 'PgDn';
rskeypgup = 'PgUp';
+rstabpredefined = 'Predefined';
rsreportpreview = 'Preview';
rscollectionrecentlyused = 'Usados Recientemente';
+rscolorred = 'Red';
rsreplace = 'Reemplazar';
rsretry = 'Reintentar';
rskeyright = 'Right';
diff --git a/src/corelib/lang_fr.inc b/src/corelib/lang_fr.inc
index 7409c5ff..0a9a8e21 100644
--- a/src/corelib/lang_fr.inc
+++ b/src/corelib/lang_fr.inc
@@ -19,17 +19,21 @@ rsfileattributes = 'Attributs';
rsshortaug = 'Aoû';
rslongaug = 'Août';
rskeybksp = 'BkSp';
+rscolorblue = 'Blue';
rsbold = 'Gras';
rscancel = 'Annuler';
rscannotcreatedir = 'Impossible de créer le répertoire';
rschange = 'Modifier';
rschangetitle = 'Changer le titre';
rscharactermap = 'Table de caractères';
+rscolorpickerhint = 'Click on Picker and maintain click => release to get the color';
rsclose = 'Fermer';
rscollection = 'Collection';
+rstabsheetcolorwheel = 'Color Wheel';
rsconfigurebookmarks = 'Configurer les signets';
rsconfirm = 'Confirmer';
rsconfirmation = 'Confirmation';
+rscontinuous = 'Continuous';
rscopy = 'Copier';
rserrcouldnotopendir = 'Le répertoire <%s> n''''a pas pu être ouvert';
rscreate = 'Créer';
@@ -56,8 +60,8 @@ rskeyesc = 'Esc';
rsexampletext = 'Texte exemple';
rsexit = 'Sortir';
rserrfailedtocreatedir = 'Le répertoire <%s> n''''a pas pu être ouvert';
-rsfailedtofindhelpviewer = 'Failed to find the help viewer.';
-rsfalse = 'False';
+rsfailedtofindhelpviewer = 'Visualiseur d''aide non trouvé';
+rsfalse = 'Faux';
rscollectionfavourites = 'Favoris';
rsshortfeb = 'Fév';
rslongfeb = 'Février';
@@ -67,14 +71,16 @@ rsfiles = 'Fichiers';
rsfind = 'Trouver';
rscollectionfixedwidth = 'Longueur fixe';
rscollectionfontaliases = 'Alias';
-rserrreportfontfilemissing = 'Font file <%s.fnt> not found';
+rserrreportfontfilemissing = 'Fichier de police <%s.fnt> non trouvé';
rsshortfri = 'Ven';
rslongfri = 'Vendredi';
+rscolorgreen = 'Green';
rsfilegroup = 'Groupe';
rshelp = 'Aide';
+rshexadecimal = 'Hexadecimal';
rskeyhome = 'Home';
rsignore = 'Ignorer';
-rserrreportimagefilemissing = 'Image <%s> is missing';
+rserrreportimagefilemissing = 'Image <%s> introuvable';
rsinformation = 'Information';
rskeyins = 'Ins';
rsinsert = 'Insérer';
@@ -111,14 +117,16 @@ rslongoct = 'Octobre';
rsopen = 'Ouvrir';
rsopenafile = 'Ouvrir un fichier';
rsfileowner = 'Propriétaire';
-rsfiletypepdf = 'PDF Documents';
+rsfiletypepdf = 'Documents PDF';
rsreportpage = 'Page';
rspassword = 'Mot de passe';
rspaste = 'Coller';
rskeypgdn = 'PgDn';
rskeypgup = 'PgUp';
-rsreportpreview = 'Preview';
+rstabpredefined = 'Predefined';
+rsreportpreview = 'Prévisualisation';
rscollectionrecentlyused = 'Récemment utilisé';
+rscolorred = 'Red';
rsreplace = 'Remplacer';
rsretry = 'Retenter';
rskeyright = 'Right';
@@ -145,7 +153,7 @@ rsshortsun = 'Dim';
rslongsun = 'Dimanche';
rskeytab = 'Tab';
rstexttoinsert = 'Texte à insérer';
-rserrreportnopagestoprint = 'There are no pages to print';
+rserrreportnopagestoprint = 'Il n''y a pas de page à imprimer';
rsshortthu = 'Jeu';
rslongthu = 'Jeudi';
rstoday = 'Aujourd''''hui';
@@ -163,4 +171,4 @@ rslongwed = 'Mercredi';
rsaddnewitem = 'Voulez-vous ajouter l''''item <%s> à la liste?';
rsyes = 'Oui';
rsyestoall = 'Oui à tous';
-rsreportpageof = 'of';
+rsreportpageof = 'de';
diff --git a/src/corelib/lang_it.inc b/src/corelib/lang_it.inc
index 2ab860ad..26eb36d8 100644
--- a/src/corelib/lang_it.inc
+++ b/src/corelib/lang_it.inc
@@ -19,17 +19,21 @@ rsfileattributes = 'Attributi';
rsshortaug = 'Ago';
rslongaug = 'Agosto';
rskeybksp = 'BkSp';
+rscolorblue = 'Blue';
rsbold = 'Grassetto';
rscancel = 'Annulla';
rscannotcreatedir = 'Non riesco a creare la cartella';
rschange = 'Cambia';
rschangetitle = 'Change Title';
rscharactermap = 'Character Map';
+rscolorpickerhint = 'Click on Picker and maintain click => release to get the color';
rsclose = 'Chiudi';
rscollection = 'Collezione';
+rstabsheetcolorwheel = 'Color Wheel';
rsconfigurebookmarks = 'Configure Bookmarks';
rsconfirm = 'Conferma';
rsconfirmation = 'Conferma';
+rscontinuous = 'Continuous';
rscopy = 'Copia';
rserrcouldnotopendir = 'Impossibile aprire la cartella <%s>';
rscreate = 'Crea';
@@ -70,8 +74,10 @@ rscollectionfontaliases = 'Font Aliases';
rserrreportfontfilemissing = 'Font file <%s.fnt> not found';
rsshortfri = 'Ven';
rslongfri = 'Venerdì';
+rscolorgreen = 'Green';
rsfilegroup = 'Gruppo';
rshelp = 'Aiuto';
+rshexadecimal = 'Hexadecimal';
rskeyhome = 'Home';
rsignore = 'Ignora';
rserrreportimagefilemissing = 'Image <%s> is missing';
@@ -117,8 +123,10 @@ rspassword = 'Password';
rspaste = 'Incolla';
rskeypgdn = 'PgDn';
rskeypgup = 'PgUp';
+rstabpredefined = 'Predefined';
rsreportpreview = 'Preview';
rscollectionrecentlyused = 'Usati Recentemente';
+rscolorred = 'Red';
rsreplace = 'Sostituisci';
rsretry = 'Riprova';
rskeyright = 'Right';
diff --git a/src/corelib/lang_pt.inc b/src/corelib/lang_pt.inc
index f9c4aa13..fb3dd92b 100644
--- a/src/corelib/lang_pt.inc
+++ b/src/corelib/lang_pt.inc
@@ -19,17 +19,21 @@ rsfileattributes = 'Atributos';
rsshortaug = 'Ago';
rslongaug = 'Agosto';
rskeybksp = 'BkSp';
+rscolorblue = 'Blue';
rsbold = 'Negrito';
rscancel = 'Cancelar';
rscannotcreatedir = 'Não foi possível criar diretório';
rschange = 'Editar';
rschangetitle = 'Mudar Título';
rscharactermap = 'Mapa de Caracteres';
+rscolorpickerhint = 'Click on Picker and maintain click => release to get the color';
rsclose = 'Fechar';
rscollection = 'Coleção';
+rstabsheetcolorwheel = 'Color Wheel';
rsconfigurebookmarks = 'Configure Bookmarks';
rsconfirm = 'Confirmar';
rsconfirmation = 'Confirmação';
+rscontinuous = 'Continuous';
rscopy = 'Copiar';
rserrcouldnotopendir = 'Não pode abrir o diretório <%s>';
rscreate = 'Criar';
@@ -70,8 +74,10 @@ rscollectionfontaliases = 'Font Aliases';
rserrreportfontfilemissing = 'Font file <%s.fnt> not found';
rsshortfri = 'Sex';
rslongfri = 'Sexta-feira';
+rscolorgreen = 'Green';
rsfilegroup = 'Grupo';
rshelp = 'Ajuda';
+rshexadecimal = 'Hexadecimal';
rskeyhome = 'Home';
rsignore = 'Ignorar';
rserrreportimagefilemissing = 'Image <%s> is missing';
@@ -117,8 +123,10 @@ rspassword = 'Senha';
rspaste = 'Colar';
rskeypgdn = 'PgDn';
rskeypgup = 'PgUp';
+rstabpredefined = 'Predefined';
rsreportpreview = 'Preview';
rscollectionrecentlyused = 'Recentemente Usado';
+rscolorred = 'Red';
rsreplace = 'Substituir';
rsretry = 'Retentar';
rskeyright = 'Right';
diff --git a/src/corelib/lang_ru.inc b/src/corelib/lang_ru.inc
index a6d8a46e..ce5b753e 100644
--- a/src/corelib/lang_ru.inc
+++ b/src/corelib/lang_ru.inc
@@ -7,7 +7,7 @@ rserrnotassigned = 'Значение <%s> не определено';
rsnewitemdetected = 'Обнаружен новый элемент';
rsabort = 'Прервать';
rsabout = 'Информация о %s';
-rsaddcurrentdirectory = 'Add current directory';
+rsaddcurrentdirectory = 'Добавить текущую директорию';
rsall = 'Все';
rsallfiles = 'Все файлы';
rscollectionallfonts = 'Все шрифты';
@@ -19,17 +19,21 @@ rsfileattributes = 'Атрибуты';
rsshortaug = 'Авг';
rslongaug = 'Август';
rskeybksp = 'BkSp';
+rscolorblue = 'Синий';
rsbold = 'Жирный';
rscancel = 'Отмена';
rscannotcreatedir = 'Невозможно создать директорию';
rschange = 'Изменить';
-rschangetitle = 'Change Title';
+rschangetitle = 'Изменить Заголовок';
rscharactermap = 'Character Map';
+rscolorpickerhint = 'Click on Picker and maintain click => release to get the color';
rsclose = 'Закрыть';
rscollection = 'Группа';
-rsconfigurebookmarks = 'Configure Bookmarks';
+rstabsheetcolorwheel = 'Color Wheel';
+rsconfigurebookmarks = 'Настроить Закладки';
rsconfirm = 'Подтвердить';
rsconfirmation = 'Подтверждение';
+rscontinuous = 'Continuous';
rscopy = 'Копировать';
rserrcouldnotopendir = 'Невозможно открыть директорию <%s>';
rscreate = 'Создать';
@@ -43,7 +47,7 @@ rslongdec = 'Декабрь';
rskeydel = 'Del';
rsdelete = 'Удалить';
rsdirectories = 'Директории';
-rsdirectory = 'Directory';
+rsdirectory = 'Директория';
rskeydown = 'Down';
rsdrive = 'Диск';
rsedit = 'Редактировать';
@@ -67,14 +71,16 @@ rsfiles = 'Файлы';
rsfind = 'Найти';
rscollectionfixedwidth = 'Моноширинные';
rscollectionfontaliases = 'Псевдонимы шрифтов';
-rserrreportfontfilemissing = 'Font file <%s.fnt> not found';
+rserrreportfontfilemissing = 'Файл шрифта <%s.fnt> не найден';
rsshortfri = 'Пт';
rslongfri = 'Пятница';
+rscolorgreen = 'Green';
rsfilegroup = 'Группа';
rshelp = 'Справка';
+rshexadecimal = 'Hexadecimal';
rskeyhome = 'Home';
rsignore = 'Пропустить';
-rserrreportimagefilemissing = 'Image <%s> is missing';
+rserrreportimagefilemissing = 'Изображение <%s> не найдено';
rsinformation = 'Информация';
rskeyins = 'Ins';
rsinsert = 'Вставка';
@@ -111,14 +117,16 @@ rslongoct = 'Октябрь';
rsopen = 'Открыть';
rsopenafile = 'Открыть файл';
rsfileowner = 'Владелец';
-rsfiletypepdf = 'PDF Documents';
+rsfiletypepdf = 'PDF Документы';
rsreportpage = 'Page';
rspassword = 'Пароль';
rspaste = 'Вставить';
rskeypgdn = 'PgDn';
rskeypgup = 'PgUp';
+rstabpredefined = 'Predefined';
rsreportpreview = 'Preview';
rscollectionrecentlyused = 'Ранее использованные';
+rscolorred = 'Red';
rsreplace = 'Заменить';
rsretry = 'Повторить';
rskeyright = 'Right';
@@ -145,7 +153,7 @@ rsshortsun = 'Вс';
rslongsun = 'Воскресенье';
rskeytab = 'Tab';
rstexttoinsert = 'Text to Insert';
-rserrreportnopagestoprint = 'There are no pages to print';
+rserrreportnopagestoprint = 'Нет страниц для печати';
rsshortthu = 'Чт';
rslongthu = 'Четверг';
rstoday = 'Сегодня';
diff --git a/src/corelib/render/software/Agg2D.pas b/src/corelib/render/software/Agg2D.pas
index 08801228..7cf9cb48 100644
--- a/src/corelib/render/software/Agg2D.pas
+++ b/src/corelib/render/software/Agg2D.pas
@@ -644,7 +644,7 @@ type
function BitmapAlphaTransparency(bitmap : TfpgImage; alpha : byte ) : boolean;
function fpgColor2AggColor(c: TfpgColor): TAggColor;
-
+
IMPLEMENTATION
@@ -1136,7 +1136,7 @@ begin
stride );
{ OK }
- result:=true;
+ result:=true;
end;
@@ -2652,6 +2652,10 @@ procedure TAgg2D.Font(
italic : boolean = false;
cache : TAggFontCacheType = AGG_VectorFontCache;
angle : double = 0.0 );
+{$IFDEF AGG2D_USE_WINFONTS}
+var
+ b : int;
+{$ENDIF}
begin
m_textAngle :=angle;
m_fontHeight :=height;
@@ -3555,7 +3559,7 @@ procedure TAgg2D.DoSetFontRes(fntres: TfpgFontResourceBase);
{$IFDEF WINDOWS}
begin
{$IFDEF AGG2D_USE_FREETYPE }
- Font('c:\WINNT\Fonts\arial.ttf', 10);
+ Font(GetWindowsFontDir + 'arial.ttf', 10);
{$ENDIF }
{$IFDEF AGG2D_USE_WINFONTS}
Font('Arial', 13);
@@ -3835,4 +3839,4 @@ end;
end.
-
+
diff --git a/src/corelib/render/software/agg-demos/extrafpc.cfg b/src/corelib/render/software/agg-demos/extrafpc.cfg
new file mode 100644
index 00000000..94482a02
--- /dev/null
+++ b/src/corelib/render/software/agg-demos/extrafpc.cfg
@@ -0,0 +1,21 @@
+-FUunits
+-Fu../
+-Fu../ctrl/
+#IFDEF UNIX
+ -Fu../platform/linux/
+#ENDIF
+#IFDEF WINDOWS
+ -Fu../platform/win/
+ -WG
+#ENDIF
+#IFDEF Carbon
+ -Fu../platform/mac/
+#ENDIF
+-Fu../svg/
+-Fu../util/
+-Fi../
+-Xs
+-XX
+-CX
+-Mdelphi
+
diff --git a/src/corelib/render/software/agg_2D.pas b/src/corelib/render/software/agg_2D.pas
index 45d88e44..0fcbc3d9 100644
--- a/src/corelib/render/software/agg_2D.pas
+++ b/src/corelib/render/software/agg_2D.pas
@@ -414,9 +414,9 @@ type
opt : ViewportOption = XMidYMid );
// Basic Shapes
- procedure line (x1 ,y1 ,x2 ,y2 : double );
+ procedure line (const x1 ,y1 ,x2 ,y2 : double; AFixAlignment: boolean = false );
procedure triangle (x1 ,y1 ,x2 ,y2 ,x3 ,y3 : double );
- procedure rectangle(x1 ,y1 ,x2 ,y2 : double );
+ procedure rectangle(const x1 ,y1 ,x2 ,y2 : double; AFixAlignment: boolean = false);
procedure roundedRect(x1 ,y1 ,x2 ,y2 ,r : double ); overload;
procedure roundedRect(x1 ,y1 ,x2 ,y2 ,rx ,ry : double ); overload;
@@ -443,7 +443,7 @@ type
fileName : char_ptr; height : double;
bold : boolean = false;
italic : boolean = false;
- ch : FontCacheType = RasterFontCache;
+ ch : FontCacheType = VectorFontCache;
angle : double = 0.0 );
function fontHeight : double;
@@ -1876,13 +1876,25 @@ begin
end;
{ LINE }
-procedure Agg2D.line(x1 ,y1 ,x2 ,y2 : double );
+procedure Agg2D.line(const x1, y1, x2, y2: double; AFixAlignment: boolean = false);
+var
+ lx1, ly1, lx2, ly2: double;
begin
m_path.remove_all;
- addLine (x1 ,y1 ,x2 ,y2 );
- drawPath(StrokeOnly );
+ lx1 := x1;
+ ly1 := y1;
+ lx2 := x2;
+ ly2 := y2;
+ if AFixAlignment then
+ begin
+ AlignPoint(@lx1, @ly1);
+ AlignPoint(@lx2, @ly2);
+ end;
+
+ addLine(lx1, ly1, lx2, ly2);
+ drawPath(StrokeOnly);
end;
{ TRIANGLE }
@@ -1899,13 +1911,27 @@ begin
end;
{ RECTANGLE }
-procedure Agg2D.rectangle(x1 ,y1 ,x2 ,y2 : double );
+procedure Agg2D.rectangle(const x1 ,y1 ,x2 ,y2 : double; AFixAlignment: boolean);
+var
+ lx1, ly1, lx2, ly2: double;
begin
m_path.remove_all;
- m_path.move_to(x1 ,y1 );
- m_path.line_to(x2 ,y1 );
- m_path.line_to(x2 ,y2 );
- m_path.line_to(x1 ,y2 );
+
+ lx1 := x1;
+ ly1 := y1;
+ lx2 := x2;
+ ly2 := y2;
+
+ if AFixAlignment then
+ begin
+ AlignPoint(@lx1, @ly1);
+ AlignPoint(@lx2, @ly2);
+ end;
+
+ m_path.move_to(lx1 ,ly1 );
+ m_path.line_to(lx2 ,ly1 );
+ m_path.line_to(lx2 ,ly2 );
+ m_path.line_to(lx1 ,ly2 );
m_path.close_polygon;
drawPath(FillAndStroke );
@@ -2102,7 +2128,7 @@ procedure Agg2D.font(
fileName : char_ptr; height : double;
bold : boolean = false;
italic : boolean = false;
- ch : FontCacheType = RasterFontCache;
+ ch : FontCacheType = VectorFontCache;
angle : double = 0.0 );
var
b : int;
@@ -2121,10 +2147,11 @@ begin
m_fontEngine.hinting_(m_textHints );
if ch = VectorFontCache then
- m_fontEngine.height_(height )
+ {$NOTE We need to fix this. Translating from font pt to pixels is inaccurate. This is just a temp fix for now. }
+ m_fontEngine.height_(height * 1.3333 ) // 9pt = ~12px so that is a ratio of 1.3333
else
m_fontEngine.height_(worldToScreen(height ) );
-{$ENDIF }
+{$ENDIF}
{$IFDEF AGG2D_USE_WINFONTS}
m_fontEngine.hinting_(m_textHints );
@@ -2167,7 +2194,9 @@ end;
procedure Agg2D.textHints(hints : boolean );
begin
m_textHints:=hints;
-
+ {$IFNDEF AGG2D_NO_FONT}
+ m_fontEngine.hinting_(m_textHints );
+ {$ENDIF}
end;
{ TEXTWIDTH }
@@ -2350,6 +2379,7 @@ end;
procedure Agg2D.resetPath;
begin
m_path.remove_all;
+ m_path.move_to(0 ,0 );
end;
diff --git a/src/corelib/render/software/agg_blur.pas b/src/corelib/render/software/agg_blur.pas
index 5ddda2bc..78e6df72 100644
--- a/src/corelib/render/software/agg_blur.pas
+++ b/src/corelib/render/software/agg_blur.pas
@@ -25,7 +25,7 @@
// http://incubator.quasimondo.com/processing/fast_blur_deluxe.php
// (search phrase "Stackblur: Fast But Goodlooking").
// The major improvement is that there's no more division table
-// that was very expensive to create for large blur radii. Insted,
+// that was very expensive to create for large blur radii. Instead,
// for 8-bit per channel and radius not exceeding 254 the division is
// replaced by multiplication and shift.
//
diff --git a/src/corelib/render/software/agg_platform_gdi.inc b/src/corelib/render/software/agg_platform_gdi.inc
index 88d3b586..c61d068f 100644
--- a/src/corelib/render/software/agg_platform_gdi.inc
+++ b/src/corelib/render/software/agg_platform_gdi.inc
@@ -21,6 +21,19 @@ type
// to get access to protected methods (seeing that FPC doesn't support Friend-classes)
TImageHack = class(TfpgImage);
+function GetWindowsFontDir: string;
+var
+ lWinFontPath: array[0..MAX_PATH] of WideChar;
+ lPasWinFontPath: string;
+ i: Integer;
+begin
+ // Find for example C:\Windows\Fonts or C:\WINNT\Fonts
+ Windows.GetWindowsDirectoryW(@lWinFontPath[0], MAX_PATH);
+ lPasWinFontPath := lWinFontPath;
+ lPasWinFontPath := IncludeTrailingPathDelimiter(lPasWinFontPath) + 'Fonts' + PathDelim;
+ Result := lPasWinFontPath;
+end;
+
procedure TAgg2D.DoPutBufferToScreen(x, y, w, h: TfpgCoord);
var
srcdc: HDC;
diff --git a/src/corelib/stdimages.inc b/src/corelib/stdimages.inc
index 36255154..510a1ce6 100644
--- a/src/corelib/stdimages.inc
+++ b/src/corelib/stdimages.inc
@@ -3222,4 +3222,26 @@ Const
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0,255, 0,255,255, 0,255,255, 0,255);
+const
+ stdimg_colpicker: array[0..333] of byte = (
+ 66, 77, 78, 1, 0, 0, 0, 0, 0, 0,118, 0, 0, 0, 40, 0, 0,
+ 0, 18, 0, 0, 0, 18, 0, 0, 0, 1, 0, 4, 0, 0, 0, 0, 0,
+ 216, 0, 0, 0, 19, 11, 0, 0, 19, 11, 0, 0, 16, 0, 0, 0, 16,
+ 0, 0, 0, 0, 0, 0, 0,132,132, 0, 0,255,255, 0, 0, 0, 0,
+ 132, 0,132,132,132, 0,206,214,214, 0, 0, 0,255, 0,255,255,255,
+ 0,255,255,255, 0,255,255,255, 0,255,255,255, 0,255,255,255, 0,
+ 255,255,255, 0,255,255,255, 0,255,255,255, 0,255,255,255, 0, 85,
+ 85, 85, 85, 85, 85, 85, 85, 85, 0, 0, 0, 85, 34, 34, 37, 85, 85,
+ 85, 85, 85, 0, 0, 0, 82, 34, 34, 34, 37, 85, 85, 85, 85, 0, 0,
+ 0, 85, 80, 5, 85, 85, 85, 85, 85, 85, 0, 0, 0, 85, 80, 32, 5,
+ 85, 85, 85, 85, 85, 0, 0, 0, 85, 85, 1, 64, 85, 85, 85, 85, 85,
+ 0, 0, 0, 85, 85, 2, 20, 5, 85, 85, 85, 85, 0, 0, 0, 85, 85,
+ 80, 33, 64, 85, 85, 85, 85, 0, 0, 0, 85, 85, 85, 5,116, 5, 85,
+ 85, 85, 0, 0, 0, 85, 85, 85, 80, 87, 64, 85, 85, 85, 0, 0, 0,
+ 85, 85, 85, 85, 5,116, 3, 85, 85, 0, 0, 0, 85, 85, 85, 85, 80,
+ 83, 48, 69, 85, 0, 0, 0, 85, 85, 85, 85, 85, 54, 3, 52, 85, 0,
+ 0, 0, 85, 85, 85, 85, 85, 99, 99, 51, 69, 0, 0, 0, 85, 85, 85,
+ 85, 85, 85, 54, 99, 53, 0, 0, 0, 85, 85, 85, 85, 85, 85, 55, 99,
+ 53, 0, 0, 0, 85, 85, 85, 85, 85, 85, 83, 51, 69, 0, 0, 0, 85,
+ 85, 85, 85, 85, 85, 85, 85, 85, 0, 0, 0);
diff --git a/src/corelib/x11/fpg_x11.pas b/src/corelib/x11/fpg_x11.pas
index bcd2918d..f614bda1 100644
--- a/src/corelib/x11/fpg_x11.pas
+++ b/src/corelib/x11/fpg_x11.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,
@@ -222,6 +222,7 @@ type
TfpgX11Window = class(TfpgWindowBase)
private
QueueEnabledDrops: boolean;
+ procedure ApplyFormIcon;
protected
FWinFlags: TXWindowStateFlags;
FWinHandle: TfpgWinHandle;
@@ -315,6 +316,7 @@ type
xia_wm_protocols: TAtom;
xia_wm_delete_window: TAtom;
xia_wm_state: TAtom;
+ xia_net_wm_icon: TAtom;
xia_targets: TAtom;
xia_save_targets: TAtom;
netlayer: TNETWindowLayer;
@@ -331,6 +333,7 @@ type
procedure DoFlush;
function GetScreenWidth: TfpgCoord; override;
function GetScreenHeight: TfpgCoord; override;
+ function GetScreenPixelColor(APos: TPoint): TfpgColor; override;
function Screen_dpi_x: integer; override;
function Screen_dpi_y: integer; override;
function Screen_dpi: integer; override;
@@ -1067,19 +1070,19 @@ begin
{$IFDEF DNDDEBUG}
writeln(Format(' ver(%d) check-XdndTypeList(%s) data=%xh,%d,%d,%d,%d',
[ FDNDVersion,
- BoolToStr(fpgIsBitSet(ev.xclient.data.l[1], 0), True),
+ BoolToStr(fpgGetBit(ev.xclient.data.l[1], 0), True),
ev.xclient.data.l[0],
ev.xclient.data.l[1],
ev.xclient.data.l[2],
ev.xclient.data.l[3],
ev.xclient.data.l[4] ]));
writeln(Format(' * We will be using XDND v%d protocol *', [FDNDVersion]));
- if fpgIsBitSet(ev.xclient.data.l[1], 0) then
+ if fpgGetBit(ev.xclient.data.l[1], 0) then
writeln(' ** We need to fetch XdndTypeList (>3 types)');
{$ENDIF}
// read typelist
- if fpgIsBitSet(ev.xclient.data.l[1], 0) then
+ if fpgGetBit(ev.xclient.data.l[1], 0) then
begin
// now fetch the data
XGetWindowProperty(Display, FSrcWinHandle,
@@ -1482,6 +1485,7 @@ begin
xia_wm_protocols := XInternAtom(FDisplay, 'WM_PROTOCOLS', TBool(False));
xia_wm_delete_window := XInternAtom(FDisplay, 'WM_DELETE_WINDOW', TBool(False));
xia_wm_state := XInternAtom(FDisplay, 'WM_STATE', TBool(False));
+ xia_net_wm_icon := XInternAtom(FDisplay, '_NET_WM_ICON', TBool(False));
{ initializa the XDND atoms }
FDNDTypeList := TObjectList.Create;
@@ -1684,7 +1688,7 @@ begin
OnIdle(self);
fpFD_ZERO(rfds);
fpFD_SET(xfd, rfds);
- r := fpSelect(xfd + 1, @rfds, nil, nil, {atimeoutms} 50);
+ r := fpSelect(xfd + 1, @rfds, nil, nil, Min(atimeoutms, 50));
if r <> 0 then // We got a X event or the timeout happened
XNextEvent(display, @ev)
else
@@ -2239,6 +2243,28 @@ begin
Result := wa.Height;
end;
+function TfpgX11Application.GetScreenPixelColor(APos: TPoint): TfpgColor;
+var
+ Image: PXImage;
+ Pixel: Cardinal;
+ x_Color: TXColor;
+begin
+ Result := 0;
+ Image := XGetImage(Display, FRootWindow, APos.X, APos.Y, 1, 1, $FFFFFFFF, ZPixmap);
+ if Image = nil then
+ raise Exception.Create('fpGFX/X11: Invalid XImage');
+ try
+ Pixel := XGetPixel(Image, 0, 0);
+ x_Color.pixel := Pixel;
+ XQueryColor(Display, DefaultColorMap, @x_Color);
+ Result := TfpgColor(((x_Color.red and $00FF) shl 16) or
+ ((x_Color.green and $00FF) shl 8) or
+ (x_Color.blue and $00FF));
+ finally
+ XDestroyImage(Image);
+ end;
+end;
+
function TfpgX11Application.Screen_dpi_x: integer;
var
mm: integer;
@@ -2277,6 +2303,45 @@ end;
{ TfpgX11Window }
+procedure TfpgX11Window.ApplyFormIcon;
+var
+ ico: TfpgImage;
+ ar1: array of longword; // 32 bit CPU's
+ ar2: array of qword; // 64 bit CPU's
+ ps: pbyte;
+ pd: ^TRGBTriple;
+ i: integer;
+ iconName: string;
+begin
+ if self is TfpgForm then
+ iconName := TfpgForm(self).IconName;
+ if iconName = '' then
+ Exit;
+ ico := fpgImages.GetImage(iconName);
+ if Assigned(ico) then
+ begin
+ SetLength(ar1, 2 + (ico.Width * ico.Height));
+ ar1[0] := ico.Width;
+ ar1[1] := ico.Height;
+ pd := @ar1[2];
+ ps := ico.ImageData;
+ move(ps^,pd^, ico.ImageDataSize);
+ end
+ else
+ exit; // we don't have a icon to set
+
+ {$ifdef cpu64}
+ setlength(ar2,length(ar1));
+ for i := low(ar2) to high(ar2) do
+ ar2[i] := ar1[i]; // copy array data over
+ XChangeProperty(xapplication.display, FWinHandle, xapplication.xia_net_wm_icon,
+ XA_CARDINAL, 32, PropModeReplace, @ar2[0], Length(ar2));
+ {$else}
+ XChangeProperty(xapplication.display, FWinHandle, xapplication.xia_net_wm_icon,
+ XA_CARDINAL, 32, PropModeReplace, @ar1[0], Length(ar1));
+ {$endif}
+end;
+
procedure TfpgX11Window.DoAllocateWindowHandle(AParent: TfpgWindowBase);
var
pwh: TfpgWinHandle;
@@ -2289,11 +2354,13 @@ var
WMHints: PXWMHints;
prop: TAtom;
mwmhints: TMWMHints;
+ IsToplevel: Boolean;
begin
if HandleIsValid then
Exit; //==>
- if AParent <> nil then
+ IsToplevel := (AParent = nil) or (FWindowType in [wtModalForm, wtPopup]);
+ if not IsToplevel then
pwh := TfpgX11Window(AParent).WinHandle
else
pwh := xapplication.RootWindow;
@@ -2332,16 +2399,16 @@ begin
FWinHandle := wh;
FBackupWinHandle := wh;
- if AParent = nil then // is a toplevel window
+ if IsToplevel then // is a toplevel window
begin
{ setup a window icon }
- IconPixMap := XCreateBitmapFromData(fpgApplication.Display, FWinHandle,
+
+ IconPixMap := XCreateBitmapFromData(xapplication.display, FWinHandle,
@IconBitmapBits, IconBitmapWidth, IconBitmapHeight);
WMHints := XAllocWMHints;
WMHints^.icon_pixmap := IconPixmap;
WMHints^.flags := IconPixmapHint;
-
{ setup window grouping posibilities }
if (not (waX11SkipWMHints in FWindowAttributes)) and (FWindowType = wtWindow) then
begin
@@ -2349,8 +2416,7 @@ begin
WMHints^.window_group := xapplication.FLeaderWindow;
end;
-
- XSetWMProperties(fpgApplication.Display, FWinHandle, nil, nil, nil, 0, nil, WMHints, nil);
+ XSetWMProperties(xapplication.display, FWinHandle, nil, nil, nil, 0, nil, WMHints, nil);
if (not (waX11SkipWMHints in FWindowAttributes)) and (FWindowType = wtWindow) then
begin
@@ -2371,6 +2437,9 @@ begin
begin
DoDNDEnabled(True);
end;
+
+ if xapplication.xia_net_wm_icon <> 0 then
+ ApplyFormIcon;
end;
FillChar(hints, sizeof(hints), 0);
@@ -2426,11 +2495,13 @@ begin
// for modal windows, this is necessary
if FWindowType = wtModalForm then
begin
- if Parent = nil then
+ if IsToplevel then
begin
lmwh := 0;
if fpgApplication.PrevModalForm <> nil then
lmwh := TfpgX11Window(fpgApplication.PrevModalForm).WinHandle
+ {else if AParent <> nil then
+ lmwh := TfpgX11Window(AParent).WinHandle}
{ 2011-03-24: Graeme Geldenhuys
I commented code this code because it caused more problems that it solved
when multiple modal dialogs or prompts are shown in succession.
diff --git a/src/corelib/x11/fpgui_toolkit.lpk b/src/corelib/x11/fpgui_toolkit.lpk
index ec8c841f..f53dd62e 100644
--- a/src/corelib/x11/fpgui_toolkit.lpk
+++ b/src/corelib/x11/fpgui_toolkit.lpk
@@ -28,8 +28,8 @@
</CompilerOptions>
<Description Value="fpGUI Toolkit"/>
<License Value="LGPL 2 with static linking exception."/>
- <Version Major="1" Minor="2"/>
- <Files Count="107">
+ <Version Major="1" Minor="4"/>
+ <Files Count="110">
<Item1>
<Filename Value="../stdimages.inc"/>
<Type Value="Include"/>
@@ -458,6 +458,18 @@
<Filename Value="../../gui/inputintegerdialog.inc"/>
<Type Value="Include"/>
</Item107>
+ <Item108>
+ <Filename Value="../../gui/fpg_toggle.pas"/>
+ <UnitName Value="fpg_toggle"/>
+ </Item108>
+ <Item109>
+ <Filename Value="../../gui/fpg_stringgridbuilder.pas"/>
+ <UnitName Value="fpg_StringGridBuilder"/>
+ </Item109>
+ <Item110>
+ <Filename Value="../fpg_csvparser.pas"/>
+ <UnitName Value="fpg_CSVParser"/>
+ </Item110>
</Files>
<LazDoc Paths="../../../docs/xml/corelib;../../../docs/xml/corelib/x11;../../../docs/xml/corelib/gdi;../../../docs/xml/gui"/>
<RequiredPkgs Count="1">
diff --git a/src/corelib/x11/fpgui_toolkit.pas b/src/corelib/x11/fpgui_toolkit.pas
index 86e456f4..be9f3b5a 100644
--- a/src/corelib/x11/fpgui_toolkit.pas
+++ b/src/corelib/x11/fpgui_toolkit.pas
@@ -22,8 +22,9 @@ uses
fpg_stylemanager, fpg_style_win2k, fpg_style_motif, fpg_style_clearlooks,
fpg_style_bluecurve, fpg_style_bitmap, fpg_readonly, fpg_imgfmt_png,
U_Command, U_Pdf, U_Report, U_ReportImages, U_Visu, fpg_trayicon, Agg2D,
- fpg_dbugintf, fpg_dbugmsg, fpg_fontcache, fpg_style_carbon,
- fpg_style_plastic, fpg_style_win8, fpg_scrollframe;
+ fpg_dbugintf, fpg_dbugmsg, fpg_fontcache, fpg_style_carbon,
+ fpg_style_plastic, fpg_style_win8, fpg_scrollframe, fpg_toggle,
+ fpg_StringGridBuilder, fpg_CSVParser;
implementation
diff --git a/src/extrafpc.cfg b/src/extrafpc.cfg
index d1600da1..c645739c 100644
--- a/src/extrafpc.cfg
+++ b/src/extrafpc.cfg
@@ -34,7 +34,6 @@
# For a debug version compile with debuginfo and all codegeneration checks on
#IFDEF DEBUG
-g
- -Crtoi
-B
#WRITE Compiling Debug Version
#ENDIF
@@ -91,13 +90,13 @@
# Unit output path
-FU../lib/$fpctarget/
-# Generate debugging information for GDI (slows down the compiling process)
+# Generate debugging information (slows down the compiling process)
# Enable debug info and use the line info unit by default
-#-gl
+-gl
# Always strip debuginfo from the executable
--Xs
+#-Xs
# Write always a nice FPC logo ;)
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 2c74a9ee..0524adac 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;
@@ -636,7 +712,7 @@ var
UpdateWindowPosition;
end;
end;
-
+
procedure getVisWidth;
begin
if showV then
@@ -659,6 +735,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
@@ -680,7 +772,7 @@ begin
showH := False;
getVisWidth;
getVisLines;
-
+
// determine whether to show scrollbars for different configurations
case FScrollBarStyle of
ssHorizontal:
@@ -724,6 +816,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
@@ -771,16 +882,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;
@@ -989,7 +1099,7 @@ begin
Canvas.SetClipRect(clipr);
Canvas.SetColor(FBackgroundColor);
-
+
// clearing after the last column
if r.Left <= clipr.Right then
begin
@@ -1140,7 +1250,7 @@ begin
end;
consumed := True;
end;
-
+
keyHome:
begin
if FRowSelect then
@@ -1166,7 +1276,7 @@ begin
end;
consumed := True;
end;
-
+
keyEnd:
begin
if FRowSelect then
@@ -1192,7 +1302,7 @@ begin
consumed := True;
end;
end; { case }
-
+
if consumed then
CheckFocusChange;
@@ -1273,7 +1383,7 @@ var
borders: TRect;
begin
inherited HandleMouseMove(x, y, btnstate, shiftstate);
-
+
if (ColumnCount = 0) or (RowCount = 0) then
Exit; //==>
@@ -1456,7 +1566,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
@@ -1500,6 +1610,7 @@ procedure TfpgBaseGrid.FollowFocus;
var
n: Integer;
w: TfpgCoord;
+ lmin, lmax: TfpgCoord;
begin
if (RowCount > 0) and (FFocusRow < 0) then
FFocusRow := 0;
@@ -1542,6 +1653,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;
@@ -1579,7 +1703,7 @@ begin
FFont := fpgGetFont('#Grid');
FHeaderFont := fpgGetFont('#GridHeader');
-
+
FTemp := 50; // Just to prove that ColumnWidth does adjust.
FDefaultColWidth := 64;
FDefaultRowHeight := FFont.Height + 2;
@@ -1590,7 +1714,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 1085c9b9..d428ad55 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 8d957b17..d9839612 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 9cba4577..a8bd30ed 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 3ecb43f0..7ec6163c 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 15d34b90..f1966759 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;
@@ -1099,7 +1096,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
@@ -1181,7 +1178,7 @@ begin
if mi.Separator then
Result := 5
else
- Result := FMenuFont.Height + 2;
+ Result := fpgStyle.MenuFont.Height + 2;
end;
function TfpgPopupMenu.MenuFocused: boolean;
@@ -1262,14 +1259,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;
@@ -1341,16 +1338,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 3256b6a1..69a85097 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 be5dea76..414c89a2 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;
@@ -515,7 +514,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;
@@ -523,7 +522,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);
@@ -560,14 +559,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);
@@ -940,7 +939,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;
@@ -984,7 +983,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);
@@ -1215,7 +1214,6 @@ end;
constructor TfpgPageControl.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
- FFont := fpgStyle.DefaultFont;
FPages := TList.Create;
Width := 150;
Height := 100;
@@ -1283,10 +1281,7 @@ var
begin
Result := nil;
h := TfpgTabSheet(FPages.First);
-
lp := FMargin;
- if MaxButtonWidthSum > (Width-(FMargin*2)) then
- h := FFirstTabButton;
case TabPosition of
tpTop:
@@ -1316,6 +1311,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
@@ -1338,11 +1335,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 33819462..857fb0a2 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]);
diff --git a/src/reportengine/u_command.pas b/src/reportengine/u_command.pas
index 8ef6e406..c6746d0d 100644
--- a/src/reportengine/u_command.pas
+++ b/src/reportengine/u_command.pas
@@ -16,7 +16,7 @@
the objects in memory to produce either the preview or pdf files.
The PDF Reporting Engine was originally written by
- Jean-Marc Levecque <jean-marc.levecque@jmlesite.fr>
+ Jean-Marc Levecque <jmarc.levecque@jmlesite.web4me.fr>
}
unit U_Command;
diff --git a/src/reportengine/u_pdf.pas b/src/reportengine/u_pdf.pas
index 9f31bada..f6222cf2 100644
--- a/src/reportengine/u_pdf.pas
+++ b/src/reportengine/u_pdf.pas
@@ -16,7 +16,7 @@
produces the PDF file.
The PDF Reporting Engine was originally written by
- Jean-Marc Levecque <jean-marc.levecque@jmlesite.fr>
+ Jean-Marc Levecque <jmarc.levecque@jmlesite.web4me.fr>
}
unit U_Pdf;
diff --git a/src/reportengine/u_report.pas b/src/reportengine/u_report.pas
index 6fd2ac0b..0a6a8a3e 100644
--- a/src/reportengine/u_report.pas
+++ b/src/reportengine/u_report.pas
@@ -16,7 +16,7 @@
the user program.
The PDF Reporting Engine was originally written by
- Jean-Marc Levecque <jean-marc.levecque@jmlesite.fr>
+ Jean-Marc Levecque <jmarc.levecque@jmlesite.web4me.fr>
}
unit U_Report;
@@ -353,7 +353,7 @@ type
property NumPage: integer read FNmPage write FNmPage;
property NumPageSection: integer read FNmPageSect write FNmPageSect;
property PaperHeight: integer read GetPaperHeight;
- property PagerWidth: integer read GetPaperWidth;
+ property PaperWidth: integer read GetPaperWidth;
property DefaultFile: string read FDefaultFile write FDefaultFile;
property CurrentColor: integer read FCurrentColor write FCurrentColor;
property SectionTitle: string read GetSectionTitle write SetSectionTitle;