gifctrl.pas

企业端数据申报系统：单位管理模块 单位查询. 业务申报模块 在线数据下载 在线数据上传 在线业务申核 申报业务查询 磁盘数据导出 磁盘数据导入 在线业务模块 在线业务

      end;
{$ENDIF}
      if FImage.Palette <> 0 then
        SelectPalette(Canvas.Handle, SavePal, False);
    end;
    FCache := Result;
    FCacheIndex := Index;
    FTransColor := TransColor;
{$IFDEF RX_D3}
    Result.Canvas.Unlock;
{$ENDIF}
  except
{$IFDEF RX_D3}
    Result.Canvas.Unlock;
{$ENDIF}
    if not UseCache then Result.Free;
    raise;
  end;
end;

function TRxGIFAnimator.GetPalette: HPALETTE;
begin
  Result := 0;
  if not FImage.Empty then Result := FImage.Palette;
end;

procedure TRxGIFAnimator.ImageChanged(Sender: TObject);
begin
  Lock;
  try
    FCacheIndex := -1;
    FCache.Free;
    FCache := nil;
    FTransColor := clNone;
    FFrameIndex := FImage.FrameIndex;
    if (FFrameIndex >= 0) and (FImage.Count > 0) then
      FTimer.Interval := GetDelayTime(FFrameIndex);
  finally
    Unlock;
  end;
  PictureChanged;
  Change;
end;

procedure TRxGIFAnimator.SetImage(Value: TGIFImage);
begin
  Lock;
  try
    FImage.Assign(Value);
  finally
    Unlock;
  end;
end;

procedure TRxGIFAnimator.SetCenter(Value: Boolean);
begin
  if Value <> FCenter then begin
    Lock;
    try
      FCenter := Value;
    finally
      Unlock;
    end;
    PictureChanged;
    if Animate then Repaint;
  end;
end;

procedure TRxGIFAnimator.SetStretch(Value: Boolean);
begin
  if Value <> FStretch then begin
    Lock;
    try
      FStretch := Value;
    finally
      Unlock;
    end;
    PictureChanged;
    if Animate then Repaint;
  end;
end;

procedure TRxGIFAnimator.SetTransparent(Value: Boolean);
begin
  if Value <> FTransparent then begin
    Lock;
    try
      FTransparent := Value;
    finally
      Unlock;
    end;
    PictureChanged;
    if Animate then Repaint;
  end;
end;

procedure TRxGIFAnimator.SetFrameIndex(Value: Integer);
begin
  if Value <> FFrameIndex then begin
    if (Value < FImage.Count) and (Value >= 0) then begin
      Lock;
      try
        FFrameIndex := Value;
        if (FFrameIndex >= 0) and (FImage.Count > 0) then
          FTimer.Interval := GetDelayTime(FFrameIndex);
      finally
        Unlock;
      end;
      FrameChanged;
      PictureChanged;
    end;
  end;
end;

procedure TRxGIFAnimator.DoPaintImage;
var
  Frame: TBitmap;
  Dest: TRect;
  TransColor: TColor;
begin
  { copy image from parent and back-level controls }
  if FImage.Transparent or FImage.Empty then
    CopyParentImage(Self, Canvas);
  if (not FImage.Empty) and (FImage.ScreenWidth > 0) and
    (FImage.ScreenHeight> 0) then
  begin
    TransColor := clNone;
    Frame := GetFrameBitmap(FrameIndex, TransColor);
{$IFDEF RX_D3}
    Frame.Canvas.Lock;
    try
{$ENDIF}
      if Stretch then Dest := ClientRect
      else if Center then
        Dest := Bounds((ClientWidth - Frame.Width) div 2,
          (ClientHeight - Frame.Height) div 2, Frame.Width, Frame.Height)
      else
        Dest := Rect(0, 0, Frame.Width, Frame.Height);
      if (TransColor = clNone) or not FTransparent then
        Canvas.StretchDraw(Dest, Frame)
      else begin
        StretchBitmapRectTransparent(Canvas, Dest.Left, Dest.Top,
          WidthOf(Dest), HeightOf(Dest), Bounds(0, 0, Frame.Width,
          Frame.Height), Frame, TransColor);
      end;
{$IFDEF RX_D3}
    finally
      Frame.Canvas.Unlock;
    end;
{$ENDIF}
  end;
