diff options
Diffstat (limited to 'src/corelib')
27 files changed, 861 insertions, 172 deletions
diff --git a/src/corelib/fpg_base.pas b/src/corelib/fpg_base.pas index 96332d5d..c110f3b0 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; @@ -2518,6 +2500,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 229294d2..b77b9ce9 100644 --- a/src/corelib/render/software/Agg2D.pas +++ b/src/corelib/render/software/Agg2D.pas @@ -2653,9 +2653,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; @@ -3559,7 +3560,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); 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 569772ae..ff6e7272 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; @@ -1068,19 +1071,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, @@ -1483,6 +1486,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; @@ -1685,7 +1689,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 @@ -2240,6 +2244,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; @@ -2278,6 +2304,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; @@ -2290,11 +2355,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; @@ -2333,16 +2400,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 @@ -2350,8 +2417,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 @@ -2372,6 +2438,9 @@ begin begin DoDNDEnabled(True); end; + + if xapplication.xia_net_wm_icon <> 0 then + ApplyFormIcon; end; FillChar(hints, sizeof(hints), 0); @@ -2427,11 +2496,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 |