cocoa: implement SetProp, GetProp, FillRgn

git-svn-id: trunk@34264 -

lcl/interfaces/cocoa/cocoagdiobjects.pas

@@ -320,6 +320,7 @@ type
     function SetClipRegion(AClipRegion: TCocoaRegion; Mode: TCocoaCombine): TCocoaRegionType;
     function CopyClipRegion(ADstRegion: TCocoaRegion): TCocoaRegionType;
 
+    property Clipped: Boolean read FClipped;
     property PenPos: TPoint read FPenPos write FPenPos;
     property Brush: TCocoaBrush read FBrush write SetBrush;
     property Pen: TCocoaPen read FPen write SetPen;

lcl/interfaces/cocoa/cocoaprivate.pp

@@ -53,6 +53,7 @@ type
     function lclFrame: TRect; message 'lclFrame';
     procedure lclSetFrame(const r: TRect); message 'lclSetFrame:';
     function lclClientFrame: TRect; message 'lclClientFrame';
+    function lclGetPropStorage: TStringList; message 'lclGetPropStorage';
   end;
 
   { LCLViewExtension }
@@ -109,6 +110,7 @@ type
     procedure boundsDidChange;
     // misc events
     procedure Draw(ctx: NSGraphicsContext; const bounds, dirty: NSRect);
+    function GetPropStorage: TStringList;
     function ResetCursorRects: Boolean;
   end;
 
@@ -154,6 +156,7 @@ type
     callback: IButtonCallback;
     function initWithFrame(frameRect: NSRect): id; override;
     function acceptsFirstResponder: Boolean; override;
+    function lclGetPropStorage: TStringList; override;
     procedure mouseDown(event: NSEvent); override;
     procedure mouseDragged(event: NSEvent); override;
     procedure mouseEntered(event: NSEvent); override;
@@ -168,6 +171,7 @@ type
   TCocoaTextField = objcclass(NSTextField)
     callback: ICommonCallback;
     function acceptsFirstResponder: Boolean; override;
+    function lclGetPropStorage: TStringList; override;
     procedure resetCursorRects; override;
   end;
 
@@ -185,6 +189,7 @@ type
   TCocoaTextView = objcclass(NSTextView)
     callback: ICommonCallback;
     function acceptsFirstResponder: Boolean; override;
+    function lclGetPropStorage: TStringList; override;
     procedure resetCursorRects; override;
   end;
 
@@ -201,6 +206,7 @@ type
   public
     callback: IWindowCallback;
     function acceptsFirstResponder: Boolean; override;
+    function lclGetPropStorage: TStringList; override;
     procedure mouseUp(event: NSEvent); override;
     procedure mouseDown(event: NSEvent); override;
     procedure mouseDragged(event: NSEvent); override;
@@ -214,6 +220,7 @@ type
   TCocoaCustomControl = objcclass(NSControl)
     callback: ICommonCallback;
     procedure drawRect(dirtyRect: NSRect); override;
+    function lclGetPropStorage: TStringList; override;
     procedure mouseDown(event: NSEvent); override;
     procedure mouseDragged(event: NSEvent); override;
     procedure mouseEntered(event: NSEvent); override;
@@ -227,6 +234,7 @@ type
 
   TCocoaScrollView = objcclass(NSScrollView)
     callback: ICommonCallback;
+    function lclGetPropStorage: TStringList; override;
     procedure resetCursorRects; override;
   end;
 
@@ -263,6 +271,7 @@ type
     function numberOfItemsInComboBox(combo: TCocoaComboBox): NSInteger;
       message 'numberOfItemsInComboBox:';
     procedure dealloc; override;
+    function lclGetPropStorage: TStringList; override;
     procedure resetCursorRects; override;
     procedure comboBoxWillPopUp(notification: NSNotification); message 'comboBoxWillPopUp:';
     procedure comboBoxWillDismiss(notification: NSNotification); message 'comboBoxWillDismiss:';
@@ -274,6 +283,7 @@ type
 
   TCocoaScrollBar = objcclass(NSScroller)
     callback: ICommonCallback;
+    function lclGetPropStorage: TStringList; override;
     procedure resetCursorRects; override;
   end;
 
@@ -295,6 +305,7 @@ type
     callback: ICommonCallback;
     list: TCocoaStringList;
     resultNS: NSString;  //use to return values to combo
+    function lclGetPropStorage: TStringList; override;
     function numberOfRowsInTableView(aTableView: NSTableView): NSInteger; message 'numberOfRowsInTableView:';
     function tableView_objectValueForTableColumn_row(tableView: NSTableView;
       objectValueForTableColumn: NSTableColumn; row: NSInteger):id;
@@ -307,6 +318,7 @@ type
 
   TCocoaGroupBox = objcclass(NSBox)
     callback: ICommonCallback;
