gtk, gtk2: implement GetSysColorBrush (non context-related)

git-svn-id: trunk@25130 -
2025-08-19 17:19:46 +02:00 · 2010-05-02 11:01:05 +00:00 · 2010-05-02 11:01:05 +00:00 · 0ec1f90c0e
commit 0ec1f90c0e
parent 083a214ec4
5 changed files with 114 additions and 35 deletions
--- a/lcl/interfaces/gtk/gtkdef.pp
+++ b/lcl/interfaces/gtk/gtkdef.pp
@ -156,6 +156,7 @@ type
  TGDIObject = record
    RefCount: integer; // see ReleaseGDIObject, ReferenceGDIObject
    DCCount: integer; // number of DeviceContexts using this GDIObject
+    Shared: Boolean; // stock or system object which skips DeleteObject calls
    Owner: TGtkDeviceContext;
    {$ifdef TraceGdiCalls}
    StackAddrs: TCallBacksArray;
--- a/lcl/interfaces/gtk/gtkint.pp
+++ b/lcl/interfaces/gtk/gtkint.pp
@ -109,6 +109,8 @@ type
    FStockBlackPen: HPEN;
    FStockWhitePen: HPEN;

+    FSysColorBrushes: array[0..MAX_SYS_COLORS] of HBrush;
+
    FWaitHandles: PWaitHandleEventHandler;
    {$ifdef unix}
    FChildSignalHandlers: PChildSignalEventHandler;
@ -137,6 +139,8 @@ type
    procedure InitStockItems; virtual;
    procedure FreeStockItems; virtual;
    procedure InitSystemColors;
+    procedure InitSystemBrushes; virtual;
+    procedure FreeSystemBrushes; virtual;
    procedure PassCmdLineOptions; override;
   
 {$ifdef Unix}
--- a/lcl/interfaces/gtk/gtkwidgetset.inc
+++ b/lcl/interfaces/gtk/gtkwidgetset.inc
@ -254,6 +254,7 @@ begin
  // Init stock objects;
  InitStockItems;
  InitSystemColors;
+  InitSystemBrushes;

  // clipboard
  ClipboardTypeAtoms[ctPrimarySelection]:=GDK_SELECTION_PRIMARY;
@ -390,6 +391,7 @@ begin

  FreeAllStyles;
  FreeStockItems;
+  FreeSystemBrushes;

  if FGTKToolTips<>nil then begin
    {$IFDEF Gtk2}
@ -1294,8 +1296,13 @@ procedure TGtkWidgetSet.FreeStockItems;

  procedure DeleteAndNilObject(var h: HGDIOBJ);
  begin
+    if h <> 0 then
+    begin
+      PGdiObject(h)^.Shared := False;
+      PGdiObject(h)^.RefCount := 1;
+    end;
    DeleteObject(h);
-    h:=0;
+    h := 0;
  end;

 begin
@ -1324,6 +1331,40 @@ begin
  GetStyle(lgsTooltip);
 end;

