1{ 2 ------------------------------------- 3 carbondebug.pp - graphic dump utils 4 ------------------------------------- 5 6 @created(Mon Jun 18th WET 2007) 7 @lastmod($Date$) 8 @author(Marc Weustink <marc@@lazarus.dommelstein.net>) 9 10 This unit contains utility functions to show the contents of graphics 11 12 ***************************************************************************** 13 This file is part of the Lazarus Component Library (LCL) 14 15 See the file COPYING.modifiedLGPL.txt, included in this distribution, 16 for details about the license. 17 ***************************************************************************** 18} 19 20unit CarbonDebug; 21 22{$mode objfpc}{$H+} 23 24interface 25 26uses 27 MacOSAll, 28 sysutils, CarbonUtils; 29 30procedure DbgDumpImage(AImage: CGImageRef; ATitle: String = ''; AWidth: Integer = -1; AHeight: Integer = -1); 31procedure DbgDumpLayer(ALayer: CGLayerRef; ATitle: String = ''; AWidth: Integer = -1; AHeight: Integer = -1); 32 33implementation 34 35type 36 TDbgDumpKind = (dkImage, dkLayer); 37 38 PDbgDumpInfo = ^TDbgDumpInfo; 39 TDbgDumpInfo = record 40 Width, Height: Integer; 41 OrgWidth, OrgHeight: Integer; 42 Control: ControlRef; 43 Text: String; 44 case Kind: TDbgDumpKind of 45 dkImage: (Image: CGImageRef); 46 dkLayer: (Layer: CGLayerRef); 47 end; 48 49function DbgWindowDraw(ANextHandler: EventHandlerCallRef; 50 AEvent: EventRef; 51 AInfo: PDbgDumpInfo): OSStatus; mwpascal; 52var 53 bounds, R: CGRect; 54 context: CGContextRef; 55 status: OSStatus; 56begin 57 Result := CallNextEventHandler(ANextHandler, AEvent); 58 59 HIViewGetBounds(AInfo^.Control, bounds{%H-}); 60 61 status := GetEventParameter(AEvent, kEventParamCGContextRef, typeCGContextRef, nil, SizeOf(context), nil, @Context); 62 if status = 0 then ; 63 64 CGContextSetRGBFillColor(context, 0, 1, 0, 0.3); 65 CGContextFillRect(context, bounds); 66 CGContextScaleCTM(context, 1, -1); 67 68 R := CGRectMake(2, -15, AInfo^.Width, -AInfo^.Height); 69 case AInfo^.Kind of 70 dkImage: begin 71 if AInfo^.Image <> nil 72 then begin 73 if CGImageIsMask(AInfo^.Image) <> 0 74 then begin 75 CGContextSaveGState(context); 76 CGContextSetRGBFillColor(context, 0, 0, 0, 1); 77 CGContextClipToMask(context, R, AInfo^.Image); 78 CGContextFillRect(context, R); 79 CGContextRestoreGState(context); 80 end 81 else begin 82 CGContextDrawImage(Context, R, AInfo^.Image); 83 end; 84 end; 85 end; 86 dkLayer: begin 87 CGContextDrawLayerInRect(Context, R, AInfo^.Layer); 88 end; 89 end; 90 91 CGContextSelectFont(context, Pointer(PChar('Helvetica')), 10, kCGEncodingMacRoman); 92// CGContextSetTextDrawingMode (context, kCGTextFillStroke); 93 CGContextSetTextDrawingMode (context, kCGTextFill); 94 CGContextSetRGBFillColor(context, 0, 0, 0, 1); 95 CGContextSetRGBStrokeColor(context, 0, 0, 0, 1); 96 97 CGContextShowTextAtPoint(context, 2, -12, Pointer(PChar(AInfo^.Text)), Length(AInfo^.Text)); 98end; 99 100function DbgWindowClosed(ANextHandler: EventHandlerCallRef; AEvent: EventRef; 101 AInfo: PDbgDumpInfo): OSStatus; mwpascal; 102begin 103 Result := CallNextEventHandler(ANextHandler, AEvent); 104 case AInfo^.Kind of 105 dkImage: CGImageRelease(AInfo^.Image); 106 dkLayer: CGLayerRelease(AInfo^.Layer); 107 end; 108 Dispose(AInfo); 109end; 110 111 112procedure DbgCreateWindow(AInfo: PDbgDumpInfo; const ATitle: String); 113var 114 R: Rect; 115 w: WindowRef; 116 DbgWindowDrawUPP, DbgWindowClosedUPP: EventHandlerUPP; 117 Spec: EventTypeSpec; 118begin 119 R.Top := 50; R.Left := 0; 120 if AInfo^.Width < 50 then R.Right := 50 else R.Right := AInfo^.Width; 121 if AInfo^.Height < 25 then R.Bottom := 25 else R.Bottom := AInfo^.Height; 122 Inc(R.Bottom, R.Top + 15); 123 Inc(R.Right, R.Left + 2); 124 125 W := nil; 126 CreateNewWindow( 127 kUtilityWindowClass, 128 kWindowCompositingAttribute or 129 kWindowStandardDocumentAttributes or 130// kWindowLiveResizeAttribute or 131 kWindowStandardHandlerAttribute or kWindowFrameworkScaledAttribute, 132 R, W 133 ); 134 if W = nil then Exit; 135 136 case AInfo^.Kind of 137 dkImage: CGImageRetain(AInfo^.Image); 138 dkLayer: CGLayerRetain(AInfo^.Layer); 139 end; 140 AInfo^.Text := ATitle; 141 142 DbgWindowClosedUPP := NewEventHandlerUPP(EventHandlerProcPtr(@DbgWindowClosed)); 143 Spec := MakeEventSpec(kEventClassWindow, kEventWindowClosed); 144 InstallWindowEventHandler(W, DbgWindowClosedUPP, 1, @Spec, AInfo, nil); 145 146 AInfo^.Control := nil; 147 GetRootControl(W, AInfo^.Control); 148 149 DbgWindowDrawUPP := NewEventHandlerUPP(EventHandlerProcPtr(@DbgWindowDraw)); 150 Spec := MakeEventSpec(kEventClassControl, kEventControlDraw); 151 if AInfo^.Control <> nil 152 then InstallControlEventHandler(AInfo^.Control, DbgWindowDrawUPP, 1, @Spec, AInfo, nil); 153 154 ShowWindow(W); 155end; 156 157procedure DbgDumpImage(AImage: CGImageRef; ATitle: String = ''; AWidth: Integer = -1; AHeight: Integer = -1); 158var 159 Info: PDbgDumpInfo; 160 h,w,bpp: Integer; 161begin 162 New(Info); 163 164 if (AImage = nil) 165 then begin 166 w := 0; h:= 0; bpp := 0; 167 if AWidth = -1 then AWidth := 0; 168 if AHeight = -1 then AHeight := 0; 169 end 170 else begin 171 w := CGImageGetWidth(AImage); 172 h := CGImageGetHeight(AImage); 173 bpp := CGImageGetBitsPerPixel(AImage); 174 if AWidth = -1 then AWidth := W; 175 if AHeight = -1 then AHeight := H; 176 end; 177 178 Info^.Kind := dkImage; 179 Info^.Image := AImage; 180 Info^.Width := AWidth; 181 Info^.Height := AHeight; 182 Info^.OrgWidth := w; 183 Info^.OrgHeight := h; 184 185 ATitle := ATitle + Format(' (Image: %p W:%d H:%d bpp:%d)', [AImage, w, h, bpp]); 186 DbgCreateWindow(Info, ATitle); 187end; 188 189procedure DbgDumpLayer(ALayer: CGLayerRef; ATitle: String = ''; AWidth: Integer = -1; AHeight: Integer = -1); 190var 191 Info: PDbgDumpInfo; 192 S: CGSize; 193begin 194 New(Info); 195 196 if (ALayer = nil) 197 then begin 198 S.height := 0; s.width := 0; 199 if AWidth = -1 then AWidth := 0; 200 if AHeight = -1 then AHeight := 0; 201 end 202 else begin 203 S := CGLayerGetSize(ALayer); 204 if AWidth = -1 then AWidth := Round(S.width); 205 if AHeight = -1 then AHeight := Round(S.height); 206 end; 207 208 Info^.Kind := dkLayer; 209 Info^.Layer := ALayer; 210 Info^.Width := AWidth; 211 Info^.Height := AHeight; 212 Info^.OrgWidth := Round(S.width); 213 Info^.OrgHeight := Round(S.height); 214 215 ATitle := ATitle + Format(' (Layer: %p W:%f H:%f)', [ALayer, S.width, s.height]); 216 DbgCreateWindow(Info, ATitle); 217end; 218 219 220end. 221