lcl: Pen and Font cache

- simplify some Font cache methods
  - rewrite Pen cache to store pattern separate of LogPen

git-svn-id: trunk@17305 -

lcl/graphics.pp

@@ -552,11 +552,27 @@ type
 
   TPenPattern = array of LongWord;
 
-  TPenHandleCache = class(TBlockResourceCache)
+  { TPenHandleCacheDescriptor }
+
+  TPenHandleCacheDescriptor = class(TResourceCacheDescriptor)
+  public
+    ExtPen: TExtLogPen;
+    Pattern: TPenPattern;
+  end;
+
+  { TPenHandleCache }
+
+  TPenHandleCache = class(TResourceCache)
   protected
     procedure RemoveItem(Item: TResourceCacheItem); override;
   public
     constructor Create;
+    function CompareDescriptors(Tree: TAvgLvlTree; Desc1, Desc2: Pointer): integer; override;
+    function FindPen(APen: TLCLHandle): TResourceCacheItem;
+    function FindPenDesc(const AExtPen: TExtLogPen;
+                         const APattern: TPenPattern): TPenHandleCacheDescriptor;
+    function Add(APen: TLCLHandle; const AExtPen: TExtLogPen;
+                 const APattern: TPenPattern): TPenHandleCacheDescriptor;
   end;
 
   TPen = class(TFPCustomPen)
@@ -2399,7 +2415,6 @@ begin
   FreeAndNil(BrushResourceCache);
 end;
 
-
 initialization
   UpdateLock := TCriticalSection.Create;
   RegisterIntegerConsts(TypeInfo(TColor), @IdentToColor, @ColorToIdent);

lcl/include/font.inc

@@ -29,10 +29,10 @@ type
 
 function CompareLogFontAndNameWithResDesc(Key: PLogFontAndName; Desc: TFontHandleCacheDescriptor): integer;
 begin
-  Result:=CompareStr(Key^.LongFontName,Desc.LongFontName);
+  Result := CompareStr(Key^.LongFontName, Desc.LongFontName);
   //debugln('CompareLogFontAndNameWithResDesc A ',Key^.LongFontName,' ',Desc.LongFontName,' ',DbgS(Desc),' Result=',Result);
-  if Result=0 then
+  if Result = 0 then
-    Result:=CompareMemRange(@Key^.LogFont,@Desc.LogFont,SizeOf(Desc.LogFont));
+    Result := CompareMemRange(@Key^.LogFont, @Desc.LogFont, SizeOf(Desc.LogFont));
   //debugln('CompareLogFontAndNameWithResDesc END Result=',Result);
 end;
 
@@ -51,14 +51,13 @@ end;
 function TFontHandleCache.CompareDescriptors(Tree: TAvgLvlTree; Desc1,
   Desc2: Pointer): integer;
 var
-  Descriptor1: TFontHandleCacheDescriptor;
+  Descriptor1: TFontHandleCacheDescriptor absolute Desc1;
-  Descriptor2: TFontHandleCacheDescriptor;
+  Descriptor2: TFontHandleCacheDescriptor absolute Desc2;
 begin
