From dd02769d5f6371af3389b22093a193b2f698190e Mon Sep 17 00:00:00 2001 From: tombo Date: Thu, 26 Apr 2007 11:18:35 +0000 Subject: [PATCH] Carbon intf: - improved TScrollingWinControl - moved some DbgS to LCLProc git-svn-id: trunk@11006 - --- lcl/interfaces/carbon/carbondebug.inc | 3 +- lcl/interfaces/carbon/carbonprivate.pp | 49 +++++++++++++++++++ .../carbon/carbonprivatecontrol.inc | 8 +-- lcl/interfaces/carbon/carbonproc.pp | 33 ------------- 4 files changed, 55 insertions(+), 38 deletions(-) diff --git a/lcl/interfaces/carbon/carbondebug.inc b/lcl/interfaces/carbon/carbondebug.inc index abf0b043e2..cf525564f2 100644 --- a/lcl/interfaces/carbon/carbondebug.inc +++ b/lcl/interfaces/carbon/carbondebug.inc @@ -31,7 +31,8 @@ {off $DEFINE VerboseKeyboard} {off $DEFINE VerbosePaint} {off $DEFINE VerboseCanvas} -{$DEFINE VerboseMenu} // Carbon menu +{off $DEFINE VerboseMenu} // Carbon menu +{$DEFINE VerboseScroll} // Carbon scrollable {off $DEFINE VerboseWidget} // Carbon widget {off $DEFINE VerboseAppEvent} // Carbon application event handlers diff --git a/lcl/interfaces/carbon/carbonprivate.pp b/lcl/interfaces/carbon/carbonprivate.pp index d3f1cfa414..80c02f8420 100644 --- a/lcl/interfaces/carbon/carbonprivate.pp +++ b/lcl/interfaces/carbon/carbonprivate.pp @@ -218,6 +218,8 @@ type procedure Draw; override; public function GetPreferredSize: TPoint; override; + procedure SetColor(const AColor: TColor); override; + procedure SetFont(const AFont: TFont); override; procedure UpdatePanel(AIndex: Integer = -1); end; @@ -641,6 +643,12 @@ begin AImageSize := FScrollSize; AViewSize := FScrollPageSize; ALineSize := Classes.Point(1, 1); + + {$IFDEF VerboseScroll} + DebugLn('TCarbonCustomControl.GetInfo ' + LCLObject.Name + ' Origin: ' + + DbgS(AOrigin) + ' Image: ' + DbgS(AImageSize) + ' View: ' + + DbgS(AViewSize) + 'Line: ' + DbgS(ALineSize)); + {$ENDIF} end; {------------------------------------------------------------------------------ @@ -653,6 +661,11 @@ procedure TCarbonCustomControl.ScrollTo(const ANewOrigin: TPoint); var ScrollMsg: TLMScroll; begin + {$IFDEF VerboseScroll} + DebugLn('TCarbonCustomControl.ScrollTo ' + LCLObject.Name + ' Origin: ' + + DbgS(ANewOrigin)); + {$ENDIF} + FScrollOrigin := ANewOrigin; // send vertical scroll @@ -716,6 +729,11 @@ var const SName = 'SetScrollInfo'; begin + {$IFDEF VerboseScroll} + DebugLn('TCarbonCustomControl.SetScrollInfo ' + LCLObject.Name + + ' SBStyle: ' + DbgS(SBStyle) + ' ' + DbgS(ScrollInfo)); + {$ENDIF} + if SBStyle = SB_HORZ then Result := FScrollOrigin.X; if SBStyle = SB_VERT then @@ -774,6 +792,11 @@ procedure TCarbonCustomControl.GetScrollInfo(SBStyle: Integer; const SName = 'GetScrollInfo'; begin + {$IFDEF VerboseScroll} + DebugLn('TCarbonCustomControl.GetScrollInfo ' + LCLObject.Name + + ' SBStyle: ' + DbgS(SBStyle) + ' ' + DbgS(ScrollInfo)); + {$ENDIF} + if (SIF_RANGE and ScrollInfo.fMask) > 0 then begin ScrollInfo.nMin := 0; @@ -799,6 +822,10 @@ begin if SBStyle = SB_VERT then ScrollInfo.nPage := FScrollPageSize.Y; end; + + {$IFDEF VerboseScroll} + DebugLn('TCarbonCustomControl.GetScrollInfo Result: ' + DbgS(ScrollInfo)); + {$ENDIF} end; { TCarbonScrollingWinControl } @@ -968,6 +995,28 @@ begin Result.X := LCLObject.Parent.ClientWidth; end; +{------------------------------------------------------------------------------ + Method: TCarbonStatusBar.SetColor + Params: AColor - New color + + Sets the color of control (for edit like controls) + ------------------------------------------------------------------------------} +procedure TCarbonStatusBar.SetColor(const AColor: TColor); +begin + // not supported +end; + +{------------------------------------------------------------------------------ + Method: TCarbonStatusBar.SetFont + Params: AFont - New font + + Sets the font of control + ------------------------------------------------------------------------------} +procedure TCarbonStatusBar.SetFont(const AFont: TFont); +begin + // not supported +end; + {------------------------------------------------------------------------------ Method: TCarbonStatusBar.UpdatePanel Params: AIndex - Index of panel to update or -1 to update all diff --git a/lcl/interfaces/carbon/carbonprivatecontrol.inc b/lcl/interfaces/carbon/carbonprivatecontrol.inc index 249cda8957..622925c701 100644 --- a/lcl/interfaces/carbon/carbonprivatecontrol.inc +++ b/lcl/interfaces/carbon/carbonprivatecontrol.inc @@ -353,9 +353,9 @@ var ScrollBars: TScrollStyle; begin case AParams.Style and (WS_VSCROLL or WS_HSCROLL) of - WS_VSCROLL: ScrollBars := ssVertical; - WS_HSCROLL: ScrollBars := ssHorizontal; - WS_VSCROLL or WS_HSCROLL: ScrollBars := ssBoth; + WS_VSCROLL: ScrollBars := ssAutoVertical; + WS_HSCROLL: ScrollBars := ssAutoHorizontal; + WS_VSCROLL or WS_HSCROLL: ScrollBars := ssAutoBoth; else ScrollBars := ssNone; end; @@ -401,8 +401,8 @@ begin AScrollBars in [ssNone, ssAutoVertical, ssAutoHorizontal, ssAutoBoth]), Self, SName, SViewSetScrollBarAutoHide); - if OSError(HIViewAddSubview(Result, Widget), Self, SName, SViewAddView) then Exit; OSError(HIViewSetVisible(Widget, True), Self, SName, SViewVisible); + if OSError(HIViewAddSubview(Result, Widget), Self, SName, SViewAddView) then Exit; end; {------------------------------------------------------------------------------ diff --git a/lcl/interfaces/carbon/carbonproc.pp b/lcl/interfaces/carbon/carbonproc.pp index 5c1dc1974c..7ee3e06ddd 100644 --- a/lcl/interfaces/carbon/carbonproc.pp +++ b/lcl/interfaces/carbon/carbonproc.pp @@ -96,10 +96,8 @@ function ColorToRGBColor(const AColor: TColor): RGBColor; function RGBColorToColor(const AColor: RGBColor): TColor; function CreateCGColor(const AColor: TColor): CGColorRef; -function DbgS(const ASize: TSize): string; overload; function DbgS(const ARect: FPCMacOSAll.Rect): string; overload; function DbgS(const AColor: FPCMacOSAll.RGBColor): string; overload; -function DbgS(const ATM: TTextMetric): string; overload; implementation @@ -726,11 +724,6 @@ begin Result := CGColorCreate(RGBColorSpace, @F[0]); end; -function DbgS(const ASize: TSize): string; -begin - Result := 'cx: ' + DbgS(ASize.cx) + ' cy: ' + DbgS(ASize.cy); -end; - function DbgS(const ARect: FPCMacOSAll.Rect): String; begin Result := DbgS(ARect.left) + ', ' + DbgS(ARect.top) @@ -745,32 +738,6 @@ begin ' B: ' + IntToHex(AColor.Blue, 4); end; -function DbgS(const ATM: TTextMetric): string; -begin - with ATM do - Result := - 'tmHeight: ' + DbgS(tmHeight) + - ' tmAscent: ' + DbgS(tmAscent) + - ' tmDescent: ' + DbgS(tmDescent) + - ' tmInternalLeading: ' + DbgS(tmInternalLeading) + - ' tmExternalLeading: ' + DbgS(tmExternalLeading) + - ' tmAveCharWidth: ' + DbgS(tmAveCharWidth) + - ' tmMaxCharWidth: ' + DbgS(tmMaxCharWidth) + - ' tmWeight: ' + DbgS(tmWeight) + - ' tmOverhang: ' + DbgS(tmOverhang) + - ' tmDigitizedAspectX: ' + DbgS(tmDigitizedAspectX) + - ' tmDigitizedAspectY: ' + DbgS(tmDigitizedAspectY) + - ' tmFirstChar: ' + tmFirstChar + - ' tmLastChar: ' + tmLastChar + - ' tmDefaultChar: ' + tmDefaultChar + - ' tmBreakChar: ' + tmBreakChar + - ' tmItalic: ' + DbgS(tmItalic) + - ' tmUnderlined: ' + DbgS(tmUnderlined) + - ' tmStruckOut: ' + DbgS(tmStruckOut) + - ' tmPitchAndFamily: ' + DbgS(tmPitchAndFamily) + - ' tmCharSet: ' + DbgS(tmCharSet); -end; - initialization