+procedure TGTKWidgetSet.InitSystemBrushes;
+var
+  i: integer;
+  LogBrush: TLogBrush;
+begin
+  FillChar(LogBrush, SizeOf(TLogBrush), 0);
+  for i := Low(FSysColorBrushes) to High(FSysColorBrushes) do
+  begin
+    LogBrush.lbColor := GetSysColor(i);
+    FSysColorBrushes[i] := CreateBrushIndirect(LogBrush);
+    PGDIObject(FSysColorBrushes[i])^.Shared := True;
+  end;
+end;
+
+procedure TGTKWidgetSet.FreeSystemBrushes;
+
+  procedure DeleteAndNilObject(var h: HGDIOBJ);
+  begin
+    if h <> 0 then
+    begin
+      PGdiObject(h)^.Shared := False;
+      PGdiObject(h)^.RefCount := 1;
+    end;
+    DeleteObject(h);
+    h := 0;
+  end;
+
+var
+  i: integer;
+begin
+  for i := Low(FSysColorBrushes) to High(FSysColorBrushes) do
+    DeleteAndNilObject(FSysColorBrushes[i]);
+end;
+
 {------------------------------------------------------------------------------
  Method: TGtkWidgetSet.AppTerminate
  Params:  None
@ -1348,29 +1389,38 @@ var
  LogBrush: TLogBrush;
  logPen : TLogPen;
 begin
-  FillChar(LogBrush,SizeOf(TLogBrush),0);
+  FillChar(LogBrush, SizeOf(TLogBrush), 0);
  LogBrush.lbStyle := BS_NULL;
  FStockNullBrush := CreateBrushIndirect(LogBrush);
+  PGDIObject(FStockNullBrush)^.Shared := True;
  LogBrush.lbStyle := BS_SOLID;
  LogBrush.lbColor := $000000;
  FStockBlackBrush := CreateBrushIndirect(LogBrush);
+  PGDIObject(FStockBlackBrush)^.Shared := True;
  LogBrush.lbColor := $C0C0C0;
  FStockLtGrayBrush := CreateBrushIndirect(LogBrush);
+  PGDIObject(FStockLtGrayBrush)^.Shared := True;
  LogBrush.lbColor := $808080;
  FStockGrayBrush := CreateBrushIndirect(LogBrush);
+  PGDIObject(FStockGrayBrush)^.Shared := True;
  LogBrush.lbColor := $404040;
  FStockDkGrayBrush := CreateBrushIndirect(LogBrush);
+  PGDIObject(FStockDkGrayBrush)^.Shared := True;
  LogBrush.lbColor := $FFFFFF;
  FStockWhiteBrush := CreateBrushIndirect(LogBrush);
+  PGDIObject(FStockWhiteBrush)^.Shared := True;

  LogPen.lopnStyle := PS_NULL;
  LogPen.lopnWidth.X := 1;
  LogPen.lopnColor := $FFFFFF;
  FStockNullPen := CreatePenIndirect(LogPen);
+  PGDIObject(FStockNullPen)^.Shared := True;
  LogPen.lopnStyle := PS_SOLID;
  FStockWhitePen := CreatePenIndirect(LogPen);
+  PGDIObject(FStockWhitePen)^.Shared := True;
  LogPen.lopnColor := $000000;
  FStockBlackPen := CreatePenIndirect(LogPen);
+  PGDIObject(FStockBlackPen)^.Shared := True;

  FStockSystemFont := 0;//Styles aren't initialized yet
 end;
@ -4882,6 +4932,7 @@ begin
  FillStackAddrs(get_caller_frame(get_frame), @Result^.StackAddrs);
  {$endif}
  Result^.GDIType := GDIType;
+  Result^.Shared := False;
  inc(Result^.RefCount);
  FGDIObjects.Add(Result);
  //DebugLn('[TGtkWidgetSet.NewGDIObject] ',DbgS(Result),'  ',FGDIObjects.Count);
@ -4897,10 +4948,12 @@ end;
 ------------------------------------------------------------------------------}
 procedure TGtkWidgetSet.DisposeGDIObject(GDIObject: PGdiObject);
 begin
-  if FGDIObjects.Contains(GDIObject) then begin
+  if FGDIObjects.Contains(GDIObject) then
+  begin
    FGDIObjects.Remove(GDIObject);
    GtkDef.InternalDisposePGDIObject(GDIObject);
-  end else
+  end
+  else
    RaiseGDBException('');
 end;

@ -4956,12 +5009,14 @@ function TGTKWidgetSet.ReleaseGDIObject(GdiObject: PGdiObject): boolean;
  end;

 begin
-  if GDIObject=nil then begin
-    Result:=true;
+  if GDIObject = nil then
+  begin
+    Result := True;
    exit;
  end;
  {$IFDEF DebugLCLComponents}
-  if DebugGdiObjects.IsDestroyed(GDIObject) then begin
+  if DebugGdiObjects.IsDestroyed(GDIObject) then
+  begin
    DebugLn(['TGtkWidgetSet.ReleaseGDIObject object already deleted ',GDIObject]);
    debugln(DebugGdiObjects.GetInfo(GDIObject,true));
    Halt;
@ -4971,25 +5026,29 @@ begin
  with PGdiObject(GDIObject)^ do
  begin
    dec(RefCount);
-    if RefCount>0 then begin
-      Result:=true;
+    if (RefCount > 0) or Shared then
+    begin
+      Result := True;
      exit;
    end;
-    if DCCount>0 then begin
+    if DCCount > 0 then
+    begin
      RaiseGDIObjectIsStillUsed;
-      exit(false);
+      exit(False);
    end;

-    if Owner<>nil then begin
-      if Owner.OwnedGDIObjects[GDIType]<>PGdiObject(GDIObject) then
+    if Owner <> nil then
+    begin
+      if Owner.OwnedGDIObjects[GDIType] <> PGdiObject(GDIObject) then
        RaiseInvalidGDIOwner;
-      Owner.OwnedGDIObjects[GDIType]:=nil;
+      Owner.OwnedGDIObjects[GDIType] := nil;
    end;

    case GDIType of
      gdiFont:
        begin
-          if GDIFontObject<>nil then begin
+          if GDIFontObject <> nil then
+          begin
            //DebugLn(['TGtkWidgetSet.DeleteObject GDIObject=',dbgs(Pointer(PtrInt(GDIObject))),' GDIFontObject=',dbgs(GDIFontObject)]);
            FontCache.Unreference(GDIFontObject);
          end;
