pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

* Check images are loaded at demand

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@218 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
blikblum
2007-07-20 01:17:03 +00:00
parent fd170582cf
commit f36c59e625
1 changed files with 55 additions and 114 deletions
Download Patch File Download Diff File Expand all files Collapse all files

169
components/virtualtreeview-unstable/VirtualTrees.pas
View File

@ -2278,7 +2278,7 @@ TBaseVirtualTree = class(TCustomControl)
procedure FreeDragManager; procedure FreeDragManager;
function GetBorderDimensions: TSize; virtual; function GetBorderDimensions: TSize; virtual;
function GetCheckImage(Node: PVirtualNode): Integer; virtual; function GetCheckImage(Node: PVirtualNode): Integer; virtual;
class function GetCheckImageListFor(Kind: TCheckImageKind): TBitmap; virtual; procedure GetCheckImageList; virtual;
function GetClientRect: TRect; override; function GetClientRect: TRect; override;
function GetColumnClass: TVirtualTreeColumnClass; virtual; function GetColumnClass: TVirtualTreeColumnClass; virtual;
function GetHeaderClass: TVTHeaderClass; virtual; function GetHeaderClass: TVTHeaderClass; virtual;
@ -3410,6 +3410,17 @@ type // streaming support
end; end;
const 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); MagicID: TMagicID = (#$2045, 'V', 'T', WideChar(VTTreeStreamVersion), ' ', #$2046);
// chunk IDs // chunk IDs
@ -3489,20 +3500,10 @@ type
var var
WorkerThread: TWorkerThread; WorkerThread: TWorkerThread;
WorkEvent: TEvent; 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. Initialized: Boolean; // True if global structures have been initialized.
NeedToUnitialize: Boolean; // True if the OLE subsystem could be initialized successfully. NeedToUnitialize: Boolean; // True if the OLE subsystem could be initialized successfully.
{.$I lclfunctions.inc}
//----------------- TClipboardFormats ---------------------------------------------------------------------------------- //----------------- TClipboardFormats ----------------------------------------------------------------------------------
type 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. // 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 const
MaskColor: TColor = clRed; MaskColor: TColor = clFuchsia;
FlatToCheckKind: array[Boolean] of TCheckImageKind = (ckDarkCheck,ckFlat);
//--------------- local functions ------------------------------------------- //--------------- 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); procedure AddSystemImage(Index: Integer);
var var
@ -4664,20 +4641,23 @@ begin
Width := 16; Width := 16;
Height := 16; Height := 16;
{$endif} {$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.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. // Add the 20 system checkbox and radiobutton images.
for I := 0 to 19 do for I := 0 to 19 do
AddSystemImage(I); AddSystemImage(I);
// Add the 4 node images from the dark check set. // Add the 4 node images from the dark check set.
AddNodeImages;
BM.MaskHandle := CreateBitmapMask(BM.Canvas.Handle, BM.Width, BM.Height, MaskColor); BM.MaskHandle := CreateBitmapMask(BM.Canvas.Handle, BM.Width, BM.Height, MaskColor);
{$endif}
end; end;
//---------------------------------------------------------------------------------------------------------------------- //----------------------------------------------------------------------------------------------------------------------
@ -4761,9 +4741,6 @@ procedure InitializeGlobalStructures;
// initialization of stuff global to the unit // initialization of stuff global to the unit
var
Flags: Cardinal;
begin begin
Initialized := True; Initialized := True;
@ -4784,30 +4761,9 @@ begin
// Register the tree reference clipboard format. Others will be handled in InternalClipboarFormats. // Register the tree reference clipboard format. Others will be handled in InternalClipboarFormats.
CF_VTREFERENCE := ClipboardRegisterFormat(CFSTR_VTREFERENCE); 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 := TBitmap.Create;
UtilityImages.LoadFromLazarusResource('VT_UTILITIES'); UtilityImages.LoadFromLazarusResource('VT_UTILITIES');
CreateSystemImageSet(SystemCheckImages, Flags, False);
CreateSystemImageSet(SystemFlatCheckImages, Flags, True);
// Specify an useful timer resolution for timeGetTime. // Specify an useful timer resolution for timeGetTime.
timeBeginPeriod(MinimumTimerInterval); timeBeginPeriod(MinimumTimerInterval);
@ -4840,24 +4796,7 @@ var
begin begin
timeEndPeriod(MinimumTimerInterval); 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 if NeedToUnitialize then
OleUninitialize; OleUninitialize;
@ -11394,7 +11333,6 @@ begin
DoubleBuffered := False; DoubleBuffered := False;
FCheckImageKind := ckLightCheck; FCheckImageKind := ckLightCheck;
FCheckImages := LightCheckImages;
FImageChangeLink := TChangeLink.Create; FImageChangeLink := TChangeLink.Create;
FImageChangeLink.OnChange := ImageListChange; FImageChangeLink.OnChange := ImageListChange;
@ -11475,6 +11413,8 @@ begin
FCustomCheckChangeLink.Free; FCustomCheckChangeLink.Free;
FScrollBarOptions.Free; FScrollBarOptions.Free;
FOptions.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. // The window handle must be destroyed before the header is freed because it is needed in WM_NCDESTROY.
//todo_lcl_check //todo_lcl_check
@ -13778,9 +13718,8 @@ begin
if FCheckImageKind <> Value then if FCheckImageKind <> Value then
begin begin
FCheckImageKind := Value; 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 if HandleAllocated and (FUpdateCount = 0) and not (csLoading in ComponentState) then
InvalidateRect(Handle, nil, False); InvalidateRect(Handle, nil, False);
end; end;
@ -17638,6 +17577,8 @@ begin
if not (csDesigning in ComponentState) and (toAcceptOLEDrop in FOptions.FMiscOptions) then if not (csDesigning in ComponentState) and (toAcceptOLEDrop in FOptions.FMiscOptions) then
RegisterDragDrop(Handle, DragManager as IDropTarget); RegisterDragDrop(Handle, DragManager as IDropTarget);
if toCheckSupport in FOptions.FMiscOptions then
GetCheckImageList;
UpdateScrollBars(True); UpdateScrollBars(True);
UpdateHeaderRect; UpdateHeaderRect;
end; end;
@ -20308,28 +20249,28 @@ end;
//---------------------------------------------------------------------------------------------------------------------- //----------------------------------------------------------------------------------------------------------------------
class function TBaseVirtualTree.GetCheckImageListFor(Kind: TCheckImageKind): TBitmap; procedure TBaseVirtualTree.GetCheckImageList;
begin 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; else
ckLightCheck: begin
Result := LightCheckImages; if (FCheckImages = nil) or (FCheckImages = FCustomCheckImages) then
ckFlat: FCheckImages := TBitmap.Create;
Result := FlatImages; case FCheckImageKind of
ckXP: ckSystem:
Result := XPImages; CreateSystemImageSet(FCheckImages, False);
ckSystem: ckSystemFlat:
Result := SystemCheckImages; CreateSystemImageSet(FCheckImages, True);
ckSystemFlat: else
Result := SystemFlatCheckImages; FCheckImages.TransparentColor := clDefault;
else FCheckImages.LoadFromLazarusResource(CheckImagesStrings[FCheckImageKind]);
Result := nil; end;
end; end;
end; end;