paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-14 09:59:20 +02:00
Code Issues Packages Projects Releases Wiki Activity

IDE: added package option Provides - needed by KOL, gtk intf: reduced warnings, fixed wrong type cast calling gdk_text_extends (crashing Label.OptimalFill=true and miscalculation of width)

Browse Source 
git-svn-id: trunk@12080 -
This commit is contained in:
mattias 2007-09-19 17:58:52 +00:00
parent f40ff94387
commit 4f8d2a8022
24 changed files with 253 additions and 435 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
ide/lazarusidestrconsts.pas
View File

@ -2988,6 +2988,7 @@ resourcestring
lisPckOptsUsage = 'Usage'; lisPckOptsUsage = 'Usage';
lisPOChoosePoFileDirectory = 'Choose .po file directory'; lisPOChoosePoFileDirectory = 'Choose .po file directory';
lisPckOptsIDEIntegration = 'IDE Integration'; lisPckOptsIDEIntegration = 'IDE Integration';
lisPckOptsProvides = 'Provides';
lisPckOptsDescriptionAbstract = 'Description/Abstract'; lisPckOptsDescriptionAbstract = 'Description/Abstract';
lisPckOptsAuthor = 'Author:'; lisPckOptsAuthor = 'Author:';
lisPckOptsLicense = 'License:'; lisPckOptsLicense = 'License:';
@ -3409,6 +3410,8 @@ resourcestring
rsRemove = '&Remove'; rsRemove = '&Remove';
lisAutomaticallyOnLineBreak = 'automatically on line break'; lisAutomaticallyOnLineBreak = 'automatically on line break';
lisAutomaticallyOnSpace = 'automatically on space'; lisAutomaticallyOnSpace = 'automatically on space';
lisPckOptsThisPackageProvidesTheSameAsTheFollowingPackages = 'This package '
+'provides the same as the following packages:';
implementation implementation
end. end.

2
ide/main.pp
View File

@ -12934,6 +12934,8 @@ end;
procedure TMainIDE.OnPropHookAddDependency(const AClass: TClass; procedure TMainIDE.OnPropHookAddDependency(const AClass: TClass;
const AnUnitName: shortstring); const AnUnitName: shortstring);
// add a package dependency to the package/project of the currently active
// designed component.
var var
RequiredUnitName: String; RequiredUnitName: String;
AnUnitInfo: TUnitInfo; AnUnitInfo: TUnitInfo;

8
lcl/interfaces/gtk/gtkcallback.inc
View File

