diff options
Diffstat (limited to 'src')
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; |