mmbcache.pas

一套及时通讯的原码

{========================================================================}
{=                (c) 1995-98 SwiftSoft Ronald Dittrich                 =}
{========================================================================}
{=                          All Rights Reserved                         =}
{========================================================================}
{=  D 01099 Dresden             = Tel.: [phone]                   =}
{=  Loewenstr.7a                = [e-mail]                     =}
{========================================================================}
{=  Actual versions on http://www.swiftsoft.de/mmtools.html             =}
{========================================================================}
{=  This code is for reference purposes only and may not be copied or   =}
{=  distributed in any format electronic or otherwise except one copy   =}
{=  for backup purposes.                                                =}
{=                                                                      =}
{=  No Delphi Component Kit or Component individually or in a collection=}
{=  subclassed or otherwise from the code in this unit, or associated   =}
{=  .pas, .dfm, .dcu, .asm or .obj files may be sold or distributed     =}
{=  without express permission from SwiftSoft.                          =}
{=                                                                      =}
{=  For more licence informations please refer to the associated        =}
{=  HelpFile.                                                           =}
{========================================================================}
{=  $Date: 17.02.98 - 01:12:49 $                                        =}
{========================================================================}
unit MMBCache;

{$I COMPILER.INC}

interface

uses
    {$IFDEF WIN32}
    Windows,
    {$ELSE}
    WinTypes,
    WinProcs,
    {$ENDIF}
    SysUtils,
    Classes,
    Graphics;

function  LoadCacheBitmap(Width, Height: integer): TBitmap;
procedure RemoveCacheBitmap(var Bitmap: TBitmap);

implementation

{=========================================================================}
type
    PCacheBitmap = ^TCacheBitmap;
    TCacheBitmap = record
       FBitmap    : TBitmap;
       FCount     : integer;
    end;

    TBitmapCache = class
    public
       BitmapList: TList;
       constructor Create;
       destructor  Destroy; override;
    end;

const
   BitmapCache : TBitmapCache = nil;

{== TBitmapCache ========================================================}
constructor TBitmapCache.Create;
begin
   inherited Create;
   BitmapList := TList.Create;
end;

{-- TBitmapCache --------------------------------------------------------}
destructor TBitmapCache.Destroy;
begin
   BitmapList.Free;
   inherited Destroy;
end;

{------------------------------------------------------------------------------}
function LoadCacheBitmap(Width, Height: integer): TBitmap;
Var
   CacheBitmap: PCacheBitmap;
   i: integer;

begin
   if (BitmapCache = nil) then BitmapCache := TBitmapCache.Create;

   with BitmapCache do
   begin
      if (BitmapList.Count > 0) then
      begin
         { look if we have such a bitmap always in the cache }
         for i := 0 to BitmapList.Count-1 do
         with PCacheBitmap(BitmapList.Items[i])^ do
         begin
            if (FBitmap.Width = Width) and (FBitmap.Height = Height) then
            begin
               inc(FCount);
               Result := FBitmap;
               exit;
            end;
         end;
      end;

      New(CacheBitmap);
      with CacheBitmap^ do
      begin
         FBitmap := TBitmap.Create;
         FBitmap.Width := Width;
         FBitmap.Height := Height;
         FCount     := 1;

         BitmapList.Add(CacheBitmap);
         Result := FBitmap;
      end;
   end;
end;

{------------------------------------------------------------------------------}
procedure RemoveCacheBitmap(var Bitmap: TBitmap);
var
   i: integer;

begin
   if (Bitmap <> nil) and (BitmapCache <> nil) then
   with BitmapCache do
   begin
      if (BitmapList.Count > 0) then
      begin
         for i := 0 to BitmapList.Count-1 do
         with PCacheBitmap(BitmapList.Items[i])^ do
         begin
            if (FBitmap = Bitmap) then
            begin
               dec(FCount);
               if (FCount = 0) then
               begin
                  FBitmap.Free;
                  Dispose(BitmapList.Items[i]);
                  BitmapList.Delete(i);
                  Bitmap := nil;
               end;
               break;
            end;
         end;
      end;

      if (BitmapList.Count = 0) then
      begin
         BitmapCache.Free;
         BitmapCache := nil;
      end;
   end;
end;

end.