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