end;

procedure TRxGIFAnimator.Paint;
begin
  PaintImage;
  if FImage.Transparent or FImage.Empty then
    PaintDesignRect;
end;

procedure TRxGIFAnimator.TimerDeactivate;
var
  F: TCustomForm;
begin
  SetAnimate(False);
  if (csDesigning in ComponentState) then begin
    F := GetParentForm(Self);
    if (F <> nil) and (F.Designer <> nil) then
      F.Designer.Modified;
  end;
end;

procedure TRxGIFAnimator.TimerExpired(Sender: TObject);
begin
{$IFDEF RX_D3}
  if csPaintCopy in ControlState then Exit;
{$ENDIF}
  if Visible and (FImage.Count > 1) and (Parent <> nil) and
    Parent.HandleAllocated then
  begin
    Lock;
    try
      if FFrameIndex < FImage.Count - 1 then Inc(FFrameIndex)
      else FFrameIndex := 0;
{$IFDEF RX_D3}
      Canvas.Lock;
      try
        FTimerRepaint := True;
        if AsyncDrawing and Assigned(FOnFrameChanged) then
          FTimer.Synchronize(FrameChanged)
        else FrameChanged;
        DoPaintControl;
      finally
        FTimerRepaint := False;
        Canvas.Unlock;
        if (FFrameIndex >= 0) and (FFrameIndex < FImage.Count) then
          FTimer.Interval := GetDelayTime(FFrameIndex);
      end;
      if not FLoop and (FFrameIndex = 0) then
        if AsyncDrawing then FTimer.Synchronize(TimerDeactivate)
        else TimerDeactivate;
{$ELSE}
      FTimerRepaint := True;
      try
        FrameChanged;
        Repaint;
      finally
        FTimerRepaint := False;
        if (FFrameIndex >= 0) and (FFrameIndex < FImage.Count) then
          FTimer.Interval := GetDelayTime(FFrameIndex);
      end;
      if not FLoop and (FFrameIndex = 0) then TimerDeactivate;
{$ENDIF}
    finally
      Unlock;
    end;
  end;
end;

procedure TRxGIFAnimator.Change;
begin
  if Assigned(FOnChange) then FOnChange(Self);
end;

procedure TRxGIFAnimator.FrameChanged;
begin
  if Assigned(FOnFrameChanged) then FOnFrameChanged(Self);
end;

procedure TRxGIFAnimator.Stop;
begin
  if Assigned(FOnStop) then FOnStop(Self);
end;

procedure TRxGIFAnimator.Start;
begin
  if Assigned(FOnStart) then FOnStart(Self);
end;

{$IFNDEF RX_D4}
procedure TRxGIFAnimator.SetAutoSize(Value: Boolean);
begin
  if Value <> FAutoSize then begin
    FAutoSize := Value;
    PictureChanged;
  end;
end;
{$ENDIF}

{$IFDEF RX_D3}
procedure TRxGIFAnimator.SetAsyncDrawing(Value: Boolean);
begin
  if FAsyncDrawing <> Value then begin
    Lock;
    try
      if Value then HookBitmap;
      if Assigned(FTimer) then FTimer.SyncEvent := not Value;
      FAsyncDrawing := Value;
    finally
      Unlock;
    end;
  end;
end;
{$ENDIF}

procedure TRxGIFAnimator.SetAnimate(Value: Boolean);
begin
  if FAnimate <> Value then begin
    if Value then begin
      FTimer.OnTimer := TimerExpired;
      FTimer.Enabled := True;
      FAnimate := FTimer.Enabled;
      Start;
    end
    else begin
      FTimer.Enabled := False;
      FTimer.OnTimer := nil;
      FAnimate := False;
      Stop;
      PictureChanged;
    end;
  end;
end;

procedure TRxGIFAnimator.WMSize(var Message: TWMSize);
begin
  inherited;
{$IFNDEF RX_D4}
  AdjustSize;
{$ENDIF}
end;

end.