picshow.pas

提供 122 种不同图形显示特效的可视构件

    else
      R := ClientRect;
    Area.Left := R.Left + MulDiv(Area.Left, R.Right - R.Left, PicRect.Right - PicRect.Left);
    Area.Right := R.Left + MulDiv(Area.Right, R.Right - R.Left, PicRect.Right - PicRect.Left);
    Area.Top := R.Top + MulDiv(Area.Top, R.Bottom - R.Top, PicRect.Bottom - PicRect.Top);
    Area.Bottom := R.Top + MulDiv(Area.Bottom, R.Bottom - R.Top, PicRect.Bottom - PicRect.Top);
  end
  else
  begin
    if fCenter then OffsetRect(Area, PicRect.Left, PicRect.Top);
    if Area.Left < PicRect.Left then Area.Left := PicRect.Left;
    if Area.Right > PicRect.Right then Area.Right := PicRect.Right;
    if Area.Top < PicRect.Top then Area.Top := PicRect.Top;
    if Area.Bottom > PicRect.Bottom then Area.Bottom := PicRect.Bottom;
  end;
  if not (csDestroying in ComponentState) then
  begin
    {$IFDEF WINCONTROL}
    InvalidateRect(Handle, @Area, False);
    {$ELSE}
    OffsetRect(Area, Left, Top);
    InvalidateRect(Parent.Handle, @Area, False);
    {$ENDIF}
  end;
end;

Procedure TCustomPicShow.Clear;
begin
  if not (fBusy or Media.Empty) then
  begin
    if Media.Canvas.TryLock then
    begin
      Media.Canvas.Unlock;
      Media.Free;
      Media := TBitmap.Create;
      Media.PixelFormat := pf24bit;
      Invalidate;
    end;
  end;
end;

procedure TCustomPicShow.Stop;
begin
  if fBusy and not Stopping then
  begin
    Stopping := True;
    try
      if Assigned(Thread) then
      begin
        Thread.Terminate;
        {$IFDEF PS_D4orHigher}
        Thread.WaitFor;
        {$ENDIF}
      end
      else
        AnimationComplete(Self);
    finally
      Stopping := False;
    end;
  end;
end;

procedure TCustomPicShow.Execute;
begin
  if not fBusy and Assigned(Picture.Graphic) then
  begin
    fBusy := True;
    try
      Prepare;
      if not fManual then Animate;
    except
      if Assigned(Pic) then Pic.Free;
      if Assigned(OldPic) then OldPic.Free;
      fBusy := False;
      raise;
    end;
  end;
end;

procedure TCustomPicShow.Animate;
var
  StartTime: DWord;
  Done: Boolean;
begin
  if fThreaded then
    Thread := TAnimateThread.Create(Self)
  else
  begin
    repeat
      StartTime := GetTickCount;
      if Reverse then
        if Progress >= Step then
          Progress := Progress - Step
        else
          Progress := Low(TPercent)
      else
        Progress := Progress + Step;
      Done := (Reverse and (Progress = Low(TPercent))) or
              (not Reverse and (Progress = High(TPercent)));
      if not Done then
        repeat
          Application.ProcessMessages;
        until ((GetTickCount - StartTime) > Delay) or not fBusy or fManual or Stopping;
    until Done or not fBusy or fManual or Stopping;
    if Done then AnimationComplete(Self);
  end;
end;

procedure TCustomPicShow.Prepare;
var
  R: TRect;
begin
  Media.Canvas.Brush.Color := Color;
  Media.Width := fPicture.Width;
  Media.Height := fPicture.Height;
  CalculatePicRect;
  OldPic := TBitmap.Create;
  OldPic.Width := Media.Width;
  OldPic.Height := Media.Height;
  OldPic.PixelFormat := pf24bit;
  if fStretch then
    if fStretchFine then
      R := ScaleImageToRect(PicRect, ClientRect)
    else
      R := ClientRect
  else
    R := PicRect;
  OldPic.Canvas.CopyRect(Rect(0, 0, OldPic.Width, OldPic.Height), OffScreen.Canvas, R);
  Pic := TBitmap.Create;
  Pic.Width := Media.Width;
  Pic.Height := Media.Height;
  Pic.PixelFormat := pf24bit;
  Pic.Canvas.Draw(0, 0, fPicture.Graphic);
  if Reverse then
    Progress := High(TPercent)
  else
    Progress := Low(TPercent);
end;

procedure TCustomPicShow.UpdateDisplay;
var
  X, Y, W, H: Integer;
  R, Rgn: HRgn;
  R1, R2: TRect;
  I, J, S: Integer;
