jvimagelist.pas

East make Tray Icon in delphi

  finally
    Bitmap.Free;
  end;
  UpdateImageListItem(AImageList, Pred(AImageList.Count));
end;

procedure TJvImageListItem.BitmapChanged(Sender: TObject);
begin
  UpdateImageList;
end;

function TJvImageListItem.GetDisplayName: string;
begin
  case FKind of
    ikResourceBitmap:
      Result := Format(RsResource, [FResourceName]);
    ikMappedResourceBitmap:
      Result := Format(RsMappedResource, [FResourceName]);
    ikInlineBitmap:
      Result := Format(RsBitmap,
        [GetEnumName(TypeInfo(TPixelFormat), Ord(FBitmap.PixelFormat))]);
  else
    inherited GetDisplayName;
  end;
end;

function TJvImageListItem.GetImageList: TImageList;
begin
  Result := TImageList(TJvImageListItems(Collection).Owner);
end;

procedure TJvImageListItem.SetBitmap(ABitmap: TBitmap);
begin
  if FKind = ikInlineBitmap then
  begin
    FBitmap.Assign(ABitmap);
    UpdateImageList;
  end;
end;

procedure TJvImageListItem.SetIndex(Value: Integer);
var
  ImageList: TImageList;
  OldIndex: Integer;
begin
  OldIndex := Index;
  inherited SetIndex(Value);
  ImageList := GetImageList;
  if Assigned(ImageList) and (OldIndex >= 0) and (ImageList.Count > OldIndex) and
    (Index >= 0) and (ImageList.Count > Index) then
    ImageList.Move(OldIndex, Index);
end;

procedure TJvImageListItem.SetKind(AKind: TJvImageListItemKind);
begin
  // (usc) remove when MappedResourceBitmap support is finished
  if AKind = ikMappedResourceBitmap then
    raise EJvImageListError.CreateResFmt(@RsENotSupportedItemKind, ['ikMappedResourceBitmap']);

  if FKind <> AKind then
  begin
    FKind := AKind;
    if FKind in [ikResourceBitmap, ikMappedResourceBitmap] then
      FBitmap.Assign(nil)
    else
    if FKind = ikInlineBitmap then
      FResourceName := '';
  end;
end;

procedure TJvImageListItem.SetResourceName(const AResourceName: string);
begin
  if (FKind in [ikResourceBitmap, ikMappedResourceBitmap]) and
    (FResourceName <> AResourceName) then
  begin
    FResourceName := AResourceName;
    UpdateImageList;
  end;
end;

procedure TJvImageListItem.SetTransparentColor(AColor: TColor);
begin
  if FTransparentColor <> AColor then
  begin
    FTransparentColor := AColor;
    UpdateImageList;
  end;
end;

procedure TJvImageListItem.UpdateImageList;
begin
  UpdateImageListItem(GetImageList, Index);
end;

procedure TJvImageListItem.UpdateImageListItem(AImageList: TImageList; AIndex: Integer);
var
  Bitmap: TBitmap;
begin
  if (FKind in [ikResourceBitmap, ikMappedResourceBitmap]) and (FResourceName <> '') then
  begin
    Bitmap := TBitmap.Create;
    try
      try
        if FKind = ikResourceBitmap then
          Bitmap.LoadFromResourceName(HInstance, FResourceName);
{// (usc) include when MappedResourceBitmap support is finished
        else
        if FKind = ikMappedResourceBitmap then
          GetMappedResourceBitmap(FResourceName, Bitmap);
}
        AImageList.ReplaceMasked(AIndex, Bitmap, FTransparentColor);
      except
      end;
    finally
      Bitmap.Free;
    end;
  end
  else
  if (FKind = ikInlineBitmap) and Assigned(FBitmap) and
    (FBitmap.Width = AImageList.Width) and (FBitmap.Height = AImageList.Height) then
    AImageList.ReplaceMasked(AIndex, FBitmap, FTransparentColor);
end;

//=== { TJvImageListItems } ==================================================

constructor TJvImageListItems.Create(AOwner: TComponent);
begin
  inherited Create(AOwner, TJvImageListItem);
end;

function TJvImageListItems.Add: TJvImageListItem;
begin
  Result := TJvImageListItem(inherited Add);
end;

function TJvImageListItems.GetItem(AIndex: Integer): TJvImageListItem;
begin
  Result := TJvImageListItem(inherited GetItem(AIndex));
end;

{$IFDEF COMPILER5}
function TJvImageListItems.Owner: TPersistent;
begin
  Result := GetOwner;
end;
{$ENDIF COMPILER5}

