diff --git a/Makefile b/Makefile
index 5bbdc3c307..f240415927 100644
--- a/Makefile
+++ b/Makefile
@@ -1,8 +1,8 @@
#
-# Don't edit, this file is generated by FPCMake Version 2.0.0 [2005/09/23]
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2005/11/15]
#
default: all
-MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-emx i386-watcom i386-netwlibc i386-wince m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos powerpc-linux powerpc-netbsd powerpc-macos powerpc-darwin powerpc-morphos sparc-linux sparc-netbsd sparc-solaris x86_64-linux x86_64-freebsd x86_64-win64 arm-linux arm-wince
+MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-emx i386-watcom i386-netwlibc i386-wince m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos powerpc-linux powerpc-netbsd powerpc-macos powerpc-darwin powerpc-morphos sparc-linux sparc-netbsd sparc-solaris x86_64-linux x86_64-freebsd x86_64-win64 arm-linux arm-wince powerpc64-linux
BSDs = freebsd netbsd openbsd darwin
UNIXs = linux $(BSDs) solaris qnx
LIMIT83fs = go32v2 os2 emx watcom
@@ -345,6 +345,9 @@ endif
ifeq ($(FULL_TARGET),arm-wince)
override TARGET_DIRS+=lcl components packager/registration ideintf designer packager
endif
+ifeq ($(FULL_TARGET),powerpc64-linux)
+override TARGET_UNITS+=runtimetypeinfocontrols.pas
+endif
ifeq ($(FULL_TARGET),i386-linux)
override TARGET_PROGRAMS+=lazarus startlazarus
endif
@@ -453,6 +456,9 @@ endif
ifeq ($(FULL_TARGET),arm-wince)
override TARGET_PROGRAMS+=lazarus startlazarus
endif
+ifeq ($(FULL_TARGET),powerpc64-linux)
+override CLEAN_FILES+=$(wildcard $(COMPILER_UNITTARGETDIR)/*$(OEXT)) $(wildcard $(COMPILER_UNITTARGETDIR)/*$(PPUEXT)) $(wildcard $(COMPILER_UNITTARGETDIR)/*$(RSTEXT)) $(wildcard *$(OEXT)) $(wildcard *$(PPUEXT)) $(wildcard *$(RSTEXT))
+endif
ifeq ($(FULL_TARGET),i386-linux)
override TARGET_EXAMPLEDIRS+=examples
endif
@@ -561,6 +567,9 @@ endif
ifeq ($(FULL_TARGET),arm-wince)
override TARGET_EXAMPLEDIRS+=examples
endif
+ifeq ($(FULL_TARGET),powerpc64-linux)
+override COMPILER_OPTIONS+=-gl
+endif
ifeq ($(FULL_TARGET),i386-linux)
override CLEAN_FILES+=$(wildcard *$(OEXT)) $(wildcard *$(PPUEXT)) $(wildcard *$(RSTEXT))
endif
@@ -3344,6 +3353,9 @@ packager:
$(MAKE) -C packager all
.PHONY: packager_all packager_debug packager_smart packager_release packager_units packager_examples packager_shared packager_install packager_sourceinstall packager_exampleinstall packager_distinstall packager_zipinstall packager_zipsourceinstall packager_zipexampleinstall packager_zipdistinstall packager_clean packager_distclean packager_cleanall packager_info packager_makefiles packager
endif
+ifeq ($(FULL_TARGET),powerpc64-linux)
+override COMPILER_UNITDIR+=../../ideintf/units/$(CPU_TARGET)-$(OS_TARGET)/ ../../lcl/units/$(CPU_TARGET)-$(OS_TARGET)/ ../../lcl/units/$(CPU_TARGET)-$(OS_TARGET)/$(LCL_PLATFORM)/ ../../packager/units/$(CPU_TARGET)-$(OS_TARGET)/ ./
+endif
ifeq ($(FULL_TARGET),i386-linux)
TARGET_EXAMPLEDIRS_EXAMPLES=1
endif
diff --git a/components/opengl/glcarbonaglcontext.pas b/components/opengl/glcarbonaglcontext.pas
index 5a5c540f4f..a57a568d3a 100644
--- a/components/opengl/glcarbonaglcontext.pas
+++ b/components/opengl/glcarbonaglcontext.pas
@@ -20,8 +20,9 @@ unit GLCarbonAGLContext;
interface
uses
- Classes, SysUtils, LCLProc, LCLType, gl,
- FPCMacOSAll, InterfaceBase, CarbonInt,
+ Classes, SysUtils, LCLProc, LCLType, gl, Forms,
+ FPCMacOSAll, CarbonInt, AGL, CarbonProc, CarbonDef, CarbonPrivate,
+ CarbonUtils,
Controls;
procedure LOpenGLViewport(Left, Top, Width, Height: integer);
@@ -31,38 +32,137 @@ function LOpenGLCreateContext(AWinControl: TWinControl;
SharedControl: TWinControl; AttrList: PInteger): HWND;
const
- DefaultOpenGLContextInitAttrList: array [0..10] of LongInt = (
- GDK_GL_RGBA,
- GDK_GL_RED_SIZE, 1,
- GDK_GL_GREEN_SIZE, 1,
- GDK_GL_BLUE_SIZE, 1,
- GDK_GL_DEPTH_SIZE, 1,
- GDK_GL_DOUBLEBUFFER,
- GDK_GL_None
+ DefaultOpenGLContextInitAttrList: array [0..5] of LongInt = (
+ AGL_WINDOW,
+ AGL_RGBA,
+ AGL_NO_RECOVERY,
+ AGL_DOUBLEBUFFER,
+ AGL_SINGLE_RENDERER,
+ AGL_NONE
);
+
+type
+ TAGLControlInfo = record
+ Control: ControlRef;
+ AGLContext: TAGLContext;
+ end;
+ PAGLControlInfo = ^TAGLControlInfo;
+var
+ AGLControlInfo_FOURCC: FourCharCode;
+
+function CreateAGLControlInfo(Control: ControlRef; AGLContext: TAGLContext
+ ): PAGLControlInfo;
+function GetAGLControlInfo(Control: ControlRef): PAGLControlInfo;
+procedure FreeAGLControlInfo(Control: ControlRef);
+function GetAGLContext(Control: ControlRef): TAGLContext;
implementation
procedure LOpenGLViewport(Left, Top, Width, Height: integer);
begin
-
+ glViewport(Left,Top,Width,Height);
end;
procedure LOpenGLSwapBuffers(Handle: HWND);
+var
+ AGLContext: TAGLContext;
begin
-
+ AGLContext:=GetAGLContext(ControlRef(Handle));
+ aglSwapBuffers(AGLContext);
end;
function LOpenGLMakeCurrent(Handle: HWND): boolean;
+var
+ AGLContext: TAGLContext;
begin
-
+ AGLContext:=GetAGLContext(ControlRef(Handle));
+ Result:=aglSetCurrentContext(aglContext)<>0;
end;
function LOpenGLCreateContext(AWinControl: TWinControl;
SharedControl: TWinControl; AttrList: PInteger): HWND;
+var
+ disp: GDHandle;
+ aglPixFmt: TAGLPixelFormat;
+ aglContext: TAGLContext;
+ ACarbonWindow: WindowRef;
+ CFString: CFStringRef;
+ Control: ControlRef;
+ R: FPCMacOSAll.Rect;
+ Info: PWidgetInfo;
+ WSPrivate: TClass;
+ ParentWindow: WindowPtr;
begin
+ if AWinControl.Parent=nil then
+ RaiseGDBException('GLCarbonAGLContext.LOpenGLCreateContext no parent');
+ ParentWindow:=WindowRef(AWinControl.Parent.Handle);
+ // create a dummy control
+ R:=GetCarbonRect(AWinControl.BoundsRect);
+ Control:=nil;
+ CFString := CFStringCreateWithCString(nil, Pointer(PChar('SubControl')),
+ kCFStringEncodingUTF8);
+ if CreatePushButtonControl(ParentWindow, R, CFString, Control) <> noErr
+ then
+ debugln('CreatePushButtonControl failed');
+ CFRelease(Pointer(CFString));
+
+ // create LCL WidgetInfo
+ Result:=HWnd(Control);
+ Info := CreateWidgetInfo(Control, AWinControl);
+ WSPrivate:=nil;
+ TCarbonPrivateHandleClass(WSPrivate).RegisterEvents(Info);
+
+ // create the AGL context
+ disp := GetMainDevice ();
+ aglPixFmt := aglChoosePixelFormat (@disp, 1, AttrList);
+ aglContext := aglCreateContext (aglPixFmt, NIL);
+ aglDestroyPixelFormat(aglPixFmt);
+
+ // use the carbon window.
+ // TODO: find a way to use only the control for the context
+ ACarbonWindow:=WindowRef(GetParentForm(AWinControl).Handle);
+ aglSetDrawable(aglContext,GetWindowPort(ACarbonWindow));
+
+ AGLControlInfo_FOURCC := MakeFourCC('ACI ');
+
+ CreateAGLControlInfo(Control,AGLContext);
+end;
+
+function CreateAGLControlInfo(Control: ControlRef; AGLContext: TAGLContext
+ ): PAGLControlInfo;
+begin
+ New(Result);
+ FillChar(Result^, SizeOf(Result^), 0);
+ Result^.Control:=Control;
+ Result^.AGLContext:=AGLContext;
+
+ SetControlProperty(Control, LAZARUS_FOURCC, AGLControlInfo_FOURCC,
+ SizeOf(Result), @Result);
+end;
+
+function GetAGLControlInfo(Control: ControlRef): PAGLControlInfo;
+var
+ m: LongWord;
+begin
+ GetControlProperty(Control, LAZARUS_FOURCC, AGLControlInfo_FOURCC,
+ SizeOf(Result), @m, @Result);
+end;
+
+procedure FreeAGLControlInfo(Control: ControlRef);
+var
+ Info: PAGLControlInfo;
+begin
+ Info:=GetAGLControlInfo(Control);
+ if Info=nil then exit;
+ RemoveControlProperty(Control, LAZARUS_FOURCC, AGLControlInfo_FOURCC);
+ System.FreeMem(Info);
+end;
+
+function GetAGLContext(Control: ControlRef): TAGLContext;
+begin
+ Result:=GetAGLControlInfo(Control)^.AGLContext;
end;
end.
diff --git a/components/opengl/lazopenglcontext.lpk b/components/opengl/lazopenglcontext.lpk
index 89f54aea86..349fb2d43a 100644
--- a/components/opengl/lazopenglcontext.lpk
+++ b/components/opengl/lazopenglcontext.lpk
@@ -14,7 +14,7 @@
-
+
@@ -30,6 +30,11 @@
+
+
+
+
+
diff --git a/components/opengl/openglcontext.pas b/components/opengl/openglcontext.pas
index ad2348f41a..1f5b3d053e 100644
--- a/components/opengl/openglcontext.pas
+++ b/components/opengl/openglcontext.pas
@@ -18,7 +18,7 @@
- gtk with glx : fully
- gtk2 with glx : todo
- carbon with agl : todo
- - windows with ? : todo
+ - windows with wgl: todo
}
unit OpenGLContext;
diff --git a/components/synedit/syntextdrawer.pp b/components/synedit/syntextdrawer.pp
index 92a9e4b962..9600895db9 100644
--- a/components/synedit/syntextdrawer.pp
+++ b/components/synedit/syntextdrawer.pp
@@ -729,7 +729,8 @@ begin
{$ENDIF}
end;
{$IFDEF SYN_LAZARUS}
- //debugln('TheFontStock.InternalCreateFont A ',FBaseFontName);
+ //debugln('TheFontStock.InternalCreateFont ------------------------------');
+ //debugln('TheFontStock.InternalCreateFont A ',FBaseFontName,' ',dbgs(AStyle));
Result := CreateFontIndirectEx(FBaseLF,FBaseFontName);
{$ELSE}
Result := CreateFontIndirect(FBaseLF);
@@ -833,7 +834,11 @@ begin
{$ELSE}
ASSERT(SizeOf(TFontStyles) = 1);
{$ENDIF}
+ {$IFDEF SYN_LAZARUS}
+ idx := integer(Value);
+ {$ELSE}
idx := PByte(@Value)^;
+ {$ENDIF}
ASSERT(idx <= High(TheStockFontPatterns));
UseFontHandles;
@@ -1129,7 +1134,11 @@ procedure TheTextDrawer2.SetStyle(Value: TFontStyles);
var
idx: Integer;
begin
+ {$IFDEF SYN_LAZARUS}
+ idx := integer(Value);
+ {$ELSE}
idx := PByte(@Value)^;
+ {$ENDIF}
if FFonts[idx] <> 0 then
begin
FCrntFont := FFonts[idx];
diff --git a/ide/codetemplatesdlg.pas b/ide/codetemplatesdlg.pas
index fd52248298..c86f5d45ea 100644
--- a/ide/codetemplatesdlg.pas
+++ b/ide/codetemplatesdlg.pas
@@ -331,9 +331,10 @@ function CodeMakroProcedureName(const Parameter: string;
InteractiveValue: TPersistent; SrcEdit: TSourceEditorInterface; var Value,
ErrorMsg: string): boolean;
begin
- Result:=CodeMakroProcedureName(
+ Result:=CodeMakroProcedureHead(
'WithoutParamList,WithoutBrackets,WithoutSemicolon',
InteractiveValue,SrcEdit,Value,ErrorMsg);
+ debugln('CodeMakroProcedureName ',Value);
end;
procedure RegisterStandardCodeTemplatesMenuItems;
@@ -390,7 +391,7 @@ begin
@CodeMakroProcedureHead,nil);
RegisterCodeMacro('ProcedureName','insert procedure name',
'Insert name of current procedure',
- @CodeMakroProcedureHead,nil);
+ @CodeMakroProcedureName,nil);
end;
{ TCodeTemplateEditForm }
diff --git a/ide/compileroptions.pp b/ide/compileroptions.pp
index 6de506f578..f17fa8d078 100644
--- a/ide/compileroptions.pp
+++ b/ide/compileroptions.pp
@@ -1221,6 +1221,8 @@ begin
OutFilename:=TargetFilename
else
OutFilename:=lowercase(ExtractFileNameOnly(MainSourceFileName));
+ debugln('TBaseCompilerOptions.CreateTargetFilename MainSourceFileName=',MainSourceFileName,' OutFilename=',OutFilename,' TargetFilename=',TargetFilename);
+
Result:=AppendPathDelim(UnitOutDir)+OutFilename;
end;
Result:=TrimFilename(Result);
diff --git a/ide/main.pp b/ide/main.pp
index 92b01c79d0..ef6883bdd7 100644
--- a/ide/main.pp
+++ b/ide/main.pp
@@ -7258,7 +7258,8 @@ begin
end;
// execute compilation tool 'Before'
- ToolBefore:=TProjectCompilationToolOptions(Project1.CompilerOptions.ExecuteBefore);
+ ToolBefore:=TProjectCompilationToolOptions(
+ Project1.CompilerOptions.ExecuteBefore);
if (AReason in ToolBefore.CompileReasons) then begin
Result:=DoExecuteCompilationTool(Project1.CompilerOptions.ExecuteBefore,
Project1.ProjectDirectory,
diff --git a/lcl/graphics.pp b/lcl/graphics.pp
index 5f5716014d..82f5b12783 100644
--- a/lcl/graphics.pp
+++ b/lcl/graphics.pp
@@ -1375,10 +1375,29 @@ const
(***************************************************************************
***************************************************************************)
+function DbgS(const Style: TFontStyles): string; overload;
+
procedure Register;
implementation
+function DbgS(const Style: TFontStyles): string;
+
+ procedure Add(const s: string);
+ begin
+ if Result<>'' then Result:=Result+',';
+ Result:=Result+s;
+ end;
+
+begin
+ Result:='';
+ if fsBold in Style then Add('fsBold');
+ if fsItalic in Style then Add('fsItalic');
+ if fsStrikeOut in Style then Add('fsStrikeOut');
+ if fsUnderline in Style then Add('fsUnderline');
+ Result:='['+Result+']';
+end;
+
procedure Register;
begin
RegisterClasses([TBitmap,TPixmap,TPortableNetworkGraphic,TPortableAnyMapGraphic,TPicture,
diff --git a/lcl/interfaces/carbon/carbonproc.pp b/lcl/interfaces/carbon/carbonproc.pp
index 54fd6942dd..a291674e49 100644
--- a/lcl/interfaces/carbon/carbonproc.pp
+++ b/lcl/interfaces/carbon/carbonproc.pp
@@ -30,7 +30,7 @@ unit CarbonProc;
interface
uses
- FPCMacOSAll,
+ FPCMacOSAll, Classes,
LCLProc, LCLClasses, Controls, LMessages, Forms, Avl_Tree, SysUtils,
CarbonDef;
@@ -43,7 +43,10 @@ function DeliverMessage(ATarget: TObject; var AMessage): Integer;
function RegisterEventHandler(AHandler: TCarbonWSEventHandlerProc): EventHandlerUPP;
procedure UnRegisterEventHandler(AHandler: TCarbonWSEventHandlerProc);
-function Dbgs(const ARect: FPCMacOSAll.Rect): string;
+function GetCarbonRect(Left, Top, Width, Height: Integer): FPCMacOSAll.Rect;
+function GetCarbonRect(const ARect: TRect): FPCMacOSAll.Rect;
+
+function Dbgs(const ARect: FPCMacOSAll.Rect): string; overload;
implementation
@@ -216,6 +219,22 @@ begin
UPPTree.Delete(node);
end;
+function GetCarbonRect(Left, Top, Width, Height: Integer): FPCMacOSAll.Rect;
+begin
+ Result.left:=Left;
+ Result.top:=Top;
+ Result.right:=Left+Width;
+ Result.bottom:=Top+Height;
+end;
+
+function GetCarbonRect(const ARect: TRect): FPCMacOSAll.Rect;
+begin
+ Result.left:=ARect.Left;
+ Result.top:=ARect.Top;
+ Result.right:=ARect.Right;
+ Result.bottom:=ARect.Bottom;
+end;
+
function Dbgs(const ARect: FPCMacOSAll.Rect): string;
begin
Result:=IntToStr(ARect.left)+','+IntToStr(ARect.top)
diff --git a/lcl/interfaces/carbon/carbonwsbuttons.pp b/lcl/interfaces/carbon/carbonwsbuttons.pp
index 5d23c0eb77..2b011e41d6 100644
--- a/lcl/interfaces/carbon/carbonwsbuttons.pp
+++ b/lcl/interfaces/carbon/carbonwsbuttons.pp
@@ -75,16 +75,14 @@ var
//Button: TCustomButton;
Control: ControlRef;
CFString: CFStringRef;
- R: Rect;
+ R: FPCMacOSAll.Rect;
Info: PWidgetInfo;
begin
Result := 0;
//Button := AWinControl as TCustomButton;
- R.Left := AParams.X;
- R.Top := AParams.Y;
- R.Right := AParams.X + AParams.Width;
- R.Bottom := AParams.Y + AParams.Height;
+ R:=GetCarbonRect(AParams.X,AParams.Y,
+ AParams.X + AParams.Width,AParams.Y + AParams.Height);
CFString := CFStringCreateWithCString(nil, Pointer(AParams.Caption),
DEFAULT_CFSTRING_ENCODING);
diff --git a/lcl/interfaces/carbon/carbonwscontrols.pp b/lcl/interfaces/carbon/carbonwscontrols.pp
index 7fc9f9a8f2..8a37549619 100644
--- a/lcl/interfaces/carbon/carbonwscontrols.pp
+++ b/lcl/interfaces/carbon/carbonwscontrols.pp
@@ -30,7 +30,7 @@ uses
// libs
FPCMacOSAll, CarbonUtils, CarbonExtra, Classes,
// LCL
- Controls, LCLType, LMessages, LCLProc,
+ Forms, Controls, LCLType, LMessages, LCLProc,
// widgetset
WSControls, WSLCLClasses, WSProc,
// interface
@@ -83,6 +83,7 @@ type
private
protected
public
+ class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override;
end;
{ TCarbonWSImageList }
@@ -133,17 +134,31 @@ class procedure TCarbonWSWinControl.SetBounds(const AWinControl: TWinControl;
const ALeft, ATop, AWidth, AHeight: Integer);
var
NewBounds: FPCMacOSAll.Rect;
+ //OldBounds: FPCMacOSAll.Rect;
begin
- if not WSCheckHandleAllocated(AWinControl, 'GetText') then Exit;
+ if not WSCheckHandleAllocated(AWinControl, 'SetBounds') then Exit;
NewBounds.left:=AWinControl.Left;
NewBounds.top:=AWinControl.Top;
NewBounds.right:=AWinControl.Left+AWinControl.Width;
NewBounds.bottom:=AWinControl.Top+AWinControl.Height;
DebugLn('TCarbonWSWinControl.SetBounds ',dbgsName(AWinControl),' NewBounds=',dbgs(NewBounds));
- if SetWindowBounds(WindowRef(AWinControl.Handle),kWindowStructureRgn,NewBounds)
- <> NoErr then begin
- DebugLn('TCarbonWSWinControl.SetBounds ',dbgsName(AWinControl),' failed');
+ if AWinControl is TCustomForm then begin
+ if SetWindowBounds(WindowRef(AWinControl.Handle),kWindowStructureRgn,NewBounds)
+ <> NoErr then begin
+ DebugLn('TCarbonWSWinControl.SetBounds ',dbgsName(AWinControl),' failed');
+ end;
+ end else begin
+ //GetControlBounds(ControlRef(AWinControl.Handle),OldBounds);
+ //debugln('TCarbonWSWinControl.SetBounds OldBounds=',dbgs(OldBounds));
+ SetControlBounds(ControlRef(AWinControl.Handle),NewBounds);
+ {if AWinControl.Parent<>nil then begin
+ dec(OldBounds.Left,10);
+ dec(OldBounds.Top,10);
+ inc(OldBounds.right,10);
+ inc(OldBounds.bottom,10);
+ InvalWindowRect(WindowRef(AWinControl.Parent.Handle),OldBounds);
+ end;}
end;
end;
@@ -198,6 +213,36 @@ begin
ARect.Bottom := ARect.Top + Trunc(AHIRect.size.height);
end;
+{ TCarbonWSCustomControl }
+
+function TCarbonWSCustomControl.CreateHandle(const AWinControl: TWinControl;
+ const AParams: TCreateParams): TLCLIntfHandle;
+var
+ //Button: TCustomButton;
+ Control: ControlRef;
+ CFString: CFStringRef;
+ R: FPCMacOSAll.Rect;
+ Info: PWidgetInfo;
+begin
+ Result := 0;
+ //Button := AWinControl as TCustomButton;
+
+ R:=GetCarbonRect(AParams.X,AParams.Y,
+ AParams.X + AParams.Width,AParams.Y + AParams.Height);
+
+ CFString := CFStringCreateWithCString(nil, Pointer(AParams.Caption),
+ DEFAULT_CFSTRING_ENCODING);
+ if CreatePushButtonControl(WindowRef(AParams.WndParent), R,
+ CFString, Control) = noErr
+ then
+ Result := TLCLIntfHandle(Control);
+ CFRelease(Pointer(CFString));
+ if Result = 0 then Exit;
+
+ Info := CreateWidgetInfo(Control, AWinControl);
+ TCarbonPrivateHandleClass(WSPrivate).RegisterEvents(Info);
+end;
+
initialization
////////////////////////////////////////////////////
@@ -210,7 +255,7 @@ initialization
// RegisterWSComponent(TControl, TCarbonWSControl);
RegisterWSComponent(TWinControl, TCarbonWSWinControl, TCarbonPrivateHiView);
// RegisterWSComponent(TGraphicControl, TCarbonWSGraphicControl);
-// RegisterWSComponent(TCustomControl, TCarbonWSCustomControl);
+ RegisterWSComponent(TCustomControl, TCarbonWSCustomControl);
// RegisterWSComponent(TImageList, TCarbonWSImageList);
////////////////////////////////////////////////////
diff --git a/lcl/interfaces/carbon/carbonwsforms.pp b/lcl/interfaces/carbon/carbonwsforms.pp
index a72355f22c..9e494ad4c1 100644
--- a/lcl/interfaces/carbon/carbonwsforms.pp
+++ b/lcl/interfaces/carbon/carbonwsforms.pp
@@ -128,6 +128,8 @@ var
NewBounds: FPCMacOSAll.Rect;
Info: PWidgetInfo;
NewWindowClass: Integer;
+ MinSize: HISize;
+ MaxSize: HISize;
begin
Result := 0;
@@ -157,6 +159,16 @@ begin
Info := CreateWidgetInfo(Window, AWinControl);
TCarbonPrivateHandleClass(WSPrivate).RegisterEvents(Info);
+
+ MinSize.width:=AWinControl.Constraints.EffectiveMinWidth;
+ MinSize.height:=AWinControl.Constraints.EffectiveMinHeight;
+ MaxSize.width:=AWinControl.Constraints.EffectiveMaxWidth;
+ MaxSize.height:=AWinControl.Constraints.EffectiveMaxHeight;
+ if MaxSize.width<=0 then
+ MaxSize.width:=10000;
+ if MaxSize.height<=0 then
+ MaxSize.height:=10000;
+ SetWindowResizeLimits(Window,@MinSize,@MaxSize);
// The window was created hidden so show it.
ShowWindow(Window);
diff --git a/lcl/interfaces/gtk/gtkcallback.inc b/lcl/interfaces/gtk/gtkcallback.inc
index 62bacb09e1..16752cc468 100644
--- a/lcl/interfaces/gtk/gtkcallback.inc
+++ b/lcl/interfaces/gtk/gtkcallback.inc
@@ -1594,6 +1594,7 @@ var
FileName : string;
Files: TStringList;
CurFilename: string;
+ //SelectedFont: PGdkFont;
function CheckOpenedFilename(const AFilename: string): boolean;
begin
@@ -1709,6 +1710,10 @@ begin
Assert(False, 'Trace:Pressed OK in FontDialog');
FontName := gtk_font_selection_dialog_get_font_name(
pgtkfontselectiondialog(FPointer));
+ //debugln('gtkDialogOKclickedCB FontName=',FontName);
+ //SelectedFont:=gdk_font_load(PChar(FontName));
+ //debugln('gtkDialogOKclickedCB ',dbgs(SelectedFont));
+
// extract basic font attributes from the font name in XLFD format
ALogFont:=XLFDNameToLogFont(FontName);
TFontDialog(theDialog).Font.Assign(ALogFont);
diff --git a/lcl/interfaces/gtk/gtkwinapi.inc b/lcl/interfaces/gtk/gtkwinapi.inc
index b92de64ffa..f4c951ca27 100644
--- a/lcl/interfaces/gtk/gtkwinapi.inc
+++ b/lcl/interfaces/gtk/gtkwinapi.inc
@@ -1275,6 +1275,8 @@ begin
Result:=0;
end;
{$Else}
+
+{off $DEFINE VerboseFonts}
var
GdiObject: PGdiObject;
FontNameRegistry, Foundry, FamilyName, WeightName,
@@ -1320,8 +1322,7 @@ var
CharSetRegistry, CharSetCoding
]);}
- //DebugLn(' Trying "',S,'"');
- DebugLn(' Trying Font "',S,'"');
+ //DebugLn(' Trying Font "',S,'"');
result := LoadFontXLFD(S);
end;
@@ -1335,6 +1336,7 @@ var
Tail := '-'+SetwidthName+'-'+AddStyleName+'-'+PixelSize
+'-'+PointSize+'-'+ResolutionX+'-'+ResolutionY+'-'+Spacing
+'-'+AverageWidth+'-'+CharSetRegistry+'-'+CharSetCoding;
+ //debugln('LoadFontExCharset Head=',Head,' Tail=',Tail);
for i:=0 to WeightList.Count-1 do begin
aSlant := Slant;
repeat
@@ -1347,6 +1349,7 @@ var
break;
until false;
end;
+ //debugln('LoadFontExCharset END');
end;
function LoadFontEx: boolean;
@@ -1354,6 +1357,7 @@ var
j: integer;
begin
Result := false;
+ //debugln('LoadFontEx START CharSetRegistry=',CharSetRegistry);
if CharSetRegistry<>'*' then
result := LoadFontExCharset
else
@@ -1367,6 +1371,7 @@ var
if result then
break;
end;
+ //debugln('LoadFontEx END');
end;
procedure LoadDefaultFont;
@@ -1649,7 +1654,7 @@ begin
// next checks are fall over
{$IFDEF VerboseFonts}
- write('CreateFontIndirect->');
+ debugln('TGtkWidgetSet.CreateFontIndirectEx ');
{$ENDIF}
{
if LoadFont then exit;
@@ -1658,11 +1663,23 @@ begin
WeightName := '*';
if LoadFont then exit;
}
- // try one height lower
+ // try one height smaller
+ {$IFDEF VerboseFonts}
+ debugln('TGtkWidgetSet.CreateFontIndirectEx try one height smaller');
+ {$ENDIF}
PixelSize := IntToStr(Abs(LogFont.lfHeight)-1);
+ // Since we use pixelsize, it isn't allowed to give a value here
+ PointSize := '*';
+
+ // Use the default
+ ResolutionX := '*';
+ ResolutionY := '*';
if LoadFont then exit;
- // try one height higher
+ // try one height bigger
+ {$IFDEF VerboseFonts}
+ debugln('TGtkWidgetSet.CreateFontIndirectEx try one height bigger');
+ {$ENDIF}
PixelSize := IntToStr(Abs(LogFont.lfHeight)+1);
if LoadFont then exit;
@@ -1670,6 +1687,9 @@ begin
// try instead of mono spaced -> character cell spaced
if (Spacing='m') then begin
+ {$IFDEF VerboseFonts}
+ debugln('TGtkWidgetSet.CreateFontIndirectEx try instead of mono spaced -> character cell spaced');
+ {$ENDIF}
Spacing:='c';
if LoadFont then exit;
end;
@@ -1686,11 +1706,17 @@ begin
}
// try all spacings
if spacing<>'*' then begin
+ {$IFDEF VerboseFonts}
+ debugln('TGtkWidgetSet.CreateFontIndirectEx try all spacings');
+ {$ENDIF}
Spacing := '*';
if LoadFont then exit;
end;
if charSetCoding<>'*' then begin
+ {$IFDEF VerboseFonts}
+ debugln('TGtkWidgetSet.CreateFontIndirectEx try all charsets');
+ {$ENDIF}
charsetCoding := '*';
charSetRegistry:= '*';
if LoadFont then exit;
@@ -1698,6 +1724,9 @@ begin
if (Foundry<>'*') then begin
// try all Families
+ {$IFDEF VerboseFonts}
+ debugln('TGtkWidgetSet.CreateFontIndirectEx try all families');
+ {$ENDIF}
PixelSize := IntToStr(Abs(LogFont.lfHeight));
FamilyName := '*';
if LoadFont then exit;
diff --git a/lcl/lclproc.pas b/lcl/lclproc.pas
index 3123682635..98857d8f8b 100644
--- a/lcl/lclproc.pas
+++ b/lcl/lclproc.pas
@@ -147,24 +147,24 @@ procedure DbgOut(const s1,s2,s3,s4,s5,s6,s7,s8,s9,s10: string);
procedure DbgOut(const s1,s2,s3,s4,s5,s6,s7,s8,s9,s10,s11: string);
procedure DbgOut(const s1,s2,s3,s4,s5,s6,s7,s8,s9,s10,s11,s12: string);
-function DbgS(const c: cardinal): string;
-function DbgS(const i: longint): string;
-function DbgS(const i: int64): string;
-function DbgS(const r: TRect): string;
-function DbgS(const p: TPoint): string;
-function DbgS(const p: pointer): string;
-function DbgS(const e: extended): string;
-function DbgS(const b: boolean): string;
-function DbgSName(const p: TObject): string;
-function DbgSName(const p: TClass): string;
-function DbgStr(const StringWithSpecialChars: string): string;
-function DbgWideStr(const StringWithSpecialChars: widestring): string;
-function dbgMemRange(P: PByte; Count: integer; Width: integer = 0): string;
-function dbgMemStream(MemStream: TCustomMemoryStream; Count: integer): string;
-function dbgObjMem(AnObject: TObject): string;
+function DbgS(const c: cardinal): string; overload;
+function DbgS(const i: longint): string; overload;
+function DbgS(const i: int64): string; overload;
+function DbgS(const r: TRect): string; overload;
+function DbgS(const p: TPoint): string; overload;
+function DbgS(const p: pointer): string; overload;
+function DbgS(const e: extended): string; overload;
+function DbgS(const b: boolean): string; overload;
+function DbgSName(const p: TObject): string; overload;
+function DbgSName(const p: TClass): string; overload;
+function DbgStr(const StringWithSpecialChars: string): string; overload;
+function DbgWideStr(const StringWithSpecialChars: widestring): string; overload;
+function dbgMemRange(P: PByte; Count: integer; Width: integer = 0): string; overload;
+function dbgMemStream(MemStream: TCustomMemoryStream; Count: integer): string; overload;
+function dbgObjMem(AnObject: TObject): string; overload;
-function DbgS(const i1,i2,i3,i4: integer): string;
-function DbgS(const Shift: TShiftState): string;
+function DbgS(const i1,i2,i3,i4: integer): string; overload;
+function DbgS(const Shift: TShiftState): string; overload;
// some string manipulation functions
function StripLN(const ALine: String): String;
@@ -831,6 +831,7 @@ end;
procedure InitializeDebugOutput;
var
DebugFileName: string;
+
function GetDebugFileName: string;
const
DebugLogStart = '--debug-log=';
@@ -855,6 +856,7 @@ var
if (length(result)>0) then
Result := ExpandFileName(Result);
end;
+
begin
DebugFileName := GetDebugFileName;
if (length(DebugFileName)>0) and