--- a/lcl/interfaces/gtk/gtkwinapi.inc
+++ b/lcl/interfaces/gtk/gtkwinapi.inc
@ -2291,12 +2291,14 @@ function TGtkWidgetSet.DeleteObject(GDIObject: HGDIOBJ): Boolean;
 var
  GDIObjectExists: boolean;
 begin
-  if GDIObject=0 then begin
-    Result:=true;
-    exit;
+  if GDIObject = 0 then
+  begin
+    Result := True;
+    Exit;
  end;
  {$IFDEF DebugLCLComponents}
-  if DebugGdiObjects.IsDestroyed(GDIObject) then begin
+  if DebugGdiObjects.IsDestroyed(GDIObject) then
+  begin
    DebugLn(['TGtkWidgetSet.DeleteObject object already deleted ',GDIObject]);
    debugln(DebugGdiObjects.GetInfo(PGdiObject(GDIObject),true));
    Halt;
@ -2304,13 +2306,14 @@ begin
  {$ENDIF}

  // Find out if we want to release internal GDI object
-  GDIObjectExists:=FGDIObjects.Contains(PGdiObject(GDIObject));
-  Result:=GDIObjectExists;
-  if not GDIObjectExists then begin
+  GDIObjectExists := FGDIObjects.Contains(PGdiObject(GDIObject));
+  Result := GDIObjectExists;
+  if not GDIObjectExists then
+  begin
    RaiseInvalidGDIObject;
  end;

