jvgif.pas

East make Tray Icon in delphi

begin
  FImage.FImageData := TMemoryStream.Create;
  try
    ReadImageStream(Stream, FImage.FImageData, ImageDesc, FInterlaced,
      FLocalColors, FCorrupted, FImage.FBitsPerPixel, FImage.FColorMap);
    if FCorrupted and not GIFLoadCorrupted then
      GifError(SReadError);
    FImage.FImageData.Position := 0;
    with ImageDesc do
    begin
      if ImageHeight = 0 then
        ImageHeight := FOwner.FScreenHeight;
      if ImageWidth = 0 then
        ImageWidth := FOwner.FScreenWidth;
      FTopLeft := Point(ImageLeftPos, ImageTopPos);
      FImage.FSize := Point(ImageWidth, ImageHeight);
      FImage.FPackedFields := PackedFields;
    end;
    if not FLocalColors then
      FImage.FColorMap := FOwner.FImage.FColorMap;
    FAnimateInterval := 0;
    if FExtensions <> nil then
    begin
      for I := 0 to FExtensions.Count - 1 do
        with TExtension(FExtensions[I]) do
          if FExtType = etGraphic then
          begin
            if (FExtRec.GCE.PackedFields and GCE_TRANSPARENT) <> 0 then
            begin
              TransIndex := FExtRec.GCE.TransparentColorIndex;
              if FImage.FColorMap.Count > TransIndex then
              begin
                // Mantis 2135: Ensure that the transparent color does not appear
                // twice in the palette or the second color index would end up
                // being transparent as well
                Offset := -1;
                while ColorItemTwiceInColorMap(TransIndex, FImage.FColorMap) do
                begin
                  if FImage.FColorMap.Colors[TransIndex].Blue = 0 then
                    Offset := 1
                  else
                  if FImage.FColorMap.Colors[TransIndex].Blue = 255 then
                    Offset := -1;
                  Inc(FImage.FColorMap.Colors[TransIndex].Blue, Offset);
                end;

                FTransparentColor := ItemToRGB(FImage.FColorMap.Colors[TransIndex]);
              end;
            end
            else
              FTransparentColor := clNone;
            FAnimateInterval := Max(FExtRec.GCE.DelayTime * 10, FAnimateInterval);
            FDisposal := TDisposalMethod((FExtRec.GCE.PackedFields and GCE_DISPOSAL_METHOD) shr 2);
          end;
    end;
  except
    FImage.FImageData.Free;
    FImage.FImageData := nil;
    raise;
  end;
end;

procedure TJvGIFFrame.Draw(ACanvas: TCanvas; const ARect: TRect;
  Transparent: Boolean);
begin
  if (FTransparentColor <> clNone) and Transparent then
  begin
    with ARect do
      StretchBitmapRectTransparent(ACanvas, Left, Top, Right - Left,
        Bottom - Top, Bounds(0, 0, Bitmap.Width, Bitmap.Height), Bitmap,
        FTransparentColor);
  end
  else
    ACanvas.StretchDraw(ARect, Bitmap);
end;

//=== { TJvGIFImage } ========================================================

constructor TJvGIFImage.Create;
begin
  inherited Create;
  NewImage;
  inherited SetTransparent(True);
end;

destructor TJvGIFImage.Destroy;
begin
  OnChange := nil;
  FImage.Release;
  ClearItems;
  FItems.Free;
  inherited Destroy;
end;

procedure TJvGIFImage.Clear;
begin
  Assign(nil);
end;

procedure TJvGIFImage.ClearItems;
begin
  if FItems <> nil then
    while FItems.Count > 0 do
    begin
      TObject(FItems[0]).Free;
      FItems.Delete(0);
    end;
end;

procedure TJvGIFImage.Assign(Source: TPersistent);
var
  I: Integer;
  AFrame: TJvGIFFrame;
