jvqgif.pas

East make Tray Icon in delphi

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.LoadFromStream(Stream: TStream);
begin
  ReadStream(Stream.Size - Stream.Position, Stream, True);
end;

procedure TJvGIFImage.LoadFromResourceName(Instance: THandle; const ResName: string;
  ResType: PChar);
var
  Stream: TStream;
begin
  Stream := TResourceStream.Create(Instance, ResName, ResType);
  try
    ReadStream(Stream.Size - Stream.Position, Stream, True);
  finally
    Stream.Free;
  end;
end;

procedure TJvGIFImage.LoadFromResourceID(Instance: THandle; ResID: Integer;
  ResType: PChar);
var
  Stream: TStream;
begin
  Stream := TResourceStream.CreateFromID(Instance, ResID, ResType);
  try
    ReadStream(Stream.Size - Stream.Position, Stream, True);
  finally
    Stream.Free;
  end;
end;

procedure TJvGIFImage.UpdateScreenSize;
var
  I: Integer;
begin
  FScreenWidth := 0;
  FScreenHeight := 0;
  for I := 0 to FItems.Count - 1 do
    if Frames[I] <> nil then
    begin
      FScreenWidth := Max(FScreenWidth, Frames[I].Width +
        Frames[I].FTopLeft.X);
      FScreenHeight := Max(FScreenHeight, Frames[I].Height +
        Frames[I].FTopLeft.Y);
    end;
end;

function TJvGIFImage.AddFrame(Value: TGraphic): Integer;
begin
  FFrameIndex := FItems.Add(TJvGIFFrame.Create(Self));
  TJvGIFFrame(FItems[FFrameIndex]).Assign(Value);
  if FVersion = gvUnknown then
    FVersion := gv87a;
  if FItems.Count > 1 then
    FVersion := gv89a;
  Result := FFrameIndex;
end;

procedure TJvGIFImage.DeleteFrame(Index: Integer);
begin
  Frames[Index].Free;
  FItems.Delete(Index);
  UpdateScreenSize;
  if FFrameIndex >= FItems.Count then
    Dec(FFrameIndex);
  Changed(Self);
end;

procedure TJvGIFImage.MoveFrame(CurIndex, NewIndex: Integer);
begin
  FItems.Move(CurIndex, NewIndex);
  FFrameIndex := NewIndex;
  Changed(Self);
end;

procedure TJvGIFImage.NewImage;
begin
  if FImage <> nil then
    FImage.Release;
  FImage := TGIFData.Create;
  FImage.Reference;
  if FItems = nil then
    FItems := TList.Create;
  ClearItems;
  FCorrupted := False;
  FFrameIndex := -1;
  FBackgroundColor := clNone;
  FRepeatCount := 1;
  F