-  Result:=ReleaseGDIObject(PGdiObject(GDIObject));
+  Result := ReleaseGDIObject(PGdiObject(GDIObject));
 end;

 {------------------------------------------------------------------------------
@ -5713,12 +5716,23 @@ begin
  if (nIndex < 0) or (nIndex > MAX_SYS_COLORS)
  then begin
    Result := 0;
-    //RaiseException('');
    DumpStack;
    DebugLn(Format('ERROR: [TGtkWidgetSet.GetSysColor] Bad Value: %d. Valid Range between 0 and %d', [nIndex, MAX_SYS_COLORS]));
  end
-  else Result := SysColorMap[nIndex];
-  //Assert(False, Format('Trace:[TGtkWidgetSet.GetSysColor] Index %d --> %8x', [nIndex, Result]));
+  else
+    Result := SysColorMap[nIndex];
+end;
+
+function TGTKWidgetSet.GetSysColorBrush(nIndex: Integer): HBrush;
+begin
+  if (nIndex < 0) or (nIndex > MAX_SYS_COLORS)
+  then begin
+    Result := 0;
+    DumpStack;
+    DebugLn(Format('ERROR: [TGtkWidgetSet.GetSysColorBrush] Bad Value: %d. Valid Range between 0 and %d', [nIndex, MAX_SYS_COLORS]));
+  end
+  else
+    Result := FSysColorBrushes[nIndex];
 end;

 {------------------------------------------------------------------------------
--- a/lcl/interfaces/gtk/gtkwinapih.inc
+++ b/lcl/interfaces/gtk/gtkwinapih.inc
@ -56,7 +56,7 @@ function CreateFontIndirectEx(const LogFont: TLogFont; const LongFontName: strin
 function CreateIconIndirect(IconInfo: PIconInfo): HICON; override;
 function CreatePalette(const LogPalette: TLogPalette): HPALETTE; override;
 function CreatePenIndirect(const LogPen: TLogPen): HPEN; override;
-function CreatePolygonRgn(Points: PPoint; NumPts: Integer; FillMode: integer): HRGN; Override;
+function CreatePolygonRgn(Points: PPoint; NumPts: Integer; FillMode: integer): HRGN; override;
 function CreateRectRgn(X1,Y1,X2,Y2 : Integer): HRGN; override;

 procedure DeleteCriticalSection(var CritSection: TCriticalSection); override;
@ -68,13 +68,13 @@ function DestroyIcon(Handle: HICON): Boolean; override;
 function DrawFrameControl(DC: HDC; const Rect : TRect; uType, uState : Cardinal) : Boolean; override;
 function DrawFocusRect(DC: HDC; const Rect: TRect): boolean; override;
 function DrawEdge(DC: HDC; var ARect: TRect; Edge: Cardinal; grfFlags: Cardinal): Boolean; override;
-function DrawText(DC: HDC; Str: PChar; Count: Integer; var Rect: TRect; Flags: Cardinal): Integer; Override;
+function DrawText(DC: HDC; Str: PChar; Count: Integer; var Rect: TRect; Flags: Cardinal): Integer; override;

 function Ellipse(DC: HDC; x1,y1,x2,y2: Integer): Boolean; override;
 function EnableScrollBar(Wnd: HWND; wSBflags, wArrows: Cardinal): Boolean; override;
 function EnableWindow(hWnd: HWND; bEnable: Boolean): Boolean; override;
 function EndPaint(Handle : hwnd; var PS : TPaintStruct): Integer; override;
-procedure EnterCriticalSection(var CritSection: TCriticalSection); Override;
+procedure EnterCriticalSection(var CritSection: TCriticalSection); override;
 function EnumDisplayMonitors(hdc: HDC; lprcClip: PRect; lpfnEnum: MonitorEnumProc; dwData: LPARAM): LongBool; override;
 function EnumFontFamilies(DC: HDC; Family: Pchar; EnumFontFamProc: FontEnumProc; LParam:Lparam):longint; override;
 function EnumFontFamiliesEx(DC: HDC; lpLogFont: PLogFont; Callback: FontEnumExProc; Lparam: LParam; Flags: dword): longint; override;
@ -103,9 +103,9 @@ function GetCursorPos(var lpPoint: TPoint): Boolean; override;
 function GetDC(hWnd: HWND): HDC;  override;
 function GetDCOriginRelativeToWindow(PaintDC: HDC; WindowHandle: HWND; var OriginDiff: TPoint): boolean; override;
 function GetDesignerDC(WindowHandle: HWND): HDC; override;
-function GetDeviceCaps(DC: HDC; Index: Integer): Integer; Override;
+function GetDeviceCaps(DC: HDC; Index: Integer): Integer; override;
 function GetDeviceSize(DC: HDC; var p: TPoint): boolean; override;
-function GetDIBits(DC: HDC; Bitmap: HBitmap; StartScan, NumScans: UINT; Bits: Pointer; var BitInfo: BitmapInfo; Usage: UINT): Integer; Override;
+function GetDIBits(DC: HDC; Bitmap: HBitmap; StartScan, NumScans: UINT; Bits: Pointer; var BitInfo: BitmapInfo; Usage: UINT): Integer; override;
 function GetFocus: HWND; override;
 function GetFontLanguageInfo(DC: HDC): DWord; override;
 function GetKeyState(nVirtKey: Integer): Smallint; override;
@ -121,8 +121,9 @@ function GetScrollbarVisible(Handle: HWND; SBStyle: Integer): boolean; override;
 function GetScrollInfo(Handle: HWND; SBStyle: Integer; var ScrollInfo: TScrollInfo): Boolean; override;
 function GetStockObject(Value: Integer): THandle; override;
 function GetSysColor(nIndex: Integer): DWORD; override;
+function GetSysColorBrush(nIndex: Integer): HBrush; override;
 function GetSystemMetrics(nIndex: Integer): Integer;  override;
-function GetTextColor(DC: HDC) : TColorRef; Override;
+function GetTextColor(DC: HDC) : TColorRef; override;
 function GetTextExtentPoint(DC: HDC; Str: PChar; Count: Integer; var Size: TSize): Boolean; override;
 function GetTextMetrics(DC: HDC; var TM: TTextMetric): Boolean;  override;
 function GetViewPortExtEx(DC: HDC; Size: PSize): Integer; override;
@ -134,11 +135,11 @@ function GetWindowRect(Handle : hwnd; var ARect: TRect): Integer; override;
 function GetWindowRelativePosition(Handle : hwnd; var Left, Top: integer): boolean; override;
 function GetWindowSize(Handle : hwnd; var Width, Height: integer): boolean; override;
 function GradientFill(DC: HDC; Vertices: PTriVertex; NumVertices : Longint;
-  Meshes: Pointer; NumMeshes : Longint; Mode : Longint): Boolean; Override;
+  Meshes: Pointer; NumMeshes : Longint; Mode : Longint): Boolean; override;

 function HideCaret(hWnd: HWND): Boolean; override;

-procedure InitializeCriticalSection(var CritSection: TCriticalSection); Override;
+procedure InitializeCriticalSection(var CritSection: TCriticalSection); override;
 function IntersectClipRect(dc: hdc; Left, Top, Right, Bottom: Integer): Integer; override;
 function InvalidateRect(aHandle : HWND; Rect : pRect; bErase : Boolean) : Boolean; override;
 function IsIconic(handle: HWND): boolean; override;
@ -147,7 +148,7 @@ function IsWindowEnabled(handle: HWND): boolean; override;
 function IsWindowVisible(handle: HWND): boolean; override;
 function IsZoomed(handle: HWND): boolean; override;

-procedure LeaveCriticalSection(var CritSection: TCriticalSection); Override;
+procedure LeaveCriticalSection(var CritSection: TCriticalSection); override;
 function LineTo(DC: HDC; X, Y: Integer): Boolean; override;

 function MessageBox(hWnd: HWND; lpText, lpCaption: PChar; uType: Cardinal): integer; override;