begin
  if Source = nil then
  begin
    NewImage;
    Changed(Self);
  end
  else
  if (Source is TJvGIFImage) and (Source <> Self) then
  begin
    FImage.Release;
    FImage := TJvGIFImage(Source).FImage;
    FImage.Reference;
    FVersion := TJvGIFImage(Source).FVersion;
    FBackgroundColor := TJvGIFImage(Source).FBackgroundColor;
    FRepeatCount := TJvGIFImage(Source).FRepeatCount;
    FLooping := TJvGIFImage(Source).FLooping;
    FCorrupted := TJvGIFImage(Source).FCorrupted;
    if FItems = nil then
      FItems := TList.Create
    else
      ClearItems;
    with TJvGIFImage(Source) do
    begin
      for I := 0 to FItems.Count - 1 do
      begin
        AFrame := TJvGIFFrame.Create(Self);
        try
          AFrame.FImage.FBitsPerPixel :=
            TJvGIFFrame(FItems[I]).FImage.FBitsPerPixel;
          AFrame.Assign(TJvGIFFrame(FItems[I]));
          AFrame.FLocalColors := TJvGIFFrame(FItems[I]).FLocalColors;
          Self.FItems.Add(AFrame);
        except
          AFrame.Free;
          raise;
        end;
      end;
      Self.FScreenWidth := FScreenWidth;
      Self.FScreenHeight := FScreenHeight;
    end;
    FFrameIndex := TJvGIFImage(Source).FFrameIndex;
    Changed(Self);
  end
  else
  if Source is TJvGIFFrame then
  begin
    NewImage;
    with TJvGIFFrame(Source).FOwner.FImage do
    begin
      FImage.FAspectRatio := FAspectRatio;
      FImage.FBitsPerPixel := FBitsPerPixel;
      FImage.FColorResBits := FColorResBits;
      Move(FColorMap, FImage.FColorMap, SizeOf(FColorMap));
    end;
    FFrameIndex := FItems.Add(TJvGIFFrame.Create(Self));
    TJvGIFFrame(FItems[FFrameIndex]).Assign(Source);
    if FVersion = gvUnknown then
      FVersion := gv87a;
    Changed(Self);
  end
  else
  if Source is TBitmap then
  begin
    NewImage;
    AddFrame(TBitmap(Source));
    Changed(Self);
  end
  else
  if Source is TJvAni then
  begin
    NewImage;
    FBackgroundColor := clWindow;
    with TJvAni(Source) do
    begin
      for I := 0 to FrameCount - 1 do
      begin
        AddFrame(TIcon(Icons[I]));
        Self.Frames[I].FAnimateInterval :=
          Longint(Frames[I].Rate * 100) div 6;
        if Frames[I].Rate = 0 then
          Self.Frames[I].FAnimateInterval := 100;
      end;
    end;
    Changed(Self);
  end
  else
    inherited Assign(Source);
end;

procedure TJvGIFImage.AssignTo(Dest: TPersistent);
begin
  if Dest is TJvGIFImage then
    Dest.Assign(Self)
  else
  if Dest is TGraphic then
  begin
    if Empty then
      Dest.Assign(nil)
    else
    if FFrameIndex >= 0 then
      TJvGIFFrame(FItems[FFrameIndex]).AssignTo(Dest)
    else
      Dest.Assign(Bitmap);
  end
  else
    inherited AssignTo(Dest);
end;

procedure TJvGIFImage.Draw(ACanvas: TCanvas; const ARect: TRect);
begin
  if FFrameIndex >= 0 then
    TJvGIFFrame(FItems[FFrameIndex]).Draw(ACanvas, ARect, Self.Transparent);
end;

function TJvGIFImage.GetBackgroundColor: TColor;
begin
  Result := FBackgroundColor;
end;

procedure TJvGIFImage.SetBackgroundColor(Value: TColor);
begin
  if Value <> FBackgroundColor then
  begin
    FBackgroundColor := Value;
    Changed(Self);
  end;
end;

procedure TJvGIFImage.SetLooping(Value: Boolean);
begin
  if Value <> FLooping then
  begin
    FLooping := Value;
    Changed(Self);
  end;
end;

procedure TJvGIFImage.SetRepeatCount(Value: Word);
begin
  if Min(Value, MAX_LOOP_COUNT) <> FRepeatCount then
  begin
    FRepeatCount := Min(Value, MAX_LOOP_COUNT);
    Changed(Self);
  end;
end;

function TJvGIFImage.GetPixelFormat: TPixelFormat;
var
  I: Integer;
begin
  Result := pfDevice;
  if not Empty then
  begin
    Result := ColorsToPixelFormat(FImage.FColorMap.Count);
    for I := 0 to FItems.Count - 1 do
    begin
      if (Frames[I].FImage.FImageData = nil) or
        (Frames[I].FImage.FImageData.Size = 0) then
      begin
        if Assigned(Frames[I].FBitmap) then
          Result := TPixelFormat(Max(Ord(Result),
            Ord(GetBitmapPixelFormat(Frames[I].FBitmap))))
        else
          Result := TPixelFormat(Max(Ord(Result), Ord(pfDevice)));
      end
      else
      if Frames[I].FLocalColors then
        Result := TPixelFormat(Max(Ord(Result),
          Ord(ColorsToPixelFormat(Frames[I].FImage.FColorMap.Count))));
    end;
  end;
end;

function TJvGIFImage.GetCorrupted: Boolean;
var
  I: Integer;
