paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2026-01-04 04:00:44 +01:00
Code Issues Packages Projects Releases Wiki Activity

Fixes region applying for Gtk2 for TForm, implements CreateEllipticRgn in gtk2 and gives better parameter names to this routine

Browse Source 
git-svn-id: trunk@31817 -
This commit is contained in:
sekelsenmat 2011-07-28 12:17:07 +00:00
parent 117ae6777c
commit 1805877800
5 changed files with 63 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
lcl/include/intfbasewinapi.inc
View File

@ -136,7 +136,7 @@ begin
Result := 0;
end;
function TWidgetSet.CreateEllipticRgn(p1, p2, p3, p4: Integer): HRGN;
function TWidgetSet.CreateEllipticRgn(X1, Y1, X2, Y2: Integer): HRGN;
begin
Result:=ERROR;
DebugLn('WARNING: CreateEllipticRgn not yet implemented.');

4
lcl/include/winapi.inc
View File

@ -1092,9 +1092,9 @@ end;
{------------------------------------------------------------------------------
function CreateEllipticRgnIndirect(const ARect: TRect): HRGN;
------------------------------------------------------------------------------}
function CreateEllipticRgn(p1, p2, p3, p4: Integer): HRGN;
function CreateEllipticRgn(X1, Y1, X2, Y2: Integer): HRGN;
begin
Result := WidgetSet.CreateEllipticRgn(p1,p2,p3,p4);
Result := WidgetSet.CreateEllipticRgn(X1, Y1, X2, Y2);
end;
{------------------------------------------------------------------------------

2
lcl/include/winapih.inc
View File

@ -61,7 +61,7 @@ function CreateDIBitmap(DC: HDC; var InfoHeader: TBitmapInfoHeader;
wUsage: UINT): HBITMAP; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function CreateDIBSection(DC: HDC; const BitmapInfo: tagBitmapInfo; Usage: UINT;
var Bits: Pointer; SectionHandle: THandle; Offset: DWORD): HBITMAP; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function CreateEllipticRgn(p1, p2, p3, p4: Integer): HRGN; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function CreateEllipticRgn(X1, Y1, X2, Y2: Integer): HRGN; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
//function CreateEllipticRgnIndirect --> independent
//function CreateFont --> independent
function CreateFontIndirect(const LogFont: TLogFont): HFONT; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}

60
lcl/interfaces/gtk2/gtk2winapi.inc
View File

@ -1292,6 +1292,51 @@ begin
Result := True;
end;
{
Gtk2 has no function to build an elliptical region so we approximate it to a
polygon. Our Ellipse is axis-aligned, so it's parametrization is:
X(t) = Xc + a * cos(t)
Y(t) = Yc + b * sin(t)
(Xc,Yc) is the center of the ellipse
}
function TGtk2WidgetSet.CreateEllipticRgn(X1, Y1, X2, Y2: Integer): HRGN;
var
points: array of TGdkPoint;
n_points: Integer;
i, Xc, Yc, a, b: Integer;
t: Double;
GObject: PGdiObject;
RegionObj: PGdkRegion;
begin
a := (X2 - X1) div 2;
b := (Y2 - Y1) div 2;
Xc := X1 + a;
Yc := Y1 + b;
// Choose a large enough amount of points
n_points := Max(X2-X1,Y2-Y1) * 4;
SetLength(points, n_points);
// And fill them iterating through the ellipse
for i := 0 to n_points - 1 do
begin
t := (i / n_points) * 2 * Pi;
points[i].X := Round(Xc + a * cos(t));
points[i].Y := Round(Yc + b * sin(t));
end;
GObject := NewGDIObject(gdiRegion);
RegionObj := gdk2.gdk_region_polygon(@points[0], n_points, GDK_WINDING_RULE);
GObject^.GDIRegionObject := RegionObj;
Result := HRGN(PtrUInt(GObject));
// Free the allocated array
SetLength(points, 0);
//DebugLn('TGtk2WidgetSet.CreateRectRgn A ',GDKRegionAsString(RegionObj));
end;
{------------------------------------------------------------------------------
Function: CreateFontIndirect
Params: const LogFont: TLogFont
@ -8964,10 +9009,21 @@ var
Widget: PGtkWidget;
Window: PGdkWindow;
ShapeRegion: PGdkRegion;
LCLObject: TObject;
begin
Widget := GetFixedWidget(PGtkWidget(hWnd));
if Widget = nil then
// For normal widgets we should use GetFixedWidget,
// but for TForm we should apply the region in the raw hWnd
LCLObject := GetLCLObject(PGtkWidget(hWnd));
if (LCLObject <> nil) and (LCLObject is TCustomForm) then
begin
Widget := PGtkWidget(hWnd);
end
else
begin
Widget := GetFixedWidget(PGtkWidget(hWnd));
if Widget = nil then
Widget := PGtkWidget(hWnd);
end;
if Widget = nil then
Exit(0);
Window := GetControlWindow(Widget);

2
lcl/interfaces/gtk2/gtk2winapih.inc
View File

@ -62,7 +62,7 @@ function CreateBrushIndirect(const LogBrush: TLogBrush): HBRUSH; override;
function CreateCaret(Handle : HWND; Bitmap : hBitmap; width, Height : Integer) : Boolean; override;
function CreateCompatibleBitmap(DC: HDC; Width, Height: Integer): HBITMAP; override;
function CreateCompatibleDC(DC: HDC): HDC; override;
//function CreateEllipticRgn(p1, p2, p3, p4: Integer): HRGN; override;
function CreateEllipticRgn(X1, Y1, X2, Y2: Integer): HRGN; override;
function CreateFontIndirect(const LogFont: TLogFont): HFONT; override;
function CreateFontIndirectEx(const LogFont: TLogFont; const LongFontName: string): HFONT; override;
function CreateIconIndirect(IconInfo: PIconInfo): HICON; override;