diff options
author | graemeg <graemeg@ae50a9b5-8222-0410-bf8d-8a13f76226bf> | 2007-07-18 12:30:52 +0000 |
---|---|---|
committer | graemeg <graemeg@ae50a9b5-8222-0410-bf8d-8a13f76226bf> | 2007-07-18 12:30:52 +0000 |
commit | 45b155cbdfd40f4b836c291867c1032d5e38c582 (patch) | |
tree | 1901a3e88e1759022bc5dc92a16d1689139cee13 /prototypes | |
parent | f2cc28aa00a57f237c7449b13a2d384e1e71299c (diff) | |
download | fpGUI-45b155cbdfd40f4b836c291867c1032d5e38c582.tar.xz |
* GDI: Fixed Canvas.DrawLine issues
* GDI: Fixed Canvas.DrawRectangle issues
* GDI: Improved the Canvas.SetLineStyle, though Pen and Brush
still needs improving.
Diffstat (limited to 'prototypes')
5 files changed, 60 insertions, 48 deletions
diff --git a/prototypes/fpgui2/examples/core/canvastest/fpgcanvas.lpi b/prototypes/fpgui2/examples/core/canvastest/fpgcanvas.lpi index 9c070422..c85685b5 100644 --- a/prototypes/fpgui2/examples/core/canvastest/fpgcanvas.lpi +++ b/prototypes/fpgui2/examples/core/canvastest/fpgcanvas.lpi @@ -1,7 +1,7 @@ <?xml version="1.0"?> <CONFIG> <ProjectOptions> - <PathDelim Value="/"/> + <PathDelim Value="\"/> <Version Value="5"/> <General> <Flags> @@ -9,7 +9,7 @@ </Flags> <SessionStorage Value="InProjectDir"/> <MainUnit Value="0"/> - <IconPath Value="./"/> + <IconPath Value=".\"/> <TargetFileExt Value=""/> <Title Value="fpcanvas"/> </General> @@ -18,13 +18,14 @@ </VersionInfo> <PublishOptions> <Version Value="2"/> + <DestinationDirectory Value="$(TestDir)\publishedproject\"/> <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/> </PublishOptions> <RunParams> <local> <FormatVersion Value="1"/> - <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/> + <LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/> </local> </RunParams> <RequiredPackages Count="1"> @@ -42,6 +43,7 @@ </ProjectOptions> <CompilerOptions> <Version Value="5"/> + <PathDelim Value="\"/> <CodeGeneration> <Generate Value="Faster"/> </CodeGeneration> diff --git a/prototypes/fpgui2/examples/core/canvastest/fpgcanvas.lpr b/prototypes/fpgui2/examples/core/canvastest/fpgcanvas.lpr index 42cb3ac5..0f6b560f 100644 --- a/prototypes/fpgui2/examples/core/canvastest/fpgcanvas.lpr +++ b/prototypes/fpgui2/examples/core/canvastest/fpgcanvas.lpr @@ -69,9 +69,13 @@ begin Canvas.DrawLine(5, 5, 50, 50); Canvas.SetColor(clBlue); Canvas.DrawLine(50, 5, 5, 50); - Canvas.SetColor(clRed); + { Diagonal line } Canvas.DrawLine(60, 5, 110, 55); + { Horizontal line } + Canvas.DrawLine(60, 3, 110, 3); + { Vertical line } + Canvas.DrawLine(58, 5, 58, 55); // Testing Text and Fonts diff --git a/prototypes/fpgui2/examples/core/imgtest/bitmaptest.lpi b/prototypes/fpgui2/examples/core/imgtest/bitmaptest.lpi index 7fefd31c..c8bf98e0 100644 --- a/prototypes/fpgui2/examples/core/imgtest/bitmaptest.lpi +++ b/prototypes/fpgui2/examples/core/imgtest/bitmaptest.lpi @@ -1,7 +1,7 @@ <?xml version="1.0"?> <CONFIG> <ProjectOptions> - <PathDelim Value="/"/> + <PathDelim Value="\"/> <Version Value="5"/> <General> <Flags> @@ -9,7 +9,7 @@ </Flags> <SessionStorage Value="InProjectDir"/> <MainUnit Value="0"/> - <IconPath Value="./"/> + <IconPath Value=".\"/> <TargetFileExt Value=""/> <Title Value="bitmaptest"/> </General> @@ -18,13 +18,14 @@ </VersionInfo> <PublishOptions> <Version Value="2"/> + <DestinationDirectory Value="$(TestDir)\publishedproject\"/> <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/> </PublishOptions> <RunParams> <local> <FormatVersion Value="1"/> - <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/> + <LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/> </local> </RunParams> <RequiredPackages Count="1"> @@ -42,9 +43,10 @@ </ProjectOptions> <CompilerOptions> <Version Value="5"/> + <PathDelim Value="\"/> <SearchPaths> - <IncludeFiles Value="../source/"/> - <OtherUnitFiles Value="../source/;../source/x11/;../gui/"/> + <IncludeFiles Value="..\source\"/> + <OtherUnitFiles Value="..\source\;..\source\x11\;..\gui\"/> </SearchPaths> <CodeGeneration> <Generate Value="Faster"/> diff --git a/prototypes/fpgui2/examples/gui/timertest/timertest.lpi b/prototypes/fpgui2/examples/gui/timertest/timertest.lpi index b3df5d3b..0dfae648 100644 --- a/prototypes/fpgui2/examples/gui/timertest/timertest.lpi +++ b/prototypes/fpgui2/examples/gui/timertest/timertest.lpi @@ -1,7 +1,7 @@ <?xml version="1.0"?> <CONFIG> <ProjectOptions> - <PathDelim Value="/"/> + <PathDelim Value="\"/> <Version Value="5"/> <General> <Flags> @@ -9,7 +9,7 @@ </Flags> <SessionStorage Value="InProjectDir"/> <MainUnit Value="0"/> - <IconPath Value="./"/> + <IconPath Value=".\"/> <TargetFileExt Value=""/> </General> <VersionInfo> @@ -23,7 +23,7 @@ <RunParams> <local> <FormatVersion Value="1"/> - <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/> + <LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/> </local> </RunParams> <RequiredPackages Count="1"> @@ -41,6 +41,7 @@ </ProjectOptions> <CompilerOptions> <Version Value="5"/> + <PathDelim Value="\"/> <CodeGeneration> <Generate Value="Faster"/> </CodeGeneration> diff --git a/prototypes/fpgui2/source/core/gdi/gfx_gdi.pas b/prototypes/fpgui2/source/core/gdi/gfx_gdi.pas index b4ec88fb..ba991fca 100644 --- a/prototypes/fpgui2/source/core/gdi/gfx_gdi.pas +++ b/prototypes/fpgui2/source/core/gdi/gfx_gdi.pas @@ -994,13 +994,13 @@ begin SetBkMode(Fgc, TRANSPARENT); FBrush := CreateSolidBrush(0); - FPen := CreatePen(PS_SOLID, 0, 0); + FPen := CreatePen(PS_SOLID, 0, 0); // defaults to black FClipRegion := CreateRectRgn(0, 0, 1, 1); - FColor := clText1; + FColor := fpgColorToWin(clText1); FLineStyle := lsSolid; FLineWidth := 0; - FBackgroundColor := clBoxColor; + FBackgroundColor := fpgColorToWin(clBoxColor); end; FDrawing := True; @@ -1068,26 +1068,17 @@ begin end; procedure TfpgCanvasImpl.DoDrawLine(x1, y1, x2, y2: TfpgCoord); -var - pts: array[1..2] of Windows.TPoint; begin - pts[1].X := x1; - pts[1].Y := y1; - pts[2].X := x2; - pts[2].Y := y2; - PolyLine(Fgc, pts, 2); - Windows.SetPixel(Fgc, x2, y2, FWindowsColor); + Windows.MoveToEx(Fgc, x1, y1, nil); + Windows.LineTo(Fgc, x2, y2); end; procedure TfpgCanvasImpl.DoDrawRectangle(x, y, w, h: TfpgCoord); -var - wr: Windows.TRect; begin - wr.Left := x; - wr.Top := y; - wr.Right := x + w; - wr.Bottom := y + h; - Windows.FrameRect(Fgc, wr, FBrush); + DoDrawLine(x, y, x+w-1, y); // top + DoDrawLine(x+w-1, y, x+w-1, y+h-1); // right + DoDrawLine(x, y+h-1, x+w-1, y+h-1); // bottom + DoDrawLine(x, y, x, y+h-1); // left end; procedure TfpgCanvasImpl.DoDrawString(x, y: TfpgCoord; const txt: string); @@ -1126,7 +1117,7 @@ begin pts[2].Y := y2; pts[3].X := x3; pts[3].Y := y3; - Polygon(Fgc, pts, 3); + Windows.Polygon(Fgc, pts, 3); end; function TfpgCanvasImpl.DoGetClipRect: TfpgRect; @@ -1155,19 +1146,27 @@ begin end; procedure TfpgCanvasImpl.DoSetColor(cl: TfpgColor); +var + newBrush, oldBrush: HBRUSH; + newPen, oldPen: HPEN; begin - DeleteObject(FBrush); - DeleteObject(FPen); - FWindowsColor := fpgColorToWin(cl); - FBrush := CreateSolidBrush(FWindowsColor); - FPen := CreatePen(FintLineStyle, FLineWidth, FWindowsColor); - SelectObject(Fgc, FBrush); - SelectObject(Fgc, FPen); + newBrush := CreateSolidBrush(FWindowsColor); + newPen := CreatePen(FintLineStyle, FLineWidth, FWindowsColor); + oldBrush := SelectObject(Fgc, newBrush); + oldPen := SelectObject(Fgc, newPen); + FBrush := newBrush; + FPen := newPen; + + DeleteObject(oldBrush); + DeleteObject(oldPen); end; procedure TfpgCanvasImpl.DoSetLineStyle(awidth: integer; astyle: TfpgLineStyle); +var + lw: integer; + lPen: HPEN; begin { Notes from MSDN: If the value specified by nWidth is greater than 1, the fnPenStyle parameter must be PS_NULL, PS_SOLID, or @@ -1176,26 +1175,30 @@ PS_INSIDEFRAME. } case AStyle of lsDot: begin - FintLineStyle := PS_DOT; - FLineWidth := 1; + FintLineStyle := PS_DOT; + lw := 1; end; lsDash: begin - FintLineStyle := PS_DASH; - FLineWidth := 1; + FintLineStyle := PS_DASH; + lw := 1; end; lsSolid: - FintLineStyle := PS_SOLID; + begin + FintLineStyle := PS_SOLID; + lw := FLineWidth; + end; else begin - FintLineStyle := PS_DOT; - FLineWidth := 1; + FintLineStyle := PS_SOLID; + lw := 1; end; end; - DeleteObject(FPen); - FPen := CreatePen(FintLineStyle, FLineWidth, FWindowsColor); - SelectObject(Fgc, FPen); + lPen := CreatePen(FintLineStyle, lw, FWindowsColor); + Windows.SelectObject(Fgc, lPen); + Windows.DeleteObject(FPen); + FPen := lPen; end; procedure TfpgCanvasImpl.DoSetTextColor(cl: TfpgColor); |