procedure TJvImageListItems.SetItem(AIndex: Integer; Value: TJvImageListItem);
begin
  inherited SetItem(AIndex, Value);
end;

procedure TJvImageListItems.Update(Item: TCollectionItem);
begin
  if Assigned(Item) then
    TJvImageListItem(Item).UpdateImageList;
end;

{ Loads the bitmaps for the ImageList from the bitmap Bitmap.
  The return value is the number of added bitmaps. }

function LoadImageListFromBitmap(ImgList: TCustomImageList; const Bitmap: TBitmap;
  MaskColor: TColor = clFuchsia; AutoMaskColor: Boolean = False): Integer; overload;
var
  Bmp: TBitmap;
  Width, Height: Integer;
  i: Integer;
  TempImageList: TCustomImageList;
begin
  Result := 0;
  if (ImgList = nil) or (ImgList.Width = 0) or (ImgList.Height = 0) or
    (Bitmap = nil) then
    Exit;

  Width := ImgList.Width;
  Height := ImgList.Height;
  Result := Bitmap.Width div Width; // count
  if (Result = 0) and (Bitmap.Width > 0) then
    Result := 1;
  TempImageList := TCustomImageList.CreateSize(Width, Height);
  Bmp := TBitmap.Create;
  try
    Bmp.PixelFormat := Bitmap.PixelFormat;
    {$IFDEF VCL}
    TempImageList.Handle := CreateImageListHandle(Width, Height,
      Bitmap.PixelFormat, ImgList.Masked, Result);
    {$ENDIF VCL}

   // split Bitmap and add all bitmaps to ImgList
    for i := 0 to Result - 1 do
    begin
      if AutoMaskColor then
        MaskColor := Bitmap.Canvas.Pixels[i * Width, Height - 1];

      Bmp.Canvas.Brush.Color := MaskColor;
      Bmp.Width := 0; // clear bitmap
      Bmp.Width := Width;
      Bmp.Height := Height;
      {$IFDEF VCL}
      BitBlt(Bmp.Canvas.Handle, 0, 0, Width, Height,
        Bitmap.Canvas.Handle, i * Width, 0, SRCCOPY);
      {$ENDIF VCL}
      {$IFDEF VisualCLX}
      Bmp.Canvas.CopyRect(Rect(0, 0, Width, Height),
        Bitmap.Canvas, Rect(i * Width, 0, (i + 1) * Width, Height));
      {$ENDIF VisualCLX}

      TempImageList.AddMasked(Bmp, MaskColor);
    end;
    ImgList.AddImages(TempImageList);
  finally
    Bmp.Free;
    TempImageList.Free;
  end;
end;

function LoadImageListFromBitmap(ImgList: TCustomImageList; const Bitmap: TBitmap;
  MaskBitmap: TBitmap): Integer; overload;
var
  Bmp, MaskBmp: TBitmap;
  Width, Height: Integer;
  i: Integer;
  TempImageList: TCustomImageList;
begin
  Result := 0;
  if (ImgList = nil) or (ImgList.Width = 0) or (ImgList.Height = 0) or
    (Bitmap = nil) or (MaskBitmap = nil) then
    Exit;

  Width := ImgList.Width;
  Height := ImgList.Height;
  Result := Bitmap.Width div Width; // calc count
  if (Result = 0) and (Bitmap.Width > 0) then
    Result := 1;
  TempImageList := TCustomImageList.CreateSize(Width, Height);
  Bmp := TBitmap.Create;
  MaskBmp := TBitmap.Create;
  try
    Bmp.PixelFormat := Bitmap.PixelFormat;
    MaskBmp.PixelFormat := MaskBitmap.PixelFormat;

    {$IFDEF VCL}
    TempImageList.Handle := CreateImageListHandle(Width, Height,
      Bitmap.PixelFormat, ImgList.Masked, Result);
    {$ENDIF VCL}

   // split Bitmap and add all bitmaps to ImgList
    for i := 0 to Result - 1 do
    begin
      Bmp.Width := 0; // clear bitmap
      Bmp.Width := Width;
      Bmp.Height := Height;
      {$IFDEF VCL}
      BitBlt(Bmp.Canvas.Handle, 0, 0, Width, Height,
        Bitmap.Canvas.Handle, i * Width, 0, SRCCOPY);
      {$ENDIF VCL}
      {$IFDEF VisualCLX}
      Bmp.Canvas.CopyRect(Rect(0, 0, Width, Height),
        Bitmap.Canvas, Rect(i * Width, 0, (i + 1) * Width, Height));
      {$ENDIF VisualCLX}

      MaskBmp.Width := 0; // clear bitmap
      MaskBmp.Width := Width;
      MaskBmp.Height := Height;
      {$IFDEF VCL}
      BitBlt(MaskBmp.Canvas.Handle, 0, 0, Width, Height,
        MaskBitmap.Canvas.Handle, i * Width, 0, SRCCOPY);
      {$ENDIF VCL}
      {$IFDEF VisualCLX}
      MaskBmp.Canvas.CopyRect(Rect(0, 0, Width, Height),
        MaskBitmap.Canvas, Rect(i * Width, 0, (i + 1) * Width, Height));
      {$ENDIF VisualCLX}

      TempImageList.Add(Bmp, MaskBmp);
    end;
    ImgList.AddImages(TempImageList);
  finally
    Bmp.Free;
    TempImageList.Free;
  end;