+    function lclGetPropStorage: TStringList; override;
     procedure resetCursorRects; override;
   end;
 
@@ -314,6 +326,11 @@ implementation
 
 { TCocoaScrollView }
 
+function TCocoaScrollView.lclGetPropStorage: TStringList;
+begin
+  Result := callback.GetPropStorage;
+end;
+
 procedure TCocoaScrollView.resetCursorRects;
 begin
   if not callback.resetCursorRects then
@@ -322,6 +339,11 @@ end;
 
 { TCocoaScrollBar }
 
+function TCocoaScrollBar.lclGetPropStorage: TStringList;
+begin
+  Result := callback.GetPropStorage;
+end;
+
 procedure TCocoaScrollBar.resetCursorRects;
 begin
   if not callback.resetCursorRects then
@@ -330,6 +352,11 @@ end;
 
 { TCocoaGroupBox }
 
+function TCocoaGroupBox.lclGetPropStorage: TStringList;
+begin
+  Result := callback.GetPropStorage;
+end;
+
 procedure TCocoaGroupBox.resetCursorRects;
 begin
   if not callback.resetCursorRects then
@@ -373,6 +400,11 @@ begin
   Result := True;
 end;
 
+function TCocoaButton.lclGetPropStorage: TStringList;
+begin
+  Result := callback.GetPropStorage;
+end;
+
 procedure TCocoaButton.mouseUp(event: NSEvent);
 var
   mp: NSPoint;
@@ -424,6 +456,11 @@ begin
   Result:=true;
 end;
 
+function TCocoaTextField.lclGetPropStorage: TStringList;
+begin
+  Result := callback.GetPropStorage;
+end;
+
 procedure TCocoaTextField.resetCursorRects;
 begin
   // this will not work well because
@@ -440,6 +477,11 @@ begin
   Result:=true;
 end;
 
+function TCocoaTextView.lclGetPropStorage: TStringList;
+begin
+  Result := callback.GetPropStorage;
+end;
+
 procedure TCocoaTextView.resetCursorRects;
 begin
   if not callback.resetCursorRects then
@@ -487,6 +529,11 @@ begin
   Result := True;
 end;
 
+function TCocoaWindow.lclGetPropStorage: TStringList;
+begin
+  Result := callback.GetPropStorage;
+end;
+
 procedure TCocoaWindow.mouseUp(event: NSEvent);
 var
   mp: NSPoint;
@@ -558,6 +605,11 @@ begin
   callback.Draw(NSGraphicsContext.currentContext, bounds, dirtyRect);
 end;
 
+function TCocoaCustomControl.lclGetPropStorage: TStringList;
+begin
+  Result := callback.GetPropStorage;
+end;
+
 procedure TCocoaCustomControl.mouseDown(event: NSEvent);
 begin
   inherited mouseDown(event);
@@ -657,6 +709,11 @@ begin
   FillChar(Result, sizeof(Result), 0);
 end;
 
+function LCLObjectExtension.lclGetPropStorage: TStringList;
+begin
+  Result := nil;
+end;
+
 { LCLControlExtension }
 
 function RectToViewCoord(view: NSView; const r: TRect): NSRect;
@@ -882,6 +939,11 @@ end;
 
 { TCocoaListView }
 
+function TCocoaListView.lclGetPropStorage: TStringList;
+begin
+  Result := callback.GetPropStorage;
+end;
+
 function TCocoaListView.numberOfRowsInTableView(aTableView:NSTableView): NSInteger;
 begin
   if Assigned(list) then
@@ -973,6 +1035,11 @@ begin
   inherited dealloc;
 end;
 
+function TCocoaComboBox.lclGetPropStorage: TStringList;
+begin
+  Result := callback.GetPropStorage;
+end;
+
 procedure TCocoaComboBox.resetCursorRects;
 begin
   if not callback.resetCursorRects then

lcl/interfaces/cocoa/cocoawinapi.inc

@@ -399,18 +399,55 @@ end;
 
 function TCocoaWidgetSet.FillRect(DC: HDC; const Rect: TRect; Brush: HBRUSH): Boolean;
 var
-  ctx : TCocoaContext;
-  br  : TCocoaGDIObject;
+  ctx: TCocoaContext;
+  br: TCocoaGDIObject;
 begin
-  ctx:=CheckDC(DC);
-  br:=CheckGDIOBJ(Brush);
-  Result:=Assigned(ctx) and (not Assigned(br) or (br is TCocoaBrush));
+  ctx := CheckDC(DC);
+  br := CheckGDIOBJ(Brush);
+  Result := Assigned(ctx) and (not Assigned(br) or (br is TCocoaBrush));
   if not Result then Exit;
 
   with Rect do
     ctx.Rectangle(Left, Top, Right, Bottom, True, TCocoaBrush(br));
 end;
 
