mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-22 11:19:26 +02:00
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)
git-svn-id: trunk@12080 -
This commit is contained in:
mattias
parent
f40ff94387
commit
4f8d2a8022
@ -2988,6 +2988,7 @@ resourcestring
|
||||
lisPckOptsUsage = 'Usage';
|
||||
lisPOChoosePoFileDirectory = 'Choose .po file directory';
|
||||
lisPckOptsIDEIntegration = 'IDE Integration';
|
||||
lisPckOptsProvides = 'Provides';
|
||||
lisPckOptsDescriptionAbstract = 'Description/Abstract';
|
||||
lisPckOptsAuthor = 'Author:';
|
||||
lisPckOptsLicense = 'License:';
|
||||
@ -3409,6 +3410,8 @@ resourcestring
|
||||
rsRemove = '&Remove';
|
||||
lisAutomaticallyOnLineBreak = 'automatically on line break';
|
||||
lisAutomaticallyOnSpace = 'automatically on space';
|
||||
lisPckOptsThisPackageProvidesTheSameAsTheFollowingPackages = 'This package '
|
||||
+'provides the same as the following packages:';
|
||||
|
||||
implementation
|
||||
end.
|
||||
|
||||
@ -12934,6 +12934,8 @@ end;
|
||||
|
||||
procedure TMainIDE.OnPropHookAddDependency(const AClass: TClass;
|
||||
const AnUnitName: shortstring);
|
||||
// add a package dependency to the package/project of the currently active
|
||||
// designed component.
|
||||
var
|
||||
RequiredUnitName: String;
|
||||
AnUnitInfo: TUnitInfo;
|
||||
|
||||
@ -330,7 +330,7 @@ begin
|
||||
Mess.Minimized:=false;
|
||||
Mess.ActiveWindow:=0;
|
||||
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;
|
||||
//DebugLn('gtkactivateCB ',DbgSName(TObject(Data)));
|
||||
DeliverMessage(Data, Mess);
|
||||
@ -637,7 +637,7 @@ begin
|
||||
Mess.Minimized:=false;
|
||||
Mess.ActiveWindow:=0;
|
||||
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;
|
||||
DeliverMessage(Data, Mess); // send message directly (not Post)
|
||||
|
||||
@ -3067,7 +3067,7 @@ begin
|
||||
if Pos < High(SmallPos)
|
||||
then SmallPos := Pos
|
||||
else SmallPos := High(SmallPos);
|
||||
ScrollBar := HWND(Scroll);
|
||||
ScrollBar := HWND(PtrUInt(Scroll));
|
||||
ScrollType := get_gtk_scroll_type(Scroll);
|
||||
ScrollCode := ScrollTypeToSbCode(False, ScrollType,
|
||||
gtk_range_get_update_policy(Scroll));
|
||||
@ -3093,7 +3093,7 @@ begin
|
||||
then SmallPos := Pos
|
||||
else SmallPos := High(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);
|
||||
// GTK1 has a bug with wheel mouse. It sometimes gives the wrong direction.
|
||||
ScrollCode := ScrollTypeToSbCode(True, ScrollType,
|
||||
|
||||
@ -135,6 +135,7 @@ begin
|
||||
{$IFDEF Gtk1}
|
||||
gdk_font_ref(AFont);
|
||||
{$ELSE}
|
||||
//DebugLn(['ReferenceGtkIntfFont ',dbgs(AFont)]);
|
||||
g_object_ref(AFont);
|
||||
{$ENDIF}
|
||||
end;
|
||||
@ -144,6 +145,7 @@ begin
|
||||
{$IFDEF Gtk1}
|
||||
gdk_font_unref(AFont);
|
||||
{$ELSE}
|
||||
//DebugLn(['UnreferenceGtkIntfFont ',dbgs(AFont)]);
|
||||
g_object_unref(AFont);
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
@ -203,12 +203,6 @@ type
|
||||
// images
|
||||
procedure LoadPixbufFromLazResource(const ResourceName: string;
|
||||
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;
|
||||
BitSize : Longint; Bits: Pointer; var BitInfo: BitmapInfo; Usage: UINT; DIB : Boolean): Integer;virtual;
|
||||
function RawImage_DescriptionFromDrawable(out ADesc: TRawImageDescription; ADrawable: PGdkDrawable; ACustomAlpha: Boolean): boolean;
|
||||
|
||||
@ -108,12 +108,12 @@ begin
|
||||
with Msg.DrawListItemStruct^ do begin
|
||||
ItemID:=ItemIndex;
|
||||
Area:=AreaRect;
|
||||
DC:=GetDC(HWnd(Widget));
|
||||
DC:=GetDC(HWnd(PtrUInt(Widget)));
|
||||
ItemState:=State;
|
||||
end;
|
||||
//DebugLn('gtkListItemDrawAfterCB ',DbgSName(LCLList.Owner),' Widget=',DbgS(Widget));
|
||||
Result := DeliverMessage(LCLList.Owner, Msg)=0;
|
||||
ReleaseDC(HWnd(Widget),Msg.DrawListItemStruct^.DC);
|
||||
ReleaseDC(HWnd(PtrUInt(Widget)),Msg.DrawListItemStruct^.DC);
|
||||
finally
|
||||
Dispose(Msg.DrawListItemStruct);
|
||||
end;
|
||||
|
||||
@ -1671,240 +1671,6 @@ begin
|
||||
Result:=true;
|
||||
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;
|
||||
StartScan, NumScans: UINT;
|
||||
@ -2033,7 +1799,7 @@ begin
|
||||
BitSize := longint(SizeOf(Byte))
|
||||
*(longint(biSizeImage) div biHeight)
|
||||
*longint(NumScans + StartScan);
|
||||
if MemSize(Bits) < BitSize
|
||||
if MemSize(Bits) < PtrUInt(BitSize)
|
||||
then begin
|
||||
DebugLn('WARNING: [TGtkWidgetSet.InternalGetDIBits] not enough memory allocated for Bits!');
|
||||
exit;
|
||||
@ -2075,7 +1841,7 @@ begin
|
||||
if DIB
|
||||
then dec(y)
|
||||
else inc(y);
|
||||
until (Y < 0) or (y >= NumScans);
|
||||
until (Y < 0) or (y >= longint(NumScans));
|
||||
|
||||
16: repeat
|
||||
for X := 0 to biwidth - 1 do
|
||||
@ -2093,7 +1859,7 @@ begin
|
||||
if DIB
|
||||
then dec(y)
|
||||
else inc(y);
|
||||
until (Y < 0) or (y >= NumScans);
|
||||
until (Y < 0) or (y >= longint(NumScans));
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -2178,7 +1944,7 @@ begin
|
||||
case Visual^.thetype of
|
||||
GDK_VISUAL_STATIC_GRAY: 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_TRUE_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);
|
||||
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);
|
||||
if ARawImage.DataSize > 0 then
|
||||
System.Move(pixels^, ARawImage.Data^, ARawImage.DataSize);
|
||||
@ -2346,7 +2112,7 @@ var
|
||||
RaiseGDBException('NewRawImage.Description.BitsPerPixel<>AnImage^.bpp');
|
||||
{$endif}
|
||||
|
||||
ARawImage.DataSize := PtrUInt(Image^.bpl) * Image^.Height;
|
||||
ARawImage.DataSize := PtrUInt(Image^.bpl) * PtrUInt(Image^.Height);
|
||||
{$IFDEF VerboseRawImage}
|
||||
DebugLn('TGtkWidgetSet.RawImage_FromDrawable: G Width=',dbgs(Image^.Width),' Height=',dbgs(Image^.Height),
|
||||
' BitsPerPixel=',dbgs(ADesc.BitsPerPixel),' bpl=',dbgs(Image^.bpl));
|
||||
@ -2545,7 +2311,7 @@ begin
|
||||
Exit;
|
||||
end;
|
||||
|
||||
if (W < ARect.Right) or (H < ARect.Bottom)
|
||||
if (longint(W) < ARect.Right) or (longint(H) < ARect.Bottom)
|
||||
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]);
|
||||
Exit;
|
||||
@ -2605,7 +2371,7 @@ function TGTKWidgetSet.RawImage_AddMask(var ARawImage: TRawImage; AMask: PGdkBit
|
||||
// ARect must have the same dimension as the rawimage
|
||||
var
|
||||
ADesc: TRawImageDescription absolute ARawImage.Description;
|
||||
Width, Height, H: cardinal;
|
||||
Width, Height, H: longint;
|
||||
Image: PGdkImage;
|
||||
BytesPerLine: Integer;
|
||||
SrcPtr, DstPtr: PByte;
|
||||
@ -2635,7 +2401,7 @@ begin
|
||||
R.Right := R.Left + Width;
|
||||
R.Bottom := R.Top + Height;
|
||||
|
||||
if Width <> ADesc.Width
|
||||
if cardinal(Width) <> ADesc.Width
|
||||
then begin
|
||||
{$ifdef RawimageConsistencyChecks}
|
||||
RaiseGDBException('TGTKWidgetSet.RawImage_AddMask: Width <> RawImage.Description.Width');
|
||||
@ -2645,7 +2411,7 @@ begin
|
||||
Exit;
|
||||
end;
|
||||
|
||||
if Height <> ADesc.Height
|
||||
if cardinal(Height) <> ADesc.Height
|
||||
then begin
|
||||
{$ifdef RawimageConsistencyChecks}
|
||||
RaiseGDBException('TGTKWidgetSet.RawImage_AddMask: Height <> RawImage.Description.Height');
|
||||
@ -2675,7 +2441,7 @@ begin
|
||||
ADesc.MaskBitsPerPixel := GetGdkImageBitsPerPixel(Image);
|
||||
ADesc.MaskLineEnd := rileByteBoundary;// gdk_bitmap_create_from_data expects rileByteBoundary
|
||||
BytesPerLine := GetBytesPerLine(ADesc.Width, ADesc.MaskBitsPerPixel, ADesc.MaskLineEnd);
|
||||
ARawImage.MaskSize := PtrUInt(BytesPerLine) * Height;
|
||||
ARawImage.MaskSize := PtrUInt(BytesPerLine) * PtrUInt(Height);
|
||||
|
||||
ReAllocMem(ARawImage.Mask, ARawImage.MaskSize);
|
||||
if ARawImage.MaskSize > 0
|
||||
@ -2896,7 +2662,7 @@ var
|
||||
end;
|
||||
|
||||
SrcPixmap := SrcGDIBitmap^.GDIPixmapObject.Image;
|
||||
MskBitmap := CreateGdkMaskBitmap(HBITMAP(SrcGDIBitmap), Mask);
|
||||
MskBitmap := CreateGdkMaskBitmap(HBITMAP(PtrUInt(SrcGDIBitmap)), Mask);
|
||||
|
||||
{$IFDEF VerboseStretchCopyArea}
|
||||
DebugLn('SrcDevBitmapToDrawable SrcPixmap=[',GetWindowDebugReport(SrcPixmap),']',
|
||||
@ -4016,7 +3782,7 @@ var
|
||||
NoteBookWidget: PGtkNotebook;
|
||||
GtkWindow: PGtkWidget;
|
||||
begin
|
||||
Handle := hwnd(ObjectToGtkObject(Sender));
|
||||
Handle := HWnd(PtrUInt(ObjectToGtkObject(Sender)));
|
||||
if Handle=0 then exit;
|
||||
Widget:=PGtkWidget(Handle);
|
||||
if WidgetIsDestroyingHandle(Widget) then exit;
|
||||
@ -4142,7 +3908,7 @@ begin
|
||||
|
||||
// update caret
|
||||
if GtkWidgetIsA(Widget,GTKAPIWidget_GetType) then
|
||||
DestroyCaret(HDC(Widget));
|
||||
DestroyCaret(HDC(PtrUInt(Widget)));
|
||||
|
||||
// remove pending size messages
|
||||
UnsetResizeRequest(Widget);
|
||||
@ -4798,20 +4564,20 @@ begin
|
||||
// however lazarus fails to start, so I'm enabling it for now
|
||||
if (ALCLObject is TWinControl) then
|
||||
begin
|
||||
TWinControl(ALCLObject).Handle := THandle(AGTKObject);
|
||||
TWinControl(ALCLObject).Handle := THandle(PtrUInt(AGTKObject));
|
||||
if AGTKObject <> nil then begin
|
||||
gtk_object_set_data(AGTKObject, 'Sender', ALCLObject);
|
||||
end;
|
||||
end
|
||||
else
|
||||
if (ALCLObject is TMenuItem) then
|
||||
TMenuItem(ALCLObject).Handle := HMenu(AGTKObject)
|
||||
TMenuItem(ALCLObject).Handle := HMenu(PtrUInt(AGTKObject))
|
||||
else
|
||||
if (ALCLObject is TMenu) then
|
||||
TMenu(ALCLObject).Items.Handle := HMenu(AGTKObject)
|
||||
TMenu(ALCLObject).Items.Handle := HMenu(PtrUInt(AGTKObject))
|
||||
else
|
||||
if (ALCLObject is TCommonDialog) then
|
||||
TCommonDialog(ALCLObject).Handle:= THandle(AGTKObject);
|
||||
TCommonDialog(ALCLObject).Handle:= THandle(PtrUInt(AGTKObject));
|
||||
|
||||
Set_RC_Name(ALCLObject, AGTKObject);
|
||||
|
||||
@ -5004,7 +4770,7 @@ begin
|
||||
CursorValue := -1;
|
||||
end;
|
||||
if CursorValue <> -1 then
|
||||
Result := hCursor(gdk_cursor_new(CursorValue));
|
||||
Result := hCursor(PtrUInt(gdk_cursor_new(CursorValue)));
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -5448,7 +5214,7 @@ begin
|
||||
{$IFDEF DebugLCLComponents}
|
||||
DebugGtkWidgets.MarkCreated(P,dbgsName(Sender));
|
||||
{$ENDIF}
|
||||
Result := THandle(P);
|
||||
Result := THandle(PtrUInt(P));
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -5855,32 +5621,14 @@ end;
|
||||
Params: GDIObject: a (LCL) gdiObject
|
||||
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;
|
||||
var
|
||||
GdiObject: PGdiObject absolute AGDIObj;
|
||||
begin
|
||||
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;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -6223,15 +5971,18 @@ begin
|
||||
{$ELSE}
|
||||
if DC.DCWidget<>nil then begin
|
||||
ClientWidget:=GetFixedWidget(DC.DCWidget);
|
||||
//DebugLn(['TGTKWidgetSet.OnCreateFontForDC ClientWidget=',GetWidgetDebugReport(ClientWidget)]);
|
||||
DC.CurrentFont:=NewGDIObject(gdiFont);
|
||||
DC.CurrentFont^.GDIFontObject:=
|
||||
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);
|
||||
if FontCache.FindGTKFont(GetGtkFont(DC))=nil then
|
||||
RaiseGDBException('');
|
||||
RaiseGDBException('inconsistency: font added to cache, but can not be found');
|
||||
end else
|
||||
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}
|
||||
DC.OwnedGDIObjects[gdiFont]:=DC.CurrentFont;
|
||||
end;
|
||||
@ -6684,7 +6435,7 @@ var
|
||||
begin
|
||||
GDIObject := NewGDIObject(gdiRegion);
|
||||
GDIObject^.GDIRegionObject:=gdk_region_copy(PGdiObject(SrcRGN)^.GDIRegionObject);
|
||||
Result := hRgn(GDIObject);
|
||||
Result := hRgn(PtrUInt(GDIObject));
|
||||
end;
|
||||
|
||||
function TGtkWidgetSet.DCClipRegionValid(DC: HDC): boolean;
|
||||
@ -6693,7 +6444,7 @@ var
|
||||
begin
|
||||
Result:=false;
|
||||
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;
|
||||
Result:=true;
|
||||
end;
|
||||
@ -6704,7 +6455,7 @@ var
|
||||
begin
|
||||
GObject := NewGDIObject(gdiRegion);
|
||||
GObject^.GDIRegionObject := gdk_region_new;
|
||||
Result := HRGN(GObject);
|
||||
Result := HRGN(PtrUInt(GObject));
|
||||
//DebugLn('TGtkWidgetSet.CreateEmptyRgn A RGN=',DbgS(Result));
|
||||
end;
|
||||
|
||||
@ -6897,7 +6648,7 @@ end;
|
||||
procedure TGtkWidgetSet.WordWrap(DC: HDC; AText: PChar;
|
||||
MaxWidthInPixel: integer; var Lines: PPChar; var LineCount: integer);
|
||||
var
|
||||
UseFont : TGtkIntfFont;
|
||||
UseFont: TGtkIntfFont;
|
||||
|
||||
function GetLineWidthInPixel(LineStart, LineLen: integer): integer;
|
||||
var
|
||||
|
||||
@ -210,46 +210,20 @@ begin
|
||||
GDK2.gdk_region_xor(result, source2);
|
||||
end;
|
||||
|
||||
Procedure gdk_text_extents(FontDesc: PPangoFontDescription;
|
||||
Procedure gdk_text_extents(TheFont: TGtkIntfFont;
|
||||
Str: PChar; StrLength: integer;
|
||||
lbearing, rbearing, width, ascent, descent: Pgint);
|
||||
var
|
||||
Layout : PPangoLayout;
|
||||
AttrList : PPangoAttrList;
|
||||
Attr : PPangoAttribute;
|
||||
Extents : TPangoRectangle;
|
||||
AttrListAllocated: Boolean;
|
||||
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]);
|
||||
GetStyle(lgsDefault);
|
||||
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);
|
||||
|
||||
//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]);
|
||||
Layout:=TheFont;
|
||||
pango_layout_set_single_paragraph_mode(Layout, TRUE);
|
||||
pango_layout_set_width(Layout, -1);
|
||||
|
||||
pango_layout_set_alignment(Layout, PANGO_ALIGN_LEFT);
|
||||
|
||||
pango_layout_set_text(Layout, Str, StrLength);
|
||||
|
||||
if Assigned(width) then
|
||||
pango_layout_get_pixel_size(Layout, width, nil);
|
||||
|
||||
if Assigned(lbearing) or Assigned(rbearing)
|
||||
or Assigned(ascent) or Assigned(descent) then begin
|
||||
pango_layout_get_extents(Layout, nil, @Extents);
|
||||
@ -266,10 +240,6 @@ begin
|
||||
if Assigned(descent) then
|
||||
descent^ := PANGO_DESCENT(extents) div PANGO_SCALE;
|
||||
end;
|
||||
|
||||
if AttrListAllocated then
|
||||
pango_attr_list_unref(AttrList);
|
||||
g_object_unref(Layout);
|
||||
end;
|
||||
|
||||
{$EndIf Gtk2}
|
||||
@ -986,7 +956,7 @@ begin
|
||||
else
|
||||
PS^.rcPaint := GtkPaintMsg.Data.Rect;
|
||||
|
||||
Result.DC:=BeginPaint(THandle(Widget), PS^);
|
||||
Result.DC:=BeginPaint(THandle(PtrUInt(Widget)), PS^);
|
||||
Result.PaintStruct:=PS;
|
||||
Result.Result:=0;
|
||||
if FreeGtkPaintMsg then
|
||||
@ -1005,7 +975,7 @@ begin
|
||||
DC := TDeviceContext(Msg^.WParam)
|
||||
else
|
||||
DC := TDeviceContext(PS^.hdc);
|
||||
EndPaint(THandle(DC.DCWidget), PS^);
|
||||
EndPaint(THandle(PtrUInt(DC.DCWidget)), PS^);
|
||||
Dispose(PS);
|
||||
Msg^.LParam:=0;
|
||||
Msg^.WParam:=0;
|
||||
@ -1032,7 +1002,7 @@ begin
|
||||
DC := TDeviceContext(Msg^.WParam)
|
||||
else
|
||||
DC := TDeviceContext(PS^.hdc);
|
||||
EndPaint(THandle(DC.DCWidget), PS^);
|
||||
EndPaint(THandle(PtrUInt(DC.DCWidget)), PS^);
|
||||
Dispose(PS);
|
||||
Msg^.LParam:=0;
|
||||
Msg^.WParam:=0;
|
||||
@ -1344,7 +1314,7 @@ begin
|
||||
DestLeft:=DestWidget^.allocation.x+((WindowWidth-ImageWidth) div 2);
|
||||
if CenterVertically then
|
||||
DestTop:=DestWidget^.allocation.y+((WindowHeight-ImageHeight) div 2);
|
||||
DestDC:=GetDC(HDC(DestWidget));
|
||||
DestDC:=GetDC(HDC(PtrUInt(DestWidget)));
|
||||
|
||||
//DebugLn('DrawImageListIconOnWidget B DestXY=',DestLeft,',',DestTop,
|
||||
// ' DestWindowSize=',WindowWidth,',',WindowWidth,
|
||||
@ -1352,7 +1322,7 @@ begin
|
||||
StretchBlt(DestDC, DestLeft, DestTop, ImageWidth, ImageHeight,
|
||||
Bitmap.Canvas.Handle, 0, 0, ImageWidth, ImageHeight,
|
||||
SRCCOPY);
|
||||
ReleaseDC(HDC(DestWidget),DestDC);
|
||||
ReleaseDC(HDC(PtrUInt(DestWidget)),DestDC);
|
||||
Bitmap.Free;
|
||||
end;
|
||||
{$endif}
|
||||
@ -1588,7 +1558,7 @@ begin
|
||||
SourceDC.GDIObjects[g]:=nil;
|
||||
if MoveGDIOwnerShip then begin
|
||||
if OwnedGDIObjects[g]<>nil then begin
|
||||
DeleteObject(HGDIOBJ(OwnedGDIObjects[g]));
|
||||
DeleteObject(HGDIOBJ(PtrUInt(OwnedGDIObjects[g])));
|
||||
end;
|
||||
CurGDIObject:=SourceDC.OwnedGDIObjects[g];
|
||||
if CurGDIObject<>nil then begin
|
||||
@ -4774,8 +4744,8 @@ begin
|
||||
MouseCaptureType:=mctGTK;
|
||||
if MouseCaptureWidget<>nil then begin
|
||||
// the MouseCaptureWidget is probably not a main widget
|
||||
SendMessage(HWnd(MouseCaptureWidget), LM_CAPTURECHANGED, 0,
|
||||
HWnd(OldMouseCaptureWidget));
|
||||
SendMessage(HWnd(PtrUInt(MouseCaptureWidget)), LM_CAPTURECHANGED, 0,
|
||||
HWnd(PtrUInt(OldMouseCaptureWidget)));
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
@ -8362,7 +8332,7 @@ begin
|
||||
{$ENDIF}
|
||||
{$IFDEF GTK2}
|
||||
If (Style <> nil) then begin
|
||||
PangoFontDesc := pango_font_description_copy(Style^.font_desc);
|
||||
PangoFontDesc := Style^.font_desc;
|
||||
if PangoFontDesc<>nil then begin
|
||||
Result:=pango_font_description_get_family(PangoFontDesc);
|
||||
end;
|
||||
@ -9382,7 +9352,7 @@ end;
|
||||
|
||||
|
||||
{-------------------------------------------------------------------------------
|
||||
Function GetTextExtentIgnoringAmpersands(Font : PGDKFont;
|
||||
Function GetTextExtentIgnoringAmpersands(TheFont: PGDKFont;
|
||||
Str : PChar; StrLength: integer;
|
||||
MaxWidth: Longint; lbearing, rbearing, width, ascent, descent : Pgint);
|
||||
|
||||
@ -9390,15 +9360,9 @@ end;
|
||||
That means, ampersands are not counted.
|
||||
Negative MaxWidth means no limit.
|
||||
-------------------------------------------------------------------------------}
|
||||
{$Ifdef GTK2}
|
||||
Procedure GetTextExtentIgnoringAmpersands(FontDesc : PPangoFontDescription;
|
||||
Procedure GetTextExtentIgnoringAmpersands(TheFont: TGtkIntfFont;
|
||||
Str : PChar; StrLength: integer;
|
||||
lbearing, rbearing, width, ascent, descent : Pgint);
|
||||
{$Else}
|
||||
Procedure GetTextExtentIgnoringAmpersands(FontDesc : PGDKFont;
|
||||
Str : PChar; StrLength: integer;
|
||||
lbearing, rbearing, width, ascent, descent : Pgint);
|
||||
{$EndIf}
|
||||
var
|
||||
NewStr : PChar;
|
||||
i: integer;
|
||||
@ -9413,37 +9377,49 @@ begin
|
||||
StrLength:=StrLen(NewStr);
|
||||
end;
|
||||
end;
|
||||
gdk_text_extents(FontDesc, NewStr, StrLength,
|
||||
gdk_text_extents(TheFont, NewStr, StrLength,
|
||||
lbearing, rBearing, width, ascent, descent);
|
||||
if NewStr<>Str then
|
||||
StrDispose(NewStr);
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
function FontIsDoubleByteCharsFont(TheFont: PGdkFont): boolean;
|
||||
function FontIsDoubleByteCharsFont(TheFont: TGtkIntfFont): boolean;
|
||||
|
||||
This is only a heuristic
|
||||
------------------------------------------------------------------------------}
|
||||
function FontIsDoubleByteCharsFont(TheFont: PGdkFont): boolean;
|
||||
function FontIsDoubleByteCharsFont(TheFont: TGtkIntfFont): boolean;
|
||||
var
|
||||
SingleCharLen, DoubleCharLen: integer;
|
||||
begin
|
||||
{$IFDEF Gtk1}
|
||||
SingleCharLen:=gdk_text_width(TheFont, 'A', 1);
|
||||
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);
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
function FontIsMonoSpaceFont(TheFont: PGdkFont): boolean;
|
||||
function FontIsMonoSpaceFont(TheFont: TGtkIntfFont): boolean;
|
||||
|
||||
This is only a heuristic
|
||||
------------------------------------------------------------------------------}
|
||||
function FontIsMonoSpaceFont(TheFont: PGdkFont): boolean;
|
||||
function FontIsMonoSpaceFont(TheFont: TGtkIntfFont): boolean;
|
||||
var
|
||||
{$IFDEF Gtk1}
|
||||
SingleCharLen: LongInt;
|
||||
{$ENDIF}
|
||||
MWidth: LongInt;
|
||||
IWidth: LongInt;
|
||||
begin
|
||||
{$IFDEF Gtk1}
|
||||
SingleCharLen:=gdk_text_width(TheFont, 'A', 1);
|
||||
if SingleCharLen=0 then begin
|
||||
// assume a double byte character font
|
||||
@ -9454,29 +9430,17 @@ begin
|
||||
MWidth:=gdk_text_width(TheFont, 'm', 1);
|
||||
IWidth:=gdk_text_width(TheFont, 'i', 1);
|
||||
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;
|
||||
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
|
||||
Params:
|
||||
|
||||
@ -784,21 +784,14 @@ procedure UpdateWidgetStyleOfControl(AWinControl: TWinControl);
|
||||
|
||||
// fonts
|
||||
function LoadDefaultFont: TGtkIntfFont;
|
||||
function FontIsDoubleByteCharsFont(TheFont: PGdkFont): boolean;
|
||||
function FontIsMonoSpaceFont(TheFont: PGdkFont): boolean;
|
||||
function FontIsDoubleByteCharsFont(TheFont: TGtkIntfFont): boolean;
|
||||
function FontIsMonoSpaceFont(TheFont: TGtkIntfFont): boolean;
|
||||
{$Ifdef GTK2}
|
||||
function FontIsDoubleByteCharsFont(TheFont: PPangoFontDescription): boolean;
|
||||
function FontIsMonoSpaceFont(TheFont: PPangoFontDescription): boolean;
|
||||
function LoadDefaultFontDesc: PPangoFontDescription;
|
||||
procedure GetTextExtentIgnoringAmpersands(FontDesc: PPangoFontDescription;
|
||||
Str: PChar; StrLength: integer;
|
||||
lbearing, rbearing, width, ascent, descent: Pgint);
|
||||
{$ENDIF}
|
||||
{$IFDEF GTK1}
|
||||
procedure GetTextExtentIgnoringAmpersands(FontDesc: PGDKFont;
|
||||
procedure GetTextExtentIgnoringAmpersands(TheFont: TGtkIntfFont;
|
||||
Str: PChar; StrLength: integer;
|
||||
lbearing, rbearing, width, ascent, descent: Pgint);
|
||||
{$EndIf}
|
||||
function GetDefaultFontName: string;
|
||||
procedure FillScreenFonts(ScreenFonts: TStrings);
|
||||
function GetTextHeight(DCTextMetric: TDevContextTextMetric): integer;
|
||||
@ -837,7 +830,7 @@ function GetGtkContainerBorderWidth(Widget: PGtkContainer): gint;
|
||||
Function gdk_region_xor(source1:PGdkRegion; source2:PGdkRegion): PGdkRegion;
|
||||
|
||||
//mimic GDKFont Routines With Pango -->
|
||||
Procedure gdk_text_extents(FontDesc: PPangoFontDescription;
|
||||
Procedure gdk_text_extents(TheFont: TGtkIntfFont;
|
||||
Str: PChar; StrLength: integer;
|
||||
lbearing, rbearing, width, ascent, descent: Pgint);
|
||||
{$EndIf}
|
||||
|
||||
@ -854,7 +854,7 @@ begin
|
||||
LoadDataByPixbufLoader;
|
||||
end;
|
||||
|
||||
Result := HBITMAP(GdiObject);
|
||||
Result := HBITMAP(PtrUInt(GdiObject));
|
||||
|
||||
Assert(False, Format('Trace:< [TGtkWidgetSet.CreateBitmap] --> 0x%x', [Integer(Result)]));
|
||||
end;
|
||||
@ -984,7 +984,7 @@ begin
|
||||
If not GObject^.IsNullBrush then
|
||||
SetGDIColorRef(GObject^.GDIBrushColor,lbColor);
|
||||
end;
|
||||
Result := HBRUSH(GObject);
|
||||
Result := HBRUSH(PtrUInt(GObject));
|
||||
except
|
||||
Result:=0;
|
||||
DisposeGDIObject(GObject);
|
||||
@ -1092,7 +1092,7 @@ begin
|
||||
|
||||
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]));
|
||||
end;
|
||||
@ -1163,7 +1163,10 @@ function TGtkWidgetSet.CreateCursor(ACursorInfo: PIconInfo): hCursor;
|
||||
begin
|
||||
// c_bit := Ord(0.222 * c.red + 0.707 * c.green + 0.071 * c.blue >= $8000);
|
||||
// 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);
|
||||
|
||||
AImgBits^ := AImgBits^ or (c_bit shl offset);
|
||||
@ -1254,8 +1257,8 @@ begin
|
||||
bg.blue := 0;
|
||||
bg.pixel := 0;
|
||||
|
||||
Result := hCursor(gdk_cursor_new_from_pixmap (srcbitmap, mskbitmap, @fg, @bg,
|
||||
ACursorInfo^.xHotspot, ACursorInfo^.yHotspot));
|
||||
Result := HCursor(PtrUInt(gdk_cursor_new_from_pixmap (srcbitmap, mskbitmap,
|
||||
@fg, @bg, ACursorInfo^.xHotspot, ACursorInfo^.yHotspot)));
|
||||
|
||||
gdk_pixmap_unref(srcbitmap);
|
||||
gdk_pixmap_unref(mskbitmap);
|
||||
@ -1809,7 +1812,7 @@ begin
|
||||
Result := 0;
|
||||
end
|
||||
else begin
|
||||
Result := HFONT(GdiObject);
|
||||
Result := HFONT(PtrUInt(GdiObject));
|
||||
end;
|
||||
|
||||
if Result = 0
|
||||
@ -1860,7 +1863,7 @@ begin
|
||||
GObject^.IndexTable.OnGetKeyForHashItem:=@GetIndexAsKey;
|
||||
InitializePalette(GObject, LogPalette.palPalEntry, LogPalette.palNumEntries);
|
||||
|
||||
Result := HPALETTE(GObject);
|
||||
Result := HPALETTE(PtrUInt(GObject));
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -1885,7 +1888,7 @@ begin
|
||||
SetGDIColorRef(GObject^.GDIPenColor,lopnColor);
|
||||
end;
|
||||
|
||||
Result := HPEN(GObject);
|
||||
Result := HPEN(PtrUInt(GObject));
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -1996,7 +1999,7 @@ begin
|
||||
|
||||
FreeMem(PointArray);
|
||||
|
||||
Result := HRGN(GObject);
|
||||
Result := HRGN(PtrUInt(GObject));
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -2034,7 +2037,7 @@ begin
|
||||
GObject^.GDIRegionObject := RegionObj;
|
||||
gdk_region_destroy(RRGN);
|
||||
|
||||
Result := HRGN(GObject);
|
||||
Result := HRGN(PtrUInt(GObject));
|
||||
//DebugLn('TGtkWidgetSet.CreateRectRgn A ',GDKRegionAsString(RegionObj));
|
||||
end;
|
||||
|
||||
@ -4288,7 +4291,7 @@ begin
|
||||
if (Widget <> nil) and gtk_widget_has_focus(Widget)
|
||||
then begin
|
||||
// return the window
|
||||
Result := HWND(GetMainWidget(PGtkWidget(Window)));
|
||||
Result := HWND(PtrUInt(GetMainWidget(PGtkWidget(Window))));
|
||||
//DebugLn('TGtkWidgetSet.GetActiveWindow Result=',GetWidgetDebugReport(PgtkWidget(Result)));
|
||||
Break;
|
||||
end;
|
||||
@ -4380,7 +4383,7 @@ begin
|
||||
Widget:=nil;
|
||||
end;
|
||||
end;
|
||||
Result := HWnd(Widget);
|
||||
Result := HWnd(PtrUInt(Widget));
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -4771,7 +4774,7 @@ begin
|
||||
DebugLn('WARNING: [TGtkWidgetSet.GetClipRGN] Invalid HRGN');
|
||||
end
|
||||
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
|
||||
else with TDeviceContext(DC) do
|
||||
begin
|
||||
@ -5138,7 +5141,7 @@ begin
|
||||
|
||||
if (Widget <> nil) and gtk_widget_has_focus(Widget)
|
||||
then begin
|
||||
Result := HWND(GetMainWidget(Widget));
|
||||
Result := HWND(PtrUInt(GetMainWidget(Widget)));
|
||||
Break;
|
||||
end;
|
||||
end;
|
||||
@ -5408,7 +5411,7 @@ begin
|
||||
//DebugLn('TGtkWidgetSet.GetParent ',DbgS(Handle));
|
||||
Result:=0;
|
||||
if Handle<>0 then
|
||||
Result:=HWnd(PGtkWidget(Handle)^.Parent);
|
||||
Result:=HWnd(PtrUInt(PGtkWidget(Handle)^.Parent));
|
||||
end;
|
||||
|
||||
|
||||
@ -5647,7 +5650,7 @@ begin
|
||||
end;
|
||||
|
||||
If FStockSystemFont = 0 then
|
||||
FStockSystemFont := HFont(CreateDefaultFont);
|
||||
FStockSystemFont := HFont(PtrUInt(CreateDefaultFont));
|
||||
Result := FStockSystemFont;
|
||||
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.
|
||||
@ -6437,11 +6440,11 @@ begin
|
||||
Result := False;
|
||||
|
||||
//Sanity Checks For Vertices Size vs. Count
|
||||
If MemSize(Vertices) < SizeOf(tagTRIVERTEX)*NumVertices then
|
||||
If MemSize(Vertices) < PtrUInt(SizeOf(tagTRIVERTEX)*NumVertices) then
|
||||
exit;
|
||||
|
||||
//Sanity Checks For Meshes Size vs. Count
|
||||
If MemSize(Meshes) < MeshSize[DoFillTriangle]*NumMeshes then
|
||||
If MemSize(Meshes) < PtrUInt(MeshSize[DoFillTriangle]*NumMeshes) then
|
||||
exit;
|
||||
|
||||
For I := 0 to NumMeshes - 1 do begin
|
||||
@ -6979,7 +6982,7 @@ begin
|
||||
DeleteObject(RGN);
|
||||
GetClipBox(DC, @ClipRect);
|
||||
// draw polygon area
|
||||
FillRect(DC, ClipRect, HBrush(GetBrush));
|
||||
FillRect(DC, ClipRect, HBrush(PtrUInt(GetBrush)));
|
||||
// restore old clipping
|
||||
SelectClipRGN(DC, Tmp);
|
||||
DeleteObject(Tmp);
|
||||
@ -7294,7 +7297,7 @@ const
|
||||
begin
|
||||
if (Item^.Data <> Pointer(hndMenu)) // exclude ourself
|
||||
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
|
||||
Result := gtk_radio_menu_item_group(PGtkRadioMenuItem(Item^.Data));
|
||||
Exit;
|
||||
@ -7521,7 +7524,7 @@ begin
|
||||
if CurGDIObject<>nil then begin
|
||||
if CurGDIObject^.Owner<>aDC then
|
||||
RaiseGDBException('');
|
||||
DeleteObject(HGDIOBJ(CurGDIObject));
|
||||
DeleteObject(HGDIOBJ(PtrUInt(CurGDIObject)));
|
||||
if aDC.OwnedGDIObjects[g]<>nil then
|
||||
RaiseGDBException('');
|
||||
end;
|
||||
@ -7752,7 +7755,7 @@ begin
|
||||
OldClipRegion:=ClipRegion;
|
||||
ClipRegion := nil;// decrease DCCount
|
||||
if (OldClipRegion=OwnedGDIObjects[gdiRegion]) then
|
||||
DeleteObject(HGDIOBJ(OldClipRegion));
|
||||
DeleteObject(HGDIOBJ(PtrUInt(OldClipRegion)));
|
||||
end;
|
||||
|
||||
If (RGN = 0) then begin
|
||||
@ -7824,7 +7827,7 @@ var
|
||||
NewDrawable: PGdkPixmap;
|
||||
begin
|
||||
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;
|
||||
|
||||
DevCon.CurrentBitmap := GDIObject;
|
||||
@ -7876,7 +7879,7 @@ begin
|
||||
gdiBrush: begin
|
||||
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;
|
||||
|
||||
DevCon.CurrentBrush := GDIObject;
|
||||
@ -7893,7 +7896,7 @@ begin
|
||||
gdiFont: begin
|
||||
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;
|
||||
|
||||
DevCon.CurrentFont := GDIObject;
|
||||
@ -7906,7 +7909,7 @@ begin
|
||||
end;
|
||||
|
||||
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;
|
||||
|
||||
DevCon.CurrentPen := PGDIObject(GDIObj);
|
||||
@ -7917,7 +7920,7 @@ begin
|
||||
end;
|
||||
|
||||
gdiRegion: begin
|
||||
Result := HRGN(DevCon.ClipRegion);
|
||||
Result := HRGN(PtrUInt(DevCon.ClipRegion));
|
||||
if DevCon.GC <> nil
|
||||
then SelectClipRGN(DC, GDIObj)
|
||||
else DevCon.ClipRegion := nil;
|
||||
@ -9404,7 +9407,7 @@ begin
|
||||
|
||||
aRect := Rect(X+DCOrigin.X,Y+DCOrigin.Y,X + Sz.CX, Sz.CY);
|
||||
//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));
|
||||
TxtPt.X := X;
|
||||
{$IfDef Win32}
|
||||
|
||||
@ -111,7 +111,7 @@ var
|
||||
begin
|
||||
BitBtn := AWinControl as TCustomBitBtn;
|
||||
|
||||
Result := TLCLIntfHandle(gtk_button_new);
|
||||
Result := TLCLIntfHandle(PtrUInt(gtk_button_new));
|
||||
if Result = 0 then Exit;
|
||||
{$IFDEF DebugLCLComponents}
|
||||
DebugGtkWidgets.MarkCreated(Pointer(Result),dbgsName(AWinControl));
|
||||
|
||||
@ -563,7 +563,7 @@ begin
|
||||
csStaticText:
|
||||
begin
|
||||
if TStaticText(AWinControl).ShowAccelChar then begin
|
||||
DC := GetDC(HDC(GetStyleWidget(lgsLabel)));
|
||||
DC := GetDC(HDC(PtrUInt(GetStyleWidget(lgsLabel))));
|
||||
aLabel := TGtkWidgetSet(WidgetSet).ForceLineBreaks(
|
||||
DC, pLabel, TStaticText(AWinControl).Width, false);
|
||||
DeleteDC(DC);
|
||||
@ -743,7 +743,7 @@ begin
|
||||
if V < High(Msg.SmallPos)
|
||||
then Msg.SmallPos := V
|
||||
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;
|
||||
end;
|
||||
@ -805,7 +805,7 @@ begin
|
||||
if V < High(Msg.SmallPos)
|
||||
then Msg.SmallPos := V
|
||||
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;
|
||||
end;
|
||||
@ -823,7 +823,7 @@ begin
|
||||
DebugGtkWidgets.MarkCreated(Widget,dbgsName(AWinControl));
|
||||
{$ENDIF}
|
||||
|
||||
Result := THandle(Widget);
|
||||
Result := THandle(PtrUInt(Widget));
|
||||
if Result = 0 then Exit;
|
||||
|
||||
gtk_widget_show(Widget);
|
||||
|
||||
@ -255,7 +255,7 @@ begin
|
||||
|
||||
gtk_notebook_set_tab_pos(AWidget, GtkPositionTypeMap[TCustomNotebook(AWinControl).TabPosition]);
|
||||
GTKWidgetSet.FinishComponentCreate(AWinControl, AWidget);
|
||||
Result := TLCLIntfHandle(AWidget);
|
||||
Result := TLCLIntfHandle(PtrUInt(AWidget));
|
||||
end;
|
||||
|
||||
class procedure TGtkWSCustomNotebook.AddPage(const ANotebook: TCustomNotebook;
|
||||
@ -593,7 +593,7 @@ begin
|
||||
{$IFDEF DebugLCLComponents}
|
||||
DebugGtkWidgets.MarkCreated(P,dbgsName(AWinControl));
|
||||
{$ENDIF}
|
||||
Result := TLCLIntfHandle(P);
|
||||
Result := TLCLIntfHandle(PtrUInt(P));
|
||||
end;
|
||||
|
||||
class procedure TGtkWSCustomPanel.SetColor(const AWinControl: TWinControl);
|
||||
|
||||
@ -303,7 +303,7 @@ begin
|
||||
{$IFDEF DebugLCLComponents}
|
||||
DebugGtkWidgets.MarkCreated(P,dbgsName(AWinControl));
|
||||
{$ENDIF}
|
||||
Result := TLCLIntfHandle(P);
|
||||
Result := TLCLIntfHandle(PtrUInt(P));
|
||||
end;
|
||||
|
||||
class procedure TGtkWSCustomForm.SetAllowDropFiles(const AForm: TCustomForm;
|
||||
@ -428,7 +428,7 @@ begin
|
||||
{$IFDEF DebugLCLComponents}
|
||||
DebugGtkWidgets.MarkCreated(P,dbgsName(AWinControl));
|
||||
{$ENDIF}
|
||||
Result := TLCLIntfHandle(P);
|
||||
Result := TLCLIntfHandle(PtrUInt(P));
|
||||
end;
|
||||
|
||||
initialization
|
||||
|
||||
@ -146,7 +146,7 @@ begin
|
||||
SetContainerMenuToggleSize;
|
||||
|
||||
if GtkWidgetIsA(MenuItem, GTK_TYPE_RADIO_MENU_ITEM) then
|
||||
TGtkWidgetSet(WidgetSet).RegroupMenuItem(HMENU(MenuItem),GroupIndex);
|
||||
TGtkWidgetSet(WidgetSet).RegroupMenuItem(HMENU(PtrUInt(MenuItem)),GroupIndex);
|
||||
end;
|
||||
//DebugLn('TGtkWidgetSet.AttachMenu END ',AMenuItem.Name,':',AMenuItem.ClassName);
|
||||
end;
|
||||
@ -162,7 +162,7 @@ begin
|
||||
{$IFDEF DebugLCLComponents}
|
||||
DebugGtkWidgets.MarkCreated(MenuItemWidget,dbgsName(AMenuItem));
|
||||
{$ENDIF}
|
||||
Result := THandle(MenuItemWidget);
|
||||
Result := THandle(PtrUInt(MenuItemWidget));
|
||||
end;
|
||||
|
||||
class procedure TGtkWSMenuItem.DestroyHandle(const AMenuItem: TMenuItem);
|
||||
|
||||
@ -167,7 +167,7 @@ begin
|
||||
gtk_adjustment_new(1,1,100,1,1,1)),1,0);
|
||||
gtk_widget_show_all(p);
|
||||
gtkWidgetSet.FinishComponentCreate(AWinControl, P);
|
||||
Result := THandle(P);
|
||||
Result := THandle(PtrUInt(P));
|
||||
end;
|
||||
|
||||
initialization
|
||||
|
||||
@ -540,7 +540,7 @@ begin
|
||||
Widget:=GetWidgetInfo(Pointer(Handle),True)^.CoreWidget;
|
||||
GList:= PGtkCList(Widget)^.selection;
|
||||
while Assigned(GList) do begin
|
||||
if PtrUInt(GList^.data) = AIndex then begin
|
||||
if PtrUInt(GList^.data) = PtrUInt(AIndex) then begin
|
||||
Result:=true;
|
||||
exit;
|
||||
end else
|
||||
@ -934,7 +934,7 @@ begin
|
||||
{$IFDEF DebugLCLComponents}
|
||||
DebugGtkWidgets.MarkCreated(P,dbgsName(AWinControl));
|
||||
{$ENDIF}
|
||||
Result := TLCLIntfHandle(P);
|
||||
Result := TLCLIntfHandle(PtrUInt(P));
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
@ -1054,7 +1054,7 @@ begin
|
||||
{$IFDEF DebugLCLComponents}
|
||||
DebugGtkWidgets.MarkCreated(P, dbgsName(AWinControl));
|
||||
{$ENDIF}
|
||||
Result := TLCLIntfHandle(P);
|
||||
Result := TLCLIntfHandle(PtrUInt(P));
|
||||
end;
|
||||
|
||||
class procedure TGtkWSCustomStaticText.SetAlignment(const ACustomStaticText: TCustomStaticText;
|
||||
@ -1092,7 +1092,7 @@ var
|
||||
Allocation: TGTKAllocation;
|
||||
begin
|
||||
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;
|
||||
{$IFDEF DebugLCLComponents}
|
||||
DebugGtkWidgets.MarkCreated(Pointer(Result),'button');
|
||||
@ -1326,7 +1326,7 @@ begin
|
||||
{$IFDEF DebugLCLComponents}
|
||||
DebugGtkWidgets.MarkCreated(P,dbgsName(AWinControl));
|
||||
{$ENDIF}
|
||||
Result := TLCLIntfHandle(P);
|
||||
Result := TLCLIntfHandle(PtrUInt(P));
|
||||
DebugLn(['TGtkWSCustomMemo.CreateHandle ']);
|
||||
end;
|
||||
|
||||
@ -1496,7 +1496,7 @@ begin
|
||||
{$IFDEF DebugLCLComponents}
|
||||
DebugGtkWidgets.MarkCreated(P,dbgsName(AWinControl));
|
||||
{$ENDIF}
|
||||
Result := TLCLIntfHandle(P);
|
||||
Result := TLCLIntfHandle(PtrUInt(P));
|
||||
end;
|
||||
|
||||
class procedure TGtkWSCustomGroupBox.GetPreferredSize(const AWinControl: TWinControl;
|
||||
|
||||
@ -550,7 +550,7 @@ begin
|
||||
end;
|
||||
|
||||
gdk_pixbuf_unref(pixbuf);
|
||||
Result := HBitmap(Pixmap);
|
||||
Result := HBitmap(PtrUInt(Pixmap));
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
|
||||
@ -106,8 +106,8 @@ begin
|
||||
end;
|
||||
|
||||
// create cursor from pixbuf
|
||||
Result := hCursor(gdk_cursor_new_from_pixbuf(gdk_display_get_default, pixbuf,
|
||||
ACursorInfo^.xHotSpot, ACursorInfo^.yHotSpot));
|
||||
Result := HCursor(PtrUInt(gdk_cursor_new_from_pixbuf(gdk_display_get_default, pixbuf,
|
||||
ACursorInfo^.xHotSpot, ACursorInfo^.yHotSpot)));
|
||||
end;
|
||||
|
||||
function TGtk2WidgetSet.CreateFontIndirectEx(const LogFont: TLogFont;
|
||||
@ -272,7 +272,7 @@ begin
|
||||
end else begin
|
||||
// return the new font
|
||||
GdiObject^.LogFont:=LogFont;
|
||||
Result := HFONT(GdiObject);
|
||||
Result := HFONT(PtrUInt(GdiObject));
|
||||
end;
|
||||
end else begin
|
||||
{$IFDEF VerboseFonts}
|
||||
|
||||
@ -245,7 +245,7 @@ begin
|
||||
HookNoteBookClass;
|
||||
//DebugLn(['TGtk2WSCustomNotebook.CreateHandle ',DbgSName(AWinControl)]);
|
||||
P := PGtkNoteBook(TGtkWSCustomNotebook.CreateHandle(AWinControl, AParams));
|
||||
Result := HWND(P);
|
||||
Result := HWND(PtrUInt(P));
|
||||
end;
|
||||
|
||||
class function TGtk2WSCustomNotebook.GetDefaultClientRect(
|
||||
|
||||
@ -597,6 +597,7 @@ type
|
||||
FOutputStateFile: string;
|
||||
FPackageEditor: TBasePackageEditor;
|
||||
FPackageType: TLazPackageType;
|
||||
FProvides: TStrings;
|
||||
FRSTOutputDirectory: string;
|
||||
fPublishOptions: TPublishPackageOptions;
|
||||
FRemovedFiles: TFPList; // TFPList of TPkgFile
|
||||
@ -630,6 +631,7 @@ type
|
||||
procedure SetLazDocPaths(const AValue: string);
|
||||
procedure SetLicense(const AValue: string);
|
||||
procedure SetOutputStateFile(const AValue: string);
|
||||
procedure SetProvides(const AValue: TStrings);
|
||||
procedure SetRSTOutputDirectory(const AValue: string);
|
||||
procedure SetRegistered(const AValue: boolean);
|
||||
procedure SetModified(const AValue: boolean);
|
||||
@ -734,6 +736,8 @@ type
|
||||
procedure AddUsedByDependency(Dependency: TPkgDependency);
|
||||
procedure RemoveUsedByDependency(Dependency: TPkgDependency);
|
||||
function UsedByDepByIndex(Index: integer): TPkgDependency;
|
||||
// provides
|
||||
function ProvidesPackage(const AName: string): boolean;
|
||||
// ID
|
||||
procedure ChangeID(const NewName: string; NewVersion: TPkgVersion);
|
||||
public
|
||||
@ -784,6 +788,7 @@ type
|
||||
write SetPackageType;
|
||||
property RSTOutputDirectory: string read FRSTOutputDirectory
|
||||
write SetRSTOutputDirectory;
|
||||
property Provides: TStrings read FProvides write SetProvides;
|
||||
property PublishOptions: TPublishPackageOptions
|
||||
read fPublishOptions write fPublishOptions;
|
||||
property Registered: boolean read FRegistered write SetRegistered;
|
||||
@ -2263,6 +2268,13 @@ begin
|
||||
FOutputStateFile:=NewStateFile;
|
||||
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);
|
||||
var
|
||||
NewValue: String;
|
||||
@ -2332,6 +2344,7 @@ begin
|
||||
FUsageOptions.ParsedOpts.OnLocalSubstitute:=@SubstitutePkgMacro;
|
||||
FDefineTemplates:=TLazPackageDefineTemplates.Create(Self);
|
||||
fPublishOptions:=TPublishPackageOptions.Create(Self);
|
||||
FProvides:=TStringList.Create;
|
||||
Clear;
|
||||
FUsageOptions.ParsedOpts.InvalidateGraphOnChange:=true;
|
||||
end;
|
||||
@ -2341,6 +2354,7 @@ begin
|
||||
Include(FFlags,lpfDestroying);
|
||||
Clear;
|
||||
FreeAndNil(fPublishOptions);
|
||||
FreeAndNil(FProvides);
|
||||
FreeAndNil(FDefineTemplates);
|
||||
FreeAndNil(FRemovedFiles);
|
||||
FreeAndNil(FFiles);
|
||||
@ -2402,6 +2416,7 @@ begin
|
||||
FRegistered:=false;
|
||||
FUsageOptions.Clear;
|
||||
fPublishOptions.Clear;
|
||||
FProvides.Clear;
|
||||
UpdateSourceDirectories;
|
||||
// set some nice start values
|
||||
if not (lpfDestroying in FFlags) then begin
|
||||
@ -2542,6 +2557,7 @@ begin
|
||||
PathDelimChanged);
|
||||
fPublishOptions.LoadFromXMLConfig(XMLConfig,Path+'PublishOptions/',
|
||||
PathDelimChanged);
|
||||
LoadStringList(XMLConfig,FProvides,Path+'Provides/');
|
||||
EndUpdate;
|
||||
Modified:=false;
|
||||
UnlockModified;
|
||||
@ -2593,6 +2609,7 @@ begin
|
||||
FFirstRequiredDependency,pdlRequires);
|
||||
FUsageOptions.SaveToXMLConfig(XMLConfig,Path+'UsageOptions/');
|
||||
fPublishOptions.SaveToXMLConfig(XMLConfig,Path+'PublishOptions/');
|
||||
SaveStringList(XMLConfig,FProvides,Path+'Provides/');
|
||||
Modified:=false;
|
||||
end;
|
||||
|
||||
@ -2823,6 +2840,16 @@ begin
|
||||
Result:=GetDependencyWithIndex(FFirstUsedByDependency,pdlUsedBy,Index);
|
||||
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;
|
||||
NewFileType: TPkgFileType; NewFlags: TPkgFileFlags;
|
||||
CompPriorityCat: TComponentPriorityCategory): TPkgFile;
|
||||
|
||||
@ -212,6 +212,8 @@ type
|
||||
ResolveLinks: boolean): TLazPackage;
|
||||
function FindPackageWithID(PkgID: TLazPackageID): TLazPackage;
|
||||
function FindPackageWithIDMask(PkgIDMask: TLazPackageID): TLazPackage;
|
||||
function FindPackageProvidingName(FirstDependency: TPkgDependency;
|
||||
const Name: string): TLazPackage;
|
||||
function FindUnit(StartPackage: TLazPackage; const TheUnitName: string;
|
||||
WithRequiredPackages, IgnoreDeleted: boolean): TPkgFile;
|
||||
function FindUnitInAllPackages(const TheUnitName: string;
|
||||
@ -796,6 +798,31 @@ begin
|
||||
Result:=nil;
|
||||
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;
|
||||
const TheUnitName: string;
|
||||
WithRequiredPackages, IgnoreDeleted: boolean): TPkgFile;
|
||||
|
||||
@ -2110,6 +2110,14 @@ begin
|
||||
Result:=mrCancel;
|
||||
exit;
|
||||
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
|
||||
exit(mrOk);
|
||||
// add a dependency for the package to the project
|
||||
|
||||
@ -98,6 +98,10 @@ type
|
||||
RSTOutputGroupBox: TGroupBox;
|
||||
RSTOutputDirectoryEdit: TEdit;
|
||||
RSTOutputDirectoryButton: TButton;
|
||||
// Provides page
|
||||
ProvidesPage: TPage;
|
||||
ProvidesLabel: TLabel;
|
||||
ProvidesMemo: TMemo;
|
||||
// buttons
|
||||
OkButton: TButton;
|
||||
CancelButton: TButton;
|
||||
@ -123,6 +127,7 @@ type
|
||||
procedure SetupUsagePage(PageIndex: integer);
|
||||
procedure SetupDescriptionPage(PageIndex: integer);
|
||||
procedure SetupIDEPage(PageIndex: integer);
|
||||
procedure SetupProvidesPage(PageIndex: integer);
|
||||
procedure ReadOptionsFromPackage;
|
||||
procedure ReadPkgTypeFromPackage;
|
||||
function GetEditForPathButton(AButton: TPathEditorButton): TEdit;
|
||||
@ -440,11 +445,6 @@ begin
|
||||
|
||||
// Usage page
|
||||
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
|
||||
UnitPath:=TrimSearchPath(UnitPathEdit.Text,'');
|
||||
IncludePath:=TrimSearchPath(IncludePathEdit.Text,'');
|
||||
@ -453,9 +453,20 @@ begin
|
||||
LinkerOptions:=LinkerOptionsMemo.Text;
|
||||
CustomOptions:=CustomOptionsMemo.Text;
|
||||
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.RSTOutputDirectory:=RSTOutputDirectoryEdit.Text;
|
||||
|
||||
// Provides page
|
||||
LazPackage.Provides:=ProvidesMemo.Lines;
|
||||
|
||||
ModalResult:=mrOk;
|
||||
end;
|
||||
|
||||
@ -555,12 +566,14 @@ begin
|
||||
Pages.Add(lisPckOptsUsage);
|
||||
Pages.Add(lisToDoLDescription);
|
||||
Pages.Add(lisPckOptsIDEIntegration);
|
||||
Pages.Add(lisPckOptsProvides);
|
||||
PageIndex:=0;
|
||||
end;
|
||||
|
||||
SetupUsagePage(0);
|
||||
SetupDescriptionPage(1);
|
||||
SetupIDEPage(2);
|
||||
SetupProvidesPage(3);
|
||||
|
||||
OkButton:=TButton.Create(Self);
|
||||
with OkButton do begin
|
||||
@ -812,6 +825,33 @@ begin
|
||||
RSTOutputDirectoryEdit.AnchorToNeighbour(akRight,0,RSTOutputDirectoryButton);
|
||||
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);
|
||||
begin
|
||||
// Usage page
|
||||
@ -990,8 +1030,12 @@ begin
|
||||
CustomOptionsMemo.Text:=CustomOptions;
|
||||
end;
|
||||
|
||||
// IDE integration
|
||||
LazDocPathEdit.Text:=LazPackage.LazDocPaths;
|
||||
RSTOutputDirectoryEdit.Text:=LazPackage.RSTOutputDirectory;
|
||||
|
||||
// Provides
|
||||
ProvidesMemo.Lines.Assign(LazPackage.Provides);
|
||||
end;
|
||||
|
||||
procedure TPackageOptionsDialog.ReadPkgTypeFromPackage;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user