begin
  Media.Canvas.Draw(0, 0, OldPic);
  if Assigned(fOnBeforeNewFrame) then
    fOnBeforeNewFrame(Self, Pic, Media);
  W := Pic.Width;
  H := Pic.Height;
  SetRect(R1, 0, 0, W, H);
  SetRect(R2, 0, 0, W, H);
  Rgn := NULLREGION;
  if W >= H then
  begin
    X := MulDiv(W, fProgress, 100);
    Y := MulDiv(X, H, W);
    S := MulDiv(W, fStep, 90);
  end
  else
  begin
    Y := MulDiv(H, fProgress, 100);
    X := MulDiv(Y, W, H);
    S := MulDiv(H, fStep, 90);
  end;
  case fStyle of
      0: begin
           if Assigned(fOnCustomDraw) then
             fOnCustomDraw(Self, Pic, Media)
           else
           begin
             Media.Canvas.Draw(0, 0, Pic);
             Rgn := CreateRectRgn(0, 0, W, H);
             fProgress := High(TPercent);
           end;
         end;
      1: begin
           R1.Left := W - X;
         end;
      2: begin
           R1.Right := X;
         end;
      3: begin
           R1.Left := W - X;
           R1.Right := (2 * W) - X;
         end;
      4: begin
           R1.Left := X - W;
           R1.Right := X;
         end;
      5: begin
           R1.Right := X;
           R2.Right := X;
         end;
      6: begin
           R1.Left := W - X;
           R2.Left := W - X;
         end;
      7: begin
           R1.Right := (2 * W) - X;
           R2.Right := X;
         end;
      8: begin
           R1.Left := X - W;
           R2.Left := W - X;
         end;
      9: begin
           R1.Left := X - W;
           R1.Right := (2 * W) - X;
           R2.Left := (W - X) div 2;
           R2.Right := (W + X) div 2;
         end;
     10: begin
           R1.Left := (W - X) div 2;
           R1.Right := (W + X) div 2;
         end;
     11: begin
           R1.Left := (W - X) div 2;
           R1.Right := (W + X) div 2;
           R2.Left := (W - X) div 2;
           R2.Right := (W + X) div 2;
         end;
     12: begin
           R1.Left := 0;
           R1.Right := (X div 2) + 1;
           R2.Left := 0;
           R2.Right := (X div 2) + 1;
           Media.Canvas.CopyRect(R1, Pic.Canvas, R2);
           InvalidateArea(R1);
           R1.Left := W - (X div 2) - 1;
           R1.Right := W;
           R2.Left := W - (X div 2) - 1;
           R2.Right := W;
         end;
     13: begin
           R1.Left := 0;
           R1.Right := (X div 2) + 1;
           R2.Left := 0;
           R2.Right := (W div 2) + 1;
           Media.Canvas.CopyRect(R1, Pic.Canvas, R2);
           InvalidateArea(R1);
           R1.Left := W - (X div 2) - 1;
           R1.Right := W;
           R2.Left := W div 2;
           R2.Right := W;
         end;
     14: begin
           R1.Left := X;
           if R1.Left < W div 5 then
             R1.Right := R1.Left + X div 2
           else if (R1.Left + W div 5) > W then
             R1.Right := R1.Left + (W - X) div 2
           else
             R1.Right := R1.Left + W div 10;
           R2.Left := R1.Right;
           R2.Right := R2.Left + R1.Right - R1.Left;
           MirrorCopyRect(Media.Canvas, R1, Pic, R2, True, False);
           InvalidateArea(R1);
           R1.Left := 0;
           R1.Right := X;
           R2.Left := 0;
           R2.Right := X;
         end;
     15: begin
           R1.Right := W - X;
           if (R1.Right + W div 5) > W then
             R1.Left := R1.Right - X div 2
           else if R1.Right < W div 5 then
             R1.Left := R1.Right - (W - X) div 2
           else
             R1.Left := R1.Right - W div 10;
           R2.Right := R1.Left;
           R2.Left := R2.Right - R1.Right + R1.Left;
           MirrorCopyRect(Media.Canvas, R1, Pic, R2, True, False);
           InvalidateArea(R1);
           R1.Left := W - X;
           R1.Right := W;
           R2.Left := W - X;
           R2.Right := W;
         end;
     16: begin
           R1.Left := 0;
           R1.Right := X;
           R2.Left := 0;
           R2.Right := X;
           Media.Canvas.CopyRect(R1, Pic.Canvas, R2);
           InvalidateArea(R1);
           R1.Left := X;
           R1.Right := W;
           R2.Left := X;
           R2.Right := X + W div 20;
         end;
     17: begin
           R1.Left := W - X;
           R1.Right := W;
           R2.Left := W - X;
           R2.Right := W;
           Media.Canvas.CopyRect(R1, Pic.Canvas, R2);
           InvalidateArea(R1);
           R1.Left := 0;
           R1.Right := W - X;
           R2.Left := (W - X) - W div 20;
           R2.Right := W - X;
         end;
     18: begin
           R1.Top := H - Y;
         end;
     19: begin
           R1.Bottom := Y;
         end;
     20: begin
           R1.Top := H - Y;
           R1.Bottom := (2 * H) - Y;
         end;
     21: begin
           R1.Top := Y - H;
           R1.Bottom := Y;
         end;
     22: begin
           R1.Bottom := Y;
           R2.Bottom := Y;
         end;
     23: begin
           R1.Top := H - Y;
           R2.Top := H - Y;
         end;
     24: begin
           R1.Bottom := (2 * H) - Y;
           R2.Bottom := Y;
         end;
     25: begin
           R1.Top := Y - H;
           R2.Top := H - Y;
         end;
     26: begin
           R1.Top := Y - H;
           R1.Bottom := (2 * H) - Y;
           R2.Top := (H - Y) div 2;
           R2.Bottom := (H + Y) div 2;
         end;
     27: begin
           R1.Top := (H - Y) div 2;
           R1.Bottom := (H + Y) div 2;
         end;
     28: begin
           R1.Top := (H - Y) div 2;
           R1.Bottom := (H + Y) div 2;
           R2.Top := (H - Y) div 2;
           R2.Bottom := (H + Y) div 2;
         end;
     29: begin
           R1.Top := 0;
           R1.Bottom := (Y div 2) + 1;
           R2.Top := 0;
           R2.Bottom := (Y div 2) + 1;
           Media.Canvas.CopyRect(R1, Pic.Canvas, R2);
           InvalidateArea(R1);
           R1.Top := H - (Y div 2) - 1;
           R1.Bottom := H;
           R2.Top := H - (Y div 2) - 1;
           R2.Bottom := H;
         end;
     30: begin
           R1.Top := 0;
           R1.Bottom := (Y div 2) + 1;
           R2.Top := 0;
           R2.Bottom := (H div 2) + 1;
           Media.Canvas.CopyRect(R1, Pic.Canvas, R2);
           InvalidateArea(R1);
           R1.Top := H - (Y div 2) - 1;
           R1.Bottom := H;
           R2.Top := H div 2;
           R2.Bottom := H;
         end;
     31: begin
           R1.Top := Y;
           if R1.Top < H div 5 then
             R1.Bottom := R1.Top + Y div 2
           else if (R1.Top + H div 5) > H then
             R1.Bottom := R1.Top + (H - Y) div 2
           else
             R1.Bottom := R1.Top + H div 10;
           R2.Top := R1.Bottom;
           R2.Bottom := R2.Top + R1.Bottom - R1.Top;
           MirrorCopyRect(Media.Canvas, R1, Pic, R2, False, True);
           InvalidateArea(R1);
           R1.Top := 0;
           R1.Bottom := Y;
           R2.Top := 0;
           R2.Bottom := Y;
         end;
     32: begin
           R1.Bottom := H - Y;
           if (R1.Bottom + H div 5) > H then
             R1.Top := R1.Bottom - Y div 2
           else if R1.Bottom < H div 5 then
             R1.Top := R1.Bottom - (H - Y) div 2
           else
             R1.Top := R1.Bottom - H div 10;
           R2.Bottom := R1.Top;
           R2.Top := R2.Bottom - R1.Bottom + R1.Top;
           MirrorCopyRect(Media.Canvas, R1, Pic, R2, False, True);
           InvalidateArea(R1);
           R1.Top := H - Y;
           R1.Bottom := H;
           R2.Top := H - Y;
           R2.Bottom := H;
         end;
     33: begin
           R1.Top := 0;
           R1.Bottom := Y;
           R2.Top := 0;
           R2.Bottom := Y;
           Media.Canvas.CopyRect(R1, Pic.Canvas, R2);
           InvalidateArea(R1);
           R1.Top := Y;
           R1.Bottom := H;
           R2.Top := Y;
           R2.Bottom := Y + H div 20;
         end;
     34: begin
           R1.Top := H - Y;
           R1.Bottom := H;
           R2.Top := H - Y;
           R2.Bottom := H;
           Media.Canvas.CopyRect(R1, Pic.Canvas, R2);
           InvalidateArea(R1);
           R1.Top := 0;
           R1.Bottom := H - Y;
           R2.Top := (H - Y) - H div 20;
           R2.Bottom := H - Y;
         end;
     35: begin
           R1.Left := W - X;
           R1.Top := H - Y;
         end;
     36: begin
           R1.Left := W - X;
           R1.Bottom := Y;
         end;
     37: begin
           R1.Right := X;
           R1.Bottom := Y;
         end;
     38: begin
           R1.Right := X;
           R1.Top := H - Y;
         end;
     39: begin
           R1.Left := W - X;
           R1.Top := H - Y;
           R1.Right := (2 * W) - X;
           R1.Bottom := (2 * H) - Y;
         end;
     40: begin
           R1.Left := W - X;
           R1.Top := Y - H;
           R1.Right := (2 * W) - X;
           R1.Bottom := Y;
         end;
     41: begin
           R1.Left := X - W;
           R1.Top := Y - H;
           R1.Right := X;
           R1.Bottom := Y;
         end;
     42: begin
           R1.Left := X - W;
           R1.Top := H - Y;
           R1.Right := X;
           R1.Bottom := (2 * H) - Y;
         end;
     43: begin
           R1.Right := X;
           R1.Bottom := Y;
           R2.Right := X;
           R2.Bottom := Y;
         end;
     44: begin
           R1.Right := X;