+function TCocoaWidgetSet.FillRgn(DC: HDC; RegionHnd: HRGN; hbr: HBRUSH): Bool;
+var
+  OldRgn: TCocoaRegion;
+  R: TRect;
+  Clipped: Boolean;
+  ctx: TCocoaContext;
+  br: TCocoaGDIObject;
+  I: Integer;
+begin
+  ctx := CheckDC(DC);
+  br := CheckGDIOBJ(hbr);
+  Result := Assigned(ctx) and (not Assigned(br) or (br is TCocoaBrush));
+  if not Result then Exit;
+
+  Clipped := ctx.Clipped;
+  I := ctx.SaveDC;
+  if Clipped then
+    OldRgn := TCocoaRegion.CreateDefault;
+  try
+    if Clipped then
+      ctx.CopyClipRegion(OldRgn);
+    if SelectClipRgn(DC, RegionHnd) <> ERROR then
+    begin
+      R := TCocoaRegion(RegionHnd).GetBounds;
+      with R do
+        ctx.Rectangle(Left, Top, Right, Bottom, True, TCocoaBrush(br));
+      if Clipped then
+        SelectClipRgn(DC, HRGN(OldRgn));
+      Result := True;
+    end;
+  finally
+    if Clipped then
+      OldRgn.Free;
+    ctx.RestoreDC(I);
+  end;
+end;
+
 {------------------------------------------------------------------------------
   function ShowWindow(hWnd: HWND; nCmdShow: Integer): Boolean;
 
@@ -562,15 +599,15 @@ end;
 
 function TCocoaWidgetSet.GetWindowSize(Handle: hwnd; var Width, Height: Integer): boolean;
 var
-  r   : TRect;
+  r: TRect;
 begin
-  if Handle<>0 then begin
-    Result:=True;
-    r:=NSObject(Handle).lclFrame;
-    Width:=R.Right-R.Left;
-    Height:=R.Bottom-R.Top;
-  end else
-    Result:=False;
+  Result := Handle <> 0;
+  if Result then
+  begin
+    r := NSObject(Handle).lclFrame;
+    Width := R.Right - R.Left;
+    Height := R.Bottom - R.Top;
+  end;
 end;
 
 function TCocoaWidgetSet.InvalidateRect(aHandle : HWND; Rect : pRect; bErase : Boolean): Boolean;
@@ -587,17 +624,58 @@ end;
 
 function TCocoaWidgetSet.UpdateWindow(Handle: HWND): Boolean;
 begin
-  Result:=InvalidateRect(Handle, nil, false);
+  Result := InvalidateRect(Handle, nil, False);
 end;
 
-function TCocoaWidgetSet.GetProp(Handle : hwnd; Str : PChar): Pointer;
+function TCocoaWidgetSet.GetProp(Handle: hwnd; Str: PChar): Pointer;
+var
+  PropStorage: TStringList;
+  I: Integer;
 begin
-  Result:=nil;
+  if Handle <> 0 then
+  begin
+    PropStorage := NSObject(Handle).lclGetPropStorage;
+    if Assigned(PropStorage) then
+    begin
+      I := PropStorage.IndexOf(Str);
+      if I <> -1 then
+        Result := PropStorage.Objects[I]
+      else
+        Result := nil;
+    end
+    else
+      Result := nil;
+  end;
 end;
 
-function TCocoaWidgetSet.SetProp(Handle: hwnd; Str : PChar; Data : Pointer) : Boolean;
+function TCocoaWidgetSet.GetRgnBox(RGN: HRGN; lpRect: PRect): Longint;
 begin
-  Result:=False;
+  Result := ERROR;
+  if Assigned(lpRect) then
+    lpRect^ := Types.Rect(0, 0, 0, 0);
+
+  if not (TObject(RGN) is TCocoaRegion) then
+    Exit;
+
+  if Assigned(lpRect) then
+  begin
+    lpRect^ := TCocoaRegion(RGN).GetBounds;
+    Result := CocoaRegionTypeToWin32Map[TCocoaRegion(RGN).GetType];
+  end;
+end;
+
+function TCocoaWidgetSet.SetProp(Handle: hwnd; Str: PChar; Data: Pointer): Boolean;
+var
+  PropStorage: TStringList;
+begin
+  Result := Handle <> 0;
+  if Result then
+  begin
+    PropStorage := NSObject(Handle).lclGetPropStorage;
+    Result := Assigned(PropStorage);
+    if Result then
+      PropStorage.AddObject(Str, TObject(Data));
+  end;
 end;
 
 {----------------------------- WINDOWS SCROLLING ------------------------------}

lcl/interfaces/cocoa/cocoawinapih.inc

@@ -84,8 +84,8 @@ function ExtCreatePen(dwPenStyle, dwWidth: DWord; const lplb: TLogBrush; dwStyle
 function ExtTextOut(DC: HDC; X, Y: Integer; Options: Longint; Rect: PRect; Str: PChar; Count: Longint; Dx: PInteger): Boolean; override;
 
 function FillRect(DC: HDC; const Rect: TRect; Brush: HBRUSH): Boolean; override;
-{function FillRgn(DC: HDC; RegionHnd: HRGN; hbr: HBRUSH): Bool; override;
-function Frame(DC: HDC; const ARect: TRect): Integer; override;
+function FillRgn(DC: HDC; RegionHnd: HRGN; hbr: HBRUSH): Bool; override;
+{function Frame(DC: HDC; const ARect: TRect): Integer; override;
 function Frame3d(DC: HDC; var ARect: TRect; const FrameWidth : integer; const Style : TBevelCut): Boolean; override;
 function FrameRect(DC: HDC; const ARect: TRect; hBr: HBRUSH): Integer; override;
 
@@ -108,10 +108,10 @@ function GetFocus: HWND; override;
 function GetKeyState(nVirtKey: Integer): Smallint; override;}
 function GetMonitorInfo(hMonitor: HMONITOR; lpmi: PMonitorInfo): Boolean; override;
 {function GetObject(GDIObj: HGDIOBJ; BufSize: Integer; Buf: Pointer): Integer; override;}
-function GetParent(Handle : HWND): HWND; override;
-function GetProp(Handle : hwnd; Str : PChar): Pointer; override;
-{function GetRgnBox(RGN : HRGN; lpRect : PRect) : Longint; override;
-function GetROP2(DC: HDC): Integer; override;}
+function GetParent(Handle: HWND): HWND; override;
+function GetProp(Handle: hwnd; Str: PChar): Pointer; override;
+function GetRgnBox(RGN: HRGN; lpRect: PRect) : Longint; override;
+{function GetROP2(DC: HDC): Integer; override;}
 function GetScrollBarSize(Handle: HWND; BarKind: Integer): integer; override;
 function GetScrollbarVisible(Handle: HWND; SBStyle: Integer): boolean; override;
 function GetScrollInfo(Handle: HWND; BarFlag: Integer; Var ScrollInfo: TScrollInfo): Boolean; override;
@@ -174,7 +174,7 @@ function SetCursor(ACursor: HCURSOR): HCURSOR; override;
 function SetCursorPos(X, Y: Integer): Boolean; override;
 {function SetFocus(hWnd: HWND): HWND; override;
 function SetForegroundWindow(HWnd: HWND): boolean; override;}
-function SetProp(Handle: hwnd; Str : PChar; Data : Pointer) : Boolean; override;
+function SetProp(Handle: hwnd; Str: PChar; Data: Pointer) : Boolean; override;
 function SetScrollInfo(Handle : HWND; SBStyle : Integer; ScrollInfo: TScrollInfo; bRedraw : Boolean): Integer; override;
 function SetTextColor(DC: HDC; Color: TColorRef): TColorRef; override;
 {function SetWindowOrgEx(DC : HDC; NewX, NewY : Integer; OldPoint: PPoint) : Boolean; override;

lcl/interfaces/cocoa/cocoawscommon.pas

@@ -24,12 +24,15 @@ type
   { TLCLCommonCallback }
 
   TLCLCommonCallback = class(TObject, ICommonCallBack)
+  private
+    FPropStorage: TStringList;
   public
     Owner: NSObject;
-    Target  : TWinControl;
-    Context : TCocoaContext;
+    Target: TWinControl;
+    Context: TCocoaContext;
     constructor Create(AOwner: NSObject; ATarget: TWinControl); virtual;
     destructor Destroy; override;
+    function GetPropStorage: TStringList;
     procedure MouseDown(x,y: Integer); virtual;
     procedure MouseUp(x,y: Integer); virtual;
     procedure MouseClick(clickCount: Integer); virtual;
@@ -119,14 +122,23 @@ begin
   inherited Create;
   Owner := AOwner;
   Target := ATarget;
+  FPropStorage := TStringList.Create;
+  FPropStorage.Sorted := True;
+  FPropStorage.Duplicates := dupAccept;
 end;
 
 destructor TLCLCommonCallback.Destroy;
 begin
   Context.Free;
+  FPropStorage.Free;
   inherited Destroy;
 end;
 
+function TLCLCommonCallback.GetPropStorage: TStringList;
+begin
+  Result := FPropStorage;
+end;
+
 procedure TLCLCommonCallback.MouseDown(x, y: Integer);
 begin
   LCLSendMouseDownMsg(Target,x,y,mbLeft, []);