* Check images are loaded at demand

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@218 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/virtualtreeview-unstable/VirtualTrees.pas

@@ -2278,7 +2278,7 @@ TBaseVirtualTree = class(TCustomControl)
     procedure FreeDragManager;
     function GetBorderDimensions: TSize; virtual;
     function GetCheckImage(Node: PVirtualNode): Integer; virtual;
-    class function GetCheckImageListFor(Kind: TCheckImageKind): TBitmap; virtual;
+    procedure GetCheckImageList; virtual;
     function GetClientRect: TRect; override;
     function GetColumnClass: TVirtualTreeColumnClass; virtual;
     function GetHeaderClass: TVTHeaderClass; virtual;
@@ -3410,6 +3410,17 @@ type // streaming support
   end;
 
 const
+  CheckImagesStrings: array [TCheckImageKind] of String =
+    ('VT_CHECK_LIGHT',
+    'VT_CHECK_DARK',
+    'VT_TICK_LIGHT',
+    'VT_TICK_DARK',
+    'VT_FLAT',
+    'VT_XP',
+    '',//ckCustom,
+    '',//ckSystem,
+    ''//ckSystemFlat
+     );
   MagicID: TMagicID = (#$2045, 'V', 'T', WideChar(VTTreeStreamVersion), ' ', #$2046);
 
   // chunk IDs
@@ -3489,20 +3500,10 @@ type
 var
   WorkerThread: TWorkerThread;
   WorkEvent: TEvent;
-  LightCheckImages,                    // global light check images
+  UtilityImages: TBitmap;              // some small additional images (e.g for header dragging)
-  DarkCheckImages,                     // global heavy check images
-  LightTickImages,                     // global light tick images
-  DarkTickImages,                      // global heavy check images
-  FlatImages,                          // global flat check images
-  XPImages,                            // global XP style check images
-  UtilityImages,                       // some small additional images (e.g for header dragging)
-  SystemCheckImages,                   // global system check images
-  SystemFlatCheckImages: TBitmap;   // global flat system check images
   Initialized: Boolean;                // True if global structures have been initialized.
   NeedToUnitialize: Boolean;           // True if the OLE subsystem could be initialized successfully.
 
-{.$I lclfunctions.inc}
-
 //----------------- TClipboardFormats ----------------------------------------------------------------------------------
 
 type
@@ -4583,41 +4584,17 @@ end;
 
 //----------------------------------------------------------------------------------------------------------------------
 
-procedure CreateSystemImageSet(var BM: TBitmap; Flags: Cardinal; Flat: Boolean);
+procedure CreateSystemImageSet(BM: TBitmap; Flat: Boolean);
 
 // Creates a system check image set.
-// Note: the DarkCheckImages and FlatImages image lists must already be filled, as some images from them are copied here.
+// Note: some images are copied from DarkCheckImages and FlatImages
 
 const
-  MaskColor: TColor = clRed;
+  MaskColor: TColor = clFuchsia;
+  FlatToCheckKind: array[Boolean] of TCheckImageKind = (ckDarkCheck,ckFlat);
 
   //--------------- local functions -------------------------------------------
 
-  procedure AddNodeImages;
-
-  var
-    I: Integer;
-    OffsetX,
-    OffsetY: Integer;
-    SrcBM: TBitmap;
-
-  begin
-    // The offsets are used to center the node images in case the sizes differ.
-    OffsetX := (BM.Height - DarkCheckImages.Height) div 2;
-    OffsetY := (BM.Height - DarkCheckImages.Height) div 2;
-    if Flat then
-      SrcBM := FlatImages
-    else
-      SrcBM := DarkCheckImages;
-    for I := 21 to 24 do
-    begin
-      StretchMaskBlt(BM.Canvas.Handle, I*BM.Height + OffsetX, OffsetY, BM.Height, BM.Height, SrcBM.Canvas.Handle,
-        I*SrcBM.Height, 0, BM.Height, BM.Height, SrcBM.MaskHandle, 0, 0, 0);
-    end;
-  end;
-
-  //---------------------------------------------------------------------------
-
   procedure AddSystemImage(Index: Integer);
 
   var
@@ -4664,20 +4641,23 @@ begin
   Width := 16;
   Height := 16;
   {$endif}
-  
+  {$ifdef Windows}
-  // Create a temporary bitmap, which holds the intermediate images.
+  //Transparent property does not work for 4bpp bitmaps (LCL bug 8823)
-  BM := TBitmap.Create;
+  //BM.Transparent := False;
-  BM.Width := Width * 25;
+  BM.TransparentColor := clNone;
-  BM.Height := Height;
+  {$endif}
+  BM.LoadFromLazarusResource(CheckImagesStrings[FlatToCheckKind[Flat]]);
+  //DrawFrameControl is not properly implemented in gtk
+  {$ifdef Windows}
   BM.Canvas.Brush.Color := MaskColor;
-  //BM.Canvas.Brush.Style := bsSolid;
+  //clear the first 21 images
-  BM.Canvas.FillRect(Rect(0, 0, BM.Width, BM.Height));
+  BM.Canvas.FillRect(Rect(0, 0, Width * 21, BM.Height));
   // Add the 20 system checkbox and radiobutton images.
   for I := 0 to 19 do
     AddSystemImage(I);
   // Add the 4 node images from the dark check set.
-  AddNodeImages;
   BM.MaskHandle := CreateBitmapMask(BM.Canvas.Handle, BM.Width, BM.Height, MaskColor);
+  {$endif}
 end;
 
 //----------------------------------------------------------------------------------------------------------------------
@@ -4761,9 +4741,6 @@ procedure InitializeGlobalStructures;
 
 // initialization of stuff global to the unit
 
-var
-  Flags: Cardinal;
-
 begin
   Initialized := True;
 
@@ -4784,30 +4761,9 @@ begin
   // Register the tree reference clipboard format. Others will be handled in InternalClipboarFormats.
   CF_VTREFERENCE := ClipboardRegisterFormat(CFSTR_VTREFERENCE);
 
-  LightCheckImages := TBitmap.Create;
-  LightCheckImages.LoadFromLazarusResource('VT_CHECK_LIGHT');
-
-  DarkCheckImages := TBitmap.Create;
-  DarkCheckImages.LoadFromLazarusResource('VT_CHECK_DARK');
-
-  LightTickImages := TBitmap.Create;
-  LightTickImages.LoadFromLazarusResource('VT_TICK_LIGHT');
-
-  DarkTickImages := TBitmap.Create;
-  DarkTickImages.LoadFromLazarusResource('VT_TICK_DARK');
-
-  FlatImages := TBitmap.Create;
-  FlatImages.LoadFromLazarusResource('VT_FLAT');
-
-  XPImages := TBitmap.Create;
-  XPImages.LoadFromLazarusResource('VT_XP');
-
   UtilityImages := TBitmap.Create;
   UtilityImages.LoadFromLazarusResource('VT_UTILITIES');
 
-  CreateSystemImageSet(SystemCheckImages, Flags, False);
-  CreateSystemImageSet(SystemFlatCheckImages, Flags, True);
-
   // Specify an useful timer resolution for timeGetTime.
   timeBeginPeriod(MinimumTimerInterval);
 
@@ -4840,24 +4796,7 @@ var
 begin
   timeEndPeriod(MinimumTimerInterval);
 
-  LightCheckImages.Free;
+  FreeAndNil(UtilityImages);
-  LightCheckImages := nil;
-  DarkCheckImages.Free;
-  DarkCheckImages := nil;
-  LightTickImages.Free;
-  LightTickImages := nil;
-  DarkTickImages.Free;
-  DarkTickImages := nil;
-  FlatImages.Free;
-  FlatImages := nil;
-  XPImages.Free;
-  XPImages := nil;
-  UtilityImages.Free;
-  UtilityImages := nil;
-  SystemCheckImages.Free;
-  SystemCheckImages := nil;
-  SystemFlatCheckImages.Free;
-  SystemFlatCheckImages := nil;
 
   if NeedToUnitialize then
     OleUninitialize;
@@ -11394,7 +11333,6 @@ begin
   DoubleBuffered := False;
 
   FCheckImageKind := ckLightCheck;
-  FCheckImages := LightCheckImages;
 
   FImageChangeLink := TChangeLink.Create;
   FImageChangeLink.OnChange := ImageListChange;
@@ -11475,6 +11413,8 @@ begin
   FCustomCheckChangeLink.Free;
   FScrollBarOptions.Free;
   FOptions.Free;
+  if FCheckImages <> FCustomCheckImages then
+    FCheckImages.Free;
 
   // The window handle must be destroyed before the header is freed because it is needed in WM_NCDESTROY.
   //todo_lcl_check
@@ -13778,9 +13718,8 @@ begin
   if FCheckImageKind <> Value then
   begin
     FCheckImageKind := Value;
-    FCheckImages := GetCheckImageListFor(Value);
+    if toCheckSupport in FOptions.FMiscOptions then
-    if FCheckImages = nil then
+      GetCheckImageList;
-      FCheckImages := FCustomCheckImages;
     if HandleAllocated and (FUpdateCount = 0) and not (csLoading in ComponentState) then
       InvalidateRect(Handle, nil, False);
   end;
@@ -17638,6 +17577,8 @@ begin
   if not (csDesigning in ComponentState) and (toAcceptOLEDrop in FOptions.FMiscOptions) then
      RegisterDragDrop(Handle, DragManager as IDropTarget);
 
+  if toCheckSupport in FOptions.FMiscOptions then
+    GetCheckImageList;
   UpdateScrollBars(True);
   UpdateHeaderRect;
 end;
@@ -20308,28 +20249,28 @@ end;
 
 //----------------------------------------------------------------------------------------------------------------------
 
-class function TBaseVirtualTree.GetCheckImageListFor(Kind: TCheckImageKind): TBitmap;
+procedure TBaseVirtualTree.GetCheckImageList;
 
 begin
-  case Kind of
+  if FCheckImageKind = ckCustom then
-    ckDarkCheck:
+  begin
-      Result := DarkCheckImages;
+    if FCheckImages <> FCustomCheckImages then
-    ckLightTick:
+      FCheckImages.Free;
-      Result := LightTickImages;
+    FCheckImages := FCustomCheckImages;
-    ckDarkTick:
+  end
-      Result := DarkTickImages;
-    ckLightCheck:
-      Result := LightCheckImages;
-    ckFlat:
-      Result := FlatImages;
-    ckXP:
-      Result := XPImages;
-    ckSystem:
-      Result := SystemCheckImages;
-    ckSystemFlat:
-      Result := SystemFlatCheckImages;
   else
-      Result := nil;
+  begin
+    if (FCheckImages = nil) or (FCheckImages = FCustomCheckImages) then
+      FCheckImages := TBitmap.Create;
+    case FCheckImageKind of
+      ckSystem:
+        CreateSystemImageSet(FCheckImages, False);
+      ckSystemFlat:
+        CreateSystemImageSet(FCheckImages, True);
+      else
+        FCheckImages.TransparentColor := clDefault;
+        FCheckImages.LoadFromLazarusResource(CheckImagesStrings[FCheckImageKind]);
+    end;
   end;
 end;