begin
  Result := FCorrupted;
  if not Result then
    for I := 0 to FItems.Count - 1 do
      if Frames[I].Corrupted then
      begin
        Result := True;
        Exit;
      end;
end;

function TJvGIFImage.GetTransparentColor: TColor;
begin
  if (FItems.Count > 0) and (FFrameIndex >= 0) then
    Result := TJvGIFFrame(FItems[FFrameIndex]).FTransparentColor
  else
    Result := clNone;
end;

function TJvGIFImage.GetCount: Integer;
begin
  Result := FItems.Count;
end;

function TJvGIFImage.GetFrame(Index: Integer): TJvGIFFrame;
begin
  Result := TJvGIFFrame(FItems[Index]);
end;

procedure TJvGIFImage.SetFrameIndex(Value: Integer);
begin
  Value := Min(FItems.Count - 1, Max(-1, Value));
  if FFrameIndex <> Value then
  begin
    FFrameIndex := Value;
    PaletteModified := True;
    Changed(Self);
  end;
end;

function TJvGIFImage.Equals(Graphic: TGraphic): Boolean;
begin
  Result := (Graphic is TJvGIFImage) and
    (FImage = TJvGIFImage(Graphic).FImage);
end;

function TJvGIFImage.GetBitmap: TBitmap;
var
  Bmp: TBitmap;
begin
  if FItems.Count > 0 then
  begin
    if (FFrameIndex >= 0) and (FFrameIndex < FItems.Count) then
      Result := TJvGIFFrame(FItems[FFrameIndex]).Bitmap
    else
      Result := TJvGIFFrame(FItems[0]).Bitmap
  end
  else
  begin
    FFrameIndex := 0;
    Bmp := TBitmap.Create;
    try
      Bmp.Handle := 0;
      Assign(Bmp);
      Result := TJvGIFFrame(FItems[FFrameIndex]).Bitmap;
    finally
      Bmp.Free;
    end;
  end;
end;

function TJvGIFImage.GetGlobalColorCount: Integer;
begin
  Result := FImage.FColorMap.Count;
end;

function TJvGIFImage.GetEmpty: Boolean;
var
  I: Integer;
begin
  I := Max(FFrameIndex, 0);
  Result := (FItems.Count = 0) or
    ((TJvGIFFrame(FItems[I]).FBitmap = nil) and
    ((TJvGIFFrame(FItems[I]).FImage.FImageData = nil) or
    (TJvGIFFrame(FItems[I]).FImage.FImageData.Size = 0)));
end;

function TJvGIFImage.GetPalette: HPALETTE;
begin
  if FItems.Count > 0 then
    Result := Bitmap.Palette
  else
    Result := 0;
end;

function TJvGIFImage.GetTransparent: Boolean;
var
  I: Integer;
begin
  if inherited GetTransparent then
    for I := 0 to FItems.Count - 1 do
      if Frames[I].TransparentColor <> clNone then
      begin
        Result := True;
        Exit;
      end;
  Result := False;
end;

function TJvGIFImage.GetHeight: Integer;
begin
  if not Empty and (FFrameIndex >= 0) and (FFrameIndex < Count) then
    Result := TJvGIFFrame(FItems[FFrameIndex]).Bitmap.Height
  else
    Result := 0;
end;

function TJvGIFImage.GetWidth: Integer;
begin
  if not Empty and (FFrameIndex >= 0) and (FFrameIndex < Count) then
    Result := TJvGIFFrame(FItems[FFrameIndex]).Bitmap.Width
  else
    Result := 0;
end;

function TJvGIFImage.GetScreenWidth: Integer;
begin
  if Empty then
    Result := 0
  else
    Result := FScreenWidth;
end;

function TJvGIFImage.GetScreenHeight: Integer;
begin
  if Empty then
    Result := 0
  else
    Result := FScreenHeight;
end;

procedure TJvGIFImage.LoadFromClipboardFormat(AFormat: Word; AData: THandle;
  APalette: HPALETTE);
var
  Bmp: TBitmap;
  Stream: TMemoryStream;
  Size: Longint;
  Buffer: Pointer;
  Data: THandle;
begin
  { !! check for gif clipboard Data, mime type image/gif }
  Data := GetClipboardData(CF_GIF);
  if Data <> 0 then
  begin
    Buffer := GlobalLock(Data);
    try
      Stream := TMemoryStream.Create;
      try
        Stream.Write(Buffer^, GlobalSize(Data));
        Stream.Position := 0;
        Stream.Read(Size, SizeOf(Size));
        ReadStream(Size, Stream, False);
        if Count > 0 then
        begin
          FFrameIndex := 0;
          AData := GetClipboardData(CF_BITMAP);
          if AData <> 0 then
          b