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

* Change CheckImages type from TBitmap to TImageList just original component

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4128 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
blikblum
2015-05-14 02:07:13 +00:00
parent 400ffe6431
commit 1253df1460
1 changed files with 86 additions and 79 deletions
Download Patch File Download Diff File Expand all files Collapse all files

143
components/virtualtreeview-new/trunk/VirtualTrees.pas
View File

@ -2095,10 +2095,10 @@ type
FHotPlusBM, FHotPlusBM,
FHotMinusBM: TBitmap; // small bitmaps used for hot tree buttons FHotMinusBM: TBitmap; // small bitmaps used for hot tree buttons
FImages, // normal images in the tree FImages, // normal images in the tree
FStateImages: TCustomImageList; // state images in the tree FStateImages, // state images in the tree
FCustomCheckImages: TBitmap; // application defined check images FCustomCheckImages: TCustomImageList; // application defined check images
FCheckImageKind: TCheckImageKind; // light or dark, cross marks or tick marks FCheckImageKind: TCheckImageKind; // light or dark, cross marks or tick marks
FCheckImages: TBitmap; // Reference to global image list to be used for the check images. FCheckImages: TCustomImageList; // Reference to global image list to be used for the check images.
FImageChangeLink, FImageChangeLink,
FStateChangeLink, FStateChangeLink,
FCustomCheckChangeLink: TChangeLink; // connections to the image lists FCustomCheckChangeLink: TChangeLink; // connections to the image lists
@ -2421,7 +2421,7 @@ type
procedure SetChildCount(Node: PVirtualNode; NewChildCount: Cardinal); procedure SetChildCount(Node: PVirtualNode; NewChildCount: Cardinal);
procedure SetClipboardFormats(const Value: TClipboardFormats); procedure SetClipboardFormats(const Value: TClipboardFormats);
procedure SetColors(const Value: TVTColors); procedure SetColors(const Value: TVTColors);
procedure SetCustomCheckImages(const Value: TBitmap); procedure SetCustomCheckImages(const Value: TCustomImageList);
procedure SetDefaultNodeHeight(Value: Cardinal); procedure SetDefaultNodeHeight(Value: Cardinal);
procedure SetDisabled(Node: PVirtualNode; Value: Boolean); procedure SetDisabled(Node: PVirtualNode; Value: Boolean);
procedure SetEmptyListMessage(const Value: String); procedure SetEmptyListMessage(const Value: String);
@ -2546,8 +2546,6 @@ type
function CanSplitterResizeNode(P: TPoint; Node: PVirtualNode; Column: TColumnIndex): Boolean; function CanSplitterResizeNode(P: TPoint; Node: PVirtualNode; Column: TColumnIndex): Boolean;
procedure Change(Node: PVirtualNode); virtual; procedure Change(Node: PVirtualNode); virtual;
procedure ChangeScale(M, D: Integer); override; procedure ChangeScale(M, D: Integer); override;
//lcl
procedure CheckImageListNeeded;
function CheckParentCheckState(Node: PVirtualNode; NewCheckState: TCheckState): Boolean; virtual; function CheckParentCheckState(Node: PVirtualNode; NewCheckState: TCheckState): Boolean; virtual;
procedure ClearTempCache; virtual; procedure ClearTempCache; virtual;
function ColumnIsEmpty(Node: PVirtualNode; Column: TColumnIndex): Boolean; virtual; function ColumnIsEmpty(Node: PVirtualNode; Column: TColumnIndex): Boolean; virtual;
@ -2779,8 +2777,6 @@ type
function SuggestDropEffect(Source: TObject; Shift: TShiftState; const Pt: TPoint; AllowedEffects: LongWord): LongWord; virtual; function SuggestDropEffect(Source: TObject; Shift: TShiftState; const Pt: TPoint; AllowedEffects: LongWord): LongWord; virtual;
procedure ToggleSelection(StartNode, EndNode: PVirtualNode); virtual; procedure ToggleSelection(StartNode, EndNode: PVirtualNode); virtual;
procedure UnselectNodes(StartNode, EndNode: PVirtualNode); virtual; procedure UnselectNodes(StartNode, EndNode: PVirtualNode); virtual;
//lcl
procedure UpdateCheckImageList;
procedure UpdateColumnCheckState(Col: TVirtualTreeColumn); procedure UpdateColumnCheckState(Col: TVirtualTreeColumn);
procedure UpdateDesigner; virtual; procedure UpdateDesigner; virtual;
procedure UpdateEditBounds; virtual; procedure UpdateEditBounds; virtual;
@ -2814,7 +2810,7 @@ type
property CheckImageKind: TCheckImageKind read FCheckImageKind write SetCheckImageKind default ckSystemDefault; property CheckImageKind: TCheckImageKind read FCheckImageKind write SetCheckImageKind default ckSystemDefault;
property ClipboardFormats: TClipboardFormats read FClipboardFormats write SetClipboardFormats; property ClipboardFormats: TClipboardFormats read FClipboardFormats write SetClipboardFormats;
property Colors: TVTColors read FColors write SetColors; property Colors: TVTColors read FColors write SetColors;
property CustomCheckImages: TBitmap read FCustomCheckImages write SetCustomCheckImages; property CustomCheckImages: TCustomImageList read FCustomCheckImages write SetCustomCheckImages;
property DefaultHintKind: TVTHintKind read GetDefaultHintKind; property DefaultHintKind: TVTHintKind read GetDefaultHintKind;
property DefaultNodeHeight: Cardinal read FDefaultNodeHeight write SetDefaultNodeHeight default 18; property DefaultNodeHeight: Cardinal read FDefaultNodeHeight write SetDefaultNodeHeight default 18;
property DefaultPasteMode: TVTNodeAttachMode read FDefaultPasteMode write FDefaultPasteMode default amAddChildLast; property DefaultPasteMode: TVTNodeAttachMode read FDefaultPasteMode write FDefaultPasteMode default amAddChildLast;
@ -3188,7 +3184,7 @@ type
{$endif} {$endif}
property BottomNode: PVirtualNode read GetBottomNode write SetBottomNode; property BottomNode: PVirtualNode read GetBottomNode write SetBottomNode;
property CheckedCount: Integer read GetCheckedCount; property CheckedCount: Integer read GetCheckedCount;
property CheckImages: TBitmap read FCheckImages; property CheckImages: TCustomImageList read FCheckImages;
property CheckState[Node: PVirtualNode]: TCheckState read GetCheckState write SetCheckState; property CheckState[Node: PVirtualNode]: TCheckState read GetCheckState write SetCheckState;
property CheckType[Node: PVirtualNode]: TCheckType read GetCheckType write SetCheckType; property CheckType[Node: PVirtualNode]: TCheckType read GetCheckType write SetCheckType;
property ChildCount[Node: PVirtualNode]: Cardinal read GetChildCount write SetChildCount; property ChildCount[Node: PVirtualNode]: Cardinal read GetChildCount write SetChildCount;
@ -3551,8 +3547,7 @@ type
property Color; property Color;
property Colors; property Colors;
property Constraints; property Constraints;
//todo: see a way to set CustomCheckImages at design time property CustomCheckImages;
//property CustomCheckImages;
property DefaultNodeHeight; property DefaultNodeHeight;
property DefaultPasteMode; property DefaultPasteMode;
property DefaultText; property DefaultText;
@ -4276,6 +4271,14 @@ type
var var
WorkerThread: TWorkerThread; WorkerThread: TWorkerThread;
WorkEvent: TEvent; WorkEvent: TEvent;
LightCheckImages, // global light check images
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
SystemCheckImages, // global system check images
SystemFlatCheckImages: TImageList; // global flat system check images
UtilityImages: TBitmap; // some small additional images (e.g for header dragging) UtilityImages: TBitmap; // some small additional images (e.g for header dragging)
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.
@ -5312,6 +5315,22 @@ end;
procedure FinalizeGlobalStructures; procedure FinalizeGlobalStructures;
begin begin
LightCheckImages.Free;
LightCheckImages := nil;
DarkCheckImages.Free;
DarkCheckImages := nil;
LightTickImages.Free;
LightTickImages := nil;
DarkTickImages.Free;
DarkTickImages := nil;
FlatImages.Free;
FlatImages := nil;
XPImages.Free;
XPImages := nil;
SystemCheckImages.Free;
SystemCheckImages := nil;
SystemFlatCheckImages.Free;
SystemFlatCheckImages := nil;
FreeAndNil(UtilityImages); FreeAndNil(UtilityImages);
if NeedToUnitialize then if NeedToUnitialize then
@ -5656,10 +5675,7 @@ begin
if not (csLoading in ComponentState) and HandleAllocated then if not (csLoading in ComponentState) and HandleAllocated then
begin begin
if toCheckSupport in ToBeSet + ToBeCleared then if toCheckSupport in ToBeSet + ToBeCleared then
begin
CheckImageListNeeded;
Invalidate; Invalidate;
end;
if not (csDesigning in ComponentState) then if not (csDesigning in ComponentState) then
begin begin
if toFullRepaintOnResize in (ToBeSet + ToBeCleared) then if toFullRepaintOnResize in (ToBeSet + ToBeCleared) then
@ -6851,9 +6867,6 @@ begin
FCheckBox := Value; FCheckBox := Value;
if Value and (csDesigning in Owner.Header.Treeview.ComponentState) then if Value and (csDesigning in Owner.Header.Treeview.ComponentState) then
Owner.Header.Options := Owner.Header.Options + [hoShowImages]; Owner.Header.Options := Owner.Header.Options + [hoShowImages];
//lcl
if FCheckBox then
Owner.Header.Treeview.CheckImageListNeeded;
Changed(False); Changed(False);
end; end;
end; end;
@ -11939,6 +11952,7 @@ begin
inherited DoubleBuffered := False; inherited DoubleBuffered := False;
FCheckImageKind := ckSystemDefault; FCheckImageKind := ckSystemDefault;
FCheckImages := SystemCheckImages;
FImageChangeLink := TChangeLink.Create; FImageChangeLink := TChangeLink.Create;
FImageChangeLink.OnChange := ImageListChange; FImageChangeLink.OnChange := ImageListChange;
@ -12409,7 +12423,7 @@ begin
else else
StateImageOffset := 0; StateImageOffset := 0;
if WithCheck then if WithCheck then
CheckOffset := FCheckImages.Height + 2 CheckOffset := FCheckImages.Width + 2
else else
CheckOffset := 0; CheckOffset := 0;
AutoSpan := FHeader.UseColumns and (toAutoSpanColumns in FOptions.FAutoOptions); AutoSpan := FHeader.UseColumns and (toAutoSpanColumns in FOptions.FAutoOptions);
@ -12589,7 +12603,7 @@ begin
else else
StateImageOffset := 0; StateImageOffset := 0;
if WithCheck then if WithCheck then
CheckOffset := FCheckImages.Height + 2 CheckOffset := FCheckImages.Width + 2
else else
CheckOffset := 0; CheckOffset := 0;
AutoSpan := FHeader.UseColumns and (toAutoSpanColumns in FOptions.FAutoOptions); AutoSpan := FHeader.UseColumns and (toAutoSpanColumns in FOptions.FAutoOptions);
@ -14141,8 +14155,9 @@ begin
if FCheckImageKind <> Value then if FCheckImageKind <> Value then
begin begin
FCheckImageKind := Value; FCheckImageKind := Value;
if toCheckSupport in FOptions.FMiscOptions then FCheckImages := GetCheckImageListFor(Value);
UpdateCheckImageList; if not Assigned(FCheckImages) then
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;
@ -14317,18 +14332,25 @@ end;
//---------------------------------------------------------------------------------------------------------------------- //----------------------------------------------------------------------------------------------------------------------
procedure TBaseVirtualTree.SetCustomCheckImages(const Value: TBitmap); procedure TBaseVirtualTree.SetCustomCheckImages(const Value: TCustomImageList);
begin begin
if FCustomCheckImages <> Value then if FCustomCheckImages <> Value then
begin begin
if Assigned(FCustomCheckImages) then if Assigned(FCustomCheckImages) then
begin begin
FCustomCheckImages.UnRegisterChanges(FCustomCheckChangeLink);
FCustomCheckImages.RemoveFreeNotification(Self);
// Reset the internal check image list reference too, if necessary. // Reset the internal check image list reference too, if necessary.
if FCheckImages = FCustomCheckImages then if FCheckImages = FCustomCheckImages then
FCheckImages := nil; FCheckImages := nil;
end; end;
FCustomCheckImages := Value; FCustomCheckImages := Value;
if Assigned(FCustomCheckImages) then
begin
FCustomCheckImages.RegisterChanges(FCustomCheckChangeLink);
FCustomCheckImages.FreeNotification(Self);
end;
// Check if currently custom check images are active. // Check if currently custom check images are active.
if FCheckImageKind = ckCustom then if FCheckImageKind = ckCustom then
FCheckImages := Value; FCheckImages := Value;
@ -18269,8 +18291,6 @@ begin
RegisterDragDrop(Handle, VTVDragManager as IDropTarget); RegisterDragDrop(Handle, VTVDragManager as IDropTarget);
{$endif} {$endif}
if toCheckSupport in FOptions.FMiscOptions then
CheckImageListNeeded;
UpdateScrollBars(True); UpdateScrollBars(True);
UpdateHeaderRect; UpdateHeaderRect;
end; end;
@ -18455,7 +18475,7 @@ begin
// Check support is only available for the main column. // Check support is only available for the main column.
if MainColumnHit and (toCheckSupport in FOptions.FMiscOptions) and Assigned(FCheckImages) and if MainColumnHit and (toCheckSupport in FOptions.FMiscOptions) and Assigned(FCheckImages) and
(HitInfo.HitNode.CheckType <> ctNone) then (HitInfo.HitNode.CheckType <> ctNone) then
Inc(ImageOffset, FCheckImages.Height + 2); Inc(ImageOffset, FCheckImages.Width + 2);
if MainColumnHit and (Offset < ImageOffset) then if MainColumnHit and (Offset < ImageOffset) then
begin begin
@ -18592,7 +18612,7 @@ begin
// Check support is only available for the main column. // Check support is only available for the main column.
if MainColumnHit and (toCheckSupport in FOptions.FMiscOptions) and Assigned(FCheckImages) and if MainColumnHit and (toCheckSupport in FOptions.FMiscOptions) and Assigned(FCheckImages) and
(HitInfo.HitNode.CheckType <> ctNone) then (HitInfo.HitNode.CheckType <> ctNone) then
Dec(ImageOffset, FCheckImages.Height + 2); Dec(ImageOffset, FCheckImages.Width + 2);
if MainColumnHit and (Offset > ImageOffset) then if MainColumnHit and (Offset > ImageOffset) then
begin begin
@ -21386,10 +21406,6 @@ end;
class function TBaseVirtualTree.GetCheckImageListFor(Kind: TCheckImageKind): TCustomImageList; class function TBaseVirtualTree.GetCheckImageListFor(Kind: TCheckImageKind): TCustomImageList;
begin begin
Result := nil;
raise Exception.Create('GetCheckImageListFor not implemented');
{
case Kind of case Kind of
ckDarkCheck: ckDarkCheck:
Result := DarkCheckImages; Result := DarkCheckImages;
@ -21410,25 +21426,10 @@ begin
else else
Result := nil; Result := nil;
end; end;
}
end; end;
//---------------------------------------------------------------------------------------------------------------------- //----------------------------------------------------------------------------------------------------------------------
procedure TBaseVirtualTree.CheckImageListNeeded;
begin
if FCheckImages <> nil then
Exit;
if FCheckImageKind = ckCustom then
FCheckImages := FCustomCheckImages
else
begin
FCheckImages := TBitmap.Create;
FCheckImages.Transparent := True;
FCheckImages.LoadFromLazarusResource(CheckImagesStrings[FCheckImageKind]);
end;
end;
function TBaseVirtualTree.GetClientRect: TRect; function TBaseVirtualTree.GetClientRect: TRect;
begin begin
Result := inherited; Result := inherited;
@ -21543,7 +21544,7 @@ begin
Inc(NodeLeft, FImages.Width + 2); Inc(NodeLeft, FImages.Width + 2);
WithCheck := (toCheckSupport in FOptions.FMiscOptions) and Assigned(FCheckImages); WithCheck := (toCheckSupport in FOptions.FMiscOptions) and Assigned(FCheckImages);
if WithCheck then if WithCheck then
CheckOffset := FCheckImages.Height + 2 CheckOffset := FCheckImages.Width + 2
else else
CheckOffset := 0; CheckOffset := 0;
@ -23410,17 +23411,28 @@ begin
if not (csDestroying in ComponentState) then if not (csDestroying in ComponentState) then
Invalidate; Invalidate;
end end
else
if AComponent = FCustomCheckImages then
begin
CustomCheckImages := nil;
FCheckImageKind := ckSystemDefault;
if not (csDestroying in ComponentState) then
Invalidate;
end
else else
if AComponent = PopupMenu then if AComponent = PopupMenu then
PopupMenu := nil PopupMenu := nil
else else
// Check for components linked to the header. // Check for components linked to the header.
if Assigned(FHeader) then
begin
if AComponent = FHeader.FImages then if AComponent = FHeader.FImages then
FHeader.Images := nil FHeader.Images := nil
else else
if AComponent = FHeader.PopupMenu then if AComponent = FHeader.PopupMenu then
FHeader.PopupMenu := nil; FHeader.PopupMenu := nil;
end; end;
end;
inherited; inherited;
end; end;
@ -23645,6 +23657,7 @@ var
Details: TThemedElementDetails; Details: TThemedElementDetails;
{$endif} {$endif}
UseThemes: Boolean; UseThemes: Boolean;
DrawEffect: TGraphicsDrawEffect;
begin begin
{$ifdef DEBUG_VTV}Logger.EnterMethod([lcCheck],'PaintCheckImage');{$endif} {$ifdef DEBUG_VTV}Logger.EnterMethod([lcCheck],'PaintCheckImage');{$endif}
@ -23699,13 +23712,17 @@ begin
else else
with FCheckImages do with FCheckImages do
begin begin
{$ifdef USE_DELPHICOMPAT} if Selected and not Ghosted then
DirectMaskBlt(Canvas.Handle, XPos, YPos, Height, Height, Canvas.Handle, begin
Index * Height, 0, MaskHandle); if Focused or (toPopupMode in FOptions.FPaintOptions) then
{$else} DrawEffect := gdeHighlighted
StretchMaskBlt(Canvas.Handle, XPos, YPos, Height, Height, Canvas.Handle, else
Index * Height, 0, Height, Height, MaskHandle, Index * Height, 0, SRCCOPY); DrawEffect := gdeNormal;
{$endif} end
else
DrawEffect := gdeShadowed;
Draw(Canvas, XPos, YPos, Index, DrawEffect);
end; end;
end; end;
{$ifdef DEBUG_VTV}Logger.ExitMethod([lcCheck],'PaintCheckImage');{$endif} {$ifdef DEBUG_VTV}Logger.ExitMethod([lcCheck],'PaintCheckImage');{$endif}
@ -24882,16 +24899,6 @@ end;
//---------------------------------------------------------------------------------------------------------------------- //----------------------------------------------------------------------------------------------------------------------
procedure TBaseVirtualTree.UpdateCheckImageList;
begin
if FCheckImages <> FCustomCheckImages then
FCheckImages.Free;
FCheckImages := nil;
CheckImageListNeeded;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TBaseVirtualTree.UpdateColumnCheckState(Col: TVirtualTreeColumn); procedure TBaseVirtualTree.UpdateColumnCheckState(Col: TVirtualTreeColumn);
begin begin
@ -26616,7 +26623,7 @@ begin
if toShowRoot in FOptions.FPaintOptions then if toShowRoot in FOptions.FPaintOptions then
Inc(Offset, FIndent); Inc(Offset, FIndent);
if (toCheckSupport in FOptions.FMiscOptions) and Assigned(FCheckImages) and (Node.CheckType <> ctNone) then if (toCheckSupport in FOptions.FMiscOptions) and Assigned(FCheckImages) and (Node.CheckType <> ctNone) then
Inc(Offset, FCheckImages.Height + 2); Inc(Offset, FCheckImages.Width + 2);
end; end;
// Consider associated images. // Consider associated images.
if Assigned(FStateImages) and HasImage(Node, ikState, Column) then if Assigned(FStateImages) and HasImage(Node, ikState, Column) then
@ -26740,7 +26747,7 @@ begin
if Assigned(Result.FirstChild) then if Assigned(Result.FirstChild) then
begin begin
while Assigned(Result.FirstChild) do while Assigned(Result.FirstChild) do
begin begin
Result := Result.FirstChild; Result := Result.FirstChild;
if not (vsInitialized in Result.States) then if not (vsInitialized in Result.States) then
InitNode(Result); InitNode(Result);
@ -26886,7 +26893,7 @@ begin
// Child nodes are the first choice if possible. // Child nodes are the first choice if possible.
if Assigned(Result.FirstChild) then if Assigned(Result.FirstChild) then
begin begin
while Assigned(Result.FirstChild) do while Assigned(Result.FirstChild) do
Result := Result.FirstChild; Result := Result.FirstChild;
end end
@ -30156,7 +30163,7 @@ begin
ImageInfo[iiCheck].Index := GetCheckImage(Node); ImageInfo[iiCheck].Index := GetCheckImage(Node);
if ImageInfo[iiCheck].Index > -1 then if ImageInfo[iiCheck].Index > -1 then
begin begin
AdjustImageBorder(FCheckImages.Height, FCheckImages.Height, BidiMode, VAlign, ContentRect, ImageInfo[iiCheck]); AdjustImageBorder(FCheckImages, BidiMode, VAlign, ContentRect, ImageInfo[iiCheck]);
ImageInfo[iiCheck].Ghosted := False; ImageInfo[iiCheck].Ghosted := False;
end; end;
end end