diff options
Diffstat (limited to 'src')
95 files changed, 5522 insertions, 1718 deletions
diff --git a/src/VERSION_FILE.inc b/src/VERSION_FILE.inc new file mode 100644 index 00000000..14e23a39 --- /dev/null +++ b/src/VERSION_FILE.inc @@ -0,0 +1 @@ +FPGUI_VERSION = '0.7'; diff --git a/src/build_204.sh b/src/build_204.sh deleted file mode 100755 index d1b96860..00000000 --- a/src/build_204.sh +++ /dev/null @@ -1,2 +0,0 @@ -fpc @extrafpc.cfg corelib/x11/fpgui_toolkit.pas -OG -O2 -dX11 - diff --git a/src/buildcrosslinux32.sh b/src/buildcrosslinux32.sh new file mode 100755 index 00000000..1c900532 --- /dev/null +++ b/src/buildcrosslinux32.sh @@ -0,0 +1,51 @@ +#!/bin/bash +########################################################################### +# NOTE: +# Cross compiling is from Linux 64-bit to Linux 32-bit only. +# +# This is really only for my testing purposes so I can quickly test +# other platforms and targets +# +########################################################################### + +CROSSFPC=/opt/fpc_2.4.1/i386-linux/bin/fpc + +#fpctarget=`$CROSSFPC -iTP`-`fpc -iTO` +#echo $fpctarget + +#libpath='../lib/'$fpctarget +unitpath='../lib/i386-linux' +# Must we create the output directory? +if [ ! -d $unitpath ]; then + echo 'creating directory: '$unitpath + mkdir $unitpath + echo ' ' +fi +# compile fpGUI Toolkit itself +echo 'compiling fpGUI Toolkit library' +$CROSSFPC -Tlinux -Pi386 -dRELEASE -dX11 @extrafpc.cfg corelib/x11/fpgui_toolkit.pas +echo ' ' + +unitpath='../docview/src/units/i386-linux' +# Must we create the output directory for DocView? +if [ ! -d $unitpath ]; then + echo 'creating directory: '$unitpath + mkdir $unitpath + echo ' ' +fi +# compile the DocView (documentation viewer) application +echo 'compiling DocView' +$CROSSFPC -Tlinux -Pi386 -dRELEASE -dX11 @extrafpc.cfg -Fu../docview/components/richtext/ -FE$unitpath ../docview/src/docview.lpr +echo ' ' + +unitpath='../uidesigner/units/i386-linux' +# Must we create the output directory for DocView? +if [ ! -d $unitpath ]; then + echo 'creating directory: '$unitpath + mkdir $unitpath + echo ' ' +fi +# compile the UI Designer (visual form designer) application +echo 'compiling UIDesigner' +$CROSSFPC -Tlinux -Pi386 -dRELEASE -dX11 @extrafpc.cfg -FE$unitpath ../uidesigner/uidesigner.lpr +echo ' ' diff --git a/src/buildcrosswin32.sh b/src/buildcrosswin32.sh new file mode 100755 index 00000000..82189dfe --- /dev/null +++ b/src/buildcrosswin32.sh @@ -0,0 +1,20 @@ +#!/bin/bash + +# NOTE: Cross compiling is from Linux to Windows 32-bit only + +CROSSFPC=/opt/fpc_2.3.1/i386-win32/lib/fpc/2.3.1/ppcross386 + +#fpctarget=`$CROSSFPC -iTP`-`fpc -iTO` +#echo $fpctarget + +#libpath='../lib/'$fpctarget +libpath='../lib/i386-win32' + +# Must we create the output directory? +if [ ! -d $libpath ]; then + echo 'creating directory: '$libpath + mkdir $libpath + echo ' ' +fi + +$CROSSFPC -Twin32 dRELEASE -dGDI @extrafpc.cfg corelib/gdi/fpgui_toolkit.pas diff --git a/src/corelib/fpg_base.pas b/src/corelib/fpg_base.pas index 020f9943..199004ba 100644 --- a/src/corelib/fpg_base.pas +++ b/src/corelib/fpg_base.pas @@ -1,7 +1,7 @@ { - fpGUI - Free Pascal GUI Library + fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2009 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -32,7 +32,6 @@ type TfpgColor = type longword; // Always in RRGGBB (Alpha, Red, Green, Blue) format!! TfpgString = type string; TfpgChar = type string[4]; - TfpgModalResult = Low(integer)..High(integer); PPoint = ^TPoint; @@ -41,6 +40,14 @@ type Green: word; Blue: word; Alpha: word; + end deprecated; + + // Same declaration as in FPImage unit, but we don't use FPImage yet, so declare it here + TFPColor = record + Red: word; + Green: word; + Blue: word; + Alpha: word; end; TWindowType = (wtChild, wtWindow, wtModalForm, wtPopup); @@ -59,6 +66,10 @@ type TClipboardKeyType = (ckNone, ckCopy, ckPaste, ckCut); + // If you have to convert this to an Integer, mrNone = 0 etc. + TfpgModalResult = (mrNone, mrOK, mrCancel, mrYes, mrNo, mrAbort, mrRetry, + mrIgnore, mrAll, mrNoToAll, mrYesToAll); + const MOUSE_LEFT = 1; MOUSE_RIGHT = 3; @@ -83,25 +94,13 @@ const FPGM_MOVE = 16; FPGM_POPUPCLOSE = 17; FPGM_HINTTIMER = 18; + FPGM_FREEME = 19; FPGM_USER = 50000; - FPGM_KILLME = High(Integer); + FPGM_KILLME = MaxInt; // The special keys, based on the well-known keyboard scan codes {$I keys.inc} - { TfpgModalResult values } - mrNone = 0; - mrOk = mrNone + 1; - mrCancel = mrOk + 1; - mrYes = mrCancel + 1; - mrNo = mrYes + 1; - mrAbort = mrNo + 1; - mrRetry = mrAbort + 1; - mrIgnore = mrRetry + 1; - mrAll = mrIgnore + 1; - mrNoToAll = mrAll + 1; - mrYesToAll = mrNoToAll + 1; - { Default fpGUI help viewer } FPG_HELPVIEWER = 'docview'; @@ -190,17 +189,19 @@ type FImageDataSize: integer; FMaskData: pointer; FMaskDataSize: integer; + FMaskPoint: TPoint; procedure DoFreeImage; virtual; abstract; procedure DoInitImage(acolordepth, awidth, aheight: integer; aimgdata: Pointer); virtual; abstract; procedure DoInitImageMask(awidth, aheight: integer; aimgdata: Pointer); virtual; abstract; public constructor Create; destructor Destroy; override; - procedure Invert; + procedure Invert(IncludeMask: Boolean = False); procedure FreeImage; procedure AllocateImage(acolordepth, awidth, aheight: integer); procedure AllocateMask; procedure CreateMaskFromSample(x, y: TfpgCoord); + { Must always be called AFTER you populated the ImageData array. Then only does it allocate OS resources. } procedure UpdateImage; property ImageData: pointer read FImageData; property ImageDataSize: integer read FImageDataSize; @@ -210,6 +211,7 @@ type property Height: integer read FHeight; property ColorDepth: integer read FColorDepth; property Masked: boolean read FMasked; + property MaskPoint: TPoint read FMaskPoint; property Colors[x, y: TfpgCoord]: TfpgColor read GetColor write SetColor; end; @@ -227,6 +229,7 @@ type protected FFontDesc: string; FFontRes: TfpgFontResourceBase; + function GetIsFixedWidth: boolean; virtual; public function TextWidth(const txt: string): integer; function Ascent: integer; @@ -235,6 +238,7 @@ type property FontDesc: string read FFontDesc; property FontRes: TfpgFontResourceBase read FFontRes; property Handle: TfpgFontResourceBase read FFontRes; + property IsFixedWidth: boolean read GetIsFixedWidth; end; @@ -370,8 +374,19 @@ type TfpgComponent = class(TComponent) private FTagPointer: Pointer; + FHelpContext: THelpContext; + FHelpKeyword: TfpgString; + FHelpType: THelpType; + protected + procedure SetHelpContext(const AValue: THelpContext); virtual; + procedure SetHelpKeyword(const AValue: TfpgString); virtual; public + constructor Create(AOwner: TComponent); override; property TagPointer: Pointer read FTagPointer write FTagPointer; + published + property HelpContext: THelpContext read FHelpContext write SetHelpContext default 0; + property HelpKeyword: TfpgString read FHelpKeyword write SetHelpKeyword; + property HelpType: THelpType read FHelpType write FHelpType default htKeyword; end; @@ -400,6 +415,7 @@ type FCanvas: TfpgCanvasBase; FSizeIsDirty: Boolean; FPosIsDirty: Boolean; + FMouseCursorIsDirty: Boolean; function HandleIsValid: boolean; virtual; abstract; procedure DoUpdateWindowPosition; virtual; abstract; procedure DoAllocateWindowHandle(AParent: TfpgWindowBase); virtual; abstract; @@ -458,16 +474,11 @@ type end; - { TfpgApplicationBase } - - TfpgApplicationBase = class(TComponent) + TfpgApplicationBase = class(TfpgComponent) private FMainForm: TfpgWindowBase; FTerminated: boolean; FCritSect: TCriticalSection; - FHelpType: THelpType; - FHelpContext: THelpContext; - FHelpWord: TfpgString; FHelpKey: word; FHelpFile: TfpgString; function GetForm(Index: Integer): TfpgWindowBase; @@ -498,15 +509,13 @@ type procedure Lock; procedure Unlock; procedure InvokeHelp; - function ContextHelp(const HelpContext: THelpContext): Boolean; - function KeywordHelp(const HelpKeyword: string): Boolean; + function ContextHelp(const AHelpContext: THelpContext): Boolean; + function KeywordHelp(const AHelpKeyword: string): Boolean; property FormCount: integer read GetFormCount; property Forms[Index: Integer]: TfpgWindowBase read GetForm; - property HelpContext: THelpContext read FHelpContext write FHelpContext; + property HelpContext; property HelpFile: TfpgString read GetHelpFile write FHelpFile; property HelpKey: word read FHelpKey write FHelpKey default keyF1; - property HelpType: THelpType read FHelpType write FHelpType default htContext; - property HelpWord: TfpgString read FHelpWord write FHelpWord; property IsInitialized: boolean read FIsInitialized; property TopModalForm: TfpgWindowBase read GetTopModalForm; property MainForm: TfpgWindowBase read FMainForm write FMainForm; @@ -602,8 +611,10 @@ function KeycodeToText(AKey: Word; AShiftState: TShiftState): string; function CheckClipboardKey(AKey: Word; AShiftstate: TShiftState): TClipboardKeyType; { Color } -function fpgColorToRGBTriple(const AColor: TfpgColor): TRGBTriple; -function RGBTripleTofpgColor(const AColor: TRGBTriple): TfpgColor; +function fpgColorToRGBTriple(const AColor: TfpgColor): TRGBTriple; deprecated; +function fpgColorToFPColor(const AColor: TfpgColor): TFPColor; +function RGBTripleTofpgColor(const AColor: TRGBTriple): TfpgColor; deprecated; +function FPColorTofpgColor(const AColor: TFPColor): TfpgColor; function fpgGetRed(const AColor: TfpgColor): word; function fpgGetGreen(const AColor: TfpgColor): word; function fpgGetBlue(const AColor: TfpgColor): word; @@ -808,7 +819,7 @@ begin end { if/else } end; -function fpgColorToRGBTriple(const AColor: TfpgColor): TRGBTriple; +function fpgColorToRGBTriple(const AColor: TfpgColor): TRGBTriple; deprecated; begin with Result do begin @@ -819,7 +830,23 @@ begin end end; -function RGBTripleTofpgColor(const AColor: TRGBTriple): TfpgColor; +function fpgColorToFPColor(const AColor: TfpgColor): TFPColor; +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; deprecated; +begin + Result := AColor.Blue or (AColor.Green shl 8) or (AColor.Red shl 16);// or (AColor.Alpha shl 32); +end; + +function FPColorTofpgColor(const AColor: TFPColor): TfpgColor; begin Result := AColor.Blue or (AColor.Green shl 8) or (AColor.Red shl 16);// or (AColor.Alpha shl 32); end; @@ -862,24 +889,24 @@ end; function fpgGetAvgColor(const AColor1, AColor2: TfpgColor): TfpgColor; var - c1, c2: TRGBTriple; - avg: TRGBTriple; + c1, c2: TFPColor; + avg: TFPColor; begin - c1 := fpgColorToRGBTriple(AColor1); - c2 := fpgColorToRGBTriple(AColor2); + c1 := fpgColorToFPColor(AColor1); + c2 := fpgColorToFPColor(AColor2); avg.Red := c1.Red + (c2.Red - c1.Red) div 2; avg.Green := c1.Green + (c2.Green - c1.Green) div 2; avg.Blue := c1.Blue + (c2.Blue - c1.Blue) div 2; avg.Alpha := c1.Alpha + (c2.Alpha - c1.Alpha) div 2; - Result := RGBTripleTofpgColor(avg); + Result := FPColorTofpgColor(avg); end; function PtInRect(const ARect: TfpgRect; const APoint: TPoint): Boolean; begin Result := (APoint.x >= ARect.Left) and (APoint.y >= ARect.Top) and - (APoint.x < ARect.Right) and - (APoint.y < ARect.Bottom); + (APoint.x <= ARect.Right) and + (APoint.y <= ARect.Bottom); end; procedure SortRect(var ARect: TRect); @@ -1021,6 +1048,8 @@ end; procedure TfpgWindowBase.AllocateWindowHandle; begin DoAllocateWindowHandle(FParent); + if FMouseCursorIsDirty then + DoSetMouseCursor; end; procedure TfpgWindowBase.ReleaseWindowHandle; @@ -1116,6 +1145,7 @@ constructor TfpgWindowBase.Create(AOwner: TComponent); begin inherited Create(AOwner); FMouseCursor := mcDefault; + FMouseCursorIsDirty := False; FPosIsDirty := True; FSizeIsDirty := True; FMaxWidth := 0; @@ -1454,15 +1484,15 @@ end; procedure TfpgCanvasBase.GradientFill(ARect: TfpgRect; AStart, AStop: TfpgColor; ADirection: TGradientDirection); var - RGBStart: TRGBTriple; - RGBStop: TRGBTriple; + RGBStart: TFPColor; + RGBStop: TFPColor; RDiff, GDiff, BDiff: Integer; count: Integer; i: Integer; - newcolor: TRGBTriple; + newcolor: TFPColor; begin - RGBStart := fpgColorToRGBTriple(fpgColorToRGB(AStart)); - RGBStop := fpgColorToRGBTriple(fpgColorToRGB(AStop)); + RGBStart := fpgColorToFPColor(fpgColorToRGB(AStart)); + RGBStop := fpgColorToFPColor(fpgColorToRGB(AStop)); if ADirection = gdVertical then count := ARect.Bottom - ARect.Top @@ -1479,7 +1509,7 @@ begin newcolor.Red := RGBStart.Red + (i * RDiff) div count; newcolor.Green := RGBStart.Green + (i * GDiff) div count; newcolor.Blue := RGBStart.Blue + (i * BDiff) div count; - SetColor(RGBTripleTofpgColor(newcolor)); + SetColor(FPColorTofpgColor(newcolor)); // We have to overshoot by 1 pixel as DrawLine paints 1 pixel short (by design) if ADirection = gdHorizontal then @@ -1558,6 +1588,8 @@ end; procedure TfpgCanvasBase.SetFont(AFont: TfpgFontBase); begin + if AFont = nil then + exit; FFont := AFont; DoSetFontRes(AFont.FFontRes); end; @@ -1616,6 +1648,17 @@ end; { TfpgFontBase } +function TfpgFontBase.GetIsFixedWidth: boolean; +begin + // very crude but handy as a fallback option + if (Pos('mono', Lowercase(FFontDesc)) > 0) or + (Pos('courier', Lowercase(FFontDesc)) > 0) or + (Pos('fixed', Lowercase(FFontDesc)) > 0) then + Result := True + else + Result := False; +end; + function TfpgFontBase.TextWidth(const txt: string): integer; begin if Length(txt) = 0 then @@ -1675,7 +1718,7 @@ var contributions: array[0..10] of TfpgInterpolationContribution; dif, w, gamma, a: double; c: TfpgColor; - rgb: TRGBTriple; + rgb: TFPColor; begin for x := 0 to Width - 1 do begin @@ -1719,7 +1762,7 @@ begin with contributions[r] do begin c := image.colors[place, y]; - rgb := fpgColorToRGBTriple(c); + rgb := fpgColorToFPColor(c); a := weight; // * rgb.Alpha / $FFFF; re := re + a * rgb.Red; gr := gr + a * rgb.Green; @@ -1733,7 +1776,7 @@ begin blue := ColorRound(bl); // alpha := ColorRound(gamma * $FFFF); end; - tempimage.colors[x, y] := RGBTripleTofpgColor(rgb); + tempimage.colors[x, y] := FPColorTofpgColor(rgb); end; end; end; @@ -1746,7 +1789,7 @@ var contributions: array[0..10] of TfpgInterpolationContribution; dif, w, gamma, a: double; c: TfpgColor; - rgb: TRGBTriple; + rgb: TFPColor; begin for y := 0 to Height - 1 do begin @@ -1790,7 +1833,7 @@ begin with contributions[r] do begin c := tempimage.colors[x, place]; - rgb := fpgColorToRGBTriple(c); + rgb := fpgColorToFPColor(c); a := weight;// * rgb.alpha / $FFFF; re := re + a * rgb.red; gr := gr + a * rgb.green; @@ -1804,7 +1847,7 @@ begin blue := ColorRound(bl); // alpha := ColorRound(gamma * $FFFF); end; - Canvas.Pixels[x + dx, y + dy] := RGBTripleTofpgColor(rgb); + Canvas.Pixels[x + dx, y + dy] := FPColorTofpgColor(rgb); end; end; end; @@ -1886,7 +1929,7 @@ var begin p := FImageData; Inc(p, (FWidth * y) + x); - p^ := longword(AValue); + p^ := AValue; // write(IntToHex(AValue, 6) + ' '); end; @@ -1901,6 +1944,7 @@ begin FMaskData := nil; FMaskDataSize := 0; FMasked := False; + FMaskPoint := Point(0, 0); end; destructor TfpgImageBase.Destroy; @@ -1909,7 +1953,7 @@ begin inherited Destroy; end; -procedure TfpgImageBase.Invert; +procedure TfpgImageBase.Invert(IncludeMask: Boolean); var p: ^byte; n: integer; @@ -1924,13 +1968,16 @@ begin Inc(p); end; - if FMaskData <> nil then + if IncludeMask then begin - p := FMaskData; - for n := 1 to FMaskDataSize do + if FMaskData <> nil then begin - p^ := p^ xor $FF; - Inc(p); + p := FMaskData; + for n := 1 to FMaskDataSize do + begin + p^ := p^ xor $FF; + Inc(p); + end; end; end; end; @@ -2006,6 +2053,7 @@ begin Exit; //==> AllocateMask; + FMaskPoint := Point(x, y); p := FImageData; if x < 0 then @@ -2196,21 +2244,27 @@ end; procedure TfpgApplicationBase.InvokeHelp; begin + { TODO -oGraeme -cHelp System : We should probably try ActiveForm and ActiveWidget help first. } if HelpType = htKeyword then - KeywordHelp(HelpWord) + KeywordHelp(HelpKeyword) else ContextHelp(HelpContext); end; -function TfpgApplicationBase.ContextHelp(const HelpContext: THelpContext): Boolean; +function TfpgApplicationBase.ContextHelp(const AHelpContext: THelpContext): Boolean; var p: TProcess; begin - { TODO -oGraeme : Support HelpContext in docview } p := TProcess.Create(nil); try if fpgFileExists(HelpFile) then - p.CommandLine := GetHelpViewer + ' ' + HelpFile + begin + if AHelpContext = 0 then + p.CommandLine := GetHelpViewer + ' ' + HelpFile + else + p.CommandLine := GetHelpViewer + ' ' + HelpFile + ' -n ' + IntToStr(AHelpContext); +//writeln('DEBUG: TfpgApplicationBase.ContextHelp > ', p.CommandLine); + end else p.CommandLine := GetHelpViewer; p.Execute; @@ -2219,15 +2273,17 @@ begin end; end; -function TfpgApplicationBase.KeywordHelp(const HelpKeyword: string): Boolean; +function TfpgApplicationBase.KeywordHelp(const AHelpKeyword: string): Boolean; var p: TProcess; begin - { TODO -oGraeme : Support HelpKeyword in docview } p := TProcess.Create(nil); try if fpgFileExists(HelpFile) then - p.CommandLine := GetHelpViewer + ' ' + HelpFile + begin + p.CommandLine := GetHelpViewer + ' ' + HelpFile + ' -s ' + AHelpKeyword; +//writeln('DEBUG: TfpgApplicationBase.ContextHelp > ', p.CommandLine); + end else p.CommandLine := GetHelpViewer; p.Execute; @@ -2546,5 +2602,33 @@ begin FEntries := newl; end; +{ TfpgComponent } + +procedure TfpgComponent.SetHelpContext(const AValue: THelpContext); +begin + if not (csLoading in ComponentState) then + FHelpType := htContext; + if FHelpContext = AValue then + Exit; //==> + FHelpContext := AValue; +end; + +procedure TfpgComponent.SetHelpKeyword(const AValue: TfpgString); +begin + if not (csLoading in ComponentState) then + FHelpType := htKeyword; + if FHelpKeyword = AValue then + Exit; //==> + FHelpKeyword := AValue; +end; + +constructor TfpgComponent.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FHelpType := htKeyword; + FHelpContext := 0; + FTagPointer := nil; +end; + end. diff --git a/src/corelib/fpg_cmdlineparams.pas b/src/corelib/fpg_cmdlineparams.pas index 10ed9740..07f40c1e 100644 --- a/src/corelib/fpg_cmdlineparams.pas +++ b/src/corelib/fpg_cmdlineparams.pas @@ -1,9 +1,9 @@ { - fpGUI - Free Pascal GUI Library + fpGUI - Free Pascal GUI Toolkit Unit to handle command line processing - Copyright (C) 2007 - 2009 See the file AUTHORS.txt, included in this + Copyright (C) 2007 - 2010 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/corelib/fpg_constants.pas b/src/corelib/fpg_constants.pas index 7c4af9b0..d93e5208 100644 --- a/src/corelib/fpg_constants.pas +++ b/src/corelib/fpg_constants.pas @@ -1,7 +1,7 @@ { - fpGUI - Free Pascal GUI Library + fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2009 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2010 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/corelib/fpg_extgraphics.pas b/src/corelib/fpg_extgraphics.pas index f0ff7417..f0e4d3d2 100644 --- a/src/corelib/fpg_extgraphics.pas +++ b/src/corelib/fpg_extgraphics.pas @@ -1,7 +1,7 @@ { fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2010 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/corelib/fpg_extinterpolation.pas b/src/corelib/fpg_extinterpolation.pas index c27b18c9..b08f5817 100644 --- a/src/corelib/fpg_extinterpolation.pas +++ b/src/corelib/fpg_extinterpolation.pas @@ -1,7 +1,7 @@ { - fpGUI - Free Pascal GUI Library + fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2010 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/corelib/fpg_imagelist.pas b/src/corelib/fpg_imagelist.pas index 1150211a..20d34e35 100644 --- a/src/corelib/fpg_imagelist.pas +++ b/src/corelib/fpg_imagelist.pas @@ -1,7 +1,7 @@ { - fpGUI - Free Pascal GUI Library + fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2009 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -72,6 +72,7 @@ type procedure AddImage(AImage: TfpgImage; AIndex: integer = -1); procedure RemoveIndex(AIndex: integer); function GetMaxItem: integer; + procedure Clear; property Item[AIndex: integer]: TfpgImageItem read GetItem write SetItem; property Count: integer read GetCount; end; @@ -208,6 +209,11 @@ begin result := TfpgImageItem(FList[i]).Index; end; +procedure TfpgImageList.Clear; +begin + FList.Clear; +end; + { TfpgImageItem } procedure TfpgImageItem.SetImageList(AImageList: TfpgImageList); @@ -276,7 +282,7 @@ end; destructor TfpgImageItem.Destroy; begin if FImage <> nil then - FImage.Destroy; + FImage.Free; inherited Destroy; end; diff --git a/src/corelib/fpg_imgfmt_bmp.pas b/src/corelib/fpg_imgfmt_bmp.pas index 11298453..48b25d5b 100644 --- a/src/corelib/fpg_imgfmt_bmp.pas +++ b/src/corelib/fpg_imgfmt_bmp.pas @@ -1,7 +1,7 @@ { - fpGUI - Free Pascal GUI Library + fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -183,13 +183,11 @@ begin pixelcnt := 0; while (p) < (pdata) do begin - pcol^ := Plongword(p)^; - //Writeln('color: ',HexStr(pcol^,8)); + pcol^ := (LongWord(p[3]) shl 24) + (LongWord(p[2]) shl 16) + (LongWord(p[1]) shl 8) + LongWord(p[0]); Inc(pcol); - Inc(Plongword(p)); + inc(p, 4); Inc(pixelcnt); end; - //writeln(pixelcnt,' colors loaded.'); end; pdest := img.ImageData; @@ -219,7 +217,7 @@ begin //Writeln(linecnt,' lines loaded.'); move(img.ImageData^, img.MaskData^, img.ImageDataSize); - img.Invert; + img.Invert(True); end; 4: diff --git a/src/corelib/fpg_imgfmt_jpg.pas b/src/corelib/fpg_imgfmt_jpg.pas new file mode 100644 index 00000000..1a7fce23 --- /dev/null +++ b/src/corelib/fpg_imgfmt_jpg.pas @@ -0,0 +1,382 @@ +{ + fpGUI - Free Pascal GUI Toolkit + + Copyright (C) 2006 - 2010 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: + JPEG format image parser +} + + +unit fpg_imgfmt_jpg; + +{$mode objfpc}{$H+} + + +interface + +uses + Classes, + SysUtils, + fpg_main, + fpg_base, + fpg_dialogs; + +type + EJPEG = class(Exception); + +procedure ReadImage_JPG(img: TfpgImage; bmp: TStream; const AScale: integer = 1); +function LoadImage_JPG(const AFileName: String; const AScale: integer = 1): TfpgImage; + +implementation +uses + {PASJPG10 library} + jmorecfg, + jpeglib, + jerror, + jdeferr, + jdmarker, + jdmaster, + jdapimin, + jdapistd; + +type + + my_src_ptr = ^my_source_mgr; + my_source_mgr = record + pub : jpeg_source_mgr; {public fields} + infile : TStream; {source stream} + buffer : JOCTET_FIELD_PTR; {start of buffer} + start_of_file : boolean; {have we gotten any data yet?} + end; + +// my_error_ptr = ^my_error_mgr; + my_error_mgr = record + pub: jpeg_error_mgr; + end; + + bmp_dest_ptr = ^bmp_dest_struct; + bmp_dest_struct = record + {image info} + data_width : JDIMENSION; {JSAMPLEs per row} + row_width : JDIMENSION; {physical width of one row in the BMP file} + pad_bytes : INT; {number of padding bytes needed per row} + grayscale : boolean; {grayscale or quantized color table ?} + {pixelrow buffer} + buffer : JSAMPARRAY; {pixelrow buffer} + buffer_height : JDIMENSION; {normally, we'll use 1} + cur_output_row : JDIMENSION; {next row# to write to virtual array} + end; + + + +const + INPUT_BUF_SIZE = 4096; + +procedure init_source(cinfo : j_decompress_ptr); +var + src : my_src_ptr; +begin + src := my_src_ptr(cinfo^.src); + src^.start_of_file := TRUE; +end; + +function fill_input_buffer(cinfo : j_decompress_ptr) : boolean; +var + src : my_src_ptr; + nbytes : size_t; +begin + src := my_src_ptr(cinfo^.src); + nbytes := src^.infile.Read(src^.buffer^, INPUT_BUF_SIZE); + if (nbytes <= 0) then begin + if (src^.start_of_file) then {Treat empty input file as fatal error} + ERREXIT(j_common_ptr(cinfo), JERR_INPUT_EMPTY); + WARNMS(j_common_ptr(cinfo), JWRN_JPEG_EOF); + {Insert a fake EOI marker} + src^.buffer^[0] := JOCTET ($FF); + src^.buffer^[1] := JOCTET (JPEG_EOI); + nbytes := 2; + end; + src^.pub.next_input_byte := JOCTETptr(src^.buffer); + src^.pub.bytes_in_buffer := nbytes; + src^.start_of_file := FALSE; + fill_input_buffer := TRUE; +end; + +procedure skip_input_data(cinfo : j_decompress_ptr; + num_bytes : long); +var + src : my_src_ptr; +begin + src := my_src_ptr (cinfo^.src); + if (num_bytes > 0) then begin + while (num_bytes > long(src^.pub.bytes_in_buffer)) do begin + Dec(num_bytes, long(src^.pub.bytes_in_buffer)); + fill_input_buffer(cinfo); + { note we assume that fill_input_buffer will never return FALSE, + so suspension need not be handled. } + end; + Inc( src^.pub.next_input_byte, size_t(num_bytes) ); + Dec( src^.pub.bytes_in_buffer, size_t(num_bytes) ); + end; +end; + +procedure term_source(cinfo : j_decompress_ptr); +begin + { no work necessary here } +end; + +procedure jpeg_stream_src(cinfo : j_decompress_ptr; const infile: TStream); +var + src : my_src_ptr; +begin + if (cinfo^.src = nil) then begin {first time for this JPEG object?} + + cinfo^.src := jpeg_source_mgr_ptr( + cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_PERMANENT, + SIZEOF(my_source_mgr)) ); + src := my_src_ptr (cinfo^.src); + src^.buffer := JOCTET_FIELD_PTR( + cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_PERMANENT, + INPUT_BUF_SIZE * SIZEOF(JOCTET)) ); + end; + src := my_src_ptr (cinfo^.src); + {override pub's method pointers} + src^.pub.init_source := @init_source; + src^.pub.fill_input_buffer := @fill_input_buffer; + src^.pub.skip_input_data := @skip_input_data; + src^.pub.resync_to_restart := @jpeg_resync_to_restart; {use default method} + src^.pub.term_source := @term_source; + {define our fields} + src^.infile := infile; + src^.pub.bytes_in_buffer := 0; {forces fill_input_buffer on first read} + src^.pub.next_input_byte := nil; {until buffer loaded} +end; + +procedure error_exit (cinfo : j_common_ptr); +var + buffer : string; +begin + buffer := ''; + cinfo^.err^.format_message(cinfo, buffer); + raise EJPEG.Create(buffer); +end; + +procedure emit_message (cinfo : j_common_ptr; msg_level : int); +var + err : jpeg_error_mgr_ptr; +begin + err := cinfo^.err; + if (msg_level < 0) then begin + {It's a warning message. Since corrupt files may generate many warnings,} + {the policy implemented here is to show only the first warning,} + {unless trace_level >= 3} + if (err^.num_warnings = 0) or (err^.trace_level >= 3) then + err^.output_message(cinfo); + {Always count warnings in num_warnings} + Inc( err^.num_warnings ); + end else + {It's a trace message. Show it if trace_level >= msg_level} + if (err^.trace_level >= msg_level) then + err^.output_message (cinfo); +end; + +procedure output_message (cinfo : j_common_ptr); +var + buffer : string; +begin + buffer := ''; + cinfo^.err^.format_message (cinfo, buffer); + {message dialog} + ShowMessage(buffer); +end; + +procedure format_message (cinfo : j_common_ptr; var buffer : string); +begin + buffer := 'JPEG ERROR -- #' + IntToStr(cinfo^.err^.msg_code); +end; + +procedure reset_error_mgr (cinfo : j_common_ptr); +begin + cinfo^.err^.num_warnings := 0; + {trace_level is not reset since it is an application-supplied parameter} + cinfo^.err^.msg_code := 0; {may be useful as a flag for "no error"} +end; + +function jpeg_my_error (var err : my_error_mgr) : jpeg_error_mgr_ptr; +begin + {methods} + err.pub.error_exit := @error_exit; + err.pub.emit_message := @emit_message; + err.pub.output_message := @output_message; + err.pub.format_message := @format_message; + err.pub.reset_error_mgr := @reset_error_mgr; + {fields} + err.pub.trace_level := 0; {default := no tracing} + err.pub.num_warnings := 0; {no warnings emitted yet} + err.pub.msg_code := 0; {may be useful as a flag for "no error"} + {message table(s)} + err.pub.jpeg_message_table := nil; {we don't want to use a static table} + err.pub.last_jpeg_message := pred(JMSG_LASTMSGCODE); + err.pub.addon_message_table := nil; + err.pub.first_addon_message := JMSG_NOMESSAGE; {for safety} + err.pub.last_addon_message := JMSG_NOMESSAGE; + {return result} + jpeg_my_error := @err; +end; + +function jinit_write_bmp (cinfo : j_decompress_ptr) : bmp_dest_ptr; +var + dest : bmp_dest_ptr; +begin + dest := bmp_dest_ptr ( + cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, + SIZEOF(bmp_dest_struct)) ); + jpeg_calc_output_dimensions(cinfo); + dest^.data_width := cinfo^.output_width * cinfo^.output_components; + dest^.row_width := dest^.data_width; + while ((dest^.row_width and 3) <> 0) do + Inc(dest^.row_width); + dest^.pad_bytes := int(dest^.row_width-dest^.data_width); + if (cinfo^.out_color_space = JCS_GRAYSCALE) then + dest^.grayscale := True + else if (cinfo^.out_color_space = JCS_RGB) then + if (cinfo^.quantize_colors) then + dest^.grayscale := True + else + dest^.grayscale := False + else + ERREXIT(j_common_ptr(cinfo), JERR_BMP_COLORSPACE); + {decompress buffer} + dest^.buffer := cinfo^.mem^.alloc_sarray + (j_common_ptr(cinfo), JPOOL_IMAGE, dest^.row_width, JDIMENSION (1)); + dest^.buffer_height := 1; + dest^.cur_output_row := 0; + {result} + jinit_write_bmp := dest; +end; + +procedure write_jpeg_pixelrow (cinfo : j_decompress_ptr; + dest : bmp_dest_ptr; + rows_supplied : JDIMENSION; + img : TfpgImage); +var + inptr: JSAMPLE_PTR; + col : JDIMENSION; + // pad : int; + NewBGR: TFPColor; + PDest: PLongWord; +begin + inptr := JSAMPLE_PTR(dest^.buffer^[0]); + + PDest:= img.ImageData; + inc(PDest, img.Width *rows_supplied); + if not dest^.grayscale then + begin + for col := pred(cinfo^.output_width) downto 0 do + begin + fillchar(NewBGR,sizeof(NewBGR),0); + NewBGR.Red:=inptr^; + Inc(inptr); + NewBGR.Green:=inptr^; + Inc(inptr); + NewBGR.Blue:=inptr^; + Inc(inptr); + PDest^ := FPColorTofpgColor(NewBGR); + inc(PDest); + end; + end + else + begin + for col := pred(cinfo^.output_width) downto 0 do + begin + NewBGR.Red:=inptr^; + NewBGR.Green:=inptr^; + NewBGR.Blue:=inptr^; + NewBGR.Alpha:=inptr^; + Inc(inptr); + PDest^ := FPColorTofpgColor(NewBGR); + inc(PDest); + end; + end; +end; + + +procedure ReadImage_JPG(img: TfpgImage; bmp: TStream; const AScale: integer); +var + cinfo : jpeg_decompress_struct; + err : my_error_mgr; + dest : bmp_dest_ptr; +begin + if img = nil then + Exit; //==> + + img.FreeImage; + {initialize the JPEG decompression object with default error handling.} + cinfo.err := jpeg_my_error(err); + jpeg_create_decompress(@cinfo); + try + {specify the source of the compressed data} + jpeg_stream_src(@cinfo, bmp); + {obtain image info from header, set default decompression parameters} + jpeg_read_header(@cinfo, TRUE); + + cinfo.scale_num := 1; + case AScale of + 1: cinfo.scale_denom := 1; // full size + 2: cinfo.scale_denom := 2; // 1/2 size + 3: cinfo.scale_denom := 4; // 1/4 size + 4: cinfo.scale_denom := 8; // 1/8 size + else + cinfo.scale_denom := 1; // defaults to full size + end; + + dest := jinit_write_bmp(@cinfo); + + img.AllocateImage(32, (cinfo.image_width + (cinfo.scale_denom-1)) div cinfo.scale_denom , + (cinfo.image_height+ (cinfo.scale_denom-1)) div cinfo.scale_denom); // color image + {prepare for decompression, initialize internal state} + jpeg_start_decompress(@cinfo) ; + {process data} + while (cinfo.output_scanline < cinfo.output_height) do + begin + jpeg_read_scanlines(@cinfo, dest^.buffer, dest^.buffer_height); + write_jpeg_pixelrow(@cinfo, dest,cinfo.output_scanline-1,img); + end; + {finish} + jpeg_finish_decompress(@cinfo); + finally + {destroy} + jpeg_destroy_decompress(@cinfo); + end; + img.UpdateImage; +end; + +function LoadImage_JPG(const AFileName: String; const AScale: integer): TfpgImage; +var + inFile: TStream; +begin + Result := nil; + if not FileExists(AFileName) then + Exit; //==> + + inFile:=TFileStream.Create(AFileName,fmOpenRead); + try + Result:=TfpgImage.Create; + ReadImage_JPG(Result, inFile, AScale); + finally + inFile.Free; + end; +end; + + +end. + diff --git a/src/corelib/fpg_imgutils.pas b/src/corelib/fpg_imgutils.pas new file mode 100644 index 00000000..afb4d4fe --- /dev/null +++ b/src/corelib/fpg_imgutils.pas @@ -0,0 +1,110 @@ +{ + fpGUI - Free Pascal GUI Toolkit + + Copyright (C) 2006 - 2010 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: + Some handly image manipulation functions to use with TfpgImage class. + Included is a gray color conversion matrix. +} + +unit fpg_imgutils; + +{$mode objfpc}{$H+} + +{ TODO : Make the conversion matrix a plugable architecture. Similar to the + interpolation handling in TfpgCanvas. } + +interface + +uses + fpg_base, + fpg_main; + +type + TGrayConvMatrix = record + red: single; + green: single; + blue: single; + end; + +var + GrayConvMatrix: TGrayConvMatrix; + GrayBrightness: Boolean; + GrayBrightnessPercentage: integer; + +const + GCM_NTSC: TGrayConvMatrix = (red:0.299; green:0.587; blue:0.114); // NTSC method + GCM_Mathematical: TGrayConvMatrix = (red:0.334; green:0.333; blue:0.333); // Intensity method + GCM_Photoshop: TGrayConvMatrix = (red:0.212671; green:0.715160; blue:0.072169); // Y of YUV from B/W TV's + + +procedure fpgApplyGreyFilter(var AImg: TfpgImage); +function fpgCalculateGray(const AFrom: TfpgColor; const ABrighter: boolean = False; const APercent: integer = 0): TfpgColor; + + +implementation + + +procedure fpgApplyGreyFilter(var AImg: TfpgImage); +var + x, y: integer; + c: TfpgColor; +begin + for x := 0 to AImg.Width-1 do + begin + for y := 0 to AImg.Height-1 do + begin + c := AImg.Colors[x, y]; + AImg.Colors[x, y] := fpgCalculateGray(c, GrayBrightness, GrayBrightnessPercentage); + end; + end; + AImg.UpdateImage; +end; + + +{ AFrom is the original color we want to change + ABrighter = True goes to direction of White. False goes to direction of Black + APercent = 0 zero is straight conversion to gray. 100% is pure black or + white, depending on ABrighter value. } +function fpgCalculateGray(const AFrom: TfpgColor; const ABrighter: boolean = False; const APercent: integer = 0): TfpgColor; +var + g: integer; + rgb: TFPColor; +begin + with GrayConvMatrix do + begin + rgb := fpgColorToFPColor(AFrom); + g := round(red*rgb.red + green*rgb.green + blue*rgb.blue); + + if ABrighter then + g := trunc(255 - ((255 - g) * (100 - APercent) / 100)) + else + g := trunc(g * (100 - APercent) / 100); + + if (g < 0) then g := 0; + if (g > 255) then g := 255; + + rgb.Red := g; + rgb.Green := g; + rgb.Blue := g; + end; + Result := FPColorTofpgColor(rgb); +end; + + +initialization + GrayConvMatrix := GCM_NTSC; + GrayBrightness := True; + GrayBrightnessPercentage := 20; + +end. + diff --git a/src/corelib/fpg_main.pas b/src/corelib/fpg_main.pas index e8c26eae..c8023408 100644 --- a/src/corelib/fpg_main.pas +++ b/src/corelib/fpg_main.pas @@ -1,7 +1,7 @@ { - fpGUI - Free Pascal GUI Library + fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2009 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -12,7 +12,7 @@ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. Description: - The main unit trying everything together in corelib. + The main unit that ties everything together from CoreLib. } unit fpg_main; @@ -21,7 +21,6 @@ unit fpg_main; {.$Define DEBUG} -{ TODO : Remove IFDEF in Interface uses clause } { TODO : Implement font size adjustments for each platform. eg: linux=10pt & windows=8pt } interface @@ -29,16 +28,8 @@ interface uses Classes, SysUtils, - fpg_base - // This is the only place we have such IFDEF!!! Is this ok, or must we - // implement it like we have done for the previous version of fpGFX? - {$IFDEF MSWINDOWS} - ,fpg_gdi - {$ENDIF} - {$IFDEF UNIX} - ,fpg_x11 - {$ENDIF} - ; + fpg_base, + fpg_interface; type TOrientation = (orVertical, orHorizontal); @@ -68,8 +59,9 @@ const cMessageQueueSize = 1024; // version and name constants - fpGUIVersion = '0.6.2'; + {$I VERSION_FILE.inc} // this includes the auto generated: fpGUI_Version = xxx fpGUIName = 'fpGUI Toolkit'; + fpGUIWebsite = 'http://opensoft.homeip.net/fpgui/'; const txtWordDelims: set of char = [' ', #9, #13, #10]; @@ -151,6 +143,8 @@ type TfpgImage = class(TfpgImageImpl) public + function CreateDisabledImage: TfpgImage; + function ImageFromSource: TfpgImage; function ImageFromRect(var ARect: TRect): TfpgImage; overload; function ImageFromRect(var ARect: TfpgRect): TfpgImage; overload; end; @@ -232,7 +226,7 @@ type FHintPos: TPoint; procedure SetHintPause(const AValue: Integer); procedure SetupLocalizationStrings; - procedure InternalMsgClose(var msg: TfpgMessageRec); message FPGM_CLOSE; + procedure InternalMsgFreeMe(var msg: TfpgMessageRec); message FPGM_FREEME; procedure InternalMsgHintTimer(var msg: TfpgMessageRec); message FPGM_HINTTIMER; procedure CreateHintWindow; procedure HintTimerFired(Sender: TObject); @@ -253,6 +247,7 @@ type destructor Destroy; override; function GetFont(const afontdesc: string): TfpgFont; procedure ActivateHint(APos: TPoint; AHint: TfpgString); + procedure RecreateHintWindow; procedure Flush; procedure HandleException(Sender: TObject); procedure HideHint; @@ -321,10 +316,12 @@ type TfpgClipboard = class(TfpgClipboardImpl) end; + TfpgFileList = class(TfpgFileListImpl) end; + var fpgStyle: TfpgStyle; { TODO -ograemeg : move this into fpgApplication } fpgCaret: TfpgCaret; { TODO -ograemeg : move this into fpgApplication } @@ -376,6 +373,7 @@ function fpgRectToRect(const ARect: TfpgRect): TRect; procedure PrintRect(const Rect: TRect); procedure PrintRect(const Rect: TfpgRect); procedure PrintCoord(const x, y: TfpgCoord); +procedure PrintCoord(const pt: TPoint); function PrintCallTrace(const AClassName, AMethodName: string): IInterface; procedure PrintCallTraceDbgLn(const AMessage: string); procedure DumpStack; @@ -403,7 +401,8 @@ uses fpg_hint, fpg_extgraphics, fpg_utils, - fpg_cmdlineparams; + fpg_cmdlineparams, + fpg_imgutils; var fpgTimers: TList; @@ -423,6 +422,8 @@ type constructor Create(AFontID, AFontDesc: string); end; + TWidgetFriend = class(TfpgWidget); // so we can get access to the Protected section + constructor TNamedFontItem.Create(AFontID, AFontDesc: string); begin FontID := AFontID; @@ -692,7 +693,7 @@ begin spacing := ''; inc(iCallTrace); for i := 0 to iCallTrace do - spacing := spacing + ' '; + spacing += ' '; FClassName := AClassName; FMethodName := AMethodName; {$IFDEF DEBUG} @@ -708,7 +709,12 @@ begin dec(iCallTrace); inherited Destroy; end; - + +procedure PrintCoord(const pt: TPoint); +begin + PrintCoord(pt.X, pt.Y); +end; + function PrintCallTrace(const AClassName, AMethodName: string): IInterface; begin Result := TPrintCallTrace.Create(AClassName, AMethodName); @@ -721,14 +727,14 @@ var begin s := ''; for i := 0 to iCallTrace+1 do - s := s + ' '; + s += ' '; writeln(s + AMessage); end; procedure DumpStack; -Var - Message : String; - i : longint; +var + lMessage: String; + i: longint; begin writeln(' Stack trace:'); // Dump_Stack(StdOut, get_frame); @@ -736,15 +742,15 @@ begin Writeln(stdout,'An unhandled exception occurred at $',HexStr(Ptrint(ExceptAddr),sizeof(PtrInt)*2),' :'); if ExceptObject is exception then begin - Message:=Exception(ExceptObject).ClassName+' : '+Exception(ExceptObject).Message; - Writeln(stdout,Message); + lMessage := Exception(ExceptObject).ClassName+' : '+Exception(ExceptObject).Message; + Writeln(stdout,lMessage); end else Writeln(stdout,'Exception object ',ExceptObject.ClassName,' is not of class Exception.'); Writeln(stdout,BackTraceStrFunc(ExceptAddr)); if (ExceptFrameCount>0) then begin - for i:=0 to ExceptFrameCount-1 do + for i := 0 to ExceptFrameCount-1 do Writeln(stdout,BackTraceStrFunc(ExceptFrames[i])); end; Writeln(stdout,''); @@ -788,21 +794,21 @@ end; procedure TfpgTimer.SetEnabled(const AValue: boolean); begin if (not FEnabled) and AValue then - FNextAlarm := now + interval * ONE_MILISEC; + FNextAlarm := now + (interval * ONE_MILISEC); FEnabled := AValue; end; procedure TfpgTimer.SetInterval(const AValue: integer); begin FInterval := AValue; - FNextAlarm := now + FInterval * ONE_MILISEC; + FNextAlarm := now + (FInterval * ONE_MILISEC); end; constructor TfpgTimer.Create(ainterval: integer); begin FInterval := ainterval; - OnTimer := nil; - FEnabled := False; + OnTimer := nil; + FEnabled := False; fpgTimers.Add(self); end; @@ -826,7 +832,7 @@ begin // set the next alarm point if interval > 0 then while FNextAlarm <= ctime do - FNextAlarm := FNextAlarm + (interval * ONE_MILISEC); + FNextAlarm += (interval * ONE_MILISEC); if Assigned(FOnTimer) then FOnTimer(self); @@ -971,8 +977,12 @@ begin begin HideHint; FHintWindow.Free; + FHintWindow := nil; end; - + FHintTimer.Enabled := False; + FHintTimer.OnTimer := nil; + FHintTimer.Free; + DestroyComponents; // while message queue is still active for i := 0 to (fpgNamedFonts.Count - 1) do @@ -1066,11 +1076,30 @@ begin h := wnd.Font.Height + (wnd.Border * 2) + (wnd.Margin * 2); { prevents hint from going off the right screen edge } if (APos.X + w) > ScreenWidth then + begin APos.X:= ScreenWidth - w; + // just a few more sanity checks + if APos.X < 0 then + APos.X := 0; + if w > ScreenWidth then + w := ScreenWidth; + end; wnd.SetPosition(APos.X, APos.Y, w, h); + wnd.UpdateWindowPosition; wnd.Show; end; +procedure TfpgApplication.RecreateHintWindow; +begin + if Assigned(FHintWindow) then + begin + HideHint; + FHintWindow.Free; + FHintWindow := nil; + end; + CreateHintWindow; +end; + procedure TfpgApplication.Initialize; begin { TODO : Remember to process parameters!! } @@ -1140,6 +1169,20 @@ begin SetLength(FalseBoolStrs,1); TrueBoolStrs[0] := rsTrue; FalseBoolStrs[0] := rsFalse; + + // Dialog box button captions + cMsgDlgBtnText[mbOK] := rsOK; + cMsgDlgBtnText[mbCancel] := rsCancel; + cMsgDlgBtnText[mbYes] := rsYes; + cMsgDlgBtnText[mbNo] := rsNo; + cMsgDlgBtnText[mbAbort] := rsAbort; + cMsgDlgBtnText[mbRetry] := rsRetry; + cMsgDlgBtnText[mbIgnore] := rsIgnore; + cMsgDlgBtnText[mbAll] := rsAll; + cMsgDlgBtnText[mbNoToAll] := rsNoToAll; + cMsgDlgBtnText[mbYesToAll] := rsYesToAll; + cMsgDlgBtnText[mbHelp] := rsHelp; + cMsgDlgBtnText[mbClose] := rsClose; end; procedure TfpgApplication.SetHintPause(const AValue: Integer); @@ -1148,7 +1191,7 @@ begin FHintTimer.Interval := FHintPause; end; -procedure TfpgApplication.InternalMsgClose(var msg: TfpgMessageRec); +procedure TfpgApplication.InternalMsgFreeMe(var msg: TfpgMessageRec); begin if Assigned(msg.Sender) then begin @@ -1193,13 +1236,17 @@ end; procedure TfpgApplication.HintTimerFired(Sender: TObject); var w: TfpgWidget; + lHint: TfpgString; begin w := nil; -// writeln('HintTimerFired...'); w := TfpgWidget(FHintWidget); try if Assigned(w) then - ActivateHint(w.WindowToScreen(w, FHintPos), w.Hint); + begin +//writeln('fpgApplication.HintTimerFired w = ', w.ClassName, ' - ', w.Name); + TWidgetFriend(w).DoShowHint(lHint); + ActivateHint(w.WindowToScreen(w, FHintPos), lHint); + end; except // silence it! { TODO : FHintWidget probably went out of scope just as timer fired. Try @@ -1235,8 +1282,9 @@ begin fpgStyle := TfpgStyle.Create; fpgCaret := TfpgCaret.Create; fpgImages := TfpgImages.Create; + fpgCreateStandardImages; - + // This will process Application and fpGUI Toolkit translation (*.po) files TranslateResourceStrings(ApplicationName, ExtractFilePath(ParamStr(0)), ''); SetupLocalizationStrings; @@ -1422,7 +1470,7 @@ begin Result := TrimRight(Result) + sLineBreak; end else Inc(lw, tw); - Result := Result + sub; + Result += sub; end; end; @@ -1623,25 +1671,25 @@ begin {$Note Refactor this so under Windows it can detect the system colors instead. Also under Linux (KDE and Gnome) we should be able to detect the system colors.} - fpgSetNamedColor(clWindowBackground, $D4D0C8); + fpgSetNamedColor(clWindowBackground, $D5D2CD); fpgSetNamedColor(clBoxColor, $FFFFFF); - fpgSetNamedColor(clShadow1, $808080); - fpgSetNamedColor(clShadow2, $404040); - fpgSetNamedColor(clHilite1, $E0E0E0); - fpgSetNamedColor(clHilite2, $FFFFFF); + fpgSetNamedColor(clShadow1, $848284); // medium + fpgSetNamedColor(clShadow2, $424142); // dark + fpgSetNamedColor(clHilite1, $E0E0E0); // light + fpgSetNamedColor(clHilite2, $FFFFFF); // white fpgSetNamedColor(clText1, $000000); fpgSetNamedColor(clText2, $000040); fpgSetNamedColor(clText3, $800000); fpgSetNamedColor(clText4, $404000); - fpgSetNamedColor(clSelection, $0A246A); + fpgSetNamedColor(clSelection, $08246A); fpgSetNamedColor(clSelectionText, $FFFFFF); fpgSetNamedColor(clInactiveSel, $D0D0FF); fpgSetNamedColor(clInactiveSelText, $000000); fpgSetNamedColor(clScrollBar, $E8E4DB); - fpgSetNamedColor(clButtonFace, $D4D0C8); + fpgSetNamedColor(clButtonFace, $D5D2CD); fpgSetNamedColor(clListBox, $FFFFFF); fpgSetNamedColor(clGridLines, $A0A0A0); - fpgSetNamedColor(clGridHeader, $D4D0C8); + fpgSetNamedColor(clGridHeader, $D5D2CD); fpgSetNamedColor(clWidgetFrame, $000000); fpgSetNamedColor(clInactiveWgFrame, $A0A0A0); fpgSetNamedColor(clTextCursor, $000000); @@ -1650,6 +1698,10 @@ begin fpgSetNamedColor(clMenuText, $000000); fpgSetNamedColor(clMenuDisabled, $909090); fpgSetNamedColor(clHintWindow, $FFFFBF); + fpgSetNamedColor(clGridSelection, $08246A); // same as clSelection + fpgSetNamedColor(clGridSelectionText, $FFFFFF); // same as clSelectionText + fpgSetNamedColor(clGridInactiveSel, $D0D0FF); // same as clInactiveSel + fpgSetNamedColor(clGridInactiveSelText, $000000); // same as clInactiveSelText // Global Font Objects @@ -1839,7 +1891,7 @@ begin Exit; //==> if not AEnabled then begin - ACanvas.SetTextColor(clHilite1); + ACanvas.SetTextColor(clHilite2); ACanvas.DrawString(x+1, y+1, AText); ACanvas.SetTextColor(clShadow1); end; @@ -2038,17 +2090,38 @@ end; { TfpgImage } +function TfpgImage.CreateDisabledImage: TfpgImage; +begin + Result := ImageFromSource; + fpgApplyGreyFilter(Result); +end; + +function TfpgImage.ImageFromSource: TfpgImage; +var + x, y: TfpgCoord; +begin + Result := TfpgImage.Create; + Result.AllocateImage(ColorDepth, Width, Height); + for x := 0 to Width-1 do + begin + for y := 0 to Height-1 do + begin + Result.Colors[x, y] := Colors[x, y]; + end; + end; + if Masked then + Result.CreateMaskFromSample(MaskPoint.X, MaskPoint.Y); + Result.UpdateImage; +end; + function TfpgImage.ImageFromRect(var ARect: TRect): TfpgImage; var x, y: TfpgCoord; ix, iy: TfpgCoord; begin SortRect(ARect); - Result := TfpgImage.Create; Result.AllocateImage(ColorDepth, ARect.Right-ARect.Left, ARect.Bottom-ARect.Top); - Result.UpdateImage; - iy := -1; for y := ARect.Top to ARect.Bottom-1 do begin @@ -2060,6 +2133,7 @@ begin Result.Colors[ix, iy] := Colors[x, y]; end; end; + Result.UpdateImage; end; function TfpgImage.ImageFromRect(var ARect: TfpgRect): TfpgImage; @@ -2068,11 +2142,8 @@ var ix, iy: TfpgCoord; begin SortRect(ARect); - Result := TfpgImage.Create; Result.AllocateImage(ColorDepth, ARect.Width, ARect.Height); - Result.UpdateImage; - iy := -1; for y := ARect.Top to ARect.Bottom do begin @@ -2084,6 +2155,7 @@ begin Result.Colors[ix, iy] := Colors[x, y]; end; end; + Result.UpdateImage; end; initialization @@ -2097,7 +2169,7 @@ initialization InitializeDebugOutput; fpgInitMsgQueue; -finalization; +finalization uClipboard.Free; uApplication.Free; FinalizeDebugOutput; diff --git a/src/corelib/fpg_msgqueue.inc b/src/corelib/fpg_msgqueue.inc index 80e0be96..386178d9 100644 --- a/src/corelib/fpg_msgqueue.inc +++ b/src/corelib/fpg_msgqueue.inc @@ -171,12 +171,7 @@ begin m.Dest := Dest; m.Params := aparams; -// try - m.Dest.Dispatch(m) -// except -// on E: Exception do -// {$IFDEF DEBUG}writeln('fpgSendMessage Caught Exception: ' + E.Message){$ENDIF}; -// end; + fpgDeliverMessage(m); end; procedure fpgSendMessage(Sender, Dest: TObject; MsgCode: integer); overload; @@ -190,12 +185,7 @@ begin m.Sender := Sender; m.Dest := Dest; -// try - m.Dest.Dispatch(m) -// except -// on E: Exception do -// {$IFDEF DEBUG}writeln('fpgSendMessage Caught Exception: ' + E.Message){$ENDIF}; -// end; + fpgDeliverMessage(m); end; procedure fpgDeliverMessage(var msg: TfpgMessageRec); @@ -207,21 +197,16 @@ begin msg.Dest.Free else begin -// try - msg.Dest.Dispatch(msg); - if fpgApplication.FMessageHookList.Count > 0 then + msg.Dest.Dispatch(msg); + if fpgApplication.FMessageHookList.Count > 0 then + begin + for i := 0 to fpgApplication.FMessageHookList.Count - 1 do begin - for i := 0 to fpgApplication.FMessageHookList.Count - 1 do - begin - oItem := TMsgHookItem(fpgApplication.FMessageHookList.Items[i]); - if (msg.Dest = oItem.Dest) and (msg.MsgCode = oItem.MsgCode) then - oItem.Listener.Dispatch(msg); - end; + oItem := TMsgHookItem(fpgApplication.FMessageHookList.Items[i]); + if (msg.Dest = oItem.Dest) and (msg.MsgCode = oItem.MsgCode) then + oItem.Listener.Dispatch(msg); end; -// except -// on E: Exception do -// {$IFDEF DEBUG}writeln('fpgDeliverMessage Caught Exception: ' + E.Message){$ENDIF}; -// end; + end; end; end; diff --git a/src/corelib/fpg_pofiles.pas b/src/corelib/fpg_pofiles.pas index 8e683379..5f8ff7bc 100644 --- a/src/corelib/fpg_pofiles.pas +++ b/src/corelib/fpg_pofiles.pas @@ -1,7 +1,7 @@ { - fpGUI - Free Pascal GUI Library + fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2010 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/corelib/fpg_popupwindow.pas b/src/corelib/fpg_popupwindow.pas index fe7ef9d6..fdb78b66 100644 --- a/src/corelib/fpg_popupwindow.pas +++ b/src/corelib/fpg_popupwindow.pas @@ -1,7 +1,7 @@ { - fpGUI - Free Pascal GUI Library + fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -43,15 +43,16 @@ type procedure SetPopupFrame(const AValue: boolean); protected procedure MsgClose(var msg: TfpgMessageRec); message FPGM_CLOSE; - procedure AdjustWindowStyle; override; procedure HandleClose; virtual; procedure HandleShow; override; + procedure HandlePaint; override; procedure ProcessPopupFrame; virtual; procedure DoPaintPopupFrame; virtual; procedure DoOnClose; virtual; procedure DoOnShow; virtual; public constructor Create(AOwner: TComponent); override; + procedure AdjustWindowStyle; override; procedure ShowAt(AWidget: TfpgWidget; x, y: TfpgCoord); overload; procedure ShowAt(x, y: TfpgCoord); overload; procedure Close; virtual; @@ -241,6 +242,13 @@ begin DoOnShow; end; +procedure TfpgPopupWindow.HandlePaint; +begin + inherited HandlePaint; + if PopupFrame then + DoPaintPopupFrame; +end; + procedure TfpgPopupWindow.ProcessPopupFrame; var i: integer; @@ -263,10 +271,7 @@ begin end; HandleResize(Width+2, Height+2); UpdateWindowPosition; - - Canvas.BeginDraw; - DoPaintPopupFrame; - Canvas.EndDraw; + Repaint; end; end; @@ -337,11 +342,6 @@ procedure TfpgPopupWindow.Close; begin HandleClose; PopupListRemove(self); - { TODO : Move this out to the GDI specific unit. } - {$IFDEF MSWINDOWS} - if uFirstPopup <> nil then - uFirstPopup^.Widget.CaptureMouse; - {$ENDIF} end; diff --git a/src/corelib/fpg_stdimages.pas b/src/corelib/fpg_stdimages.pas index 07b5f338..2682ce3f 100644 --- a/src/corelib/fpg_stdimages.pas +++ b/src/corelib/fpg_stdimages.pas @@ -1,7 +1,7 @@ { - fpGUI - Free Pascal GUI Library + fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -102,6 +102,11 @@ begin @stdimg_checkboxes, sizeof(stdimg_checkboxes)); + fpgImages.AddMaskedBMP( + 'stdimg.ellipse', + @stdimg_ellipse, + sizeof(stdimg_ellipse), 0,0); + // General purpose images: fpgImages.AddMaskedBMP( @@ -145,6 +150,11 @@ begin sizeof(stdimg_menu_preferences_16), 0,0); fpgImages.AddMaskedBMP( + 'stdimg.check', + @stdimg_menu_check_16, + sizeof(stdimg_menu_check_16), 0,0); + + fpgImages.AddMaskedBMP( 'stdimg.document', @stdimg_document, sizeof(stdimg_document), 0,0); @@ -210,6 +220,11 @@ begin sizeof(stdimg_folder_up_16), 0,0); fpgImages.AddMaskedBMP( + 'stdimg.folderfile', + @stdimg_folder_open_file_16, + sizeof(stdimg_folder_open_file_16), 0,0); + + fpgImages.AddMaskedBMP( 'stdimg.open', @stdimg_folder_open_16, sizeof(stdimg_folder_open_16), 0,0); diff --git a/src/corelib/fpg_stringhashlist.pas b/src/corelib/fpg_stringhashlist.pas index 15bd36fd..21b6af16 100644 --- a/src/corelib/fpg_stringhashlist.pas +++ b/src/corelib/fpg_stringhashlist.pas @@ -1,7 +1,7 @@ { - fpGUI - Free Pascal GUI Library + fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2010 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/corelib/fpg_strings.pas b/src/corelib/fpg_strings.pas index 180910d7..3bb22ec3 100644 --- a/src/corelib/fpg_strings.pas +++ b/src/corelib/fpg_strings.pas @@ -1,7 +1,7 @@ { - fpGUI - Free Pascal GUI Library + fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2010 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/corelib/fpg_stringutils.pas b/src/corelib/fpg_stringutils.pas index d3f9b9a3..f97f1b61 100644 --- a/src/corelib/fpg_stringutils.pas +++ b/src/corelib/fpg_stringutils.pas @@ -1,7 +1,7 @@ { - fpGUI - Free Pascal GUI Library + fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2009 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -46,6 +46,8 @@ procedure Delete8(var S: string; Index, Size: integer); procedure Insert8(const Source: string; var S: string; Index: integer); function fpgCharAt(const s: TfpgString; Index: integer): TfpgChar; +function fpgAppendPathDelim(const Path: TfpgString): TfpgString; +function fpgRemovePathDelim(const Path: TfpgString): TfpgString; implementation @@ -317,6 +319,21 @@ begin Result := UTF8Copy(s, Index, 1); end; +function fpgAppendPathDelim(const Path: TfpgString): TfpgString; +begin + if (Path <> '') and (Path[Length(Path)] <> PathDelim) then + Result := Path + PathDelim + else + Result := Path; +end; + +function fpgRemovePathDelim(const Path: TfpgString): TfpgString; +begin + if (Path <> '') and (Path[Length(Path)] = PathDelim) then + Result := LeftStr(Path, Length(Path)-1) + else + Result := Path; +end; end. diff --git a/src/corelib/fpg_translations.pas b/src/corelib/fpg_translations.pas index b4be413f..996387c7 100644 --- a/src/corelib/fpg_translations.pas +++ b/src/corelib/fpg_translations.pas @@ -1,7 +1,7 @@ { - fpGUI - Free Pascal GUI Library + fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -26,6 +26,7 @@ interface uses Classes ,SysUtils + ,fpg_base ; @@ -57,6 +58,7 @@ type procedure TranslateResourceStrings(const BaseAppName, BaseDirectory, CustomLang: string); +function fpgMatchLocale(const ALanguageID: TfpgString): boolean; implementation @@ -157,15 +159,27 @@ begin end; // Strip the '.' onwards part. eg: en_ZA.UTF-8 -> en_ZA -procedure FixLanguageIDs; +procedure FixLanguageIDs(var ALanguageID: TfpgString); var lpos: integer; begin - lpos := Pos('.', SystemLanguageID1); + lpos := Pos('.', ALanguageID); if lpos > 0 then - SystemLanguageID1 := Copy(SystemLanguageID1, 0, lpos-1); + ALanguageID := Copy(ALanguageID, 0, lpos-1); end; +function fpgMatchLocale(const ALanguageID: TfpgString): boolean; +var + s: TfpgString; +begin + s := ALanguageID; + FixLanguageIDs(s); + Result := s = SystemLanguageID1; + if not Result then + Result := s = SystemLanguageID2; +end; + + { TTranslationList } function TTranslationList.GetItems(Index: integer): TTranslation; @@ -213,7 +227,7 @@ end; initialization TranslationList := nil; GetLanguageIDs(SystemLanguageID1, SystemLanguageID2); - FixLanguageIDs; + FixLanguageIDs(SystemLanguageID1); finalization TranslationList.Free; diff --git a/src/corelib/fpg_utils.pas b/src/corelib/fpg_utils.pas index c583494e..d4d7886c 100644 --- a/src/corelib/fpg_utils.pas +++ b/src/corelib/fpg_utils.pas @@ -1,7 +1,7 @@ { - fpGUI - Free Pascal GUI Library + fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2009 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -54,6 +54,9 @@ function fpgFileExists(const FileName: TfpgString): Boolean; function fpgDirectoryExists(const ADirectory: TfpgString): Boolean; function fpgExtractFileDir(const FileName: TfpgString): TfpgString; function fpgExtractFilePath(const FileName: TfpgString): TfpgString; +function fpgExtractFileName(const FileName: TfpgString): TfpgString; +function fpgExtractFileExt(const FileName: TfpgString): TfpgString; +function fpgForceDirectories(const ADirectory: TfpgString): Boolean; implementation @@ -132,6 +135,21 @@ begin Result := ExtractFilePath(fpgToOSEncoding(Filename)); end; +function fpgExtractFileName(const FileName: TfpgString): TfpgString; +begin + Result := ExtractFileName(fpgToOSEncoding(Filename)); +end; + +function fpgExtractFileExt(const FileName: TfpgString): TfpgString; +begin + Result := ExtractFileExt(fpgToOSEncoding(Filename)); +end; + +function fpgForceDirectories(const ADirectory: TfpgString): Boolean; +begin + Result := ForceDirectories(fpgToOSEncoding(ADirectory)); +end; + function fpgAppendPathDelim(const Path: TfpgString): TfpgString; begin if (Path <> '') and (Path[length(Path)] <> PathDelim) then @@ -180,12 +198,8 @@ end; function fpgAllFilesMask: TfpgString; begin - {$Note In FPC 2.2.2 onwards we can use AllFilesMask which is part of RTL } - {$IFDEF WINDOWS} - Result := '*.*'; - {$ELSE} - Result := '*'; - {$ENDIF} + { Since FPC 2.2.2 we have the AllFilesMask variable, which is part of the RTL } + Result := AllFilesMask; end; function fpgConvertLineEndings(const s: TfpgString): TfpgString; diff --git a/src/corelib/fpg_widget.pas b/src/corelib/fpg_widget.pas index f844907e..39bb4193 100644 --- a/src/corelib/fpg_widget.pas +++ b/src/corelib/fpg_widget.pas @@ -1,7 +1,7 @@ { - fpGUI - Free Pascal GUI Library + fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -32,6 +32,8 @@ uses type TFocusSearchDirection = (fsdFirst, fsdLast, fsdNext, fsdPrev); + THintEvent = procedure(Sender: TObject; var AHint: TfpgString) of object; + TfpgWidget = class(TfpgWindow) private @@ -49,8 +51,10 @@ type FOnKeyPress: TKeyPressEvent; FOnResize: TNotifyEvent; FOnScreen: boolean; + FOnShowHint: THintEvent; procedure SetActiveWidget(const AValue: TfpgWidget); function IsShowHintStored: boolean; + procedure SetFormDesigner(const AValue: TObject); protected procedure MsgPaint(var msg: TfpgMessageRec); message FPGM_PAINT; procedure MsgResize(var msg: TfpgMessageRec); message FPGM_RESIZE; @@ -75,12 +79,14 @@ type FAnchors: TAnchors; FActiveWidget: TfpgWidget; FAlign: TAlign; - FHint: string; + FHint: TfpgString; FShowHint: boolean; FParentShowHint: boolean; FBackgroundColor: TfpgColor; FTextColor: TfpgColor; FIsContainer: Boolean; + function GetOnShowHint: THintEvent; virtual; + procedure SetOnShowHint(const AValue: THintEvent); virtual; procedure SetBackgroundColor(const AValue: TfpgColor); virtual; procedure SetTextColor(const AValue: TfpgColor); virtual; function GetParent: TfpgWidget; reintroduce; @@ -89,9 +95,12 @@ type procedure SetVisible(const AValue: boolean); virtual; procedure SetShowHint(const AValue: boolean); virtual; procedure SetParentShowHint(const AValue: boolean); virtual; + function GetHint: TfpgString; virtual; + procedure SetHint(const AValue: TfpgString); virtual; procedure DoUpdateWindowPosition; override; procedure DoAlign(AAlign: TAlign); procedure DoResize; + procedure DoShowHint(var AHint: TfpgString); procedure HandlePaint; virtual; procedure HandleKeyChar(var AText: TfpgChar; var shiftstate: TShiftState; var consumed: boolean); virtual; procedure HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: boolean); virtual; @@ -127,19 +136,22 @@ type property OnMouseUp: TMouseButtonEvent read FOnMouseUp write FOnMouseUp; property OnPaint: TPaintEvent read FOnPaint write FOnPaint; property OnResize: TNotifyEvent read FOnResize write FOnResize; + property OnShowHint: THintEvent read GetOnShowHint write SetOnShowHint; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; + procedure AfterConstruction; override; function GetClientRect: TfpgRect; virtual; function GetBoundsRect: TfpgRect; virtual; function InDesigner: boolean; + procedure InvokeHelp; virtual; procedure Realign; procedure SetFocus; 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???? - property FormDesigner: TObject read FFormDesigner write FFormDesigner; + property FormDesigner: TObject read FFormDesigner write SetFormDesigner; property Parent: TfpgWidget read GetParent write SetParent; property ActiveWidget: TfpgWidget read FActiveWidget write SetActiveWidget; property IsContainer: Boolean read FIsContainer; @@ -151,7 +163,7 @@ type property Focused: boolean read FFocused write FFocused default False; property Anchors: TAnchors read FAnchors write FAnchors; property Align: TAlign read FAlign write FAlign; - property Hint: string read FHint write FHint; + property Hint: TfpgString read GetHint write SetHint; property ShowHint: boolean read FShowHint write SetShowHint stored IsShowHintStored; property ParentShowHint: boolean read FParentShowHint write SetParentShowHint default True; property BackgroundColor: TfpgColor read FBackgroundColor write SetBackgroundColor default clWindowBackground; @@ -169,7 +181,7 @@ implementation uses fpg_constants, - fpg_hint; + fpg_menu; var @@ -203,7 +215,7 @@ begin for i := 0 to ComponentCount - 1 do begin if Components[i] is TfpgWidget then - TfpgWidget(Components[i]).Enabled := self.Enabled; + TfpgWidget(Components[i]).Enabled := FEnabled; end; RePaint; end; @@ -212,7 +224,7 @@ procedure TfpgWidget.SetActiveWidget(const AValue: TfpgWidget); begin if FActiveWidget = AValue then Exit; //==> - if FFormDesigner <> nil then + if InDesigner then Exit; //==> if FActiveWidget <> nil then @@ -222,11 +234,28 @@ begin FActiveWidget.HandleSetFocus; end; +function TfpgWidget.GetHint: TfpgString; +begin + Result := FHint; +end; + function TfpgWidget.IsShowHintStored: boolean; begin Result := not ParentShowHint; end; +procedure TfpgWidget.SetFormDesigner(const AValue: TObject); +var + i: integer; +begin + FFormDesigner := AValue; + for i := 0 to ComponentCount-1 do + begin + if (Components[i] is TfpgWidget) and (TfpgWidget(Components[i]).Parent = self) then + TfpgWidget(Components[i]).FormDesigner := AValue; + end; +end; + procedure TfpgWidget.SetVisible(const AValue: boolean); begin if FVisible = AValue then @@ -234,9 +263,13 @@ begin FVisible := AValue; if FOnScreen then if FVisible then - HandleShow + begin +// writeln('DEBUG: TfpgWidget.SetVisible - handleshow'); + HandleShow; + end else begin +// writeln('DEBUG: TfpgWidget.SetVisible - handlehide'); HandleHide; FOnScreen := True; end; @@ -258,6 +291,11 @@ begin FShowHint := False; end; +procedure TfpgWidget.SetHint(const AValue: TfpgString); +begin + FHint := AValue; +end; + procedure TfpgWidget.DoUpdateWindowPosition; var dw: integer; @@ -318,6 +356,28 @@ begin Result := (FFormDesigner <> nil) end; +procedure TfpgWidget.InvokeHelp; +begin + case HelpType of + htKeyword: + if HelpKeyword <> '' then + begin + fpgApplication.KeywordHelp(HelpKeyword); + Exit; //==> + end; + htContext: + if HelpContext <> 0 then + begin + fpgApplication.ContextHelp(HelpContext); + Exit; //==> + end; + end; + if Parent <> nil then + Parent.InvokeHelp + else + fpgApplication.InvokeHelp; +end; + procedure TfpgWidget.Realign; begin HandleAlignments(0, 0); @@ -358,6 +418,8 @@ begin FBackgroundColor := clWindowBackground; FTextColor := clText1; + inherited Create(AOwner); + if (AOwner <> nil) and (AOwner is TfpgWidget) then begin Parent := TfpgWidget(AOwner); @@ -371,28 +433,30 @@ begin FWindowType := wtChild; FShowHint := Parent.ShowHint; end; +end; - inherited Create(AOwner); +destructor TfpgWidget.Destroy; +begin + {$IFDEF DEBUG} + writeln('TfpgWidget.Destroy [', Classname, '.', Name, ']'); + {$ENDIF} + HandleHide; + inherited Destroy; +end; +procedure TfpgWidget.AfterConstruction; +begin + inherited AfterConstruction; // This is for components that are created at runtime, after it's // parent has already been shown. if (Parent <> nil) and (Parent.HasHandle) then begin - InternalHandleShow; + HandleShow; end; Loaded; // remove csLoading from ComponentState end; -destructor TfpgWidget.Destroy; -begin - {$IFDEF DEBUG} - writeln('TfpgWidget.Destroy [', Classname, ']'); - {$ENDIF} - HandleHide; - inherited; -end; - procedure TfpgWidget.MsgKeyChar(var msg: TfpgMessageRec); var lChar: TfpgChar; @@ -424,7 +488,7 @@ var consumed: boolean; wg: TfpgWidget; begin - if FFormDesigner <> nil then + if InDesigner then begin FFormDesigner.Dispatch(msg); if msg.Stop then @@ -454,7 +518,7 @@ var consumed: boolean; wg: TfpgWidget; begin - if FFormDesigner <> nil then + if InDesigner then begin FFormDesigner.Dispatch(msg); if msg.Stop then @@ -481,7 +545,7 @@ procedure TfpgWidget.MsgMouseDown(var msg: TfpgMessageRec); var mb: TMouseButton; begin - if FFormDesigner <> nil then + if InDesigner then begin // dispatching message to designer FFormDesigner.Dispatch(msg); @@ -521,7 +585,7 @@ var IsDblClick: boolean; begin // writeln('TfpgWidget.MsgMouseUp'); - if FFormDesigner <> nil then + if InDesigner then begin FFormDesigner.Dispatch(msg); if msg.Stop then @@ -578,7 +642,7 @@ end; procedure TfpgWidget.MsgMouseMove(var msg: TfpgMessageRec); begin - if FFormDesigner <> nil then + if InDesigner then begin FFormDesigner.Dispatch(msg); if msg.Stop then @@ -611,7 +675,7 @@ begin {$IFDEF DEBUG} writeln('MsgMouseEnter'); {$ENDIF} - if FFormDesigner <> nil then + if InDesigner then begin FFormDesigner.Dispatch(msg); if msg.Stop then @@ -628,7 +692,7 @@ begin {$IFDEF DEBUG} writeln('MsgMouseExit'); {$ENDIF} - if FFormDesigner <> nil then + if InDesigner then begin FFormDesigner.Dispatch(msg); if msg.Stop then @@ -646,33 +710,43 @@ begin msg.Params.mouse.shiftstate, msg.Params.mouse.delta); end; +function TfpgWidget.GetOnShowHint: THintEvent; +begin + Result := FOnShowHint; +end; + +procedure TfpgWidget.SetOnShowHint(const AValue: THintEvent); +begin + FOnShowHint := AValue; +end; + procedure TfpgWidget.HandleShow; var n: integer; c: TComponent; begin -// writeln('Widget.HandleShow - ', ClassName, ' x:', Left, ' y:', Top, ' w:', Width, ' h:', Height); FOnScreen := True; -// FVisible := True; - AllocateWindowHandle; DoSetWindowVisible(FVisible); for n := 0 to ComponentCount - 1 do begin c := Components[n]; - if (c is TfpgWidget) and (TfpgWidget(c).Parent = self) and - (TfpgWidget(c).FOnScreen = False) then - TfpgWidget(c).HandleShow; + if (c is TfpgWidget) and (TfpgWidget(c).Parent = self) then + begin + if not (c is TfpgPopupMenu) then // these should not be created yet + begin + TfpgWidget(c).HandleShow; + end; + end; end; end; procedure TfpgWidget.InternalHandleShow; begin FOnScreen := True; - FVisible := False; AllocateWindowHandle; - DoSetWindowVisible(False); + DoSetWindowVisible(FVisible); end; procedure TfpgWidget.HandleHide; @@ -955,8 +1029,8 @@ begin if Components[n] is TfpgWidget then begin w := TfpgWidget(Components[n]); - - if w.Visible and w.Enabled and w.Focusable then + if w.Enabled and w.Visible and w.Focusable then + begin case direction of fsdFirst: if w.TabOrder < lasttaborder then @@ -976,6 +1050,7 @@ begin if startwg = w then FoundIt := True else if w.TabOrder < lasttaborder then + begin if (startwg = nil) or (w.TabOrder > startwg.TabOrder) or (FoundIt and (w.TabOrder = startwg.TabOrder)) then @@ -983,7 +1058,7 @@ begin Result := w; lasttaborder := w.TabOrder; end; - + end; fsdPrev: if startwg = w then FoundIt := True @@ -996,7 +1071,8 @@ begin lasttaborder := w.TabOrder; end; - end; + end; { case } + end; { if w.Enabled... } end; end; @@ -1019,7 +1095,7 @@ begin dh := msg.Params.rect.Height - FHeight; HandleResize(msg.Params.rect.Width, msg.Params.rect.Height); HandleAlignments(dw, dh); - if FFormDesigner <> nil then + if InDesigner then begin FFormDesigner.Dispatch(msg); end; @@ -1029,7 +1105,7 @@ end; procedure TfpgWidget.MsgMove(var msg: TfpgMessageRec); begin HandleMove(msg.Params.rect.Left, msg.Params.rect.Top); - if FFormDesigner <> nil then + if InDesigner then begin FFormDesigner.Dispatch(msg); end; @@ -1150,7 +1226,7 @@ begin if Components[n] is TfpgWidget then begin w := TfpgWidget(Components[n]); - if w.Align = AAlign then + if (w.Align = AAlign) and (w.Visible) then alist.Add(w); end; @@ -1160,7 +1236,7 @@ begin for n := 0 to alist.Count - 1 do begin w := TfpgWidget(alist[n]); - case aalign of + case AAlign of alTop: begin w.MoveAndResize(FAlignRect.Left, FAlignRect.Top, FAlignRect.Width, w.Height); @@ -1201,6 +1277,15 @@ begin FOnResize(Self); end; +procedure TfpgWidget.DoShowHint(var AHint: TfpgString); +begin + AHint := Hint; + if Assigned(FOnShowHint) then + begin + FOnShowHint(self, AHint); + end; +end; + procedure TfpgWidget.SetPosition(aleft, atop, awidth, aheight: TfpgCoord); begin MoveAndResize(aleft, atop, awidth, aheight); diff --git a/src/corelib/fpg_wuline.pas b/src/corelib/fpg_wuline.pas index 1f159d08..cfed0a73 100644 --- a/src/corelib/fpg_wuline.pas +++ b/src/corelib/fpg_wuline.pas @@ -1,7 +1,7 @@ { - fpGUI - Free Pascal GUI Library + fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -44,7 +44,7 @@ type // Blend a pixel with the current colour procedure AlphaBlendPixel(ACanvas: TfpgCanvas; X, Y: integer; R, G, B: word; ARatio: Double); var - LBack, LNew: TRGBTriple; + LBack, LNew: TFPColor; LMinusRatio: Double; begin if (X < 0) or (X > TCanvasHack(ACanvas).FWindow.Width - 1) or (Y < 0) or @@ -52,11 +52,11 @@ begin Exit; // clipping LMinusRatio := 1 - ARatio; - LBack := fpgColorToRGBTriple(ACanvas.Pixels[X, Y]); + LBack := fpgColorToFPColor(ACanvas.Pixels[X, Y]); LNew.Blue := round(B*ARatio + LBack.Blue*LMinusRatio); LNew.Green := round(G*ARatio + LBack.Green*LMinusRatio); LNew.Red := round(R*ARatio + LBack.Red*LMinusRatio); - ACanvas.Pixels[X, Y] := RGBTripleTofpgColor(LNew); + ACanvas.Pixels[X, Y] := FPColorTofpgColor(LNew); end; // Draw a anti-aliased line diff --git a/src/corelib/gdi/fpg_gdi.pas b/src/corelib/gdi/fpg_gdi.pas index fd6aa6d6..e242bfb6 100644 --- a/src/corelib/gdi/fpg_gdi.pas +++ b/src/corelib/gdi/fpg_gdi.pas @@ -1,7 +1,7 @@ { - fpGUI - Free Pascal GUI Library + fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -13,6 +13,10 @@ Description: This defines the CoreLib backend interface to the Windows GDI API. + + Win32 API Reference - http://msdn.microsoft.com/en-us/library/ff468919(VS.85).aspx + Windows CE 3.0 API Reference - http://msdn.microsoft.com/en-us/library/ms925466.aspx + FPC WinCE information - http://wiki.freepascal.org/WinCE_port } unit fpg_gdi; @@ -44,12 +48,11 @@ var FontSmoothingType: Cardinal; type - // forward declaration - TfpgWindowImpl = class; + TfpgGDIWindow = class; - TfpgFontResourceImpl = class(TfpgFontResourceBase) + TfpgGDIFontResource = class(TfpgFontResourceBase) private FFontData: HFONT; FMetrics: Windows.TEXTMETRIC; @@ -67,11 +70,7 @@ type end; - TfpgFontImpl = class(TfpgFontBase) - end; - - - TfpgImageImpl = class(TfpgImageBase) + TfpgGDIImage = class(TfpgImageBase) private FBMPHandle: HBITMAP; FMaskHandle: HBITMAP; @@ -87,18 +86,16 @@ type end; - { TfpgCanvasImpl } - - TfpgCanvasImpl = class(TfpgCanvasBase) + TfpgGDICanvas = class(TfpgCanvasBase) private FDrawing: boolean; FBufferBitmap: HBitmap; - FDrawWindow: TfpgWindowImpl; + FDrawWindow: TfpgGDIWindow; Fgc: TfpgDCHandle; FBufgc: TfpgDCHandle; FWinGC: TfpgDCHandle; FBackgroundColor: TfpgColor; - FCurFontRes: TfpgFontResourceImpl; + FCurFontRes: TfpgGDIFontResource; FClipRect: TfpgRect; FClipRectSet: Boolean; FWindowsColor: longword; @@ -141,18 +138,18 @@ type end; - TfpgWindowImpl = class(TfpgWindowBase) + TfpgGDIWindow = class(TfpgWindowBase) private FMouseInWindow: boolean; FNonFullscreenRect: TfpgRect; FNonFullscreenStyle: longword; FFullscreenIsSet: boolean; FSkipResizeMessage: boolean; - function DoMouseEnterLeaveCheck(AWindow: TfpgWindowImpl; uMsg, wParam, lParam: Cardinal): Boolean; + function DoMouseEnterLeaveCheck(AWindow: TfpgGDIWindow; uMsg, wParam, lParam: Cardinal): Boolean; procedure WindowSetFullscreen(aFullScreen, aUpdate: boolean); protected FWinHandle: TfpgWinHandle; - FModalForWin: TfpgWindowImpl; + FModalForWin: TfpgGDIWindow; FWinStyle: longword; FWinStyleEx: longword; FParentWinHandle: TfpgWinHandle; @@ -177,7 +174,7 @@ type end; - TfpgApplicationImpl = class(TfpgApplicationBase) + TfpgGDIApplication = class(TfpgApplicationBase) protected FDisplay: HDC; WindowClass: TWndClass; @@ -220,7 +217,7 @@ type end; - TfpgClipboardImpl = class(TfpgClipboardBase) + TfpgGDIClipboard = class(TfpgClipboardBase) protected FClipboardText: TfpgString; function DoGetText: TfpgString; override; @@ -229,7 +226,7 @@ type end; - TfpgFileListImpl = class(TfpgFileListBase) + TfpgGDIFileList = class(TfpgFileListBase) function EncodeAttributesString(attrs: longword): TFileModeString; constructor Create; override; function InitializeEntry(sr: TSearchRec): TFileEntry; override; @@ -257,6 +254,37 @@ var // some required keyboard functions {$INCLUDE fpg_keys_gdi.inc} +{$IFDEF wince} +// A few tweaks to get fpGUI working on the Symbol MC1000 WinCE 4.2 +// *** Need to fix the hack in procedure TfpgWindowImpl.DoAllocateWindowHandle + +const + CS_OWNDC = 0; + WS_OVERLAPPEDWINDOW = WS_VISIBLE; + WS_POPUPWINDOW = 0; + WS_EX_APPWINDOW = 0; + +// From Lazarus wince\winext.pas: +function GET_X_LPARAM(lp : Windows.LParam) : longint; + begin + result:=smallint(LOWORD(lp)); + end; +function GET_Y_LPARAM(lp : Windows.LParam) : longint; + begin + result:=smallint(HIWORD(lp)); + end; + +// *** copied from Lazarus +function MulDiv(nNumber, nNumerator, nDenominator: Integer): Integer; +begin + if nDenominator = 0 then + Result := -1 + else +// Result := MathRound( int64(nNumber) * int64(nNumerator) / nDenominator); + Result := Round( int64(nNumber) * int64(nNumerator) / nDenominator); +end; +{$ENDIF} + function fpgColorToWin(col: TfpgColor): longword; var c: dword; @@ -387,15 +415,23 @@ end; // returns true when the operating system is windows 2000 or newer function IsWin2kOrLater: Boolean; begin + {$IFDEF WinCE} + Result := false; + {$ELSE} Result := (Win32Platform = VER_PLATFORM_WIN32_NT) and (Win32MajorVersion >= 5); + {$ENDIF} end; // returns true when the operating system is windows XP or newer function IsWinXPOrLater: Boolean; begin + {$IFDEF WinCE} + Result := false; + {$ELSE} Result := (Win32Platform = VER_PLATFORM_WIN32_NT) and (((Win32MajorVersion = 5) and (Win32MinorVersion >= 1)) or ((Win32MajorVersion >= 6) and (Win32MinorVersion >= 0))); + {$ENDIF} end; function WinkeystateToShiftstate(keystate: cardinal): TShiftState; @@ -412,6 +448,32 @@ begin end; end; +{$IFDEF wince} +procedure WinCESetDibBits(BMP: HBITMAP; awidth, aheight: Integer; aimgdata: Pointer; var bi: TBitmapInfo); +var + hdcSrc, hdcDest: HDC; + hbmSrc: HBITMAP; + bm: BITMAP; +begin + hdcDest:= CreateCompatibleDC(0); + SelectObject(hdcDest, BMP); + if bi.bmiHeader.biBitCount = 1 then + begin + SetDIBitsToDevice(hdcDest, 0, 0, awidth, aheight, 0, 0, 0, aheight, aimgdata, bi, DIB_RGB_COLORS); + end + else + begin + hdcSrc:= CreateCompatibleDC(0); + hbmSrc:= CreateBitmap(awidth, aheight, 1, bi.bmiHeader.biBitCount, aimgdata); + SelectObject(hdcSrc, hbmSrc); + BitBlt(hdcDest, 0, 0, awidth, aheight, hdcSrc, 0, 0, SRCCOPY); + DeleteDC(hdcSrc); + DeleteObject(hbmSrc); + end; + DeleteDC(hdcDest); +end; +{$ENDIF} + procedure GetWindowBorderDimensions(const w: TfpgWindowBase; var dx, dy: integer); var bx: integer; // left/right border width @@ -455,10 +517,10 @@ begin begin // write('Hooked HCBT_ACTIVATE at '+IntToStr(wParam)+': '); if (wapplication.TopModalForm <> nil) and - (wParam <> TfpgWindowImpl(wapplication.TopModalForm).FWinHandle) then + (wParam <> TfpgGDIWindow(wapplication.TopModalForm).FWinHandle) then begin // writeln('stopped'); - SetActiveWindow(TfpgWindowImpl(wapplication.TopModalForm).FWinHandle); + SetActiveWindow(TfpgGDIWindow(wapplication.TopModalForm).FWinHandle); Result := 1; end else begin @@ -471,10 +533,10 @@ end; function fpgWindowProc(hwnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; var - w: TfpgWindowImpl; - pw: TfpgWindowImpl; + w: TfpgGDIWindow; + pw: TfpgGDIWindow; kwg: TfpgWidget; - mw: TfpgWindowImpl; + mw: TfpgGDIWindow; kcode: integer; i: integer; sstate: integer; @@ -487,6 +549,7 @@ var mcode: integer; wmsg: TMsg; PaintStruct: TPaintStruct; + TmpW: widestring; //------------ procedure SetMinMaxInfo(var MinMaxInfo: TMINMAXINFO); @@ -525,7 +588,7 @@ var begin if uMsg = WM_CREATE then begin - w := TfpgWindowImpl(PCreateStruct(lParam)^.lpCreateParams); + w := TfpgGDIWindow(PCreateStruct(lParam)^.lpCreateParams); w.FWinHandle := hwnd; // this is very important, because number of messages sent // before the createwindow returns the window handle Windows.SetWindowLong(hwnd, GWL_USERDATA, longword(w)); @@ -563,10 +626,10 @@ begin Exit; //==> end; - w := TfpgWindowImpl(Windows.GetWindowLong(hwnd, GWL_USERDATA)); + w := TfpgGDIWindow(Windows.GetWindowLong(hwnd, GWL_USERDATA)); Result := 0; - if not (w is TfpgWindowImpl) then + if not (w is TfpgGDIWindow) then begin {$IFDEF DEBUG} writeln('fpGFX/GDI: Unable to detect Window - using DefWindowProc'); {$ENDIF} Result := Windows.DefWindowProc(hwnd, uMsg, wParam, lParam); @@ -621,7 +684,8 @@ begin fpgSendMessage(nil, w, FPGM_KEYRELEASE, msgp) else if uMsg = WM_CHAR then begin - msgp.keyboard.keychar := UTF8Encode(WideChar(wParam)); + tmpW := WideChar(wParam); + msgp.keyboard.keychar := UTF8Encode(tmpW); fpgSendMessage(nil, w, FPGM_KEYCHAR, msgp); end; @@ -692,7 +756,7 @@ begin mw := GetMyWidgetFromHandle(h); pw := mw; while (pw <> nil) and (pw.Parent <> nil) do - pw := TfpgWindowImpl(pw.Parent); + pw := TfpgGDIWindow(pw.Parent); if ((pw = nil) or (PopupListFind(pw.WinHandle) = nil)) and (not PopupDontCloseWidget(TfpgWidget(mw))) and @@ -706,7 +770,7 @@ begin if (wapplication.TopModalForm <> nil) then begin mw := nil; - mw := TfpgWindowImpl(WidgetParentForm(TfpgWidget(w))); + mw := TfpgGDIWindow(WidgetParentForm(TfpgWidget(w))); if (mw <> nil) and (wapplication.TopModalForm <> mw) then blockmsg := True; end; @@ -852,9 +916,9 @@ begin mw := nil; h := WindowFromPoint(pt); if h > 0 then // get window mouse is hovering over - mw := TfpgWindowImpl(Windows.GetWindowLong(h, GWL_USERDATA)); + mw := TfpgGDIWindow(Windows.GetWindowLong(h, GWL_USERDATA)); - if (mw is TfpgWindowImpl) then + if (mw is TfpgGDIWindow) then begin msgp.mouse.x := pt.x; msgp.mouse.y := pt.y; @@ -960,11 +1024,16 @@ begin end; end; -{ TfpgApplicationImpl } +{ TfpgGDIApplication } // helper function for DoGetFontFaceList +{$IFDEF wince} +function MyFontEnumerator(var LogFont: ENUMLOGFONT; var TextMetric: NEWTEXTMETRIC; + FontType: Integer; data: LPARAM): Integer; CDecl; +{$ELSE} function MyFontEnumerator(var LogFont: ENUMLOGFONTEX; var TextMetric: NEWTEXTMETRICEX; FontType: Integer; data: LPARAM): Integer; stdcall; +{$ENDIF} var sl: TStringList; s: string; @@ -976,18 +1045,22 @@ begin Result := 1; end; -function TfpgApplicationImpl.DoGetFontFaceList: TStringList; +function TfpgGDIApplication.DoGetFontFaceList: TStringList; var LFont: TLogFont; begin Result := TStringList.Create; FillChar(LFont, sizeof(LFont), 0); LFont.lfCharset := DEFAULT_CHARSET; + {$IFDEF wince} + EnumFontFamiliesW(Display, @LFont, @MyFontEnumerator, LongInt(result)); + {$ELSE} EnumFontFamiliesEx(Display, @LFont, @MyFontEnumerator, LongInt(result), 0); + {$ENDIF} Result.Sort; end; -function TfpgApplicationImpl.GetHiddenWindow: HWND; +function TfpgGDIApplication.GetHiddenWindow: HWND; begin if (FHiddenWindow = 0) then begin @@ -1004,12 +1077,12 @@ begin Windows.RegisterClass(@HiddenWndClass); FHiddenWindow := CreateWindow('FPGHIDDEN', '', - DWORD(WS_POPUP), 0, 0, 0, 0, TfpgWindowImpl(MainForm).FWinHandle, 0, MainInstance, nil); + DWORD(WS_POPUP), 0, 0, 0, 0, TfpgGDIWindow(MainForm).FWinHandle, 0, MainInstance, nil); end; Result := FHiddenWindow; end; -constructor TfpgApplicationImpl.Create(const AParams: string); +constructor TfpgGDIApplication.Create(const AParams: string); begin inherited Create(AParams); FIsInitialized := False; @@ -1062,20 +1135,20 @@ begin wapplication := TfpgApplication(self); end; -destructor TfpgApplicationImpl.Destroy; +destructor TfpgGDIApplication.Destroy; begin UnhookWindowsHookEx(ActivationHook); inherited Destroy; end; -function TfpgApplicationImpl.DoMessagesPending: boolean; +function TfpgGDIApplication.DoMessagesPending: boolean; var Msg: TMsg; begin Result := Windows.PeekMessageW(@Msg, 0, 0, 0, PM_NOREMOVE); end; -procedure TfpgApplicationImpl.DoWaitWindowMessage(atimeoutms: integer); +procedure TfpgGDIApplication.DoWaitWindowMessage(atimeoutms: integer); var Msg: TMsg; timerid: longword; @@ -1084,7 +1157,7 @@ var begin timerid := 0; if Assigned(wapplication.MainForm) then - ltimerWnd := TfpgWindowImpl(wapplication.MainForm).WinHandle + ltimerWnd := TfpgGDIWindow(wapplication.MainForm).WinHandle else ltimerWnd := 0; @@ -1096,11 +1169,15 @@ begin Exit; // handling waiting timeout end; - {$Note Incorporate Felipe's code from previous fpGUI in here. It handles WinCE and Windows just fine. } + {$IFDEF WinCE} + // No GetVersion + Windows.GetMessageW(@Msg, 0, 0, 0); //NT + {$ELSE} if (GetVersion() < $80000000) then Windows.GetMessageW(@Msg, 0, 0, 0) //NT else Windows.GetMessage(@Msg, 0, 0, 0); //Win98 + {$ENDIF} Windows.DispatchMessage(@msg); @@ -1108,12 +1185,14 @@ begin Windows.KillTimer(ltimerWnd, 1); // same IDEvent as used in SetTimer end; -procedure TfpgApplicationImpl.DoFlush; +procedure TfpgGDIApplication.DoFlush; begin + {$IFNDEF wince} GdiFlush; + {$ENDIF} end; -function TfpgApplicationImpl.GetScreenWidth: TfpgCoord; +function TfpgGDIApplication.GetScreenWidth: TfpgCoord; var r: TRECT; begin @@ -1122,7 +1201,7 @@ begin // Result := Windows.GetSystemMetrics(SM_CXSCREEN); end; -function TfpgApplicationImpl.GetScreenHeight: TfpgCoord; +function TfpgGDIApplication.GetScreenHeight: TfpgCoord; var r: TRECT; begin @@ -1131,35 +1210,35 @@ begin // Result := Windows.GetSystemMetrics(SM_CYSCREEN); end; -function TfpgApplicationImpl.Screen_dpi_x: integer; +function TfpgGDIApplication.Screen_dpi_x: integer; begin Result := GetDeviceCaps(wapplication.display, LOGPIXELSX) end; -function TfpgApplicationImpl.Screen_dpi_y: integer; +function TfpgGDIApplication.Screen_dpi_y: integer; begin Result := GetDeviceCaps(wapplication.display, LOGPIXELSY) end; -function TfpgApplicationImpl.Screen_dpi: integer; +function TfpgGDIApplication.Screen_dpi: integer; begin Result := Screen_dpi_y; end; -{ TfpgWindowImpl } +{ TfpgGDIWindow } var // this are required for Windows MouseEnter & MouseExit detection. uLastWindowHndl: TfpgWinHandle; -function TfpgWindowImpl.DoMouseEnterLeaveCheck(AWindow: TfpgWindowImpl; uMsg, wParam, lParam: Cardinal): Boolean; +function TfpgGDIWindow.DoMouseEnterLeaveCheck(AWindow: TfpgGDIWindow; uMsg, wParam, lParam: Cardinal): Boolean; var pt, spt: Windows.POINT; msgp: TfpgMessageParams; CursorInDifferentWindow: boolean; CurrentWindowHndl: TfpgWinHandle; MouseCaptureWHndl: TfpgWinHandle; - LastWindow: TfpgWindowImpl; - CurrentWindow: TfpgWindowImpl; + LastWindow: TfpgGDIWindow; + CurrentWindow: TfpgGDIWindow; begin // vvzh: this method currently cannot receive mouse events when mouse pointer // is outside of the application window. We could try to play with @@ -1209,7 +1288,7 @@ begin uLastWindowHndl := CurrentWindowHndl; end; -procedure TfpgWindowImpl.WindowSetFullscreen(aFullScreen, aUpdate: boolean); +procedure TfpgGDIWindow.WindowSetFullscreen(aFullScreen, aUpdate: boolean); begin if aFullScreen = FFullscreenIsSet then Exit; //==> @@ -1219,7 +1298,7 @@ begin FNonFullscreenStyle := FWinStyle; FNonFullscreenRect.SetRect(Left, Top, Width, Height); // vvzh: the following lines are the workaround for bug. When calling - // WindowSetFullscreen from TfpgWindowImpl.DoAllocateWindowHandle, + // WindowSetFullscreen from TfpgGDIWindow.DoAllocateWindowHandle, // Left and Top are equal to -2147483648. As the result, if // we set FullScreen := True at the form creation time and then // call SetFullScreen(False) the form disappears, because it is moved @@ -1268,10 +1347,15 @@ begin FFullscreenIsSet := aFullScreen; end; -procedure TfpgWindowImpl.DoAllocateWindowHandle(AParent: TfpgWindowBase); +procedure TfpgGDIWindow.DoAllocateWindowHandle(AParent: TfpgWindowBase); var +{$IFDEF wince} + wcname: widestring; + wname: widestring; +{$ELSE} wcname: string; wname: string; +{$ENDIF} mid: dword; rwidth: integer; rheight: integer; @@ -1287,27 +1371,26 @@ begin mid := 0; wcname := 'FPGWIN'; - if aparent <> nil then - FParentWinHandle := TfpgWindowImpl(AParent).WinHandle + if AParent <> nil then + FParentWinHandle := TfpgGDIWindow(AParent).WinHandle else FParentWinHandle := 0; - if FWindowType = wtChild then + if WindowType = wtChild then begin FWinStyle := WS_CHILD; FWinStyleEx := 0; mid := 1; wcname := 'FPGWIDGET'; end - else if FWindowType in [wtPopup] then + else if WindowType in [wtPopup] then begin // This prevents the popup window from stealing the focus. eg: ComboBox dropdown FParentWinHandle := GetDesktopWindow; FWinStyle := WS_CHILD; FWinStyleEx := WS_EX_TOPMOST or WS_EX_TOOLWINDOW; - end; - - if FWindowType = wtModalForm then + end + else if WindowType = wtModalForm then begin // set parent window to special hidden window. It helps to hide window taskbar button. FParentWinHandle := wapplication.GetHiddenWindow; @@ -1317,6 +1400,9 @@ begin FWinStyleEx := 0; end; + if ((WindowType = wtWindow) or (WindowType = wtModalForm)) and (waBorderLess in FWindowAttributes) then + FWinStyle := FWinStyle and WS_POPUP; // this is different to wtPopop (toolwindow, hint window) because it can steal focus like a normal form + AdjustWindowStyle; if waAutoPos in FWindowAttributes then @@ -1325,7 +1411,7 @@ begin FTop := TfpgCoord(CW_USEDEFAULT); end; - if (FWindowType <> wtChild) and not (waSizeable in FWindowAttributes) then + if (WindowType <> wtChild) and not (waSizeable in FWindowAttributes) then FWinStyle := FWinStyle and not (WS_SIZEBOX or WS_MAXIMIZEBOX); FWinStyle := FWinStyle or WS_CLIPCHILDREN or WS_CLIPSIBLINGS; @@ -1345,11 +1431,35 @@ begin r.Top := FTop; r.Right := FLeft + FWidth; r.Bottom := FTop + FHeight; + {$IFDEF wince} + AdjustWindowRectEx(@r, FWinStyle, False, FWinStyleEx); + {$ELSE} AdjustWindowRectEx(r, FWinStyle, False, FWinStyleEx); + {$ENDIF} rwidth := r.Right - r.Left; rheight := r.Bottom - r.Top; end; + {$IFDEF wince} + // required for some WinCE devices + FWinStyleEx := FWinStyleEx or WS_VISIBLE; // or WS_BORDER; + FWinStyle := FWinStyleEx; + + FWinHandle := Windows.CreateWindowExW( + FWinStyleEx, // extended window style + PWideChar(wcname), // registered class name + PWideChar(wname), // window name + FWinStyle, // window style + FLeft, // horizontal position of window + FTop, // vertical position of window + rwidth, // window width + rheight, // window height + FParentWinHandle, // handle to parent or owner window + mid, // menu handle or child identifier + MainInstance, // handle to application instance + Self // window-creation data + ); + {$ELSE} FWinHandle := Windows.CreateWindowEx( FWinStyleEx, // extended window style PChar(wcname), // registered class name @@ -1364,6 +1474,7 @@ begin MainInstance, // handle to application instance Self // window-creation data ); + {$ENDIF} if waScreenCenterPos in FWindowAttributes then begin @@ -1387,7 +1498,7 @@ begin FSkipResizeMessage := False; end; -procedure TfpgWindowImpl.DoReleaseWindowHandle; +procedure TfpgGDIWindow.DoReleaseWindowHandle; begin if FWinHandle <= 0 then Exit; @@ -1395,12 +1506,12 @@ begin FWinHandle := 0; end; -procedure TfpgWindowImpl.DoRemoveWindowLookup; +procedure TfpgGDIWindow.DoRemoveWindowLookup; begin // Nothing to do here end; -procedure TfpgWindowImpl.DoSetWindowVisible(const AValue: Boolean); +procedure TfpgGDIWindow.DoSetWindowVisible(const AValue: Boolean); var r: TRect; begin @@ -1429,7 +1540,7 @@ begin Windows.ShowWindow(FWinHandle, SW_HIDE); end; -procedure TfpgWindowImpl.DoMoveWindow(const x: TfpgCoord; const y: TfpgCoord); +procedure TfpgGDIWindow.DoMoveWindow(const x: TfpgCoord; const y: TfpgCoord); begin if HandleIsValid then Windows.SetWindowPos( @@ -1438,18 +1549,18 @@ begin SWP_NOZORDER or SWP_NOSIZE);// or SWP_NOREDRAW); end; -function TfpgWindowImpl.DoWindowToScreen(ASource: TfpgWindowBase; const AScreenPos: TPoint): TPoint; +function TfpgGDIWindow.DoWindowToScreen(ASource: TfpgWindowBase; const AScreenPos: TPoint): TPoint; begin - if not TfpgWindowImpl(ASource).HandleIsValid then + if not TfpgGDIWindow(ASource).HandleIsValid then Exit; //==> Result.X := AScreenPos.X; Result.Y := AScreenPos.Y; - ClientToScreen(TfpgWindowImpl(ASource).WinHandle, Result); + ClientToScreen(TfpgGDIWindow(ASource).WinHandle, Result); end; { -procedure TfpgWindowImpl.MoveToScreenCenter; +procedure TfpgGDIWindow.MoveToScreenCenter; var r : TRECT; begin @@ -1460,15 +1571,19 @@ begin end; } -procedure TfpgWindowImpl.DoSetWindowTitle(const atitle: string); +procedure TfpgGDIWindow.DoSetWindowTitle(const atitle: string); begin + {$ifdef wince} + Windows.SetWindowText(WinHandle, PWideChar(Utf8Decode(ATitle))); + {$else} if UnicodeEnabledOS then Windows.SetWindowTextW(WinHandle, PWideChar(Utf8Decode(ATitle))) else Windows.SetWindowText(WinHandle, PChar(Utf8ToAnsi(ATitle))); + {$endif} end; -procedure TfpgWindowImpl.DoSetMouseCursor; +procedure TfpgGDIWindow.DoSetMouseCursor; var hc: HCURSOR; begin @@ -1496,24 +1611,24 @@ begin SetCursor(hc); end; -constructor TfpgWindowImpl.Create(AOwner: TComponent); +constructor TfpgGDIWindow.Create(AOwner: TComponent); begin inherited Create(AOwner); FWinHandle := 0; FFullscreenIsSet := false; end; -procedure TfpgWindowImpl.ActivateWindow; +procedure TfpgGDIWindow.ActivateWindow; begin SetForegroundWindow(FWinHandle); end; -procedure TfpgWindowImpl.CaptureMouse; +procedure TfpgGDIWindow.CaptureMouse; begin Windows.SetCapture(FWinHandle); end; -procedure TfpgWindowImpl.ReleaseMouse; +procedure TfpgGDIWindow.ReleaseMouse; begin Windows.ReleaseCapture; // if PopupListFirst <> nil then @@ -1521,18 +1636,18 @@ begin // if GfxFirstPopup <> nil then SetCapture(GfxFirstPopup^.wg.WinHandle); end; -procedure TfpgWindowImpl.SetFullscreen(AValue: Boolean); +procedure TfpgGDIWindow.SetFullscreen(AValue: Boolean); begin inherited SetFullscreen(AValue); WindowSetFullscreen(AValue, True); end; -function TfpgWindowImpl.HandleIsValid: boolean; +function TfpgGDIWindow.HandleIsValid: boolean; begin Result := FWinHandle > 0; end; -procedure TfpgWindowImpl.DoUpdateWindowPosition; +procedure TfpgGDIWindow.DoUpdateWindowPosition; var bx, by: integer; begin @@ -1546,9 +1661,9 @@ begin FSkipResizeMessage := False; end; -{ TfpgCanvasImpl } +{ TfpgGDICanvas } -constructor TfpgCanvasImpl.Create; +constructor TfpgGDICanvas.Create; begin inherited; FDrawing := False; @@ -1556,7 +1671,7 @@ begin FBufferBitmap := 0; end; -destructor TfpgCanvasImpl.Destroy; +destructor TfpgGDICanvas.Destroy; begin if FDrawing then DoEndDraw; @@ -1564,7 +1679,7 @@ begin inherited; end; -procedure TfpgCanvasImpl.DoBeginDraw(awin: TfpgWindowBase; buffered: boolean); +procedure TfpgGDICanvas.DoBeginDraw(awin: TfpgWindowBase; buffered: boolean); var ARect: TfpgRect; bmsize: Windows.TSIZE; @@ -1572,8 +1687,10 @@ begin if FDrawing and buffered and (FBufferBitmap > 0) then begin // check if the dimensions are ok + {$IFNDEF wince} GetBitmapDimensionEx(FBufferBitmap, bmsize); - FDrawWindow := TfpgWindowImpl(awin); + {$ENDIF} + FDrawWindow := TfpgGDIWindow(awin); DoGetWinRect(ARect); if (bmsize.cx <> (ARect.Right-ARect.Left+1)) or (bmsize.cy <> (ARect.Bottom-ARect.Top+1)) then @@ -1582,7 +1699,7 @@ begin if not FDrawing then begin - FDrawWindow := TfpgWindowImpl(awin); + FDrawWindow := TfpgGDIWindow(awin); FWinGC := Windows.GetDC(FDrawWindow.FWinHandle); if buffered then @@ -1621,7 +1738,7 @@ begin FDrawing := True; end; -procedure TfpgCanvasImpl.DoEndDraw; +procedure TfpgGDICanvas.DoEndDraw; begin if FDrawing then begin @@ -1638,71 +1755,75 @@ begin end; end; -function TfpgCanvasImpl.GetPixel(X, Y: integer): TfpgColor; +function TfpgGDICanvas.GetPixel(X, Y: integer): TfpgColor; var c: longword; begin c := Windows.GetPixel(Fgc, X, Y); if c = CLR_INVALID then - Writeln('fpGFX/GDI: TfpgCanvasImpl.GetPixel returned an invalid color'); + Writeln('fpGFX/GDI: TfpgGDICanvas.GetPixel returned an invalid color'); Result := WinColorTofpgColor(c); end; -procedure TfpgCanvasImpl.SetPixel(X, Y: integer; const AValue: TfpgColor); +procedure TfpgGDICanvas.SetPixel(X, Y: integer; const AValue: TfpgColor); begin Windows.SetPixel(Fgc, X, Y, fpgColorToWin(AValue)); end; -procedure TfpgCanvasImpl.DoDrawArc(x, y, w, h: TfpgCoord; a1, a2: Extended); +procedure TfpgGDICanvas.DoDrawArc(x, y, w, h: TfpgCoord; a1, a2: Extended); var SX, SY, EX, EY: Longint; begin - {Stupid GDI can't tell the difference between 0 and 360°!!} + {Stupid GDI can't tell the difference between 0 and 360 degrees!!} if a2 = 0 then Exit; //==> {Stupid GDI must be told in which direction to draw} + {$IFNDEF wince} if a2 < 0 then Windows.SetArcDirection(FGc, AD_CLOCKWISE) else Windows.SetArcDirection(FGc, AD_COUNTERCLOCKWISE); + {$ENDIF} Angles2Coords(x, y, w, h, a1*16, a2*16, SX, SY, EX, EY); {$IFNDEF wince} Windows.Arc(Fgc, x, y, x+w, y+h, SX, SY, EX, EY); {$ENDIF} end; -procedure TfpgCanvasImpl.DoFillArc(x, y, w, h: TfpgCoord; a1, a2: Extended); +procedure TfpgGDICanvas.DoFillArc(x, y, w, h: TfpgCoord; a1, a2: Extended); var SX, SY, EX, EY: Longint; begin - {Stupid GDI can't tell the difference between 0 and 360°!!} + {Stupid GDI can't tell the difference between 0 and 360 degrees!!} if a2 = 0 then Exit; //==> {Stupid GDI must be told in which direction to draw} + {$IFNDEF wince} if a2 < 0 then Windows.SetArcDirection(FGc, AD_CLOCKWISE) else Windows.SetArcDirection(FGc, AD_COUNTERCLOCKWISE); + {$ENDIF} Angles2Coords(x, y, w, h, a1*16, a2*16, SX, SY, EX, EY); {$IFNDEF wince} Windows.Pie(Fgc, x, y, x+w, y+h, SX, SY, EX, EY); {$ENDIF} end; -procedure TfpgCanvasImpl.DoDrawPolygon(Points: PPoint; NumPts: Integer; Winding: boolean); +procedure TfpgGDICanvas.DoDrawPolygon(Points: PPoint; NumPts: Integer; Winding: boolean); //var // pts: array of TPoint; begin Windows.Polygon(Fgc, Points, NumPts); end; -procedure TfpgCanvasImpl.DoPutBufferToScreen(x, y, w, h: TfpgCoord); +procedure TfpgGDICanvas.DoPutBufferToScreen(x, y, w, h: TfpgCoord); begin if FBufferBitmap > 0 then BitBlt(FWinGC, x, y, w, h, Fgc, x, y, SRCCOPY); end; -procedure TfpgCanvasImpl.DoAddClipRect(const ARect: TfpgRect); +procedure TfpgGDICanvas.DoAddClipRect(const ARect: TfpgRect); var rg: HRGN; begin @@ -1714,22 +1835,32 @@ begin DeleteObject(rg); end; -procedure TfpgCanvasImpl.DoClearClipRect; +procedure TfpgGDICanvas.DoClearClipRect; begin SelectClipRgn(Fgc, 0); FClipRectSet := False; end; -procedure TfpgCanvasImpl.DoDrawLine(x1, y1, x2, y2: TfpgCoord); +procedure TfpgGDICanvas.DoDrawLine(x1, y1, x2, y2: TfpgCoord); begin Windows.MoveToEx(Fgc, x1, y1, nil); Windows.LineTo(Fgc, x2, y2); end; -procedure TfpgCanvasImpl.DoDrawRectangle(x, y, w, h: TfpgCoord); +procedure TfpgGDICanvas.DoDrawRectangle(x, y, w, h: TfpgCoord); var wr: Windows.TRect; r: TfpgRect; + +{$IFDEF WinCE} +// *** copied from Lazarus +function FrameRect(DC: HDC; const ARect: TRect; hBr: HBRUSH) : integer; +begin +//roozbeh....works for now! + Result := Integer(DrawFocusRect(DC,Arect)); +end; +{$ENDIF} + begin if FLineStyle = lsSolid then begin @@ -1737,7 +1868,11 @@ begin wr.Top := y; wr.Right := x + w; wr.Bottom := y + h; - Windows.FrameRect(Fgc, wr, FBrush) // this handles 1x1 rectangles + {$IFDEF WinCE} + FrameRect(Fgc, wr, FBrush); + {$ELSE} + Windows.FrameRect(Fgc, wr, FBrush); // this handles 1x1 rectangles + {$ENDIF} end else begin @@ -1749,7 +1884,7 @@ begin end; end; -procedure TfpgCanvasImpl.DoDrawString(x, y: TfpgCoord; const txt: string); +procedure TfpgGDICanvas.DoDrawString(x, y: TfpgCoord; const txt: string); var WideText: widestring; begin @@ -1764,7 +1899,7 @@ begin {$endif} end; -procedure TfpgCanvasImpl.DoFillRectangle(x, y, w, h: TfpgCoord); +procedure TfpgGDICanvas.DoFillRectangle(x, y, w, h: TfpgCoord); var wr: Windows.TRect; begin @@ -1775,7 +1910,7 @@ begin Windows.FillRect(Fgc, wr, FBrush); end; -procedure TfpgCanvasImpl.DoFillTriangle(x1, y1, x2, y2, x3, y3: TfpgCoord); +procedure TfpgGDICanvas.DoFillTriangle(x1, y1, x2, y2, x3, y3: TfpgCoord); var pts: array[1..3] of Windows.TPoint; begin @@ -1788,12 +1923,12 @@ begin Windows.Polygon(Fgc, pts, 3); end; -function TfpgCanvasImpl.DoGetClipRect: TfpgRect; +function TfpgGDICanvas.DoGetClipRect: TfpgRect; begin Result := FClipRect; end; -procedure TfpgCanvasImpl.DoGetWinRect(out r: TfpgRect); +procedure TfpgGDICanvas.DoGetWinRect(out r: TfpgRect); var wr: TRect; begin @@ -1804,7 +1939,7 @@ begin r.Height := wr.Bottom - wr.Top + 1; end; -procedure TfpgCanvasImpl.DoSetClipRect(const ARect: TfpgRect); +procedure TfpgGDICanvas.DoSetClipRect(const ARect: TfpgRect); begin FClipRectSet := True; FClipRect := ARect; @@ -1813,7 +1948,7 @@ begin SelectClipRgn(Fgc, FClipRegion); end; -procedure TfpgCanvasImpl.DoSetColor(cl: TfpgColor); +procedure TfpgGDICanvas.DoSetColor(cl: TfpgColor); begin DeleteObject(FBrush); FWindowsColor := fpgColorToWin(cl); @@ -1822,7 +1957,7 @@ begin SelectObject(Fgc, FBrush); end; -procedure TfpgCanvasImpl.DoSetLineStyle(awidth: integer; astyle: TfpgLineStyle); +procedure TfpgGDICanvas.DoSetLineStyle(awidth: integer; astyle: TfpgLineStyle); const cDot: array[1..2] of DWORD = (1, 1); cDash: array[1..4] of DWORD = (4, 2, 4, 2); @@ -1838,11 +1973,15 @@ begin case AStyle of lsDot: begin + {$IFNDEF wince} FPen := ExtCreatePen(PS_GEOMETRIC or PS_ENDCAP_FLAT or PS_USERSTYLE, FLineWidth, logBrush, Length(cDot), @cDot); + {$ENDIF} end; lsDash: begin + {$IFNDEF wince} FPen := ExtCreatePen(PS_GEOMETRIC or PS_ENDCAP_FLAT or PS_USERSTYLE, FLineWidth, logBrush, Length(cDash), @cDash); + {$ENDIF} end; lsSolid: begin @@ -1856,12 +1995,12 @@ begin SelectObject(Fgc, FPen); end; -procedure TfpgCanvasImpl.DoSetTextColor(cl: TfpgColor); +procedure TfpgGDICanvas.DoSetTextColor(cl: TfpgColor); begin Windows.SetTextColor(Fgc, fpgColorToWin(cl)); end; -procedure TfpgCanvasImpl.TryFreeBackBuffer; +procedure TfpgGDICanvas.TryFreeBackBuffer; begin if FBufferBitmap > 0 then DeleteObject(FBufferBitmap); @@ -1872,15 +2011,15 @@ begin FBufgc := 0; end; -procedure TfpgCanvasImpl.DoSetFontRes(fntres: TfpgFontResourceBase); +procedure TfpgGDICanvas.DoSetFontRes(fntres: TfpgFontResourceBase); begin if fntres = nil then Exit; //==> - FCurFontRes := TfpgFontResourceImpl(fntres); + FCurFontRes := TfpgGDIFontResource(fntres); Windows.SelectObject(Fgc, FCurFontRes.Handle); end; -procedure TfpgCanvasImpl.DoDrawImagePart(x, y: TfpgCoord; img: TfpgImageBase; xi, yi, w, h: integer); +procedure TfpgGDICanvas.DoDrawImagePart(x, y: TfpgCoord; img: TfpgImageBase; xi, yi, w, h: integer); const DSTCOPY = $00AA0029; ROP_DSPDxax = $00E20746; @@ -1892,22 +2031,22 @@ begin Exit; //==> tmpdc := CreateCompatibleDC(wapplication.display); - SelectObject(tmpdc, TfpgImageImpl(img).BMPHandle); + SelectObject(tmpdc, TfpgGDIImage(img).BMPHandle); - if TfpgImageImpl(img).FIsTwoColor then + if TfpgGDIImage(img).FIsTwoColor then rop := PATCOPY else rop := SRCCOPY; - if TfpgImageImpl(img).MaskHandle > 0 then - MaskBlt(Fgc, x, y, w, h, tmpdc, xi, yi, TfpgImageImpl(img).MaskHandle, xi, yi, MakeRop4(rop, DSTCOPY)) + if TfpgGDIImage(img).MaskHandle > 0 then + MaskBlt(Fgc, x, y, w, h, tmpdc, xi, yi, TfpgGDIImage(img).MaskHandle, xi, yi, MakeRop4(rop, DSTCOPY)) else BitBlt(Fgc, x, y, w, h, tmpdc, xi, yi, rop); DeleteDC(tmpdc); end; -procedure TfpgCanvasImpl.DoXORFillRectangle(col: TfpgColor; x, y, w, h: TfpgCoord); +procedure TfpgGDICanvas.DoXORFillRectangle(col: TfpgColor; x, y, w, h: TfpgCoord); var hb: HBRUSH; nullpen: HPEN; @@ -1926,9 +2065,9 @@ begin SelectObject(Fgc, FPen); end; -{ TfpgFontResourceImpl } +{ TfpgGDIFontResource } -constructor TfpgFontResourceImpl.Create(const afontdesc: string); +constructor TfpgGDIFontResource.Create(const afontdesc: string); begin FFontData := OpenFontByDesc(afontdesc); @@ -1939,14 +2078,14 @@ begin end; end; -destructor TfpgFontResourceImpl.Destroy; +destructor TfpgGDIFontResource.Destroy; begin if HandleIsValid then Windows.DeleteObject(FFontData); inherited; end; -function TfpgFontResourceImpl.OpenFontByDesc(const desc: string): HFONT; +function TfpgGDIFontResource.OpenFontByDesc(const desc: string): HFONT; var lf: Windows.LOGFONT; facename: string; @@ -2035,30 +2174,34 @@ begin lf.lfQuality := DEFAULT_QUALITY; end; + {$IFDEF wince} + Result := CreateFontIndirectW(@lf); + {$ELSE} Result := CreateFontIndirectA(@lf); + {$ENDIF} end; -function TfpgFontResourceImpl.HandleIsValid: boolean; +function TfpgGDIFontResource.HandleIsValid: boolean; begin Result := FFontData <> 0; end; -function TfpgFontResourceImpl.GetAscent: integer; +function TfpgGDIFontResource.GetAscent: integer; begin Result := FMetrics.tmAscent; end; -function TfpgFontResourceImpl.GetDescent: integer; +function TfpgGDIFontResource.GetDescent: integer; begin Result := FMetrics.tmDescent; end; -function TfpgFontResourceImpl.GetHeight: integer; +function TfpgGDIFontResource.GetHeight: integer; begin Result := FMetrics.tmHeight; end; -function TfpgFontResourceImpl.GetTextWidth(const txt: string): integer; +function TfpgGDIFontResource.GetTextWidth(const txt: string): integer; var ts: Windows.SIZE; WideText: widestring; @@ -2080,16 +2223,16 @@ begin Result := ts.cx; end; -{ TfpgImageImpl } +{ TfpgGDIImage } -constructor TfpgImageImpl.Create; +constructor TfpgGDIImage.Create; begin FBMPHandle := 0; FMaskHandle := 0; FIsTwoColor := False; end; -procedure TfpgImageImpl.DoFreeImage; +procedure TfpgGDIImage.DoFreeImage; begin if FBMPHandle > 0 then DeleteObject(FBMPHandle); @@ -2099,7 +2242,7 @@ begin FMaskHandle := 0; end; -procedure TfpgImageImpl.DoInitImage(acolordepth, awidth, aheight: integer; aimgdata: Pointer); +procedure TfpgGDIImage.DoInitImage(acolordepth, awidth, aheight: integer; aimgdata: Pointer); var bi: TBitmapInfo; begin @@ -2128,7 +2271,11 @@ begin biClrImportant := 0; end; + {$IFNDEF wince} SetDIBits(wapplication.display, FBMPHandle, 0, aheight, aimgdata, bi, DIB_RGB_COLORS); + {$else} + WinCESetDibBits(FBMPHandle, awidth, aheight, aimgdata, bi); + {$ENDIF} FIsTwoColor := (acolordepth = 1); end; @@ -2139,7 +2286,7 @@ type bmColors: array[1..2] of longword; end; -procedure TfpgImageImpl.DoInitImageMask(awidth, aheight: integer; aimgdata: Pointer); +procedure TfpgGDIImage.DoInitImageMask(awidth, aheight: integer; aimgdata: Pointer); var bi: TMyMonoBitmap; pbi: PBitmapInfo; @@ -2167,12 +2314,16 @@ begin bi.bmColors[2] := $FFFFFF; pbi := @bi; + {$IFNDEF wince} SetDIBits(wapplication.display, FMaskHandle, 0, aheight, aimgdata, pbi^, DIB_RGB_COLORS); + {$ELSE} + WinCESetDibBits(FMaskHandle, awidth, aheight, aimgdata, pbi^); + {$ENDIF} end; -{ TfpgClipboardImpl } +{ TfpgGDIClipboard } -function TfpgClipboardImpl.DoGetText: TfpgString; +function TfpgGDIClipboard.DoGetText: TfpgString; var h: THANDLE; p: PChar; @@ -2198,7 +2349,7 @@ begin Result := FClipboardText; end; -procedure TfpgClipboardImpl.DoSetText(const AValue: TfpgString); +procedure TfpgGDIClipboard.DoSetText(const AValue: TfpgString); begin FClipboardText := AValue; if OpenClipboard(FClipboardWndHandle) then @@ -2209,7 +2360,7 @@ begin end; end; -procedure TfpgClipboardImpl.InitClipboard; +procedure TfpgGDIClipboard.InitClipboard; begin {$WARNING This does not work! 'FPGUI' window class was not registered, so CreateWindowEx always returns 0} @@ -2229,9 +2380,9 @@ begin ); end; -{ TfpgFileListImpl } +{ TfpgGDIFileList } -function TfpgFileListImpl.EncodeAttributesString(attrs: longword +function TfpgGDIFileList.EncodeAttributesString(attrs: longword ): TFileModeString; begin Result := ''; @@ -2243,13 +2394,13 @@ begin if (attrs and FILE_ATTRIBUTE_COMPRESSED) <> 0 then Result := Result + 'c'; end; -constructor TfpgFileListImpl.Create; +constructor TfpgGDIFileList.Create; begin inherited Create; FHasFileMode := false; end; -function TfpgFileListImpl.InitializeEntry(sr: TSearchRec): TFileEntry; +function TfpgGDIFileList.InitializeEntry(sr: TSearchRec): TFileEntry; begin Result := inherited InitializeEntry(sr); if Assigned(Result) then @@ -2260,7 +2411,7 @@ begin end; end; -procedure TfpgFileListImpl.PopulateSpecialDirs(const aDirectory: TfpgString); +procedure TfpgGDIFileList.PopulateSpecialDirs(const aDirectory: TfpgString); const MAX_DRIVES = 25; var @@ -2276,10 +2427,12 @@ begin while n <= MAX_DRIVES do begin drvs := chr(n+ord('A'))+':\'; + {$IFNDEF wince} if Windows.GetDriveType(PChar(drvs)) <> 1 then begin FSpecialDirs.Add(drvs); end; + {$ENDIF} inc(n); end; end; diff --git a/src/corelib/gdi/fpg_interface.pas b/src/corelib/gdi/fpg_interface.pas new file mode 100644 index 00000000..c75aaa28 --- /dev/null +++ b/src/corelib/gdi/fpg_interface.pas @@ -0,0 +1,40 @@ +{ + fpGUI - Free Pascal GUI Toolkit + + Copyright (C) 2006 - 2010 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 alias types to bind each backend graphics library + to fpg_main without the need for IFDEF's +} + +unit fpg_interface; + +{$mode objfpc}{$H+} + +interface + +uses + fpg_gdi; + +type + TfpgFontResourceImpl = TfpgGDIFontResource; + TfpgImageImpl = TfpgGDIImage; + TfpgCanvasImpl = TfpgGDICanvas; + TfpgWindowImpl = TfpgGDIWindow; + TfpgApplicationImpl = TfpgGDIApplication; + TfpgClipboardImpl = TfpgGDIClipboard; + TfpgFileListImpl = TfpgGDIFileList; + +implementation + +end. + diff --git a/src/corelib/gdi/fpg_keys_gdi.inc b/src/corelib/gdi/fpg_keys_gdi.inc index e7d79f25..914dd5f7 100644 --- a/src/corelib/gdi/fpg_keys_gdi.inc +++ b/src/corelib/gdi/fpg_keys_gdi.inc @@ -1,7 +1,7 @@ { - fpGUI - Free Pascal GUI Library + fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2010 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/corelib/gdi/fpg_utils_impl.inc b/src/corelib/gdi/fpg_utils_impl.inc index 5d72ca88..d3bb2f0c 100644 --- a/src/corelib/gdi/fpg_utils_impl.inc +++ b/src/corelib/gdi/fpg_utils_impl.inc @@ -1,7 +1,6 @@ {%mainunit fpg_utils.pas} uses - Registry, Shellapi; // GDI specific implementations of encoding functions @@ -19,7 +18,9 @@ end; procedure fpgOpenURL(const aURL: TfpgString); begin try - ShellExecute(0, 'open', PChar(aURL), nil, nil, 0) ; + {$IFNDEF wince} + ShellExecute(0, 'open', PChar(aURL), nil, nil, 1 {SW_SHOWNORMAL}); + {$ENDIF} except // do nothing end; diff --git a/src/corelib/gdi/fpgui_toolkit.lpk b/src/corelib/gdi/fpgui_toolkit.lpk index 265e3292..11731043 100644 --- a/src/corelib/gdi/fpgui_toolkit.lpk +++ b/src/corelib/gdi/fpgui_toolkit.lpk @@ -8,26 +8,30 @@ <Version Value="8"/>
<PathDelim Value="\"/>
<SearchPaths>
+ <IncludeFiles Value="..\..\"/>
<OtherUnitFiles Value="..\;..\..\gui\;..\..\gui\db\"/>
<UnitOutputDirectory Value="..\..\..\lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
- <CStyleOperator Value="False"/>
<AllowLabel Value="False"/>
<CPPInline Value="False"/>
+ <UseAnsiStrings Value="True"/>
</SyntaxOptions>
</Parsing>
+ <CodeGeneration>
+ <Optimizations>
+ <OptimizationLevel Value="0"/>
+ </Optimizations>
+ </CodeGeneration>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
- <Description Value="fpGUI Toolkit -"/>
- <License Value="Modified LGPL -"/>
- <Version Minor="6" Release="3"/>
- <Files Count="73">
+ <Description Value="fpGUI Toolkit"/>
+ <License Value="LGPL 2 with static linking exception."/>
+ <Version Minor="7"/>
+ <Files Count="80">
<Item1>
<Filename Value="..\stdimages.inc"/>
<Type Value="Include"/>
@@ -311,15 +315,43 @@ <Item71>
<Filename Value="..\fpg_extgraphics.pas"/>
<UnitName Value="fpg_extgraphics"/>
- </Item71> - <Item72> - <Filename Value="..\..\gui\fpg_colormapping.pas"/> - <UnitName Value="fpg_ColorMapping"/> - </Item72> - <Item73> - <Filename Value="..\..\gui\fpg_colorwheel.pas"/> - <UnitName Value="fpg_ColorWheel"/> + </Item71>
+ <Item72>
+ <Filename Value="..\..\gui\fpg_colormapping.pas"/>
+ <UnitName Value="fpg_ColorMapping"/>
+ </Item72>
+ <Item73>
+ <Filename Value="..\..\gui\fpg_colorwheel.pas"/>
+ <UnitName Value="fpg_ColorWheel"/>
</Item73>
+ <Item74>
+ <Filename Value="fpg_interface.pas"/>
+ <UnitName Value="fpg_interface"/>
+ </Item74>
+ <Item75>
+ <Filename Value="..\..\gui\fpg_editbtn.pas"/>
+ <UnitName Value="fpg_editbtn"/>
+ </Item75>
+ <Item76>
+ <Filename Value="..\..\gui\colordialog.inc"/>
+ <Type Value="Include"/>
+ </Item76>
+ <Item77>
+ <Filename Value="..\fpg_imgfmt_jpg.pas"/>
+ <UnitName Value="fpg_imgfmt_jpg"/>
+ </Item77>
+ <Item78>
+ <Filename Value="..\..\gui\inputquerydialog.inc"/>
+ <Type Value="Include"/>
+ </Item78>
+ <Item79>
+ <Filename Value="..\fpg_imgutils.pas"/>
+ <UnitName Value="fpg_imgutils"/>
+ </Item79>
+ <Item80>
+ <Filename Value="..\..\VERSION_FILE.inc"/>
+ <Type Value="Include"/>
+ </Item80>
</Files>
<LazDoc Paths="..\..\..\docs\xml\corelib\;..\..\..\docs\xml\corelib\x11\;..\..\..\docs\xml\corelib\gdi\;..\..\..\docs\xml\gui\"/>
<RequiredPkgs Count="1">
@@ -333,7 +365,6 @@ </UsageOptions>
<PublishOptions>
<Version Value="2"/>
- <DestinationDirectory Value="$(TestDir)\publishedpackage\"/>
<IgnoreBinaries Value="False"/>
</PublishOptions>
</Package>
diff --git a/src/corelib/gdi/fpgui_toolkit.pas b/src/corelib/gdi/fpgui_toolkit.pas index 1d63fc3e..2e3e81b6 100644 --- a/src/corelib/gdi/fpgui_toolkit.pas +++ b/src/corelib/gdi/fpgui_toolkit.pas @@ -1,24 +1,25 @@ -{ This file was automatically created by Lazarus. do not edit! - This source is only used to compile and install the package. - } - -unit fpgui_toolkit; - -interface - -uses - fpg_base, fpg_main, fpg_cmdlineparams, fpg_command_intf, fpg_constants, - fpg_extinterpolation, fpg_imagelist, fpg_imgfmt_bmp, fpg_pofiles, - fpg_popupwindow, fpg_stdimages, fpg_stringhashlist, fpg_translations, - fpg_stringutils, fpg_utils, fpg_widget, fpg_wuline, fpg_animation, - fpg_basegrid, fpg_button, fpg_checkbox, fpg_combobox, fpg_customgrid, - fpg_dialogs, fpg_editcombo, fpg_edit, fpg_form, fpg_gauge, fpg_grid, - fpg_hyperlink, fpg_iniutils, fpg_label, fpg_listbox, fpg_listview, fpg_memo, - fpg_menu, fpg_mru, fpg_panel, fpg_popupcalendar, fpg_progressbar, - fpg_radiobutton, fpg_scrollbar, fpg_style, fpg_tab, fpg_trackbar, fpg_tree, - fpgui_db, fpg_gdi, fpg_impl, fpg_splitter, fpg_hint, fpg_spinedit, - fpg_extgraphics, fpg_ColorMapping, fpg_ColorWheel; - -implementation - -end. +{ This file was automatically created by Lazarus. do not edit!
+ This source is only used to compile and install the package.
+ }
+
+unit fpgui_toolkit;
+
+interface
+
+uses
+ fpg_base, fpg_main, fpg_cmdlineparams, fpg_command_intf, fpg_constants,
+ fpg_extinterpolation, fpg_imagelist, fpg_imgfmt_bmp, fpg_pofiles,
+ fpg_popupwindow, fpg_stdimages, fpg_stringhashlist, fpg_translations,
+ fpg_stringutils, fpg_utils, fpg_widget, fpg_wuline, fpg_animation,
+ fpg_basegrid, fpg_button, fpg_checkbox, fpg_combobox, fpg_customgrid,
+ fpg_dialogs, fpg_editcombo, fpg_edit, fpg_form, fpg_gauge, fpg_grid,
+ fpg_hyperlink, fpg_iniutils, fpg_label, fpg_listbox, fpg_listview, fpg_memo,
+ fpg_menu, fpg_mru, fpg_panel, fpg_popupcalendar, fpg_progressbar,
+ fpg_radiobutton, fpg_scrollbar, fpg_style, fpg_tab, fpg_trackbar, fpg_tree,
+ fpgui_db, fpg_gdi, fpg_impl, fpg_splitter, fpg_hint, fpg_spinedit,
+ fpg_extgraphics, fpg_ColorMapping, fpg_ColorWheel, fpg_interface,
+ fpg_editbtn, fpg_imgfmt_jpg, fpg_imgutils;
+
+implementation
+
+end.
diff --git a/src/corelib/lang_af.inc b/src/corelib/lang_af.inc index 5617ef91..70598111 100644 --- a/src/corelib/lang_af.inc +++ b/src/corelib/lang_af.inc @@ -20,6 +20,7 @@ rsbold = 'Vetdruk'; rscancel = 'Kanselleer'; rscannotcreatedir = 'Kan nie die lêergids skep nie'; rschange = 'Verander'; +rscharactermap = 'Character Map'; rsclose = 'Sluit'; rscollection = 'Versameling'; rsconfirm = 'Bevestig'; @@ -60,6 +61,7 @@ rshelp = 'Help'; rsignore = 'Ignoreer'; rsinformation = 'Informasie'; rsinsert = 'Invoeg'; +rsinsertfromcharactermap = 'Insert from Character Map'; rsitalic = 'Kursief'; rserritemofwrongtype = 'Die item is nie van <%s> tiepe nie!'; rsshortjan = 'Jan'; @@ -101,6 +103,7 @@ rssave = 'Stoor'; rssaveafile = 'Stoor ''n lêer as'; rssearch = 'Soek'; rsselect = 'Kies'; +rsselectadirectory = 'Kies ''n lêergids'; rsselectafont = 'Kies ''n lettertipe'; rsshortsep = 'Sept'; rslongsep = 'September'; @@ -110,6 +113,7 @@ rssize = 'Groote'; rsstyle = 'Steil'; rsshortsun = 'So'; rslongsun = 'Sondag'; +rstexttoinsert = 'Text to Insert'; rsshortthu = 'Do'; rslongthu = 'Donderdag'; rstoday = 'Vandag'; diff --git a/src/corelib/lang_de.inc b/src/corelib/lang_de.inc index e48739e2..f3f45489 100644 --- a/src/corelib/lang_de.inc +++ b/src/corelib/lang_de.inc @@ -20,6 +20,7 @@ rsbold = 'Fett'; rscancel = 'Abbrechen'; rscannotcreatedir = 'Kann Verzeichnis nicht anlegen'; rschange = 'Ändern'; +rscharactermap = 'Character Map'; rsclose = 'Schließen'; rscollection = 'Sammlung'; rsconfirm = 'Bestätigen'; @@ -60,6 +61,7 @@ rshelp = 'Hilfe'; rsignore = 'Ãœbergehen'; rsinformation = 'Information'; rsinsert = 'Einfügen'; +rsinsertfromcharactermap = 'Insert from Character Map'; rsitalic = 'Kursiv'; rserritemofwrongtype = 'Eintrag ist nicht vom Typ <%s>!'; rsshortjan = 'Jan'; @@ -101,6 +103,7 @@ rssave = 'Speichern'; rssaveafile = 'Datei speichern unter'; rssearch = 'Suchen'; rsselect = 'Ausgewählte'; +rsselectadirectory = 'Wählen Sie ein Verzeichnis'; rsselectafont = 'Schriftart auswählen'; rsshortsep = 'Sep'; rslongsep = 'September'; @@ -110,6 +113,7 @@ rssize = 'Größe'; rsstyle = 'Stil'; rsshortsun = 'Son'; rslongsun = 'Sonntag'; +rstexttoinsert = 'Text to Insert'; rsshortthu = 'Don'; rslongthu = 'Donnerstag'; rstoday = 'Heute'; diff --git a/src/corelib/lang_en.inc b/src/corelib/lang_en.inc index 792f3694..a7db8859 100644 --- a/src/corelib/lang_en.inc +++ b/src/corelib/lang_en.inc @@ -20,6 +20,7 @@ rsbold = 'Bold'; rscancel = 'Cancel'; rscannotcreatedir = 'Cannot create directory'; rschange = 'Change'; +rscharactermap = 'Character Map'; rsclose = 'Close'; rscollection = 'Collection'; rsconfirm = 'Confirm'; @@ -60,6 +61,7 @@ rshelp = 'Help'; rsignore = 'Ignore'; rsinformation = 'Information'; rsinsert = 'Insert'; +rsinsertfromcharactermap = 'Insert from Character Map'; rsitalic = 'Italic'; rserritemofwrongtype = 'Item is not of <%s> type!'; rsshortjan = 'Jan'; @@ -101,6 +103,7 @@ rssave = 'Save'; rssaveafile = 'Save file as'; rssearch = 'Search'; rsselect = 'Select'; +rsselectadirectory = 'Select a Directory'; rsselectafont = 'Select a font'; rsshortsep = 'Sep'; rslongsep = 'September'; @@ -110,6 +113,7 @@ rssize = 'Size'; rsstyle = 'Style'; rsshortsun = 'Sun'; rslongsun = 'Sunday'; +rstexttoinsert = 'Text to Insert'; rsshortthu = 'Thu'; rslongthu = 'Thursday'; rstoday = 'Today'; diff --git a/src/corelib/lang_es.inc b/src/corelib/lang_es.inc index 37ae2836..099f1939 100644 --- a/src/corelib/lang_es.inc +++ b/src/corelib/lang_es.inc @@ -20,6 +20,7 @@ rsbold = 'Negrita'; rscancel = 'Cancelar'; rscannotcreatedir = 'No se puede crear la carpeta'; rschange = 'Cambiar'; +rscharactermap = 'Character Map'; rsclose = 'Cerrar'; rscollection = 'Colección'; rsconfirm = 'Confirmar'; @@ -60,6 +61,7 @@ rshelp = 'Ayuda'; rsignore = 'Ignorar'; rsinformation = 'Información'; rsinsert = 'Insertar'; +rsinsertfromcharactermap = 'Insert from Character Map'; rsitalic = 'Italica'; rserritemofwrongtype = 'El item no es del tipo <%s>!'; rsshortjan = 'Jan'; @@ -101,6 +103,7 @@ rssave = 'Guardar'; rssaveafile = 'Guardar como'; rssearch = 'Buscar'; rsselect = 'Seleccionar'; +rsselectadirectory = 'Seleccione un directorio'; rsselectafont = 'Seleccione una fuente'; rsshortsep = 'Sep'; rslongsep = 'September'; @@ -110,6 +113,7 @@ rssize = 'Tamaño'; rsstyle = 'Estilo'; rsshortsun = 'Dom'; rslongsun = 'Domingo'; +rstexttoinsert = 'Text to Insert'; rsshortthu = 'Jun'; rslongthu = 'Jueves'; rstoday = 'Today'; diff --git a/src/corelib/lang_fr.inc b/src/corelib/lang_fr.inc index bac60936..b75ee215 100644 --- a/src/corelib/lang_fr.inc +++ b/src/corelib/lang_fr.inc @@ -20,6 +20,7 @@ rsbold = 'Gras'; rscancel = 'Annuler'; rscannotcreatedir = 'Impossible de créer le répertoire'; rschange = 'Modifier'; +rscharactermap = 'Character Map'; rsclose = 'Fermer'; rscollection = 'Collection'; rsconfirm = 'Confirmer'; @@ -60,6 +61,7 @@ rshelp = 'Aide'; rsignore = 'Ignorer'; rsinformation = 'Information'; rsinsert = 'Insérer'; +rsinsertfromcharactermap = 'Insert from Character Map'; rsitalic = 'Italique'; rserritemofwrongtype = 'L''''item n''''est pas du type <%s>!'; rsshortjan = 'Jan'; @@ -101,6 +103,7 @@ rssave = 'Sauver'; rssaveafile = 'Sauver sous'; rssearch = 'Chercher'; rsselect = 'Selectionner'; +rsselectadirectory = 'Sélectionner un répertoire'; rsselectafont = 'Choisir la police'; rsshortsep = 'Sep'; rslongsep = 'Septembre'; @@ -110,6 +113,7 @@ rssize = 'Taille'; rsstyle = 'Style'; rsshortsun = 'Dim'; rslongsun = 'Dimanche'; +rstexttoinsert = 'Text to Insert'; rsshortthu = 'Jeu'; rslongthu = 'Jeudi'; rstoday = 'Aujourd''''hui'; diff --git a/src/corelib/lang_it.inc b/src/corelib/lang_it.inc index f3223386..ece9f08f 100644 --- a/src/corelib/lang_it.inc +++ b/src/corelib/lang_it.inc @@ -20,6 +20,7 @@ rsbold = 'Grassetto'; rscancel = 'Annulla'; rscannotcreatedir = 'Non riesco a creare la cartella'; rschange = 'Cambia'; +rscharactermap = 'Character Map'; rsclose = 'Chiudi'; rscollection = 'Collezione'; rsconfirm = 'Conferma'; @@ -60,6 +61,7 @@ rshelp = 'Aiuto'; rsignore = 'Ignora'; rsinformation = 'Informazione'; rsinsert = 'Inserisci'; +rsinsertfromcharactermap = 'Insert from Character Map'; rsitalic = 'Italico'; rserritemofwrongtype = 'L''''elemento non è del tipo <%s> !'; rsshortjan = 'Gen'; @@ -101,6 +103,7 @@ rssave = 'Salva'; rssaveafile = 'Salva con nome'; rssearch = 'Cerca'; rsselect = 'Seleziona'; +rsselectadirectory = 'Selezionare una directory'; rsselectafont = 'Seleziona un font'; rsshortsep = 'Set'; rslongsep = 'Settembre'; @@ -110,6 +113,7 @@ rssize = 'Dimensione'; rsstyle = 'Stile'; rsshortsun = 'Dom'; rslongsun = 'Domenica'; +rstexttoinsert = 'Text to Insert'; rsshortthu = 'Gio'; rslongthu = 'Giovedì'; rstoday = 'Oggi'; diff --git a/src/corelib/lang_pt.inc b/src/corelib/lang_pt.inc index 0863168f..b6a2d330 100644 --- a/src/corelib/lang_pt.inc +++ b/src/corelib/lang_pt.inc @@ -20,6 +20,7 @@ rsbold = 'Negrito'; rscancel = 'Cancelar'; rscannotcreatedir = 'Não foi possÃvel criar diretório'; rschange = 'Editar'; +rscharactermap = 'Character Map'; rsclose = 'Fechar'; rscollection = 'Coleção'; rsconfirm = 'Confirmar'; @@ -60,6 +61,7 @@ rshelp = 'Ajuda'; rsignore = 'Ignorar'; rsinformation = 'Informação'; rsinsert = 'Inserir'; +rsinsertfromcharactermap = 'Insert from Character Map'; rsitalic = 'Itálico'; rserritemofwrongtype = 'Item is not of <%s> type!'; rsshortjan = 'Jan'; @@ -101,6 +103,7 @@ rssave = 'Salvar'; rssaveafile = 'Salvar arquivo como'; rssearch = 'Pesquisar'; rsselect = 'Selecionar'; +rsselectadirectory = 'Selecione um diretório'; rsselectafont = 'Selecione a fonte'; rsshortsep = 'Sep'; rslongsep = 'September'; @@ -110,6 +113,7 @@ rssize = 'Tamanho'; rsstyle = 'Estilo'; rsshortsun = 'Sun'; rslongsun = 'Sunday'; +rstexttoinsert = 'Text to Insert'; rsshortthu = 'Thu'; rslongthu = 'Thursday'; rstoday = 'Today'; diff --git a/src/corelib/lang_ru.inc b/src/corelib/lang_ru.inc index 86ed9478..f1571f0b 100644 --- a/src/corelib/lang_ru.inc +++ b/src/corelib/lang_ru.inc @@ -20,6 +20,7 @@ rsbold = 'Жирный'; rscancel = 'Отмена'; rscannotcreatedir = 'Ðевозможно Ñоздать директорию'; rschange = 'Изменить'; +rscharactermap = 'Character Map'; rsclose = 'Закрыть'; rscollection = 'Группа'; rsconfirm = 'Подтвердить'; @@ -60,6 +61,7 @@ rshelp = 'Справка'; rsignore = 'ПропуÑтить'; rsinformation = 'ИнформациÑ'; rsinsert = 'Ð’Ñтавка'; +rsinsertfromcharactermap = 'Insert from Character Map'; rsitalic = 'КурÑив'; rserritemofwrongtype = 'Тип Ñлемента отличаетÑÑ Ð¾Ñ‚ <%s>!'; rsshortjan = 'Янв'; @@ -101,6 +103,7 @@ rssave = 'Сохранить'; rssaveafile = 'Сохранить файл как'; rssearch = 'ПоиÑк'; rsselect = 'Выбрать'; +rsselectadirectory = 'Выберите директорию'; rsselectafont = 'Выбор шрифта'; rsshortsep = 'Сен'; rslongsep = 'СентÑбрь'; @@ -110,6 +113,7 @@ rssize = 'Размер'; rsstyle = 'Стиль'; rsshortsun = 'Ð’Ñ'; rslongsun = 'ВоÑкреÑенье'; +rstexttoinsert = 'Text to Insert'; rsshortthu = 'Чт'; rslongthu = 'Четверг'; rstoday = 'СегоднÑ'; diff --git a/src/corelib/predefinedcolors.inc b/src/corelib/predefinedcolors.inc index 897a528d..1e6c4b54 100644 --- a/src/corelib/predefinedcolors.inc +++ b/src/corelib/predefinedcolors.inc @@ -1,4 +1,4 @@ -{%mainunit gfxbase.pas} +{%mainunit fpg_base.pas} // The following colors match the predefined Delphi Colors // NOTE: @@ -63,6 +63,10 @@ clMenuText = TfpgColor(cl_BaseNamedColor + 25); // $80000019; clMenuDisabled = TfpgColor(cl_BaseNamedColor + 26); // $8000001A; clHintWindow = TfpgColor(cl_BaseNamedColor + 27); // $8000001B; + clGridSelection = TfpgColor(cl_BaseNamedColor + 28); + clGridSelectionText = TfpgColor(cl_BaseNamedColor + 29); + clGridInactiveSel = TfpgColor(cl_BaseNamedColor + 30); + clGridInactiveSelText = TfpgColor(cl_BaseNamedColor + 31); diff --git a/src/corelib/stdimages.inc b/src/corelib/stdimages.inc index 647d2e3b..0c880278 100644 --- a/src/corelib/stdimages.inc +++ b/src/corelib/stdimages.inc @@ -1,4 +1,4 @@ -{%mainunit gfx_stdimages.pas} +{%mainunit fpg_stdimages.pas} Const stdimg_list_add_16 : Array[0..821] of byte = ( @@ -1018,6 +1018,20 @@ Const 0,224, 0, 0, 0); Const + stdimg_ellipse : Array[0..181] of byte = ( + 66, 77,182, 0, 0, 0, 0, 0, 0, 0, 54, 0, 0, 0, 40, 0, 0, + 0, 10, 0, 0, 0, 4, 0, 0, 0, 1, 0, 24, 0, 0, 0, 0, 0, + 128, 0, 0, 0, 19, 11, 0, 0, 19, 11, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0,255, 0,229,255, 0,229,255, 0,229,255, 0,229,255, 0, + 229,255, 0,229,255, 0,229,255, 0,229,255, 0,229,255, 0,229, 0, + 0,255, 0,229, 0, 0, 0, 0, 0, 0,255, 0,229, 0, 0, 0, 0, + 0, 0,255, 0,229, 0, 0, 0, 0, 0, 0,255, 0,229, 0, 0,255, + 0,229, 0, 0, 0, 0, 0, 0,255, 0,229, 0, 0, 0, 0, 0, 0, + 255, 0,229, 0, 0, 0, 0, 0, 0,255, 0,229, 0, 0,255, 0,229, + 255, 0,229,255, 0,229,255, 0,229,255, 0,229,255, 0,229,255, 0, + 229,255, 0,229,255, 0,229,255, 0,229, 0, 0); + +Const stdimg_refresh_16 : Array[0..821] of byte = ( 66, 77, 54, 3, 0, 0, 0, 0, 0, 0, 54, 0, 0, 0, 40, 0, 0, 0, 16, 0, 0, 0, 16, 0, 0, 0, 1, 0, 24, 0, 0, 0, 0, 0, @@ -1957,6 +1971,58 @@ Const 255,255,255,255,255,255); Const + stdimg_folder_open_file_16 : Array[0..821] of byte = ( + 66, 77, 54, 3, 0, 0, 0, 0, 0, 0, 54, 0, 0, 0, 40, 0, 0, + 0, 16, 0, 0, 0, 16, 0, 0, 0, 1, 0, 24, 0, 0, 0, 0, 0, + 0, 3, 0, 0,215, 13, 0, 0,215, 13, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0,255,255,255,255,255,255,255,255,255,255,255,255,255,255, + 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, + 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, + 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, + 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, + 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, + 165,129,103,139, 82, 41,139, 82, 41,157,108, 74,157,108, 74,157,108, + 74,157,108, 74,157,108, 74,157,108, 74,157,108, 74,157,108, 74,157, + 108, 74,139, 82, 41,145,110, 84,255,255,255,255,255,255,139, 82, 41, + 209,165,123,210,165,124,210,165,124,210,165,124,210,165,124,210,165, + 124,210,165,124,210,165,124,210,165,124,210,165,124,210,165,124,209, + 165,123,139, 82, 41,255,255,255,255,255,255,157,104, 63,208,161,116, + 207,159,114,207,159,114,207,159,114,207,159,114,207,159,114,207,159, + 114,207,159,114,207,159,114,207,159,114,207,159,114,208,161,116,139, + 82, 41,255,255,255,139, 82, 41,196,151,112,208,162,119,207,160,117, + 207,160,117,207,160,117,207,160,117,207,160,117,207,160,117,207,160, + 117,207,160,117,207,160,117,207,160,117,208,162,119,196,151,112,139, + 82, 41,139, 82, 41,206,164,127,210,165,123,209,164,122,209,164,122, + 209,164,122,209,164,122,209,164,122,209,164,122,209,164,122,209,164, + 122,209,164,122,209,164,122,210,166,124,212,169,129,139, 82, 41,139, + 82, 41,215,180,148,220,186,153,220,186,153,220,186,153,220,185,152, + 216,179,143,212,169,130,211,168,127,211,168,127,211,168,127,211,168, + 127,211,168,127,212,168,128,209,169,133,139, 82, 41,139, 82, 41,139, + 82, 41,139, 82, 41,139, 82, 41,139, 82, 41,139, 82, 41,139, 82, 41, + 210,173,142,218,180,145,217,179,145,217,179,145,217,179,145,217,179, + 145,217,180,145,217,183,152,139, 82, 41,255,255,255,139, 82, 41,127, + 120,111,253,253,253,248,249,249,243,241,240,205,137, 89,139, 82, 41, + 139, 82, 41,139, 82, 41,139, 82, 41,139, 82, 41,139, 82, 41,139, 82, + 41,139, 82, 41,139, 82, 41,255,255,255,139, 82, 41,142,136,127,242, + 242,242,241,242,241,241,241,241,205,137, 89,255,247,240,253,231,214, + 253,230,212,252,228,208,251,227,203,254,243,232,205,136, 88,139, 82, + 41,255,255,255,255,255,255,139, 82, 41,177,154,132,151,138,124,150, + 137,123,148,136,121,205,137, 89,255,247,242, 92, 92, 92, 92, 92, 92, + 92, 92, 92, 92, 92, 92,253,242,231,205,137, 89,139, 82, 41,255,255, + 255,255,255,255,139, 82, 41,218,183,153,212,172,137,212,172,137,213, + 174,140,205,136, 88,254,247,241,252,228,209,251,226,204,249,221,196, + 247,218,192,252,242,233,205,137, 89,139, 82, 41,255,255,255,255,255, + 255,157,103, 62,197,159,132,213,181,155,213,181,155,211,179,152,204, + 135, 87,255,247,241, 93, 93, 93, 92, 92, 92, 92, 92, 92,254,249,243, + 255,247,240,205,137, 89,255,255,255,255,255,255,255,255,255,255,255, + 255,139, 82, 41,139, 82, 41,139, 82, 41,139, 82, 41,205,137, 89,255, + 247,240,255,247,240,255,247,240,255,247,240,255,247,240,255,247,240, + 205,137, 89,255,255,255,255,255,255,255,255,255,255,255,255,255,255, + 255,255,255,255,255,255,255,255,255,255,205,137, 89,205,137, 89,205, + 137, 89,205,137, 89,205,137, 89,205,137, 89,205,137, 89,205,137, 89, + 255,255,255,255,255,255); + +Const stdimg_btn_close_16 : Array[0..821] of byte = ( 66, 77, 54, 3, 0, 0, 0, 0, 0, 0, 54, 0, 0, 0, 40, 0, 0, 0, 16, 0, 0, 0, 16, 0, 0, 0, 1, 0, 24, 0, 0, 0, 0, 0, @@ -2624,3 +2690,57 @@ Const 255,221,223,222,145,149,148,162,166,165,255,255,255,255,255,255,255, 255,255,255,255,255,185,187,186,148,152,150,255,255,255,255,255,255, 255,255,255,255,255,255); + +Const + stdimg_menu_check_16 : Array[0..821] of byte = ( + 66, 77, 54, 3, 0, 0, 0, 0, 0, 0, 54, 0, 0, 0, 40, 0, 0, + 0, 16, 0, 0, 0, 16, 0, 0, 0, 1, 0, 24, 0, 0, 0, 0, 0, + 0, 3, 0, 0, 19, 11, 0, 0, 19, 11, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255, 0, 0, 0,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255, 0, 0, 0, 0, 0, 0, 0, 0, 0,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255, 0, 0, 0, 0, 0, 0, + 255, 0,255, 0, 0, 0, 0, 0, 0, 0, 0, 0,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255, 0, 0, 0,255, 0,255,255, 0,255, + 255, 0,255, 0, 0, 0, 0, 0, 0, 0, 0, 0,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255, 0, 0, 0, 0, 0, 0,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255, 0, 0, 0,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0, + 255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, + 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255,255, 0,255, + 255, 0,255,255, 0,255); + + diff --git a/src/corelib/x11/fpg_impl.pas b/src/corelib/x11/fpg_impl.pas index 81b8012c..c4ebbe8f 100644 --- a/src/corelib/x11/fpg_impl.pas +++ b/src/corelib/x11/fpg_impl.pas @@ -1,7 +1,7 @@ { - fpGUI - Free Pascal GUI Library + fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2010 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/corelib/x11/fpg_interface.pas b/src/corelib/x11/fpg_interface.pas new file mode 100644 index 00000000..c4adf079 --- /dev/null +++ b/src/corelib/x11/fpg_interface.pas @@ -0,0 +1,40 @@ +{ + fpGUI - Free Pascal GUI Toolkit + + Copyright (C) 2006 - 2010 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 alias types to bind each backend graphics library + to fpg_main without the need for IFDEF's +} + +unit fpg_interface; + +{$mode objfpc}{$H+} + +interface + +uses + fpg_x11; + +type + TfpgFontResourceImpl = TfpgX11FontResource; + TfpgImageImpl = TfpgX11Image; + TfpgCanvasImpl = TfpgX11Canvas; + TfpgWindowImpl = TfpgX11Window; + TfpgApplicationImpl = TfpgX11Application; + TfpgClipboardImpl = TfpgX11Clipboard; + TfpgFileListImpl = TfpgX11FileList; + +implementation + +end. + diff --git a/src/corelib/x11/fpg_keyconv_x11.pas b/src/corelib/x11/fpg_keyconv_x11.pas index 80c53417..dce0487c 100644 --- a/src/corelib/x11/fpg_keyconv_x11.pas +++ b/src/corelib/x11/fpg_keyconv_x11.pas @@ -1,7 +1,7 @@ { - fpGUI - Free Pascal GUI Library + fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2010 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/corelib/x11/fpg_netlayer_x11.pas b/src/corelib/x11/fpg_netlayer_x11.pas index 6a2aeeb6..bd104dae 100644 --- a/src/corelib/x11/fpg_netlayer_x11.pas +++ b/src/corelib/x11/fpg_netlayer_x11.pas @@ -1,7 +1,7 @@ { - fpGUI - Free Pascal GUI Library + fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2010 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/corelib/x11/fpg_utils_impl.inc b/src/corelib/x11/fpg_utils_impl.inc index 2099addb..d8625b8c 100644 --- a/src/corelib/x11/fpg_utils_impl.inc +++ b/src/corelib/x11/fpg_utils_impl.inc @@ -23,6 +23,8 @@ begin Helper := ''; if fpsystem('which xdg-open') = 0 then Helper := 'xdg-open' + else if FileExists('/usr/bin/sensible-browser') then + Helper := '/usr/bin/sensible-browser' else if FileExists('/etc/alternatives/x-www-browser') then Helper := '/etc/alternatives/x-www-browser' else if fpsystem('which firefox') = 0 then diff --git a/src/corelib/x11/fpg_x11.pas b/src/corelib/x11/fpg_x11.pas index e6696677..3d832130 100644 --- a/src/corelib/x11/fpg_x11.pas +++ b/src/corelib/x11/fpg_x11.pas @@ -1,7 +1,7 @@ { - fpGUI - Free Pascal GUI Library + fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2009 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -52,6 +52,7 @@ type PInt = ^integer; + {$HINTS OFF} TXIC = record dummy: Pointer; end; @@ -62,6 +63,7 @@ type dummy: Pointer; end; PXIM = ^TXIM; + {$HINTS ON} TXdbeSwapInfo = record @@ -109,7 +111,6 @@ const PROP_MWM_HINTS_ELEMENTS = 5; type - TXWindowStateFlag = (xwsfMapped); TXWindowStateFlags = set of TXWindowStateFlag; @@ -117,10 +118,10 @@ type TX11EventFilter = function(const AEvent: TXEvent): Boolean of object; // forward declaration - TfpgWindowImpl = class; + TfpgX11Window = class; - TfpgFontResourceImpl = class(TfpgFontResourceBase) + TfpgX11FontResource = class(TfpgFontResourceBase) private FFontData: PXftFont; function DoGetTextWidthClassic(const txt: string): integer; @@ -138,7 +139,7 @@ type end; - TfpgImageImpl = class(TfpgImageBase) + TfpgX11Image = class(TfpgImageBase) private FXimg: TXImage; FXimgmask: TXImage; @@ -153,14 +154,14 @@ type end; - TfpgCanvasImpl = class(TfpgCanvasBase) + TfpgX11Canvas = class(TfpgCanvasBase) private FDrawing: boolean; - FDrawWindow: TfpgWindowImpl; + FDrawWindow: TfpgX11Window; FBufferPixmap: TfpgDCHandle; FDrawHandle: TfpgDCHandle; Fgc: TfpgGContext; - FCurFontRes: TfpgFontResourceImpl; + FCurFontRes: TfpgX11FontResource; FClipRect: TfpgRect; FClipRectSet: boolean; FXftDraw: PXftDraw; @@ -203,12 +204,12 @@ type end; - TfpgWindowImpl = class(TfpgWindowBase) + TfpgX11Window = class(TfpgWindowBase) protected FWinFlags: TXWindowStateFlags; FWinHandle: TfpgWinHandle; FBackupWinHandle: TfpgWinHandle; // Used by DestroyNotify & UnmapNotify events - FModalForWin: TfpgWindowImpl; + FModalForWin: TfpgX11Window; procedure DoAllocateWindowHandle(AParent: TfpgWindowBase); override; procedure DoReleaseWindowHandle; override; procedure DoRemoveWindowLookup; override; @@ -229,9 +230,9 @@ type end; - TfpgApplicationImpl = class(TfpgApplicationBase) + TfpgX11Application = class(TfpgApplicationBase) private - FComposeBuffer: String[32]; + FComposeBuffer: TfpgString; FComposeStatus: TStatus; FEventFilter: TX11EventFilter; function ConvertShiftState(AState: Cardinal): TShiftState; @@ -268,12 +269,12 @@ type function Screen_dpi_y: integer; override; function Screen_dpi: integer; override; property Display: PXDisplay read FDisplay; - property RootWindow: TfpgWinHandle read FRootWindow; - property EventFilter: TX11EventFilter read FEventFilter write FEventFilter; + property RootWindow: TfpgWinHandle read FRootWindow; platform; + property EventFilter: TX11EventFilter read FEventFilter write FEventFilter; platform; end; - TfpgClipboardImpl = class(TfpgClipboardBase) + TfpgX11Clipboard = class(TfpgClipboardBase) private FWaitingForSelection: Boolean; protected @@ -284,11 +285,13 @@ type end; - TfpgFileListImpl = class(TfpgFileListBase) - function EncodeModeString(FileMode: longword): TFileModeString; - constructor Create; override; + TfpgX11FileList = class(TfpgFileListBase) + protected function InitializeEntry(sr: TSearchRec): TFileEntry; override; procedure PopulateSpecialDirs(const aDirectory: TfpgString); override; + public + constructor Create; override; + function EncodeModeString(FileMode: longword): TFileModeString; end; @@ -299,7 +302,9 @@ implementation uses baseunix, - users, { for *nix user and group name support } + {$IFNDEF DARWIN} + users, { For unix user and group name support. Mac+X11 doesn't like this } + {$ENDIF} fpg_main, fpg_widget, fpg_popupwindow, @@ -383,7 +388,7 @@ type // single direction linked list WindowLookupRec = record - w: TfpgWindowImpl; + w: TfpgX11Window; Next: PWindowLookupRec; end; @@ -391,7 +396,7 @@ var FirstWindowLookupRec: PWindowLookupRec; LastWindowLookupRec: PWindowLookupRec; -procedure AddWindowLookup(w: TfpgWindowImpl); +procedure AddWindowLookup(w: TfpgX11Window); var p: PWindowLookupRec; begin @@ -408,7 +413,7 @@ begin LastWindowLookupRec := p; end; -procedure RemoveWindowLookup(w: TfpgWindowImpl); +procedure RemoveWindowLookup(w: TfpgX11Window); var prevp: PWindowLookupRec; p: PWindowLookupRec; @@ -437,7 +442,7 @@ begin end; end; -function FindWindowByHandle(wh: TfpgWinHandle): TfpgWindowImpl; +function FindWindowByHandle(wh: TfpgWinHandle): TfpgX11Window; var p: PWindowLookupRec; begin @@ -457,7 +462,7 @@ begin Result := nil; end; -function FindWindowByBackupHandle(wh: TfpgWinHandle): TfpgWindowImpl; +function FindWindowByBackupHandle(wh: TfpgWinHandle): TfpgX11Window; var p: PWindowLookupRec; begin @@ -534,7 +539,7 @@ begin e._type := SelectionNotify; e.requestor := ev.xselectionrequest.requestor; e.selection := ev.xselectionrequest.selection; - e.selection := xapplication.xia_clipboard; +// e.selection := xapplication.xia_clipboard; e.target := ev.xselectionrequest.target; e.time := ev.xselectionrequest.time; e._property := ev.xselectionrequest._property; @@ -543,7 +548,7 @@ begin begin a := XA_STRING; XChangeProperty(xapplication.Display, e.requestor, e._property, - XA_ATOM, sizeof(TAtom)*8, 0, PByte(@a), sizeof(TAtom)); + XA_ATOM, 32, PropModeReplace, PByte(@a), Sizeof(TAtom)); // I think last parameter is right? end else begin @@ -566,9 +571,9 @@ begin end; -{ TfpgApplicationImpl } +{ TfpgX11Application } -function TfpgApplicationImpl.ConvertShiftState(AState: Cardinal): TShiftState; +function TfpgX11Application.ConvertShiftState(AState: Cardinal): TShiftState; begin Result := []; if (AState and Button1Mask) <> 0 then @@ -595,7 +600,7 @@ begin Include(Result, ssAltGr); end; -function TfpgApplicationImpl.KeySymToKeycode(KeySym: TKeySym): Word; +function TfpgX11Application.KeySymToKeycode(KeySym: TKeySym): Word; const Table_20aX: array[$20a0..$20ac] of Word = (keyEcuSign, keyColonSign, keyCruzeiroSign, keyFFrancSign, keyLiraSign, keyMillSign, keyNairaSign, @@ -664,17 +669,23 @@ begin {$ENDIF} end; -function TfpgApplicationImpl.StartComposing(const Event: TXEvent): TKeySym; +function TfpgX11Application.StartComposing(const Event: TXEvent): TKeySym; var l: integer; begin + SetLength(FComposeBuffer, 20); // buffer set to some default size // Xutf8LookupString returns the size of FComposeBuffer in bytes. l := Xutf8LookupString(InputContext, @Event.xkey, @FComposeBuffer[1], - SizeOf(FComposeBuffer) - 1, @Result, @FComposeStatus); + Length(FComposeBuffer), @Result, @FComposeStatus); SetLength(FComposeBuffer, l); + // if overflow occured, then previous SetLength() would have fixed the buffer + // size, so run Xutf8LookupString again to read correct value. + if FComposeStatus = XBufferOverflow then + Xutf8LookupString(InputContext, @Event.xkey, @FComposeBuffer[1], + Length(FComposeBuffer), @Result, @FComposeStatus); end; -function TfpgApplicationImpl.DoGetFontFaceList: TStringList; +function TfpgX11Application.DoGetFontFaceList: TStringList; var pfs: PFcFontSet; ppat: PPFcPattern; @@ -682,7 +693,8 @@ var s: string; pc: PChar; begin - pfs := XftListFonts(Display, DefaultScreen, [FC_SCALABLE, FcTypeBool, 1, 0, FC_FAMILY, 0]); + // this now even returns non-scaleable fonts which is what we sometimes want. + pfs := XftListFonts(Display, DefaultScreen, [0, FC_FAMILY, 0]); if pfs = nil then Exit; //==> @@ -706,7 +718,7 @@ begin Result.Sort; end; -constructor TfpgApplicationImpl.Create(const AParams: string); +constructor TfpgX11Application.Create(const AParams: string); begin inherited Create(AParams); FIsInitialized := False; @@ -741,15 +753,14 @@ begin if InputMethod = nil then Exit; - InputContext := XCreateIC(InputMethod, [XNInputStyle, XIMPreeditNothing or XIMStatusNothing, 0]); + InputContext := XCreateIC(InputMethod, [XNInputStyle, XIMPreeditNothing or XIMStatusNothing, nil]); if InputContext = nil then Exit; - FIsInitialized := True; xapplication := TfpgApplication(self); end; -destructor TfpgApplicationImpl.Destroy; +destructor TfpgX11Application.Destroy; begin netlayer.Free; XCloseDisplay(FDisplay); @@ -757,7 +768,7 @@ begin inherited Destroy; end; -function TfpgApplicationImpl.DoMessagesPending: boolean; +function TfpgX11Application.DoMessagesPending: boolean; begin Result := (XPending(display) > 0); end; @@ -823,15 +834,15 @@ begin end; end; -procedure TfpgApplicationImpl.DoWaitWindowMessage(atimeoutms: integer); +procedure TfpgX11Application.DoWaitWindowMessage(atimeoutms: integer); var ev: TXEvent; NewEvent: TXevent; i: integer; r: integer; blockmsg: boolean; - w: TfpgWindowImpl; - ew: TfpgWindowImpl; + w: TfpgX11Window; + ew: TfpgX11Window; kwg: TfpgWidget; wh: TfpgWinHandle; wa: TXWindowAttributes; @@ -848,9 +859,9 @@ var procedure PrintKeyEvent(const event: TXEvent); var keysym: TKeySym; - compose_status: TXComposeStatus; - length: integer; - s: string[10]; + icstatus: TStatus; + l: integer; + s: string; begin case event._type of X.KeyPress: @@ -866,10 +877,12 @@ var writeln('not a key event '); end; end; - length := Xutf8LookupString(InputContext, @event.xkey, @s[1], 9, @keysym, @compose_status); - SetLength(s, length); - if((length > 0) and (length <=9)) then - writeln('result of xlookupstring [' + s + ']'); + SetLength(s, 20); + l := Xutf8LookupString(InputContext, @event.xkey, @s[1], Length(s), @keysym, @icstatus); + SetLength(s, l); + if icstatus = XBufferOverflow then + Xutf8LookupString(InputContext, @event.xkey, @s[1], Length(s), @keysym, @icstatus); + writeln('result of xlookupstring [' + s + ']'); writeln(Format('*** keysym [%s] ', [XKeysymToString(keysym)])); end; @@ -1042,7 +1055,7 @@ begin begin ew := w; while (w <> nil) and (w.Parent <> nil) do - w := TfpgWindowImpl(w.Parent); + w := TfpgX11Window(w.Parent); if (w <> nil) and (PopupListFind(w.WinHandle) = nil) and (not PopupDontCloseWidget(TfpgWidget(ew))) then @@ -1055,7 +1068,7 @@ begin w := FindWindowByHandle(ev.xbutton.window); // restore w if xapplication.TopModalForm <> nil then begin - ew := TfpgWindowImpl(WidgetParentForm(TfpgWidget(w))); + ew := TfpgX11Window(WidgetParentForm(TfpgWidget(w))); if (ew <> nil) and (xapplication.TopModalForm <> ew) and (waUnblockableMessages in ew.WindowAttributes = False) then blockmsg := true; end; @@ -1133,7 +1146,7 @@ begin ReportLostWindow(ev); if xapplication.TopModalForm <> nil then begin - ew := TfpgWindowImpl(WidgetParentForm(TfpgWidget(w))); + ew := TfpgX11Window(WidgetParentForm(TfpgWidget(w))); if (ew <> nil) and (xapplication.TopModalForm <> ew) and (waUnblockableMessages in ew.WindowAttributes = False) then blockmsg := true; end; @@ -1168,7 +1181,7 @@ begin if xapplication.TopModalForm <> nil then begin // This is ugly!!!!!!!!!!!!!!! - ew := TfpgWindowImpl(WidgetParentForm(TfpgWidget(w))); + ew := TfpgX11Window(WidgetParentForm(TfpgWidget(w))); if (ew <> nil) and (xapplication.TopModalForm <> ew) and (waUnblockableMessages in ew.WindowAttributes = False) then blockmsg := true; end; @@ -1271,7 +1284,7 @@ begin if not Assigned(w) then ReportLostWindow(ev) else - RemoveWindowLookup(TfpgWindowImpl(w)); + RemoveWindowLookup(TfpgX11Window(w)); end; X.GraphicsExpose, @@ -1294,28 +1307,28 @@ begin end; end; -procedure TfpgApplicationImpl.DoFlush; +procedure TfpgX11Application.DoFlush; begin XFlush(FDisplay); end; -function TfpgApplicationImpl.GetScreenWidth: TfpgCoord; +function TfpgX11Application.GetScreenWidth: TfpgCoord; var wa: TXWindowAttributes; begin - XGetWindowAttributes(FDisplay, RootWindow, @wa); + XGetWindowAttributes(FDisplay, FRootWindow, @wa); Result := wa.Width; end; -function TfpgApplicationImpl.GetScreenHeight: TfpgCoord; +function TfpgX11Application.GetScreenHeight: TfpgCoord; var wa: TXWindowAttributes; begin - XGetWindowAttributes(FDisplay, RootWindow, @wa); + XGetWindowAttributes(FDisplay, FRootWindow, @wa); Result := wa.Height; end; -function TfpgApplicationImpl.Screen_dpi_x: integer; +function TfpgX11Application.Screen_dpi_x: integer; var mm: integer; begin @@ -1328,7 +1341,7 @@ begin Result := 96; // seems to be a well known default. :-( end; -function TfpgApplicationImpl.Screen_dpi_y: integer; +function TfpgX11Application.Screen_dpi_y: integer; var mm: integer; begin @@ -1341,7 +1354,7 @@ begin Result := Screen_dpi_x; // same as width end; -function TfpgApplicationImpl.Screen_dpi: integer; +function TfpgX11Application.Screen_dpi: integer; begin Result := Screen_dpi_y; {$IFDEF DEBUG} @@ -1351,9 +1364,9 @@ begin {$ENDIF} end; -{ TfpgWindowImpl } +{ TfpgX11Window } -procedure TfpgWindowImpl.DoAllocateWindowHandle(AParent: TfpgWindowBase); +procedure TfpgX11Window.DoAllocateWindowHandle(AParent: TfpgWindowBase); var pwh: TfpgWinHandle; wh: TfpgWinHandle; @@ -1372,7 +1385,7 @@ begin Exit; //==> if AParent <> nil then - pwh := TfpgWindowImpl(AParent).WinHandle + pwh := TfpgX11Window(AParent).WinHandle else pwh := xapplication.RootWindow; @@ -1385,6 +1398,7 @@ begin end; AdjustWindowStyle; + wh := XCreateWindow(xapplication.Display, pwh, FLeft, FTop, FWidth, FHeight, 0, CopyFromParent, @@ -1461,9 +1475,9 @@ begin begin lmwh := 0; if fpgApplication.PrevModalForm <> nil then - lmwh := TfpgWindowImpl(fpgApplication.PrevModalForm).WinHandle + lmwh := TfpgX11Window(fpgApplication.PrevModalForm).WinHandle else if fpgApplication.MainForm <> nil then - lmwh := TfpgWindowImpl(fpgApplication.MainForm).WinHandle; + lmwh := TfpgX11Window(fpgApplication.MainForm).WinHandle; if lmwh <> 0 then begin XSetTransientForHint(xapplication.display, FWinHandle, lmwh); @@ -1483,7 +1497,7 @@ begin prop := XInternAtom(xapplication.display, '_MOTIF_WM_INFO', longbool(0)); if prop = X.None then begin - writeln('Window Manager does not support MWM hints. Bypassing window manager control for borderless window.'); +// writeln('Window Manager does not support MWM hints. Bypassing window manager control for borderless window.'); // Set Override Redirect here! mwmhints.flags := 0; end @@ -1514,7 +1528,7 @@ begin AddWindowLookup(self); end; -procedure TfpgWindowImpl.DoReleaseWindowHandle; +procedure TfpgX11Window.DoReleaseWindowHandle; //var // lCallTrace: IInterface; begin @@ -1533,13 +1547,13 @@ begin FWinHandle := 0; end; -procedure TfpgWindowImpl.DoRemoveWindowLookup; +procedure TfpgX11Window.DoRemoveWindowLookup; begin // PrintCallTraceDbgLn('RemoveWindowLookup ' + Name + ' [' + Classname + ']'); RemoveWindowLookup(self); end; -procedure TfpgWindowImpl.DoSetWindowVisible(const AValue: Boolean); +procedure TfpgX11Window.DoSetWindowVisible(const AValue: Boolean); begin if AValue then begin @@ -1562,34 +1576,34 @@ begin end; end; -function TfpgWindowImpl.HandleIsValid: boolean; +function TfpgX11Window.HandleIsValid: boolean; begin Result := (FWinHandle > 0); end; -procedure TfpgWindowImpl.DoMoveWindow(const x: TfpgCoord; const y: TfpgCoord); +procedure TfpgX11Window.DoMoveWindow(const x: TfpgCoord; const y: TfpgCoord); begin if HandleIsValid then XMoveWindow(xapplication.display, FWinHandle, x, y); end; -function TfpgWindowImpl.DoWindowToScreen(ASource: TfpgWindowBase; const AScreenPos: TPoint): TPoint; +function TfpgX11Window.DoWindowToScreen(ASource: TfpgWindowBase; const AScreenPos: TPoint): TPoint; var dx: integer; dy: integer; cw: TfpgWinHandle; begin - if not TfpgWindowImpl(ASource).HandleIsValid then + if not TfpgX11Window(ASource).HandleIsValid then Exit; //==> - XTranslateCoordinates(xapplication.display, TfpgWindowImpl(ASource).WinHandle, + XTranslateCoordinates(xapplication.display, TfpgX11Window(ASource).WinHandle, XDefaultRootWindow(xapplication.display), AScreenPos.X, AScreenPos.Y, @dx, @dy, @cw); Result.X := dx; Result.Y := dy; end; -procedure TfpgWindowImpl.DoUpdateWindowPosition; +procedure TfpgX11Window.DoUpdateWindowPosition; var w: longword; h: longword; @@ -1607,14 +1621,17 @@ begin XMoveResizeWindow(xapplication.display, FWinHandle, FLeft, FTop, w, h); end; -procedure TfpgWindowImpl.DoSetMouseCursor; +procedure TfpgX11Window.DoSetMouseCursor; var xc: TCursor; shape: integer; begin if not HasHandle then + begin + FMouseCursorIsDirty := True; Exit; //==> - + end; + case FMouseCursor of mcSizeEW: shape := XC_sb_h_double_arrow; mcSizeNS: shape := XC_sb_v_double_arrow; @@ -1634,9 +1651,11 @@ begin xc := XCreateFontCursor(xapplication.Display, shape); XDefineCursor(xapplication.Display, FWinHandle, xc); XFreeCursor(xapplication.Display, xc); + + FMouseCursorIsDirty := False; end; -procedure TfpgWindowImpl.DoSetWindowTitle(const ATitle: string); +procedure TfpgX11Window.DoSetWindowTitle(const ATitle: string); var tp: TXTextProperty; begin @@ -1656,19 +1675,19 @@ begin XSetWMIconName(xapplication.Display, FWinHandle, @tp); end; -constructor TfpgWindowImpl.Create(AOwner: TComponent); +constructor TfpgX11Window.Create(AOwner: TComponent); begin inherited Create(AOwner); FWinHandle := 0; FBackupWinHandle := 0; end; -procedure TfpgWindowImpl.ActivateWindow; +procedure TfpgX11Window.ActivateWindow; begin XSetInputFocus(xapplication.Display, FWinHandle, RevertToParent, CurrentTime); end; -procedure TfpgWindowImpl.CaptureMouse; +procedure TfpgX11Window.CaptureMouse; begin XGrabPointer(xapplication.Display, FWinHandle, TBool(False), @@ -1682,20 +1701,20 @@ begin ); end; -procedure TfpgWindowImpl.ReleaseMouse; +procedure TfpgX11Window.ReleaseMouse; begin XUngrabPointer(xapplication.display, CurrentTime); end; -procedure TfpgWindowImpl.SetFullscreen(AValue: Boolean); +procedure TfpgX11Window.SetFullscreen(AValue: Boolean); begin inherited SetFullscreen(AValue); fpgApplication.netlayer.WindowSetFullscreen(FWinHandle, AValue); end; -{ TfpgFontResourceImpl } +{ TfpgX11FontResource } -function TfpgFontResourceImpl.DoGetTextWidthClassic(const txt: string): integer; +function TfpgX11FontResource.DoGetTextWidthClassic(const txt: string): integer; var extents: TXGlyphInfo; begin @@ -1703,7 +1722,7 @@ begin Result := extents.xOff; end; -function TfpgFontResourceImpl.DoGetTextWidthWorkaround(const txt: string): integer; +function TfpgX11FontResource.DoGetTextWidthWorkaround(const txt: string): integer; var extents: TXGlyphInfo; ch: string; @@ -1719,40 +1738,40 @@ begin end; end; -constructor TfpgFontResourceImpl.Create(const afontdesc: string); +constructor TfpgX11FontResource.Create(const afontdesc: string); begin FFontData := XftFontOpenName(xapplication.display, xapplication.DefaultScreen, PChar(afontdesc)); end; -destructor TfpgFontResourceImpl.Destroy; +destructor TfpgX11FontResource.Destroy; begin if HandleIsValid then XftFontClose(xapplication.Display, FFontData); inherited; end; -function TfpgFontResourceImpl.HandleIsValid: boolean; +function TfpgX11FontResource.HandleIsValid: boolean; begin Result := (FFontData <> nil); end; -function TfpgFontResourceImpl.GetAscent: integer; +function TfpgX11FontResource.GetAscent: integer; begin Result := FFontData^.ascent; end; -function TfpgFontResourceImpl.GetDescent: integer; +function TfpgX11FontResource.GetDescent: integer; begin Result := FFontData^.descent; end; -function TfpgFontResourceImpl.GetHeight: integer; +function TfpgX11FontResource.GetHeight: integer; begin // Do NOT use FFontData^.height as it isn't as accurate Result := GetAscent + GetDescent; end; -function TfpgFontResourceImpl.GetTextWidth(const txt: string): integer; +function TfpgX11FontResource.GetTextWidth(const txt: string): integer; begin if length(txt) < 1 then begin @@ -1767,9 +1786,9 @@ begin Result := DoGetTextWidthWorkaround(txt); end; -{ TfpgCanvasImpl } +{ TfpgX11Canvas } -constructor TfpgCanvasImpl.Create; +constructor TfpgX11Canvas.Create; begin inherited; FDrawing := False; @@ -1782,7 +1801,7 @@ begin FClipRegion := nil; end; -destructor TfpgCanvasImpl.Destroy; +destructor TfpgX11Canvas.Destroy; begin if FDrawing then DoEndDraw; @@ -1791,7 +1810,7 @@ begin inherited Destroy; end; -procedure TfpgCanvasImpl.DoBeginDraw(awin: TfpgWindowBase; buffered: boolean); +procedure TfpgX11Canvas.DoBeginDraw(awin: TfpgWindowBase; buffered: boolean); var x: integer; y: integer; @@ -1804,15 +1823,15 @@ var pmh: longword; GcValues: TXGcValues; begin - if Assigned(TfpgWindowImpl(awin)) then + if Assigned(TfpgX11Window(awin)) then begin // This occurs every now and again with TfpgMemo and InvertCaret painting! // Investigate this. - if not TfpgWindowImpl(awin).HasHandle then + if not TfpgX11Window(awin).HasHandle then raise Exception.Create('Window doesn''t have a Handle'); end; - XGetGeometry(xapplication.display, TfpgWindowImpl(awin).FWinHandle, @rw, @x, @y, @w, @h, @bw, @d); + XGetGeometry(xapplication.display, TfpgX11Window(awin).FWinHandle, @rw, @x, @y, @w, @h, @bw, @d); if FDrawing and buffered and (FBufferPixmap > 0) then if FBufferPixmap > 0 then @@ -1825,7 +1844,7 @@ begin if not FDrawing then begin - FDrawWindow := TfpgWindowImpl(awin); + FDrawWindow := TfpgX11Window(awin); if buffered then begin @@ -1881,13 +1900,12 @@ begin XDefaultColormap(xapplication.display, xapplication.DefaultScreen)); FClipRegion := XCreateRegion; - end; FDrawing := True; end; -procedure TfpgCanvasImpl.DoPutBufferToScreen(x, y, w, h: TfpgCoord); +procedure TfpgX11Canvas.DoPutBufferToScreen(x, y, w, h: TfpgCoord); var cgc: TfpgGContext; GcValues: TXGcValues; @@ -1900,7 +1918,7 @@ begin end; end; -procedure TfpgCanvasImpl.DoEndDraw; +procedure TfpgX11Canvas.DoEndDraw; begin if FDrawing then begin @@ -1916,7 +1934,7 @@ begin end; end; -function TfpgCanvasImpl.GetPixel(X, Y: integer): TfpgColor; +function TfpgX11Canvas.GetPixel(X, Y: integer): TfpgColor; var Image: PXImage; Pixel: Cardinal; @@ -1941,7 +1959,7 @@ begin end; end; -procedure TfpgCanvasImpl.SetPixel(X, Y: integer; const AValue: TfpgColor); +procedure TfpgX11Canvas.SetPixel(X, Y: integer; const AValue: TfpgColor); var oldColor: TfpgColor; begin @@ -1951,19 +1969,19 @@ begin SetColor(oldColor); end; -procedure TfpgCanvasImpl.DoDrawArc(x, y, w, h: TfpgCoord; a1, a2: Extended); +procedure TfpgX11Canvas.DoDrawArc(x, y, w, h: TfpgCoord; a1, a2: Extended); begin XDrawArc(xapplication.display, FDrawHandle, Fgc, x, y, w-1, h-1, Trunc(64 * a1), Trunc(64 * a2)); end; -procedure TfpgCanvasImpl.DoFillArc(x, y, w, h: TfpgCoord; a1, a2: Extended); +procedure TfpgX11Canvas.DoFillArc(x, y, w, h: TfpgCoord; a1, a2: Extended); begin XFillArc(xapplication.display, FDrawHandle, Fgc, x, y, w, h, Trunc(64 * a1), Trunc(64 * a2)); end; -procedure TfpgCanvasImpl.DoDrawPolygon(Points: fpg_base.PPoint; NumPts: Integer; Winding: boolean); +procedure TfpgX11Canvas.DoDrawPolygon(Points: fpg_base.PPoint; NumPts: Integer; Winding: boolean); var PointArray: PXPoint; i: integer; @@ -1980,7 +1998,7 @@ begin FreeMem(PointArray); end; -procedure TfpgCanvasImpl.BufferFreeTimer(Sender: TObject); +procedure TfpgX11Canvas.BufferFreeTimer(Sender: TObject); begin {$IFDEF DEBUG} WriteLn('fpGFX/X11: Freeing Buffer w=', FPixWidth, ' h=', FPixHeight); @@ -1989,31 +2007,31 @@ begin FreeAndNil(FBufferFreeTimer); end; -procedure TfpgCanvasImpl.TryFreePixmap; +procedure TfpgX11Canvas.TryFreePixmap; begin if FBufferPixmap > 0 then XFreePixmap(xapplication.Display, FBufferPixmap); FBufferPixmap := 0; end; -procedure TfpgCanvasImpl.DoSetFontRes(fntres: TfpgFontResourceBase); +procedure TfpgX11Canvas.DoSetFontRes(fntres: TfpgFontResourceBase); begin if fntres = nil then Exit; //==> - FCurFontRes := TfpgFontResourceImpl(fntres); + FCurFontRes := TfpgX11FontResource(fntres); end; -procedure TfpgCanvasImpl.DoSetTextColor(cl: TfpgColor); +procedure TfpgX11Canvas.DoSetTextColor(cl: TfpgColor); begin SetXftColor(cl, FColorTextXft); end; -procedure TfpgCanvasImpl.DoSetColor(cl: TfpgColor); +procedure TfpgX11Canvas.DoSetColor(cl: TfpgColor); begin XSetForeGround(xapplication.display, Fgc, fpgColorToX(cl)); end; -procedure TfpgCanvasImpl.DoSetLineStyle(awidth: integer; astyle: TfpgLineStyle); +procedure TfpgX11Canvas.DoSetLineStyle(awidth: integer; astyle: TfpgLineStyle); const cDot: array[0..1] of Char = #1#1; cDash: array[0..1] of Char = #4#2; @@ -2060,7 +2078,7 @@ begin end; { case } end; -procedure TfpgCanvasImpl.DoDrawString(x, y: TfpgCoord; const txt: string); +procedure TfpgX11Canvas.DoDrawString(x, y: TfpgCoord; const txt: string); begin if Length(txt) < 1 then Exit; //==> @@ -2069,7 +2087,7 @@ begin y + FCurFontRes.GetAscent, PChar(txt), Length(txt)); end; -procedure TfpgCanvasImpl.DoGetWinRect(out r: TfpgRect); +procedure TfpgX11Canvas.DoGetWinRect(out r: TfpgRect); var rw: TfpgWinHandle; x: integer; @@ -2083,12 +2101,12 @@ begin @(r.width), @(r.height), @bw, @d); end; -procedure TfpgCanvasImpl.DoFillRectangle(x, y, w, h: TfpgCoord); +procedure TfpgX11Canvas.DoFillRectangle(x, y, w, h: TfpgCoord); begin XFillRectangle(xapplication.display, FDrawHandle, Fgc, x, y, w, h); end; -procedure TfpgCanvasImpl.DoXORFillRectangle(col: TfpgColor; x, y, w, h: TfpgCoord); +procedure TfpgX11Canvas.DoXORFillRectangle(col: TfpgColor; x, y, w, h: TfpgCoord); begin XSetForeGround(xapplication.display, Fgc, fpgColorToX(fpgColorToRGB(col))); XSetFunction(xapplication.display, Fgc, GXxor); @@ -2097,7 +2115,7 @@ begin XSetFunction(xapplication.display, Fgc, GXcopy); end; -procedure TfpgCanvasImpl.DoFillTriangle(x1, y1, x2, y2, x3, y3: TfpgCoord); +procedure TfpgX11Canvas.DoFillTriangle(x1, y1, x2, y2, x3, y3: TfpgCoord); var pts: array[1..3] of TXPoint; begin @@ -2108,20 +2126,23 @@ begin XFillPolygon(xapplication.display, FDrawHandle, Fgc, @pts, 3, CoordModeOrigin, X.Complex); end; -procedure TfpgCanvasImpl.DoDrawRectangle(x, y, w, h: TfpgCoord); +procedure TfpgX11Canvas.DoDrawRectangle(x, y, w, h: TfpgCoord); begin // writeln(Format('DoDrawRectangle x=%d y=%d w=%d h=%d', [x, y, w, h])); // Same behavior as Windows. See documentation for reason. - XDrawRectangle(xapplication.display, FDrawHandle, Fgc, x, y, w-1, h-1); + if (w = 1) and (h = 1) then // a dot + DoDrawLine(x, y, x+w, y+w) + else + XDrawRectangle(xapplication.display, FDrawHandle, Fgc, x, y, w-1, h-1); end; -procedure TfpgCanvasImpl.DoDrawLine(x1, y1, x2, y2: TfpgCoord); +procedure TfpgX11Canvas.DoDrawLine(x1, y1, x2, y2: TfpgCoord); begin // Same behavior as Windows. See documentation for reason. XDrawLine(xapplication.display, FDrawHandle, Fgc, x1, y1, x2, y2); end; -procedure TfpgCanvasImpl.DoSetClipRect(const ARect: TfpgRect); +procedure TfpgX11Canvas.DoSetClipRect(const ARect: TfpgRect); var r: TXRectangle; rg: TRegion; @@ -2142,12 +2163,12 @@ begin XDestroyRegion(rg); end; -function TfpgCanvasImpl.DoGetClipRect: TfpgRect; +function TfpgX11Canvas.DoGetClipRect: TfpgRect; begin Result := FClipRect; end; -procedure TfpgCanvasImpl.DoAddClipRect(const ARect: TfpgRect); +procedure TfpgX11Canvas.DoAddClipRect(const ARect: TfpgRect); var r: TXRectangle; rg: TRegion; @@ -2169,7 +2190,7 @@ begin XDestroyRegion(rg); end; -procedure TfpgCanvasImpl.DoClearClipRect; +procedure TfpgX11Canvas.DoClearClipRect; var r: TfpgRect; begin @@ -2178,7 +2199,7 @@ begin FClipRectSet := False; end; -procedure TfpgCanvasImpl.DoDrawImagePart(x, y: TfpgCoord; img: TfpgImageBase; xi, yi, w, h: integer); +procedure TfpgX11Canvas.DoDrawImagePart(x, y: TfpgCoord; img: TfpgImageBase; xi, yi, w, h: integer); var msk: TPixmap; gc2: Tgc; @@ -2201,7 +2222,7 @@ begin XFillRectangle(xapplication.display, msk, gc2, 0, 0, w, h); XSetForeground(xapplication.display, gc2, 1); - XPutImage(xapplication.display, msk, gc2, TfpgImageImpl(img).XImageMask, xi, yi, 0, 0, w, h); + XPutImage(xapplication.display, msk, gc2, TfpgX11Image(img).XImageMask, xi, yi, 0, 0, w, h); drawgc := XCreateGc(xapplication.display, FDrawHandle, 0, @GcValues); XSetClipMask(xapplication.display, drawgc, msk); @@ -2216,19 +2237,19 @@ begin XPutImage(xapplication.display, FDrawHandle, Fgc, TfpgImage(img).XImage, xi, yi, x, y, w, h); end; -{ TfpgImageImpl } +{ TfpgX11Image } -constructor TfpgImageImpl.Create; +constructor TfpgX11Image.Create; begin inherited Create; end; -procedure TfpgImageImpl.DoFreeImage; +procedure TfpgX11Image.DoFreeImage; begin // does nothing on X11 end; -procedure TfpgImageImpl.DoInitImage(acolordepth, awidth, aheight: integer; aimgdata: Pointer); +procedure TfpgX11Image.DoInitImage(acolordepth, awidth, aheight: integer; aimgdata: Pointer); begin FMasked := False; @@ -2275,7 +2296,7 @@ begin XInitImage(@FXimg); end; -procedure TfpgImageImpl.DoInitImageMask(awidth, aheight: integer; aimgdata: Pointer); +procedure TfpgX11Image.DoInitImageMask(awidth, aheight: integer; aimgdata: Pointer); begin FMasked := True; @@ -2305,19 +2326,19 @@ begin XInitImage(@FXimgMask); end; -function TfpgImageImpl.XImage: PXImage; +function TfpgX11Image.XImage: PXImage; begin Result := @FXimg; end; -function TfpgImageImpl.XImageMask: PXImage; +function TfpgX11Image.XImageMask: PXImage; begin Result := @FXimgMask; end; -{ TfpgClipboardImpl } +{ TfpgX11Clipboard } -function TfpgClipboardImpl.DoGetText: TfpgString; +function TfpgX11Clipboard.DoGetText: TfpgString; begin XConvertSelection(xapplication.Display, xapplication.xia_clipboard, XA_STRING, xapplication.xia_clipboard, FClipboardWndHandle, 0); @@ -2333,23 +2354,23 @@ begin Result := FClipboardText; end; -procedure TfpgClipboardImpl.DoSetText(const AValue: TfpgString); +procedure TfpgX11Clipboard.DoSetText(const AValue: TfpgString); begin FClipboardText := AValue; XSetSelectionOwner(xapplication.Display, xapplication.xia_clipboard, FClipboardWndHandle, 0); end; -procedure TfpgClipboardImpl.InitClipboard; +procedure TfpgX11Clipboard.InitClipboard; begin FWaitingForSelection := False; FClipboardWndHandle := XCreateSimpleWindow(xapplication.Display, xapplication.RootWindow, 10, 10, 10, 10, 0, 0, 0); end; -{ TfpgFileListImpl } +{ TfpgX11FileList } -function TfpgFileListImpl.EncodeModeString(FileMode: longword): TFileModeString; +function TfpgX11FileList.EncodeModeString(FileMode: longword): TFileModeString; const modestring: string[9] = 'xwrxwrxwr'; // must be in reverse order var @@ -2372,13 +2393,13 @@ begin end; end; -constructor TfpgFileListImpl.Create; +constructor TfpgX11FileList.Create; begin inherited Create; FHasFileMode := true; end; -function TfpgFileListImpl.InitializeEntry(sr: TSearchRec): TFileEntry; +function TfpgX11FileList.InitializeEntry(sr: TSearchRec): TFileEntry; var info: Tstat; fullname: TfpgString; @@ -2392,14 +2413,29 @@ begin Result.IsExecutable := ((sr.Mode and $40) <> 0); Result.mode := EncodeModeString(sr.Mode); Fpstat(PChar(fullname), info); - {Result.GroupID := info.st_gid; - Result.OwnerID := info.st_uid;} - Result.Owner := GetUserName(TUID(info.st_uid)); - Result.Group := GetGroupName(TGID(info.st_uid)); + // Especially if files are transfered on removable media the host system + // might not have those user or group ids. So name lookups will fail. This + // simply returns the ID's in such cases. + {$IFNDEF DARWIN} + try + Result.Owner := GetUserName(TUID(info.st_uid)); + except + Result.Owner := IntToStr(info.st_uid); + end; + try + Result.Group := GetGroupName(TGID(info.st_gid)); + except + Result.Group := IntToStr(info.st_gid); + end; + {$ELSE} + // Darwin (Mac-OS) can't seem to use users.pp unit from FPC. A bug in FPC? + Result.Owner := IntToStr(info.st_uid); + Result.Group := IntToStr(info.st_gid); + {$ENDIF} end; end; -procedure TfpgFileListImpl.PopulateSpecialDirs(const aDirectory: TfpgString); +procedure TfpgX11FileList.PopulateSpecialDirs(const aDirectory: TfpgString); var ds: string; begin diff --git a/src/corelib/x11/fpg_xft_x11.pas b/src/corelib/x11/fpg_xft_x11.pas index f517ecf9..22bf3aff 100644 --- a/src/corelib/x11/fpg_xft_x11.pas +++ b/src/corelib/x11/fpg_xft_x11.pas @@ -1,7 +1,7 @@ { - fpGUI - Free Pascal GUI Library + fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -28,7 +28,18 @@ uses ,XLib ,Xutil ; - + +const + {$IF Defined(DARWIN)} + libXft = 'libXft.dylib'; + {$LINKLIB libXft} + fclib = 'libfontconfig.dylib'; + {$LINKLIB libfontconfig} + {$ELSE} + libXft = 'libXft.so'; + fclib = 'libfontconfig.so'; + {$IFEND} + type TPicture = longword; @@ -84,9 +95,47 @@ type PFcFontSet = ^TFcFontSet; const - FC_FAMILY : PChar = 'family'; - FC_SIZE : PChar = 'size'; - FC_SCALABLE : PChar = 'scalable'; +// FC_FAMILY : PChar = 'family'; +// FC_SIZE : PChar = 'size'; +// FC_SCALABLE : PChar = 'scalable'; + + FC_FAMILY = 'family'; //* String */ + FC_STYLE = 'style'; //* String */ + FC_SLANT = 'slant'; //* Int */ + FC_WEIGHT = 'weight'; //* Int */ + FC_SIZE = 'size'; //* Double */ + FC_ASPECT = 'aspect'; //* Double */ + FC_PIXEL_SIZE = 'pixelsize'; //* Double */ + FC_SPACING = 'spacing'; //* Int */ + FC_FOUNDRY = 'foundry'; //* String */ + FC_ANTIALIAS = 'antialias'; //* Bool (depends) */ + FC_HINTING = 'hinting'; //* Bool (true) */ + FC_VERTICAL_LAYOUT = 'verticallayout';//* Bool (false) */ + FC_AUTOHINT = 'autohint'; //* Bool (false) */ + FC_GLOBAL_ADVANCE = 'globaladvance'; //* Bool (true) */ + FC_FILE = 'file'; //* String */ + FC_INDEX = 'index'; //* Int */ + FC_FT_FACE = 'ftface'; //* FT_Face */ + FC_RASTERIZER = 'rasterizer'; //* String */ + FC_OUTLINE = 'outline'; //* Bool */ + FC_SCALABLE = 'scalable'; //* Bool */ + FC_SCALE = 'scale'; //* double */ + FC_DPI = 'dpi'; //* double */ + FC_RGBA = 'rgba'; //* Int */ + FC_MINSPACE = 'minspace'; //* Bool use minimum line spacing */ + FC_SOURCE = 'source'; //* String (X11, freetype) */ + FC_CHARSET = 'charset'; //* CharSet */ + FC_LANG = 'lang'; //* String RFC 3066 langs */ + FC_FONTVERSION = 'fontversion'; //* Int from 'head' table */ + + FC_MATRIX = 'matrix'; + FC_CHAR_WIDTH = 'charwidth'; + + FC_WEIGHT_BOLD = 200; + FC_SLANT_ITALIC = 100; + FC_PROPORTIONAL = 0; + FC_MONO = 100; + FcTypeVoid = 0; FcTypeInteger = 1; @@ -98,64 +147,32 @@ const FcTypeFTFace = 7; FcTypeLangSet = 8; -function XftDrawCreate(display : PXDisplay; win : TXID; vis : PVisual; colorm : longint) : PXftDraw; cdecl; -procedure XftDrawChange(xftd : PXftDraw; win : TXID); cdecl; -procedure XftDrawDestroy(draw : PXftDraw); cdecl; - -function XftDrawPicture(draw : PXftDraw) : TPicture; cdecl; - -function XftFontOpenName(display : PXDisplay; scr : integer; par3 : PChar) : PXftFont; cdecl; -procedure XftFontClose(display : PXDisplay; fnt : PXftFont); cdecl; - -procedure XftDrawStringUtf8(draw : PXftDraw; var col : TXftColor; fnt : PXftFont; x,y : integer; txt : PChar; len : integer); cdecl; -procedure XftDrawString8(draw : PXftDraw; var col : TXftColor; fnt : PXftFont; x,y : integer; txt : PChar; len : integer); cdecl; -procedure XftDrawString16(draw : PXftDraw; var col : TXftColor; fnt : PXftFont; x,y : integer; txt : PChar; len : integer); cdecl; - -procedure XftTextExtentsUtf8(display : PXDisplay; fnt : PXftFont; txt : PChar; len : integer; var extents : TXGlyphInfo); cdecl; -procedure XftTextExtents8(display : PXDisplay; fnt : PXftFont; txt : PChar; len : integer; var extents : TXGlyphInfo); cdecl; -procedure XftTextExtents16(display : PXDisplay; fnt : PXftFont; txt : PChar; len : integer; var extents : TXGlyphInfo); cdecl; - -//function XftGlyphExists(display : PXDisplay; fnt : PXftFont; ch : integer) : longbool; cdecl; -//procedure XftDrawSetClipRectangles(draw : PXftDraw; xorigin, yorigin : integer; rect : PXRectangle; rnum : integer); cdecl; -procedure XftDrawSetClip(draw : PXftDraw; rg : TRegion); cdecl; +function XftDrawCreate(display : PXDisplay; win : TXID; vis : PVisual; colorm : longint) : PXftDraw; cdecl; external libXft; +procedure XftDrawChange(xftd : PXftDraw; win : TXID); cdecl; external libXft; +procedure XftDrawDestroy(draw : PXftDraw); cdecl; external libXft; +function XftDrawPicture(draw : PXftDraw) : TPicture; cdecl; external libXft; +function XftFontOpenName(display : PXDisplay; scr : integer; par3 : PChar) : PXftFont; cdecl; external libXft; +procedure XftFontClose(display : PXDisplay; fnt : PXftFont); cdecl; external libXft; +procedure XftDrawStringUtf8(draw : PXftDraw; var col : TXftColor; fnt : PXftFont; x,y : integer; txt : PChar; len : integer); cdecl; external libXft; +procedure XftDrawString8(draw : PXftDraw; var col : TXftColor; fnt : PXftFont; x,y : integer; txt : PChar; len : integer); cdecl; external libXft; +procedure XftDrawString16(draw : PXftDraw; var col : TXftColor; fnt : PXftFont; x,y : integer; txt : PChar; len : integer); cdecl; external libXft; +procedure XftTextExtentsUtf8(display : PXDisplay; fnt : PXftFont; txt : PChar; len : integer; var extents : TXGlyphInfo); cdecl; external libXft; +procedure XftTextExtents8(display : PXDisplay; fnt : PXftFont; txt : PChar; len : integer; var extents : TXGlyphInfo); cdecl; external libXft; +procedure XftTextExtents16(display : PXDisplay; fnt : PXftFont; txt : PChar; len : integer; var extents : TXGlyphInfo); cdecl; external libXft; +//function XftGlyphExists(display : PXDisplay; fnt : PXftFont; ch : integer) : longbool; cdecl; external libXft; +//procedure XftDrawSetClipRectangles(draw : PXftDraw; xorigin, yorigin : integer; rect : PXRectangle; rnum : integer); cdecl; external libXft; +procedure XftDrawSetClip(draw : PXftDraw; rg : TRegion); cdecl; external libXft; +function XftListFonts(display : PXDisplay; screen : integer; params : array of const) : PFcFontSet; cdecl; external libXft; +function XftNameUnparse(pat : PFcPattern; dest : PChar; destlen : integer) : boolean; cdecl; external libXft; +procedure FcFontSetDestroy(fsp : PFcFontSet); cdecl; external libXft; -function XftListFonts(display : PXDisplay; screen : integer; params : array of const) : PFcFontSet; cdecl; -function XftNameUnparse(pat : PFcPattern; dest : PChar; destlen : integer) : boolean; cdecl; -procedure FcFontSetDestroy(fsp : PFcFontSet); cdecl; +//function FcFontList(config: PFcConfig; p:PFcPattern; os:PFcObjectSet): PFcFontSet;cdecl; external fclib name 'FcFontList'; implementation - -function XftDrawCreate(display : PXDisplay; win : TXID; vis : PVisual; colorm : longint) : PXftDraw; cdecl; external; -procedure XftDrawChange(xftd : PXftDraw; win : TXID); cdecl; external; -procedure XftDrawDestroy(draw : PXftDraw); cdecl; external; - -function XftDrawPicture(draw : PXftDraw) : TPicture; cdecl; external; - -function XftFontOpenName(display : PXDisplay; scr : integer; par3 : PChar) : PXftFont; cdecl; external; -procedure XftFontClose(display : PXDisplay; fnt : PXftFont); cdecl; external; - -procedure XftDrawStringUtf8(draw : PXftDraw; var col : TXftColor; fnt : PXftFont; x,y : integer; txt : PChar; len : integer); cdecl; external; -procedure XftDrawString8(draw : PXftDraw; var col : TXftColor; fnt : PXftFont; x,y : integer; txt : PChar; len : integer); cdecl; external; -procedure XftDrawString16(draw : PXftDraw; var col : TXftColor; fnt : PXftFont; x,y : integer; txt : PChar; len : integer); cdecl; external; - -procedure XftTextExtentsUtf8(display : PXDisplay; fnt : PXftFont; txt : PChar; len : integer; var extents : TXGlyphInfo); cdecl; external; -procedure XftTextExtents8(display : PXDisplay; fnt : PXftFont; txt : PChar; len : integer; var extents : TXGlyphInfo); cdecl; external; -procedure XftTextExtents16(display : PXDisplay; fnt : PXftFont; txt : PChar; len : integer; var extents : TXGlyphInfo); cdecl; external; - -//function XftGlyphExists(display : PXDisplay; fnt : PXftFont; ch : integer) : longbool; cdecl; external; - -//procedure XftDrawSetClipRectangles(draw : PXftDraw; xorigin, yorigin : integer; rect : PXRectangle; rnum : integer); cdecl; external; - -procedure XftDrawSetClip(draw : PXftDraw; rg : TRegion); cdecl; external; - -function XftListFonts(display : PXDisplay; screen : integer; params : array of const) : PFcFontSet; cdecl; external; -function XftNameUnparse(pat : PFcPattern; dest : PChar; destlen : integer) : boolean; cdecl; external; -procedure FcFontSetDestroy(fsp : PFcFontSet); cdecl; external; - end. diff --git a/src/corelib/x11/fpgui_toolkit.lpk b/src/corelib/x11/fpgui_toolkit.lpk index 2765e02d..6af40c75 100644 --- a/src/corelib/x11/fpgui_toolkit.lpk +++ b/src/corelib/x11/fpgui_toolkit.lpk @@ -5,20 +5,22 @@ <AddToProjectUsesSection Value="False"/> <Author Value="Graeme Geldenhuys"/> <CompilerOptions> - <Version Value="8"/> + <Version Value="9"/> <SearchPaths> + <IncludeFiles Value="../../"/> <OtherUnitFiles Value="../;../../gui/;../../gui/db/"/> <UnitOutputDirectory Value="../../../lib/$(TargetCPU)-$(TargetOS)"/> </SearchPaths> <Parsing> <SyntaxOptions> - <CStyleOperator Value="False"/> <AllowLabel Value="False"/> <CPPInline Value="False"/> </SyntaxOptions> </Parsing> <CodeGeneration> - <SmartLinkUnit Value="True"/> + <Optimizations> + <OptimizationLevel Value="0"/> + </Optimizations> </CodeGeneration> <Other> <CompilerPath Value="$(CompPath)"/> @@ -26,10 +28,10 @@ </CompilerOptions> <Description Value="fpGUI Toolkit "/> - <License Value="Modified LGPL + <License Value="LGPL 2 with static linking exception. "/> - <Version Minor="6" Release="3"/> - <Files Count="77"> + <Version Minor="7"/> + <Files Count="84"> <Item1> <Filename Value="../stdimages.inc"/> <Type Value="Include"/> @@ -338,6 +340,34 @@ <Filename Value="../../gui/fpg_colorwheel.pas"/> <UnitName Value="fpg_ColorWheel"/> </Item77> + <Item78> + <Filename Value="fpg_interface.pas"/> + <UnitName Value="fpg_interface"/> + </Item78> + <Item79> + <Filename Value="../../gui/fpg_editbtn.pas"/> + <UnitName Value="fpg_editbtn"/> + </Item79> + <Item80> + <Filename Value="../../gui/colordialog.inc"/> + <Type Value="Include"/> + </Item80> + <Item81> + <Filename Value="../fpg_imgfmt_jpg.pas"/> + <UnitName Value="fpg_imgfmt_jpg"/> + </Item81> + <Item82> + <Filename Value="../../gui/inputquerydialog.inc"/> + <Type Value="Include"/> + </Item82> + <Item83> + <Filename Value="../fpg_imgutils.pas"/> + <UnitName Value="fpg_imgutils"/> + </Item83> + <Item84> + <Filename Value="../../VERSION_FILE.inc"/> + <Type Value="Include"/> + </Item84> </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 b6e85833..f9ea7c1d 100644 --- a/src/corelib/x11/fpgui_toolkit.pas +++ b/src/corelib/x11/fpgui_toolkit.pas @@ -1,4 +1,4 @@ -{ This file was automatically created by Lazarus. do not edit ! +{ This file was automatically created by Lazarus. Do not edit! This source is only used to compile and install the package. } @@ -10,13 +10,14 @@ uses fpg_base, fpg_main, fpg_cmdlineparams, fpg_command_intf, fpg_constants, fpg_extinterpolation, fpg_imagelist, fpg_imgfmt_bmp, fpg_pofiles, fpg_popupwindow, fpg_stdimages, fpg_stringhashlist, fpg_translations, fpg_stringutils, fpg_utils, - fpg_widget, fpg_wuline, fpg_impl, fpg_x11, fpg_netlayer_x11, fpg_keyconv_x11, fpg_xft_x11, - fpg_animation, fpg_basegrid, fpg_button, fpg_checkbox, fpg_combobox, fpg_customgrid, - fpg_dialogs, fpg_editcombo, fpg_edit, fpg_form, fpg_gauge, fpg_grid, fpg_hyperlink, - fpg_iniutils, fpg_label, fpg_listbox, fpg_listview, fpg_memo, fpg_menu, fpg_mru, fpg_panel, - fpg_popupcalendar, fpg_progressbar, fpg_radiobutton, fpg_scrollbar, fpg_style, fpg_tab, - fpg_trackbar, fpg_tree, fpgui_db, fpg_splitter, fpg_hint, fpg_spinedit, fpg_extgraphics, - fpg_ColorMapping, fpg_ColorWheel; + fpg_widget, fpg_wuline, fpg_impl, fpg_x11, fpg_netlayer_x11, fpg_keyconv_x11, + fpg_xft_x11, fpg_animation, fpg_basegrid, fpg_button, fpg_checkbox, fpg_combobox, + fpg_customgrid, fpg_dialogs, fpg_editcombo, fpg_edit, fpg_form, fpg_gauge, fpg_grid, + fpg_hyperlink, fpg_iniutils, fpg_label, fpg_listbox, fpg_listview, fpg_memo, fpg_menu, + fpg_mru, fpg_panel, fpg_popupcalendar, fpg_progressbar, fpg_radiobutton, + fpg_scrollbar, fpg_style, fpg_tab, fpg_trackbar, fpg_tree, fpgui_db, fpg_splitter, + fpg_hint, fpg_spinedit, fpg_extgraphics, fpg_ColorMapping, fpg_ColorWheel, + fpg_interface, fpg_editbtn, fpg_imgfmt_jpg, fpg_imgutils; implementation diff --git a/src/extrafpc.cfg b/src/extrafpc.cfg index 8757773c..1c17edca 100644 --- a/src/extrafpc.cfg +++ b/src/extrafpc.cfg @@ -43,6 +43,9 @@ # Allow inline and use ansistrings. -Sih +# Allows C-style assignment += -= etc. +-Sc + # Optimize always for Size #-O2s @@ -50,6 +53,7 @@ # Slashes are also allowed under dos # searchpath for includefiles +-Fi. -Ficorelib #IFDEF X11 -Ficorelib/x11/ @@ -99,8 +103,8 @@ #-viwn # # If you don't want so much verbosity use --vw +#-vw # # Show only errors -#-ve +-ve diff --git a/src/fpmake.pas b/src/fpmake.pas index d6f9383d..5afc82ea 100644 --- a/src/fpmake.pas +++ b/src/fpmake.pas @@ -1,7 +1,7 @@ { fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2010 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/charmapdialog.inc b/src/gui/charmapdialog.inc index 5c602627..1eb21b77 100644 --- a/src/gui/charmapdialog.inc +++ b/src/gui/charmapdialog.inc @@ -1,7 +1,7 @@ { - fpGUI - Free Pascal GUI Library + fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2009 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -17,8 +17,6 @@ actual character code. } -{ TODO : This unit needs to be localized } -{ TODO : This dialog needs to be incorporated with TfpgEdit popup menu. } {%mainunit fpg_dialogs.pas} @@ -27,27 +25,28 @@ TCharMapForm = class(TfpgForm) private {@VFD_HEAD_BEGIN: CharMapForm} - StringGrid1: TfpgStringGrid; - Button1: TfpgButton; + grdCharacters: TfpgStringGrid; + btnClose: TfpgButton; lblCharInfo: TfpgLabel; edText: TfpgEdit; lblText: TfpgLabel; pnlChar: TfpgPanel; {@VFD_HEAD_END: CharMapForm} - procedure FormShow(Sender: TObject); - procedure StringGrid1FocusChange(Sender: TObject; ARow, ACol: integer); - procedure StringGrid1DrawCell(Sender: TObject; const ARow, ACol: integer; const ARect: TfpgRect; const AFlags: TfpgGridDrawState; var ADefaultDrawing: boolean); - procedure StringGrid1CanSelectCell(Sender: TObject; const ARow, ACol: integer; var ACanSelect: boolean); - procedure StringGrid1DoubleClick(Sender: TObject; AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint); - procedure FillCharMap; - procedure Button1Clicked(Sender: TObject); - function GetNewText: TfpgString; + procedure FormShow(Sender: TObject); + procedure grdCharactersFocusChange(Sender: TObject; ARow, ACol: integer); + procedure grdCharactersDrawCell(Sender: TObject; const ARow, ACol: integer; const ARect: TfpgRect; const AFlags: TfpgGridDrawState; var ADefaultDrawing: boolean); + procedure grdCharactersCanSelectCell(Sender: TObject; const ARow, ACol: integer; var ACanSelect: boolean); + procedure grdCharactersDoubleClick(Sender: TObject; AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint); + procedure grdCharactersKeyPressed(Sender: TObject; var KeyCode: word; var ShiftState: TShiftState; var Consumed: boolean); + procedure FillCharMap; + procedure Button1Clicked(Sender: TObject); + function GetNewText: TfpgString; + procedure SetupCaptions; public - procedure AfterCreate; override; - property NewText: TfpgString read GetNewText; + procedure AfterCreate; override; + property NewText: TfpgString read GetNewText; end; -function fpgShowCharMap: TfpgString; {$ENDIF read_interface} @@ -77,14 +76,14 @@ begin FillCharMap; end; -procedure TCharMapForm.StringGrid1FocusChange(Sender: TObject; ARow, ACol: integer); +procedure TCharMapForm.grdCharactersFocusChange(Sender: TObject; ARow, ACol: integer); var i: integer; tmp, tmp2: TfpgString; begin if (ARow > 0) and (ACol > 0) then begin - tmp := StringGrid1.Cells[ACol, ARow]; + tmp := grdCharacters.Cells[ACol, ARow]; tmp2 := ''; // generate UTF-8 byte representation for i := 1 to Length(tmp) do @@ -99,25 +98,25 @@ begin end; end; -procedure TCharMapForm.StringGrid1DrawCell(Sender: TObject; +procedure TCharMapForm.grdCharactersDrawCell(Sender: TObject; const ARow, ACol: integer; const ARect: TfpgRect; const AFlags: TfpgGridDrawState; var ADefaultDrawing: boolean); begin if (ARow = 0) or (ACol = 0) then begin ADefaultDrawing := False; - StringGrid1.Canvas.Color := clWindowBackground; - StringGrid1.Canvas.FillRectangle(ARect); - //StringGrid1.Canvas.DrawButtonFace(ARect, []); - StringGrid1.Canvas.TextColor := clText1; //clGray; - StringGrid1.Canvas.DrawText(ARect, StringGrid1.Cells[ACol, ARow], + grdCharacters.Canvas.Color := clWindowBackground; + grdCharacters.Canvas.FillRectangle(ARect); + //grdCharacters.Canvas.DrawButtonFace(ARect, []); + grdCharacters.Canvas.TextColor := clText1; //clGray; + grdCharacters.Canvas.DrawText(ARect, grdCharacters.Cells[ACol, ARow], [txtHCenter, txtVCenter]); end else ADefaultDrawing := True; end; -procedure TCharMapForm.StringGrid1CanSelectCell(Sender: TObject; +procedure TCharMapForm.grdCharactersCanSelectCell(Sender: TObject; const ARow, ACol: integer; var ACanSelect: boolean); begin if (ACol = 0) or (ARow = 0) then @@ -126,10 +125,19 @@ begin ACanSelect := True; end; -procedure TCharMapForm.StringGrid1DoubleClick(Sender: TObject; +procedure TCharMapForm.grdCharactersDoubleClick(Sender: TObject; AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint); begin - edText.Text := edText.Text + StringGrid1.Cells[StringGrid1.FocusCol, StringGrid1.FocusRow]; + edText.Text := edText.Text + grdCharacters.Cells[grdCharacters.FocusCol, grdCharacters.FocusRow]; +end; + +procedure TCharMapForm.grdCharactersKeyPressed(Sender: TObject; var KeyCode: word; + var ShiftState: TShiftState; var Consumed: boolean); +begin + if KeyCode = keyEnter then + begin + edText.Text := edText.Text + grdCharacters.Cells[grdCharacters.FocusCol, grdCharacters.FocusRow]; + end; end; procedure TCharMapForm.FillCharMap; @@ -138,33 +146,33 @@ var j: byte; c: byte; begin - StringGrid1.BeginUpdate; + grdCharacters.BeginUpdate; try - StringGrid1.ColumnCount := 17; - StringGrid1.RowCount := 17; - StringGrid1.ShowHeader := False; + grdCharacters.ColumnCount := 17; + grdCharacters.RowCount := 17; + grdCharacters.ShowHeader := False; for i := 0 to 15 do begin for j := 0 to 15 do begin - StringGrid1.ColumnWidth[j] := 20; + grdCharacters.ColumnWidth[j] := 20; c := i shl 4 or j; if (c > 0) and (c < 128) then - StringGrid1.Cells[j + 1, i + 1] := chr(c) + grdCharacters.Cells[j + 1, i + 1] := chr(c) else - StringGrid1.Cells[j + 1, i + 1] := + grdCharacters.Cells[j + 1, i + 1] := chr($C0 or (i div $4)) + chr($80 or c mod $40); end; - StringGrid1.Cells[0, i + 1] := Format('%.2x +', [i]); - StringGrid1.Cells[i + 1, 0] := Format('%.2x', [i]); + grdCharacters.Cells[0, i + 1] := Format('%.2x +', [i]); + grdCharacters.Cells[i + 1, 0] := Format('%.2x', [i]); end; - StringGrid1.ColumnWidth[0] := 30; - StringGrid1.ColumnWidth[16] := 20; - StringGrid1.Cells[0, 0] := '00'; + grdCharacters.ColumnWidth[0] := 30; + grdCharacters.ColumnWidth[16] := 20; + grdCharacters.Cells[0, 0] := '00'; finally - StringGrid1.FocusCol := 1; - StringGrid1.FocusRow := 1; - StringGrid1.EndUpdate; + grdCharacters.FocusCol := 1; + grdCharacters.FocusRow := 1; + grdCharacters.EndUpdate; end; end; @@ -178,6 +186,13 @@ begin Result := edText.Text; end; +procedure TCharMapForm.SetupCaptions; +begin + WindowTitle := rsCharacterMap; + btnClose.Text := rsClose; + lblText.Text := rsTextToInsert; +end; + procedure TCharMapForm.AfterCreate; begin {%region 'Auto-generated GUI code' -fold} @@ -185,33 +200,36 @@ begin Name := 'CharMapForm'; SetPosition(316, 186, 377, 390); WindowTitle := 'Character Map'; + Hint := ''; WindowPosition := wpOneThirdDown; OnShow := @FormShow; - StringGrid1 := TfpgStringGrid.Create(self); - with StringGrid1 do + grdCharacters := TfpgStringGrid.Create(self); + with grdCharacters do begin - Name := 'StringGrid1'; + Name := 'grdCharacters'; SetPosition(4, 4, 368, 296); Anchors := [anLeft,anRight,anTop,anBottom]; FontDesc := '#Grid'; HeaderFontDesc := '#GridHeader'; + Hint := ''; RowCount := 0; RowSelect := False; TabOrder := 0; - OnFocusChange := @StringGrid1FocusChange; - OnDrawCell := @StringGrid1DrawCell; - OnCanSelectCell := @StringGrid1CanSelectCell; - OnDoubleClick := @StringGrid1DoubleClick; + OnFocusChange := @grdCharactersFocusChange; + OnDrawCell := @grdCharactersDrawCell; + OnCanSelectCell := @grdCharactersCanSelectCell; + OnDoubleClick := @grdCharactersDoubleClick; + OnKeyPress := @grdCharactersKeyPressed; end; - Button1 := TfpgButton.Create(self); - with Button1 do + btnClose := TfpgButton.Create(self); + with btnClose do begin - Name := 'Button1'; + Name := 'btnClose'; SetPosition(292, 360, 80, 24); Anchors := [anRight,anBottom]; - Text := 'Close'; + Text := 'btnClose'; FontDesc := '#Label1'; Hint := ''; ImageName := ''; @@ -227,7 +245,7 @@ begin Anchors := [anLeft,anBottom]; FontDesc := '#Label1'; Hint := ''; - Text := 'Label'; + Text := 'lblCharInfo'; end; edText := TfpgEdit.Create(self); @@ -236,6 +254,7 @@ begin Name := 'edText'; SetPosition(108, 326, 156, 24); Anchors := [anLeft,anBottom]; + Hint := ''; TabOrder := 3; Text := ''; FontDesc := '#Edit1'; @@ -249,7 +268,7 @@ begin Anchors := [anLeft,anBottom]; FontDesc := '#Label1'; Hint := ''; - Text := 'Text to Insert:'; + Text := 'lblTextToInsert'; end; pnlChar := TfpgPanel.Create(self); @@ -259,12 +278,15 @@ begin SetPosition(292, 304, 60, 48); Anchors := [anLeft,anRight,anTop,anBottom]; FontDesc := 'Arial-16:antialias=true'; + Hint := ''; Style := bsLowered; Text := ''; end; {@VFD_BODY_END: CharMapForm} {%endregion} + + SetupCaptions; end; diff --git a/src/gui/colordialog.inc b/src/gui/colordialog.inc new file mode 100644 index 00000000..6914257e --- /dev/null +++ b/src/gui/colordialog.inc @@ -0,0 +1,316 @@ +{ + fpGUI - Free Pascal GUI Toolkit + + Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this + distribution, for details of the copyright. + + See the file COPYING.modifiedLGPL, included in this distribution, + for details about redistributing fpGUI. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + Description: + This unit contains the Color Selection dialog. +} + + +{%mainunit fpg_dialogs.pas} + +{$IFDEF read_interface} + +type + + TfpgColorSelectDialog = class(TfpgBaseDialog) + private + {@VFD_HEAD_BEGIN: ColorSelectDialog} + PageControl1: TfpgPageControl; + TabSheet1: TfpgTabSheet; + TabSheet2: TfpgTabSheet; + ComboBox1: TfpgComboBox; + ColorListBox1: TfpgColorListBox; + Label1: TfpgLabel; + Label2: TfpgLabel; + ColorWheel: TfpgColorWheel; + ValueBar: TfpgValueBar; + edR: TfpgSpinEdit; + edG: TfpgSpinEdit; + edB: TfpgSpinEdit; + Label3: TfpgLabel; + Label4: TfpgLabel; + Label5: TfpgLabel; + pnlColorPreview: TfpgBevel; + {@VFD_HEAD_END: ColorSelectDialog} + FViaRGB: Boolean; // to prevent recursive changes + function GetSelectedColor: TfpgColor; + procedure SetSelectedColor(const AValue: TfpgColor); + procedure ColorChanged(Sender: TObject); + procedure RGBChanged(Sender: TObject); + procedure UpdateRGBComponents; + public + constructor Create(AOwner: TComponent); override; + procedure AfterCreate; override; + property SelectedColor: TfpgColor read GetSelectedColor write SetSelectedColor; + end; + + +{$ENDIF read_interface} + + + +{$IFDEF read_implementation} + + +function fpgSelectColorDialog(APresetColor: TfpgColor): TfpgColor; +var + frm: TfpgColorSelectDialog; +begin + Result := APresetColor; + frm := TfpgColorSelectDialog.Create(nil); + try + frm.ColorWheel.SetSelectedColor(APresetColor); + if frm.ShowModal = mrOK then + Result := frm.ValueBar.SelectedColor; + finally + frm.Free; + end; +end; + +{ TfpgColorSelectDialog } + +function TfpgColorSelectDialog.GetSelectedColor: TfpgColor; +begin + // +end; + +procedure TfpgColorSelectDialog.SetSelectedColor(const AValue: TfpgColor); +begin + // +end; + +procedure TfpgColorSelectDialog.ColorChanged(Sender: TObject); +begin +// UpdateHSVComponents; + if not FViaRGB then + UpdateRGBComponents; + pnlColorPreview.BackgroundColor := ValueBar.SelectedColor; +end; + +procedure TfpgColorSelectDialog.RGBChanged(Sender: TObject); +var + rgb: TFPColor; + c: TfpgColor; +begin + FViaRGB := True; // prevent recursive updates + rgb.Red := edR.Value; + rgb.Green := edG.Value; + rgb.Blue := edB.Value; + c := FPColorTofpgColor(rgb); + ColorWheel.SetSelectedColor(c); // This will trigger ColorWheel and ValueBar OnChange event + FViaRGB := False; +end; + +procedure TfpgColorSelectDialog.UpdateRGBComponents; +var + rgb: TFPColor; + c: TfpgColor; +begin + c := ValueBar.SelectedColor; + rgb := fpgColorToFPColor(c); + edR.Value := rgb.Red; + edG.Value := rgb.Green; + edB.Value := rgb.Blue; +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(316, 186, 328, 375); + WindowTitle := 'Color Select Dialog'; + Hint := ''; + WindowPosition := wpOneThirdDown; + + PageControl1 := TfpgPageControl.Create(self); + with PageControl1 do + begin + Name := 'PageControl1'; + SetPosition(4, 4, 320, 332); + Anchors := [anLeft,anRight,anTop,anBottom]; + ActivePageIndex := 0; + Hint := ''; + TabOrder := 1; + end; + + TabSheet1 := TfpgTabSheet.Create(PageControl1); + with TabSheet1 do + begin + Name := 'TabSheet1'; + SetPosition(3, 24, 314, 305); + Text := 'Color Wheel'; + end; + + TabSheet2 := TfpgTabSheet.Create(PageControl1); + with TabSheet2 do + begin + Name := 'TabSheet2'; + SetPosition(3, 24, 314, 305); + Text := 'Predefined'; + end; + + ComboBox1 := TfpgComboBox.Create(TabSheet2); + with ComboBox1 do + begin + Name := 'ComboBox1'; + SetPosition(8, 24, 299, 22); + Anchors := [anLeft,anRight,anTop]; + FontDesc := '#List'; + Hint := ''; + TabOrder := 1; + end; + + ColorListBox1 := TfpgColorListBox.Create(TabSheet2); + with ColorListBox1 do + begin + Name := 'ColorListBox1'; + SetPosition(8, 72, 299, 224); + Anchors := [anLeft,anRight,anTop,anBottom]; + ColorPalette := cpStandardColors; + FontDesc := '#List'; + Hint := ''; + HotTrack := False; + PopupFrame := False; + TabOrder := 2; + end; + + Label1 := TfpgLabel.Create(TabSheet2); + with Label1 do + begin + Name := 'Label1'; + SetPosition(8, 6, 328, 16); + FontDesc := '#Label1'; + Hint := ''; + Text := 'Select a color palette'; + end; + + Label2 := TfpgLabel.Create(TabSheet2); + with Label2 do + begin + Name := 'Label2'; + SetPosition(8, 54, 328, 16); + FontDesc := '#Label1'; + Hint := ''; + Text := 'Available colors:'; + end; + + ColorWheel := TfpgColorWheel.Create(TabSheet1); + with ColorWheel do + begin + Name := 'ColorWheel'; + SetPosition(8, 8, 204, 204); + end; + + ValueBar := TfpgValueBar.Create(TabSheet1); + with ValueBar do + begin + Name := 'ValueBar'; + SetPosition(240, 8, 64, 204); + OnChange := @ColorChanged; + end; + + edR := TfpgSpinEdit.Create(TabSheet1); + with edR do + begin + Name := 'edR'; + SetPosition(92, 216, 52, 24); + MaxValue := 255; + MinValue := 0; + OnChange := @RGBChanged; + end; + + edG := TfpgSpinEdit.Create(TabSheet1); + with edG do + begin + Name := 'edG'; + SetPosition(92, 244, 52, 24); + MaxValue := 255; + MinValue := 0; + OnChange := @RGBChanged; + end; + + edB := TfpgSpinEdit.Create(TabSheet1); + with edB do + begin + Name := 'edB'; + SetPosition(92, 272, 52, 24); + MaxValue := 255; + MinValue := 0; + OnChange := @RGBChanged; + end; + + Label3 := TfpgLabel.Create(TabSheet1); + with Label3 do + begin + Name := 'Label3'; + SetPosition(8, 220, 80, 16); + Alignment := taRightJustify; + FontDesc := '#Label1'; + Hint := ''; + Text := 'Red'; + end; + + Label4 := TfpgLabel.Create(TabSheet1); + with Label4 do + begin + Name := 'Label4'; + SetPosition(8, 248, 80, 16); + Alignment := taRightJustify; + FontDesc := '#Label1'; + Hint := ''; + Text := 'Green'; + end; + + Label5 := TfpgLabel.Create(TabSheet1); + with Label5 do + begin + Name := 'Label5'; + SetPosition(8, 276, 80, 16); + Alignment := taRightJustify; + FontDesc := '#Label1'; + Hint := ''; + Text := 'Blue'; + end; + + pnlColorPreview := TfpgBevel.Create(TabSheet1); + with pnlColorPreview do + begin + Name := 'pnlColorPreview'; + SetPosition(248, 232, 52, 52); + Hint := ''; + end; + + {@VFD_BODY_END: ColorSelectDialog} + {%endregion} + + // link colorwheel and valuebar + ColorWheel.ValueBar := ValueBar; + + // position standard dialog buttons + btnCancel.Left := Width - FDefaultButtonWidth - FSpacing; + btnCancel.Top := Height - btnCancel.Height - FSpacing; + btnOK.Left := btnCancel.Left - FDefaultButtonWidth - 6; + btnOK.Top := btnCancel.Top; +end; + + +{$ENDIF read_implementation} + diff --git a/src/gui/db/fpgui_db.pas b/src/gui/db/fpgui_db.pas index 1e814ba0..a3530ca7 100644 --- a/src/gui/db/fpgui_db.pas +++ b/src/gui/db/fpgui_db.pas @@ -1,7 +1,7 @@ { fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2010 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_animation.pas b/src/gui/fpg_animation.pas index b95d83ac..fedfa545 100644 --- a/src/gui/fpg_animation.pas +++ b/src/gui/fpg_animation.pas @@ -1,7 +1,7 @@ { fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -70,6 +70,7 @@ type property ImageFileName; property IsTransparent; property FrameCount; + property OnShowHint; end; @@ -130,7 +131,8 @@ end; procedure TfpgBaseImgAnim.SetEnabled(const AValue: boolean); begin inherited SetEnabled(AValue); - FTimer.Enabled := FEnabled; + if not (csDesigning in ComponentState) then + FTimer.Enabled := FEnabled; end; procedure TfpgBaseImgAnim.SetImageFilename(const AValue: TfpgString); diff --git a/src/gui/fpg_basegrid.pas b/src/gui/fpg_basegrid.pas index 7c9e757f..9a29e004 100644 --- a/src/gui/fpg_basegrid.pas +++ b/src/gui/fpg_basegrid.pas @@ -1,7 +1,7 @@ { fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -30,7 +30,8 @@ uses fpg_base, fpg_main, fpg_widget, - fpg_scrollbar; + fpg_scrollbar, + fpg_menu; type @@ -42,7 +43,7 @@ type TfpgDrawCellEvent = procedure(Sender: TObject; const ARow, ACol: Integer; const ARect: TfpgRect; const AFlags: TfpgGridDrawState; var ADefaultDrawing: boolean) of object; // widget options - TfpgGridOption = (go_HideFocusRect); + TfpgGridOption = (go_HideFocusRect, go_AlternativeColor, go_SmoothScroll); TfpgGridOptions = set of TfpgGridOption; // Column 2 is special just for testing purposes. Descendant classes will @@ -65,6 +66,7 @@ type FPrevRow: Integer; FFirstRow: Integer; FFirstCol: Integer; + FXOffset: integer; // used for go_SmoothScroll FMargin: integer; FFont: TfpgFont; FHeaderFont: TfpgFont; @@ -77,6 +79,8 @@ type FHScrollBar: TfpgScrollBar; FUpdateCount: integer; FOptions: TfpgGridOptions; + FPopupMenu: TfpgPopupMenu; + FAlternativeBGColor: TfpgColor; function GetFontDesc: string; function GetHeaderFontDesc: string; procedure HScrollBarMove(Sender: TObject; position: integer); @@ -96,12 +100,14 @@ type function VisibleWidth: integer; function VisibleHeight: integer; procedure SetFirstRow(const AValue: Integer); + procedure SetAlternativeBGColor(const AValue: TfpgColor); protected property UpdateCount: integer read FUpdateCount; procedure UpdateScrollBars; virtual; function GetHeaderText(ACol: Integer): string; virtual; function GetColumnWidth(ACol: Integer): integer; virtual; procedure SetColumnWidth(ACol: Integer; const AValue: integer); virtual; + function GetBackgroundColor(ARow: integer; ACol: integer): TfpgColor; virtual; function GetColumnBackgroundColor(ACol: Integer): TfpgColor; virtual; procedure SetColumnBackgroundColor(ACol: Integer; const AValue: TfpgColor); virtual; function GetColumnTextColor(ACol: Integer): TfpgColor; virtual; @@ -122,7 +128,9 @@ type procedure HandleMouseMove(x, y: integer; btnstate: word; shiftstate: TShiftState); override; procedure HandleLMouseUp(x, y: integer; shiftstate: TShiftState); override; procedure HandleLMouseDown(x, y: integer; shiftstate: TShiftState); override; + procedure HandleRMouseUp(x, y: integer; shiftstate: TShiftState); override; procedure FollowFocus; virtual; + property AlternateBGColor: TfpgColor read FAlternativeBGColor write SetAlternativeBGColor default clHilite1; property DefaultColWidth: integer read FDefaultColWidth write SetDefaultColWidth default 64; property DefaultRowHeight: integer read FDefaultRowHeight write SetDefaultRowHeight; property Font: TfpgFont read FFont; @@ -133,6 +141,7 @@ type property FocusRow: Integer read FFocusRow write SetFocusRow default -1; property RowSelect: boolean read FRowSelect write SetRowSelect; property ColumnCount: Integer read GetColumnCount; + property PopupMenu: TfpgPopupMenu read FPopupMenu write FPopupMenu; property RowCount: Integer read GetRowCount; property ShowHeader: boolean read FShowHeader write SetShowHeader default True; property ShowGrid: boolean read FShowGrid write SetShowGrid default True; @@ -166,12 +175,25 @@ implementation procedure TfpgBaseGrid.HScrollBarMove(Sender: TObject; position: integer); begin - if FFirstCol <> position then + if go_SmoothScroll in FOptions then begin - if Position < 0 then - Position := 0; - FFirstCol := position; - RePaint; + if FXOffset <> position then + begin + if Position < 0 then + Position := 0; + FXOffset := position; + Repaint; + end; + end + else + begin + if FFirstCol <> position then + begin + if Position < 0 then + Position := 0; + FFirstCol := position; + RePaint; + end; end; end; @@ -260,6 +282,24 @@ begin end; end; +function TfpgBaseGrid.GetBackgroundColor(ARow: integer; ACol: integer): TfpgColor; +begin + if (ARow >= 0) and (ACol >= 0) and (ARow < RowCount) and (ACol < ColumnCount) then + begin + if go_AlternativeColor in Options then + begin + if (ARow mod 2) <> 0 then + Result := AlternateBGColor + else + Result := ColumnBackgroundColor[ACol]; + end + else + Result := ColumnBackgroundColor[ACol]; + end + else + Result := BackgroundColor; +end; + function TfpgBaseGrid.GetColumnBackgroundColor(ACol: Integer): TfpgColor; begin // implemented in descendant @@ -351,8 +391,11 @@ begin Canvas.SetTextColor(clText1); s := GetHeaderText(ACol); x := (ARect.Left + (ARect.Width div 2)) - (FHeaderFont.TextWidth(s) div 2); - if x < 1 then - x := 1; + if not (go_SmoothScroll in FOptions) then + begin + if x < 1 then + x := 1; + end; fpgStyle.DrawString(Canvas, x, ARect.Top+1, s, Enabled); end; @@ -477,6 +520,12 @@ begin RePaint; end; +procedure TfpgBaseGrid.SetAlternativeBGColor(const AValue: TfpgColor); +begin + if FAlternativeBGColor = AValue then exit; + FAlternativeBGColor := AValue; +end; + procedure TfpgBaseGrid.UpdateScrollBars; var HWidth: integer; @@ -484,6 +533,7 @@ var vw: integer; cw: integer; i: integer; + x: integer; begin VHeight := Height - 4; HWidth := Width - 4; @@ -500,6 +550,7 @@ begin begin FHScrollBar.Visible := False; FFirstCol := 0; + FXOffset := 0; end; // This needs improving while resizing @@ -529,8 +580,16 @@ begin Dec(VHeight, FHScrollBar.Height); FHScrollBar.Min := 0; FHScrollBar.SliderSize := 0.2; - FHScrollBar.Max := ColumnCount-1; - FHScrollBar.Position := FFirstCol; + if go_SmoothScroll in FOptions then + begin + FHScrollBar.Max := cw - vw; + FHScrollBar.Position := FXOffset; + end + else + begin + FHScrollBar.Max := ColumnCount-1; + FHScrollBar.Position := FFirstCol; + end; FHScrollBar.RepaintSlider; end; @@ -559,8 +618,9 @@ var row: Integer; clipr: TfpgRect; // clip rectangle drawstate: TfpgGridDrawState; + cLeft: integer; + c: integer; begin - drawstate := []; Canvas.BeginDraw; // inherited HandlePaint; Canvas.ClearClipRect; @@ -576,12 +636,25 @@ begin clipr.SetRect(FMargin, FMargin, VisibleWidth, VisibleHeight); r := clipr; + cLeft := FMargin; // column starting point + if go_SmoothScroll in FOptions then + begin + if FHScrollBar.Visible then + Dec(cLeft, FHScrollBar.Position); + c := 0; + end + else + begin + c := FFirstCol; + end; + if (ColumnCount > 0) and ShowHeader then begin // Drawing horizontal headers + r.Left := cLeft; r.Height := FHeaderHeight; Canvas.SetFont(FHeaderFont); - for col := FFirstCol to ColumnCount-1 do + for col := c to ColumnCount-1 do begin r.Width := ColumnWidth[col]; Canvas.SetClipRect(clipr); @@ -602,9 +675,10 @@ begin for row := FFirstRow to RowCount-1 do begin - r.Left := FMargin; - for col := FFirstCol to ColumnCount-1 do + r.Left := cLeft; + for col := c to ColumnCount-1 do begin + drawstate := []; r.Width := ColumnWidth[col]; Canvas.SetClipRect(clipr); @@ -612,18 +686,18 @@ begin begin if FFocused then begin - Canvas.SetColor(clSelection); - Canvas.SetTextColor(clSelectionText); + Canvas.SetColor(clGridSelection); + Canvas.SetTextColor(clGridSelectionText); end else begin - Canvas.SetColor(clInactiveSel); - Canvas.SetTextColor(clInactiveSelText); + Canvas.SetColor(clGridInactiveSel); + Canvas.SetTextColor(clGridInactiveSelText); end; end else begin - Canvas.SetColor(ColumnBackgroundColor[col]); + Canvas.SetColor(GetBackgroundColor(row, col)); Canvas.SetTextColor(ColumnTextColor[col]); end; Canvas.AddClipRect(r); @@ -898,6 +972,8 @@ var cw: integer; n: integer; colresize: boolean; + cLeft: integer; + c: integer; begin inherited HandleMouseMove(x, y, btnstate, shiftstate); @@ -922,15 +998,27 @@ begin colresize := False; hh := FHeaderHeight; + cLeft := FMargin; // column starting point + if go_SmoothScroll in FOptions then + begin + if FHScrollBar.Visible then + Dec(cLeft, FHScrollBar.Position); + c := 0; + end + else + begin + c := FFirstCol; + end; + if (y <= FMargin + hh) then // we are over the Header row begin cw := 0; - for n := FFirstCol to ColumnCount-1 do + for n := c to ColumnCount-1 do begin inc(cw, ColumnWidth[n]); // Resizing is enabled 4 pixel either way of the cell border - if ((x >= (FMargin+cw - 4)) and (x <= (FMargin+cw+4))) or - (cw > (FMargin + VisibleWidth)) and (x >= FMargin + VisibleWidth-4) then + if ((x >= (cLeft+cw-4)) and (x <= (cLeft+cw+4))) {or + (cw > (cLeft + VisibleWidth)) and (x >= (cLeft + VisibleWidth-4))} then begin colresize := True; Break; @@ -969,6 +1057,8 @@ var nw: integer; prow: Integer; pcol: Integer; + c: integer; + cLeft: integer; begin inherited HandleLMouseDown(x, y, shiftstate); @@ -987,27 +1077,40 @@ begin if ShowHeader and (y <= FMargin+hh) then // inside Header row begin {$IFDEF DEBUG} Writeln('header click...'); {$ENDIF} + + cLeft := FMargin; // column starting point + if go_SmoothScroll in FOptions then + begin + if FHScrollBar.Visible then + Dec(cLeft, FHScrollBar.Position); + c := 0; + end + else + begin + c := FFirstCol; + end; + cw := 0; - for n := FFirstCol to ColumnCount-1 do + for n := c to ColumnCount-1 do begin inc(cw, ColumnWidth[n]); - if (x >= (FMargin+cw - 4)) and (x <= (FMargin+cw + 4)) then + if (x >= (cLeft+cw-4)) and (x <= (cLeft+cw+4)) then begin {$IFDEF DEBUG} Writeln('column resize...'); {$ENDIF} FColResizing := True; FResizedCol := n; FDragPos := x; Break; - end - else if (cw > FMargin+VisibleWidth) and (x >= FMargin+VisibleWidth-4) then - begin - FColResizing := True; - FResizedCol := n; - FDragPos := x; - nw := ColumnWidth[FResizedCol] - (cw+FMargin-x); - if nw > 0 then - SetColumnWidth(FResizedCol, nw ); - Break; + //end + //else if (cw > cLeft+VisibleWidth) and (x >= cLeft+VisibleWidth-4) then + //begin + // FColResizing := True; + // FResizedCol := n; + // FDragPos := x; + // nw := ColumnWidth[FResizedCol] - (cw+cLeft-x); + // if nw > 0 then + // SetColumnWidth(FResizedCol, nw ); + // Break; end; { if/else } if cw > VisibleWidth then @@ -1038,6 +1141,26 @@ begin CheckFocusChange; end; +procedure TfpgBaseGrid.HandleRMouseUp(x, y: integer; shiftstate: TShiftState); +var + hh: integer; +begin + inherited HandleRMouseUp(x, y, shiftstate); + if Assigned(PopupMenu) then + begin + // popup should not appear if you clicked in header - maybe this behaviour should be user-selectable? + if ShowHeader then + hh := FHeaderHeight+1 + else + hh := 0; + + if ShowHeader and (y > FMargin+hh) then // not in Header row + begin + PopupMenu.ShowAt(self, x, y); + end; + end; +end; + procedure TfpgBaseGrid.FollowFocus; var n: Integer; @@ -1084,7 +1207,7 @@ begin end; end; { for } end; { if/else } - + CheckFocusChange; UpdateScrollBars; end; @@ -1117,6 +1240,7 @@ begin FDefaultRowHeight := FFont.Height + 2; FHeaderHeight := FHeaderFont.Height + 2; FBackgroundColor := clBoxColor; + FAlternativeBGColor := clHilite1; FColResizing := False; MinHeight := HeaderHeight + DefaultRowHeight + FMargin; @@ -1182,6 +1306,8 @@ var hh: integer; cw: integer; n: Integer; + cLeft: integer; + c: integer; begin if ShowHeader then hh := FHeaderHeight+1 @@ -1192,11 +1318,23 @@ begin if ARow > RowCount-1 then ARow := RowCount-1; + cLeft := FMargin; // column starting point + if go_SmoothScroll in FOptions then + begin + if FHScrollBar.Visible then + Dec(cLeft, FHScrollBar.Position); + c := 0; + end + else + begin + c := FFirstCol; + end; + cw := 0; - for n := FFirstCol to ColumnCount-1 do + for n := c to ColumnCount-1 do begin inc(cw, ColumnWidth[n]); - if FMargin+cw >= x then + if cLeft+cw >= x then begin ACol := n; Break; diff --git a/src/gui/fpg_button.pas b/src/gui/fpg_button.pas index 4600d894..19b31049 100644 --- a/src/gui/fpg_button.pas +++ b/src/gui/fpg_button.pas @@ -1,7 +1,7 @@ { fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -33,7 +33,6 @@ type TImageLayout = (ilImageLeft, ilImageTop, ilImageRight, ilImageBottom); - { TfpgBaseButton } TfpgBaseButton = class(TfpgWidget, ICommandHolder) private @@ -137,24 +136,33 @@ type property Flat; property FontDesc; property GroupIndex; + property Height; property Hint; property ImageLayout; property ImageMargin; property ImageName; property ImageSpacing; + property Left; + property MaxHeight; + property MaxWidth; + property MinHeight; + property MinWidth; property ModalResult; property ParentShowHint; property ShowHint; property ShowImage; + property TabOrder; property Text; property TextColor; - property TabOrder; + property Top; + property Width; + property OnClick; property OnMouseDown; property OnMouseExit; property OnMouseEnter; property OnMouseMove; property OnMouseUp; - property OnClick; + property OnShowHint; end; @@ -500,7 +508,7 @@ var pofs: integer; lBtnFlags: TFButtonFlags; clr: TfpgColor; - + img: TfpgImage; begin // inherited HandlePaint; Canvas.ClearClipRect; @@ -559,9 +567,17 @@ begin CalculatePositions (ix, iy, tx, ty); - if FShowImage and assigned (FImage) then - Canvas.DrawImage(ix + pofs, iy + pofs, FImage); - + if FShowImage and Assigned(FImage) then + begin + if Enabled then + Canvas.DrawImage(ix + pofs, iy + pofs, FImage) + else + begin + img := FImage.CreateDisabledImage; + Canvas.DrawImage(ix + pofs, iy + pofs, img); + img.Free; + end; + end; fpgStyle.DrawString(Canvas, tx+pofs, ty+pofs, Text, Enabled); end; @@ -714,7 +730,9 @@ begin if pform <> nil then pform.ModalResult := ModalResult; - if Assigned(OnClick) then + if Assigned(FCommand) then // ICommand takes preference to OnClick + FCommand.Execute + else if Assigned(OnClick) then OnClick(self); end; diff --git a/src/gui/fpg_checkbox.pas b/src/gui/fpg_checkbox.pas index 87a1b4df..a075a4cd 100644 --- a/src/gui/fpg_checkbox.pas +++ b/src/gui/fpg_checkbox.pas @@ -1,7 +1,7 @@ { fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2009 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -69,14 +69,24 @@ type property BoxLayout; property Checked; property FontDesc; + property Height; + property Hint; + property Left; + property MaxHeight; + property MaxWidth; + property MinHeight; + property MinWidth; property ParentShowHint; property ShowHint; property TabOrder; property Text; property TextColor; + property Top; + property Width; property OnChange; property OnEnter; property OnExit; + property OnShowHint; end; diff --git a/src/gui/fpg_colormapping.pas b/src/gui/fpg_colormapping.pas index 9f486bbf..b915bd93 100644 --- a/src/gui/fpg_colormapping.pas +++ b/src/gui/fpg_colormapping.pas @@ -1,7 +1,7 @@ { - fpGUI - Free Pascal GUI Library + fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2009 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2010 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: TRGBTriple; + rgb: TFPColor; begin - rgb := fpgColorToRGBTriple(C); + rgb := fpgColorToFPColor(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: TRGBTriple; + rgb: TFPColor; 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 := RGBTripleTofpgColor(rgb); + Result := FPColorTofpgColor(rgb); end; diff --git a/src/gui/fpg_colorwheel.pas b/src/gui/fpg_colorwheel.pas index ed90dc79..43ebb8a9 100644 --- a/src/gui/fpg_colorwheel.pas +++ b/src/gui/fpg_colorwheel.pas @@ -1,7 +1,7 @@ { - fpGUI - Free Pascal GUI Library + fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2009 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -13,7 +13,7 @@ Description: This unit implements color selectors using a ColorWheel and - a ValueBar. Color results are in HSV format. + a ValueBar. Color results are in HSV or TfpgColor format. } unit fpg_ColorWheel; @@ -213,7 +213,6 @@ begin FImage.Free; FImage := TfpgImage.Create; FImage.AllocateImage(32, DrawWidth, DrawHeight); - FImage.UpdateImage; for X := 0 to DrawWidth - 1 do begin for Y := 0 to DrawHeight - 1 do @@ -232,6 +231,7 @@ begin // point is outside wheel. Also incase color is alias, lookup the RGB values. FImage.Colors[x, y] := fpgColorToRGB(BackgroundColor); end; + FImage.UpdateImage; end; FRecalcWheel := False; end diff --git a/src/gui/fpg_combobox.pas b/src/gui/fpg_combobox.pas index 6e34704e..632a4918 100644 --- a/src/gui/fpg_combobox.pas +++ b/src/gui/fpg_combobox.pas @@ -1,7 +1,7 @@ { fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -83,7 +83,7 @@ type FBtnPressed: Boolean; procedure SetMargin(const AValue: integer); procedure CalculateInternalButtonRect; virtual; - procedure InternalOnClose(Sender: TObject); + procedure InternalOnClose(Sender: TObject); virtual; procedure InternalItemsChanged(Sender: TObject); virtual; procedure HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: boolean); override; procedure DoOnChange; virtual; @@ -141,6 +141,7 @@ type property FocusItem; property FontDesc; property Height; + property Hint; property Items; property Margin; property Options; @@ -155,6 +156,7 @@ type property OnDropDown; property OnEnter; property OnExit; + property OnShowHint; end; @@ -405,8 +407,6 @@ end; { TComboboxDropdownWindow } procedure TComboboxDropdownWindow.SetFirstItem; -var - i: integer; begin // If FocusItem is less than DropDownCount FirsItem = 0 if ListBox.FocusItem+1 <= FCallerWidget.DropDownCount then diff --git a/src/gui/fpg_customgrid.pas b/src/gui/fpg_customgrid.pas index b0c2d3ab..4f38f12a 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 - 2008 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -22,7 +22,6 @@ unit fpg_customgrid; { TODO: * Column text alignment needs to be implemented. Currently always Centre. - * AlternateColor for rows need to be implemented. } {.$Define DEBUG} @@ -259,7 +258,7 @@ begin if (ACol >= 0) and (ACol < ColumnCount) then Result := TfpgGridColumn(FColumns[ACol]).FBackgroundColor else - result := BackgroundColor; + Result := BackgroundColor; end; procedure TfpgCustomGrid.SetColumnBackgroundColor(ACol: Integer; const AValue: TfpgColor); diff --git a/src/gui/fpg_dialogs.pas b/src/gui/fpg_dialogs.pas index 2ffc803b..73c668c3 100644 --- a/src/gui/fpg_dialogs.pas +++ b/src/gui/fpg_dialogs.pas @@ -1,7 +1,7 @@ { fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -23,7 +23,6 @@ unit fpg_dialogs; TODO: * Try and refactor the code to remove all IFDEF's * Implement MessageDlg with icons and buttons [Work-In-Progress] - * Select Directory dialog (treeview style) } {.$Define DEBUG} @@ -48,7 +47,10 @@ uses fpg_combobox, fpg_panel, fpg_memo, - fpg_tree; + fpg_tree, + fpg_ColorWheel, + fpg_spinedit, + fpg_tab; type TfpgMsgDlgType = (mtAbout, mtWarning, mtError, mtInformation, mtConfirmation, @@ -159,10 +161,12 @@ type FOpenMode: boolean; FFilterList: TStringList; FFilter: string; + FInitialDir: string; procedure SetFilter(const Value: string); function GetFontDesc: string; function GetShowHidden: boolean; procedure SetFontDesc(const AValue: string); + procedure SetInitialDir(const AValue: string); procedure SetShowHidden(const Value: boolean); procedure ListChanged(Sender: TObject; ARow: Integer); procedure GridDblClicked(Sender: TObject; AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint); @@ -188,6 +192,7 @@ type function RunSaveFile: boolean; property Filter: string read FFilter write SetFilter; property FontDesc: string read GetFontDesc write SetFontDesc; + property InitialDir: string read FInitialDir write SetInitialDir; property ShowHidden: boolean read GetShowHidden write SetShowHidden; end; @@ -203,6 +208,8 @@ type {$I promptuserdialog.inc} {$I selectdirdialog.inc} {$I charmapdialog.inc} +{$I colordialog.inc} +{$I inputquerydialog.inc} @@ -212,6 +219,9 @@ procedure ShowMessage(AMessage: string; ACentreText: Boolean = False); overload; function SelectFontDialog(var FontDesc: string): boolean; function SelectFileDialog(const ADialogType: boolean = sfdOpen; const AFilter: TfpgString = ''): TfpgString; function SelectDirDialog(const AStartDir: TfpgString = ''): TfpgString; +function fpgShowCharMap: TfpgString; +function fpgSelectColorDialog(APresetColor: TfpgColor = clBlack): TfpgColor; +function fpgInputQuery(const ACaption, APrompt: TfpgString; var Value: TfpgString): Boolean; implementation @@ -339,7 +349,7 @@ begin Result := False; frm := TfpgFontSelectDialog.Create(nil); frm.SetFontDesc(FontDesc); - if frm.ShowModal = 1 then + if frm.ShowModal = mrOK then begin FontDesc := frm.GetFontDesc; Result := True; @@ -381,6 +391,7 @@ var begin dlg := TfpgSelectDirDialog.Create(nil); try + dlg.SelectedDir := AStartDir; if dlg.ShowModal = mrOK then Result := dlg.SelectedDir else @@ -514,14 +525,14 @@ begin btnCancel := CreateButton(self, Width-FDefaultButtonWidth-FSpacing, 370, FDefaultButtonWidth, rsCancel, @btnCancelClick); btnCancel.Name := 'btnCancel'; - btnCancel.ImageName := 'stdimg.Cancel'; // Do NOT localize + btnCancel.ImageName := 'stdimg.cancel'; // Do NOT localize btnCancel.ShowImage := True; btnCancel.Anchors := [anRight, anBottom]; btnCancel.TabOrder := 2; btnOK := CreateButton(self, btnCancel.Left-FDefaultButtonWidth-FSpacing, 370, FDefaultButtonWidth, rsOK, @btnOKClick); btnOK.Name := 'btnOK'; - btnOK.ImageName := 'stdimg.OK'; // Do NOT localize + btnOK.ImageName := 'stdimg.ok'; // Do NOT localize btnOK.ShowImage := True; btnOK.Anchors := [anRight, anBottom]; btnOK.TabOrder := 1; @@ -986,6 +997,15 @@ begin grid.FontDesc := AValue; end; +procedure TfpgFileDialog.SetInitialDir(const AValue: string); +begin + if FInitialDir <> AValue then + begin + FInitialDir := AValue; + SetCurrentDirectory(FInitialDir); + end; +end; + procedure TfpgFileDialog.SetShowHidden(const Value: boolean); begin btnShowHidden.Down := Value; @@ -1215,7 +1235,7 @@ var begin dlg := TfpgNewDirDialog.Create(nil); try - if dlg.ShowModal = 1 then + if dlg.ShowModal = mrOK then begin if dlg.Directory <> '' then begin @@ -1372,7 +1392,7 @@ begin btnOK.ImageName := 'stdimg.open'; // Do NOT localize btnOK.Text := rsOpen; - if ShowModal = 1 then + if ShowModal = mrOK then Result := True else Result := False; @@ -1396,7 +1416,7 @@ begin btnOK.ImageName := 'stdimg.save'; // Do NOT localize btnOK.Text := rsSave; - if ShowModal = 1 then + if ShowModal = mrOK then Result := True else Result := False; @@ -1414,6 +1434,8 @@ end; {$I promptuserdialog.inc} {$I selectdirdialog.inc} {$I charmapdialog.inc} +{$I colordialog.inc} +{$I inputquerydialog.inc} end. diff --git a/src/gui/fpg_edit.pas b/src/gui/fpg_edit.pas index c7e31225..5dd25fb0 100644 --- a/src/gui/fpg_edit.pas +++ b/src/gui/fpg_edit.pas @@ -1,7 +1,7 @@ { fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -55,6 +55,8 @@ type FMaxLength: integer; FSelecting: Boolean; FReadOnly: Boolean; + FIgnoreMouseCursor: Boolean; + FAutoSize: Boolean; procedure Adjust(UsePxCursorPos: boolean = false); virtual; procedure AdjustTextOffset(UsePxCursorPos: boolean); virtual; procedure AdjustDrawingInfo; virtual; @@ -75,6 +77,7 @@ type procedure DefaultPopupCopy(Sender: TObject); procedure DefaultPopupPaste(Sender: TObject); procedure DefaultPopupClearAll(Sender: TObject); + procedure DefaultPopupInsertFromCharmap(Sender: TObject); procedure SetDefaultPopupMenuItemsState; procedure SetReadOnly(const AValue: Boolean); protected @@ -111,9 +114,11 @@ type procedure HandleHide; override; function GetDrawText: String; property AutoSelect: Boolean read FAutoSelect write SetAutoSelect default True; + property AutoSize: Boolean read FAutoSize write FAutoSize default True; property BorderStyle: TfpgEditBorderStyle read FBorderStyle write SetBorderStyle default ebsDefault; property FontDesc: String read GetFontDesc write SetFontDesc; property HideSelection: Boolean read FHideSelection write SetHideSelection default True; + property IgnoreMouseCursor: Boolean read FIgnoreMouseCursor write FIgnoreMouseCursor default False; property MaxLength: Integer read FMaxLength write FMaxLength; property PasswordMode: Boolean read FPasswordMode write SetPasswordMode default False; property PopupMenu: TfpgPopupMenu read FPopupMenu write FPopupMenu; @@ -155,15 +160,19 @@ type property PopupMenu; // UI Designer doesn't fully support it yet published property AutoSelect; + property AutoSize; property BackgroundColor default clBoxColor; property BorderStyle; property ExtraHint; property FontDesc; property HeightMargin; property HideSelection; + property Hint; + property IgnoreMouseCursor; property MaxLength; property ParentShowHint; property PasswordMode; + property ReadOnly; property ShowHint; property SideMargin; property TabOrder; @@ -176,6 +185,7 @@ type property OnMouseEnter; property OnMouseExit; property OnPaint; + property OnShowHint; end; @@ -223,6 +233,7 @@ type property OnMouseEnter; property OnMouseExit; property OnPaint; + property OnShowHint; public constructor Create(AOwner: TComponent); override; published @@ -244,8 +255,10 @@ type property Text; published property CustomThousandSeparator; + property Hint; property NegativeColor; property ParentShowHint; + property ReadOnly; property ShowHint; property ShowThousand default True; property TabOrder; @@ -258,6 +271,7 @@ type property OnMouseEnter; property OnMouseExit; property OnMouseMove; + property OnShowHint; end; @@ -278,17 +292,19 @@ type property OldColor; property Text; published - property Decimals: integer read FDecimals write SetDecimals default -1; property CustomDecimalSeparator; + property CustomThousandSeparator; + property Decimals: integer read FDecimals write SetDecimals default -1; property FixedDecimals: boolean read FFixedDecimals write SetFixedDecimals default False; + property Hint; property NegativeColor; + property ParentShowHint; + property ReadOnly; + property ShowHint; property ShowThousand default True; property TabOrder; property TextColor; - property CustomThousandSeparator; property Value: extended read GetValue write SetValue; - property ParentShowHint; - property ShowHint; property OnChange; property OnEnter; property OnExit; @@ -296,6 +312,7 @@ type property OnMouseEnter; property OnMouseExit; property OnMouseMove; + property OnShowHint; end; @@ -314,21 +331,24 @@ type property OldColor; property Text; published - property Decimals: integer read FDecimals write SetDecimals default 2; - property NegativeColor; property CustomDecimalSeparator; property CustomThousandSeparator; - property ShowThousand default True; - property Value: Currency read GetValue write SetValue; + property Decimals: integer read FDecimals write SetDecimals default 2; + property Hint; + property NegativeColor; property ParentShowHint; + property ReadOnly; property ShowHint; + property ShowThousand default True; property TabOrder; + property Value: Currency read GetValue write SetValue; property OnChange; property OnEnter; property OnExit; property OnKeyPress; property OnMouseEnter; property OnMouseExit; + property OnShowHint; end; @@ -348,7 +368,8 @@ implementation uses fpg_stringutils, - fpg_constants; + fpg_constants, + fpg_dialogs; const // internal popupmenu item names @@ -356,6 +377,7 @@ const ipmCopy = 'miDefaultCopy'; ipmPaste = 'miDefaultPaste'; ipmClearAll = 'miDefaultClearAll'; + ipmCharmap = 'miDefaultCharmap'; function CreateEdit(AOwner: TComponent; x, y, w, h: TfpgCoord): TfpgEdit; @@ -679,7 +701,7 @@ begin end; Canvas.SetClipRect(r); - if Enabled then + if Enabled and not ReadOnly then Canvas.SetColor(FBackgroundColor) else Canvas.SetColor(clWindowBackground); @@ -703,7 +725,7 @@ begin prevval := Text; s := AText; - if not consumed then + if (not consumed) and (not ReadOnly) then begin // Handle only printable characters // UTF-8 characters beyond ANSI range are supposed to be printable @@ -753,14 +775,18 @@ begin ckPaste: begin DoPaste(fpgClipboard.Text); - hasChanged := True; + if not ReadOnly then + hasChanged := True; end; ckCut: begin DoCopy; DeleteSelection; - Adjust; - hasChanged := True; + if not ReadOnly then + begin + Adjust; + hasChanged := True; + end; end; else Consumed := False; @@ -787,18 +813,20 @@ begin end; keyRight: - if FCursorPos < UTF8Length(FText) then begin consumed := True; - Inc(FCursorPos); + if FCursorPos < UTF8Length(FText) then + begin + Inc(FCursorPos); - if (ssCtrl in shiftstate) then - // word search... - // while (FCursorPos < Length(FText)) and ptkIsAlphaNum(copy(FText,FCursorPos+1,1)) - // do Inc(FCursorPos); - // while (FCursorPos < Length(FText)) and not ptkIsAlphaNum(copy(FText,FCursorPos+1,1)) - // do Inc(FCursorPos); - ; + if (ssCtrl in shiftstate) then + // word search... + // while (FCursorPos < Length(FText)) and ptkIsAlphaNum(copy(FText,FCursorPos+1,1)) + // do Inc(FCursorPos); + // while (FCursorPos < Length(FText)) and not ptkIsAlphaNum(copy(FText,FCursorPos+1,1)) + // do Inc(FCursorPos); + ; + end; end; keyHome: @@ -829,32 +857,32 @@ begin if not Consumed then begin - consumed := True; - - case keycode of - keyBackSpace: - begin - if FSelOffset <> 0 then - DeleteSelection - else if FCursorPos > 0 then + if not ReadOnly then + begin + case keycode of + keyBackSpace: begin - UTF8Delete(FText, FCursorPos, 1); - Dec(FCursorPos); + if FSelOffset <> 0 then + DeleteSelection + else if FCursorPos > 0 then + begin + UTF8Delete(FText, FCursorPos, 1); + Dec(FCursorPos); + hasChanged := True; + end;// backspace + Consumed := True; + end; + + keyDelete: + begin + if FSelOffset <> 0 then + DeleteSelection + else if FCursorPos < UTF8Length(FText) then + UTF8Delete(FText, FCursorPos + 1, 1); hasChanged := True; - end;// backspace - end; - - - keyDelete: - begin - if FSelOffset <> 0 then - DeleteSelection - else if FCursorPos < UTF8Length(FText) then - UTF8Delete(FText, FCursorPos + 1, 1); - hasChanged := True; - end; - else - Consumed := False; + Consumed := True; + end; + end; { case } end; if Consumed then @@ -947,7 +975,7 @@ begin inherited HandleMouseEnter; if (csDesigning in ComponentState) then Exit; - if Enabled then + if Enabled and (not FIgnoreMouseCursor) then MouseCursor := mcIBeam; end; @@ -990,30 +1018,31 @@ end; constructor TfpgBaseEdit.Create(AOwner: TComponent); begin inherited Create(AOwner); - FFont := fpgGetFont('#Edit1'); // owned object ! - Focusable := True; - FHeight := FFont.Height + 8; // (BorderStyle + HeightMargin) * 2 - FWidth := 120; - FTextColor := Parent.TextColor; - FBackgroundColor := clBoxColor; - FAutoSelect := True; - FSelecting := False; - FHideSelection := True; - FReadOnly := False; - FSideMargin := 3; - FHeightMargin := 2; - FMaxLength := 0; // no limit - FText := ''; - FCursorPos := UTF8Length(FText); - FSelStart := FCursorPos; - FSelOffset := 0; - FTextOffset := 0; - FPasswordMode := False; - FBorderStyle := ebsDefault; - FPopupMenu := nil; - FDefaultPopupMenu := nil; - FOnChange := nil; - + FFont := fpgGetFont('#Edit1'); // owned object ! + Focusable := True; + FHeight := FFont.Height + 8; // (BorderStyle + HeightMargin) * 2 + FWidth := 120; + FTextColor := Parent.TextColor; + FBackgroundColor := clBoxColor; + FAutoSelect := True; + FAutoSize := True; + FSelecting := False; + FHideSelection := True; + FReadOnly := False; + FSideMargin := 3; + FHeightMargin := 2; + FMaxLength := 0; // no limit + FText := ''; + FCursorPos := UTF8Length(FText); + FSelStart := FCursorPos; + FSelOffset := 0; + FTextOffset := 0; + FPasswordMode := False; + FBorderStyle := ebsDefault; + FIgnoreMouseCursor := False; + FPopupMenu := nil; + FDefaultPopupMenu := nil; + FOnChange := nil; end; destructor TfpgBaseEdit.Destroy; @@ -1057,16 +1086,19 @@ procedure TfpgBaseEdit.SetFontDesc(const AValue: string); begin FFont.Free; FFont := fpgGetFont(AValue); - case BorderStyle of - ebsNone: - if Height < FFont.Height + (FHeightMargin * 2) then - Height:= FFont.Height + (FHeightMargin * 2); - ebsDefault: - if Height < FFont.Height + 4 + (FHeightMargin * 2) then - Height:= FFont.Height + 4 + (FHeightMargin * 2); - ebsSingle: - if Height < FFont.Height + 2 + (FHeightMargin * 2) then - Height:= FFont.Height + 2 + (FHeightMargin * 2); + if AutoSize then + begin + case BorderStyle of + ebsNone: + if Height < FFont.Height + (FHeightMargin * 2) then + Height:= FFont.Height + (FHeightMargin * 2); + ebsDefault: + if Height < FFont.Height + 4 + (FHeightMargin * 2) then + Height:= FFont.Height + 4 + (FHeightMargin * 2); + ebsSingle: + if Height < FFont.Height + 2 + (FHeightMargin * 2) then + Height:= FFont.Height + 2 + (FHeightMargin * 2); + end; end; Adjust; RePaint; @@ -1130,24 +1162,43 @@ end; procedure TfpgBaseEdit.DefaultPopupCut(Sender: TObject); begin + if ReadOnly then + Exit; CutToClipboard; end; procedure TfpgBaseEdit.DefaultPopupCopy(Sender: TObject); begin + if ReadOnly then + Exit; CopyToClipboard; end; procedure TfpgBaseEdit.DefaultPopupPaste(Sender: TObject); begin + if ReadOnly then + Exit; PasteFromClipboard end; procedure TfpgBaseEdit.DefaultPopupClearAll(Sender: TObject); begin + if ReadOnly then + Exit; Clear; end; +procedure TfpgBaseEdit.DefaultPopupInsertFromCharmap(Sender: TObject); +var + s: TfpgString; +begin + if ReadOnly then + Exit; + s := fpgShowCharMap; + if s <> '' then + DoPaste(s); +end; + procedure TfpgBaseEdit.SetDefaultPopupMenuItemsState; var i: integer; @@ -1160,13 +1211,15 @@ begin itm := TfpgMenuItem(FDefaultPopupMenu.Components[i]); // enabled/disable menu items if itm.Name = ipmCut then - itm.Enabled := FSelOffset <> 0 + itm.Enabled := (not ReadOnly) and (FSelOffset <> 0) else if itm.Name = ipmCopy then itm.Enabled := FSelOffset <> 0 else if itm.Name = ipmPaste then - itm.Enabled := fpgClipboard.Text <> '' + itm.Enabled := (not ReadOnly) and (fpgClipboard.Text <> '') else if itm.Name = ipmClearAll then - itm.Enabled := Text <> ''; + itm.Enabled := (not ReadOnly) and (Text <> '') + else if itm.Name = ipmCharmap then + itm.Enabled := (not ReadOnly); end; end; end; @@ -1175,6 +1228,7 @@ procedure TfpgBaseEdit.SetReadOnly(const AValue: Boolean); begin if FReadOnly = AValue then exit; FReadOnly := AValue; + RePaint; end; function TfpgBaseEdit.GetMarginAdjustment: integer; @@ -1204,6 +1258,10 @@ begin itm.Name := ipmPaste; itm := FDefaultPopupMenu.AddMenuItem(rsDelete, '', @DefaultPopupClearAll); itm.Name := ipmClearAll; + itm := FDefaultPopupMenu.AddMenuItem('-', '', nil); + itm.Name := 'N1'; + itm := FDefaultPopupMenu.AddMenuItem(rsInsertFromCharacterMap, '', @DefaultPopupInsertFromCharmap); + itm.Name := ipmCharmap; end; SetDefaultPopupMenuItemsState; @@ -1214,6 +1272,8 @@ procedure TfpgBaseEdit.DeleteSelection; var prevval: TfpgString; begin + if ReadOnly then + Exit; prevval := FText; if FSelOffset <> 0 then begin @@ -1246,6 +1306,8 @@ var s: string; prevval: TfpgString; begin + if ReadOnly then + Exit; prevval := FText; DeleteSelection; s := AText; @@ -1333,19 +1395,25 @@ end; procedure TfpgBaseTextEdit.HandlePaint; var r: TfpgRect; + flags: TFTextFlags; begin inherited HandlePaint; r := Canvas.GetClipRect; // contains adjusted size based on borders + r.Left := -FDrawOffset + GetMarginAdjustment; - if (FVisibleText = '') and not Focused then + if Enabled and (FVisibleText = '') and (not Focused) then begin Canvas.SetTextColor(clShadow1); - fpgStyle.DrawString(Canvas, -FDrawOffset + GetMarginAdjustment, r.Top + FHeightMargin, FExtraHint, Enabled); + flags := [txtLeft, txtVCenter]; + Canvas.DrawText(r, FExtraHint, flags); // fpgStyle.DrawString is called internally end else begin Canvas.SetTextColor(FTextColor); - fpgStyle.DrawString(Canvas, -FDrawOffset + GetMarginAdjustment, r.Top + FHeightMargin, FVisibleText, Enabled); + flags := [txtLeft, txtVCenter]; + if not Enabled then + flags += [txtDisabled]; + Canvas.DrawText(r, FVisibleText, flags); // fpgStyle.DrawString is called internally end; if Focused then @@ -1692,12 +1760,6 @@ begin r := GetClientRect; Canvas.SetClipRect(r); - if Enabled then - Canvas.SetColor(FBackgroundColor) - else - Canvas.SetColor(clWindowBackground); - Canvas.FillRectangle(r); - Canvas.SetFont(Font); Canvas.SetTextColor(TextColor); x := r.Width - Font.TextWidth(Text) - FSideMargin; diff --git a/src/gui/fpg_editbtn.pas b/src/gui/fpg_editbtn.pas new file mode 100644 index 00000000..70c6da00 --- /dev/null +++ b/src/gui/fpg_editbtn.pas @@ -0,0 +1,435 @@ +{ + fpGUI - Free Pascal GUI Toolkit + + Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this + distribution, for details of the copyright. + + See the file COPYING.modifiedLGPL, included in this distribution, + for details about redistributing fpGUI. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + Description: + This unit contains various "composite" components. Components that + work together as a single component. +} + +unit fpg_editbtn; + +{$mode objfpc}{$H+} + +interface + +uses + Classes + ,fpg_base + ,fpg_main + ,fpg_widget + ,fpg_edit + ,fpg_button + ,fpg_panel + ; + +type + TfpgBaseEditButton = class(TfpgAbstractPanel) + private + FOnButtonClick: TNotifyEvent; + FReadOnly: Boolean; + procedure SetReadOnly(const AValue: Boolean); + function GetExtraHint: TfpgString; + procedure SetExtraHint(const AValue: TfpgString); + protected + FEdit: TfpgEdit; + FButton: TfpgButton; + function GetOnShowHint: THintEvent; override; + procedure SetOnShowHint(const AValue: THintEvent); override; + procedure SetHint(const AValue: TfpgString); override; + function GetHint: TfpgString; override; + procedure InternalButtonClick(Sender: TObject); virtual; + procedure HandleResize(AWidth, AHeight: TfpgCoord); override; + property ExtraHint: TfpgString read GetExtraHint write SetExtraHint; + property ReadOnly: Boolean read FReadOnly write SetReadOnly default False; + property OnButtonClick: TNotifyEvent read FOnButtonClick write FOnButtonClick; + public + constructor Create(AOwner: TComponent); override; + end; + + + TfpgFileNameEdit = class(TfpgBaseEditButton) + private + FFilter: TfpgString; + FInitialDir: TfpgString; + procedure SetFilter(const AValue: TfpgString); + procedure SetFileName(const AValue: TfpgString); + function GetFileName: TfpgString; + protected + procedure HandlePaint; override; + procedure InternalButtonClick(Sender: TObject); override; + public + constructor Create(AOwner: TComponent); override; + published + property ExtraHint; + property FileName: TfpgString read GetFileName write SetFileName; + property InitialDir: TfpgString read FInitialDir write FInitialDir; + property Filter: TfpgString read FFilter write SetFilter; + property ReadOnly; + property TabOrder; + property OnButtonClick; + property OnShowHint; + end; + + + TfpgDirectoryEdit = class(TfpgBaseEditButton) + private + FRootDirectory: TfpgString; + function GetDirectory: TfpgString; + procedure SetDirectory(const AValue: TfpgString); + protected + procedure HandlePaint; override; + procedure InternalButtonClick(Sender: TObject); override; + public + constructor Create(AOwner: TComponent); override; + published + property Directory: TfpgString read GetDirectory write SetDirectory; + property ExtraHint; + property RootDirectory: TfpgString read FRootDirectory write FRootDirectory; + property ReadOnly; + property TabOrder; + property OnButtonClick; + 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; + public + constructor Create(AOwner: TComponent); override; + published + property FontDesc: TfpgString read GetFontDesc write SetFontDesc; + property ReadOnly; + property TabOrder; + property OnButtonClick; + property OnShowHint; + end; + + +implementation + +uses + fpg_constants + ,fpg_dialogs + ,fpg_utils + ; + + +{ TfpgBaseEditButton } + +procedure TfpgBaseEditButton.SetReadOnly(const AValue: Boolean); +begin + if FReadOnly = AValue then + Exit; + FReadOnly := AValue; + FEdit.ReadOnly := FReadOnly; + FButton.Enabled := not FReadOnly; // Buttons don't have ReadOnly property. +end; + +function TfpgBaseEditButton.GetExtraHint: TfpgString; +begin + Result := FEdit.ExtraHint; +end; + +procedure TfpgBaseEditButton.SetExtraHint(const AValue: TfpgString); +begin + FEdit.ExtraHint := AValue; +end; + +function TfpgBaseEditButton.GetOnShowHint: THintEvent; +begin + // rewire the FEdit event to the parent (composite) component + Result := FEdit.OnShowHint; +end; + +procedure TfpgBaseEditButton.SetOnShowHint(const AValue: THintEvent); +begin + // rewire the FEdit event to the parent (composite) component + FEdit.OnShowHint := AValue; +end; + +procedure TfpgBaseEditButton.SetHint(const AValue: TfpgString); +begin + FEdit.Hint := AValue; +end; + +function TfpgBaseEditButton.GetHint: TfpgString; +begin + Result := FEdit.Hint; +end; + +procedure TfpgBaseEditButton.InternalButtonClick(Sender: TObject); +begin + // do nothing + if Assigned(OnButtonClick) then + OnButtonClick(self); +end; + +procedure TfpgBaseEditButton.HandleResize(AWidth, AHeight: TfpgCoord); +begin + inherited HandleResize(AWidth, AHeight); + if csDesigning in ComponentState then + begin + FEdit.Visible := False; + FButton.Visible := False; + end + else + begin + FEdit.SetPosition(0, 0, AWidth - AHeight, AHeight); + FButton.SetPosition(AWidth - AHeight, 0, AHeight, AHeight); + end; +end; + +constructor TfpgBaseEditButton.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FWidth := 140; + FHeight := 24; + FReadOnly := False; + + FEdit := TfpgEdit.Create(self); + with FEdit do + begin + Name := 'FEdit'; + Text := ''; + FontDesc := '#Edit1'; + TabOrder := 0; + end; + + FButton := TfpgButton.Create(self); + with FButton do + begin + Name := 'FButton'; + Text := ''; + FontDesc := '#Label1'; + ImageMargin := -1; + ImageName := 'stdimg.elipses'; + ImageSpacing := 0; + TabOrder := 1; + OnClick := @InternalButtonClick; + end; +end; + + + +{ TfpgFileNameEdit } + +constructor TfpgFileNameEdit.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FFilter := ''; + FButton.ImageName := 'stdimg.folderfile'; +end; + +procedure TfpgFileNameEdit.SetFilter(const AValue: TfpgString); +begin + FFilter := AValue; +end; + +procedure TfpgFileNameEdit.SetFileName(const AValue: TfpgString); +begin + FEdit.Text := AValue; +end; + +function TfpgFileNameEdit.GetFileName: TfpgString; +begin + Result := FEdit.Text; +end; + +procedure TfpgFileNameEdit.HandlePaint; +var + img: TfpgImage; +begin + inherited HandlePaint; + // only so that it looks pretty in the UI Designer + if csDesigning in ComponentState then + begin + FEdit.Visible := False; + FButton.Visible := False; + Canvas.Clear(clBoxColor); + fpgStyle.DrawControlFrame(Canvas, 0, 0, Width - Height, Height); + fpgStyle.DrawButtonFace(Canvas, Width - Height, 0, Height, Height, [btfIsEmbedded]); + Canvas.SetFont(fpgApplication.DefaultFont); + if Filename <> '' then + begin + Canvas.TextColor := clText3; + Canvas.DrawText(4, 0, Width - Height, Height, Filename, [txtLeft, txtVCenter]); + end + else + begin + Canvas.TextColor := clShadow1; + Canvas.DrawText(0, 0, Width - Height, Height, ClassName, [txtHCenter, txtVCenter]); + end; + img := fpgImages.GetImage('stdimg.folderfile'); // don't free the img instance - we only got a reference + if img <> nil then + Canvas.DrawImage(Width-Height+((Height-img.Width) div 2), (Height-img.Height) div 2, img); + end; +end; + +procedure TfpgFileNameEdit.InternalButtonClick(Sender: TObject); +var + dlg: TfpgFileDialog; +begin + dlg := TfpgFileDialog.Create(nil); + try + if FileName = '' then + begin + if FInitialDir <> '' then + dlg.InitialDir := FInitialDir; + end + else + begin + // Use path of existing filename + dlg.InitialDir := fpgExtractFilePath(FileName); + if dlg.InitialDir = '' then // FileName had no path + dlg.InitialDir := FInitialDir; + end; + if FFilter = '' then + dlg.Filter := rsAllFiles + ' (' + AllFilesMask + ')' + '|' + AllFilesMask + else + dlg.Filter := FFilter + '|' + rsAllFiles + ' (' + AllFilesMask + ')' + '|' + AllFilesMask; + if dlg.RunOpenFile then + begin + FEdit.Text := dlg.FileName; + end; + finally + dlg.Free; + end; + inherited InternalButtonClick(Sender); +end; + + +{ TfpgDirectoryEdit} + +constructor TfpgDirectoryEdit.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FButton.ImageName := 'stdimg.folder'; +end; + +function TfpgDirectoryEdit.GetDirectory: TfpgString; +begin + Result := FEdit.Text; +end; + +procedure TfpgDirectoryEdit.SetDirectory(const AValue: TfpgString); +begin + FEdit.Text := AValue; +end; + +procedure TfpgDirectoryEdit.HandlePaint; +var + img: TfpgImage; +begin + inherited HandlePaint; + // only so that it looks pretty in the UI Designer + if csDesigning in ComponentState then + begin + FEdit.Visible := False; + FButton.Visible := False; + Canvas.Clear(clBoxColor); + fpgStyle.DrawControlFrame(Canvas, 0, 0, Width - Height, Height); + fpgStyle.DrawButtonFace(Canvas, Width - Height, 0, Height, Height, [btfIsEmbedded]); + Canvas.SetFont(fpgApplication.DefaultFont); + if Directory <> '' then + begin + Canvas.TextColor := clText3; + Canvas.DrawText(4, 0, Width - Height, Height, Directory, [txtLeft, txtVCenter]); + end + else + begin + Canvas.TextColor := clShadow1; + Canvas.DrawText(0, 0, Width - Height, Height, ClassName, [txtHCenter, txtVCenter]); + end; + img := fpgImages.GetImage('stdimg.folder'); // don't free the img instance - we only got a reference + if img <> nil then + Canvas.DrawImage(Width-Height+((Height-img.Width) div 2), (Height-img.Height) div 2, img); + end; +end; + +procedure TfpgDirectoryEdit.InternalButtonClick(Sender: TObject); +var + dlg: TfpgSelectDirDialog; +begin + dlg := TfpgSelectDirDialog.Create(nil); + try + if FRootDirectory <> '' then + dlg.RootDirectory := FRootDirectory; + dlg.SelectedDir := Directory; + if dlg.ShowModal = mrOK then + begin + FEdit.Text:= dlg.SelectedDir; + end; + finally + dlg.Free; + end; + inherited InternalButtonClick(Sender); +end; + + +{ TfpgFontEdit } + +function TfpgFontEdit.GetFontDesc: TfpgString; +begin + Result := FEdit.Text; +end; + +procedure TfpgFontEdit.SetFontDesc(const AValue: TfpgString); +begin + FEdit.Text := AValue; +end; + +procedure TfpgFontEdit.HandlePaint; +var + img: TfpgImage; +begin + inherited HandlePaint; + // only so that it looks pretty in the UI Designer + if csDesigning in ComponentState then + begin + FEdit.Visible := False; + FButton.Visible := False; + Canvas.Clear(clBoxColor); + 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.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 + Canvas.DrawImage(Width-Height+((Height-img.Width) div 2), (Height-img.Height) div 2, img); + end; +end; + +procedure TfpgFontEdit.InternalButtonClick(Sender: TObject); +var + f: TfpgString; +begin + f := FontDesc; + if SelectFontDialog(f) then + FontDesc := f; + inherited InternalButtonClick(Sender); +end; + +constructor TfpgFontEdit.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FButton.ImageName := 'stdimg.font'; +end; + + +end. + diff --git a/src/gui/fpg_editcombo.pas b/src/gui/fpg_editcombo.pas index 8d660664..20b6ee8d 100644 --- a/src/gui/fpg_editcombo.pas +++ b/src/gui/fpg_editcombo.pas @@ -1,7 +1,7 @@ { fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -64,8 +64,6 @@ type TAllowNew = (anNo, anYes, anAsk); - { TfpgBaseEditCombo } - TfpgBaseEditCombo = class(TfpgBaseComboBox) private FAutoCompletion: Boolean; @@ -77,8 +75,7 @@ type procedure SetAllowNew(const AValue: TAllowNew); procedure InternalBtnClick(Sender: TObject); procedure InternalListBoxSelect(Sender: TObject); - procedure InternalListBoxKeyPress(Sender: TObject; var keycode: word; var shiftstate: TShiftState; - var consumed: Boolean); + procedure InternalListBoxKeyPress(Sender: TObject; var keycode: word; var shiftstate: TShiftState; var consumed: Boolean); protected FDropDown: TfpgPopupWindow; FDrawOffset: integer; @@ -120,6 +117,7 @@ type property FocusItem; property FontDesc; property Height; + property Hint; property Items; property Margin; property Text; @@ -131,6 +129,7 @@ type property OnEnter; property OnExit; property OnKeyPress; + property OnShowHint; end; diff --git a/src/gui/fpg_form.pas b/src/gui/fpg_form.pas index 8c2545c1..57c156a6 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 - 2008 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -34,6 +34,9 @@ type TFormCloseEvent = procedure(Sender: TObject; var CloseAction: TCloseAction) of object; TFormCloseQueryEvent = procedure(Sender: TObject; var CanClose: boolean) of object; + TfpgHelpEvent = function(AHelpType: THelpType; AHelpContext: THelpContext; + const AHelpKeyword: String; const AHelpFile: String; + var AHandled: Boolean): Boolean of object; TfpgBaseForm = class(TfpgWidget) @@ -47,14 +50,13 @@ type FOnDestroy: TNotifyEvent; FOnHide: TNotifyEvent; FOnShow: TNotifyEvent; + FOnHelp: TfpgHelpEvent; protected FModalResult: TfpgModalResult; FParentForm: TfpgBaseForm; FWindowPosition: TWindowPosition; FWindowTitle: string; FSizeable: boolean; - procedure AdjustWindowStyle; override; - procedure SetWindowParameters; override; procedure SetWindowTitle(const ATitle: string); override; procedure MsgActivate(var msg: TfpgMessageRec); message FPGM_ACTIVATE; procedure MsgDeActivate(var msg: TfpgMessageRec); message FPGM_DEACTIVATE; @@ -67,6 +69,7 @@ type procedure HandleResize(awidth, aheight: TfpgCoord); override; procedure HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: boolean); override; procedure DoOnClose(var CloseAction: TCloseAction); virtual; + function DoOnHelp(AHelpType: THelpType; AHelpContext: THelpContext; const AHelpKeyword: String; const AHelpFile: String; var AHandled: Boolean): Boolean; virtual; // properties property Sizeable: boolean read FSizeable write FSizeable; property ModalResult: TfpgModalResult read FModalResult write FModalResult; @@ -80,6 +83,7 @@ type property OnCreate: TNotifyEvent read FOnCreate write FOnCreate; property OnDeactivate: TNotifyEvent read FOnDeactivate write FOnDeactivate; property OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy; + property OnHelp: TfpgHelpEvent read FOnHelp write FOnHelp; property OnHide: TNotifyEvent read FOnHide write FOnHide; property OnShow: TNotifyEvent read FOnShow write FOnShow; public @@ -88,9 +92,12 @@ type procedure AfterConstruction; override; procedure BeforeDestruction; override; procedure AfterCreate; virtual; + procedure AdjustWindowStyle; override; + procedure SetWindowParameters; override; + procedure InvokeHelp; override; procedure Show; procedure Hide; - function ShowModal: integer; + function ShowModal: TfpgModalResult; procedure Close; function CloseQuery: boolean; virtual; end; @@ -100,22 +107,41 @@ type published property BackgroundColor; property FullScreen; + property Height; + property Hint; + property Left; + property MaxHeight; + property MaxWidth; + property MinHeight; + property MinWidth; property ModalResult; - property Sizeable; property ShowHint; + property Sizeable; property TextColor; + property Top; + property Width; property WindowPosition; property WindowTitle; property OnActivate; + property OnClick; property OnClose; property OnCloseQuery; property OnCreate; property OnDeactivate; property OnDestroy; + property OnDoubleClick; + property OnEnter; + property OnExit; property OnHide; + property OnMouseDown; + property OnMouseEnter; + property OnMouseExit; + property OnMouseMove; + property OnMouseUp; property OnPaint; property OnResize; property OnShow; + property OnShowHint; end; @@ -262,13 +288,25 @@ begin // for the user end; +procedure TfpgBaseForm.InvokeHelp; +var + lEventHandled: Boolean; + lSucceeded: Boolean; +begin + lEventHandled := False; + lSucceeded := False; + lSucceeded := DoOnHelp(HelpType, HelpContext, HelpKeyword, fpgApplication.HelpFile, lEventHandled); + if (not lSucceeded) or (not lEventHandled) then + inherited InvokeHelp; +end; + procedure TfpgBaseForm.Show; begin FVisible := True; HandleShow; end; -function TfpgBaseForm.ShowModal: integer; +function TfpgBaseForm.ShowModal: TfpgModalResult; var lCloseAction: TCloseAction; begin @@ -288,7 +326,6 @@ begin except on E: Exception do begin - ModalResult := -1; Visible := False; fpgApplication.HandleException(self); end; @@ -301,7 +338,7 @@ begin if ModalResult <> mrNone then begin - lCloseAction := caFree; // Dummy variable - we do nothing with it + lCloseAction := caHide; // Dummy variable - we do nothing with it DoOnClose(lCloseAction); // Simply so the OnClose event fires. end; end; @@ -369,8 +406,8 @@ end; procedure TfpgBaseForm.AfterConstruction; begin - inherited AfterConstruction; AfterCreate; + inherited AfterConstruction; if Assigned(FOnCreate) then FOnCreate(self); end; @@ -388,12 +425,16 @@ begin OnClose(self, CloseAction); end; +function TfpgBaseForm.DoOnHelp(AHelpType: THelpType; AHelpContext: THelpContext; + const AHelpKeyword: String; const AHelpFile: String; var AHandled: Boolean): Boolean; +begin + if Assigned(FOnHelp) then + Result := FOnHelp(AHelpType, AHelpContext, AHelpKeyword, AHelpFile, AHandled); +end; + procedure TfpgBaseForm.Hide; begin Visible := False; -// HandleHide; - if ModalResult = mrNone then - ModalResult := -1; end; procedure TfpgBaseForm.Close; @@ -426,7 +467,7 @@ begin fpgApplication.Terminate else // We can't free ourselves, somebody else needs to do it - fpgPostMessage(Self, fpgApplication, FPGM_CLOSE); + fpgPostMessage(Self, fpgApplication, FPGM_FREEME); end; end; { case CloseAction } end; { if CloseQuery } diff --git a/src/gui/fpg_gauge.pas b/src/gui/fpg_gauge.pas index b8678828..37a154c6 100644 --- a/src/gui/fpg_gauge.pas +++ b/src/gui/fpg_gauge.pas @@ -1,7 +1,7 @@ { fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -87,6 +87,7 @@ type property Color: TfpgColor read FColor write FColor default clButtonFace; property Enabled; property FirstColor: TfpgColor read FFirstColor write SetFirstColor default clBlack; + property Hint; property Kind: TGaugeKind read FKind write SetGaugeKind default gkHorizontalBar; property MaxValue: Longint read FMax write SetMax default 100; property MinValue: Longint read FMin write SetMin default 0; @@ -96,6 +97,7 @@ type property ShowHint; property ShowText: Boolean read FShowText write SetShowText default True; property Visible; + property OnShowHint; end; @@ -113,22 +115,22 @@ uses to be moved in CanvasBase? } procedure FillArcGradient(canvas: TfpgCanvas; X,Y,W,H: TfpgCoord; a1,a2: double; Astart,Astop: TfpgColor); var - RGBStart: TRGBTriple; - RGBStop: TRGBTriple; + RGBStart: TFPColor; + RGBStop: TFPColor; RDiff, GDiff, BDiff: Integer; count: Integer; i: Integer; - newcolor: TRGBTriple; + newcolor: TFPColor; begin - if Astart = Astop then + if Astart = Astop then begin { No gradient, just solid color} canvas.SetColor(Astart); canvas.FillArc(X, Y, W, H, a1, a2); Exit; //==> end; - RGBStart := fpgColorToRGBTriple(fpgColorToRGB(AStart)); - RGBStop := fpgColorToRGBTriple(fpgColorToRGB(AStop)); + RGBStart := fpgColorToFPColor(fpgColorToRGB(AStart)); + RGBStop := fpgColorToFPColor(fpgColorToRGB(AStop)); count := min(H,W); count := count div 2; @@ -154,7 +156,7 @@ begin newcolor.Red := RGBStart.Red + (i * RDiff) div count; newcolor.Green := RGBStart.Green + (i * GDiff) div count; newcolor.Blue := RGBStart.Blue + (i * BDiff) div count; - canvas.SetColor(RGBTripleTofpgColor(newcolor)); + canvas.SetColor(FPColorTofpgColor(newcolor)); canvas.DrawArc(X, Y, W, H, a1, a2); end; end; diff --git a/src/gui/fpg_grid.pas b/src/gui/fpg_grid.pas index 6d7579a0..112a1f33 100644 --- a/src/gui/fpg_grid.pas +++ b/src/gui/fpg_grid.pas @@ -1,7 +1,7 @@ { fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -25,7 +25,6 @@ unit fpg_grid; returning a TStrings with all related text inserted. * File Grid: Introduce support for images based on file types. User must be able to override the default images with their own. - * Remove the usage of libc unit. libc is linux/x86 specific. } interface @@ -57,16 +56,18 @@ type property Font; property HeaderFont; published - property FontDesc; - property HeaderFontDesc; - property RowCount; property ColumnCount; property Columns; property FocusRow; + property FontDesc; + property HeaderFontDesc; + property Options; + property RowCount; property ScrollBarStyle; property TabOrder; property OnRowChange; property OnDoubleClick; + property OnShowHint; end; @@ -121,7 +122,10 @@ type TfpgStringGrid = class(TfpgCustomStringGrid) + public + property Font; published + property AlternateBGColor; property BackgroundColor; // property ColResizing; property ColumnCount; @@ -134,8 +138,10 @@ type property FontDesc; property HeaderFontDesc; property HeaderHeight; + property Hint; property Options; property ParentShowHint; + property PopupMenu; property RowCount; property RowSelect; property ScrollBarStyle; @@ -151,6 +157,7 @@ type property OnFocusChange; property OnKeyPress; property OnRowChange; + property OnShowHint; end; function CreateStringGrid(AOwner: TComponent; x, y, w, h: TfpgCoord; AColumnCount: integer = 0): TfpgStringGrid; @@ -456,6 +463,7 @@ procedure TfpgCustomStringGrid.DrawCell(ARow, ACol: Integer; ARect: TfpgRect; var Flags: TFTextFlags; txt: string; + r: TfpgRect; begin if Cells[ACol, ARow] <> '' then begin @@ -483,7 +491,14 @@ begin end; { case } with ARect,Columns[ACol] do - Canvas.DrawText(Left+HMargin, Top, Right-Left-(HMargin*2), Bottom-Top, txt, Flags); + begin + r := ARect; + // make adjustment for margins + r.Left := r.Left + HMargin; + r.Width := r.Width - (HMargin*2); + // finally paint the text + Canvas.DrawText(r, txt, Flags); + end; end; end; diff --git a/src/gui/fpg_hint.pas b/src/gui/fpg_hint.pas index 34fc7ca2..38fff686 100644 --- a/src/gui/fpg_hint.pas +++ b/src/gui/fpg_hint.pas @@ -1,7 +1,7 @@ { fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -28,19 +28,19 @@ uses SysUtils, fpg_base, fpg_main, - fpg_form, - fpg_label; + fpg_form; type - TfpgHintWindow = class(TfpgForm) + TfpgHintWindow = class(TfpgBaseForm) private FFont: TfpgFont; FTime: Integer; FShadow: Integer; FBorder: Integer; FMargin: Integer; - L_Hint: TfpgLabel; T_Chrono: TfpgTimer; + FHintTextRec: TfpgRect; + FText: TfpgString; procedure FormShow(Sender: TObject); procedure FormHide(Sender: TObject); function GetText: TfpgString; @@ -49,24 +49,38 @@ type procedure SetShadow(AValue: Integer); procedure SetBorder(AValue: Integer); procedure SetTime(AValue: Integer); - procedure SetLTextColor(AValue: Tfpgcolor); - procedure SetLBackgroundColor(AValue: Tfpgcolor); procedure SetShadowColor(AValue: TfpgColor); + function GetFontDesc: string; + procedure SetFontDesc(const AValue: string); protected procedure HandleShow; override; + procedure HandlePaint; override; + procedure PaintBorder; virtual; + procedure PaintHintText; virtual; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; - procedure SetPosition(aleft, atop, awidth, aheight: TfpgCoord); override; property Font: TfpgFont read FFont; property Text: TfpgString read GetText write SetText; property Shadow: Integer read FShadow write SetShadow default 0; property Border: Integer read FBorder write SetBorder default 1; property Margin: Integer read FMargin write FMargin default 3; - property LTextColor: TfpgColor write SetLTextColor default clBlack; - property LBackgroundColor: TfpgColor write SetLBackgroundColor default clHintWindow; property ShadowColor: TfpgColor write SetShadowColor default clGray; - property Time: Integer write SetTime default 5000; + property Time: Integer read FTime write SetTime; + published + property BackgroundColor; + property FontDesc: string read GetFontDesc write SetFontDesc; + property TextColor; + //property OnActivate; + property OnClose; + //property OnCloseQuery; + property OnCreate; + //property OnDeactivate; + property OnDestroy; + property OnHide; + property OnPaint; + property OnResize; + property OnShow; end; @@ -79,6 +93,7 @@ var implementation + type TfpgHintShadow = class(TfpgForm) public @@ -106,18 +121,18 @@ end; function TfpgHintWindow.GetText: TfpgString; begin - Result := L_Hint.Text; + Result := FText; end; procedure TfpgHintWindow.SetText(const AValue: TfpgString); begin - L_Hint.Text := AValue; + FText := AValue; end; procedure TfpgHintWindow.T_ChronoFini(Sender: TObject); begin {$IFDEF DEBUG} - writeln('TF_Hint.T_ChronoFini timer fired'); + writeln('DEBUG: TfpgHintWindow.T_ChronoFini timer fired'); {$ENDIF} Hide; end; @@ -143,22 +158,21 @@ begin end; end; -procedure TfpgHintWindow.SetLTextColor(AValue: Tfpgcolor); +procedure TfpgHintWindow.SetShadowColor(AValue: Tfpgcolor); begin - if L_Hint.TextColor <> AValue then - L_Hint.TextColor := AValue + if uShadowForm.BackgroundColor <> AValue then + uShadowForm.BackgroundColor := AValue; end; -procedure TfpgHintWindow.SetLBackgroundColor(AValue: Tfpgcolor); +function TfpgHintWindow.GetFontDesc: string; begin - if L_Hint.BackgroundColor <> AValue then - L_Hint.BackgroundColor := AValue + Result := FFont.FontDesc; end; -procedure TfpgHintWindow.SetShadowColor(AValue: Tfpgcolor); +procedure TfpgHintWindow.SetFontDesc(const AValue: string); begin - if uShadowForm.BackgroundColor <> AValue then - uShadowForm.BackgroundColor := AValue; + FFont.Free; + FFont := fpgGetFont(AValue); end; procedure TfpgHintWindow.HandleShow; @@ -172,6 +186,38 @@ begin inherited HandleShow; end; +procedure TfpgHintWindow.HandlePaint; +begin + inherited HandlePaint; // background is set + Canvas.ClearClipRect; + Canvas.Font := FFont; + // Do we need to resize? + PaintBorder; + if FBorder > 0 then + Canvas.SetClipRect(fpgRect(FBorder, FBorder, Width-(FBorder*2), Height-(FBorder*2))); + PaintHintText; +end; + +procedure TfpgHintWindow.PaintBorder; +var + i: integer; +begin + if FBorder = 0 then // no border + Exit; + Canvas.Color := clBlack; + for i := 0 to FBorder-1 do + begin + Canvas.DrawRectangle(i, i, Width-(i*2), Height-(i*2)); + end; +end; + +procedure TfpgHintWindow.PaintHintText; +begin + FHintTextRec.SetRect(FBorder, FBorder, Width-(FBorder*2), Height-(FBorder*2)); + Canvas.TextColor := FTextColor; + Canvas.DrawText(FHintTextRec, Text, [txtHCenter, txtVCenter, txtWrap]); +end; + constructor TfpgHintWindow.Create(AOwner: TComponent); begin inherited Create(AOwner); @@ -179,34 +225,28 @@ begin WindowPosition := wpUser; WindowType := wtPopup; Sizeable := False; - BackgroundColor:= clBlack; + BackgroundColor:= clHintWindow; //clBlack; // This becomes the hint border so don't set to clHintWindow FFont := fpgGetFont('#Label1'); FMargin := 3; FBorder := 1; FShadow := 0; // no shadow by default - FTime := 5000; - L_Hint := CreateLabel(Self, FBorder, FBorder, '', Width - FBorder * 2, Height - FBorder * 2, taCenter, tlCenter); - L_Hint.BackgroundColor := clHintWindow; - L_Hint.OnClick := @T_ChronoFini; + FTime := 5000; // show hint for 5 seconds then close + FHintTextRec.SetRect(FBorder, FBorder, Width-(FBorder*2), Height-(FBorder*2)); T_Chrono := TfpgTimer.Create(FTime); T_Chrono.OnTimer := @T_ChronoFini; uShadowForm:= TfpgHintShadow.Create(nil); + OnClick := @T_ChronoFini; OnShow := @FormShow; OnHide := @FormHide; end; destructor TfpgHintWindow.Destroy; begin + T_Chrono.Enabled := False; T_Chrono.Free; FFont.Free; inherited Destroy; - uShadowForm.Destroy; -end; - -procedure TfpgHintWindow.SetPosition(aleft, atop, awidth, aheight: TfpgCoord); -begin - inherited SetPosition(aleft, atop, awidth, aheight); - L_Hint.SetPosition(Border, Border, Width - (Border * 2), Height - (Border * 2)); + uShadowForm.Free; end; constructor TfpgHintShadow.Create(AOwner: TComponent); diff --git a/src/gui/fpg_hyperlink.pas b/src/gui/fpg_hyperlink.pas index ffed0bfb..2c850a97 100644 --- a/src/gui/fpg_hyperlink.pas +++ b/src/gui/fpg_hyperlink.pas @@ -1,7 +1,7 @@ { fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -50,14 +50,18 @@ type constructor Create(AOwner: TComponent); override; procedure GoHyperLink; published + property Alignment; property Autosize; property FontDesc; + property Hint; property HotTrackColor: TfpgColor read fHotTrackColor write SetHotTrackColor; property HotTrackFont: TfpgString read fHTFont write SetHotTrackFont; property Text; property TextColor; + property ShowHint; property URL: TfpgString read FUrl write SetURL; property OnClick; + property OnShowHint; end; diff --git a/src/gui/fpg_iniutils.pas b/src/gui/fpg_iniutils.pas index ef6a7f7d..1c8fe45a 100644 --- a/src/gui/fpg_iniutils.pas +++ b/src/gui/fpg_iniutils.pas @@ -1,7 +1,7 @@ { fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2007 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -53,7 +53,8 @@ implementation uses fpg_main, - fpg_constants; + fpg_constants, + fpg_utils; var uINI: TfpgINIFile; @@ -89,7 +90,7 @@ begin if lFileName = '' then lFileName := ApplicationName + '.ini' - else if ExtractFileExt(lFileName) = '' then + else if fpgExtractFileExt(lFileName) = '' then lFileName := lFileName + '.ini'; lFileName := lDir + lFileName; diff --git a/src/gui/fpg_label.pas b/src/gui/fpg_label.pas index 94a0df4c..409116b9 100644 --- a/src/gui/fpg_label.pas +++ b/src/gui/fpg_label.pas @@ -1,7 +1,7 @@ { fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -72,13 +72,21 @@ type property AutoSize; property BackgroundColor; property FontDesc; + property Height; property Hint; property Layout; + property Left; property LineSpace; + property MaxHeight; + property MaxWidth; + property MinHeight; + property MinWidth; + property Parent; property ParentShowHint; property ShowHint; property Text; property TextColor; + property Top; property Width; property WrapText; property OnClick; @@ -88,6 +96,7 @@ type property OnMouseExit; property OnMouseMove; property OnMouseUp; + property OnShowHint; end; @@ -106,19 +115,19 @@ begin Result.Top := y; Result.Text := AText; Result.LineSpace := ALineSpace; - if w = 0 then - begin - Result.Width := Result.Font.TextWidth(Result.Text); - Result.FAutoSize := True; - end - else - Result.Width := w; if h < Result.Font.Height then Result.Height:= Result.Font.Height else Result.Height:= h; Result.Alignment:= HAlign; Result.Layout:= VAlign; + if w = 0 then + begin + Result.Width := Result.Font.TextWidth(Result.Text); + Result.AutoSize := True; + end + else + Result.Width := w; end; { TfpgCustomLabel } @@ -183,7 +192,7 @@ end; procedure TfpgCustomLabel.ResizeLabel; begin if FAutoSize and not FWrapText then - Width:= FFont.TextWidth(FText); + Width := FFont.TextWidth(FText); UpdateWindowPosition; RePaint; end; diff --git a/src/gui/fpg_listbox.pas b/src/gui/fpg_listbox.pas index 384704bf..4b6d162e 100644 --- a/src/gui/fpg_listbox.pas +++ b/src/gui/fpg_listbox.pas @@ -1,7 +1,7 @@ { fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -137,6 +137,7 @@ type property DragToReorder; property FocusItem; property FontDesc; + property Hint; property HotTrack; property Items; property ParentShowHint; @@ -144,6 +145,8 @@ type property ShowHint; property TabOrder; property TextColor; + property OnDoubleClick; + property OnShowHint; end; @@ -196,10 +199,13 @@ type property DragToReorder; property FocusItem; property FontDesc; + property Hint; property HotTrack; property Items; + property ParentShowHint; property PopupFrame; property ShowColorNames; + property ShowHint; property TabOrder; property TextColor; end; @@ -216,13 +222,14 @@ type TfpgListBoxStrings = class(TStringList) protected ListBox: TfpgTextListBox; - procedure SetUpdateState(Updating: Boolean); override; public constructor Create(AListBox: TfpgTextListBox); destructor Destroy; override; function Add(const s: String): Integer; override; procedure Delete(Index: Integer); override; procedure Clear; override; + procedure Exchange(Index1, Index2: Integer); override; + procedure Assign(Source: TPersistent); override; end; @@ -239,12 +246,6 @@ end; { TfpgListBoxStrings } -procedure TfpgListBoxStrings.SetUpdateState(Updating: Boolean); -begin - inherited SetUpdateState(Updating); - // do nothing extra for now -end; - constructor TfpgListBoxStrings.Create(AListBox: TfpgTextListBox); begin inherited Create; @@ -260,6 +261,8 @@ end; function TfpgListBoxStrings.Add(const s: String): Integer; begin Result := inherited Add(s); + if UpdateCount > 0 then + Exit; if Assigned(ListBox) and (ListBox.HasHandle) then begin ListBox.UpdateScrollBar; @@ -270,6 +273,8 @@ end; procedure TfpgListBoxStrings.Delete(Index: Integer); begin inherited Delete(Index); + if UpdateCount > 0 then + Exit; if Assigned(ListBox) and (ListBox.HasHandle) then begin ListBox.UpdateScrollBar; @@ -280,11 +285,36 @@ end; procedure TfpgListBoxStrings.Clear; begin inherited Clear; + if UpdateCount > 0 then + Exit; ListBox.FocusItem := -1; ListBox.UpdateScrollBar; ListBox.Invalidate; end; +procedure TfpgListBoxStrings.Exchange(Index1, Index2: Integer); +begin + inherited Exchange(Index1, Index2); + if UpdateCount > 0 then + Exit; + if Assigned(ListBox) and (ListBox.HasHandle) then + begin + ListBox.Invalidate; + end; +end; + +procedure TfpgListBoxStrings.Assign(Source: TPersistent); +begin + inherited Assign(Source); + if UpdateCount > 0 then + Exit; + if Assigned(ListBox) and (ListBox.HasHandle) then + begin + ListBox.UpdateScrollBar; + ListBox.Invalidate; + end; +end; + { TfpgBaseListBox } @@ -622,7 +652,7 @@ var r: TfpgRect; begin //if FUpdateCount > 0 then - //Exit; //==> + // Exit; //==> inherited HandlePaint; Canvas.ClearClipRect; @@ -990,6 +1020,10 @@ begin FItems.Add(TColorItem.Create('clUnset', clUnset)); FItems.Add(TColorItem.Create('clMenuText', clMenuText)); FItems.Add(TColorItem.Create('clMenuDisabled', clMenuDisabled)); + FItems.Add(TColorItem.Create('clGridSelection', clGridSelection)); + FItems.Add(TColorItem.Create('clGridSelectionText', clGridSelectionText)); + FItems.Add(TColorItem.Create('clGridInactiveSel', clGridInactiveSel)); + FItems.Add(TColorItem.Create('clGridInactiveSelText', clGridInactiveSelText)); end; cpWebColors: begin diff --git a/src/gui/fpg_listview.pas b/src/gui/fpg_listview.pas index f6688787..12ed4364 100644 --- a/src/gui/fpg_listview.pas +++ b/src/gui/fpg_listview.pas @@ -1,7 +1,7 @@ { fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2009 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -24,6 +24,7 @@ interface uses Classes, SysUtils, + contnrs, fpg_base, fpg_main, fpg_widget, @@ -80,7 +81,7 @@ type TfpgLVColumns = class(TPersistent) private FListView: TfpgListView; - FColumns: TList; + FColumns: TObjectList; function GetColumn(AIndex: Integer): TfpgLVColumn; procedure SetColumn(AIndex: Integer; const AValue: TfpgLVColumn); public @@ -121,7 +122,7 @@ type FColumns: TfpgLVColumns; FCurrentIndexOf: Integer; FViewers: TList; - FItems: TList; + FItems: TObjectList; function GetCapacity: Integer; function GetItem(AIndex: Integer): TfpgLVItem; procedure SetCapacity(const AValue: Integer); @@ -244,13 +245,16 @@ type procedure BeginUpdate; procedure EndUpdate; procedure MakeItemVisible(AIndex: Integer; PartialOK: Boolean = False); - function ItemAdd: TfpgLVItem; + function ItemAdd: TfpgLVItem; deprecated; + function AddItem: TfpgLVItem; + function NewItem: TfpgLVItem; published property Columns: TfpgLVColumns read FColumns; property HScrollBar: TfpgScrollBar read FHScrollBar; property ItemHeight: Integer read GetItemHeight; property ItemIndex: Integer read FItemIndex write SetItemIndex; property Items: TfpgLVItems read FItems write SetItems; + property Hint; property MultiSelect: Boolean read FMultiSelect write SetMultiSelect; property ParentShowHint; property SelectionFollowsFocus: Boolean read FSelectionFollowsFocus write FSelectionFollowsFocus; @@ -262,6 +266,7 @@ type property OnPaintColumn: TfpgLVPaintColumnEvent read FOnPaintColumn write FOnPaintColumn; property OnPaintItem: TfpgLVPaintItemEvent read FOnPaintItem write FOnPaintItem; property OnSelectionChanged: TfpgLVItemSelectEvent read FOnSelectionChanged write FOnSelectionChanged; + property OnShowHint; end; @@ -387,7 +392,7 @@ end; constructor TfpgLVItems.Create(AViewer: IfpgLVItemViewer); begin - FItems := TList.Create; + FItems := TObjectList.Create; FViewers := TList.Create; AddViewer(AViewer); end; @@ -433,11 +438,11 @@ begin // search significantly when we are using indexof in a for loop if (FCurrentIndexOf > 100) and (FCurrentIndexOf < Count-2) then begin - if FItems.Items[FCurrentIndexOf] = Pointer(AItem) then + if FItems.Items[FCurrentIndexOf] = AItem then Result := FCurrentIndexOf - else if FItems.Items[FCurrentIndexOf+1] = Pointer(AItem) then + else if FItems.Items[FCurrentIndexOf+1] = AItem then Result := FCurrentIndexOf+1 - else if FItems.Items[FCurrentIndexOf-1] = Pointer(AItem) then + else if FItems.Items[FCurrentIndexOf-1] = AItem then Result := FCurrentIndexOf-1 end; if Result = -1 then @@ -800,13 +805,7 @@ begin FOnColumnClick(Self, Column, Button); Column.FDown := True; - - if FUpdateCount = 0 then - begin - Canvas.BeginDraw(False); - PaintHeaders; - Canvas.EndDraw;//(2,2, width-4, Height-4); - end; + Repaint; end; procedure TfpgListView.HandleHeaderMouseMove(x, y: Integer; btnstate: word; @@ -1568,6 +1567,7 @@ begin FItems.DeleteViewer(Self); FSelected.Free; FOldSelected.Free; + FColumns.Free; inherited Destroy; end; @@ -1615,10 +1615,20 @@ end; function TfpgListView.ItemAdd: TfpgLVItem; begin + Result := AddItem; +end; + +function TfpgListView.AddItem: TfpgLVItem; +begin Result := TfpgLVItem.Create(FItems); FItems.Add(Result); end; +function TfpgListView.NewItem: TfpgLVItem; +begin + Result := TfpgLVItem.Create(FItems); +end; + { TfpgLVColumns } function TfpgLVColumns.GetColumn(AIndex: Integer): TfpgLVColumn; @@ -1634,7 +1644,7 @@ end; constructor TfpgLVColumns.Create(AListView: TfpgListView); begin FListView := AListView; - FColumns := TList.Create; + FColumns := TObjectList.Create; end; destructor TfpgLVColumns.Destroy; diff --git a/src/gui/fpg_memo.pas b/src/gui/fpg_memo.pas index 7b59043f..37f21a42 100644 --- a/src/gui/fpg_memo.pas +++ b/src/gui/fpg_memo.pas @@ -1,7 +1,7 @@ { fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2009 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -110,6 +110,7 @@ type published property BackgroundColor default clBoxColor; property FontDesc: string read GetFontDesc write SetFontDesc; + property Hint; property Lines: TStringList read FLines; property ParentShowHint; property ShowHint; @@ -119,6 +120,7 @@ type property OnEnter; property OnExit; property OnKeyPress; + property OnShowHint; end; @@ -402,8 +404,9 @@ begin SetLineText(selsl, ls); end; - for n := selsl to selel do - FLines.Delete(n); + //delete moves lines up, so delete same line number over and over. + for n := (selsl+1) to selel do + FLines.Delete(selsl+1); FCursorPos := selsp; FCursorLine := selsl; @@ -864,6 +867,10 @@ begin Break; end; { for } + // Special case because it never entered the for loop above + if (LineCount = 0) and Focused then + fpgCaret.SetCaret(Canvas, FSideMargin, 3, fpgCaret.Width, FFont.Height); + if not Focused then fpgCaret.UnSetCaret(Canvas); diff --git a/src/gui/fpg_menu.pas b/src/gui/fpg_menu.pas index 8031f4f1..06e64b6f 100644 --- a/src/gui/fpg_menu.pas +++ b/src/gui/fpg_menu.pas @@ -1,7 +1,7 @@ { fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -58,6 +58,7 @@ type private FCommand: ICommand; FEnabled: boolean; + FHint: TfpgString; FHotKeyDef: TfpgHotKeyDef; FOnClick: TNotifyEvent; FSeparator: boolean; @@ -76,11 +77,12 @@ type procedure Click; function Selectable: boolean; function GetAccelChar: string; - procedure DrawText(ACanvas: TfpgCanvas; x, y: TfpgCoord); + procedure DrawText(ACanvas: TfpgCanvas; x, y: TfpgCoord; const AImgWidth: integer); function GetCommand: ICommand; procedure SetCommand(ACommand: ICommand); property Checked: boolean read FChecked write SetChecked; property Text: TfpgString read FText write SetText; + property Hint: TfpgString read FHint write FHint; property HotKeyDef: TfpgHotKeyDef read FHotKeyDef write SetHotKeyDef; property Separator: boolean read FSeparator write SetSeparator; property Visible: boolean read FVisible write SetVisible; @@ -121,8 +123,8 @@ type procedure HandlePaint; override; procedure HandleShow; override; procedure HandleClose; override; - procedure DrawItem(mi: TfpgMenuItem; rect: TfpgRect); virtual; - procedure DrawRow(line: integer; focus: boolean); virtual; + procedure DrawItem(mi: TfpgMenuItem; rect: TfpgRect; const AItemFocused: boolean); virtual; + procedure DrawRow(line: integer; const AItemFocused: boolean); virtual; function ItemHeight(mi: TfpgMenuItem): integer; virtual; procedure PrepareToShow; public @@ -185,10 +187,14 @@ function CreateMenuBar(AOwner: TfpgWidget): TfpgMenuBar; overload; implementation - + var uFocusedPopupMenu: TfpgPopupMenu; +const + cImgWidth: integer = 16; + + function CreateMenuBar(AOwner: TfpgWidget; x, y, w, h: TfpgCoord): TfpgMenuBar; begin if AOwner = nil then @@ -257,13 +263,16 @@ begin FSeparator := False; FVisible := True; FEnabled := True; + FChecked := False; FSubMenu := nil; FOnClick := nil; end; procedure TfpgMenuItem.Click; begin - if Assigned(FOnClick) then + if Assigned(FCommand) then // ICommand takes preference over OnClick + FCommand.Execute + else if Assigned(FOnClick) then FOnClick(self); end; @@ -285,13 +294,12 @@ begin Result := ''; end; -procedure TfpgMenuItem.DrawText(ACanvas: TfpgCanvas; x, y: TfpgCoord); +procedure TfpgMenuItem.DrawText(ACanvas: TfpgCanvas; x, y: TfpgCoord; const AImgWidth: integer); var s: string; p: integer; achar: string; begin -// writeln('DrawText x:', x, ' y:', y); if not Enabled then ACanvas.SetFont(fpgStyle.MenuDisabledFont) else @@ -305,12 +313,13 @@ begin if p > 0 then begin // first part of text before the & sign - ACanvas.DrawString(x, y, UTF8Copy(s, 1, p-1)); + fpgStyle.DrawString(ACanvas, x, y, UTF8Copy(s, 1, p-1), Enabled); + inc(x, fpgStyle.MenuFont.TextWidth(UTF8Copy(s, 1, p-1))); if UTF8Copy(s, p+1, 1) = achar then begin // Do we need to paint a actual & sign (create via && in item text) - ACanvas.DrawString(x, y, achar); + fpgStyle.DrawString(ACanvas, x, y, achar, Enabled); inc(x, fpgStyle.MenuFont.TextWidth(achar)); end else @@ -318,7 +327,7 @@ begin // Draw the HotKey text if Enabled then ACanvas.SetFont(fpgStyle.MenuAccelFont); - ACanvas.DrawString(x, y, UTF8Copy(s, p+1, 1)); + fpgStyle.DrawString(ACanvas, x, y, UTF8Copy(s, p+1, 1), Enabled); inc(x, ACanvas.Font.TextWidth(UTF8Copy(s, p+1, 1))); if Enabled then ACanvas.SetFont(fpgStyle.MenuFont); @@ -329,7 +338,7 @@ begin // Draw the remaining text after the & sign if UTF8Length(s) > 0 then - ACanvas.DrawString(x, y, s); + fpgStyle.DrawString(ACanvas, x, y, s, Enabled); end; function TfpgMenuItem.GetCommand: ICommand; @@ -507,7 +516,7 @@ begin Canvas.SetColor(clShadow1); Canvas.DrawLine(r.Left, r.Bottom-1, r.Right+1, r.Bottom-1); // bottom // outer bottom line - Canvas.SetColor(clHilite1); + Canvas.SetColor(clWhite); Canvas.DrawLine(r.Left, r.Bottom, r.Right+1, r.Bottom); // bottom for n := 0 to VisibleCount-1 do @@ -590,7 +599,7 @@ begin Canvas.FillRectangle(r); // a possible future theme option // Canvas.GradientFill(r, FLightColor, FDarkColor, gdVertical); - mi.DrawText(Canvas, r.left+4, r.top+1); + mi.DrawText(Canvas, r.left+4, r.top+1, cImgWidth); Canvas.EndDraw(r.Left, r.Top, r.Width, r.Height); Exit; //==> end; { if col=n } @@ -739,7 +748,7 @@ begin begin CloseSubMenus; // showing the submenu - mi.SubMenu.ShowAt(self, Width, GetItemPosY(FFocusItem)); + mi.SubMenu.ShowAt(self, Width-5, GetItemPosY(FFocusItem)); // 5 is the menu overlap in pixels mi.SubMenu.OpenerPopup := self; mi.SubMenu.OpenerMenuBar := OpenerMenuBar; uFocusedPopupMenu := mi.SubMenu; @@ -829,7 +838,6 @@ procedure TfpgPopupMenu.HandleLMouseUp(x, y: integer; shiftstate: TShiftState); var newf: integer; mi: TfpgMenuItem; - r: TfpgRect; begin inherited HandleLMouseUp(x, y, shiftstate); @@ -972,7 +980,7 @@ begin Canvas.BeginDraw; // inherited HandlePaint; Canvas.Clear(BackgroundColor); - Canvas.SetColor(clWidgetFrame); + Canvas.SetColor(clWindowBackground); Canvas.DrawRectangle(0, 0, Width, Height); // black rectangle border Canvas.DrawButtonFace(1, 1, Width-1, Height-1, []); // 3d rectangle inside black border @@ -1009,7 +1017,7 @@ begin Result := TfpgMenuItem(FItems.Items[ind]); end; -procedure TfpgPopupMenu.DrawItem(mi: TfpgMenuItem; rect: TfpgRect); +procedure TfpgPopupMenu.DrawItem(mi: TfpgMenuItem; rect: TfpgRect; const AItemFocused: boolean); var s: string; x: integer; @@ -1017,35 +1025,47 @@ var begin if mi.Separator then begin - Canvas.SetColor(clMenuText); - Canvas.DrawLine(rect.Left, rect.Top+2, rect.Right+1, rect.Top+2); + Canvas.SetColor(clShadow1); + Canvas.DrawLine(rect.Left+1, rect.Top+2, rect.Right, rect.Top+2); + Canvas.SetColor(clHilite2); + Canvas.DrawLine(rect.Left+1, rect.Top+3, rect.Right, rect.Top+3); end else begin - x := rect.Left + FSymbolWidth + FTextMargin; + // process Check mark if needed + if mi.Checked then + begin + img := fpgImages.GetImage('stdimg.check'); // Do NOT localize + if AItemFocused then + img.Invert; + Canvas.DrawImage(rect.Left, rect.Top, img); + if AItemFocused then + img.Invert; // restore image to original state + end; - mi.DrawText(Canvas, x, rect.top); + // process menu item Text + x := rect.Left + FSymbolWidth + FTextMargin; + mi.DrawText(Canvas, x+cImgWidth, rect.top, cImgWidth); + // process menu item Hot Key text if mi.HotKeyDef <> '' then begin s := mi.HotKeyDef; - Canvas.DrawString(rect.Right-FMenuFont.TextWidth(s)-FTextMargin, rect.Top, s); + fpgStyle.DrawString(Canvas, rect.Right-FMenuFont.TextWidth(s)-FTextMargin, rect.Top, s, mi.Enabled); end; + // process menu item submenu arrow image if mi.SubMenu <> nil then begin - canvas.SetColor(Canvas.TextColor); + Canvas.SetColor(Canvas.TextColor); x := (rect.height div 2) - 3; - img := fpgImages.GetImage('sys.sb.right'); + img := fpgImages.GetImage('sys.sb.right'); // Do NOT localize Canvas.DrawImage(rect.right-x-2, rect.Top + ((rect.Height-img.Height) div 2), img); -// canvas.FillTriangle(rect.right-x-2, rect.top+2, -// rect.right-2, rect.top+2+x, -// rect.right-x-2, rect.top+2+2*x); end; end; end; -procedure TfpgPopupMenu.DrawRow(line: integer; focus: boolean); +procedure TfpgPopupMenu.DrawRow(line: integer; const AItemFocused: boolean); var n: integer; r: TfpgRect; @@ -1062,7 +1082,7 @@ begin if line = n then begin - if focus and (not mi.Separator) then + if AItemFocused and (not mi.Separator) then begin if MenuFocused then begin @@ -1092,7 +1112,7 @@ begin end; end; Canvas.FillRectangle(r); - DrawItem(mi, r); + DrawItem(mi, r, AItemFocused); Canvas.EndDraw(r.Left, r.Top, r.Width, r.Height); Exit; //==> end; @@ -1202,8 +1222,8 @@ begin hkw := hkw + 10; // spacing between text and hotkey text FHeight := FMargin*2 + h; - FWidth := (FMargin+FTextMargin)*2 + FSymbolWidth + tw + hkw; - + FWidth := ((FMargin+FTextMargin)*2) + FSymbolWidth + tw + hkw + (cImgWidth*2); + uFocusedPopupMenu := self; end; diff --git a/src/gui/fpg_mru.pas b/src/gui/fpg_mru.pas index 64feb793..58106e12 100644 --- a/src/gui/fpg_mru.pas +++ b/src/gui/fpg_mru.pas @@ -1,7 +1,7 @@ { fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2010 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_panel.pas b/src/gui/fpg_panel.pas index 28e2c722..b58b516d 100644 --- a/src/gui/fpg_panel.pas +++ b/src/gui/fpg_panel.pas @@ -1,7 +1,7 @@ { fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -32,7 +32,7 @@ uses type TPanelShape = (bsBox, bsFrame, bsTopLine, bsBottomLine, bsLeftLine, - bsRightLine, bsSpacer); + bsRightLine, bsSpacer, bsVerDivider); TPanelStyle = (bsLowered, bsRaised); @@ -41,14 +41,17 @@ type TfpgAbstractPanel = class(TfpgWidget) private - FPanelShape: TPanelShape; FPanelStyle: TPanelStyle; FPanelBorder: TPanelBorder; + FParentBackgroundColor: Boolean; procedure SetPanelStyle(const AValue: TPanelStyle); procedure SetPanelBorder(const AValue: TPanelBorder); + procedure SetParentBackgroundColor(const AValue: Boolean); protected + procedure HandlePaint; override; property Style: TPanelStyle read FPanelStyle write SetPanelStyle default bsRaised; property BorderStyle: TPanelBorder read FPanelBorder write SetPanelBorder default bsSingle; + property ParentBackgroundColor: Boolean read FParentBackgroundColor write SetParentBackgroundColor default False; public constructor Create(AOwner: TComponent); override; function GetClientRect: TfpgRect; override; @@ -57,22 +60,42 @@ type TfpgBevel = class(TfpgAbstractPanel) private + FPanelShape: TPanelShape; procedure SetPanelShape(const AValue: TPanelShape); + procedure DrawBox; // bsBox + procedure DrawFrame; // bsFrame + procedure DrawTopLine; // bsTopLine + procedure DrawBottomLine; // bsBottomLine + procedure DrawLeftLine; // bsLeftLine + procedure DrawRightLine; // bsRightLine + procedure DrawSpacer; // bsSpacer + procedure DrawVerDivider; // bsVerDivider protected procedure HandlePaint; override; published property BackgroundColor; property BorderStyle; - property Shape: TPanelShape read FPanelShape write SetPanelShape default bsBox; - property Style; + property Height; + property Hint; + property Left; + property MaxHeight; + property MaxWidth; + property MinHeight; + property MinWidth; + property ParentBackgroundColor; property ParentShowHint; + property Shape: TPanelShape read FPanelShape write SetPanelShape default bsBox; property ShowHint; + property Style; + property Top; + property Width; property OnClick; property OnDoubleClick; property OnMouseDown; property OnMouseMove; property OnMouseUp; property OnPaint; + property OnShowHint; end; @@ -90,8 +113,6 @@ type procedure SetLayout(const AValue: TLayout); function GetText: string; procedure SetText(const AValue: string); - function GetFontDesc: string; - procedure SetFontDesc(const AValue: string); function GetLineSpace: integer; procedure SetLineSpace(const AValue: integer); function GetMargin: integer; @@ -100,6 +121,8 @@ type procedure SetWrapText(const AValue: boolean); protected FFont: TfpgFont; + function GetFontDesc: string; virtual; + procedure SetFontDesc(const AValue: string); virtual; procedure HandlePaint; override; public constructor Create(AOwner: TComponent); override; @@ -110,17 +133,28 @@ type property BackgroundColor; property BorderStyle; property FontDesc: string read GetFontDesc write SetFontDesc; + property Height; + property Hint; property Layout: TLayout read GetLayout write SetLayout default tlCenter; - property Style; - property Text: string read GetText write SetText; - property TextColor; + property Left; property LineSpace: integer read GetLineSpace write SetLineSpace default 2; property Margin: integer read GetMargin write SetMargin default 2; - property WrapText: boolean read GetWrapText write SetWrapText default False; + property MaxHeight; + property MaxWidth; + property MinHeight; + property MinWidth; + property ParentBackgroundColor; property ParentShowHint; property ShowHint; + property Style; + property Text: string read GetText write SetText; + property TextColor; + property Top; + property Width; + property WrapText: boolean read GetWrapText write SetWrapText default False; property OnClick; property OnDoubleClick; + property OnShowHint; end; @@ -139,24 +173,35 @@ type procedure SetMargin(const AValue: integer); protected FFont: TfpgFont; - function GetClientRect: TfpgRect; override; procedure HandlePaint; override; public constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + function GetClientRect: TfpgRect; override; property Font: TfpgFont read FFont; published property Alignment: TAlignment read GetAlignment write SetAlignment default taLeftJustify; property BackgroundColor; property BorderStyle; property FontDesc: string read GetFontDesc write SetFontDesc; + property Height; + property Hint; + property Left; property Margin: integer read GetMargin write SetMargin default 2; + property MaxHeight; + property MaxWidth; + property MinHeight; + property MinWidth; property ParentShowHint; property ShowHint; property Style; property Text: string read GetText write SetText; property TextColor; + property Top; + property Width; property OnClick; property OnDoubleClick; + property OnShowHint; end; @@ -242,16 +287,31 @@ begin end; end; +procedure TfpgAbstractPanel.SetParentBackgroundColor(const AValue: Boolean); +begin + if FParentBackgroundColor = AValue then exit; + FParentBackgroundColor := AValue; + RePaint; +end; + +procedure TfpgAbstractPanel.HandlePaint; +begin + inherited HandlePaint; + if FParentBackgroundColor then + Canvas.Clear(Parent.BackgroundColor) + else + Canvas.Clear(BackgroundColor); +end; + constructor TfpgAbstractPanel.Create(AOwner: TComponent); begin inherited Create(AOwner); - FPanelShape := bsBox; FPanelStyle := bsRaised; FPanelBorder := bsSingle; FWidth := 80; FHeight := 80; FFocusable := True; // otherwise children can't get focus - FBackgroundColor := Parent.BackgroundColor; + FParentBackgroundColor := False; FIsContainer := True; end; @@ -266,69 +326,160 @@ begin end; end; -procedure TfpgBevel.HandlePaint; +procedure TfpgBevel.DrawBox; begin - inherited HandlePaint; - - Canvas.Clear(BackgroundColor); - - // Canvas.SetLineStyle(2, lsSolid); - // Canvas.SetColor(clWindowBackground); - // Canvas.DrawRectangle(1, 1, Width - 1, Height - 1); if FPanelBorder = bsSingle then Canvas.SetLineStyle(1, lsSolid) else Canvas.SetLineStyle(2, lsSolid); + if FPanelBorder = bsSingle then + Canvas.DrawLine(0, 0, Width - 1, 0) + else + Canvas.DrawLine(0, 1, Width - 1, 1); + + if FPanelBorder = bsSingle then + Canvas.DrawLine(0, 1, 0, Height - 1) + else + Canvas.DrawLine(1, 1, 1, Height - 1); + if Style = bsRaised then - Canvas.SetColor(clHilite2) + Canvas.SetColor(clShadow2) else - Canvas.SetColor(clShadow2); + Canvas.SetColor(clHilite2); - if Shape in [bsBox] then - if FPanelBorder = bsSingle then - Canvas.DrawLine(0, 0, Width - 1, 0) - else - Canvas.DrawLine(0, 1, Width - 1, 1); - if Shape in [bsFrame, bsTopLine] then - Canvas.DrawLine(0, 0, Width - 1, 0); - if Shape in [bsBox] then - if FPanelBorder = bsSingle then - Canvas.DrawLine(0, 1, 0, Height - 1) - else - Canvas.DrawLine(1, 1, 1, Height - 1); - if Shape in [bsFrame, bsLeftLine] then - Canvas.DrawLine(0, 1, 0, Height - 1); - if Shape in [bsFrame, bsRightLine] then - Canvas.DrawLine(Width - 2, 1, Width - 2, Height - 1); - if Shape in [bsFrame, bsBottomLine] then - Canvas.DrawLine(1, Height - 2, Width - 1, Height - 2); + Canvas.DrawLine(Width - 1, 0, Width - 1, Height - 1); + Canvas.DrawLine(0, Height - 1, Width, Height - 1); +end; + +procedure TfpgBevel.DrawFrame; +begin + Canvas.SetLineStyle(1, lsSolid); + + Canvas.DrawLine(0, 0, Width - 1, 0); + Canvas.DrawLine(0, 1, 0, Height - 1); + Canvas.DrawLine(Width - 2, 1, Width - 2, Height - 1); + Canvas.DrawLine(1, Height - 2, Width - 1, Height - 2); + + if Style = bsRaised then + Canvas.SetColor(clShadow2) + else + Canvas.SetColor(clHilite2); + + Canvas.DrawLine(1, 1, Width - 2, 1); + Canvas.DrawLine(1, 2, 1, Height - 2); + Canvas.DrawLine(Width - 1, 0, Width - 1, Height - 1); + Canvas.DrawLine(0, Height - 1, Width, Height - 1); +end; + +procedure TfpgBevel.DrawTopLine; +begin + Canvas.SetLineStyle(1, lsSolid); + Canvas.DrawLine(0, 0, Width, 0); if Style = bsRaised then Canvas.SetColor(clShadow2) else Canvas.SetColor(clHilite2); - if Shape in [bsFrame, bsTopLine] then - Canvas.DrawLine(1, 1, Width - 2, 1); - if Shape in [bsFrame, bsLeftLine] then - Canvas.DrawLine(1, 2, 1, Height - 2); - if Shape in [bsBox, bsFrame, bsRightLine] then - Canvas.DrawLine(Width - 1, 0, Width - 1, Height - 1); - if Shape in [bsBox, bsFrame, bsBottomLine] then - Canvas.DrawLine(0, Height - 1, Width, Height - 1); - + Canvas.DrawLine(0, 1, Width, 1); +end; + +procedure TfpgBevel.DrawBottomLine; +begin + Canvas.SetLineStyle(1, lsSolid); + Canvas.DrawLine(0, Height - 2, Width, Height - 2); + + if Style = bsRaised then + Canvas.SetColor(clShadow2) + else + Canvas.SetColor(clHilite2); + + Canvas.DrawLine(0, Height - 1, Width, Height - 1); +end; + +procedure TfpgBevel.DrawLeftLine; +begin + Canvas.SetLineStyle(1, lsSolid); + Canvas.DrawLine(0, 1, 0, Height - 1); + + if Style = bsRaised then + Canvas.SetColor(clShadow2) + else + Canvas.SetColor(clHilite2); + + Canvas.DrawLine(1, 1, 1, Height - 1); +end; + +procedure TfpgBevel.DrawRightLine; +begin + Canvas.SetLineStyle(1, lsSolid); + Canvas.DrawLine(Width - 2, 0, Width - 2, Height - 1); + + if Style = bsRaised then + Canvas.SetColor(clShadow2) + else + Canvas.SetColor(clHilite2); + + Canvas.DrawLine(Width - 1, 0, Width - 1, Height - 1); +end; + +procedure TfpgBevel.DrawSpacer; +begin // To make it more visible in the UI Designer if csDesigning in ComponentState then begin - if Shape in [bsSpacer] then - begin - Canvas.SetColor(clInactiveWgFrame); - Canvas.SetLineStyle(1, lsDash); - Canvas.DrawRectangle(0, 0, Width, Height); -// Canvas.SetTextColor(clText1); -// Canvas.DrawString(2, 2, Name + ': ' + Classname); - end; + Canvas.SetColor(clInactiveWgFrame); + Canvas.SetLineStyle(1, lsDash); + Canvas.DrawRectangle(0, 0, Width, Height); + end; +end; + +procedure TfpgBevel.DrawVerDivider; + + procedure PaintLine(px, py: integer); + begin + if Style = bsRaised then + Canvas.SetColor(clHilite2) + else + Canvas.SetColor(clShadow1); + + Canvas.DrawLine(px, py, px+2, py); + Canvas.DrawLine(px, py, px, Height); + + if Style = bsRaised then + Canvas.SetColor(clShadow1) + else + Canvas.SetColor(clHilite2); + + Canvas.DrawLine(px+1, Height - 1, px+3, Height - 1); + Canvas.DrawLine(px+2, py, px+2, Height); + end; + +begin + PaintLine(0, 0); + if FPanelBorder = bsDouble then + PaintLine(3, 0); +end; + +procedure TfpgBevel.HandlePaint; +begin + inherited HandlePaint; + + if Style = bsRaised then + Canvas.SetColor(clHilite2) + else + Canvas.SetColor(clShadow1); + + case Shape of + bsBox: DrawBox; + bsFrame: DrawFrame; + bsTopLine: DrawTopLine; + bsBottomLine: DrawBottomLine; + bsLeftLine: DrawLeftLine; + bsRightLine: DrawRightLine; + bsSpacer: DrawSpacer; + bsVerDivider: DrawVerDivider; end; end; @@ -435,8 +586,6 @@ var begin inherited HandlePaint; - Canvas.Clear(BackgroundColor); - // Canvas.SetLineStyle(2, lsSolid); // Canvas.SetColor(clWindowBackground); // Canvas.DrawRectangle(1, 1, Width - 1, Height - 1); @@ -502,12 +651,9 @@ begin inherited Create(AOwner); FText := 'Panel'; FFont := fpgGetFont('#Label1'); - FPanelShape := bsBox; FPanelStyle := bsRaised; FWidth := 80; FHeight := 80; - FFocusable := True; // otherwise children can't get focus - FBackgroundColor := Parent.BackgroundColor; FAlignment := taCenter; FLayout := tlCenter; FWrapText := False; @@ -743,7 +889,6 @@ begin inherited Create(AOwner); FText := 'Group box'; FFont := fpgGetFont('#Label1'); - FPanelShape := bsBox; FPanelStyle := bsRaised; FWidth := 80; FHeight := 80; @@ -753,5 +898,11 @@ begin FMargin := 2; end; +destructor TfpgGroupBox.Destroy; +begin + FFont.Free; + inherited Destroy; +end; + end. diff --git a/src/gui/fpg_popupcalendar.pas b/src/gui/fpg_popupcalendar.pas index a4c2fe94..af27568b 100644 --- a/src/gui/fpg_popupcalendar.pas +++ b/src/gui/fpg_popupcalendar.pas @@ -1,7 +1,7 @@ { fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -51,14 +51,52 @@ uses fpg_combobox, fpg_basegrid, fpg_grid, - fpg_dialogs{, - fpg_checkbox}; + fpg_dialogs, + fpg_menu, + fpg_hyperlink, + fpg_panel; type TfpgOnDateSetEvent = procedure(Sender: TObject; const ADate: TDateTime) of object; TfpgOnCheckboxChangedEvent = procedure(Sender: TObject; const AIsChecked: Boolean) of object; + TYearSelectForm = class(TfpgPopupWindow) + private + {@VFD_HEAD_BEGIN: YearSelectForm} + btnMinus10: TfpgButton; + btnPlus10: TfpgButton; + Bevel1: TfpgBevel; + Label1: TfpgHyperlink; + Label2: TfpgHyperlink; + Label3: TfpgHyperlink; + Label4: TfpgHyperlink; + Label5: TfpgHyperlink; + Label6: TfpgHyperlink; + Label7: TfpgHyperlink; + Label8: TfpgHyperlink; + Label9: TfpgHyperlink; + Label10: TfpgHyperlink; + {@VFD_HEAD_END: YearSelectForm} + FYear: Word; + FOriginalYear: Word; + FMinYear: Word; + FMaxYear: Word; + procedure YearClicked(Sender: TObject); + procedure SetYear(const AValue: Word); + procedure Minus10Clicked(Sender: TObject); + procedure Plus10Clicked(Sender: TObject); + protected + procedure HandlePaint; override; + public + constructor CreateCustom(AOwner: TComponent; const MinYear, MaxYear: Word); + procedure AfterConstruction; override; + procedure AfterCreate; + property Year: Word read FYear write SetYear; + property MinYear: Word read FMinYear; + property MaxYear: Word read FMaxYear; + end; + TfpgPopupCalendar = class(TfpgPopupWindow) private @@ -85,6 +123,10 @@ type FDayColor: TfpgColor; FHolidayColor: TfpgColor; FSelectedColor: TfpgColor; + FSingleClickSelect: boolean; + FMonthsPopupMenu: TfpgPopupMenu; + FYearPopupWindow: TYearSelectForm; + procedure YearPopupWindowClose(Sender: TObject); function GetDateElement(Index: integer): Word; procedure PopulateDays; procedure CalculateMonthOffset; @@ -105,10 +147,16 @@ type procedure btnMonthUpClicked(Sender: TObject); procedure btnMonthDownClicked(Sender: TObject); procedure btnTodayClicked(Sender: TObject); + procedure grdName1Clicked(Sender: TObject); procedure grdName1DoubleClick(Sender: TObject; AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint); procedure grdName1KeyPress(Sender: TObject; var KeyCode: word; var ShiftState: TShiftState; var Consumed: boolean); procedure grdName1DrawCell(Sender: TObject; const ARow, ACol: Integer; const ARect: TfpgRect; const AFlags: TfpgGridDrawState; var ADefaultDrawing: boolean); + procedure edtMonthClicked(Sender: TObject); + procedure edtYearClicked(Sender: TObject); + procedure miMonthClicked(Sender: TObject); procedure TearDown; + procedure SetSingleClickSelect(const AValue: boolean); + procedure ClosePopupMenusWindows; protected FntNorm, FntBold: TfpgFont; FOrigFocusWin: TfpgWidget; @@ -116,12 +164,14 @@ type procedure HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: boolean); override; procedure HandleShow; override; procedure HandleHide; override; + procedure ShowDefaultPopupMenu; virtual; property CallerWidget: TfpgWidget read FCallerWidget write FCallerWidget; public constructor Create(AOwner: TComponent; AOrigFocusWin: TfpgWidget); reintroduce; destructor Destroy; override; procedure AfterCreate; property CloseOnSelect: boolean read FCloseOnSelect write SetCloseOnSelect default True; + property SingleClickSelect: boolean read FSingleClickSelect write SetSingleClickSelect default False; property Day: Word index 1 read GetDateElement write SetDateElement; property Month: Word index 2 read GetDateElement write SetDateElement; property Year: Word index 3 read GetDateElement write SetDateElement; @@ -150,6 +200,7 @@ type FHolidayColor: TfpgColor; FSelectedColor: TfpgColor; FCloseOnSelect: boolean; + FSingleClickSelect: boolean; procedure SetDateFormat(const AValue: string); procedure SetDateValue(const AValue: TDateTime); procedure SetMaxDate(const AValue: TDateTime); @@ -159,10 +210,11 @@ type procedure SetDayColor(const AValue: TfpgColor); procedure SetHolidayColor(const AValue: TfpgColor); procedure SetSelectedColor(const AValue: TfpgColor); - procedure SetText(const AValue: string); override; - function GetText: string; override; procedure SetCloseOnSelect(const AValue: boolean); + procedure SetSingleClickSelect(const AValue: boolean); protected + function GetText: string; override; + procedure SetText(const AValue: string); override; procedure InternalOnValueSet(Sender: TObject; const ADate: TDateTime); virtual; function HasText: boolean; override; procedure DoDropDown; override; @@ -170,36 +222,37 @@ type constructor Create(AOwner: TComponent); override; published property BackgroundColor; + { Clicking on calendar Today button will close the popup calendar by default } + property CloseOnSelect: boolean read FCloseOnSelect write SetCloseOnSelect default True; property DateFormat: string read FDateFormat write SetDateFormat; property DateValue: TDateTime read FDate write SetDateValue; - property FontDesc; - property MinDate: TDateTime read FMinDate write SetMinDate; - property MaxDate: TDateTime read FMaxDate write SetMaxDate; - property WeekStartDay: integer read FWeekStartDay write SetWeekStartDay default 0; - property WeeklyHoliday: integer read FWeeklyHoliday write SetWeeklyHoliday default -1; property DayColor: TfpgColor read FDayColor write SetDayColor; + property FontDesc; + property Hint; property HolidayColor: TfpgColor read FHolidayColor write SetHolidayColor; - property SelectedColor: TfpgColor read FSelectedColor write SetSelectedColor; + property MaxDate: TDateTime read FMaxDate write SetMaxDate; + property MinDate: TDateTime read FMinDate write SetMinDate; property ParentShowHint; + property SelectedColor: TfpgColor read FSelectedColor write SetSelectedColor; + property SingleClickSelect: boolean read FSingleClickSelect write SetSingleClickSelect default False; property ShowHint; - { Clicking on calendar Today button will close the popup calendar by default } - property CloseOnSelect: boolean read FCloseOnSelect write SetCloseOnSelect default True; + property WeeklyHoliday: integer read FWeeklyHoliday write SetWeeklyHoliday default -1; + property WeekStartDay: integer read FWeekStartDay write SetWeekStartDay default 0; property TabOrder; property OnChange; property OnCloseUp; property OnDropDown; property OnEnter; property OnExit; + property OnShowHint; end; TfpgCalendarCheckCombo = class(TfpgCalendarCombo) private -// FCheckBox: TfpgCheckbox; FChecked: boolean; FCheckBoxRect: TfpgRect; FCheckboxChanged: TfpgOnCheckboxChangedEvent; - procedure InternalCheckBoxChanged(Sender: TObject); procedure SetChecked(const AValue: Boolean); procedure DoCheckboxChanged; protected @@ -221,15 +274,297 @@ type {@VFD_NEWFORM_DECL} + implementation uses + dateutils, fpg_scrollbar, fpg_constants; +type + // friend class to get access to Protected methods + TPopupMenuFriend = class(TfpgPopupMenu); + {@VFD_NEWFORM_IMPL} +procedure TYearSelectForm.YearClicked(Sender: TObject); +begin + FYear := StrToInt(TfpgHyperlink(Sender).Text); + Close; +end; + +procedure TYearSelectForm.SetYear(const AValue: Word); + + function IsInRange(const AYear: word): boolean; + begin + // always one year less on either side (min and max) so we don't go over + // any possible month limits. + Result := (AYear > MinYear) and (AYear < MaxYear); + end; + +begin + if FYear = AValue then exit; + FYear := AValue; + if FOriginalYear = 0 then + FOriginalYear := FYear; + Label1.Text := IntToStr(FYear-4); + Label1.Enabled := IsInRange(FYear-4); + Label2.Text := IntToStr(FYear-3); + Label2.Enabled := IsInRange(FYear-3); + Label3.Text := IntToStr(FYear-2); + Label3.Enabled := IsInRange(FYear-2); + Label4.Text := IntToStr(FYear-1); + Label4.Enabled := IsInRange(FYear-1); + Label5.Text := IntToStr(FYear); + if FYear = FOriginalYear then + Label5.FontDesc := '#Label2' + else + Label5.FontDesc := '#Label1'; + Label5.Enabled := IsInRange(FYear); + Label6.Text := IntToStr(FYear+1); + Label6.Enabled := IsInRange(FYear+1); + Label7.Text := IntToStr(FYear+2); + Label7.Enabled := IsInRange(FYear+2); + Label8.Text := IntToStr(FYear+3); + Label8.Enabled := IsInRange(FYear+3); + Label9.Text := IntToStr(FYear+4); + Label9.Enabled := IsInRange(FYear+4); + Label10.Text := IntToStr(FYear+5); + Label10.Enabled := IsInRange(FYear+5); +end; + +procedure TYearSelectForm.Minus10Clicked(Sender: TObject); +begin + SetYear(FYear-10); +end; + +procedure TYearSelectForm.Plus10Clicked(Sender: TObject); +begin + SetYear(FYear+10); +end; + +procedure TYearSelectForm.HandlePaint; +begin +// inherited HandlePaint; + Canvas.BeginDraw; + Canvas.Clear(BackgroundColor); + Canvas.SetColor(clWindowBackground); + Canvas.DrawRectangle(0, 0, Width, Height); // black rectangle border + Canvas.DrawButtonFace(1, 1, Width-1, Height-1, []); // 3d rectangle inside black border + Canvas.EndDraw; +end; + +constructor TYearSelectForm.CreateCustom(AOwner: TComponent; const MinYear, MaxYear: Word); +begin + Create(AOwner); + FYear := 0; + FOriginalYear := 0; + FMinYear := MinYear; + FMaxYear := MaxYear; +end; + +procedure TYearSelectForm.AfterConstruction; +begin + inherited AfterConstruction; + AfterCreate; +end; + +procedure TYearSelectForm.AfterCreate; +begin + {%region 'Auto-generated GUI code' -fold} + {@VFD_BODY_BEGIN: YearSelectForm} + Name := 'YearSelectForm'; + SetPosition(439, 401, 130, 122); +// WindowTitle := 'YearSelectForm'; +// Hint := ''; +// Sizeable := False; + + btnMinus10 := TfpgButton.Create(self); + with btnMinus10 do + begin + Name := 'btnMinus10'; + SetPosition(4, 4, 24, 24); + Text := ''; + FontDesc := '#Label1'; + Hint := ''; + ImageMargin := -1; + ImageName := 'sys.sb.left'; + ImageSpacing := 0; + TabOrder := 1; + OnClick := @Minus10Clicked; + end; + + btnPlus10 := TfpgButton.Create(self); + with btnPlus10 do + begin + Name := 'btnPlus10'; + SetPosition(104, 4, 24, 24); + Text := ''; + FontDesc := '#Label1'; + Hint := ''; + ImageMargin := -1; + ImageName := 'sys.sb.right'; + ImageSpacing := 0; + TabOrder := 2; + OnClick := @Plus10Clicked; + end; + + Bevel1 := TfpgBevel.Create(self); + with Bevel1 do + begin + Name := 'Bevel1'; + SetPosition(64, 32, 2, 85); + Hint := ''; + Style := bsLowered; + end; + + Label1 := TfpgHyperlink.Create(self); + with Label1 do + begin + Name := 'Label1'; + SetPosition(8, 32, 44, 16); + Alignment := taCenter; + FontDesc := '#Label1'; + Hint := ''; + Text := 'Label'; + TextColor := clText1; + HotTrackFont := '#Label1'; + OnClick := @YearClicked; + end; + + Label2 := TfpgHyperlink.Create(self); + with Label2 do + begin + Name := 'Label2'; + SetPosition(8, 48, 44, 16); + Alignment := taCenter; + FontDesc := '#Label1'; + Hint := ''; + Text := 'Label'; + TextColor := clText1; + HotTrackFont := '#Label1'; + OnClick := @YearClicked; + end; + + Label3 := TfpgHyperlink.Create(self); + with Label3 do + begin + Name := 'Label3'; + SetPosition(8, 64, 44, 16); + Alignment := taCenter; + FontDesc := '#Label1'; + Hint := ''; + Text := 'Label'; + TextColor := clText1; + HotTrackFont := '#Label1'; + OnClick := @YearClicked; + end; + + Label4 := TfpgHyperlink.Create(self); + with Label4 do + begin + Name := 'Label4'; + SetPosition(8, 80, 44, 16); + Alignment := taCenter; + FontDesc := '#Label1'; + Hint := ''; + Text := 'Label'; + TextColor := clText1; + HotTrackFont := '#Label1'; + OnClick := @YearClicked; + end; + + Label5 := TfpgHyperlink.Create(self); + with Label5 do + begin + Name := 'Label5'; + SetPosition(8, 96, 44, 16); + Alignment := taCenter; + FontDesc := '#Label1'; + Hint := ''; + Text := 'Label'; + TextColor := clText1; + HotTrackFont := '#Label1'; + OnClick := @YearClicked; + end; + + Label6 := TfpgHyperlink.Create(self); + with Label6 do + begin + Name := 'Label6'; + SetPosition(76, 32, 44, 16); + Alignment := taCenter; + FontDesc := '#Label1'; + Hint := ''; + Text := 'Label'; + TextColor := clText1; + HotTrackFont := '#Label1'; + OnClick := @YearClicked; + end; + + Label7 := TfpgHyperlink.Create(self); + with Label7 do + begin + Name := 'Label7'; + SetPosition(76, 48, 44, 16); + Alignment := taCenter; + FontDesc := '#Label1'; + Hint := ''; + Text := 'Label'; + TextColor := clText1; + HotTrackFont := '#Label1'; + OnClick := @YearClicked; + end; + + Label8 := TfpgHyperlink.Create(self); + with Label8 do + begin + Name := 'Label8'; + SetPosition(76, 64, 44, 16); + Alignment := taCenter; + FontDesc := '#Label1'; + Hint := ''; + Text := 'Label'; + TextColor := clText1; + HotTrackFont := '#Label1'; + OnClick := @YearClicked; + end; + + Label9 := TfpgHyperlink.Create(self); + with Label9 do + begin + Name := 'Label9'; + SetPosition(76, 80, 44, 16); + Alignment := taCenter; + FontDesc := '#Label1'; + Hint := ''; + Text := 'Label'; + TextColor := clText1; + HotTrackFont := '#Label1'; + OnClick := @YearClicked; + end; + + Label10 := TfpgHyperlink.Create(self); + with Label10 do + begin + Name := 'Label10'; + SetPosition(76, 96, 44, 16); + Alignment := taCenter; + FontDesc := '#Label1'; + Hint := ''; + Text := 'Label'; + TextColor := clText1; + HotTrackFont := '#Label1'; + OnClick := @YearClicked; + end; + + {@VFD_BODY_END: YearSelectForm} + {%endregion} +end; + + procedure TfpgPopupCalendar.PopulateDays; var r, c: integer; @@ -253,6 +588,7 @@ end; procedure TfpgPopupCalendar.grdName1DoubleClick(Sender: TObject; AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint); begin + ClosePopupMenusWindows; TearDown; end; @@ -298,6 +634,33 @@ begin end; end; +procedure TfpgPopupCalendar.edtMonthClicked(Sender: TObject); +begin + ClosePopupMenusWindows; + ShowDefaultPopupMenu; +end; + +procedure TfpgPopupCalendar.edtYearClicked(Sender: TObject); +begin + ClosePopupMenusWindows; + if not Assigned(FYearPopupWindow) then + begin + FYearPopupWindow := TYearSelectForm.CreateCustom(nil, YearOf(MinDate), YearOf(MaxDate)); + FYearPopupWindow.OnClose := @YearPopupWindowClose; + FYearPopupWindow.Year := Year; + end; + + FYearPopupWindow.ShowAt(self, edtYear.Left, edtYear.Bottom); +end; + +procedure TfpgPopupCalendar.miMonthClicked(Sender: TObject); +var + itm: TfpgMenuItem; +begin + itm := Sender as TfpgMenuItem; + SetDateElement(2 {month index}, itm.Tag); +end; + procedure TfpgPopupCalendar.TearDown; var lD: Word; @@ -308,6 +671,10 @@ begin if s = '' then Exit; //==> lD := StrToInt(s); + if (grdName1.FocusRow = 0) and (lD > 7) then + Exit; // clicked in previous month + if (grdName1.FocusRow >= 4) and (lD < 15) then + Exit; // clicked in next month d := EncodeDate(Year, Month, lD); if (d >= FMinDate) and (d <= FMaxDate) then begin @@ -322,6 +689,32 @@ begin end; end; +procedure TfpgPopupCalendar.SetSingleClickSelect(const AValue: boolean); +begin + if FSingleClickSelect = AValue then exit; + FSingleClickSelect := AValue; +end; + +procedure TfpgPopupCalendar.ClosePopupMenusWindows; +begin + if Assigned(FMonthsPopupMenu) then + begin + FMonthsPopupMenu.Close; + FreeAndNil(FMonthsPopupMenu); + end; + + if Assigned(FYearPopupWindow) then + begin + FYearPopupWindow.Close; + FreeAndNil(FYearPopupWindow); + end; +end; + +procedure TfpgPopupCalendar.YearPopupWindowClose(Sender: TObject); +begin + Year := FYearPopupWindow.Year; +end; + function TfpgPopupCalendar.GetDateElement(Index: integer): Word; var lD, lM, lY: Word; @@ -372,14 +765,20 @@ procedure TfpgPopupCalendar.SetDateElement(Index: integer; const AValue: Word); var lD, lM, lY: Word; lDate: TDateTime; + d: Word; begin if AValue > 0 then begin DecodeDate(FDate, lY, lM, lD); case Index of - 1: lD := AValue; - 2: lM := AValue; - 3: lY := AValue; + 1: lD := AValue; + 2: begin + lM := AValue; + d := DaysInAMonth(lY, lM); + if lD > d then // If original day value is larger than days in new month + lD := d; + end; + 3: lY := AValue; end; try lDate := EncodeDate(lY, lM, lD); @@ -395,14 +794,14 @@ begin if FDate = AValue then Exit; //==> - if (trunc(FDate) >= trunc(FMinDate)) then + if (trunc(AValue) >= trunc(FMinDate)) then {$IFDEF DEBUG} writeln('Passed min test') {$ENDIF} else exit; - if (FDate <= FMaxDate) then + if (trunc(AValue) <= trunc(FMaxDate)) then {$IFDEF DEBUG} writeln('Passed max test') {$ENDIF} @@ -514,6 +913,7 @@ procedure TfpgPopupCalendar.btnYearUpClicked(Sender: TObject); var d: TDateTime; begin + ClosePopupMenusWindows; d := IncMonth(FDate, 12); if d <= FMaxDate then DateValue := d; @@ -523,6 +923,7 @@ procedure TfpgPopupCalendar.btnYearDownClicked(Sender: TObject); var d: TDateTime; begin + ClosePopupMenusWindows; d := IncMonth(FDate, -12); if d >= FMinDate then DateValue := d; @@ -532,6 +933,7 @@ procedure TfpgPopupCalendar.btnMonthUpClicked(Sender: TObject); var d: TDateTime; begin + ClosePopupMenusWindows; d := IncMonth(FDate); if d <= FMaxDate then DateValue := d; @@ -541,6 +943,7 @@ procedure TfpgPopupCalendar.btnMonthDownClicked(Sender: TObject); var d: TDateTime; begin + ClosePopupMenusWindows; d := IncMonth(FDate, -1); if d >= FMinDate then DateValue := d; @@ -548,6 +951,7 @@ end; procedure TfpgPopupCalendar.btnTodayClicked(Sender: TObject); begin + ClosePopupMenusWindows; if Now >= FMinDate then begin DateValue := Now; @@ -555,6 +959,13 @@ begin end; end; +procedure TfpgPopupCalendar.grdName1Clicked(Sender: TObject); +begin + ClosePopupMenusWindows; + if FSingleClickSelect then + TearDown; +end; + procedure TfpgPopupCalendar.HandlePaint; begin Canvas.BeginDraw; @@ -657,6 +1068,51 @@ begin FocusRootWidget.SetFocus; end; +procedure TfpgPopupCalendar.ShowDefaultPopupMenu; +var + itm: TfpgMenuItem; + pt: TPoint; +begin + if not Assigned(FMonthsPopupMenu) then + begin + FMonthsPopupMenu := TfpgPopupMenu.Create(nil); + itm := FMonthsPopupMenu.AddMenuItem(rslongjan, '', @miMonthClicked); + itm.Tag := 1; + itm := FMonthsPopupMenu.AddMenuItem(rslongfeb, '', @miMonthClicked); + itm.Tag := 2; + itm := FMonthsPopupMenu.AddMenuItem(rslongmar, '', @miMonthClicked); + itm.Tag := 3; + itm := FMonthsPopupMenu.AddMenuItem(rslongapr, '', @miMonthClicked); + itm.Tag := 4; + itm := FMonthsPopupMenu.AddMenuItem(rsLongMay, '', @miMonthClicked); + itm.Tag := 5; + itm := FMonthsPopupMenu.AddMenuItem(rslongjun, '', @miMonthClicked); + itm.Tag := 6; + itm := FMonthsPopupMenu.AddMenuItem(rslongjul, '', @miMonthClicked); + itm.Tag := 7; + itm := FMonthsPopupMenu.AddMenuItem(rslongaug, '', @miMonthClicked); + itm.Tag := 8; + itm := FMonthsPopupMenu.AddMenuItem(rslongsep, '', @miMonthClicked); + itm.Tag := 9; + itm := FMonthsPopupMenu.AddMenuItem(rslongoct, '', @miMonthClicked); + itm.Tag := 10; + itm := FMonthsPopupMenu.AddMenuItem(rslongnov, '', @miMonthClicked); + itm.Tag := 11; + itm := FMonthsPopupMenu.AddMenuItem(rslongdec, '', @miMonthClicked); + itm.Tag := 12; + end; + + // translate Edit coordinates + pt := WindowToScreen(self, Point(edtMonth.Left, edtMonth.Bottom)); + TPopupMenuFriend(FMonthsPopupMenu).PrepareToShow; // forces height calculation + // If dropdown will not fit below Edit, then we place it above + if (pt.y + FMonthsPopupMenu.Height) > fpgApplication.ScreenHeight then + pt.y := pt.y - edtMonth.Height - FMonthsPopupMenu.Height; + +// SetDefaultPopupMenuItemsState; + FMonthsPopupMenu.ShowAt(nil, pt.x, pt.y); +end; + constructor TfpgPopupCalendar.Create(AOwner: TComponent; AOrigFocusWin: TfpgWidget); begin inherited Create(AOwner); @@ -673,11 +1129,16 @@ begin FSelectedColor := clWhite; FMonthOffset := 0; FCloseOnSelect := True; + FSingleClickSelect := False; UpdateCalendar; end; destructor TfpgPopupCalendar.Destroy; begin + if Assigned(FMonthsPopupMenu) then + FMonthsPopupMenu.Free; + if Assigned(FYearPopupWindow) then + FYearPopupWindow.Free; FntBold.Free; FntNorm.Free; inherited Destroy; @@ -685,22 +1146,26 @@ end; procedure TfpgPopupCalendar.AfterCreate; begin + {%region 'Auto-generated GUI code' -fold} {@VFD_BODY_BEGIN: fpgPopupCalendar} Name := 'fpgPopupCalendar'; - SetPosition(285, 249, 233, 142); -// WindowTitle := 'fpgPopupCalendar'; -// Sizeable := False; -// WindowPosition := wpUser; + SetPosition(370, 182, 233, 142); + Hint := ''; edtYear := TfpgEdit.Create(self); with edtYear do begin Name := 'edtYear'; SetPosition(0, 0, 37, 22); + AutoSize := False; + BorderStyle := ebsSingle; + Hint := ''; + TabOrder := 1; Text := ''; FontDesc := '#Edit1'; + IgnoreMouseCursor := True; Focusable := False; - BorderStyle := ebsSingle; + OnClick := @edtYearClicked; end; btnYearUp := TfpgButton.Create(self); @@ -711,8 +1176,10 @@ begin Text := ''; Embedded := True; FontDesc := '#Label1'; + Hint := ''; ImageMargin := 0; ImageName := 'sys.sb.up'; + TabOrder := 2; Focusable := False; OnClick := @btnYearUpClicked; end; @@ -725,8 +1192,10 @@ begin Text := ''; Embedded := True; FontDesc := '#Label1'; + Hint := ''; ImageMargin := 0; ImageName := 'sys.sb.down'; + TabOrder := 3; Focusable := False; OnClick := @btnYearDownClicked; end; @@ -736,10 +1205,15 @@ begin begin Name := 'edtMonth'; SetPosition(50, 0, 100, 22); + AutoSize := False; + BorderStyle := ebsSingle; + Hint := ''; + TabOrder := 4; Text := ''; FontDesc := '#Edit1'; + IgnoreMouseCursor := True; Focusable := False; - BorderStyle := ebsSingle; + OnClick := @edtMonthClicked; end; btnMonthUp := TfpgButton.Create(self); @@ -750,8 +1224,10 @@ begin Text := ''; Embedded := True; FontDesc := '#Label1'; + Hint := ''; ImageMargin := 0; ImageName := 'sys.sb.up'; + TabOrder := 5; Focusable := False; OnClick := @btnMonthUpClicked; end; @@ -764,12 +1240,14 @@ begin Text := ''; Embedded := True; FontDesc := '#Label1'; + Hint := ''; ImageMargin := 0; ImageName := 'sys.sb.down'; + TabOrder := 6; Focusable := False; OnClick := @btnMonthDownClicked; end; - + btnToday := TfpgButton.Create(self); with btnToday do begin @@ -777,6 +1255,9 @@ begin SetPosition(164, 0, 70, 22); Text := 'Today'; FontDesc := '#Label1'; + Hint := ''; + ImageName := ''; + TabOrder := 7; Focusable := True; OnClick := @btnTodayClicked; end; @@ -795,25 +1276,20 @@ begin AddColumn('Sat', 33, taCenter); FontDesc := '#Grid'; HeaderFontDesc := '#GridHeader'; + Hint := ''; RowCount := 6; + RowSelect := False; + TabOrder := 8; ScrollBarStyle := ssNone; + OnClick := @grdName1Clicked; OnDoubleClick := @grdName1DoubleClick; OnKeyPress := @grdName1KeyPress; OnDrawCell := @grdName1DrawCell; end; {@VFD_BODY_END: fpgPopupCalendar} -{ - // Setup localization - // UI Designer doesn't support resource strings yet! - grdName1.ColumnTitle[0] := rsShortSun; - grdName1.ColumnTitle[1] := rsShortMon; - grdName1.ColumnTitle[2] := rsShortTue; - grdName1.ColumnTitle[3] := rsShortWed; - grdName1.ColumnTitle[4] := rsShortThu; - grdName1.ColumnTitle[5] := rsShortFri; - grdName1.ColumnTitle[6] := rsShortSat; -} + {%endregion} + btnToday.Text := rsToday; end; @@ -916,6 +1392,12 @@ begin FCloseOnSelect := AValue; end; +procedure TfpgCalendarCombo.SetSingleClickSelect(const AValue: boolean); +begin + if FSingleClickSelect = AValue then exit; + FSingleClickSelect := AValue; +end; + function TfpgCalendarCombo.HasText: boolean; begin Result := FDate >= FMinDate; @@ -929,6 +1411,7 @@ begin FWeeklyHoliday := -1; FDate := Now; FCloseOnSelect := True; + FSingleClickSelect := False; DateFormat := ShortDateFormat; end; @@ -975,6 +1458,7 @@ begin ddw.DontCloseWidget := self; { Set to false CloseOnSelect to leave opened popup calendar menu } ddw.CloseOnSelect := CloseOnSelect; + ddw.SingleClickSelect := SingleClickSelect; ddw.CallerWidget := self; if Assigned(OnDropDown) then @@ -1006,17 +1490,12 @@ end; { TfpgCalendarCheckCombo } -procedure TfpgCalendarCheckCombo.InternalCheckBoxChanged(Sender: TObject); -begin - RePaint; -end; - procedure TfpgCalendarCheckCombo.SetChecked(const AValue: Boolean); begin if AValue = FChecked then Exit; //==> FChecked := Avalue; - InternalCheckBoxChanged(nil); + Repaint; end; procedure TfpgCalendarCheckCombo.DoCheckboxChanged; @@ -1028,13 +1507,10 @@ end; procedure TfpgCalendarCheckCombo.DoDrawText(const ARect: TfpgRect); var lRect: TfpgRect; - flags: TFTextFlags; - lColor: TfpgColor; begin lRect := ARect; lRect.Left := lRect.Left+FCheckBoxRect.Width + 1; lRect.Width := lRect.Width - (FCheckBoxRect.Width + 1) - FMargin; - flags := [txtRight, txtVCenter]; if HasText then begin if not FChecked then @@ -1060,7 +1536,6 @@ procedure TfpgCalendarCheckCombo.InternalOnValueSet(Sender: TObject; begin inherited InternalOnValueSet(Sender, ADate); Checked := True; -// InternalCheckBoxChanged(nil); end; procedure TfpgCalendarCheckCombo.HandleKeyPress(var keycode: word; @@ -1115,6 +1590,7 @@ begin begin Checked := not FChecked; DoCheckboxChanged; + Repaint; end else inherited HandleLMouseUp(x, y, shiftstate); @@ -1127,22 +1603,6 @@ begin FCheckBoxRect.SetRect(2, 0, 17, 17); FCheckboxRect.Top := (FHeight - FCheckBoxRect.Height) div 2; OffsetRect(FCheckboxRect, 2, 3); // frame border must be taken into consideration - -{ - FCheckBox := TfpgCheckBox.Create(self); - with FCheckbox do - begin - Name := '_IntCheckBox'; - SetPosition(2, 2, 18, 17); - Checked := True; - FontDesc := '#Label1'; - Text := ''; -// BackgroundColor := self.BackgroundColor; - BackgroundColor := clMagenta; - Focusable := False; - OnChange := @InternalCheckBoxChanged; - end; -} end; diff --git a/src/gui/fpg_progressbar.pas b/src/gui/fpg_progressbar.pas index 72355493..ee6b2405 100644 --- a/src/gui/fpg_progressbar.pas +++ b/src/gui/fpg_progressbar.pas @@ -1,7 +1,7 @@ { fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -61,6 +61,7 @@ type TfpgProgressBar = class(TfpgCustomProgressBar) published property BackgroundColor default $c4c4c4; + property Hint; property ShowCaption; property Max; property Min; @@ -69,6 +70,7 @@ type property ShowHint; property Step; property TextColor; + property OnShowHint; end; diff --git a/src/gui/fpg_radiobutton.pas b/src/gui/fpg_radiobutton.pas index 97303bb5..9410a000 100644 --- a/src/gui/fpg_radiobutton.pas +++ b/src/gui/fpg_radiobutton.pas @@ -1,7 +1,7 @@ { fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -65,6 +65,7 @@ type property BackgroundColor; property Checked: boolean read FChecked write SetChecked default False; property FontDesc: string read GetFontDesc write SetFontDesc; + property Hint; property BoxLayout: TBoxLayout read GetBoxLayout write SetBoxLayout default tbLeftBox; property GroupIndex: integer read FGroupIndex write FGroupIndex; property ParentShowHint; @@ -73,6 +74,7 @@ type property Text: string read FText write SetText; property TextColor; property OnChange: TNotifyEvent read FOnChange write FOnChange; + property OnShowHint; end; diff --git a/src/gui/fpg_scrollbar.pas b/src/gui/fpg_scrollbar.pas index 5d69ced6..55db9f59 100644 --- a/src/gui/fpg_scrollbar.pas +++ b/src/gui/fpg_scrollbar.pas @@ -1,7 +1,7 @@ { fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -49,6 +49,7 @@ type private FLargeChange: Integer; FScrollbarDownPart: TfpgScrollBarPart; + FRecalc: Boolean; procedure SetMax(const AValue: integer); procedure SetMin(const AValue: integer); procedure SetSBPosition(const AValue: integer); @@ -78,6 +79,7 @@ type procedure HandleMouseMove(x, y: integer; btnstate: word; shiftstate: TShiftState); override; procedure HandleMouseScroll(x, y: integer; shiftstate: TShiftState; delta: smallint); override; procedure HandlePaint; override; + procedure HandleResize(AWidth, AHeight: TfpgCoord); override; procedure PositionChange(d: integer); public Orientation: TOrientation; @@ -85,6 +87,10 @@ type constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure RepaintSlider; + procedure LineUp; + procedure LineDown; + procedure PageUp; + procedure PageDown; property PageSize: integer read FPageSize write FPageSize default 5; property Position: integer read FPosition write SetSBPosition default 10; property ScrollStep: integer read FScrollStep write FScrollStep default 1; @@ -97,6 +103,9 @@ type implementation +const + cMinSliderLength = 20; + { TfpgScrollBar } constructor TfpgScrollBar.Create(AOwner: TComponent); @@ -112,10 +121,11 @@ begin SliderSize := 0.5; FOnScroll := nil; FSliderPos := 0; - FSliderLength := 10; + FSliderLength := cMinSliderLength; FScrollStep := 1; FPageSize := 5; FLargeChange := 0; + FRecalc := True; end; destructor TfpgScrollBar.Destroy; @@ -138,15 +148,43 @@ begin DrawButton(Width-Height, 0, Height, Height, 'sys.sb.right', FScrollbarDownPart = sbpDownForward); end; - DrawSlider(True); + DrawSlider(FRecalc); Canvas.EndDraw; // Do not remove - Scrollbars do painting outside HandlePaint as well! + FRecalc := False; +end; + +procedure TfpgScrollBar.HandleResize(AWidth, AHeight: TfpgCoord); +begin + inherited HandleResize(AWidth, AHeight); + FRecalc := True; end; procedure TfpgScrollBar.RepaintSlider; begin if not HasHandle then Exit; //==> - DrawSlider(True); + FRecalc := True; + Invalidate;// DrawSlider(True); +end; + +procedure TfpgScrollBar.LineUp; +begin + Step(-1); +end; + +procedure TfpgScrollBar.LineDown; +begin + Step(1); +end; + +procedure TfpgScrollBar.PageUp; +begin + StepPage(-1); +end; + +procedure TfpgScrollBar.PageDown; +begin + StepPage(1); end; procedure TfpgScrollBar.SetMax(const AValue: integer); @@ -183,7 +221,7 @@ begin FPosition := AValue; if HasHandle then - DrawSlider(False); + Invalidate;// DrawSlider(False); end; procedure TfpgScrollBar.Step(ASteps: Integer); @@ -284,6 +322,7 @@ begin end; end; +// only called from inside HandlePaint so no need for BeginDraw..EndDraw calls procedure TfpgScrollBar.DrawButton(x, y, w, h: TfpgCoord; const imgname: string; Pressed: Boolean = False); var img: TfpgImage; @@ -308,12 +347,13 @@ begin Canvas.DrawImage(x + w div 2 - (img.Width div 2) + dx, y + h div 2 - (img.Height div 2) + dy, img); end; +// only called from inside HandlePaint so no need for BeginDraw..EndDraw calls procedure TfpgScrollBar.DrawSlider(recalc: boolean); var area: TfpgCoord; mm: TfpgCoord; begin - Canvas.BeginDraw; +// Canvas.BeginDraw; if SliderSize > 1 then SliderSize := 1; @@ -340,8 +380,8 @@ begin FSliderLength := Trunc(area * SliderSize); //FSliderLength := Trunc((width/area) * (fmax /area )); - if FSliderLength < 20 then - FSliderLength := 20; + if FSliderLength < cMinSliderLength then + FSliderLength := cMinSliderLength; if FSliderLength > area then FSliderLength := area; area := area - FSliderLength; @@ -388,12 +428,12 @@ begin if Orientation = orVertical then begin Canvas.DrawButtonFace(0, Width + FSliderPos, Width, FSliderLength, [btfIsEmbedded]); - Canvas.EndDraw(0, Width, Width, Height - Width - Width); +// Canvas.EndDraw(0, Width, Width, Height - Width - Width); end else begin Canvas.DrawButtonFace(Height + FSliderPos, 0, FSliderLength, Height, [btfIsEmbedded]); - Canvas.EndDraw(Height, 0, Width - Height - Height, Height); +// Canvas.EndDraw(Height, 0, Width - Height - Height, Height); end; end; @@ -476,14 +516,14 @@ begin if FScrollbarDownPart = sbpSlider then begin FSliderDragStart := FSliderPos; - DrawSlider(False); + Invalidate; //DrawSlider(False); end else if not (FScrollbarDownPart in [sbpNone, sbpSlider]) then begin FScrollTimer.Interval := 300; FScrollTimer.Enabled := True; - HandlePaint; + Invalidate; //HandlePaint; end; end; @@ -500,7 +540,7 @@ begin FScrollbarDownPart := sbpNone; if WasPressed then - HandlePaint; + Invalidate; //HandlePaint; end; procedure TfpgScrollBar.HandleMouseMove(x, y: integer; btnstate: word; shiftstate: TShiftState); @@ -538,7 +578,7 @@ begin FSliderPos := area; if ppos <> FSliderPos then - DrawSlider(False); + Invalidate; // DrawSlider(False); if area <> 0 then newp := FMin + Trunc((FMax - FMin) * (FSliderPos / area)) @@ -569,7 +609,10 @@ begin FPosition := FMax; if Visible then - DrawSlider(True); + begin + FRecalc := True; + Invalidate; // DrawSlider(True); + end; if Assigned(FOnScroll) then FOnScroll(self, FPosition); diff --git a/src/gui/fpg_spinedit.pas b/src/gui/fpg_spinedit.pas index 49f09b96..21548f97 100644 --- a/src/gui/fpg_spinedit.pas +++ b/src/gui/fpg_spinedit.pas @@ -1,7 +1,7 @@ { fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -53,8 +53,8 @@ type private FButtonUp: TfpgButton; FButtonDown: TfpgButton; - FArrowUpColor: Tfpgcolor; - FArrowDownColor: Tfpgcolor; + FArrowUpColor: TfpgColor; + FArrowDownColor: TfpgColor; FOnChange: TNotifyEvent; FTimer: TfpgTimer; FUp: Boolean; @@ -75,6 +75,7 @@ type procedure SetArrowUpColor(const AValue: Tfpgcolor); procedure SetArrowDownColor(const AValue: Tfpgcolor); procedure SetSpeedUp(const AValue: integer); + procedure DisableTimer; procedure ButtonUpPaint(Sender: TObject); procedure ButtonDownPaint(Sender: TObject); property ButtonsBackgroundColor: Tfpgcolor read GetButtonsBackgroundColor write SetButtonsBackgroundColor default clButtonFace; @@ -119,7 +120,7 @@ type procedure SetValue(const AValue: extended); procedure SetDecimals(const AValue: integer); procedure SetFixedDecimals(const AValue: Boolean); - procedure SetHint(const AValue: string); + procedure SetHint(const AValue: TfpgString); override; procedure ButtonUpClick(Sender: TObject); procedure ButtonDownClick(Sender: TObject); procedure ButtonUpMouseDown(Sender: TObject; AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint); @@ -137,6 +138,7 @@ type published property EditBackgroundColor: Tfpgcolor read GetEditBackgroundColor write SetEditBackgroundColor default clBoxColor; property ButtonsBackgroundColor; + property ButtonWidth; property TextColor: Tfpgcolor read GetTextColor write SetTextColor; property NegativeColor: TfpgColor read GetNegativeColor write SetNegativeColor; property ArrowUpColor; @@ -149,7 +151,8 @@ type property Value: extended read FValue write SetValue; property Decimals: integer read GetDecimals write SetDecimals; property FixedDecimals: Boolean read GetFixedDecimals write SetFixedDecimals; - property Hint: string read FHint write SetHint; + property Hint; + property TabOrder; property OnChange; property OnEnter; property OnExit; @@ -157,6 +160,7 @@ type property OnMouseEnter; property OnMouseExit; property OnPaint; + property OnShowHint; end; @@ -187,7 +191,7 @@ type procedure SetIncrement(const AValue: integer); procedure SetLargeIncrement(const AValue: integer); procedure SetValue(const AValue: integer); - procedure SetHint(const AValue: string); + procedure SetHint(const AValue: TfpgString); override; procedure ButtonUpClick(Sender: TObject); procedure ButtonDownClick(Sender: TObject); procedure ButtonUpMouseDown(Sender: TObject; AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint); @@ -216,7 +220,8 @@ type property Increment: integer read FIncrement write SetIncrement default 1; property LargeIncrement: integer read FLargeIncrement write SetLargeIncrement default 10; property Value: integer read FValue write SetValue default 0; - property Hint: string read FHint write SetHint; + property Hint; + property TabOrder; property OnChange; property OnEnter; property OnExit; @@ -224,6 +229,7 @@ type property OnMouseEnter; property OnMouseExit; property OnPaint; + property OnShowHint; end; @@ -365,6 +371,14 @@ begin FSpeedUpSteps := AValue; end; +procedure TfpgAbstractSpinEdit.DisableTimer; +begin + FUp:= False; + FDown:= False; + if Assigned(FTimer) then + FTimer.Enabled:= False; +end; + function GetButtonRect(AButton: TfpgButton): TRect; var r: TfpgRect; @@ -450,32 +464,23 @@ end; procedure TfpgSpinEditFloat.EnableButtons; begin - if FValue + FIncrement < FMaxValue then - FButtonUp.Enabled := True + FButtonUp.Enabled := True; + FButtonDown.Enabled := True; + if IsMaxLimitReached then + FButtonUp.Enabled := False else - begin - FUp := False; - if Assigned(FTimer) then - FTimer.Enabled := False; - end; - if FValue - FIncrement > FMinValue then - FButtonDown.Enabled := True - else - begin - FDown := False; - if Assigned(FTimer) then - FTimer.Enabled := False; - end; + if IsMinLimitReached then + FButtonDown.Enabled := False; end; function TfpgSpinEditFloat.IsMinLimitReached: Boolean; begin - Result := Value = MinValue; + Result := FValue = FMinValue; end; function TfpgSpinEditFloat.IsMaxLimitReached: Boolean; begin - Result := Value = MaxValue; + Result := FValue = FMaxValue; end; function TfpgSpinEditFloat.GetEditBackgroundColor: TfpgColor; @@ -557,7 +562,6 @@ begin FValue := FMaxValue; FEdit.Value := FValue; end; - EnableButtons; end; end; @@ -571,7 +575,6 @@ begin FValue := FMinValue; FEdit.Value := FValue; end; - EnableButtons; end; end; @@ -619,32 +622,45 @@ begin end; end; -procedure TfpgSpinEditFloat.SetHint(const AValue: string); +procedure TfpgSpinEditFloat.SetHint(const AValue: TfpgString); begin - if Hint <> AValue then - begin - FEdit.Hint := AValue; - FButtonUp.Hint := AValue; - FButtonDown.Hint := AValue; - end; + inherited SetHint(AValue); + // let child component use the same hint + FEdit.Hint := AValue; + FButtonUp.Hint := AValue; + FButtonDown.Hint := AValue; end; procedure TfpgSpinEditFloat.ButtonUpClick(Sender: TObject); begin if FValue + FIncrement <= FMaxValue then begin - Value := FValue + FIncrement; - DoOnChange; + FValue := FValue + FIncrement; + FEdit.Value := FValue; + end + else if not IsMaxLimitReached then + begin + FValue := FMaxValue; + FEdit.Value := FValue; end; + DoOnChange; + EnableButtons; end; procedure TfpgSpinEditFloat.ButtonDownClick(Sender: TObject); begin if FValue - FIncrement >= FMinValue then begin - Value := FValue - FIncrement; - DoOnChange; + FValue := FValue - FIncrement; + FEdit.Value := FValue; + end + else if not IsMinLimitReached then + begin + FValue := FMinValue; + FEdit.Value := FValue; end; + DoOnChange; + EnableButtons; end; procedure TfpgSpinEditFloat.ButtonUpMouseDown(Sender: TObject; AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint); @@ -657,9 +673,7 @@ end; procedure TfpgSpinEditFloat.ButtonUpMouseUp(Sender: TObject; AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint); begin - FUp := False; - if Assigned(FTimer) then - FTimer.Enabled := False; + DisableTimer; end; procedure TfpgSpinEditFloat.ButtonDownMouseDown(Sender: TObject; AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint); @@ -672,9 +686,7 @@ end; procedure TfpgSpinEditFloat.ButtonDownMouseUp(Sender: TObject; AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint); begin - FDown := False; - if Assigned(FTimer) then - FTimer.Enabled := False; + DisableTimer; end; procedure TfpgSpinEditFloat.EditKeyPress(Sender: TObject; var keycode: word; var shiftstate: TShiftState; var consumed: Boolean); @@ -813,6 +825,15 @@ begin if FSteps > FSpeedUpSteps then FTempIncrement := LargeIncrement; DoOnChange; + if FValue= FMaxValue then + DisableTimer; + end + else if not IsMaxLimitReached then + begin + FValue := FMaxValue; + FEdit.Value := FValue; + DoOnChange; + DisableTimer; end; end else if FDown then @@ -826,9 +847,17 @@ begin if FSteps > FSpeedUpSteps then FTempIncrement := LargeIncrement; DoOnChange; + if FValue= FMinValue then + DisableTimer; + end + else if not IsMinLimitReached then + begin + FValue := FMinValue; + FEdit.Value := FValue; + DoOnChange; + DisableTimer; end; end; - EnableButtons; end; constructor TfpgSpinEditFloat.Create(AOwner: TComponent); @@ -876,34 +905,23 @@ end; procedure TfpgSpinEdit.EnableButtons; begin - if not IsMaxLimitReached then - FButtonUp.Enabled := True - else - begin - FButtonUp.Enabled := False; - FUp := False; - if Assigned(FTimer) then - FTimer.Enabled := False; - end; - if not IsMinLimitReached then - FButtonDown.Enabled := True + FButtonUp.Enabled := True; + FButtonDown.Enabled := True; + if IsMaxLimitReached then + FButtonUp.Enabled := False else - begin - FButtonDown.Enabled := False; - FDown := False; - if Assigned(FTimer) then - FTimer.Enabled := False; - end; + if IsMinLimitReached then + FButtonDown.Enabled := False; end; function TfpgSpinEdit.IsMinLimitReached: Boolean; begin - Result := Value = MinValue; + Result := FValue = FMinValue; end; function TfpgSpinEdit.IsMaxLimitReached: Boolean; begin - Result:= Value = MaxValue; + Result:= FValue = FMaxValue; end; function TfpgSpinEdit.GetEditBackgroundColor: TfpgColor; @@ -975,7 +993,6 @@ begin FValue := FMaxValue; FEdit.Value := FValue; end; - EnableButtons; end; end; @@ -989,7 +1006,6 @@ begin FValue := FMinValue; FEdit.Value := FValue; end; - EnableButtons; end; end; @@ -1020,28 +1036,45 @@ begin end; end; -procedure TfpgSpinEdit.SetHint(const AValue: string); +procedure TfpgSpinEdit.SetHint(const AValue: TfpgString); begin - if FHint <> AValue then - begin - FEdit.Hint := AValue; - FButtonUp.Hint := AValue; - FButtonDown.Hint := AValue; - end; + inherited SetHint(AValue); + // let child component use the same hint + FEdit.Hint := AValue; + FButtonUp.Hint := AValue; + FButtonDown.Hint := AValue; end; procedure TfpgSpinEdit.ButtonUpClick(Sender: TObject); begin if FValue + FIncrement <= FMaxValue then + begin Value := FValue + FIncrement; + FEdit.Value:= FValue; + end + else if not IsMaxLimitReached then + begin + Value := FMaxValue; + FEdit.Value:= FValue; + end; DoOnChange; + EnableButtons; end; procedure TfpgSpinEdit.ButtonDownClick(Sender: TObject); begin if FValue - FIncrement >= FMinValue then + begin Value := FValue - FIncrement; + FEdit.Value:= FValue; + end + else if not IsMinLimitReached then + begin + Value := FMinValue; + FEdit.Value:= FValue; + end; DoOnChange; + EnableButtons; end; procedure TfpgSpinEdit.ButtonUpMouseDown(Sender: TObject; AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint); @@ -1054,10 +1087,7 @@ end; procedure TfpgSpinEdit.ButtonUpMouseUp(Sender: TObject; AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint); begin - FUp := False; - FTempIncrement := Increment; - if Assigned(FTimer) then - FTimer.Enabled := False; + DisableTimer; end; procedure TfpgSpinEdit.ButtonDownMouseDown(Sender: TObject; AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint); @@ -1070,10 +1100,7 @@ end; procedure TfpgSpinEdit.ButtonDownMouseUp(Sender: TObject; AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint); begin - FDown := False; - FTempIncrement := Increment; - if Assigned(FTimer) then - FTimer.Enabled := False; + DisableTimer; end; procedure TfpgSpinEdit.EditKeyPress(Sender: TObject; var keycode: word; var shiftstate: TShiftState; var consumed: Boolean); @@ -1205,29 +1232,46 @@ begin begin if FValue + FTempIncrement <= FMaxValue then begin - Value := FValue + FTempIncrement; + FValue := FValue + FTempIncrement; FEdit.Value := FValue; if FSteps <= FSpeedUpSteps then Inc(FSteps); if FSteps > FSpeedUpSteps then FTempIncrement := LargeIncrement; - DoOnchange; + DoOnChange; + if FValue= FMaxValue then + DisableTimer; + end + else if not IsMaxLimitreached then + begin + FValue := FMaxValue; + FEdit.Value := FValue; + DoOnChange; + DisableTimer; end; end else if FDown then begin if FValue - FTempIncrement >= FMinValue then begin - Value := FValue - FTempIncrement; + FValue := FValue - FTempIncrement; FEdit.Value := FValue; if FSteps <= FSpeedUpSteps then Inc(FSteps); if FSteps > FSpeedUpSteps then FTempIncrement := LargeIncrement; DoOnChange; + if FValue= FMinValue then + DisableTimer; + end + else + begin + FValue := FMinValue; + FEdit.Value := FValue; + DoOnChange; + DisableTimer; end; end; - EnableButtons; end; constructor TfpgSpinEdit.Create(AOwner: TComponent); diff --git a/src/gui/fpg_splitter.pas b/src/gui/fpg_splitter.pas index cf627081..6094656b 100644 --- a/src/gui/fpg_splitter.pas +++ b/src/gui/fpg_splitter.pas @@ -1,7 +1,7 @@ { fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2010 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_style.pas b/src/gui/fpg_style.pas index b5a799c2..f6538a81 100644 --- a/src/gui/fpg_style.pas +++ b/src/gui/fpg_style.pas @@ -1,7 +1,7 @@ { fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2010 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_tab.pas b/src/gui/fpg_tab.pas index d656ad3a..9999fa83 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 - 2008 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -22,10 +22,10 @@ unit fpg_tab; { TODO: * Tab Styles (tab, button, flat button, angled) - * Tab Position (top, bottom, left, right) * Better keyboard support * Focus rectangle drawn on tabs itself * FindNextPage() must be implemented + * Popup menu for tab selection. Should occur with RClick on tabs. } interface @@ -36,38 +36,48 @@ uses fpg_base, fpg_main, fpg_widget, - fpg_button; + fpg_button, + fpg_menu; type // forward declaration TfpgPageControl = class; TfpgTabStyle = (tsTabs, tsButtons, tsFlatButtons); - TfpgTabPosition = (tpTop, tpBottom{, tpLeft, tpRight}); + TfpgTabPosition = (tpTop, tpBottom, tpLeft, tpRight, tpNone); + TfpgTabOption = (to_PMenuClose, to_PMenuShowAvailTabs); + + TfpgTabOptions = set of TfpgTabOption; TfpgTabSheet = class(TfpgWidget) private + FPageControl: TfpgPageControl; FText: string; + FTabVisible: boolean; function GetPageControl: TfpgPageControl; function GetPageIndex: Integer; function GetText: string; procedure SetPageIndex(const AValue: Integer); procedure SetText(const AValue: string); + procedure SetPageControl(APageControl: TfpgPageControl); protected procedure HandlePaint; override; + procedure SetName(const NewName: TComponentName); override; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; - procedure AfterConstruction; override; property PageIndex: Integer read GetPageIndex write SetPageIndex; - property PageControl: TfpgPageControl read GetPageControl; + property PageControl: TfpgPageControl read FPageControl write SetPageControl; + property TabVisible: boolean read FTabVisible write FTabVisible; published property Text: string read GetText write SetText; + property OnPaint; end; TTabSheetChange = procedure(Sender: TObject; NewActiveSheet: TfpgTabSheet) of object; + TTabSheetClosing = procedure(Sender: TObject; ATabSheet: TfpgTabSheet) of object; TfpgPageControl = class(TfpgWidget) @@ -76,28 +86,33 @@ type FActivePage: TfpgTabSheet; FMargin: integer; FFixedTabWidth: integer; + FFixedTabHeight: Integer; + FOnClosingTabSheet: TTabSheetClosing; FPages: TList; FActivePageIndex: integer; FOnChange: TTabSheetChange; - FRightButton: TfpgButton; - FLeftButton: TfpgButton; - FFirstTabButton: TfpgTabSheet; + FRightButton: TfpgButton; // bottom/right + FLeftButton: TfpgButton; // left/top + FFirstTabButton: TfpgTabSheet; // when tabs don't fit in screen this is the first button on screen when tabs are scrolled FSortPages: boolean; FStyle: TfpgTabStyle; FTabPosition: TfpgTabPosition; + FPopupMenu: TfpgPopupMenu; + FTabOptions: TfpgTabOptions; function GetActivePageIndex: integer; function GetPage(AIndex: integer): TfpgTabSheet; function GetPageCount: Integer; - procedure InsertPage(const APage: TfpgTabSheet); + procedure InsertPage(const APage: TfpgTabSheet; SuppressOnChangeEvent: boolean = False); procedure RemovePage(const APage: TfpgTabSheet); procedure SetActivePageIndex(const AValue: integer); procedure SetActivePage(const AValue: TfpgTabSheet); function MaxButtonWidthSum: integer; - function MaxButtonHeight: integer; + function MaxButtonHeightSum: integer; function MaxButtonWidth: integer; function ButtonHeight: integer; function ButtonWidth(AText: string): integer; procedure SetFixedTabWidth(const AValue: integer); + procedure SetFixedTabHeight(const AValue: integer); function GetTabText(AText: string): string; procedure LeftButtonClick(Sender: TObject); procedure RightButtonClick(Sender: TObject); @@ -105,14 +120,17 @@ type procedure SetSortPages(const AValue: boolean); procedure SetStyle(const AValue: TfpgTabStyle); procedure SetTabPosition(const AValue: TfpgTabPosition); - procedure DoChange(ATabSheet: TfpgTabSheet); + procedure DoPageChange(ATabSheet: TfpgTabSheet); + procedure DoTabSheetClosing(ATabSheet: TfpgTabSheet); function DrawTab(const rect: TfpgRect; const Selected: Boolean = False; const Mode: Integer = 1): TfpgRect; + procedure pmCloseTab(Sender: TObject); protected procedure OrderSheets; // currently using bubblesort procedure RePaintTitles; virtual; procedure HandlePaint; override; procedure HandleShow; override; procedure HandleLMouseUp(x, y: integer; shiftstate: TShiftState); override; + procedure HandleRMouseUp(x, y: integer; shiftstate: TShiftState); override; procedure HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: boolean); override; public constructor Create(AOwner: TComponent); override; @@ -123,10 +141,14 @@ type property ActivePage: TfpgTabSheet read FActivePage write SetActivePage; property Pages[AIndex: integer]: TfpgTabSheet read GetPage; property OnChange: TTabSheetChange read FOnChange write FOnChange; + property OnClosingTabSheet: TTabSheetClosing read FOnClosingTabSheet write FOnClosingTabSheet; published property ActivePageIndex: integer read GetActivePageIndex write SetActivePageIndex; property BackgroundColor; property FixedTabWidth: integer read FFixedTabWidth write SetFixedTabWidth default 0; + property FixedTabHeight: integer read FFixedTabHeight write SetFixedTabHeight default 21; + property Hint; + property Options: TfpgTabOptions read FTabOptions write FTabOptions; property ParentShowHint; property ShowHint; property SortPages: boolean read FSortPages write SetSortPages default False; @@ -134,6 +156,7 @@ type property TabOrder; property TabPosition: TfpgTabPosition read FTabPosition write SetTabPosition default tpTop; property TextColor; + property OnShowHint; end; @@ -197,30 +220,50 @@ begin Canvas.Clear(FBackgroundColor); end; +procedure TfpgTabSheet.SetName(const NewName: TComponentName); +var + old: String; +begin + old := NewName; + inherited SetName(NewName); + if (csDesigning in ComponentState) then + begin + if (Text = '') or (Text = old) then + Text := NewName; + end; +end; + constructor TfpgTabSheet.Create(AOwner: TComponent); begin inherited Create(AOwner); FText := ''; + FTabVisible:= True; FFocusable := True; FBackgroundColor := Parent.BackgroundColor; FTextColor := Parent.TextColor; FIsContainer := True; + if (AOwner <> nil) and (AOwner is TfpgPageControl) then + begin + FPageControl:=TfpgPageControl(AOwner); + FPageControl.InsertPage(self, True); + end; end; destructor TfpgTabSheet.Destroy; begin - if Owner is TfpgPageControl then - TfpgPageControl(Owner).RemovePage(self); + if FPageControl <> nil then + FPageControl.RemovePage(self); inherited Destroy; end; -procedure TfpgTabSheet.AfterConstruction; +procedure TfpgTabSheet.SetPageControl(APageControl: TfpgPageControl); begin - inherited AfterConstruction; - if Owner is TfpgPageControl then - TfpgPageControl(Owner).InsertPage(self); + FPageControl := APageControl; + if APageControl <> nil then + FPageControl.InsertPage(Self); end; + { TfpgPageControl } function TfpgPageControl.GetActivePageIndex: integer; @@ -240,27 +283,55 @@ begin Result := FPages.Count; end; -procedure TfpgPageControl.InsertPage(const APage: TfpgTabSheet); +procedure TfpgPageControl.InsertPage(const APage: TfpgTabSheet; SuppressOnChangeEvent: boolean = False); begin if FPages.IndexOf(APage) <> -1 then Exit; //==> The page has already been added. FPages.Add(APage); - ActivePage := APage; + { TODO: This behaviour could maybe be controlled by a Options property } + if FPages.Count=1 then + begin + if SuppressOnChangeEvent then + Loading; + ActivePage := APage; + if SuppressOnChangeEvent then + Loaded; + end; end; procedure TfpgPageControl.RemovePage(const APage: TfpgTabSheet); +var + i: integer; begin if APage = nil then - Exit; - FPages.Remove(APage); - {$Note This still needs to be fixed.} - if APage = FActivePage then + Exit; // ==> + if FPages.Count =0 then + Exit; // ==> + + if FPages.Count > 1 then + begin + i:=FPages.IndexOf(APage); + FPages.Remove(APage); + APage.PageControl:=nil; + APage.Visible:=false; + if i = ActivePageIndex then + begin + if i > FPages.Count-1 then + ActivePage:=TfpgTabSheet(FPages.Last) + else if i = 0 then + ActivePage:= TfpgTabSheet(FPages.First) + else + ActivePage:=TfpgTabSheet(FPages[i]); + end + else if i < ActivePageIndex then + ActivePage:=TfpgTabSheet(Pages[i-1]); + end + else begin -// FActivePage := FindNextPage(APage, True); -// if FPages.Count > 0 then - ActivePage := TfpgTabSheet(FPages.First); -// else -// ActivePage := nil; + FPages.Remove(APage); + APage.PageControl := nil; + APage.Visible := False; + ActivePage := nil; end; end; @@ -278,8 +349,10 @@ begin Exit; //==> FActivePage := AValue; ActiveWidget := AValue; - FActivePageIndex := FPages.IndexOf(AValue); + if AValue <> nil then + FActivePageIndex := FPages.IndexOf(AValue); RePaint; + DoPageChange(FActivePage); end; function TfpgPageControl.MaxButtonWidthSum: integer; @@ -297,28 +370,38 @@ begin end; end; -function TfpgPageControl.MaxButtonHeight: integer; +function TfpgPageControl.MaxButtonHeightSum: integer; begin result := PageCount * ButtonHeight; end; function TfpgPageControl.MaxButtonWidth: integer; var - t: TfpgTabSheet; - i: integer; + t: TfpgTabSheet; + i: integer; begin Result := 0; - for i := 0 to FPages.Count-1 do + if FixedTabWidth > 0 then begin - t := TfpgTabSheet(FPages[i]); - if ButtonWidth(t.Text) > Result then - Result := ButtonWidth(t.Text); + Result := FixedTabWidth; + end + else + begin + for i := 0 to FPages.Count-1 do + begin + t := TfpgTabSheet(FPages[i]); + if ButtonWidth(t.Text) > Result then + Result := ButtonWidth(t.Text); + end; end; end; function TfpgPageControl.ButtonHeight: integer; begin - Result := FRightButton.Height; + if FFixedTabHeight > 0 then + result := FFixedTabHeight + else + result := FFont.Height + 10; { TODO: correct this } end; function TfpgPageControl.ButtonWidth(AText: string): integer; @@ -340,6 +423,17 @@ begin end; end; +procedure TfpgPageControl.SetFixedTabHeight(const AValue: integer); +begin + if FFixedTabHeight = AValue then + Exit; //==> + if AValue > 5 then + begin + FFixedTabHeight := AValue; + RePaint; + end; +end; + function TfpgPageControl.GetTabText(AText: string): string; var s, s1: string; @@ -360,7 +454,7 @@ begin inc(i); end; if FFont.TextWidth(s1) > (FFixedTabWidth-10) then - Delete(s1, length(s1), 1); {$Note This must become a UTF8 function} + UTF8Delete(s1, UTF8Length(s1), 1); if Length(s1) > 0 then s1 := Trim(s1); Result := s1; @@ -424,12 +518,26 @@ begin RePaint; end; -procedure TfpgPageControl.DoChange(ATabSheet: TfpgTabSheet); +procedure TfpgPageControl.DoPageChange(ATabSheet: TfpgTabSheet); begin + if (csLoading in ComponentState) then + Exit; + if (csDesigning in ComponentState) then + Exit; if Assigned(FOnChange) then FOnChange(self, ATabSheet); end; +procedure TfpgPageControl.DoTabSheetClosing(ATabSheet: TfpgTabSheet); +begin + if (csLoading in ComponentState) then + Exit; + if (csDesigning in ComponentState) then + Exit; + if Assigned(FOnClosingTabSheet) then + FOnClosingTabSheet(self, ATabSheet); +end; + function TfpgPageControl.DrawTab(const rect: TfpgRect; const Selected: Boolean = False; const Mode: Integer = 1): TfpgRect; var r: TfpgRect; @@ -443,36 +551,119 @@ begin end; if Mode = 2 then - r.Height := r.Height - 1; + r.Height -= 1; Canvas.SetColor(clWindowBackground); - Canvas.FillRectangle(r.Left, r.Top, r.Width, r.Height-2); - Canvas.SetColor(clHilite2); - Canvas.DrawLine(r.Left, r.Bottom-2, r.Left, r.Top+2); - Canvas.DrawLine(r.Left, r.Top+2, r.Left+2, r.Top); - Canvas.DrawLine(r.Left+2, r.Top, r.Right-1, r.Top); - Canvas.SetColor(clShadow1); - Canvas.DrawLine(r.Right-1, r.Top+1, r.Right-1, r.Bottom-1); - Canvas.SetColor(clShadow2); - Canvas.DrawLine(r.Right-1, r.Top+1, r.Right, r.Top+2); - Canvas.DrawLine(r.Right, r.Top+2, r.Right, r.Bottom-1); + case TabPosition of + tpTop: + begin + Canvas.FillRectangle(r.Left, r.Top, r.Width, r.Height-2); // fill tab background + Canvas.SetColor(clHilite2); + Canvas.DrawLine(r.Left, r.Bottom-2 , r.Left, r.Top+2); // left edge + Canvas.DrawLine(r.Left, r.Top+2 , r.Left+2, r.Top); // left rounder edge + Canvas.DrawLine(r.Left+2, r.Top, r.Right-1, r.Top); // top edge + Canvas.SetColor(clShadow1); + Canvas.DrawLine(r.Right-1, r.Top+1, r.Right-1, r.Bottom-1); // right inner edge + Canvas.SetColor(clShadow2); + Canvas.DrawLine(r.Right-1, r.Top+1, r.Right, r.Top+2); // right rounded edge (1px) + Canvas.DrawLine(r.Right, r.Top+2, r.Right, r.Bottom-1); // right outer edge + end; + + tpBottom: + begin + Canvas.FillRectangle(r.Left, r.Top, r.Width-2, r.Height-2); // fill tab background + Canvas.SetColor(clHilite2); + Canvas.DrawLine(r.Left, r.Top, r.Left, r.Bottom-1); // left edge + Canvas.SetColor(clShadow2); + Canvas.DrawLine(r.Left+2, r.Bottom, r.Right-1, r.Bottom); // bottom outer edge + Canvas.SetColor(clShadow1); + Canvas.DrawLine(r.Right-1, r.Bottom-1, r.Right-1, r.Top+1); // right inner edge + Canvas.DrawLine(r.Left+1, r.Bottom-1, r.Right-1, r.Bottom-1);// bottom inner edge + Canvas.SetColor(clShadow2); + Canvas.DrawLine(r.Right-1, r.Bottom-1, r.Right, r.Bottom-2); // right rounded edge (1px) + Canvas.DrawLine(r.Right, r.Bottom-2, r.Right, r.Top+1); // right outer edge + end; + + tpLeft: + begin + if Mode = 2 then + begin + r.Width := r.Width - 1; + r.Height := r.Height + 2; + end; + with Canvas do + begin + FillRectangle(r.Left, r.Top, r.Width, r.Height-2); + SetColor(clHilite2); + DrawLine(r.Left, r.Bottom-2, r.Left, r.Top+2); + DrawLine(r.Left, r.Top+2, r.Left+2, r.Top); + DrawLine(r.Left+2, r.Top, r.Right-1, r.Top); + SetColor(clShadow1); + DrawLine(r.Left+2, r.Bottom-1, r.Right-1, r.Bottom-1); + SetColor(clShadow2); + DrawLine(r.Left+1, r.Bottom-1, r.Left+3, r.Bottom); + DrawLine(r.Left+2, r.Bottom, r.Right, r.Bottom); + end; + end; + + tpRight: + begin + if Mode = 2 then + begin + r.Width := r.Width + 1; + r.Height := r.Height + 2; + end; + with Canvas do + begin + FillRectangle(r.Left, r.Top, r.Width, r.Height-2); + SetColor(clHilite2); + DrawLine(r.Left+1, r.Top, r.Right-2, r.Top); + SetColor(clShadow1); + DrawLine(r.Right-2,r.Top,r.Right-1,r.Top+1); + DrawLine(r.Left+2, r.Bottom-1, r.Right-2, r.Bottom-1); + DrawLine(r.Right-3, r.Bottom-1, r.Right-1, r.Bottom-3); + DrawLine(r.Right-1, r.Bottom-3, r.Right-1, r.Top); + SetColor(clShadow2); + DrawLine(r.Left+2,r.Bottom,r.Right-3, r.Bottom); + DrawLine(r.Right-3, r.Bottom, r.Right, r.Bottom-3); + DrawLine(r.Right, r.Top+2, r.Right, r.Bottom-2); + end; + end; + end; { case } +end; + +procedure TfpgPageControl.pmCloseTab(Sender: TObject); +var + ts: TfpgTabSheet; +begin + ts := ActivePage; + if ts = nil then + Exit; + RemovePage(ts); + DoTabSheetClosing(ts); + ts.Free; end; procedure TfpgPageControl.OrderSheets; begin FPages.Sort(@SortCompare); + FActivePageIndex := FPages.IndexOf(ActivePage); end; procedure TfpgPageControl.RePaintTitles; +const + TabHeight = 21; var - r: TfpgRect; + TabW, TabH: Integer; r2: TfpgRect; r3: TfpgRect; h: TfpgTabSheet; lp: integer; toffset: integer; + TextLeft, TextTop: Integer; dx: integer; lTxtFlags: TFTextFlags; + ActivePageVisible: Boolean; begin if not HasHandle then Exit; //==> @@ -480,179 +671,285 @@ begin if PageCount = 0 then Exit; //==> + TabW:=FixedTabWidth; + TabH:=FixedTabHeight; + ActivePageVisible := false; + If TabH = 0 then + TabH := TabHeight; h := TfpgTabSheet(FPages.First); if h = nil then - Exit; + Exit; //==> + Canvas.BeginDraw; Canvas.SetTextColor(TextColor); - lTxtFlags := TextFlagsDflt; + lTxtFlags := []; if not Enabled then Include(lTxtFlags, txtDisabled); + + if TabPosition in [tpTop, tpBottom] then + begin + if MaxButtonWidthSum > (Width-(FMargin*2)) then + begin + if FFirstTabButton = nil then + FFirstTabButton := h + else + h := FFirstTabButton; + if TabPosition = tpTop then + begin + FLeftButton.SetPosition(Width - (FRightButton.Width * 2), FMargin, FRightButton.Height, FRightButton.Height); + FRightButton.SetPosition(Width - FRightButton.Width, FMargin, FRightButton.Height, FRightButton.Height); + end + else + begin + FLeftButton.SetPosition(Width - (FRightButton.Width * 2), Height - ButtonHeight - FMargin, FRightButton.Height, FRightButton.Height); + FRightButton.SetPosition(Width - FRightButton.Width, Height - ButtonHeight - FMargin, FRightButton.Height, FRightButton.Height); + end; + FLeftButton.Visible := True; + FRightButton.Visible := True; + end + else + begin + FLeftButton.Visible := False; + FRightButton.Visible := False; + end; + end; + + if TabPosition in [tpLeft, tpRight] then + begin + if MaxButtonHeightSum > (Height-(FMargin*2)) then + begin + if FFirstTabButton = nil then + FFirstTabButton := h + else + h := FFirstTabButton; + if TabPosition = tpLeft then + begin + FLeftButton.SetPosition(MaxButtonWidth - (FRightButton.Width * 2), Height - ButtonHeight - FMargin, FRightButton.Height, FRightButton.Height); + FRightButton.SetPosition(MaxButtonWidth - FRightButton.Width, Height - ButtonHeight - FMargin, FRightButton.Height, FRightButton.Height); + end + else + begin + FLeftButton.SetPosition(Width - MaxButtonWidth, Height - ButtonHeight - FMargin, FRightButton.Height, FRightButton.Height); + FRightButton.SetPosition(Width - MaxButtonWidth + FRightButton.Width, Height - ButtonHeight - FMargin, FRightButton.Height, FRightButton.Height); + end; + FLeftButton.Visible := True; + FRightButton.Visible := True; + end + else + begin + FLeftButton.Visible := False; + FRightButton.Visible := False; + end; + end; + case TabPosition of + tpNone: + begin + while h <> nil do + begin + if h <> ActivePage then + h.Visible:=false + else + h.Visible:=True; + h.SetPosition(FMargin+2, FMargin+2 , Width - (FMargin*2) - 4, Height - ((FMargin+2)*2)); + if h <> TfpgTabSheet(FPages.Last) then + h := TfpgTabSheet(FPages[FPages.IndexOf(h)+1]) + else + h := nil; + end; + r2.Left := 0; + r2.Top := 0; + r2.Width := Width; + r2.Height := Height; + Canvas.DrawButtonFace(r2, []); + end; + tpBottom: + begin + lTxtFlags += TextFlagsDflt; + lp := 0; + r2.SetRect(2, Height - ButtonHeight-3, 50, 21); + while h <> nil do begin -(* - if MaxButtonWidthSum > (Width-(FMargin*2)) then + if h <> ActivePage then begin - if FFirstTabButton = nil then - FFirstTabButton := h - else - h := FFirstTabButton; - r.SetRect(FMargin, FMargin, Width-(FMargin*2)-(FRightButton.Width*2)-1, FRightButton.Height); - FLeftButton.SetPosition(Width - FMargin * 2 - FRightButton.Width * 2, FMargin, FRightButton.Height, FRightButton.Height); - FRightButton.SetPosition(Width - FMargin * 2 - FrightButton.Width, FMargin, FRightButton.Height, FRightButton.Height); - FLeftButton.Visible := True; - FRightButton.Visible := True; + toffset := 2; + h.Visible := False; end else begin - r.SetRect(FMargin, FMargin, Width-(FMargin*2), ButtonHeight); - FLeftButton.Visible := False; - FRightButton.Visible := False; + toffset := 4; + h.Visible := True; + h.SetPosition(FMargin+2, FMargin+2 , Width - (FMargin*2) - 4, Height - r2.Height - (FMargin+2)*2); end; - // tabsheet area - left outer line - Canvas.SetColor(clHilite1); - Canvas.DrawLine(FMargin, ButtonHeight, FMargin, Height-(FMargin*2)); - // tabsheet area - left inner line - Canvas.SetColor(clHilite2); - Canvas.DrawLine(FMargin+1, ButtonHeight+1, FMargin+1, Height - (FMargin*2) - 1); - // tabsheet area - outer bottom & right line - Canvas.SetColor(clShadow2); - Canvas.DrawLine(FMargin, Height - (FMargin*2), Width - (FMargin*2), Height - (FMargin*2)); - Canvas.DrawLine(Width - (FMargin*2), Height - (FMargin*2), Width - (FMargin*2), FMargin + ButtonHeight - 3); - // tabsheet area - inner bottom & right line - Canvas.SetColor(clShadow1); - Canvas.DrawLine(FMargin + 1, Height - (FMargin*2) - 1, Width - (FMargin*2) - 1, Height - (FMargin*2) - 1); - Canvas.DrawLine(Width - FMargin - 2, Height - FMargin - 2, Width - FMargin - 2, FMargin + ButtonHeight - 2); - Canvas.SetClipRect(r); - lp := 0; - while h <> nil do - begin - if h <> ActivePage then - begin - toffset := 4; - // tabsheet area - top lines under inactive tabs - Canvas.SetColor(clHilite1); - Canvas.DrawLine(FMargin + lp, FMargin + ButtonHeight - 2, FMargin + lp + ButtonWidth(h.Text), FMargin + ButtonHeight - 2); - Canvas.SetColor(clHilite2); - if TfpgTabSheet(FPages.First) = h then - dx := 1 - else - dx := -1; - Canvas.DrawLine(FMargin + lp+dx, FMargin + ButtonHeight - 1, FMargin + lp + ButtonWidth(h.Text) + 1, FMargin + ButtonHeight - 1); - // vertical divider line between inactive tabs - Canvas.SetColor(clShadow1); - Canvas.DrawLine(lp + FMargin + ButtonWidth(h.Text), FMargin, lp + FMargin + ButtonWidth(h.Text), FMargin + ButtonHeight - 2); - h.Visible := False; - end - else - begin - toffset := 2; - h.Visible := True; - h.SetPosition(FMargin+2, FMargin + ButtonHeight, Width - (FMargin*2) - 4, Height - (FMargin*2) - ButtonHeight - 2); - // tab outer left & top line - Canvas.SetColor(clHilite1); - Canvas.DrawLine(lp + FMargin, FMargin + ButtonHeight - 2, lp + FMargin, FMargin); - Canvas.DrawLine(lp + FMargin, FMargin, lp + FMargin + ButtonWidth(h.Text)-1, FMargin); - // tab inner left & top line - Canvas.SetColor(clHilite2); - Canvas.DrawLine(lp + FMargin + 1, FMargin + ButtonHeight - 1, lp + FMargin + 1, FMargin + 1); - Canvas.DrawLine(lp + FMargin + 1, FMargin + 1, lp + FMargin + ButtonWidth(h.Text) - 2, FMargin + 1); - // tab inner right line - Canvas.SetColor(clShadow1); - Canvas.DrawLine(lp + FMargin + ButtonWidth(h.Text) - 2, FMargin + 1, lp + FMargin + ButtonWidth(h.Text) - 2, FMargin + ButtonHeight); - // tab outer right line - Canvas.SetColor(clShadow2); - Canvas.DrawLine(lp + FMargin + ButtonWidth(h.Text) - 1, FMargin, lp + FMargin + ButtonWidth(h.Text) - 1, FMargin + ButtonHeight-1); - end; - // paint text - Canvas.DrawString(lp + (ButtonWidth(h.Text) div 2) - FFont.TextWidth(GetTabText(h.Text)) div 2, FMargin+toffset, GetTabText(h.Text)); - - lp := lp + ButtonWidth(h.Text); - if h <> TfpgTabSheet(FPages.Last) then - h := TfpgTabSheet(FPages[FPages.IndexOf(h)+1]) - else - h := nil; - end; { while } - // tabsheet area - top lines on right of tabs - Canvas.SetColor(clHilite1); - Canvas.Drawline(lp + 1, FMargin + ButtonHeight - 2, Width - (FMargin*2), FMargin + ButtonHeight - 2); - Canvas.SetColor(clHilite2); - Canvas.Drawline(lp , FMargin + ButtonHeight - 1, Width - (FMargin*2)-1, FMargin + ButtonHeight - 1); -*) + // paint tab button + r2.Width := ButtonWidth(h.Text); + 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, + Height-r2.Height-toffset, GetTabText(h.Text), lTxtFlags); + + r2.Left := r2.Left + r2.Width; + lp := lp + ButtonWidth(h.Text); + if h <> TfpgTabSheet(FPages.Last) then + h := TfpgTabSheet(FPages[FPages.IndexOf(h)+1]) + else + h := nil; end; + // Draw Page Control body rectangle (client area) + r2.Left := 0; + r2.Top := 0; + r2.Width := Width; + r2.Height := Height - r2.Height; + Canvas.DrawButtonFace(r2, []); + // Draw text of ActivePage, because we didn't before. + DrawTab(r3, false, 2); + Canvas.DrawText(r3.Left+4, r3.Top+5, r3.Width, r3.Height, ActivePage.Text, lTxtFlags); + end; tpTop: + begin + lTxtFlags += TextFlagsDflt; + lp := 0; + r2.SetRect(2, 2, 50, 21); + while h <> nil do begin - if MaxButtonWidthSum > (Width-(FMargin*2)) then + if h <> ActivePage then begin - if FFirstTabButton = nil then - FFirstTabButton := h - else - h := FFirstTabButton; - r.SetRect(FMargin, FMargin, Width-(FMargin*2)-(FRightButton.Width*2)-1, FRightButton.Height); - FLeftButton.SetPosition(Width - FRightButton.Width * 2, FMargin, FRightButton.Height, FRightButton.Height); - FRightButton.SetPosition(Width - FrightButton.Width, FMargin, FRightButton.Height, FRightButton.Height); - FLeftButton.Visible := True; - FRightButton.Visible := True; + toffset := 4; + h.Visible := False; end else begin - r.SetRect(FMargin, FMargin, Width-(FMargin*2), ButtonHeight); - FLeftButton.Visible := False; - FRightButton.Visible := False; + toffset := 2; + h.Visible := True; + h.SetPosition(FMargin+2, FMargin+2 + r2.Height, Width - (FMargin*2) - 4, Height - r2.Height - ((FMargin+2)*2)); end; - - lp := 0; - r2.SetRect(2, 2, 50, 21); - while h <> nil do + // paint tab button + r2.Width := ButtonWidth(h.Text); + 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, + FMargin+toffset, GetTabText(h.Text), lTxtFlags); + r2.Left := r2.Left + r2.Width; + lp := lp + ButtonWidth(h.Text); + if h <> TfpgTabSheet(FPages.Last) then + h := TfpgTabSheet(FPages[FPages.IndexOf(h)+1]) + else + h := nil; + end; + // Draw Page Control body rectangle (client area) + r2.Left := 0; + r2.Top := r2.Top + r2.Height-2; + r2.Width := Width; + r2.Height := Height - r2.Height; + Canvas.DrawButtonFace(r2, []); + + // Draw text of ActivePage, because we didn't before. + DrawTab(r3, false, 2); + Canvas.DrawText(r3.Left+4, r3.Top+3, r3.Width, r3.Height, ActivePage.Text, lTxtFlags); + end; + + tpRight: + begin + lTxtFlags += [txtVCenter, txtLeft]; + lp := 0; + TabW := MaxButtonWidth; + r2.SetRect(Width - 2 - TabW, 2, TabW, 21); + while h <> nil do + begin + if h <> ActivePage then begin - if h <> ActivePage then - begin - toffset := 4; - h.Visible := False; - end - else - begin - toffset := 2; - h.Visible := True; - h.SetPosition(FMargin+2, FMargin+2 + r2.Height, Width - (FMargin*2) - 4, Height - r2.Height - ((FMargin+2)*2)); - end; - // paint tab button - r2.Width := ButtonWidth(h.Text); - 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, FMargin+toffset, GetTabText(h.Text), lTxtFlags); - - r2.Left := r2.Left + r2.Width; - lp := lp + ButtonWidth(h.Text); - if h <> TfpgTabSheet(FPages.Last) then - h := TfpgTabSheet(FPages[FPages.IndexOf(h)+1]) - else - h := nil; + toffset := 4; + h.Visible := False; + end + else + begin + toffset := 2; + h.Visible := True; + { set tab content page (client area) size } + h.SetPosition(FMargin+2, FMargin+2, Width - ((FMargin+2)*2) - TabW, Height - ((FMargin+2)*2)); end; - // Draw Page Control body rectangle (client area) - r2.Left := 0; - r2.Top := r2.Top + r2.Height-2; - r2.Width := Width; - r2.Height := Height - r2.Height; - Canvas.DrawButtonFace(r2, []); - - // Draw text of ActivePage, because we didn't before. - DrawTab(r3, false, 2); - Canvas.DrawText(r3.Left+4, r3.Top+3, r3.Width, r3.Height, ActivePage.Text, lTxtFlags); + // paint tab button + r3 := DrawTab(r2, h = ActivePage); + + // paint text on non-active tabs + if h <> ActivePage then + Canvas.DrawText(r2.left+toffset, r2.Top, r2.Width, r2.Height, GetTabText(h.Text), lTxtFlags); + r2.Top += r2.Height; + lp := r2.Top; + if h <> TfpgTabSheet(FPages.Last) then + h := TfpgTabSheet(FPages[FPages.IndexOf(h)+1]) + else + h := nil; end; - end; - + // Draw Page Control body rectangle (client area) + r2.Left := 0; + r2.Top := 0; + r2.Width := Width - TabW; + r2.Height := Height; + Canvas.DrawButtonFace(r2, []); + + // Draw text of ActivePage, because we didn't before. + DrawTab(r3, false, 2); + Canvas.DrawText(r3.left+toffset, r3.Top, r3.Width, r3.Height, ActivePage.Text, lTxtFlags); + end; + + tpLeft: + begin + lTxtFlags += [txtVCenter, txtLeft]; + lp := 0; + TabW := MaxButtonWidth; + r2.SetRect(2, 2, TabW, 21); + while h <> nil do + begin + if h <> ActivePage then + begin + toffset := 4; + h.Visible := False; + end + else + begin + toffset := 2; + h.Visible := True; + { set tab content page (client area) size } + h.SetPosition(FMargin+2+TabW, FMargin+2, Width - ((FMargin+2)*2) - TabW, Height - ((FMargin+2)*2)); + end; + // paint tab button + r3 := DrawTab(r2, h = ActivePage); + + // paint text on non-active tabs + if h <> ActivePage then + Canvas.DrawText(r2.left+toffset, r2.Top, r2.Width, r2.Height, GetTabText(h.Text), lTxtFlags); + r2.Top += r2.Height; + lp := r2.Top; + if h <> TfpgTabSheet(FPages.Last) then + h := TfpgTabSheet(FPages[FPages.IndexOf(h)+1]) + else + h := nil; + end; + // Draw Page Control body rectangle (client area) + r2.Left := TabW; + r2.Top := 0; + r2.Width := Width - TabW; + r2.Height := Height; + Canvas.DrawButtonFace(r2, []); + + // Draw text of ActivePage, because we didn't before. + DrawTab(r3, false, 2); + Canvas.DrawText(r3.left+toffset, r3.Top, r3.Width, r3.Height, ActivePage.Text, lTxtFlags); + end; + end; { case } + Canvas.EndDraw; end; procedure TfpgPageControl.HandlePaint; begin -// inherited HandlePaint; if SortPages then OrderSheets; Canvas.ClearClipRect; @@ -669,15 +966,6 @@ begin Canvas.DrawString(2, 2, Name + ': ' + Classname); end; end; - - if TabPosition = tpBottom then - begin - if Focused then - Canvas.SetColor(clWidgetFrame) - else - Canvas.SetColor(clInactiveWgFrame); - Canvas.DrawRectangle(0, 0, Width, Height); - end; RePaintTitles; end; @@ -693,8 +981,10 @@ var h: TfpgTabSheet; lp: integer; // left position bw: integer; // button width + bh: integer; // button height + p1, p2: integer; // tab boundaries for mouse click to take affect begin -// writeln('>> TfpgPageControl.HandleLMouseUp'); +// debugln('>> TfpgPageControl.HandleLMouseUp'); h := TfpgTabSheet(FPages.First); if h = nil then Exit; //==> @@ -705,58 +995,92 @@ begin case TabPosition of tpTop: - begin -// writeln(' TabPosition = tpTop'); - if (y > FMargin) and (y < ButtonHeight) then - begin - while h <> nil do - begin - bw := ButtonWidth(h.Text); // initialize button width - if (x > lp) and (x < lp + bw) then - begin - if h <> ActivePage then - begin - ActivePage := h; - DoChange(ActivePage); - end; - exit; - end; { if } - lp := lp + bw; - if h <> TfpgTabSheet(FPages.Last) then - h := TfpgTabSheet(FPages[FPages.IndexOf(h)+1]) - else - h := nil; - end; { while } - end; { if } - end; - + begin + p1 := FMargin; + p2 := ButtonHeight; + end; + tpBottom: - begin -(* - if (y > Height - FMargin - buttonheight) and (y < height - FMargin) then + begin + p1 := Height - FMargin - ButtonHeight; + p2 := Height - FMargin; + end; + + tpRight: + begin + p1 := Width - MaxButtonWidth; + p2 := Width; + end; + + tpLeft: + begin + p1 := FMargin; + p2 := FMargin + MaxButtonWidth; + end; + end; + + if TabPosition in [tpTop, tpBottom] then + begin + if (y > p1) and (y < p2) then + begin + while h <> nil do + begin + bw := ButtonWidth(h.Text); // initialize button width + if (x > lp) and (x < lp + bw) then begin - while h <> nil do - begin - bw := ButtonWidth(h^.TabSheet.Text); // initialize button width - if (x > lp) and (x < lp + bw) then - begin - if h^.TabSheet <> ActiveTabSheet then - begin - ActiveTabSheet := h^.TabSheet; - DoChange(ActiveTabSheet); - end; - exit; - end; - lp := lp + bw; - h := h^.next; - end; { while } + if h <> ActivePage then + ActivePage := h; + exit; end; { if } -*) - end; - end; { case } + lp := lp + bw; + if h <> TfpgTabSheet(FPages.Last) then + h := TfpgTabSheet(FPages[FPages.IndexOf(h)+1]) + else + h := nil; + end; { while } + end; { if } + end; + + if TabPosition in [tpLeft, tpRight] then + begin + 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 + ActivePage := h; + exit; + end; { if } + lp := lp + bh; + if h <> TfpgTabSheet(FPages.Last) then + h := TfpgTabSheet(FPages[FPages.IndexOf(h)+1]) + else + h := nil; + end; { while } + end; { if } + end; + inherited HandleLMouseUp(x, y, shiftstate); end; +procedure TfpgPageControl.HandleRMouseUp(x, y: integer; shiftstate: TShiftState); +begin + inherited HandleRMouseUp(x, y, shiftstate); +// ShowDefaultPopupMenu(x, y, ShiftState); + if to_PMenuClose in FTabOptions then + begin + if not Assigned(FPopupMenu) then + begin + FPopupMenu := TfpgPopupMenu.Create(self); + FPopupMenu.AddMenuItem('Close Tab', '', @pmCloseTab); + end; + FPopupMenu.ShowAt(self, x, y); + end; +end; + procedure TfpgPageControl.HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: boolean); var @@ -765,14 +1089,13 @@ begin // writeln(Classname, '.Keypress'); consumed := True; i := ActivePageIndex; - + if ssAlt in shiftstate then case keycode of keyLeft: begin if ActivePage <> TfpgTabSheet(FPages.First) then begin ActivePage := TfpgTabSheet(FPages[i-1]); - DoChange(ActivePage); end; end; @@ -781,7 +1104,6 @@ begin if ActivePage <> TfpgTabSheet(FPages.Last) then begin ActivePage := TfpgTabSheet(FPages[i+1]); - DoChange(ActivePage); end; end; @@ -799,12 +1121,14 @@ begin FWidth := 150; FHeight := 100; FIsContainer := True; + FTabOptions := []; FTextColor := Parent.TextColor; FBackgroundColor := Parent.BackgroundColor; FFocusable := True; FOnChange := nil; FFixedTabWidth := 0; + FFixedTabHeight := 21; FFirstTabButton := nil; FStyle := tsTabs; FTabPosition := tpTop; @@ -825,20 +1149,13 @@ begin end; destructor TfpgPageControl.Destroy; -var - ts: TfpgTabSheet; +var i: integer; begin FOnChange := nil; - if FPages.Count > 0 then - FActivePage := TfpgTabSheet(FPages[0]); - ActiveWidget := nil; - while FPages.Count > 0 do - begin - ts := TfpgTabSheet(FPages.Last); - FPages.Remove(ts); - ts.Free; - end; + for i:=0 to FPages.Count-1 do + TfpgTabSheet(FPages[i]).PageControl:=nil; FPages.Free; + ActiveWidget := nil; FFirstTabButton := nil; inherited Destroy; end; diff --git a/src/gui/fpg_trackbar.pas b/src/gui/fpg_trackbar.pas index 9dc15b95..524a4c4c 100644 --- a/src/gui/fpg_trackbar.pas +++ b/src/gui/fpg_trackbar.pas @@ -1,7 +1,7 @@ { fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -69,13 +69,16 @@ type constructor Create(AOwner: TComponent); override; published property BackgroundColor; + property Hint; property Min: integer read FMin write SetMin default 0; property Max: integer read FMax write SetMax default 10; property Position: integer read FPosition write SetTBPosition default 0; + property ShowHint; property SliderSize: integer read FSliderSize write SetSliderSize default 11; property Orientation: TOrientation read FOrientation write FOrientation default orHorizontal; property TabOrder; property OnChange: TTrackBarChange read FOnChange write FOnChange; + property OnShowHint; end; @@ -118,6 +121,7 @@ type property Min: integer read FMin write SetMin default 0; property Max: integer read FMax write SetMax default 100; property ParentShowHint; + property Hint; property ShowHint; property ShowPosition: boolean read FShowPosition write SetShowPosition default False; property Orientation: TOrientation read FOrientation write FOrientation default orHorizontal; @@ -126,6 +130,7 @@ type property OnChange: TTrackBarChange read FOnChange write FOnChange; property OnEnter; property OnExit; + property OnShowHint; end; diff --git a/src/gui/fpg_tree.pas b/src/gui/fpg_tree.pas index da3e2ddf..b61b0c29 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 - 2008 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, @@ -203,8 +203,12 @@ type procedure DrawHeader(ACol: integer; ARect: TfpgRect; AFlags: integer); virtual; procedure DoChange; virtual; procedure DoExpand(ANode: TfpgTreeNode); virtual; + // only visual (visible) nodes function NextVisualNode(ANode: TfpgTreeNode): TfpgTreeNode; function PrevVisualNode(ANode: TfpgTreeNode): TfpgTreeNode; + // any next node, even if node is collapsed + function NextNode(ANode: TfpgTreeNode): TfpgTreeNode; + function PrevNode(ANode: TfpgTreeNode): TfpgTreeNode; // the nodes between the given node and the direct next node function SpaceToVisibleNext(aNode: TfpgTreeNode): integer; function StepToRoot(aNode: TfpgTreeNode): integer; @@ -214,6 +218,8 @@ type procedure SetColumnWidth(AIndex, AWidth: word); // the width of a column - aIndex of the rootnode = 0 function GetColumnWidth(AIndex: word): word; + procedure GotoNextNodeUp; + procedure GotoNextNodeDown; property Font: TfpgFont read FFont; // Invisible node that starts the tree property RootNode: TfpgTreeNode read GetRootNode; @@ -228,6 +234,7 @@ type property ParentShowHint; property ScrollWheelDelta: integer read FScrollWheelDelta write FScrollWheelDelta default 15; property ShowColumns: boolean read FShowColumns write SetShowColumns default False; + property Hint; property ShowHint; property ShowImages: boolean read FShowImages write SetShowImages default False; property TabOrder; @@ -235,6 +242,8 @@ type 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 OnShowHint; end; @@ -775,13 +784,16 @@ end; procedure TfpgTreeview.SetSelection(const AValue: TfpgTreeNode); var n: TfpgTreeNode; + dy: integer; // y delta - absolute top node + nh: integer; // node height + vh: integer; // visible height begin - if aValue <> FSelection then + if AValue <> FSelection then begin - FSelection := aValue; - if aValue <> nil then + FSelection := AValue; + if AValue <> nil then begin - n := aValue.parent; + n := AValue.Parent; while n <> nil do begin n.Expand; @@ -789,17 +801,28 @@ begin n := n.parent; end; end; - - if GetAbsoluteNodeTop(Selection) + GetNodeHeight - FVScrollbar.Position > VisibleHeight then + + dy := GetAbsoluteNodeTop(FSelection); + nh := GetNodeHeight; + vh := VisibleHeight; + if dy + nh - FVScrollbar.Position > vh then begin - FVScrollbar.Position := GetAbsoluteNodeTop(Selection) + GetNodeHeight - VisibleHeight; + if FVScrollBar.Max = 0 then // the first time and no expansion happened before. + FVScrollBar.Max := dy + Height; + FVScrollbar.Position := dy + nh - vh; FYOffset := FVScrollbar.Position; UpdateScrollBars; + if FHScrollbar.Visible then // HScrollbar appeared so we need to adjust position again + begin + FVScrollbar.Position := FVScrollbar.Position + FHScrollbar.Height; + FYOffset := FVScrollbar.Position; + UpdateScrollBars; + end; end; - if GetAbsoluteNodeTop(Selection) - FVScrollbar.Position < 0 then + if dy - FVScrollbar.Position < 0 then begin - FVScrollbar.Position := GetAbsoluteNodeTop(Selection); + FVScrollbar.Position := dy; FYOffset := FVScrollbar.Position; UpdateScrollbars; end; @@ -853,14 +876,14 @@ end; function TfpgTreeview.VisibleWidth: integer; begin - Result := Width - 2; + Result := Width - 2; // border width = 2 pixels if FVScrollbar.Visible then dec(Result, FVScrollbar.Width); end; function TfpgTreeview.VisibleHeight: integer; begin - Result := Height - 2; + Result := Height - 2; // border width = 2 pixels if FShowColumns then dec(Result, FColumnHeight); if FHScrollbar.Visible then @@ -1051,6 +1074,20 @@ begin result := DefaultColumnWidth; end; +procedure TfpgTreeView.GotoNextNodeUp; +begin + if Selection = RootNode.FirstSubNode then + Exit; + Selection := PrevNode(Selection); +end; + +procedure TfpgTreeView.GotoNextNodeDown; +begin + if Selection = RootNode.LastSubNode then + Exit; + Selection := NextNode(Selection); +end; + procedure TfpgTreeview.PreCalcColumnLeft; var Aleft: TfpgCoord; @@ -1086,9 +1123,9 @@ begin {$IFDEF DEBUG} writeln(Classname, '.UpdateScrollbars'); {$ENDIF} - FVScrollbar.Visible := VisibleHeight < GetNodeHeightSum * GetNodeHeight; + FVScrollbar.Visible := VisibleHeight < (GetNodeHeightSum * GetNodeHeight); FVScrollbar.Min := 0; - FVScrollbar.Max := (GetNodeHeightSum - 1) * GetNodeHeight; + FVScrollbar.Max := (GetNodeHeightSum * GetNodeHeight) - VisibleHeight + FHScrollbar.Height; FHScrollbar.Min := 0; FHScrollbar.Max := MaxNodeWidth - VisibleWidth + FVScrollbar.Width; FHScrollbar.Visible := MaxNodeWidth > Width - 2; @@ -1097,13 +1134,18 @@ begin FVScrollbar.Position := 0; FVScrollBar.RepaintSlider; FYOffset := 0; - end; + end + else + FVScrollBar.RepaintSlider; + if not FHScrollbar.Visible then begin FHScrollbar.Position := 0; FHScrollBar.RepaintSlider; FXOffset := 0; - end; + end + else + FHScrollBar.RepaintSlider; end; procedure TfpgTreeview.ResetScrollbar; @@ -1586,7 +1628,7 @@ begin keyRight: begin Consumed := True; - Selection.Collapsed := false; + Selection.Expand; DoExpand(Selection); ResetScrollbar; RePaint; @@ -1655,21 +1697,27 @@ end; procedure TfpgTreeview.HandleMouseScroll(x, y: integer; shiftstate: TShiftState; delta: smallint); +var + i: integer; begin inherited HandleMouseScroll(x, y, shiftstate, delta); if delta > 0 then begin inc(FYOffset, FScrollWheelDelta); - if FYOffset > VisibleHeight then - FYOffset := VisibleHeight; + i := (GetNodeHeightSum * GetNodeHeight) - VisibleHeight + FHScrollbar.Height; + if FYOffset > i then + FYOffset := i; + i := FVScrollbar.Position + FScrollWheelDelta; + FVScrollbar.Position := i; end else begin dec(FYOffset, FScrollWheelDelta); if FYOffset < 0 then FYOffset := 0; + i := FVScrollbar.Position - FScrollWheelDelta; + FVScrollbar.Position := i; end; - UpdateScrollbars; RePaint; end; @@ -1747,6 +1795,58 @@ begin end; end; +function TfpgTreeView.NextNode(ANode: TfpgTreeNode): TfpgTreeNode; + //---------------- + procedure _FindNextNode; + begin + if ANode.Next <> nil then + begin + result := ANode.Next; + end + else + begin + while ANode.Next = nil do + begin + ANode := ANode.Parent; + if ANode = nil then + exit; //==> + end; + result := ANode.Next; + end; + end; + +begin + result := nil; + if ANode.Count > 0 then + result := ANode.FirstSubNode + else + _FindNextNode; +end; + +function TfpgTreeView.PrevNode(ANode: TfpgTreeNode): TfpgTreeNode; +var + n: TfpgTreeNode; +begin + n := ANode; + if ANode.Prev <> nil then + begin + result := ANode.Prev; + ANode := ANode.Prev; + while {(not ANode.Collapsed) and} (ANode.Count > 0) do + begin + result := ANode.LastSubNode; + ANode := ANode.LastSubNode; + end; + end + else + begin + if ANode.Parent <> nil then + result := ANode.Parent + else + result := n; + end; +end; + function TfpgTreeview.SpaceToVisibleNext(aNode: TfpgTreeNode): integer; var h: TfpgTreeNode; @@ -1805,7 +1905,7 @@ begin FHScrollbar.OnScroll := @HScrollbarScroll; FHScrollbar.Visible := False; FHScrollbar.Position := 0; - FHScrollbar.SliderSize := 0.2; + FHScrollbar.SliderSize := 0.5; FVScrollbar := TfpgScrollbar.Create(self); FVScrollbar.Orientation := orVertical; diff --git a/src/gui/inputquerydialog.inc b/src/gui/inputquerydialog.inc new file mode 100644 index 00000000..5b063233 --- /dev/null +++ b/src/gui/inputquerydialog.inc @@ -0,0 +1,134 @@ +{ + fpGUI - Free Pascal GUI Toolkit + + Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this + distribution, for details of the copyright. + + See the file COPYING.modifiedLGPL, included in this distribution, + for details about redistributing fpGUI. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + Description: + This unit contains the Input Query dialogs. +} + +{%mainunit fpg_dialogs.pas} + +{$IFDEF read_interface} + +type + + TfpgQueryDialog = class(TfpgForm) + private + {@VFD_HEAD_BEGIN: fpgQueryDialog} + lblText: TfpgLabel; + edtText: TfpgEdit; + btnOK: TfpgButton; + btnCancel: TfpgButton; + {@VFD_HEAD_END: fpgQueryDialog} + procedure SetupCaptions; + public + procedure AfterCreate; override; + end; + + +{$ENDIF read_interface} + +{$IFDEF read_implementation} + +function fpgInputQuery(const ACaption, APrompt: TfpgString; var Value: TfpgString): Boolean; +var + dlg: TfpgQueryDialog; +begin + dlg := TfpgQueryDialog.Create(nil); + try + dlg.WindowTitle := ACaption; + dlg.lblText.Text := APrompt; + Result := dlg.ShowModal = mrOK; + Value := dlg.edtText.Text; + finally + dlg.Free; + end; +end; + +{ TfpgQueryDialog } + +procedure TfpgQueryDialog.SetupCaptions; +begin + btnOK.Text := rsOK; + btnCancel.Text := rsCancel; +end; + +procedure TfpgQueryDialog.AfterCreate; +begin + {%region 'Auto-generated GUI code' -fold} + {@VFD_BODY_BEGIN: fpgQueryDialog} + Name := 'fpgQueryDialog'; + SetPosition(300, 150, 340, 97); + WindowTitle := 'QueryDialog'; + Hint := ''; + WindowPosition := wpOneThirdDown; + + lblText := TfpgLabel.Create(self); + with lblText do + begin + Name := 'lblText'; + SetPosition(8, 8, 324, 16); + Anchors := [anLeft,anRight,anTop]; + FontDesc := '#Label1'; + Hint := ''; + Text := 'lblText'; + end; + + edtText := TfpgEdit.Create(self); + with edtText do + begin + Name := 'edtText'; + SetPosition(8, 26, 324, 24); + Anchors := [anLeft,anRight,anTop]; + ExtraHint := ''; + Hint := ''; + TabOrder := 2; + Text := ''; + FontDesc := '#Edit1'; + end; + + btnOK := TfpgButton.Create(self); + with btnOK do + begin + Name := 'btnOK'; + SetPosition(144, 64, 92, 24); + Anchors := [anRight,anBottom]; + Text := 'OK'; + FontDesc := '#Label1'; + Hint := ''; + ImageName := ''; + ModalResult := mrOK; + TabOrder := 3; + end; + + btnCancel := TfpgButton.Create(self); + with btnCancel do + begin + Name := 'btnCancel'; + SetPosition(240, 64, 92, 24); + Anchors := [anRight,anBottom]; + Text := 'Cancel'; + FontDesc := '#Label1'; + Hint := ''; + ImageName := ''; + ModalResult := mrCancel; + TabOrder := 4; + end; + + {@VFD_BODY_END: fpgQueryDialog} + {%endregion} + + SetupCaptions; +end; + +{$ENDIF read_implementation} + diff --git a/src/gui/messagedialog.inc b/src/gui/messagedialog.inc index 88a22272..10ffd515 100644 --- a/src/gui/messagedialog.inc +++ b/src/gui/messagedialog.inc @@ -1,7 +1,7 @@ { - fpGUI - Free Pascal GUI Library + fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2009 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2010 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 procedure PrepareButtons; protected procedure SetWindowTitle(const ATitle: string); override; + procedure HandleClose; override; procedure HandlePaint; override; procedure HandleShow; override; procedure HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: boolean); override; @@ -58,10 +59,14 @@ type procedure AfterCreate; override; class procedure About(const ATitle: string; const AText: string); class procedure AboutFPGui(const ATitle: string = ''); - class function Critical(const ATitle: string; const AText: string; AButtons: TfpgMsgDlgButtons = [mbOK]; ADefaultButton: TfpgMsgDlgBtn = mbNoButton): TfpgMsgDlgBtn; - class function Information(const ATitle: string; const AText: string; AButtons: TfpgMsgDlgButtons = [mbOK]; ADefaultButton: TfpgMsgDlgBtn = mbNoButton): TfpgMsgDlgBtn; - class function Question(const ATitle: string; const AText: string; AButtons: TfpgMsgDlgButtons = [mbYes, mbNo]; ADefaultButton: TfpgMsgDlgBtn = mbNo): TfpgMsgDlgBtn; - class function Warning(const ATitle: string; const AText: string; AButtons: TfpgMsgDlgButtons = [mbOK]; ADefaultButton: TfpgMsgDlgBtn = mbNoButton): TfpgMsgDlgBtn; + { ACloseButton is when the user cancels the dialog via the Esc key or the X window button } + class function Critical(const ATitle: string; const AText: string; AButtons: TfpgMsgDlgButtons = [mbOK]; ADefaultButton: TfpgMsgDlgBtn = mbNoButton; ACloseButton: TfpgMsgDlgBtn = mbCancel): TfpgMsgDlgBtn; + { ACloseButton is when the user cancels the dialog via the Esc key or the X window button } + class function Information(const ATitle: string; const AText: string; AButtons: TfpgMsgDlgButtons = [mbOK]; ADefaultButton: TfpgMsgDlgBtn = mbNoButton; ACloseButton: TfpgMsgDlgBtn = mbCancel): TfpgMsgDlgBtn; + { ACloseButton is when the user cancels the dialog via the Esc key or the X window button } + class function Question(const ATitle: string; const AText: string; AButtons: TfpgMsgDlgButtons = [mbYes, mbNo]; ADefaultButton: TfpgMsgDlgBtn = mbNo; ACloseButton: TfpgMsgDlgBtn = mbCancel): TfpgMsgDlgBtn; + { ACloseButton is when the user cancels the dialog via the Esc key or the X window button } + class function Warning(const ATitle: string; const AText: string; AButtons: TfpgMsgDlgButtons = [mbOK]; ADefaultButton: TfpgMsgDlgBtn = mbNoButton; ACloseButton: TfpgMsgDlgBtn = mbCancel): TfpgMsgDlgBtn; property InformativeText: string read GetInformativeText write SetInformativeText; property Text: string read FText write SetText; property Buttons: TfpgMsgDlgButtons read FButtons write SetButtons; @@ -165,9 +170,9 @@ var { TODO : At some stage the StyleManager can give us the correct button order based on the OS and Window Manager. } Result := 3; - sl.Add(cMsgDlgBtnText[mbYes] + '=' + IntToStr(mrYes)); - sl.Add(cMsgDlgBtnText[mbNo] + '=' + IntToStr(mrNo)); - sl.Add(cMsgDlgBtnText[mbCancel] + '=' + IntToStr(mrCancel)); + sl.Add(cMsgDlgBtnText[mbYes] + '=' + IntToStr(Integer(mrYes))); + sl.Add(cMsgDlgBtnText[mbNo] + '=' + IntToStr(Integer(mrNo))); + sl.Add(cMsgDlgBtnText[mbCancel] + '=' + IntToStr(Integer(mrCancel))); case DefaultButton of mbYes: lDefault := 0; mbNo: lDefault := 1; @@ -202,7 +207,7 @@ begin b := TfpgButton.Create(self); b.Name := 'DlgButton' + IntToStr(i+1); b.Text := sl.Names[i]; - b.ModalResult := StrToInt(sl.ValueFromIndex[i]); + b.ModalResult := TfpgModalResult(StrToInt(sl.ValueFromIndex[i])); if (i = lDefault) or (lcount = 1) then b.Default := True; FButtonList.Add(b); @@ -243,6 +248,13 @@ begin inherited SetWindowTitle(ATitle); end; +procedure TfpgMessageDialog.HandleClose; +begin + if ModalResult = mrNone then // Form was close via the X (window frame) button + ModalResult := mrCancel; + inherited HandleClose; +end; + procedure TfpgMessageDialog.HandlePaint; var logo: TfpgImage; @@ -369,6 +381,20 @@ begin dlg.WindowTitle := ATitle; dlg.Buttons := [mbOK]; dlg.DefaultButton := mbOK; + dlg.Text := dlg.WindowTitle; + dlg.InformativeText := LineEnding + LineEnding + + 'This program uses ' + fpGUIName + ' version ' + fpGUI_Version + '.' + + LineEnding + LineEnding + + fpGUIName + ' is intended for Open Source and Commercial applications. fpGUI' + + ' uses the LGPL 2 license with a static linking exception - the same as the Free' + + ' Pascal Compiler''s RTL.' + + LineEnding + LineEnding + + 'fpGUI is a Object Pascal toolkit for cross-platform application development.' + + ' It provides single-source portability across Linux, MS Windows, *BSD' + + ' and embedded devices like Embedded Linux and Windows CE.' + + LineEnding + LineEnding + + 'For more information, see the ' + fpGUIName + ' website at: ' + + fpGUIWebsite; dlg.PrepareLayout; dlg.ShowModal; finally @@ -378,9 +404,10 @@ end; class function TfpgMessageDialog.Critical(const ATitle: string; const AText: string; AButtons: TfpgMsgDlgButtons; - ADefaultButton: TfpgMsgDlgBtn): TfpgMsgDlgBtn; + ADefaultButton: TfpgMsgDlgBtn; ACloseButton: TfpgMsgDlgBtn): TfpgMsgDlgBtn; var dlg: TfpgMessageDialog; + mr: TfpgModalResult; begin dlg := TfpgMessageDialog.Create(nil); try @@ -391,7 +418,12 @@ begin dlg.WindowTitle := ATitle; dlg.FDefaultButton := ADefaultButton; dlg.PrepareLayout; - Result := TfpgMsgDlgBtn(dlg.ShowModal); + mr := dlg.ShowModal; + // if there is a Cancel button, ignore ACloseButton. + if (mr = mrCancel) and (not (mbCancel in AButtons)) then + Result := ACloseButton + else + Result := TfpgMsgDlgBtn(mr); finally dlg.Free; end; @@ -399,9 +431,10 @@ end; class function TfpgMessageDialog.Information(const ATitle: string; const AText: string; AButtons: TfpgMsgDlgButtons; - ADefaultButton: TfpgMsgDlgBtn): TfpgMsgDlgBtn; + ADefaultButton: TfpgMsgDlgBtn; ACloseButton: TfpgMsgDlgBtn): TfpgMsgDlgBtn; var dlg: TfpgMessageDialog; + mr: TfpgModalResult; begin dlg := TfpgMessageDialog.Create(nil); try @@ -412,7 +445,12 @@ begin dlg.WindowTitle := ATitle; dlg.FDefaultButton := ADefaultButton; dlg.PrepareLayout; - Result := TfpgMsgDlgBtn(dlg.ShowModal); + mr := dlg.ShowModal; + // if there is a Cancel button, ignore ACloseButton. + if (mr = mrCancel) and (not (mbCancel in AButtons)) then + Result := ACloseButton + else + Result := TfpgMsgDlgBtn(mr); finally dlg.Free; end; @@ -420,9 +458,10 @@ end; class function TfpgMessageDialog.Question(const ATitle: string; const AText: string; AButtons: TfpgMsgDlgButtons; - ADefaultButton: TfpgMsgDlgBtn): TfpgMsgDlgBtn; + ADefaultButton: TfpgMsgDlgBtn; ACloseButton: TfpgMsgDlgBtn): TfpgMsgDlgBtn; var dlg: TfpgMessageDialog; + mr: TfpgModalResult; begin dlg := TfpgMessageDialog.Create(nil); try @@ -433,7 +472,12 @@ begin dlg.WindowTitle := ATitle; dlg.FDefaultButton := ADefaultButton; dlg.PrepareLayout; - Result := TfpgMsgDlgBtn(dlg.ShowModal); + mr := dlg.ShowModal; + // if there is a Cancel button, ignore ACloseButton. + if (mr = mrCancel) and (not (mbCancel in AButtons)) then + Result := ACloseButton + else + Result := TfpgMsgDlgBtn(mr); finally dlg.Free; end; @@ -441,9 +485,10 @@ end; class function TfpgMessageDialog.Warning(const ATitle: string; const AText: string; AButtons: TfpgMsgDlgButtons; - ADefaultButton: TfpgMsgDlgBtn): TfpgMsgDlgBtn; + ADefaultButton: TfpgMsgDlgBtn; ACloseButton: TfpgMsgDlgBtn): TfpgMsgDlgBtn; var dlg: TfpgMessageDialog; + mr: TfpgModalResult; begin dlg := TfpgMessageDialog.Create(nil); try @@ -454,7 +499,12 @@ begin dlg.WindowTitle := ATitle; dlg.FDefaultButton := ADefaultButton; dlg.PrepareLayout; - Result := TfpgMsgDlgBtn(dlg.ShowModal); + mr := dlg.ShowModal; + // if there is a Cancel button, ignore ACloseButton. + if (mr = mrCancel) and (not (mbCancel in AButtons)) then + Result := ACloseButton + else + Result := TfpgMsgDlgBtn(mr); finally dlg.Free; end; diff --git a/src/gui/newdirdialog.inc b/src/gui/newdirdialog.inc index 62f6b4c0..406b6490 100644 --- a/src/gui/newdirdialog.inc +++ b/src/gui/newdirdialog.inc @@ -1,7 +1,7 @@ { - fpGUI - Free Pascal GUI Library + fpGUI - Free Pascal GUI Toolkit - Copyright (C) 2006 - 2009 See the file AUTHORS.txt, included in this + Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, diff --git a/src/gui/selectdirdialog.inc b/src/gui/selectdirdialog.inc index 35bafff6..d09f11c8 100644 --- a/src/gui/selectdirdialog.inc +++ b/src/gui/selectdirdialog.inc @@ -2,9 +2,6 @@ {$IFDEF read_interface} - - { TfpgSelectDirDialog } - TfpgSelectDirDialog = class(TfpgBaseDialog) private tv: TfpgTreeView; @@ -15,14 +12,16 @@ procedure SetRootDir(const AValue: TfpgString); procedure AddDirectories(Node: TfpgTreeNode; Dir: TfpgString); procedure NodeExpanded(Sender: TObject; ANode: TfpgTreeNode); + function GetSelectedDir: TfpgString; + procedure SetSelectedDir(const AValue: TfpgString); {$IFDEF MSWINDOWS} procedure AddWindowsDriveLetters; {$ENDIF} public constructor Create(AOwner: TComponent); override; procedure AfterCreate; override; - { return the selected directory } - function SelectedDir: TfpgString; + { return the selected directory or set initial selected dir } + property SelectedDir: TfpgString read GetSelectedDir write SetSelectedDir; { Directory the treeview starts from } property RootDirectory: TfpgString read FRootDir write SetRootDir; end; @@ -35,16 +34,30 @@ {$IFDEF read_implementation} function TfpgSelectDirDialog.GetAbsolutePath(Node: TfpgTreeNode): TfpgString; +var + lResult: TfpgString; begin - Result := ''; + lResult := ''; while Node <> nil do begin - if Node.Text = PathDelim then - Result := Node.Text + Result - else - Result := Node.Text + PathDelim + Result; + {$IFDEF UNIX} + if (Node.Text = PathDelim) then + lResult := Node.Text + lResult + else if (Node.Text <> '') then + lResult := Node.Text + PathDelim + lResult; + {$ENDIF} + {$IFDEF MSWINDOWS} + if (Node.Text <> '') then + begin + if (Node.Text[Length(Node.Text)] = PathDelim) then + lResult := Node.Text + lResult + else + lResult := Node.Text + PathDelim + lResult; + end; + {$ENDIF} Node := Node.Parent; end; + Result := lResult; end; procedure TfpgSelectDirDialog.InitializeTreeview; @@ -168,6 +181,49 @@ begin AddDirectories(ANode, GetAbsolutePath(ANode)); end; +function TfpgSelectDirDialog.GetSelectedDir: TfpgString; +begin + Result := ''; + if tv.Selection <> nil then + Result := GetAbsolutePath(tv.Selection); +end; + +procedure TfpgSelectDirDialog.SetSelectedDir(const AValue: TfpgString); +var + s: TfpgString; + dir: TfpgString; + i: integer; + p: integer; + prevn, nextn: TfpgTreeNode; +begin + if AValue = '' then + Exit; + s := fpgAppendPathDelim(AValue); + prevn := tv.RootNode; + nextn := prevn; + while nextn <> nil do + begin + if s = '' then + break; + i := UTF8Pos(PathDelim, s); + if i = 1 then + dir := PathDelim + else + dir := UTF8Copy(s, 1, i-1); + UTF8Delete(s, 1, i); // delete leading dir + PathDelim + if (prevn = tv.RootNode) and (pos(':', dir) > 0) then + dir += PathDelim; // Windows drive letter. eg: C:\ or D:\ etc. + nextn := prevn.FindSubNode(dir, True); + if Assigned(nextn) then + begin + prevn := nextn; + prevn.Expand; + NodeExpanded(self, prevn); + end; + end; + tv.Selection := prevn; +end; + {$IFDEF MSWINDOWS} procedure TfpgSelectDirDialog.AddWindowsDriveLetters; const @@ -199,7 +255,7 @@ begin inherited AfterCreate; Name := 'fpgSelectDirDialog'; SetPosition(20, 20, 300, 370); - WindowTitle := 'Select a Directory'; { TODO : Localize this!! } + WindowTitle := rsSelectaDirectory; WindowPosition := wpOneThirdDown; tv := TfpgTreeView.Create(self); @@ -224,12 +280,6 @@ begin InitializeTreeview; end; -function TfpgSelectDirDialog.SelectedDir: TfpgString; -begin - Result := ''; - if tv.Selection <> nil then - Result := GetAbsolutePath(tv.Selection); -end; {$ENDIF read_implementation} diff --git a/src/readme.txt b/src/readme.txt deleted file mode 100644 index 6c97dc41..00000000 --- a/src/readme.txt +++ /dev/null @@ -1,124 +0,0 @@ - - Building fpGUI from the Command Line - ==================================== - -This is still a work in progress until I can find a suitable solution. I'm -not 100% satisfied with this, but it's a quick and dirty way to get things -to compile. I'll assume you have the 'fpc' executable setup in your PATH so it -can be run from any location on your computer. I'll also assume you global -fpc.cfg file has been setup correctly so the FPC compiler can find the RTL and -FCL units. - -Under Linux run: build.sh - -Under Windows run: build.bat - - -The extrafpc.cfg file located in this directory is combined with your global -fpc.cfg file. The local extrafpc.cfg file sets up all the required search and -include paths to compile CoreLib and GUI directories. - -All compiled units (*.o and *.ppu) are saved in the ../lib directory. This -makes the search paths for you applications a little easier to setup. - - - Building fpGUI using Lazarus - ============================ - -I use a Lazarus feature call Packages that compiles the required -units and keeps track of the compiled units and paths when creating -applications. - - * Start Lazarus - * Select Components->Open Package File (*.lpk) and select the - src/corelib/<your platform>/fpgui_toolkit.lpk - Under Linux/FreeBSD the .lpk file will be in the 'x11' directory. - Under Windows the .lpk file will be in the 'gdi' directory. - A new dialog will appear - click Compile. - * Lazarus has now compiled the package and will keep track of - all the compiled units and paths. - * Now lets open a project. Select Project->Open Project and select - any project in the examples/gui directory. Select the *.lpi file. - * Now select Run->Build and Lazarus will compile the project for - you. The executable will be located in the same directory as the - source. The compiled units will be placed in the <project>/units - directory. - -When you create you own project, all you need to do is tell Lazarus to -associate the 'fpgui_package.lpk' with your project and it will automatically -find all the fpGUI compiled units and source for you. - - * Creating a new project. Select Project->New Project. Select - Program and click the Create button. - * Save the project in your preferred directory. - * Associate fpGUI with your project. Select Project->Project Inspector. - An new dialog will appear. Select Add then New Requirements. In the - Package Name combobox, select the 'fpgui_package' package and - click OK. - * You can now write your program and use any fpGUI units. Lazarus will - automatically include the paths to the fpGUI compiled units for you. - - - Building fpGUI from the Free Pascal Text IDE - ============================================ - -First you would need to setup the 'fp' IDE to find the related files. -As far as I understand the text mode IDE has it's own built-in compiler -so doesn't read the standard fpc.cfg file. - - * Run the text mode IDE from the command line: fp - * Navigate the menus to: Options|Directories and select the 'Units' - tab. - * Now enter the following directories replacing the relevant parts with - your actual paths. The example below is valid on my system only. - I was using FPC 2.2.0 under Linux and the X11 corelib backend. - - /opt/fpc_2.2.0/lib/fpc/2.2.0/units/i386-linux/* - /opt/fpc_2.2.0/lib/fpc/2.2.0/units/i386-linux/rtl - /home/graemeg/programming/fpGUI/src/corelib - /home/graemeg/programming/fpGUI/src/corelib/x11 - /home/graemeg/programming/fpGUI/src/gui - - * Now select the 'Include files' tab and enter the following paths. - Again change the paths to point to your actual directories and - X11 or GDI corelib backend. - - /home/graemeg/programming/fpGUI/src/corelib - /home/graemeg/programming/fpGUI/src/corelib/x11 - - * Now changes to 'Miscellaneous' tab, PPU output directory. Type in - the edit box: units - - NOTE: - This will place all the compiled *.ppu and *.o files into a 'units' - directory inside you current directory. So make sure you create it - before you try to compile for the first time. FPC doesn't create - directories for you! - - * Now you are ready to open your projects main program unit (F3) and - compiling it by pressing (F9). - - - Compiling any of the examples from the Command Line - =================================================== - -You need to compile fpGUI first as mentioned above! -Every project in the ../examples directory has it's own extrafpc.cfg file. -You only need to specify that config file and the project unit to compile -it. - -fpc @extrafpc.cfg <project unit> - -Example: - fpc @extrafpc.cfg docedit.lpr - - - - -Regards, - - Graeme - - - =========================================== - - - |