-  Descriptor1:=TFontHandleCacheDescriptor(Desc1);
+  Result := CompareStr(Descriptor1.LongFontName, Descriptor2.LongFontName);
-  Descriptor2:=TFontHandleCacheDescriptor(Desc2);
+  if Result <> 0 then
-  Result:=CompareStr(Descriptor1.LongFontName,Descriptor2.LongFontName);
+    Exit;
-  if Result<>0 then exit;
+  Result := CompareMemRange(@Descriptor1.LogFont, @Descriptor2.LogFont,
-  Result:=CompareMemRange(@Descriptor1.LogFont,@Descriptor2.LogFont,
                           SizeOf(Descriptor1.LogFont));
 end;
 
@@ -66,12 +65,12 @@ function TFontHandleCache.FindFont(TheFont: TLCLHandle): TResourceCacheItem;
 var
   ANode: TAvgLvlTreeNode;
 begin
-  ANode:=FItems.FindKey(@TheFont,
+  ANode := FItems.FindKey(@TheFont,
-                        TListSortCompare(@ComparePHandleWithResourceCacheItem));
+                          TListSortCompare(@ComparePHandleWithResourceCacheItem));
-  if ANode<>nil then
+  if ANode <> nil then
-    Result:=TResourceCacheItem(ANode.Data)
+    Result := TResourceCacheItem(ANode.Data)
   else
-    Result:=nil;
+    Result := nil;
 end;
 
 function TFontHandleCache.FindFontDesc(const LogFont: TLogFont;
@@ -80,14 +79,14 @@ var
   LogFontAndName: TLogFontAndName;
   ANode: TAvgLvlTreeNode;
 begin
-  LogFontAndName.LogFont:=LogFont;
+  LogFontAndName.LogFont := LogFont;
-  LogFontAndName.LongFontName:=LongFontName;
+  LogFontAndName.LongFontName := LongFontName;
-  ANode:=FDescriptors.Findkey(@LogFontAndName,
+  ANode := FDescriptors.Findkey(@LogFontAndName,
                            TListSortCompare(@CompareLogFontAndNameWithResDesc));
-  if ANode<>nil then
+  if ANode <> nil then
-    Result:=TFontHandleCacheDescriptor(ANode.Data)
+    Result := TFontHandleCacheDescriptor(ANode.Data)
   else
-    Result:=nil;
+    Result := nil;
 end;
 
 function TFontHandleCache.Add(TheFont: TLCLHandle; const LogFont: TLogFont;
@@ -95,29 +94,30 @@ function TFontHandleCache.Add(TheFont: TLCLHandle; const LogFont: TLogFont;
 var
   Item: TResourceCacheItem;
 begin
-  if FindFontDesc(LogFont,LongFontName)<>nil then
+  if FindFontDesc(LogFont, LongFontName) <> nil then
     RaiseGDBException('TFontHandleCache.Add font desc added twice');
 
   // find cache item with TheFont
-  Item:=FindFont(TheFont);
+  Item := FindFont(TheFont);
-  if Item=nil then begin
+  if Item = nil then
+  begin
     // create new item
-    Item:=TResourceCacheItem.Create(Self,TheFont);
+    Item := TResourceCacheItem.Create(Self, TheFont);
     FItems.Add(Item);
   end;
 
   // create descriptor
-  Result:=TFontHandleCacheDescriptor.Create(Self,Item);
+  Result := TFontHandleCacheDescriptor.Create(Self, Item);
-  Result.LongFontName:=LongFontName;
+  Result.LongFontName := LongFontName;
-  Result.LogFont:=LogFont;
+  Result.LogFont := LogFont;
   FDescriptors.Add(Result);
-  if FindFontDesc(LogFont,LongFontName)=nil then begin
+  if FindFontDesc(LogFont, LongFontName) = nil then
-    DebugLn('TFontHandleCache.Add Added: %p LongFontName=%s',[Pointer(Result), Result.LongFontName]);
+  begin
+    DebugLn('TFontHandleCache.Add Added: %p LongFontName=%s', [Pointer(Result), Result.LongFontName]);
     RaiseGDBException('');
   end;
 end;
 
-
 { TFont }
 
 procedure GetCharsetValues(Proc: TGetStrProc);

lcl/include/pen.inc

@@ -17,19 +17,122 @@
  *****************************************************************************
 }
 
+type
+  TExtPenAndPattern = record
+    ExtPen: TExtLogPen;
+    Pattern: TPenPattern;
+  end;
+  PExtPenAndPattern = ^TExtPenAndPattern;
+
+function CompareExtPenAndPatternWithResDesc(Key: PExtPenAndPattern; Desc: TPenHandleCacheDescriptor): integer;
+begin
+  Result := CompareMemRange(@Key^.ExtPen, @Desc.ExtPen,
+                          SizeOf(Key^.ExtPen));
+  if Result <> 0 then
+    Exit;
+
+  Result := CompareValue(Length(Key^.Pattern), Length(Desc.Pattern));
+  if Result <> 0 then
+    Exit;
+
+  if Length(Key^.Pattern) > 0 then
+  begin
+    Result := CompareMemRange(@Key^.Pattern[0], @Desc.Pattern[0],
+                            SizeOf(Key^.Pattern[0]) * Length(Key^.Pattern));
+  end;
+end;
+
 { TPenHandleCache }
 
 procedure TPenHandleCache.RemoveItem(Item: TResourceCacheItem);
 begin
-  if Item = nil then
-    RaiseGDBException('TPenHandleCache.RemoveItem');
   DeleteObject(HGDIOBJ(Item.Handle));
   inherited RemoveItem(Item);
 end;
 
 constructor TPenHandleCache.Create;
 begin
-  inherited Create(SizeOf(TExtLogPen));
+  inherited Create;
+  FResourceCacheDescriptorClass := TPenHandleCacheDescriptor;
+end;
+
+function TPenHandleCache.CompareDescriptors(Tree: TAvgLvlTree; Desc1,
+  Desc2: Pointer): integer;
+var
+  Descriptor1: TPenHandleCacheDescriptor absolute Desc1;
+  Descriptor2: TPenHandleCacheDescriptor absolute Desc2;
+begin
+  Result := CompareMemRange(@Descriptor1.ExtPen, @Descriptor2.ExtPen,
+                          SizeOf(Descriptor1.ExtPen));
+  if Result <> 0 then
+    Exit;
+
+  Result := CompareValue(Length(Descriptor1.Pattern), Length(Descriptor2.Pattern));
+  if Result <> 0 then
+    Exit;
+
+  if Length(Descriptor1.Pattern) > 0 then
+  begin
+    Result := CompareMemRange(@Descriptor1.Pattern[0], @Descriptor2.Pattern[0],
+                            SizeOf(Descriptor1.Pattern[0]) * Length(Descriptor1.Pattern));
+  end;
+end;
+
+function TPenHandleCache.FindPen(APen: TLCLHandle): TResourceCacheItem;
+var
+  ANode: TAvgLvlTreeNode;
+begin
+  ANode := FItems.FindKey(@APen,
+                          TListSortCompare(@ComparePHandleWithResourceCacheItem));
+  if ANode <> nil then
+    Result := TResourceCacheItem(ANode.Data)
+  else
+    Result := nil;
+end;
+
+function TPenHandleCache.FindPenDesc(const AExtPen: TExtLogPen;
+  const APattern: TPenPattern): TPenHandleCacheDescriptor;
+var
+  ExtPenAndPattern: TExtPenAndPattern;
+  ANode: TAvgLvlTreeNode;
+begin
+  ExtPenAndPattern.ExtPen := AExtPen;
+  ExtPenAndPattern.Pattern := APattern;
+  ANode := FDescriptors.Findkey(@ExtPenAndPattern,
+                           TListSortCompare(@CompareExtPenAndPatternWithResDesc));
+  if ANode <> nil then
+    Result := TPenHandleCacheDescriptor(ANode.Data)
+  else
+    Result := nil;
+end;
+
+function TPenHandleCache.Add(APen: TLCLHandle; const AExtPen: TExtLogPen;
+  const APattern: TPenPattern): TPenHandleCacheDescriptor;
+var
+  Item: TResourceCacheItem;
+begin
+  if FindPenDesc(AExtPen, APattern) <> nil then
+    RaiseGDBException('TPenHandleCache.Add pen desc added twice');
+
+  // find cache item with APen
+  Item := FindPen(APen);
+  if Item = nil then
+  begin
+    // create new item
+    Item := TResourceCacheItem.Create(Self, APen);
+    FItems.Add(Item);
+  end;
+
+  // create descriptor
+  Result := TPenHandleCacheDescriptor.Create(Self, Item);
+  Result.ExtPen := AExtPen;
+  Result.Pattern := APattern;
+  FDescriptors.Add(Result);
+  if FindPenDesc(AExtPen, APattern) = nil then
+  begin
+    DebugLn('TPenHandleCache.Add Added: %p', [Pointer(Result)]);
+    RaiseGDBException('');
+  end;
 end;
 
 { TPen }
@@ -262,7 +365,7 @@ var
   ALogPen: TLogPen;
   AExtPen: TExtLogPen;
   ALogBrush: TLogBrush;
-  CachedPen: TBlockResourceCacheDescriptor;
+  CachedPen: TPenHandleCacheDescriptor;
 begin
   if FReference.Allocated then Exit;
 
@@ -277,7 +380,11 @@ begin
     elpColor := FColor;
   end;
 
-  CachedPen := PenResourceCache.FindDescriptor(@AExtPen);
+  if Style = psPattern then
+    CachedPen := PenResourceCache.FindPenDesc(AExtPen, FPattern)
+  else
+    CachedPen := PenResourceCache.FindPenDesc(AExtPen, nil);
+
   if CachedPen <> nil then
   begin
     CachedPen.Item.IncreaseRefCount;
@@ -285,7 +392,8 @@ begin
   end else
   begin
     // choose which function to use: CreatePenIndirect or ExtCreatePen
-    if ((AExtPen.elpPenStyle and PS_STYLE_MASK) = AExtPen.elpPenStyle) and (AExtPen.elpPenStyle <> PS_USERSTYLE) then
+    if ((AExtPen.elpPenStyle and PS_STYLE_MASK) = AExtPen.elpPenStyle) and
+        (AExtPen.elpPenStyle <> PS_USERSTYLE) then
     begin
       // simple pen
       ALogPen.lopnStyle := AExtPen.elpPenStyle;
@@ -300,11 +408,17 @@ begin
       ALogBrush.lbColor := AExtPen.elpColor;
       ALogBrush.lbHatch := AExtPen.elpHatch;
       if (Style = psPattern) and (Length(FPattern) > 0) then
-        FReference._lclHandle := TLCLHandle(ExtCreatePen(AExtPen.elpPenStyle, AExtPen.elpWidth, ALogBrush, Length(FPattern), @FPattern[0]))
+        FReference._lclHandle := TLCLHandle(ExtCreatePen(AExtPen.elpPenStyle,
+          AExtPen.elpWidth, ALogBrush, Length(FPattern), @FPattern[0]))
       else
-        FReference._lclHandle := TLCLHandle(ExtCreatePen(AExtPen.elpPenStyle, AExtPen.elpWidth, ALogBrush, 0, nil));
+        FReference._lclHandle := TLCLHandle(ExtCreatePen(AExtPen.elpPenStyle,
+          AExtPen.elpWidth, ALogBrush, 0, nil));
     end;
-    PenResourceCache.AddResource(FReference.Handle, @AExtPen);
+
+    if Style = psPattern then
+      PenResourceCache.Add(FReference.Handle, AExtPen, FPattern)
+    else
+      PenResourceCache.Add(FReference.Handle, AExtPen, nil);
   end;
   FPenHandleCached := True;
 end;
@@ -344,7 +458,7 @@ begin
   Changing;
   if FPenHandleCached then
   begin
-    PenResourceCache.FindItem(FReference.Handle).DecreaseRefCount;
+    PenResourceCache.FindPen(FReference.Handle).DecreaseRefCount;
     FPenHandleCached := False;
   end else
     DeleteObject(HGDIOBJ(FReference.Handle));

lcl/lclrescache.pas

@@ -150,7 +150,6 @@ function ComparePHandleWithResourceCacheItem(HandlePtr: PLCLHandle; Item:
 function CompareDescPtrWithBlockResDesc(DescPtr: Pointer;
   Item: TBlockResourceCacheDescriptor): integer;
 
-
 implementation