end;

//=== { TJvImageList } =======================================================

destructor TJvImageList.Destroy;
begin
  FItems.Free;
  FPicture.Free;
  FResourceIds.Free;
  inherited Destroy;
end;

procedure TJvImageList.InitializeImageList;
begin
  FModified := False;

  {$IFDEF VCL}
  if not (csDesigning in ComponentState) and not HandleNeededHookInstalled then
    InstallHandleNeededHook;
  {$ENDIF VCL}

  FUpdateLock := 0;

  FMode := imPicture;
  FTransparentMode := tmColor;
  FTransparentColor := clFuchsia;
  {$IFDEF VCL}
  FPixelFormat := pfDevice;
  {$ENDIF VCL}

  FFileName := '';
  FPicture := TPicture.Create;
  FPicture.OnChange := DataChanged;

  FResourceIds := TStringList.Create;
  TStringList(FResourceIds).OnChange := DataChanged;

  FItems := TJvImageListItems.Create(Self);
end;

procedure TJvImageList.Assign(Source: TPersistent);
var
  ImageList: TJvImageList;
begin
  ImageList := TJvImageList(Source);

  BeginUpdate;
  try
    if (Source <> nil) and (Source is TJvImageList) then
    begin
      Clear;
      FMode := imClassic; // lock update

      if (ImageList.Picture.Graphic <> nil) and not ImageList.Picture.Graphic.Empty then
        Picture.Assign(ImageList.Picture)
      else
        Picture.Assign(nil);
      ResourceIds.Assign(ImageList.ResourceIds);
      // Do not assign FileName here.
      TransparentMode := ImageList.TransparentMode;
      TransparentColor := ImageList.TransparentColor;
      {$IFDEF VCL}
      PixelFormat := ImageList.FPixelFormat;
      {$ENDIF VCL}
    end;

    inherited Assign(Source);

    if (Source <> nil) and (Source is TJvImageList) then
      Mode := ImageList.Mode; // enable update
  finally
    EndUpdate;
  end;
end;

procedure TJvImageList.BeginUpdate;
begin
  if FUpdateLock = 0 then
    FModified := False;
  Inc(FUpdateLock);
end;

procedure TJvImageList.EndUpdate;
begin
  Dec(FUpdateLock);
  if (FUpdateLock = 0) and FModified then
    Change;
end;

procedure TJvImageList.Change;
begin
  FModified := True;
  if FUpdateLock = 0 then
    inherited Change;
end;

procedure TJvImageList.DataChanged(Sender: TObject);
begin
  UpdateImageList;
end;

procedure TJvImageList.SetPicture(Value: TPicture);
begin
  if (Value <> FPicture) then
    FPicture.Assign(Value);
end;

procedure TJvImageList.SetTransparentMode(Value: TJvImageListTransparentMode);
begin
  if Value <> FTransparentMode then
  begin
    FTransparentMode := Value;
    UpdateImageList;
  end;
end;

procedure TJvImageList.SetTransparentColor(Value: TColor);
begin
  if Value <> FTransparentColor then
  begin
    FTransparentColor := Value;
    if FTransparentMode = tmColor then
      UpdateImageList;
  end;
end;

procedure TJvImageList.SetFileName(const Value: TFileName);
begin
  if not SameFileName(Value, FFileName) then
  begin
    FFileName := Value;
    DoLoadFromFile;
  end;
end;

procedure TJvImageList.DoLoadFromFile;
begin
  if (not (csDesigning in ComponentState)) and (csLoading in ComponentState) then
    Exit;

  if (FFileName <> '') and FileExists(FFileName)
    {$IFDEF UNIX} and not DirectoryExists(FFileName) {$ENDIF} then
  try
    FPicture.LoadFromFile(FFileName);
  except
    // ignore exception
  end;
end;