@ -330,7 +330,7 @@ begin
Mess.Minimized:=false; Mess.Minimized:=false;
Mess.ActiveWindow:=0; Mess.ActiveWindow:=0;
if GtkWidgetIsA(Widget, gtk_window_get_type) then if GtkWidgetIsA(Widget, gtk_window_get_type) then
Mess.ActiveWindow:=HWnd(PGTKWindow(Widget)^.focus_widget); Mess.ActiveWindow:=HWnd(PtrUInt(PGTKWindow(Widget)^.focus_widget));
Mess.Result := 0; Mess.Result := 0;
//DebugLn('gtkactivateCB ',DbgSName(TObject(Data))); //DebugLn('gtkactivateCB ',DbgSName(TObject(Data)));
DeliverMessage(Data, Mess); DeliverMessage(Data, Mess);
@ -637,7 +637,7 @@ begin
Mess.Minimized:=false; Mess.Minimized:=false;
Mess.ActiveWindow:=0; Mess.ActiveWindow:=0;
if GtkWidgetIsA(Widget, gtk_window_get_type) then if GtkWidgetIsA(Widget, gtk_window_get_type) then
Mess.ActiveWindow:=HWnd(PGTKWindow(Widget)^.focus_widget); Mess.ActiveWindow:=HWnd(PtrUInt(PGTKWindow(Widget)^.focus_widget));
Mess.Result := 0; Mess.Result := 0;
DeliverMessage(Data, Mess); // send message directly (not Post) DeliverMessage(Data, Mess); // send message directly (not Post)
@ -3067,7 +3067,7 @@ begin
if Pos < High(SmallPos) if Pos < High(SmallPos)
then SmallPos := Pos then SmallPos := Pos
else SmallPos := High(SmallPos); else SmallPos := High(SmallPos);
ScrollBar := HWND(Scroll); ScrollBar := HWND(PtrUInt(Scroll));
ScrollType := get_gtk_scroll_type(Scroll); ScrollType := get_gtk_scroll_type(Scroll);
ScrollCode := ScrollTypeToSbCode(False, ScrollType, ScrollCode := ScrollTypeToSbCode(False, ScrollType,
gtk_range_get_update_policy(Scroll)); gtk_range_get_update_policy(Scroll));
@ -3093,7 +3093,7 @@ begin
then SmallPos := Pos then SmallPos := Pos
else SmallPos := High(SmallPos); else SmallPos := High(SmallPos);
//DebugLn('GTKVScrollCB A Adjustment^.Value=',dbgs(Adjustment^.Value),' SmallPos=',dbgs(SmallPos)); //DebugLn('GTKVScrollCB A Adjustment^.Value=',dbgs(Adjustment^.Value),' SmallPos=',dbgs(SmallPos));
ScrollBar := HWND(Scroll); ScrollBar := HWND(PtrUInt(Scroll));
ScrollType := get_gtk_scroll_type(Scroll); ScrollType := get_gtk_scroll_type(Scroll);
// GTK1 has a bug with wheel mouse. It sometimes gives the wrong direction. // GTK1 has a bug with wheel mouse. It sometimes gives the wrong direction.
ScrollCode := ScrollTypeToSbCode(True, ScrollType, ScrollCode := ScrollTypeToSbCode(True, ScrollType,

2
lcl/interfaces/gtk/gtkfontcache.pas
View File

@ -135,6 +135,7 @@ begin
{$IFDEF Gtk1} {$IFDEF Gtk1}
gdk_font_ref(AFont); gdk_font_ref(AFont);
{$ELSE} {$ELSE}
//DebugLn(['ReferenceGtkIntfFont ',dbgs(AFont)]);
g_object_ref(AFont); g_object_ref(AFont);
{$ENDIF} {$ENDIF}
end; end;
@ -144,6 +145,7 @@ begin
{$IFDEF Gtk1} {$IFDEF Gtk1}
gdk_font_unref(AFont); gdk_font_unref(AFont);
{$ELSE} {$ELSE}
//DebugLn(['UnreferenceGtkIntfFont ',dbgs(AFont)]);
g_object_unref(AFont); g_object_unref(AFont);
{$ENDIF} {$ENDIF}
end; end;

6
lcl/interfaces/gtk/gtkint.pp
View File

@ -203,12 +203,6 @@ type
// images // images
procedure LoadPixbufFromLazResource(const ResourceName: string; procedure LoadPixbufFromLazResource(const ResourceName: string;
var Pixbuf: PGdkPixbuf); var Pixbuf: PGdkPixbuf);
{$note TODO: remove}
(*
procedure LoadFromXPMFile(Bitmap: TObject; Filename: PChar);virtual;
procedure LoadFromPixbufFile(Bitmap: TObject; Filename: PChar);virtual;
procedure LoadFromPixbufData(Bitmap : hBitmap; Data : PByte);virtual;
*)
function InternalGetDIBits(DC: HDC; Bitmap: HBitmap; StartScan, NumScans: UINT; function InternalGetDIBits(DC: HDC; Bitmap: HBitmap; StartScan, NumScans: UINT;
BitSize : Longint; Bits: Pointer; var BitInfo: BitmapInfo; Usage: UINT; DIB : Boolean): Integer;virtual; BitSize : Longint; Bits: Pointer; var BitInfo: BitmapInfo; Usage: UINT; DIB : Boolean): Integer;virtual;
function RawImage_DescriptionFromDrawable(out ADesc: TRawImageDescription; ADrawable: PGdkDrawable; ACustomAlpha: Boolean): boolean; function RawImage_DescriptionFromDrawable(out ADesc: TRawImageDescription; ADrawable: PGdkDrawable; ACustomAlpha: Boolean): boolean;

4
lcl/interfaces/gtk/gtklistsl.inc
View File

@ -108,12 +108,12 @@ begin
with Msg.DrawListItemStruct^ do begin with Msg.DrawListItemStruct^ do begin
ItemID:=ItemIndex; ItemID:=ItemIndex;
Area:=AreaRect; Area:=AreaRect;
DC:=GetDC(HWnd(Widget)); DC:=GetDC(HWnd(PtrUInt(Widget)));
ItemState:=State; ItemState:=State;
end; end;
//DebugLn('gtkListItemDrawAfterCB ',DbgSName(LCLList.Owner),' Widget=',DbgS(Widget)); //DebugLn('gtkListItemDrawAfterCB ',DbgSName(LCLList.Owner),' Widget=',DbgS(Widget));
Result := DeliverMessage(LCLList.Owner, Msg)=0; Result := DeliverMessage(LCLList.Owner, Msg)=0;
ReleaseDC(HWnd(Widget),Msg.DrawListItemStruct^.DC); ReleaseDC(HWnd(PtrUInt(Widget)),Msg.DrawListItemStruct^.DC);
finally finally
Dispose(Msg.DrawListItemStruct); Dispose(Msg.DrawListItemStruct);
end; end;

311
lcl/interfaces/gtk/gtkobject.inc
View File

@ -1671,240 +1671,6 @@ begin
Result:=true; Result:=true;
end; end;
{$note TODO: remove}
(*
procedure TGtkWidgetSet.LoadFromXPMFile(Bitmap: TObject; Filename: PChar);
var
GdiObject: PGdiObject;
GDKColor: TGDKColor;
Window: PGdkWindow;
ColorMap: PGdkColormap;
P: Pointer;
TheBitmap: TBitmap;
Width, Height, Depth : Longint;
begin
if not (Bitmap is TBitmap) then
RaiseGDBException('TGtkWidgetSet.LoadFromXPMFile Bitmap is not TBitmap: '
+Bitmap.ClassName);
TheBitmap:=TBitmap(Bitmap);
GdiObject := NewGDIObject(gdiBitmap);
if TheBitmap.TransparentColor<>clNone then begin
GDKColor := AllocGDKColor(ColorToRGB(TheBitmap.TransparentColor));
p := @GDKColor;
end else
p:=nil; // automatically create transparency mask
Window:=nil; // use the X root window for colormap
{$IFDEF DebugGDK}BeginGDKErrorTrap;{$ENDIF}
if Window<>nil then
ColorMap:=gdk_window_get_colormap(Window)
else
ColorMap:=gdk_colormap_get_system;
GdiObject^.GDIPixmapObject :=
gdk_pixmap_colormap_create_from_xpm(Window,Colormap,
GdiObject^.GDIBitmapMaskObject, p, Filename);
GdiObject^.GDIBitmapType:=gbPixmap;
gdk_drawable_get_size(GdiObject^.GDIPixmapObject,@Width, @Height);
Depth := gdk_drawable_get_depth(GdiObject^.GDIPixmapObject);
If GdiObject^.Visual <> nil then
GDK_Visual_UnRef(GdiObject^.Visual);
If GdiObject^.Colormap <> nil then
GDK_Colormap_UnRef(GdiObject^.Colormap);
GdiObject^.Visual := gdk_window_get_visual(GdiObject^.GDIpixmapObject);
If GdiObject^.Visual = nil then
GdiObject^.Visual := gdk_visual_get_best_with_depth(Depth)
else
gdk_visual_ref(GdiObject^.Visual);
GdiObject^.Colormap := gdk_colormap_new(GdiObject^.Visual, GdkTrue);
{$IFDEF DebugGDK}EndGDKErrorTrap;{$ENDIF}
TheBitmap.Handle := HBITMAP(GdiObject);
If GdiObject^.GDIBitmapMaskObject <> nil then
TheBitmap.Transparent := True
else
TheBitmap.Transparent := False;
end;
procedure TGtkWidgetSet.LoadFromPixbufFile(Bitmap: TObject; Filename: PChar);
var
TheBitmap: TBitmap;
function LoadFile: Boolean;
var
Src : PGDKPixbuf;
Tmp : hBitmap;
Width, Height,
Depth : Longint;
begin
Result := False;
SRC := nil;
{$IFDEF VerboseGdkPixbuf}
debugln('TGtkWidgetSet.LoadFromPixbufFile A1');
{$ENDIF}
SRC := gdk_pixbuf_new_from_file(FileName{$IFDEF Gtk2},nil{$ENDIF});
{$IFDEF VerboseGdkPixbuf}
debugln('TGtkWidgetSet.LoadFromPixbufFile A2');
{$ENDIF}
If SRC = nil then
exit;
Width := gdk_pixbuf_get_width(Src);
Height := gdk_pixbuf_get_height(Src);
TMP := CreateCompatibleBitmap(0, Width, Height);
{$IFDEF VerboseGdkPixbuf}
debugln('TGtkWidgetSet.LoadFromPixbufFile B1');
{$ENDIF}
gdk_pixbuf_render_pixmap_and_mask(Src,
PGDIObject(TMP)^.GDIPixmapObject,
PGDIObject(TMP)^.GDIBitmapMaskObject,
0);
{$IFDEF VerboseGdkPixbuf}
debugln('TGtkWidgetSet.LoadFromPixbufFile B2');
{$ENDIF}
{$IFDEF DebugGDK}BeginGDKErrorTrap;{$ENDIF}
Depth := gdk_drawable_get_depth(PGDIObject(TMP)^.GDIPixmapObject);
If PGDIObject(TMP)^.Visual <> nil then
GDK_Visual_UnRef(PGDIObject(TMP)^.Visual);
PGDIObject(TMP)^.Visual := gdk_window_get_visual(PGDIObject(TMP)^.GDIPixmapObject);
If PGDIObject(TMP)^.Visual = nil then
PGDIObject(TMP)^.Visual := gdk_visual_get_best_with_depth(Depth)
else
GDK_Visual_Ref(PGDIObject(TMP)^.Visual);
If PGDIObject(TMP)^.Colormap <> nil then
GDK_Colormap_UnRef(PGDIObject(TMP)^.Colormap);
PGDIObject(TMP)^.Colormap :=
gdk_colormap_new(PGDIObject(TMP)^.Visual, GdkTrue);
{$IFDEF DebugGDK}EndGDKErrorTrap;{$ENDIF}
TheBitmap.Handle := TMP;
GDK_Pixbuf_Unref(Src);
Result := True;
end;
begin
if not (Bitmap is TBitmap) then
RaiseGDBException('TGtkWidgetSet.LoadFromPixbufFile Bitmap is not TBitmap: '
+Bitmap.ClassName);
TheBitmap:=TBitmap(Bitmap);
if not LoadFile then
DebugLn('WARNING: [TGtkWidgetSet.LoadFromPixbufFile] loading file FAILED!');
end;
procedure TGtkWidgetSet.LoadFromPixbufData(Bitmap : hBitmap; Data : PByte);
type
TBitmapHeader = packed record
FileHeader : tagBitmapFileHeader;
InfoHeader : tagBitmapInfoHeader;
end;
procedure FillBitmapInfo(Bitmap : hBitmap; var Header : TBitmapHeader);
var
DIB : TDIBSection;
BitmapHeader : TagBITMAPINFO;
begin
FillChar(DIB, SizeOf(DIB), 0);
GetObject(Bitmap, SizeOf(DIB), @DIB);
BitmapHeader.bmiHeader := DIB.dsbmih;
with Header, Header.FileHeader, Header.InfoHeader do
begin
InfoHeader := BitmapHeader.bmiHeader;
FillChar(FileHeader, sizeof(FileHeader), 0);
bfType := $4D42;
bfSize := SizeOf(Header) + biSizeImage;
bfOffBits := SizeOf(Header);
end;
end;
function LoadData : Boolean;
var
Loader : PGdkPixbufLoader;
Src : PGDKPixbuf;
BMPInfo : TBitmapHeader;
begin
Result := False;
FillBitmapInfo(Bitmap, BMPInfo);
Loader := gdk_pixbuf_loader_new;
If Loader = nil then
exit;
SRC := nil;
If gdk_pixbuf_loader_write(Loader, TGdkPixBufBuffer(@BMPInfo),
SizeOf(BMPInfo) div SizeOf(Char){$IFDEF Gtk2},nil{$ENDIF})
then begin
If gdk_pixbuf_loader_write(Loader, TGdkPixBufBuffer(Data),
BMPInfo.InfoHeader.biSizeImage{$IFDEF Gtk2},nil{$ENDIF}) then
begin
SRC := gdk_pixbuf_loader_get_pixbuf(loader);
if Src=nil then
DebugLn('WARNING: [TGtkWidgetSet.LoadFromPixbufData] Error occured loading Pixbuf!');
end
else
DebugLn('WARNING: [TGtkWidgetSet.LoadFromPixbufData] Error occured loading Image!');
end
else
DebugLn('WARNING: [TGtkWidgetSet.LoadFromPixbufData] Error occured loading Bitmap Header!');
gdk_pixbuf_loader_close(Loader{$IFDEF Gtk2},nil{$ENDIF});
If SRC = nil then
exit;
With PGDIObject(Bitmap)^ do begin
{$IFDEF DebugGDK}BeginGDKErrorTrap;{$ENDIF}
{$IFDEF VerboseGdkPixbuf}
debugln('TGtkWidgetSet.LoadFromPixbufData A1');
{$ENDIF}
gdk_pixbuf_render_pixmap_and_mask(Src,
GDIPixmapObject,
GDIBitmapMaskObject,
0);
{$IFDEF VerboseGdkPixbuf}
debugln('TGtkWidgetSet.LoadFromPixbufData A2');
{$ENDIF}
Depth := gdk_drawable_get_depth(GDIPixmapObject);
If Visual <> nil then
GDK_Visual_UnRef(Visual);
Visual := gdk_window_get_visual(GDIPixmapObject);
If Visual = nil then
Visual := gdk_visual_get_best_with_depth(Depth)
else
GDK_Visual_Ref(Visual);
If Colormap <> nil then
GDK_Colormap_UnRef(Colormap);
Colormap := gdk_colormap_new(Visual, GdkTrue);
{$IFDEF DebugGDK}EndGDKErrorTrap;{$ENDIF}
GDK_Pixbuf_Unref(Src);
end;
Result := True;
end;
begin
if not LoadData then
DebugLn('WARNING: [TGtkWidgetSet.LoadFromPixbufData] loading data FAILED!');
end;
*)
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
function TGtkWidgetSet.InternalGetDIBits(DC: HDC; Bitmap: HBitmap; function TGtkWidgetSet.InternalGetDIBits(DC: HDC; Bitmap: HBitmap;
StartScan, NumScans: UINT; StartScan, NumScans: UINT;
@ -2033,7 +1799,7 @@ begin
BitSize := longint(SizeOf(Byte)) BitSize := longint(SizeOf(Byte))
*(longint(biSizeImage) div biHeight) *(longint(biSizeImage) div biHeight)
*longint(NumScans + StartScan); *longint(NumScans + StartScan);
if MemSize(Bits) < BitSize if MemSize(Bits) < PtrUInt(BitSize)
then begin then begin
DebugLn('WARNING: [TGtkWidgetSet.InternalGetDIBits] not enough memory allocated for Bits!'); DebugLn('WARNING: [TGtkWidgetSet.InternalGetDIBits] not enough memory allocated for Bits!');
exit; exit;
@ -2075,7 +1841,7 @@ begin
if DIB if DIB
then dec(y) then dec(y)
else inc(y); else inc(y);
until (Y < 0) or (y >= NumScans); until (Y < 0) or (y >= longint(NumScans));
16: repeat 16: repeat
for X := 0 to biwidth - 1 do for X := 0 to biwidth - 1 do
@ -2093,7 +1859,7 @@ begin
if DIB if DIB
then dec(y) then dec(y)
else inc(y); else inc(y);
until (Y < 0) or (y >= NumScans); until (Y < 0) or (y >= longint(NumScans));
end; end;
end; end;
@ -2178,7 +1944,7 @@ begin
case Visual^.thetype of case Visual^.thetype of
GDK_VISUAL_STATIC_GRAY: ADesc.Format:=ricfGray; GDK_VISUAL_STATIC_GRAY: ADesc.Format:=ricfGray;
GDK_VISUAL_GRAYSCALE: ADesc.Format:=ricfGray; GDK_VISUAL_GRAYSCALE: ADesc.Format:=ricfGray;
GDK_VISUAL_STATIC_COLOR: ADesc.Format:=ricfGray; {$note shouldn't this be ricfRGBA ?} GDK_VISUAL_STATIC_COLOR: ADesc.Format:=ricfGray; // this is not really gray, but an index in a color map, but colormaps are not supported yet, so use gray
GDK_VISUAL_PSEUDO_COLOR: ADesc.Format:=ricfGray; GDK_VISUAL_PSEUDO_COLOR: ADesc.Format:=ricfGray;
GDK_VISUAL_TRUE_COLOR: ADesc.Format:=ricfRGBA; GDK_VISUAL_TRUE_COLOR: ADesc.Format:=ricfRGBA;
GDK_VISUAL_DIRECT_COLOR: ADesc.Format:=ricfRGBA; GDK_VISUAL_DIRECT_COLOR: ADesc.Format:=ricfRGBA;
@ -2311,7 +2077,7 @@ var
Pixbuf := gdk_pixbuf_get_from_drawable(Pixbuf, ADrawable, gdk_colormap_get_system, ARect.Left, ARect.Top, 0, 0, ADesc.Width, ADesc.Height); Pixbuf := gdk_pixbuf_get_from_drawable(Pixbuf, ADrawable, gdk_colormap_get_system, ARect.Left, ARect.Top, 0, 0, ADesc.Width, ADesc.Height);
pixels := gdk_pixbuf_get_pixels(Pixbuf); pixels := gdk_pixbuf_get_pixels(Pixbuf);
ARawImage.DataSize := gdk_pixbuf_get_rowstride(Pixbuf) * ADesc.Height; ARawImage.DataSize := PtrUInt(gdk_pixbuf_get_rowstride(Pixbuf)) * PtrUInt(ADesc.Height);
ReAllocMem(ARawImage.Data, ARawImage.DataSize); ReAllocMem(ARawImage.Data, ARawImage.DataSize);
if ARawImage.DataSize > 0 then if ARawImage.DataSize > 0 then
System.Move(pixels^, ARawImage.Data^, ARawImage.DataSize); System.Move(pixels^, ARawImage.Data^, ARawImage.DataSize);
@ -2346,7 +2112,7 @@ var
RaiseGDBException('NewRawImage.Description.BitsPerPixel<>AnImage^.bpp'); RaiseGDBException('NewRawImage.Description.BitsPerPixel<>AnImage^.bpp');
{$endif} {$endif}
ARawImage.DataSize := PtrUInt(Image^.bpl) * Image^.Height; ARawImage.DataSize := PtrUInt(Image^.bpl) * PtrUInt(Image^.Height);
{$IFDEF VerboseRawImage} {$IFDEF VerboseRawImage}
DebugLn('TGtkWidgetSet.RawImage_FromDrawable: G Width=',dbgs(Image^.Width),' Height=',dbgs(Image^.Height), DebugLn('TGtkWidgetSet.RawImage_FromDrawable: G Width=',dbgs(Image^.Width),' Height=',dbgs(Image^.Height),
' BitsPerPixel=',dbgs(ADesc.BitsPerPixel),' bpl=',dbgs(Image^.bpl)); ' BitsPerPixel=',dbgs(ADesc.BitsPerPixel),' bpl=',dbgs(Image^.bpl));
@ -2545,7 +2311,7 @@ begin
Exit; Exit;
end; end;
if (W < ARect.Right) or (H < ARect.Bottom) if (longint(W) < ARect.Right) or (longint(H) < ARect.Bottom)
then begin then begin
DebugLn('WARNING: TGTKWidgetSet.RawImage_SetAlpha: Rect(%d,%d %d,%d) outside alpha pixmap(0,0 %d,%d)', [ARect.Left, ARect.Top, ARect.Right, ARect.Bottom, W, H]); DebugLn('WARNING: TGTKWidgetSet.RawImage_SetAlpha: Rect(%d,%d %d,%d) outside alpha pixmap(0,0 %d,%d)', [ARect.Left, ARect.Top, ARect.Right, ARect.Bottom, W, H]);
Exit; Exit;
@ -2605,7 +2371,7 @@ function TGTKWidgetSet.RawImage_AddMask(var ARawImage: TRawImage; AMask: PGdkBit
// ARect must have the same dimension as the rawimage // ARect must have the same dimension as the rawimage
var var
ADesc: TRawImageDescription absolute ARawImage.Description; ADesc: TRawImageDescription absolute ARawImage.Description;
Width, Height, H: cardinal; Width, Height, H: longint;
Image: PGdkImage; Image: PGdkImage;
BytesPerLine: Integer; BytesPerLine: Integer;
SrcPtr, DstPtr: PByte; SrcPtr, DstPtr: PByte;
@ -2635,7 +2401,7 @@ begin
R.Right := R.Left + Width; R.Right := R.Left + Width;
R.Bottom := R.Top + Height; R.Bottom := R.Top + Height;
if Width <> ADesc.Width if cardinal(Width) <> ADesc.Width
then begin then begin
{$ifdef RawimageConsistencyChecks} {$ifdef RawimageConsistencyChecks}
RaiseGDBException('TGTKWidgetSet.RawImage_AddMask: Width <> RawImage.Description.Width'); RaiseGDBException('TGTKWidgetSet.RawImage_AddMask: Width <> RawImage.Description.Width');
@ -2645,7 +2411,7 @@ begin
Exit; Exit;
end; end;
if Height <> ADesc.Height if cardinal(Height) <> ADesc.Height
then begin then begin
{$ifdef RawimageConsistencyChecks} {$ifdef RawimageConsistencyChecks}
RaiseGDBException('TGTKWidgetSet.RawImage_AddMask: Height <> RawImage.Description.Height'); RaiseGDBException('TGTKWidgetSet.RawImage_AddMask: Height <> RawImage.Description.Height');
@ -2675,7 +2441,7 @@ begin
ADesc.MaskBitsPerPixel := GetGdkImageBitsPerPixel(Image); ADesc.MaskBitsPerPixel := GetGdkImageBitsPerPixel(Image);
ADesc.MaskLineEnd := rileByteBoundary;// gdk_bitmap_create_from_data expects rileByteBoundary ADesc.MaskLineEnd := rileByteBoundary;// gdk_bitmap_create_from_data expects rileByteBoundary
BytesPerLine := GetBytesPerLine(ADesc.Width, ADesc.MaskBitsPerPixel, ADesc.MaskLineEnd); BytesPerLine := GetBytesPerLine(ADesc.Width, ADesc.MaskBitsPerPixel, ADesc.MaskLineEnd);
ARawImage.MaskSize := PtrUInt(BytesPerLine) * Height; ARawImage.MaskSize := PtrUInt(BytesPerLine) * PtrUInt(Height);
ReAllocMem(ARawImage.Mask, ARawImage.MaskSize); ReAllocMem(ARawImage.Mask, ARawImage.MaskSize);
if ARawImage.MaskSize > 0 if ARawImage.MaskSize > 0
@ -2896,7 +2662,7 @@ var
end; end;
SrcPixmap := SrcGDIBitmap^.GDIPixmapObject.Image; SrcPixmap := SrcGDIBitmap^.GDIPixmapObject.Image;
MskBitmap := CreateGdkMaskBitmap(HBITMAP(SrcGDIBitmap), Mask); MskBitmap := CreateGdkMaskBitmap(HBITMAP(PtrUInt(SrcGDIBitmap)), Mask);
{$IFDEF VerboseStretchCopyArea} {$IFDEF VerboseStretchCopyArea}
DebugLn('SrcDevBitmapToDrawable SrcPixmap=[',GetWindowDebugReport(SrcPixmap),']', DebugLn('SrcDevBitmapToDrawable SrcPixmap=[',GetWindowDebugReport(SrcPixmap),']',
@ -4016,7 +3782,7 @@ var
NoteBookWidget: PGtkNotebook; NoteBookWidget: PGtkNotebook;
GtkWindow: PGtkWidget; GtkWindow: PGtkWidget;
begin begin
Handle := hwnd(ObjectToGtkObject(Sender)); Handle := HWnd(PtrUInt(ObjectToGtkObject(Sender)));
if Handle=0 then exit; if Handle=0 then exit;
Widget:=PGtkWidget(Handle); Widget:=PGtkWidget(Handle);
if WidgetIsDestroyingHandle(Widget) then exit; if WidgetIsDestroyingHandle(Widget) then exit;
@ -4142,7 +3908,7 @@ begin
// update caret // update caret
if GtkWidgetIsA(Widget,GTKAPIWidget_GetType) then if GtkWidgetIsA(Widget,GTKAPIWidget_GetType) then
DestroyCaret(HDC(Widget)); DestroyCaret(HDC(PtrUInt(Widget)));
// remove pending size messages // remove pending size messages
UnsetResizeRequest(Widget); UnsetResizeRequest(Widget);
@ -4798,20 +4564,20 @@ begin
// however lazarus fails to start, so I'm enabling it for now // however lazarus fails to start, so I'm enabling it for now
if (ALCLObject is TWinControl) then if (ALCLObject is TWinControl) then
begin begin
TWinControl(ALCLObject).Handle := THandle(AGTKObject); TWinControl(ALCLObject).Handle := THandle(PtrUInt(AGTKObject));
if AGTKObject <> nil then begin if AGTKObject <> nil then begin
gtk_object_set_data(AGTKObject, 'Sender', ALCLObject); gtk_object_set_data(AGTKObject, 'Sender', ALCLObject);
end; end;
end end
else else
if (ALCLObject is TMenuItem) then if (ALCLObject is TMenuItem) then
TMenuItem(ALCLObject).Handle := HMenu(AGTKObject) TMenuItem(ALCLObject).Handle := HMenu(PtrUInt(AGTKObject))
else else
if (ALCLObject is TMenu) then if (ALCLObject is TMenu) then
TMenu(ALCLObject).Items.Handle := HMenu(AGTKObject) TMenu(ALCLObject).Items.Handle := HMenu(PtrUInt(AGTKObject))
else else
if (ALCLObject is TCommonDialog) then if (ALCLObject is TCommonDialog) then
TCommonDialog(ALCLObject).Handle:= THandle(AGTKObject); TCommonDialog(ALCLObject).Handle:= THandle(PtrUInt(AGTKObject));
Set_RC_Name(ALCLObject, AGTKObject); Set_RC_Name(ALCLObject, AGTKObject);
@ -5004,7 +4770,7 @@ begin
CursorValue := -1; CursorValue := -1;
end; end;
if CursorValue <> -1 then if CursorValue <> -1 then
Result := hCursor(gdk_cursor_new(CursorValue)); Result := hCursor(PtrUInt(gdk_cursor_new(CursorValue)));
end; end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
@ -5448,7 +5214,7 @@ begin
{$IFDEF DebugLCLComponents} {$IFDEF DebugLCLComponents}
DebugGtkWidgets.MarkCreated(P,dbgsName(Sender)); DebugGtkWidgets.MarkCreated(P,dbgsName(Sender));
{$ENDIF} {$ENDIF}
Result := THandle(P); Result := THandle(PtrUInt(P));
end; end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
@ -5855,32 +5621,14 @@ end;
Params: GDIObject: a (LCL) gdiObject Params: GDIObject: a (LCL) gdiObject
Returns: True if valid Returns: True if valid
Checks if the given GDIObject is valid Checks if the given GDIObject is valid (e.g. known to the gtk interface).
This is a quick consistency check to avoid working with dangling pointers.
------------------------------------------------------------------------------} ------------------------------------------------------------------------------}
function TGtkWidgetSet.IsValidGDIObject(const AGDIObj: HGDIOBJ): Boolean; function TGtkWidgetSet.IsValidGDIObject(const AGDIObj: HGDIOBJ): Boolean;
var var
GdiObject: PGdiObject absolute AGDIObj; GdiObject: PGdiObject absolute AGDIObj;
begin begin
Result := (AGDIObj <> 0) and FGDIObjects.Contains(GDIObject); Result := (AGDIObj <> 0) and FGDIObjects.Contains(GDIObject);
if not Result then Exit;
{$note TODO: create objects if required}
case GDIObject^.GDIType of
gdiBitmap : begin
case GDIObject^.GDIBitmapType of
gbBitmap: Result := GDIObject^.GDIBitmapObject <> nil;
gbPixmap: Result := GDIObject^.GDIPixmapObject.Image <> nil;
else
Result := False;
end;
end;
gdiBrush : Result := True;
gdiFont : Result := GDIObject^.GDIFontObject <> nil;// ToDo: create font on demand
gdiPen : Result := True;
gdiRegion : Result := True;
else
Result := False;
end;
end; end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
@ -6223,15 +5971,18 @@ begin
{$ELSE} {$ELSE}
if DC.DCWidget<>nil then begin if DC.DCWidget<>nil then begin
ClientWidget:=GetFixedWidget(DC.DCWidget); ClientWidget:=GetFixedWidget(DC.DCWidget);
//DebugLn(['TGTKWidgetSet.OnCreateFontForDC ClientWidget=',GetWidgetDebugReport(ClientWidget)]);
DC.CurrentFont:=NewGDIObject(gdiFont); DC.CurrentFont:=NewGDIObject(gdiFont);
DC.CurrentFont^.GDIFontObject:= DC.CurrentFont^.GDIFontObject:=
gtk_widget_create_pango_layout(ClientWidget,nil); gtk_widget_create_pango_layout(ClientWidget,nil);
if FontCache.FindGTKFont(GetGtkFont(DC))<>nil then
RaiseGDBException('inconsistency: font already in cache, maybe freed, but not removed from cache');
FontCache.AddWithoutName(DC.CurrentFont^.GDIFontObject); FontCache.AddWithoutName(DC.CurrentFont^.GDIFontObject);
if FontCache.FindGTKFont(GetGtkFont(DC))=nil then if FontCache.FindGTKFont(GetGtkFont(DC))=nil then
RaiseGDBException(''); RaiseGDBException('inconsistency: font added to cache, but can not be found');
end else end else
DC.CurrentFont:=CreateDefaultFont; DC.CurrentFont:=CreateDefaultFont;
//DebugLn(['TGTKWidgetSet.OnCreateFontForDC DC=',dbghex(PtrInt(DC)),' Font=',dbghex(PtrInt(DC.CurrentFont))]); //DebugLn(['TGTKWidgetSet.OnCreateFontForDC DC=',dbghex(PtrInt(DC)),' Font=',dbghex(PtrInt(DC.CurrentFont)),' DC.DCWidget=',GetWidgetDebugReport(DC.DCWidget)]);
{$ENDIF} {$ENDIF}
DC.OwnedGDIObjects[gdiFont]:=DC.CurrentFont; DC.OwnedGDIObjects[gdiFont]:=DC.CurrentFont;
end; end;
@ -6684,7 +6435,7 @@ var
begin begin
GDIObject := NewGDIObject(gdiRegion); GDIObject := NewGDIObject(gdiRegion);
GDIObject^.GDIRegionObject:=gdk_region_copy(PGdiObject(SrcRGN)^.GDIRegionObject); GDIObject^.GDIRegionObject:=gdk_region_copy(PGdiObject(SrcRGN)^.GDIRegionObject);
Result := hRgn(GDIObject); Result := hRgn(PtrUInt(GDIObject));
end; end;
function TGtkWidgetSet.DCClipRegionValid(DC: HDC): boolean; function TGtkWidgetSet.DCClipRegionValid(DC: HDC): boolean;
@ -6693,7 +6444,7 @@ var
begin begin
Result:=false; Result:=false;
if not IsValidDC(DC) then exit; if not IsValidDC(DC) then exit;
CurClipRegion:=HRGN(TDeviceContext(DC).ClipRegion); CurClipRegion:=HRGN(PtrUInt(TDeviceContext(DC).ClipRegion));
if (CurClipRegion<>0) and (not IsValidGDIObject(CurClipRegion)) then exit; if (CurClipRegion<>0) and (not IsValidGDIObject(CurClipRegion)) then exit;
Result:=true; Result:=true;
end; end;
@ -6704,7 +6455,7 @@ var
begin begin
GObject := NewGDIObject(gdiRegion); GObject := NewGDIObject(gdiRegion);
GObject^.GDIRegionObject := gdk_region_new; GObject^.GDIRegionObject := gdk_region_new;
Result := HRGN(GObject); Result := HRGN(PtrUInt(GObject));
//DebugLn('TGtkWidgetSet.CreateEmptyRgn A RGN=',DbgS(Result)); //DebugLn('TGtkWidgetSet.CreateEmptyRgn A RGN=',DbgS(Result));
end; end;
@ -6897,7 +6648,7 @@ end;
procedure TGtkWidgetSet.WordWrap(DC: HDC; AText: PChar; procedure TGtkWidgetSet.WordWrap(DC: HDC; AText: PChar;
MaxWidthInPixel: integer; var Lines: PPChar; var LineCount: integer); MaxWidthInPixel: integer; var Lines: PPChar; var LineCount: integer);
var var
UseFont : TGtkIntfFont; UseFont: TGtkIntfFont;
function GetLineWidthInPixel(LineStart, LineLen: integer): integer; function GetLineWidthInPixel(LineStart, LineLen: integer): integer;
var var

114
lcl/interfaces/gtk/gtkproc.inc
View File

@ -210,46 +210,20 @@ begin
GDK2.gdk_region_xor(result, source2); GDK2.gdk_region_xor(result, source2);
end; end;
Procedure gdk_text_extents(FontDesc: PPangoFontDescription; Procedure gdk_text_extents(TheFont: TGtkIntfFont;
Str: PChar; StrLength: integer; Str: PChar; StrLength: integer;
lbearing, rbearing, width, ascent, descent: Pgint); lbearing, rbearing, width, ascent, descent: Pgint);
var var
Layout : PPangoLayout; Layout : PPangoLayout;
AttrList : PPangoAttrList;
Attr : PPangoAttribute;
Extents : TPangoRectangle; Extents : TPangoRectangle;
AttrListAllocated: Boolean;
begin begin
//DebugLn(['gdk_text_extents Str="',Str,'" StrLength=',StrLength,' lbearing=',lbearing<>nil,' rbearing=',rbearing<>Nil,' width=',width<>nil,' ascent=',ascent<>nil,' descent=',descent<>Nil,' ',FontDesc<>Nil]); //DebugLn(['gdk_text_extents Str="',Str,'" StrLength=',StrLength,' lbearing=',lbearing<>nil,' rbearing=',rbearing<>Nil,' width=',width<>nil,' ascent=',ascent<>nil,' descent=',descent<>Nil,' ',TheFont<>Nil]);
GetStyle(lgsDefault); Layout:=TheFont;
Layout := gtk_widget_create_pango_layout (GetStyleWidget(lgsDefault), nil);
pango_layout_set_font_description(Layout, FontDesc);
AttrList := pango_layout_get_attributes(Layout);
AttrListAllocated:=false;
if (AttrList = nil) then begin
AttrList := pango_attr_list_new();
AttrListAllocated:=true;
end;
Attr := pango_attr_underline_new(PANGO_UNDERLINE_NONE);
pango_attr_list_change(AttrList,Attr);
Attr := pango_attr_strikethrough_new(False);
pango_attr_list_change(AttrList,Attr);
pango_layout_set_attributes(Layout, AttrList);
pango_layout_set_single_paragraph_mode(Layout, TRUE); pango_layout_set_single_paragraph_mode(Layout, TRUE);
pango_layout_set_width(Layout, -1); pango_layout_set_width(Layout, -1);
pango_layout_set_alignment(Layout, PANGO_ALIGN_LEFT);
pango_layout_set_text(Layout, Str, StrLength); pango_layout_set_text(Layout, Str, StrLength);
if Assigned(width) then if Assigned(width) then
pango_layout_get_pixel_size(Layout, width, nil); pango_layout_get_pixel_size(Layout, width, nil);
if Assigned(lbearing) or Assigned(rbearing) if Assigned(lbearing) or Assigned(rbearing)
or Assigned(ascent) or Assigned(descent) then begin or Assigned(ascent) or Assigned(descent) then begin
pango_layout_get_extents(Layout, nil, @Extents); pango_layout_get_extents(Layout, nil, @Extents);
@ -266,10 +240,6 @@ begin
if Assigned(descent) then if Assigned(descent) then
descent^ := PANGO_DESCENT(extents) div PANGO_SCALE; descent^ := PANGO_DESCENT(extents) div PANGO_SCALE;
end; end;
if AttrListAllocated then
pango_attr_list_unref(AttrList);
g_object_unref(Layout);
end; end;
{$EndIf Gtk2} {$EndIf Gtk2}
@ -986,7 +956,7 @@ begin
else else
PS^.rcPaint := GtkPaintMsg.Data.Rect; PS^.rcPaint := GtkPaintMsg.Data.Rect;
Result.DC:=BeginPaint(THandle(Widget), PS^); Result.DC:=BeginPaint(THandle(PtrUInt(Widget)), PS^);
Result.PaintStruct:=PS; Result.PaintStruct:=PS;
Result.Result:=0; Result.Result:=0;
if FreeGtkPaintMsg then if FreeGtkPaintMsg then
@ -1005,7 +975,7 @@ begin
DC := TDeviceContext(Msg^.WParam) DC := TDeviceContext(Msg^.WParam)
else else
DC := TDeviceContext(PS^.hdc); DC := TDeviceContext(PS^.hdc);
EndPaint(THandle(DC.DCWidget), PS^); EndPaint(THandle(PtrUInt(DC.DCWidget)), PS^);
Dispose(PS); Dispose(PS);
Msg^.LParam:=0; Msg^.LParam:=0;
Msg^.WParam:=0; Msg^.WParam:=0;
@ -1032,7 +1002,7 @@ begin
DC := TDeviceContext(Msg^.WParam) DC := TDeviceContext(Msg^.WParam)
else else
DC := TDeviceContext(PS^.hdc); DC := TDeviceContext(PS^.hdc);
EndPaint(THandle(DC.DCWidget), PS^); EndPaint(THandle(PtrUInt(DC.DCWidget)), PS^);
Dispose(PS); Dispose(PS);
Msg^.LParam:=0; Msg^.LParam:=0;
Msg^.WParam:=0; Msg^.WParam:=0;
@ -1344,7 +1314,7 @@ begin
DestLeft:=DestWidget^.allocation.x+((WindowWidth-ImageWidth) div 2); DestLeft:=DestWidget^.allocation.x+((WindowWidth-ImageWidth) div 2);
if CenterVertically then if CenterVertically then
DestTop:=DestWidget^.allocation.y+((WindowHeight-ImageHeight) div 2); DestTop:=DestWidget^.allocation.y+((WindowHeight-ImageHeight) div 2);
DestDC:=GetDC(HDC(DestWidget)); DestDC:=GetDC(HDC(PtrUInt(DestWidget)));
//DebugLn('DrawImageListIconOnWidget B DestXY=',DestLeft,',',DestTop, //DebugLn('DrawImageListIconOnWidget B DestXY=',DestLeft,',',DestTop,
// ' DestWindowSize=',WindowWidth,',',WindowWidth, // ' DestWindowSize=',WindowWidth,',',WindowWidth,
@ -1352,7 +1322,7 @@ begin
StretchBlt(DestDC, DestLeft, DestTop, ImageWidth, ImageHeight, StretchBlt(DestDC, DestLeft, DestTop, ImageWidth, ImageHeight,
Bitmap.Canvas.Handle, 0, 0, ImageWidth, ImageHeight, Bitmap.Canvas.Handle, 0, 0, ImageWidth, ImageHeight,
SRCCOPY); SRCCOPY);
ReleaseDC(HDC(DestWidget),DestDC); ReleaseDC(HDC(PtrUInt(DestWidget)),DestDC);
Bitmap.Free; Bitmap.Free;
end; end;
{$endif} {$endif}
@ -1588,7 +1558,7 @@ begin
SourceDC.GDIObjects[g]:=nil; SourceDC.GDIObjects[g]:=nil;
if MoveGDIOwnerShip then begin if MoveGDIOwnerShip then begin
if OwnedGDIObjects[g]<>nil then begin if OwnedGDIObjects[g]<>nil then begin
DeleteObject(HGDIOBJ(OwnedGDIObjects[g])); DeleteObject(HGDIOBJ(PtrUInt(OwnedGDIObjects[g])));
end; end;
CurGDIObject:=SourceDC.OwnedGDIObjects[g]; CurGDIObject:=SourceDC.OwnedGDIObjects[g];
if CurGDIObject<>nil then begin if CurGDIObject<>nil then begin
@ -4774,8 +4744,8 @@ begin
MouseCaptureType:=mctGTK; MouseCaptureType:=mctGTK;
if MouseCaptureWidget<>nil then begin if MouseCaptureWidget<>nil then begin
// the MouseCaptureWidget is probably not a main widget // the MouseCaptureWidget is probably not a main widget
SendMessage(HWnd(MouseCaptureWidget), LM_CAPTURECHANGED, 0, SendMessage(HWnd(PtrUInt(MouseCaptureWidget)), LM_CAPTURECHANGED, 0,
HWnd(OldMouseCaptureWidget)); HWnd(PtrUInt(OldMouseCaptureWidget)));
end; end;
end; end;
end; end;
@ -8362,7 +8332,7 @@ begin
{$ENDIF} {$ENDIF}
{$IFDEF GTK2} {$IFDEF GTK2}
If (Style <> nil) then begin If (Style <> nil) then begin
PangoFontDesc := pango_font_description_copy(Style^.font_desc); PangoFontDesc := Style^.font_desc;
if PangoFontDesc<>nil then begin if PangoFontDesc<>nil then begin
Result:=pango_font_description_get_family(PangoFontDesc); Result:=pango_font_description_get_family(PangoFontDesc);
end; end;
@ -9382,7 +9352,7 @@ end;
{------------------------------------------------------------------------------- {-------------------------------------------------------------------------------
Function GetTextExtentIgnoringAmpersands(Font : PGDKFont; Function GetTextExtentIgnoringAmpersands(TheFont: PGDKFont;
Str : PChar; StrLength: integer; Str : PChar; StrLength: integer;
MaxWidth: Longint; lbearing, rbearing, width, ascent, descent : Pgint); MaxWidth: Longint; lbearing, rbearing, width, ascent, descent : Pgint);
@ -9390,15 +9360,9 @@ end;
That means, ampersands are not counted. That means, ampersands are not counted.
Negative MaxWidth means no limit. Negative MaxWidth means no limit.
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
{$Ifdef GTK2} Procedure GetTextExtentIgnoringAmpersands(TheFont: TGtkIntfFont;
Procedure GetTextExtentIgnoringAmpersands(FontDesc : PPangoFontDescription;
Str : PChar; StrLength: integer; Str : PChar; StrLength: integer;
lbearing, rbearing, width, ascent, descent : Pgint); lbearing, rbearing, width, ascent, descent : Pgint);
{$Else}
Procedure GetTextExtentIgnoringAmpersands(FontDesc : PGDKFont;
Str : PChar; StrLength: integer;
lbearing, rbearing, width, ascent, descent : Pgint);
{$EndIf}
var var
NewStr : PChar; NewStr : PChar;
i: integer; i: integer;
@ -9413,37 +9377,49 @@ begin
StrLength:=StrLen(NewStr); StrLength:=StrLen(NewStr);
end; end;
end; end;
gdk_text_extents(FontDesc, NewStr, StrLength, gdk_text_extents(TheFont, NewStr, StrLength,
lbearing, rBearing, width, ascent, descent); lbearing, rBearing, width, ascent, descent);
if NewStr<>Str then if NewStr<>Str then
StrDispose(NewStr); StrDispose(NewStr);
end; end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
function FontIsDoubleByteCharsFont(TheFont: PGdkFont): boolean; function FontIsDoubleByteCharsFont(TheFont: TGtkIntfFont): boolean;
This is only a heuristic This is only a heuristic
------------------------------------------------------------------------------} ------------------------------------------------------------------------------}
function FontIsDoubleByteCharsFont(TheFont: PGdkFont): boolean; function FontIsDoubleByteCharsFont(TheFont: TGtkIntfFont): boolean;
var var
SingleCharLen, DoubleCharLen: integer; SingleCharLen, DoubleCharLen: integer;
begin begin
{$IFDEF Gtk1}
SingleCharLen:=gdk_text_width(TheFont, 'A', 1); SingleCharLen:=gdk_text_width(TheFont, 'A', 1);
DoubleCharLen:=gdk_text_width(TheFont, #0'A', 2); DoubleCharLen:=gdk_text_width(TheFont, #0'A', 2);
{$ELSE}
pango_layout_set_single_paragraph_mode(TheFont, TRUE);
pango_layout_set_width(TheFont, -1);
pango_layout_set_text(TheFont, 'A', 1);
pango_layout_get_pixel_size(TheFont, @SingleCharLen, nil);
pango_layout_set_text(TheFont, #0'A', 2);
pango_layout_get_pixel_size(TheFont, @DoubleCharLen, nil);
{$ENDIF}
Result:=(SingleCharLen=0) and (DoubleCharLen>0); Result:=(SingleCharLen=0) and (DoubleCharLen>0);
end; end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
function FontIsMonoSpaceFont(TheFont: PGdkFont): boolean; function FontIsMonoSpaceFont(TheFont: TGtkIntfFont): boolean;
This is only a heuristic This is only a heuristic
------------------------------------------------------------------------------} ------------------------------------------------------------------------------}
function FontIsMonoSpaceFont(TheFont: PGdkFont): boolean; function FontIsMonoSpaceFont(TheFont: TGtkIntfFont): boolean;
var var
{$IFDEF Gtk1}
SingleCharLen: LongInt; SingleCharLen: LongInt;
{$ENDIF}
MWidth: LongInt; MWidth: LongInt;
IWidth: LongInt; IWidth: LongInt;
begin begin
{$IFDEF Gtk1}
SingleCharLen:=gdk_text_width(TheFont, 'A', 1); SingleCharLen:=gdk_text_width(TheFont, 'A', 1);
if SingleCharLen=0 then begin if SingleCharLen=0 then begin
// assume a double byte character font // assume a double byte character font
@ -9454,29 +9430,17 @@ begin
MWidth:=gdk_text_width(TheFont, 'm', 1); MWidth:=gdk_text_width(TheFont, 'm', 1);
IWidth:=gdk_text_width(TheFont, 'i', 1); IWidth:=gdk_text_width(TheFont, 'i', 1);
end; end;
{$ELSE}
pango_layout_set_single_paragraph_mode(TheFont, TRUE);
pango_layout_set_width(TheFont, -1);
pango_layout_set_text(TheFont, 'm', 1);
pango_layout_get_pixel_size(TheFont, @MWidth, nil);
pango_layout_set_text(TheFont, 'i', 1);
pango_layout_get_pixel_size(TheFont, @IWidth, nil);
{$ENDIF}
Result:=MWidth=IWidth; Result:=MWidth=IWidth;
end; end;
{$Ifdef GTK2}
function FontIsDoubleByteCharsFont(TheFont: PPangoFontDescription): boolean;
var
Font: PGdkFont;
begin
Font:=gdk_font_from_description(TheFont);
Result:=FontIsDoubleByteCharsFont(Font);
gdk_font_unref(Font);
end;
function FontIsMonoSpaceFont(TheFont: PPangoFontDescription): boolean;
var
Font: PGdkFont;
begin
Font:=gdk_font_from_description(TheFont);
Result:=FontIsMonoSpaceFont(Font);
gdk_font_unref(Font);
end;
{$ENDIF Gtk2}
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
Method: GDKPixel2GDIRGB Method: GDKPixel2GDIRGB
Params: Params:

15
lcl/interfaces/gtk/gtkproc.pp
View File

@ -784,21 +784,14 @@ procedure UpdateWidgetStyleOfControl(AWinControl: TWinControl);
// fonts // fonts
function LoadDefaultFont: TGtkIntfFont; function LoadDefaultFont: TGtkIntfFont;
function FontIsDoubleByteCharsFont(TheFont: PGdkFont): boolean; function FontIsDoubleByteCharsFont(TheFont: TGtkIntfFont): boolean;
function FontIsMonoSpaceFont(TheFont: PGdkFont): boolean; function FontIsMonoSpaceFont(TheFont: TGtkIntfFont): boolean;
{$Ifdef GTK2} {$Ifdef GTK2}
function FontIsDoubleByteCharsFont(TheFont: PPangoFontDescription): boolean;
function FontIsMonoSpaceFont(TheFont: PPangoFontDescription): boolean;
function LoadDefaultFontDesc: PPangoFontDescription; function LoadDefaultFontDesc: PPangoFontDescription;
procedure GetTextExtentIgnoringAmpersands(FontDesc: PPangoFontDescription;
Str: PChar; StrLength: integer;
lbearing, rbearing, width, ascent, descent: Pgint);
{$ENDIF} {$ENDIF}
{$IFDEF GTK1} procedure GetTextExtentIgnoringAmpersands(TheFont: TGtkIntfFont;
procedure GetTextExtentIgnoringAmpersands(FontDesc: PGDKFont;
Str: PChar; StrLength: integer; Str: PChar; StrLength: integer;
lbearing, rbearing, width, ascent, descent: Pgint); lbearing, rbearing, width, ascent, descent: Pgint);
{$EndIf}
function GetDefaultFontName: string; function GetDefaultFontName: string;
procedure FillScreenFonts(ScreenFonts: TStrings); procedure FillScreenFonts(ScreenFonts: TStrings);
function GetTextHeight(DCTextMetric: TDevContextTextMetric): integer; function GetTextHeight(DCTextMetric: TDevContextTextMetric): integer;
@ -837,7 +830,7 @@ function GetGtkContainerBorderWidth(Widget: PGtkContainer): gint;
Function gdk_region_xor(source1:PGdkRegion; source2:PGdkRegion): PGdkRegion; Function gdk_region_xor(source1:PGdkRegion; source2:PGdkRegion): PGdkRegion;
//mimic GDKFont Routines With Pango --> //mimic GDKFont Routines With Pango -->
Procedure gdk_text_extents(FontDesc: PPangoFontDescription; Procedure gdk_text_extents(TheFont: TGtkIntfFont;
Str: PChar; StrLength: integer; Str: PChar; StrLength: integer;
lbearing, rbearing, width, ascent, descent: Pgint); lbearing, rbearing, width, ascent, descent: Pgint);
{$EndIf} {$EndIf}

61
lcl/interfaces/gtk/gtkwinapi.inc
View File

@ -854,7 +854,7 @@ begin
LoadDataByPixbufLoader; LoadDataByPixbufLoader;
end; end;
Result := HBITMAP(GdiObject); Result := HBITMAP(PtrUInt(GdiObject));
Assert(False, Format('Trace:< [TGtkWidgetSet.CreateBitmap] --> 0x%x', [Integer(Result)])); Assert(False, Format('Trace:< [TGtkWidgetSet.CreateBitmap] --> 0x%x', [Integer(Result)]));
end; end;
@ -984,7 +984,7 @@ begin
If not GObject^.IsNullBrush then If not GObject^.IsNullBrush then
SetGDIColorRef(GObject^.GDIBrushColor,lbColor); SetGDIColorRef(GObject^.GDIBrushColor,lbColor);
end; end;
Result := HBRUSH(GObject); Result := HBRUSH(PtrUInt(GObject));
except except
Result:=0; Result:=0;
DisposeGDIObject(GObject); DisposeGDIObject(GObject);
@ -1092,7 +1092,7 @@ begin
GdiObject^.Colormap := gdk_colormap_new(GdiObject^.Visual, GdkTrue); GdiObject^.Colormap := gdk_colormap_new(GdiObject^.Visual, GdkTrue);
Result := HBITMAP(GdiObject); Result := HBITMAP(PtrUInt(GdiObject));
Assert(False, Format('Trace:< [TGtkWidgetSet.CreateCompatibleBitmap] DC: 0x%x --> 0x%x', [DC, Result])); Assert(False, Format('Trace:< [TGtkWidgetSet.CreateCompatibleBitmap] DC: 0x%x --> 0x%x', [DC, Result]));
end; end;
@ -1163,7 +1163,10 @@ function TGtkWidgetSet.CreateCursor(ACursorInfo: PIconInfo): hCursor;
begin begin
// c_bit := Ord(0.222 * c.red + 0.707 * c.green + 0.071 * c.blue >= $8000); // c_bit := Ord(0.222 * c.red + 0.707 * c.green + 0.071 * c.blue >= $8000);
// do some int math // do some int math
c_bit := Ord(222 * c.red + 707 * c.green + 071 * c.blue >= $8000 * 1000); c_bit := Ord(cardinal(222) * c.red
+ cardinal(707) * c.green
+ cardinal(071) * c.blue
>= $8000 * 1000);
m_bit := ord(MaskPixel = 1); m_bit := ord(MaskPixel = 1);
AImgBits^ := AImgBits^ or (c_bit shl offset); AImgBits^ := AImgBits^ or (c_bit shl offset);
@ -1254,8 +1257,8 @@ begin
bg.blue := 0; bg.blue := 0;
bg.pixel := 0; bg.pixel := 0;
Result := hCursor(gdk_cursor_new_from_pixmap (srcbitmap, mskbitmap, @fg, @bg, Result := HCursor(PtrUInt(gdk_cursor_new_from_pixmap (srcbitmap, mskbitmap,
ACursorInfo^.xHotspot, ACursorInfo^.yHotspot)); @fg, @bg, ACursorInfo^.xHotspot, ACursorInfo^.yHotspot)));
gdk_pixmap_unref(srcbitmap); gdk_pixmap_unref(srcbitmap);
gdk_pixmap_unref(mskbitmap); gdk_pixmap_unref(mskbitmap);
@ -1809,7 +1812,7 @@ begin
Result := 0; Result := 0;
end end
else begin else begin
Result := HFONT(GdiObject); Result := HFONT(PtrUInt(GdiObject));
end; end;
if Result = 0 if Result = 0
@ -1860,7 +1863,7 @@ begin
GObject^.IndexTable.OnGetKeyForHashItem:=@GetIndexAsKey; GObject^.IndexTable.OnGetKeyForHashItem:=@GetIndexAsKey;
InitializePalette(GObject, LogPalette.palPalEntry, LogPalette.palNumEntries); InitializePalette(GObject, LogPalette.palPalEntry, LogPalette.palNumEntries);
Result := HPALETTE(GObject); Result := HPALETTE(PtrUInt(GObject));
end; end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
@ -1885,7 +1888,7 @@ begin
SetGDIColorRef(GObject^.GDIPenColor,lopnColor); SetGDIColorRef(GObject^.GDIPenColor,lopnColor);
end; end;
Result := HPEN(GObject); Result := HPEN(PtrUInt(GObject));
end; end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
@ -1996,7 +1999,7 @@ begin
FreeMem(PointArray); FreeMem(PointArray);
Result := HRGN(GObject); Result := HRGN(PtrUInt(GObject));
end; end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
@ -2034,7 +2037,7 @@ begin
GObject^.GDIRegionObject := RegionObj; GObject^.GDIRegionObject := RegionObj;
gdk_region_destroy(RRGN); gdk_region_destroy(RRGN);
Result := HRGN(GObject); Result := HRGN(PtrUInt(GObject));
//DebugLn('TGtkWidgetSet.CreateRectRgn A ',GDKRegionAsString(RegionObj)); //DebugLn('TGtkWidgetSet.CreateRectRgn A ',GDKRegionAsString(RegionObj));
end; end;
@ -4288,7 +4291,7 @@ begin
if (Widget <> nil) and gtk_widget_has_focus(Widget) if (Widget <> nil) and gtk_widget_has_focus(Widget)
then begin then begin
// return the window // return the window
Result := HWND(GetMainWidget(PGtkWidget(Window))); Result := HWND(PtrUInt(GetMainWidget(PGtkWidget(Window))));
//DebugLn('TGtkWidgetSet.GetActiveWindow Result=',GetWidgetDebugReport(PgtkWidget(Result))); //DebugLn('TGtkWidgetSet.GetActiveWindow Result=',GetWidgetDebugReport(PgtkWidget(Result)));
Break; Break;
end; end;
@ -4380,7 +4383,7 @@ begin
Widget:=nil; Widget:=nil;
end; end;
end; end;
Result := HWnd(Widget); Result := HWnd(PtrUInt(Widget));
end; end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
@ -4771,7 +4774,7 @@ begin
DebugLn('WARNING: [TGtkWidgetSet.GetClipRGN] Invalid HRGN'); DebugLn('WARNING: [TGtkWidgetSet.GetClipRGN] Invalid HRGN');
end end
else if (TDeviceContext(DC).ClipRegion<>nil) else if (TDeviceContext(DC).ClipRegion<>nil)
and (not IsValidGDIObject(HGDIOBJ(TDeviceContext(DC).ClipRegion))) then and (not IsValidGDIObject(HGDIOBJ(PtrUInt(TDeviceContext(DC).ClipRegion)))) then
Result := ERROR Result := ERROR
else with TDeviceContext(DC) do else with TDeviceContext(DC) do
begin begin
@ -5138,7 +5141,7 @@ begin
if (Widget <> nil) and gtk_widget_has_focus(Widget) if (Widget <> nil) and gtk_widget_has_focus(Widget)
then begin then begin
Result := HWND(GetMainWidget(Widget)); Result := HWND(PtrUInt(GetMainWidget(Widget)));
Break; Break;
end; end;
end; end;
@ -5408,7 +5411,7 @@ begin
//DebugLn('TGtkWidgetSet.GetParent ',DbgS(Handle)); //DebugLn('TGtkWidgetSet.GetParent ',DbgS(Handle));
Result:=0; Result:=0;
if Handle<>0 then if Handle<>0 then
Result:=HWnd(PGtkWidget(Handle)^.Parent); Result:=HWnd(PtrUInt(PGtkWidget(Handle)^.Parent));
end; end;
@ -5647,7 +5650,7 @@ begin
end; end;
If FStockSystemFont = 0 then If FStockSystemFont = 0 then
FStockSystemFont := HFont(CreateDefaultFont); FStockSystemFont := HFont(PtrUInt(CreateDefaultFont));
Result := FStockSystemFont; Result := FStockSystemFont;
end; end;
(* SYSTEM_FIXED_FONT: // Fixed-pitch (monospace) system font used in Windows versions earlier than 3.0. This stock object is provided for compatibility with earlier versions of Windows. (* SYSTEM_FIXED_FONT: // Fixed-pitch (monospace) system font used in Windows versions earlier than 3.0. This stock object is provided for compatibility with earlier versions of Windows.
@ -6437,11 +6440,11 @@ begin
Result := False; Result := False;
//Sanity Checks For Vertices Size vs. Count //Sanity Checks For Vertices Size vs. Count
If MemSize(Vertices) < SizeOf(tagTRIVERTEX)*NumVertices then If MemSize(Vertices) < PtrUInt(SizeOf(tagTRIVERTEX)*NumVertices) then
exit; exit;
//Sanity Checks For Meshes Size vs. Count //Sanity Checks For Meshes Size vs. Count
If MemSize(Meshes) < MeshSize[DoFillTriangle]*NumMeshes then If MemSize(Meshes) < PtrUInt(MeshSize[DoFillTriangle]*NumMeshes) then
exit; exit;
For I := 0 to NumMeshes - 1 do begin For I := 0 to NumMeshes - 1 do begin
@ -6979,7 +6982,7 @@ begin
DeleteObject(RGN); DeleteObject(RGN);
GetClipBox(DC, @ClipRect); GetClipBox(DC, @ClipRect);
// draw polygon area // draw polygon area
FillRect(DC, ClipRect, HBrush(GetBrush)); FillRect(DC, ClipRect, HBrush(PtrUInt(GetBrush)));
// restore old clipping // restore old clipping
SelectClipRGN(DC, Tmp); SelectClipRGN(DC, Tmp);
DeleteObject(Tmp); DeleteObject(Tmp);
@ -7294,7 +7297,7 @@ const
begin begin
if (Item^.Data <> Pointer(hndMenu)) // exclude ourself if (Item^.Data <> Pointer(hndMenu)) // exclude ourself
and gtk_is_radio_menu_item(Item^.Data) and gtk_is_radio_menu_item(Item^.Data)
and (GroupIndex = PtrUInt(gtk_object_get_data(Item^.Data, GROUPIDX_DATANAME))) and (PtrUInt(GroupIndex) = PtrUInt(gtk_object_get_data(Item^.Data, GROUPIDX_DATANAME)))
then begin then begin
Result := gtk_radio_menu_item_group(PGtkRadioMenuItem(Item^.Data)); Result := gtk_radio_menu_item_group(PGtkRadioMenuItem(Item^.Data));
Exit; Exit;
@ -7521,7 +7524,7 @@ begin
if CurGDIObject<>nil then begin if CurGDIObject<>nil then begin
if CurGDIObject^.Owner<>aDC then if CurGDIObject^.Owner<>aDC then
RaiseGDBException(''); RaiseGDBException('');
DeleteObject(HGDIOBJ(CurGDIObject)); DeleteObject(HGDIOBJ(PtrUInt(CurGDIObject)));
if aDC.OwnedGDIObjects[g]<>nil then if aDC.OwnedGDIObjects[g]<>nil then
RaiseGDBException(''); RaiseGDBException('');
end; end;
@ -7752,7 +7755,7 @@ begin
OldClipRegion:=ClipRegion; OldClipRegion:=ClipRegion;
ClipRegion := nil;// decrease DCCount ClipRegion := nil;// decrease DCCount
if (OldClipRegion=OwnedGDIObjects[gdiRegion]) then if (OldClipRegion=OwnedGDIObjects[gdiRegion]) then
DeleteObject(HGDIOBJ(OldClipRegion)); DeleteObject(HGDIOBJ(PtrUInt(OldClipRegion)));
end; end;
If (RGN = 0) then begin If (RGN = 0) then begin
@ -7824,7 +7827,7 @@ var
NewDrawable: PGdkPixmap; NewDrawable: PGdkPixmap;
begin begin
Assert(False, Format('trace: [TGtkWidgetSet.SelectObject] DC: 0x%x, Type: Bitmap', [DC])); Assert(False, Format('trace: [TGtkWidgetSet.SelectObject] DC: 0x%x, Type: Bitmap', [DC]));
Result := HBITMAP(DevCon.GetBitmap); // always create, because a valid GDIObject is needed to restore Result := HBITMAP(PtrUInt(DevCon.GetBitmap)); // always create, because a valid GDIObject is needed to restore
if DevCon.CurrentBitmap = GDIObject then Exit; if DevCon.CurrentBitmap = GDIObject then Exit;
DevCon.CurrentBitmap := GDIObject; DevCon.CurrentBitmap := GDIObject;
@ -7876,7 +7879,7 @@ begin
gdiBrush: begin gdiBrush: begin
Assert(False, Format('trace: [TGtkWidgetSet.SelectObject] DC: 0x%x, Type: Brush', [DC])); Assert(False, Format('trace: [TGtkWidgetSet.SelectObject] DC: 0x%x, Type: Brush', [DC]));
Result := HBRUSH(DevCon.GetBrush);// always create, because a valid GDIObject is needed to restore Result := HBRUSH(PtrUInt(DevCon.GetBrush));// always create, because a valid GDIObject is needed to restore
if DevCon.CurrentBrush = GDIObject then Exit; if DevCon.CurrentBrush = GDIObject then Exit;
DevCon.CurrentBrush := GDIObject; DevCon.CurrentBrush := GDIObject;
@ -7893,7 +7896,7 @@ begin
gdiFont: begin gdiFont: begin
Assert(False, Format('trace: [TGtkWidgetSet.SelectObject] DC: 0x%x, Type: Font', [DC])); Assert(False, Format('trace: [TGtkWidgetSet.SelectObject] DC: 0x%x, Type: Font', [DC]));
Result := HFONT(DevCon.GetFont);// always create, because a valid GDIObject is needed to restore Result := HFONT(PtrUInt(DevCon.GetFont));// always create, because a valid GDIObject is needed to restore
if DevCon.CurrentFont = GDIObject then Exit; if DevCon.CurrentFont = GDIObject then Exit;
DevCon.CurrentFont := GDIObject; DevCon.CurrentFont := GDIObject;
@ -7906,7 +7909,7 @@ begin
end; end;
gdiPen: begin gdiPen: begin
Result := HPEN(DevCon.GetPen);// always create, because a valid GDIObject is needed to restore Result := HPEN(PtrUInt(DevCon.GetPen));// always create, because a valid GDIObject is needed to restore
if DevCon.CurrentPen = GDIObject then Exit; if DevCon.CurrentPen = GDIObject then Exit;
DevCon.CurrentPen := PGDIObject(GDIObj); DevCon.CurrentPen := PGDIObject(GDIObj);
@ -7917,7 +7920,7 @@ begin
end; end;
gdiRegion: begin gdiRegion: begin
Result := HRGN(DevCon.ClipRegion); Result := HRGN(PtrUInt(DevCon.ClipRegion));
if DevCon.GC <> nil if DevCon.GC <> nil
then SelectClipRGN(DC, GDIObj) then SelectClipRGN(DC, GDIObj)
else DevCon.ClipRegion := nil; else DevCon.ClipRegion := nil;
@ -9404,7 +9407,7 @@ begin
aRect := Rect(X+DCOrigin.X,Y+DCOrigin.Y,X + Sz.CX, Sz.CY); aRect := Rect(X+DCOrigin.X,Y+DCOrigin.Y,X + Sz.CX, Sz.CY);
//DebugLn('TGtkWidgetSet.TextOut ',ARect.Left,',',ARect.Top,',',ARect.RIght,',',ARect.Bottom); //DebugLn('TGtkWidgetSet.TextOut ',ARect.Left,',',ARect.Top,',',ARect.RIght,',',ARect.Bottom);
FillRect(DC,aRect,hBrush(GetBrush)); FillRect(DC,aRect,hBrush(PtrUInt(GetBrush)));
UpdateDCTextMetric(TDeviceContext(DC)); UpdateDCTextMetric(TDeviceContext(DC));
TxtPt.X := X; TxtPt.X := X;
{$IfDef Win32} {$IfDef Win32}

2
lcl/interfaces/gtk/gtkwsbuttons.pp
View File

@ -111,7 +111,7 @@ var
begin begin
BitBtn := AWinControl as TCustomBitBtn; BitBtn := AWinControl as TCustomBitBtn;
Result := TLCLIntfHandle(gtk_button_new); Result := TLCLIntfHandle(PtrUInt(gtk_button_new));
if Result = 0 then Exit; if Result = 0 then Exit;
{$IFDEF DebugLCLComponents} {$IFDEF DebugLCLComponents}
DebugGtkWidgets.MarkCreated(Pointer(Result),dbgsName(AWinControl)); DebugGtkWidgets.MarkCreated(Pointer(Result),dbgsName(AWinControl));

8
lcl/interfaces/gtk/gtkwscontrols.pp
View File

@ -563,7 +563,7 @@ begin
csStaticText: csStaticText:
begin begin
if TStaticText(AWinControl).ShowAccelChar then begin if TStaticText(AWinControl).ShowAccelChar then begin
DC := GetDC(HDC(GetStyleWidget(lgsLabel))); DC := GetDC(HDC(PtrUInt(GetStyleWidget(lgsLabel))));
aLabel := TGtkWidgetSet(WidgetSet).ForceLineBreaks( aLabel := TGtkWidgetSet(WidgetSet).ForceLineBreaks(
DC, pLabel, TStaticText(AWinControl).Width, false); DC, pLabel, TStaticText(AWinControl).Width, false);
DeleteDC(DC); DeleteDC(DC);
@ -743,7 +743,7 @@ begin
if V < High(Msg.SmallPos) if V < High(Msg.SmallPos)
then Msg.SmallPos := V then Msg.SmallPos := V
else Msg.SmallPos := High(Msg.SmallPos); else Msg.SmallPos := High(Msg.SmallPos);
Msg.ScrollBar := HWND(ScrollingData^.HScroll); Msg.ScrollBar := HWND(PtrUInt(ScrollingData^.HScroll));
Result := (DeliverMessage(AInfo^.LCLObject, Msg) <> 0) xor CallBackDefaultReturn; Result := (DeliverMessage(AInfo^.LCLObject, Msg) <> 0) xor CallBackDefaultReturn;
end; end;
@ -805,7 +805,7 @@ begin
if V < High(Msg.SmallPos) if V < High(Msg.SmallPos)
then Msg.SmallPos := V then Msg.SmallPos := V
else Msg.SmallPos := High(Msg.SmallPos); else Msg.SmallPos := High(Msg.SmallPos);
Msg.ScrollBar := HWND(ScrollingData^.HScroll); Msg.ScrollBar := HWND(PtrUInt(ScrollingData^.HScroll));
Result := (DeliverMessage(AInfo^.LCLObject, Msg) <> 0) xor CallBackDefaultReturn; Result := (DeliverMessage(AInfo^.LCLObject, Msg) <> 0) xor CallBackDefaultReturn;
end; end;
@ -823,7 +823,7 @@ begin
DebugGtkWidgets.MarkCreated(Widget,dbgsName(AWinControl)); DebugGtkWidgets.MarkCreated(Widget,dbgsName(AWinControl));
{$ENDIF} {$ENDIF}
Result := THandle(Widget); Result := THandle(PtrUInt(Widget));
if Result = 0 then Exit; if Result = 0 then Exit;
gtk_widget_show(Widget); gtk_widget_show(Widget);

4
lcl/interfaces/gtk/gtkwsextctrls.pp
View File

@ -255,7 +255,7 @@ begin
gtk_notebook_set_tab_pos(AWidget, GtkPositionTypeMap[TCustomNotebook(AWinControl).TabPosition]); gtk_notebook_set_tab_pos(AWidget, GtkPositionTypeMap[TCustomNotebook(AWinControl).TabPosition]);
GTKWidgetSet.FinishComponentCreate(AWinControl, AWidget); GTKWidgetSet.FinishComponentCreate(AWinControl, AWidget);
Result := TLCLIntfHandle(AWidget); Result := TLCLIntfHandle(PtrUInt(AWidget));
end; end;
class procedure TGtkWSCustomNotebook.AddPage(const ANotebook: TCustomNotebook; class procedure TGtkWSCustomNotebook.AddPage(const ANotebook: TCustomNotebook;
@ -593,7 +593,7 @@ begin
{$IFDEF DebugLCLComponents} {$IFDEF DebugLCLComponents}
DebugGtkWidgets.MarkCreated(P,dbgsName(AWinControl)); DebugGtkWidgets.MarkCreated(P,dbgsName(AWinControl));
{$ENDIF} {$ENDIF}
Result := TLCLIntfHandle(P); Result := TLCLIntfHandle(PtrUInt(P));
end; end;
class procedure TGtkWSCustomPanel.SetColor(const AWinControl: TWinControl); class procedure TGtkWSCustomPanel.SetColor(const AWinControl: TWinControl);

4
lcl/interfaces/gtk/gtkwsforms.pp
View File

@ -303,7 +303,7 @@ begin
{$IFDEF DebugLCLComponents} {$IFDEF DebugLCLComponents}
DebugGtkWidgets.MarkCreated(P,dbgsName(AWinControl)); DebugGtkWidgets.MarkCreated(P,dbgsName(AWinControl));
{$ENDIF} {$ENDIF}
Result := TLCLIntfHandle(P); Result := TLCLIntfHandle(PtrUInt(P));
end; end;
class procedure TGtkWSCustomForm.SetAllowDropFiles(const AForm: TCustomForm; class procedure TGtkWSCustomForm.SetAllowDropFiles(const AForm: TCustomForm;
@ -428,7 +428,7 @@ begin
{$IFDEF DebugLCLComponents} {$IFDEF DebugLCLComponents}
DebugGtkWidgets.MarkCreated(P,dbgsName(AWinControl)); DebugGtkWidgets.MarkCreated(P,dbgsName(AWinControl));
{$ENDIF} {$ENDIF}
Result := TLCLIntfHandle(P); Result := TLCLIntfHandle(PtrUInt(P));
end; end;
initialization initialization

4
lcl/interfaces/gtk/gtkwsmenus.pp
View File

@ -146,7 +146,7 @@ begin
SetContainerMenuToggleSize; SetContainerMenuToggleSize;
if GtkWidgetIsA(MenuItem, GTK_TYPE_RADIO_MENU_ITEM) then if GtkWidgetIsA(MenuItem, GTK_TYPE_RADIO_MENU_ITEM) then
TGtkWidgetSet(WidgetSet).RegroupMenuItem(HMENU(MenuItem),GroupIndex); TGtkWidgetSet(WidgetSet).RegroupMenuItem(HMENU(PtrUInt(MenuItem)),GroupIndex);
end; end;
//DebugLn('TGtkWidgetSet.AttachMenu END ',AMenuItem.Name,':',AMenuItem.ClassName); //DebugLn('TGtkWidgetSet.AttachMenu END ',AMenuItem.Name,':',AMenuItem.ClassName);
end; end;
@ -162,7 +162,7 @@ begin
{$IFDEF DebugLCLComponents} {$IFDEF DebugLCLComponents}
DebugGtkWidgets.MarkCreated(MenuItemWidget,dbgsName(AMenuItem)); DebugGtkWidgets.MarkCreated(MenuItemWidget,dbgsName(AMenuItem));
{$ENDIF} {$ENDIF}
Result := THandle(MenuItemWidget); Result := THandle(PtrUInt(MenuItemWidget));
end; end;
class procedure TGtkWSMenuItem.DestroyHandle(const AMenuItem: TMenuItem); class procedure TGtkWSMenuItem.DestroyHandle(const AMenuItem: TMenuItem);

2
lcl/interfaces/gtk/gtkwsspin.pp
View File

@ -167,7 +167,7 @@ begin
gtk_adjustment_new(1,1,100,1,1,1)),1,0); gtk_adjustment_new(1,1,100,1,1,1)),1,0);
gtk_widget_show_all(p); gtk_widget_show_all(p);
gtkWidgetSet.FinishComponentCreate(AWinControl, P); gtkWidgetSet.FinishComponentCreate(AWinControl, P);
Result := THandle(P); Result := THandle(PtrUInt(P));
end; end;
initialization initialization

12
lcl/interfaces/gtk/gtkwsstdctrls.pp
View File

@ -540,7 +540,7 @@ begin
Widget:=GetWidgetInfo(Pointer(Handle),True)^.CoreWidget; Widget:=GetWidgetInfo(Pointer(Handle),True)^.CoreWidget;
GList:= PGtkCList(Widget)^.selection; GList:= PGtkCList(Widget)^.selection;
while Assigned(GList) do begin while Assigned(GList) do begin
if PtrUInt(GList^.data) = AIndex then begin if PtrUInt(GList^.data) = PtrUInt(AIndex) then begin
Result:=true; Result:=true;
exit; exit;
end else end else
@ -934,7 +934,7 @@ begin
{$IFDEF DebugLCLComponents} {$IFDEF DebugLCLComponents}
DebugGtkWidgets.MarkCreated(P,dbgsName(AWinControl)); DebugGtkWidgets.MarkCreated(P,dbgsName(AWinControl));
{$ENDIF} {$ENDIF}
Result := TLCLIntfHandle(P); Result := TLCLIntfHandle(PtrUInt(P));
end; end;
{$ENDIF} {$ENDIF}
@ -1054,7 +1054,7 @@ begin
{$IFDEF DebugLCLComponents} {$IFDEF DebugLCLComponents}
DebugGtkWidgets.MarkCreated(P, dbgsName(AWinControl)); DebugGtkWidgets.MarkCreated(P, dbgsName(AWinControl));
{$ENDIF} {$ENDIF}
Result := TLCLIntfHandle(P); Result := TLCLIntfHandle(PtrUInt(P));
end; end;
class procedure TGtkWSCustomStaticText.SetAlignment(const ACustomStaticText: TCustomStaticText; class procedure TGtkWSCustomStaticText.SetAlignment(const ACustomStaticText: TCustomStaticText;
@ -1092,7 +1092,7 @@ var
Allocation: TGTKAllocation; Allocation: TGTKAllocation;
begin begin
Button := AWinControl as TCustomButton; Button := AWinControl as TCustomButton;
Result := TLCLIntfHandle(gtk_button_new_with_label('button')); Result := TLCLIntfHandle(PtrUInt(gtk_button_new_with_label('button')));
if Result = 0 then Exit; if Result = 0 then Exit;
{$IFDEF DebugLCLComponents} {$IFDEF DebugLCLComponents}
DebugGtkWidgets.MarkCreated(Pointer(Result),'button'); DebugGtkWidgets.MarkCreated(Pointer(Result),'button');
@ -1326,7 +1326,7 @@ begin
{$IFDEF DebugLCLComponents} {$IFDEF DebugLCLComponents}
DebugGtkWidgets.MarkCreated(P,dbgsName(AWinControl)); DebugGtkWidgets.MarkCreated(P,dbgsName(AWinControl));
{$ENDIF} {$ENDIF}
Result := TLCLIntfHandle(P); Result := TLCLIntfHandle(PtrUInt(P));
DebugLn(['TGtkWSCustomMemo.CreateHandle ']); DebugLn(['TGtkWSCustomMemo.CreateHandle ']);
end; end;
@ -1496,7 +1496,7 @@ begin
{$IFDEF DebugLCLComponents} {$IFDEF DebugLCLComponents}
DebugGtkWidgets.MarkCreated(P,dbgsName(AWinControl)); DebugGtkWidgets.MarkCreated(P,dbgsName(AWinControl));
{$ENDIF} {$ENDIF}
Result := TLCLIntfHandle(P); Result := TLCLIntfHandle(PtrUInt(P));
end; end;
class procedure TGtkWSCustomGroupBox.GetPreferredSize(const AWinControl: TWinControl; class procedure TGtkWSCustomGroupBox.GetPreferredSize(const AWinControl: TWinControl;

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

@ -550,7 +550,7 @@ begin
end; end;
gdk_pixbuf_unref(pixbuf); gdk_pixbuf_unref(pixbuf);
Result := HBitmap(Pixmap); Result := HBitmap(PtrUInt(Pixmap));
end; end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------

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

@ -106,8 +106,8 @@ begin
end; end;
// create cursor from pixbuf // create cursor from pixbuf
Result := hCursor(gdk_cursor_new_from_pixbuf(gdk_display_get_default, pixbuf, Result := HCursor(PtrUInt(gdk_cursor_new_from_pixbuf(gdk_display_get_default, pixbuf,
ACursorInfo^.xHotSpot, ACursorInfo^.yHotSpot)); ACursorInfo^.xHotSpot, ACursorInfo^.yHotSpot)));
end; end;
function TGtk2WidgetSet.CreateFontIndirectEx(const LogFont: TLogFont; function TGtk2WidgetSet.CreateFontIndirectEx(const LogFont: TLogFont;
@ -272,7 +272,7 @@ begin
end else begin end else begin
// return the new font // return the new font
GdiObject^.LogFont:=LogFont; GdiObject^.LogFont:=LogFont;
Result := HFONT(GdiObject); Result := HFONT(PtrUInt(GdiObject));
end; end;
end else begin end else begin
{$IFDEF VerboseFonts} {$IFDEF VerboseFonts}

2
lcl/interfaces/gtk2/gtk2wsextctrls.pp
View File

@ -245,7 +245,7 @@ begin
HookNoteBookClass; HookNoteBookClass;
//DebugLn(['TGtk2WSCustomNotebook.CreateHandle ',DbgSName(AWinControl)]); //DebugLn(['TGtk2WSCustomNotebook.CreateHandle ',DbgSName(AWinControl)]);
P := PGtkNoteBook(TGtkWSCustomNotebook.CreateHandle(AWinControl, AParams)); P := PGtkNoteBook(TGtkWSCustomNotebook.CreateHandle(AWinControl, AParams));
Result := HWND(P); Result := HWND(PtrUInt(P));
end; end;
class function TGtk2WSCustomNotebook.GetDefaultClientRect( class function TGtk2WSCustomNotebook.GetDefaultClientRect(

27
packager/packagedefs.pas
View File

@ -597,6 +597,7 @@ type
FOutputStateFile: string; FOutputStateFile: string;
FPackageEditor: TBasePackageEditor; FPackageEditor: TBasePackageEditor;
FPackageType: TLazPackageType; FPackageType: TLazPackageType;
FProvides: TStrings;
FRSTOutputDirectory: string; FRSTOutputDirectory: string;
fPublishOptions: TPublishPackageOptions; fPublishOptions: TPublishPackageOptions;
FRemovedFiles: TFPList; // TFPList of TPkgFile FRemovedFiles: TFPList; // TFPList of TPkgFile
@ -630,6 +631,7 @@ type
procedure SetLazDocPaths(const AValue: string); procedure SetLazDocPaths(const AValue: string);
procedure SetLicense(const AValue: string); procedure SetLicense(const AValue: string);
procedure SetOutputStateFile(const AValue: string); procedure SetOutputStateFile(const AValue: string);
procedure SetProvides(const AValue: TStrings);
procedure SetRSTOutputDirectory(const AValue: string); procedure SetRSTOutputDirectory(const AValue: string);
procedure SetRegistered(const AValue: boolean); procedure SetRegistered(const AValue: boolean);
procedure SetModified(const AValue: boolean); procedure SetModified(const AValue: boolean);
@ -734,6 +736,8 @@ type
procedure AddUsedByDependency(Dependency: TPkgDependency); procedure AddUsedByDependency(Dependency: TPkgDependency);
procedure RemoveUsedByDependency(Dependency: TPkgDependency); procedure RemoveUsedByDependency(Dependency: TPkgDependency);
function UsedByDepByIndex(Index: integer): TPkgDependency; function UsedByDepByIndex(Index: integer): TPkgDependency;
// provides
function ProvidesPackage(const AName: string): boolean;
// ID // ID
procedure ChangeID(const NewName: string; NewVersion: TPkgVersion); procedure ChangeID(const NewName: string; NewVersion: TPkgVersion);
public public
@ -784,6 +788,7 @@ type
write SetPackageType; write SetPackageType;
property RSTOutputDirectory: string read FRSTOutputDirectory property RSTOutputDirectory: string read FRSTOutputDirectory
write SetRSTOutputDirectory; write SetRSTOutputDirectory;
property Provides: TStrings read FProvides write SetProvides;
property PublishOptions: TPublishPackageOptions property PublishOptions: TPublishPackageOptions
read fPublishOptions write fPublishOptions; read fPublishOptions write fPublishOptions;
property Registered: boolean read FRegistered write SetRegistered; property Registered: boolean read FRegistered write SetRegistered;
@ -2263,6 +2268,13 @@ begin
FOutputStateFile:=NewStateFile; FOutputStateFile:=NewStateFile;
end; end;
procedure TLazPackage.SetProvides(const AValue: TStrings);
begin
if (AValue=FProvides) or (FProvides.Equals(AValue)) then exit;
FProvides.Assign(AValue);
Modified:=true;
end;
procedure TLazPackage.SetRSTOutputDirectory(const AValue: string); procedure TLazPackage.SetRSTOutputDirectory(const AValue: string);
var var
NewValue: String; NewValue: String;
@ -2332,6 +2344,7 @@ begin
FUsageOptions.ParsedOpts.OnLocalSubstitute:=@SubstitutePkgMacro; FUsageOptions.ParsedOpts.OnLocalSubstitute:=@SubstitutePkgMacro;
FDefineTemplates:=TLazPackageDefineTemplates.Create(Self); FDefineTemplates:=TLazPackageDefineTemplates.Create(Self);
fPublishOptions:=TPublishPackageOptions.Create(Self); fPublishOptions:=TPublishPackageOptions.Create(Self);
FProvides:=TStringList.Create;
Clear; Clear;
FUsageOptions.ParsedOpts.InvalidateGraphOnChange:=true; FUsageOptions.ParsedOpts.InvalidateGraphOnChange:=true;
end; end;
@ -2341,6 +2354,7 @@ begin
Include(FFlags,lpfDestroying); Include(FFlags,lpfDestroying);
Clear; Clear;
FreeAndNil(fPublishOptions); FreeAndNil(fPublishOptions);
FreeAndNil(FProvides);
FreeAndNil(FDefineTemplates); FreeAndNil(FDefineTemplates);
FreeAndNil(FRemovedFiles); FreeAndNil(FRemovedFiles);
FreeAndNil(FFiles); FreeAndNil(FFiles);
@ -2402,6 +2416,7 @@ begin
FRegistered:=false; FRegistered:=false;
FUsageOptions.Clear; FUsageOptions.Clear;
fPublishOptions.Clear; fPublishOptions.Clear;
FProvides.Clear;
UpdateSourceDirectories; UpdateSourceDirectories;
// set some nice start values // set some nice start values
if not (lpfDestroying in FFlags) then begin if not (lpfDestroying in FFlags) then begin
@ -2542,6 +2557,7 @@ begin
PathDelimChanged); PathDelimChanged);
fPublishOptions.LoadFromXMLConfig(XMLConfig,Path+'PublishOptions/', fPublishOptions.LoadFromXMLConfig(XMLConfig,Path+'PublishOptions/',
PathDelimChanged); PathDelimChanged);
LoadStringList(XMLConfig,FProvides,Path+'Provides/');
EndUpdate; EndUpdate;
Modified:=false; Modified:=false;
UnlockModified; UnlockModified;
@ -2593,6 +2609,7 @@ begin
FFirstRequiredDependency,pdlRequires); FFirstRequiredDependency,pdlRequires);
FUsageOptions.SaveToXMLConfig(XMLConfig,Path+'UsageOptions/'); FUsageOptions.SaveToXMLConfig(XMLConfig,Path+'UsageOptions/');
fPublishOptions.SaveToXMLConfig(XMLConfig,Path+'PublishOptions/'); fPublishOptions.SaveToXMLConfig(XMLConfig,Path+'PublishOptions/');
SaveStringList(XMLConfig,FProvides,Path+'Provides/');
Modified:=false; Modified:=false;
end; end;
@ -2823,6 +2840,16 @@ begin
Result:=GetDependencyWithIndex(FFirstUsedByDependency,pdlUsedBy,Index); Result:=GetDependencyWithIndex(FFirstUsedByDependency,pdlUsedBy,Index);
end; end;
function TLazPackage.ProvidesPackage(const AName: string): boolean;
var
i: Integer;
begin
for i:=0 to Provides.Count-1 do
if SysUtils.CompareText(Provides[i],AName)=0 then
exit(true);
Result:=false;
end;
function TLazPackage.AddFile(const NewFilename, NewUnitName: string; function TLazPackage.AddFile(const NewFilename, NewUnitName: string;
NewFileType: TPkgFileType; NewFlags: TPkgFileFlags; NewFileType: TPkgFileType; NewFlags: TPkgFileFlags;
CompPriorityCat: TComponentPriorityCategory): TPkgFile; CompPriorityCat: TComponentPriorityCategory): TPkgFile;

27
packager/packagesystem.pas
View File

@ -212,6 +212,8 @@ type
ResolveLinks: boolean): TLazPackage; ResolveLinks: boolean): TLazPackage;
function FindPackageWithID(PkgID: TLazPackageID): TLazPackage; function FindPackageWithID(PkgID: TLazPackageID): TLazPackage;
function FindPackageWithIDMask(PkgIDMask: TLazPackageID): TLazPackage; function FindPackageWithIDMask(PkgIDMask: TLazPackageID): TLazPackage;
function FindPackageProvidingName(FirstDependency: TPkgDependency;
const Name: string): TLazPackage;
function FindUnit(StartPackage: TLazPackage; const TheUnitName: string; function FindUnit(StartPackage: TLazPackage; const TheUnitName: string;
WithRequiredPackages, IgnoreDeleted: boolean): TPkgFile; WithRequiredPackages, IgnoreDeleted: boolean): TPkgFile;
function FindUnitInAllPackages(const TheUnitName: string; function FindUnitInAllPackages(const TheUnitName: string;
@ -796,6 +798,31 @@ begin
Result:=nil; Result:=nil;
end; end;
function TLazPackageGraph.FindPackageProvidingName(
FirstDependency: TPkgDependency;
const Name: string): TLazPackage;
function Search(ADependency: TPkgDependency; out Found: TLazPackage
): boolean;
begin
while ADependency<>nil do begin
Found:=ADependency.RequiredPackage;
if (Found<>nil) and (not (lpfVisited in Found.Flags)) then begin
Found.Flags:=Found.Flags+[lpfVisited];
if Found.ProvidesPackage(Name)
or Search(Found.FirstRequiredDependency,Found) then
exit(true);
end;
ADependency:=ADependency.NextRequiresDependency;
end;
Result:=false;
end;
begin
MarkAllPackagesAsNotVisited;
Result:=nil;
end;
function TLazPackageGraph.FindUnit(StartPackage: TLazPackage; function TLazPackageGraph.FindUnit(StartPackage: TLazPackage;
const TheUnitName: string; const TheUnitName: string;
WithRequiredPackages, IgnoreDeleted: boolean): TPkgFile; WithRequiredPackages, IgnoreDeleted: boolean): TPkgFile;

8
packager/pkgmanager.pas
View File

@ -2110,6 +2110,14 @@ begin
Result:=mrCancel; Result:=mrCancel;
exit; exit;
end; end;
if PackageGraph.FindPackageProvidingName(AProject.FirstRequiredDependency,
APackage.Name)<>nil then
begin
// package is already provided by another package
Result:=mrCancel;
exit;
end;
if OnlyTestIfPossible then if OnlyTestIfPossible then
exit(mrOk); exit(mrOk);
// add a dependency for the package to the project // add a dependency for the package to the project

54
packager/pkgoptionsdlg.pas
View File

@ -98,6 +98,10 @@ type
RSTOutputGroupBox: TGroupBox; RSTOutputGroupBox: TGroupBox;
RSTOutputDirectoryEdit: TEdit; RSTOutputDirectoryEdit: TEdit;
RSTOutputDirectoryButton: TButton; RSTOutputDirectoryButton: TButton;
// Provides page
ProvidesPage: TPage;
ProvidesLabel: TLabel;
ProvidesMemo: TMemo;
// buttons // buttons
OkButton: TButton; OkButton: TButton;
CancelButton: TButton; CancelButton: TButton;
@ -123,6 +127,7 @@ type
procedure SetupUsagePage(PageIndex: integer); procedure SetupUsagePage(PageIndex: integer);
procedure SetupDescriptionPage(PageIndex: integer); procedure SetupDescriptionPage(PageIndex: integer);
procedure SetupIDEPage(PageIndex: integer); procedure SetupIDEPage(PageIndex: integer);
procedure SetupProvidesPage(PageIndex: integer);
procedure ReadOptionsFromPackage; procedure ReadOptionsFromPackage;
procedure ReadPkgTypeFromPackage; procedure ReadPkgTypeFromPackage;
function GetEditForPathButton(AButton: TPathEditorButton): TEdit; function GetEditForPathButton(AButton: TPathEditorButton): TEdit;
@ -440,11 +445,6 @@ begin
// Usage page // Usage page
LazPackage.PackageType:=NewPackageType; LazPackage.PackageType:=NewPackageType;
case UpdateRadioGroup.ItemIndex of
2: LazPackage.AutoUpdate:=pupManually;
1: LazPackage.AutoUpdate:=pupOnRebuildingAll;
else LazPackage.AutoUpdate:=pupAsNeeded;
end;
with LazPackage.UsageOptions do begin with LazPackage.UsageOptions do begin
UnitPath:=TrimSearchPath(UnitPathEdit.Text,''); UnitPath:=TrimSearchPath(UnitPathEdit.Text,'');
IncludePath:=TrimSearchPath(IncludePathEdit.Text,''); IncludePath:=TrimSearchPath(IncludePathEdit.Text,'');
@ -453,9 +453,20 @@ begin
LinkerOptions:=LinkerOptionsMemo.Text; LinkerOptions:=LinkerOptionsMemo.Text;
CustomOptions:=CustomOptionsMemo.Text; CustomOptions:=CustomOptionsMemo.Text;
end; end;
// IDE integration page
case UpdateRadioGroup.ItemIndex of
2: LazPackage.AutoUpdate:=pupManually;
1: LazPackage.AutoUpdate:=pupOnRebuildingAll;
else LazPackage.AutoUpdate:=pupAsNeeded;
end;
LazPackage.LazDocPaths:=LazDocPathEdit.Text; LazPackage.LazDocPaths:=LazDocPathEdit.Text;
LazPackage.RSTOutputDirectory:=RSTOutputDirectoryEdit.Text; LazPackage.RSTOutputDirectory:=RSTOutputDirectoryEdit.Text;
// Provides page
LazPackage.Provides:=ProvidesMemo.Lines;
ModalResult:=mrOk; ModalResult:=mrOk;
end; end;
@ -555,12 +566,14 @@ begin
Pages.Add(lisPckOptsUsage); Pages.Add(lisPckOptsUsage);
Pages.Add(lisToDoLDescription); Pages.Add(lisToDoLDescription);
Pages.Add(lisPckOptsIDEIntegration); Pages.Add(lisPckOptsIDEIntegration);
Pages.Add(lisPckOptsProvides);
PageIndex:=0; PageIndex:=0;
end; end;
SetupUsagePage(0); SetupUsagePage(0);
SetupDescriptionPage(1); SetupDescriptionPage(1);
SetupIDEPage(2); SetupIDEPage(2);
SetupProvidesPage(3);
OkButton:=TButton.Create(Self); OkButton:=TButton.Create(Self);
with OkButton do begin with OkButton do begin
@ -812,6 +825,33 @@ begin
RSTOutputDirectoryEdit.AnchorToNeighbour(akRight,0,RSTOutputDirectoryButton); RSTOutputDirectoryEdit.AnchorToNeighbour(akRight,0,RSTOutputDirectoryButton);
end; end;
procedure TPackageOptionsDialog.SetupProvidesPage(PageIndex: integer);
begin
// Usage page
ProvidesPage:=Notebook.Page[PageIndex];
ProvidesLabel:=TLabel.Create(Self);
with ProvidesLabel do begin
Name:='ProvidesLabel';
AutoSize:=false;
Caption:=lisPckOptsThisPackageProvidesTheSameAsTheFollowingPackages;
AnchorParallel(akLeft,6,ProvidesPage);
AnchorParallel(akRight,6,ProvidesPage);
Height:=50;
Parent:=ProvidesPage;
end;
ProvidesMemo:=TMemo.Create(Self);
with ProvidesMemo do begin
Name:='ProvidesMemo';
AnchorToNeighbour(akTop,6,ProvidesLabel);
AnchorParallel(akLeft,6,ProvidesPage);
AnchorParallel(akRight,6,ProvidesPage);
AnchorParallel(akBottom,6,ProvidesPage);
Parent:=ProvidesPage;
end;
end;
procedure TPackageOptionsDialog.SetupUsagePage(PageIndex: integer); procedure TPackageOptionsDialog.SetupUsagePage(PageIndex: integer);
begin begin
// Usage page // Usage page
@ -990,8 +1030,12 @@ begin
CustomOptionsMemo.Text:=CustomOptions; CustomOptionsMemo.Text:=CustomOptions;
end; end;
// IDE integration
LazDocPathEdit.Text:=LazPackage.LazDocPaths; LazDocPathEdit.Text:=LazPackage.LazDocPaths;
RSTOutputDirectoryEdit.Text:=LazPackage.RSTOutputDirectory; RSTOutputDirectoryEdit.Text:=LazPackage.RSTOutputDirectory;
// Provides
ProvidesMemo.Lines.Assign(LazPackage.Provides);
end; end;
procedure TPackageOptionsDialog.ReadPkgTypeFromPackage; procedure TPackageOptionsDialog.ReadPkgTypeFromPackage;