673
694
{------------------------------------------------------------------------------
674
Method: DrawFrameControl
675
Params: DC - Handle to device context
676
Rect - Bounding rectangle
677
UType - Frame-control type
678
UState - Frame-control state
679
Returns: If the function succeeds
681
Draws a frame control of the specified type and style.
682
------------------------------------------------------------------------------}
683
function TCarbonWidgetSet.DrawFrameControl(DC: HDC; const Rect: TRect; UType,
684
UState: Cardinal): Boolean;
686
Result := inherited DrawFrameControl(DC, Rect, UType, UState);
689
function TCarbonWidgetSet.DrawEdge(DC: HDC; var ARect: TRect; Edge: Cardinal;
690
grfFlags: Cardinal): Boolean;
692
Result:=inherited DrawEdge(DC, ARect, Edge, grfFlags);
695
function TCarbonWidgetSet.DrawText(DC: HDC; Str: PChar; Count: Integer;
696
var Rect: TRect; Flags: Cardinal): Integer;
698
Result:=inherited DrawText(DC, Str, Count, Rect, Flags);
701
{------------------------------------------------------------------------------
704
697
DC - Handle to device context
2284
TColorComponents = array[0..3] of CGFloat;
2286
PLinearGradientInfo = ^TLinearGradientInfo;
2287
TLinearGradientInfo = record
2288
colors: array[0..1] of TColorComponents;
2291
function VertexToColor(AVertex: tagTRIVERTEX): TColorComponents;
2295
TheAlpha := AVertex.Alpha shr 8;
2296
if TheAlpha = 0 then
2300
Result[0] := (Red shr 8) / 255;
2301
Result[1] := (Green shr 8) / 255;
2302
Result[2] := (Blue shr 8 )/ 255;
2303
Result[3] := TheAlpha / 255;
2307
function LinearGradientCreateInfo(TL, BR: tagTRIVERTEX): UnivPtr;
2310
SwapColors: Boolean;
2311
Info: PLinearGradientInfo;
2312
Tmp: TColorComponents;
2314
GetMem(Info, SizeOf(TLinearGradientInfo));
2315
SwapColors := (BR.Y < TL.Y) and (BR.X < TL.X);
2328
Info^.colors[0] := VertexToColor(TL);
2329
Info^.colors[1] := VertexToColor(BR);
2332
Tmp := Info^.colors[0];
2333
Info^.colors[0] := Info^.colors[1];
2334
Info^.colors[1] := Tmp;
2338
procedure LinearGradientReleaseInfo(info: UnivPtr); mwpascal;
2343
procedure LinearGradientEvaluate(info: UnivPtr; inputValue: CGFloatPtr; outputValue: CGFloatPtr); mwpascal;
2345
GradientInfo: PLinearGradientInfo absolute info;
2349
Position := inputValue^;
2350
if Position = 0 then
2351
System.Move(GradientInfo^.colors[0], outputValue^, SizeOf(TColorComponents))
2354
outputValue[I] := GradientInfo^.colors[0][I] + Position * (GradientInfo^.colors[1][I] - GradientInfo^.colors[0][I]);
2269
2357
function TCarbonWidgetSet.GradientFill(DC: HDC; Vertices: PTriVertex;
2270
2358
NumVertices: Longint; Meshes: Pointer; NumMeshes: Longint; Mode: Longint
2361
function DoFillTriangle: Boolean; inline;
2363
Result := (Mode and GRADIENT_FILL_TRIANGLE) = GRADIENT_FILL_TRIANGLE;
2366
function DoFillVRect: Boolean; inline;
2368
Result := (Mode and GRADIENT_FILL_RECT_V) = GRADIENT_FILL_RECT_V;
2371
function FillRectMesh(Mesh: tagGradientRect) : boolean;
2373
TL, BR: tagTRIVERTEX;
2374
Shading: CGShadingRef;
2375
ShadingFunction: CGFunctionRef;
2376
ShadingCallbacks: CGFunctionCallbacks;
2377
Context: CGContextRef;
2378
domain: array[0..1] of CGFloat;
2379
range: array[0..7] of CGFloat;
2385
(UpperLeft < Cardinal(NumVertices)) and (UpperLeft >= 0) and
2386
(LowerRight < Cardinal(NumVertices)) and (LowerRight >= 0);
2387
if (LowerRight = UpperLeft) or not Result then
2390
TL := Vertices[UpperLeft];
2391
BR := Vertices[LowerRight];
2392
info := LinearGradientCreateInfo(TL, BR);
2393
Context := TCarbonDeviceContext(DC).CGContext;
2394
CGContextSaveGState(Context);
2395
// to draw a gradient in a rectangle we need to first clip it by that
2396
// rectangle and only then draw the gradient
2397
CGContextAddRect(Context, CGRectMake(TL.X, TL.Y, BR.X - TL.X, BR.Y - TL.Y));
2398
CGContextClip(Context);
2400
ShadingCallbacks.version := 0;
2401
ShadingCallbacks.evaluate := @LinearGradientEvaluate;
2402
ShadingCallbacks.releaseInfo := @LinearGradientReleaseInfo;
2413
ShadingFunction := CGFunctionCreate(Info, 1, @domain[0], 4, @range[0], ShadingCallbacks);
2415
Shading := CGShadingCreateAxial(RGBColorSpace, CGPointMake(TL.X, TL.Y), CGPointMake(TL.X, BR.Y), ShadingFunction, 0, 0)
2417
Shading := CGShadingCreateAxial(RGBColorSpace, CGPointMake(TL.X, TL.Y), CGPointMake(BR.X, TL.Y), ShadingFunction, 0, 0);
2419
CGContextDrawShading(Context, Shading);
2420
CGShadingRelease(Shading);
2421
CGContextRestoreGState(Context);
2426
MeshSize: Array[Boolean] of Integer = (
2427
SizeOf(tagGradientRect), SizeOf(tagGradientTriangle));
2273
Result:=inherited GradientFill(DC, Vertices, NumVertices, Meshes, NumMeshes,
2431
if not CheckDC(DC, 'GradientFill') then Exit(False);
2432
Result := (Meshes <> nil) and (NumMeshes >= 1) and (NumVertices >= 2)
2433
and (Vertices <> nil);
2434
if Result and DoFillTriangle then
2436
Result := inherited;
2444
//Sanity Checks For Vertices Size vs. Count
2445
if MemSize(Vertices) < PtrUInt(SizeOf(tagTRIVERTEX)*NumVertices) then
2448
for I := 0 to NumMeshes - 1 do
2450
if not FillRectMesh(PGradientRect(Meshes)[I]) then
2277
2457
{------------------------------------------------------------------------------
2925
3138
Result:=inherited ScreenToClient(Handle, P);
2928
function TCarbonWidgetSet.ScrollWindowEx(hWnd: HWND; dx, dy: Integer;
2929
prcScroll, prcClip: PRect; hrgnUpdate: HRGN; prcUpdate: PRect; flags: UINT
2932
Result:=inherited ScrollWindowEx(hWnd, dx, dy, prcScroll, prcClip,
2933
hrgnUpdate, prcUpdate, flags);
3141
{$IFDEF NewScrollWindowEx}
3142
function TCarbonWidgetSet.ScrollWindowEx(hWnd: HWND; dx, dy: Integer;
3143
prcScroll, prcClip: PRect; hrgnUpdate: HRGN; prcUpdate: PRect; flags: UINT
3146
SName = 'ScrollWindowEx';
3148
ACtl: TCarbonControl;
3153
(* - On Windows prcScroll is used a source-rectangle. The Result can (and will)
3154
be placed outside that area. It may be limited by prcClip.
3155
- Carbon uses the rect given to HIViewScrollRect as source and Clip.
3156
So to get the same effect as on Windows prcScroll may need to be extended
3157
- SW_INVALIDATE: Carbon always invalidates. So nothing to do if the flag is set.
3158
Todo: If it is not set, and if it was known that the area was not already
3159
invalidated before, then maybe it can be re-validadet?
3161
{$IFDEF VerboseWinAPI}
3162
DebugLn('TCarbonWidgetSet.ScrollWindowEx() HWnd=',dbgs(hWnd),' prcScroll ',dbgs(prcScroll <> nil),
3163
' prcClip ',dbgs(prcClip <> nil));
3166
if (dy = 0) and (dx = 0) then exit;
3167
if (hWnd = 0) then exit;
3169
ACtl := TCarbonControl(hWnd);
3170
OSError(HIViewGetBounds(ACtl.Content, R1),
3171
Self, SName, 'HIViewGetBounds');
3173
RFullSource := CGRectToRect(R1);
3174
{$ifdef VerboseScrollWindowEx}
3175
DebugLn(['ScrollWindowEx A RFullSource=', dbgs(RFullSource),' dy=',dy, ' scroll=',dbgs(prcScroll^), ' clip=',dbgs(prcClip^)]);
3178
if PrcScroll <> nil then
3180
RFullSource.Left := Max(RFullSource.Left, PrcScroll^.Left);
3181
RFullSource.Top := Max(RFullSource.Top, PrcScroll^.Top);
3182
RFullSource.Right := Min(RFullSource.Right, PrcScroll^.Right);
3183
RFullSource.Bottom := Min(RFullSource.Bottom, PrcScroll^.Bottom);
3187
RFullSource.Left := RFullSource.Left + dx;
3189
RFullSource.Right := RFullSource.Right + dx;
3191
RFullSource.Top := RFullSource.Top + dy;
3193
RFullSource.Bottom := RFullSource.Bottom + dy;
3194
{$ifdef VerboseScrollWindowEx}
3195
DebugLn(['ScrollWindowEx prcScroll RFullSource=', dbgs(RFullSource)]);
3199
if prcClip <> nil then
3201
// only limit the site towards which is scrolled
3202
// the other side is required for invalidation
3204
RFullSource.Left := Max(RFullSource.Left, prcClip^.Left - dx);
3206
RFullSource.Right := Min(RFullSource.Right, prcClip^.Right - dx);
3208
RFullSource.Top := Max(RFullSource.Top, prcClip^.Top - dy);
3210
RFullSource.Bottom := Min(RFullSource.Bottom, prcClip^.Bottom - dy);
3211
{$ifdef VerboseScrollWindowEx}
3212
DebugLn(['ScrollWindowEx prcClip RFullSource=', dbgs(RFullSource)]);
3216
if prcUpdate <> nil then
3218
prcUpdate^ := RFullSource;
3220
prcUpdate^.Left := Max(RFullSource.Left, RFullSource.Right + dx);
3222
prcUpdate^.Right := Min(RFullSource.Right, RFullSource.Left + dx);
3224
prcUpdate^.Top := Max(RFullSource.Top, RFullSource.Bottom + dy);
3226
prcUpdate^.Bottom := Min(RFullSource.Bottom, RFullSource.Top + dy);
3227
{$ifdef VerboseScrollWindowEx}
3228
DebugLn(['ScrollWindowEx prcUpdate RFullSource=', dbgs(prcUpdate^)]);
3232
R := RectToCGRect(RFullSource);
3233
OSError(HIViewScrollRect(ACtl.Content, HiRectPtr(@R), CGFloat(dx), CGFloat(dy)),
3234
ACtl, SName, 'HIViewScrollRect');
3236
if (flags and SW_SCROLLCHILDREN <> 0) then
3238
// complete view scrolls
3239
with ACtl.ScrollOffset do
3249
function TCarbonWidgetSet.ScrollWindowEx(hWnd: HWND; dx, dy: Integer;
3250
prcScroll, prcClip: PRect; hrgnUpdate: HRGN; prcUpdate: PRect; flags: UINT
3253
SName = 'ScrollWindowEx';
3255
ACtl: TCarbonControl;
3259
{$IFDEF VerboseWinAPI}
3260
DebugLn('TCarbonWidgetSet.ScrollWindowEx() HWnd=',dbgs(hWnd),' prcScroll ',prcScroll <> nil,
3261
' prcClip ',prcClip <> nil,' flags ',flags);
3265
ACtl := TCarbonControl(hWnd);
3266
if (flags and SW_SCROLLCHILDREN <> 0) then
3268
// complete view scrolls
3269
// MFR: R is not initialized
3270
OSError(HIViewScrollRect(ACtl.Content, HiRectPtr(@R), CGFloat(dx), CGFloat(dy)),
3271
ACtl, SName, 'HIViewScrollRect');
3272
with ACtl.ScrollOffset do
3281
if (prcScroll <> nil) then
3283
R := RectToCGRect(prcScroll^);
3284
// TODO: create CGRect
3285
OSError(HIViewGetBounds(ACtl.Content, R1{%H-}),
3286
Self, SName, 'HIViewGetBounds');
3287
RR := CGRectToRect(R1);
3288
{$NOTE: check why RR is not used}
3289
OSError(HIViewScrollRect(ACtl.Content, HiRectPtr(@R), CGFloat(dx), CGFloat(dy)),
3290
ACtl, SName, 'HIViewScrollRect');
3295
if flags and SW_INVALIDATE <> 0 then
3297
if prcClip <> nil then
3299
prcUpdate := prcClip;
3300
Result := InvalidateRect(hwnd, prcClip, flags and SW_ERASE <> 0)
3303
prcUpdate := prcScroll;
3304
Result := InvalidateRect(hwnd, prcScroll, flags and SW_ERASE <> 0);
3308
Result:=inherited ScrollWindowEx(hWnd, dx, dy, prcScroll, prcClip,
3309
hrgnUpdate, prcUpdate, flags);
2936
3313
function TCarbonWidgetSet.SelectClipRGN(DC: hDC; RGN: HRGN): Longint;
2938
SName = 'TCarbonWidgetSet.SelectClipRGN';
2940
3315
{$IFDEF VerboseWinAPI}
2941
3316
DebugLn('TCarbonWidgetSet.SelectClipRGN DC: ' + DbgS(DC) + ' RGN: ' +