tepage.pas

delphi2007界面效果控件源码

  PageData.RVisArc   .R      := PageData.RArc.R;
  PageData.RVisArc   .Top    := PageData.RArc   .Top    + ArcRevVisPixels;
  PageData.RVisArcRev.R      := PageData.RArcRev.R;
  IntersectRect(PageData.RVisArc   .R, PageData.RVisArc   .R, PageData.RClip.R);
  IntersectRect(PageData.RVisArcRev.R, PageData.RVisArcRev.R, PageData.RClip.R);
  IntersectRect(PageData.RMovingPgBak.R, PageData.RMovingPg.R, PageData.RClip.R);
  Aux := PageData.RMovingPg.Bottom;
  PageData.RMovingPg.Top    := PageData.RArcRev.Bottom;
  if PageData.RMovingPg.Top = PageData.RArc.Bottom
  then PageData.RMovingPg.Bottom :=
         PageData.RMovingPg.Top + (Frame - (PageData.ArcPixelCount * 2))
  else PageData.RMovingPg.Bottom := PageData.RMovingPg.Top;
  IntersectRect(PageData.RMovingPgNew.R, PageData.RMovingPg.R, PageData.RClip.R);

  if PageData.DoScroll                         and
    (not IsRectEmpty(PageData.RMovingPgNew.R)) and
    (not IsRectEmpty(PageData.RMovingPgBak.R)) then
  begin
    Aux := PageData.RMovingPg.Bottom - Aux;
    case DirectionToUse of
      tedDown : yScroll :=  Aux;
      tedUp   : yScroll := -Aux;
      tedRight: xScroll :=  Aux;
      tedLeft : xScroll := -Aux;
    end;
    if UncoverToUse
    then PageData.RMovingPgNew.Bottom := PageData.RMovingPgNew.Top + Aux
    else
    begin
      xScroll := -xScroll;
      yScroll := -yScroll;
      PageData.Rects.TgtDir     := tedDown;
      PageData.RMovingPgNew.Top := PageData.RMovingPgNew.TgtTop + Aux;
      PageData.Rects.TgtDir     := PageData.Direction;
    end;
    IntersectRect(PageData.RMovingPgNew.R, PageData.RMovingPgNew.R, PageData.RClip.R);
  end;
  if UncoverToUse
  then
  begin
    PageData.RStaticPg.Top    := PageData.RStaticPg.Bottom;
    PageData.RStaticPg.Bottom := PageData.RArcRev.Top;
  end
  else
  begin
    PageData.Rects.TgtDir       := tedDown;
    PageData.RStaticPg.Bottom   := PageData.RStaticPg.Top;
    if PageData.RArc.Bottom = PageData.RArcRev.Bottom
    then PageData.RStaticPg.Top := PageData.RMovingPg.TgtBottom
    else PageData.RStaticPg.Top := PageData.RArc     .TgtBottom;
    PageData.Rects.TgtDir       := PageData.Direction;
  end;

  // Apply 3D effect in arc's offscreen bitmap
  if not IsRectEmpty(PageData.RVisArc.R) then
  begin
    PageData.R1Arc3D.Bottom := PageData.ArcVisPixelCount;
    PageData.R1Arc3D.Top    := PageData.R1Arc3D.Bottom - (ArcVisPixels - ArcRevVisPixels);
    PageData.R2Arc3D.Bottom := PageData.RVisArc.Bottom;
    PageData.R2Arc3D.Top    :=
      PageData.R2Arc3D.Bottom -
      PageData.ArcPreCalc[PageData.R1Arc3D.Bottom - PageData.R1Arc3D.Top];

    Apply3D(
      False,
      PageData.Direction,
      PageData.ArcData,
      PageData.ArcRevData,
      PageData.ArcCustomData,
      PageData.ArcCustomData,
      PageData.BmpArc,
      PageData.R1Arc3D.TgtR,
      PageData.Bmp,
      PageData.R2Arc3D.TgtR,
      PageData.ArcVisPixelCount);
  end;

  if not IsRectEmpty(PageData.RVisArcRev.R) then
  begin
    // Calculation for clipping the processed pixels
    Aux:=
      (PageData.Height - PageData.RMovingPg.Height) - ArcRevTotPixels;
    Aux2 :=
      PageData.ArcPreCalc[PageData.RArcRev.Bottom - PageData.RVisArcRev.Bottom];

    PageData.R1ArcRev3D.Top    := 0;
    PageData.R1ArcRev3D.Bottom := PageData.RVisArcRev.Height;
    PageData.R2ArcRev3D.Top    := Aux;
    PageData.R2ArcRev3D.Bottom := Aux + ArcRevTotPixels - Aux2;

    Apply3D(
      True,
      PageData.Direction,
      PByteArray (@PageData.ArcData[PageData.ArcVisPixelCount - (PageData.RVisArcRev.Height)]),
      PageData.ArcRevData,
      PDWordArray(@PageData.ArcCustomData[PageData.ArcVisPixelCount - (PageData.RVisArcRev.Height)]),
      PageData.ArcCustomData,
      PageData.BmpArcRev,
      PageData.R1ArcRev3D.TgtR,
      PageData.BmpReversed,
      PageData.R2ArcRev3D.TgtR,
      PageData.ArcVisPixelCount);
  end;

  // Scroll the old moving page
  if(xScroll <> 0) or (yScroll <> 0) then
  begin
    RAux1 := PageData.RMovingPgBak.TgtR;
    RAux2 := PageData.RClip.TgtR;
    ScrollDC(Data.Canvas.Handle, xScroll, yScroll, RAux1, RAux2, 0, nil);
  end;

  // Paint the new pixels of the moving page
  if not IsRectEmpty(PageData.RMovingPgNew.R) then
  begin
    xAux := 0;
    yAux := 0;
    case PageData.Direction of
      tedDown : yAux := PageData.Height - PageData.RMovingPg.Top + ArcTotPixels + ArcRevTotPixels;
      tedRight: xAux := PageData.Height - PageData.RMovingPg.Top + ArcTotPixels + ArcRevTotPixels;
      tedUp   : yAux := PageData.RMovingPg.Bottom - PageData.RMovingPgNew.Bottom + ArcTotPixels - ArcRevTotPixels;
      tedLeft : xAux := PageData.RMovingPg.Bottom - PageData.RMovingPgNew.Bottom + ArcTotPixels - ArcRevTotPixels;
    end;

    BitBlt(Data.Canvas.Handle,
      PageData.RMovingPgNew.TgtLeft,
      PageData.RMovingPgNew.TgtTop,
      PageData.RMovingPgNew.TgtWidth,
      PageData.RMovingPgNew.TgtHeight,
      PageData.BmpReversed.Canvas.Handle,
      xAux,
      yAux,
      cmSrcCopy);
  end;
  UnionRect(Data.UpdateRect, Data.UpdateRect, PageData.RMovingPg.UpdR);

  if PageData.RStaticPg.Bottom > 0 then
  begin
    // Paint the new pixels of the static page
    BitBlt(Data.Canvas.Handle,
      PageData.RStaticPg.TgtLeft,
      PageData.RStaticPg.TgtTop,
      PageData.RStaticPg.TgtWidth,
      PageData.RStaticPg.TgtHeight,
      Data.DstBmp.Canvas.Handle,
      PageData.RStaticPg.TgtLeft,
      PageData.RStaticPg.TgtTop,
      cmSrcCopy);
    UnionRect(Data.UpdateRect, Data.UpdateRect, PageData.RStaticPg.UpdR);
  end;

  // Paint the arc
  if not IsRectEmpty(PageData.RVisArc.R) then
  begin
    BitBlt(
      Data.Canvas.Handle,
      PageData.RVisArc.TgtLeft,
      PageData.RVisArc.TgtTop,
      PageData.RVisArc.TgtWidth,
      PageData.RVisArc.TgtHeight,
      PageData.BmpArc.Canvas.Handle,
      PageData.R1Arc3D.TgtLeft,
      PageData.R1Arc3D.TgtTop,
      cmSrcCopy);
    UnionRect(Data.UpdateRect, Data.UpdateRect, PageData.RVisArc.UpdR);
  end;

  // Paint the reversed arc
  if not IsRectEmpty(PageData.RVisArcRev.R) then
  begin
    BitBlt(Data.Canvas.Handle,
      PageData.RVisArcRev.TgtLeft,
      PageData.RVisArcRev.TgtTop,
      PageData.RVisArcRev.TgtWidth,
      PageData.RVisArcRev.TgtHeight,
      PageData.BmpArcRev.Canvas.Handle,
      PageData.R1ArcRev3D.TgtLeft,
      PageData.R1ArcRev3D.TgtTop,
      cmSrcCopy);
    UnionRect(Data.UpdateRect, Data.UpdateRect, PageData.RVisArcRev.UpdR);
  end;
end;

function TPageTransition.GetInfo(Device: TTETransitionDevice):
  TTETransitionInfo;
begin
  Result := inherited GetInfo(Device) +
    [
      tetiMillisecondsCapable,
      tetiOffScreenBmpCapable,
      tetiThreadSafe
    ];
end;

function TPageTransition.GetPixelFormat(Device: TTETransitionDevice):
  TPixelFormat;
begin
  {$ifndef TrialLimited}
  if(FSize > 0) and Is3D(Device) and Device.IsRGB
  then Result := pf32bit
  else Result := Device.PixelFormat;
  {$else}
  Result := Device.PixelFormat;
  {$endif TrialLimited}
end;

function TPageTransition.Is3D(Device: TTETransitionDevice): Boolean;
begin
{$ifdef TrialLimited}
  Result := False;
{$else}
  Result :=
    TEProcessorInfo.MMX and
    Use3D               and
    Device.IsRGB;
{$endif TrialLimited}
end;

function TPageTransition.UncoverToUse: Boolean;
begin
  if Reversed
  then Result := not Uncover
  else Result := Uncover;
end;

{ TTERects }

constructor TTERects.Create(OrgDirValue, TgtDirValue: TTEEffectDirection);
begin
  Assert(OrgDirValue = tedDown); // Only tedDown implemented by now
  Assert(TgtDirValue in [tedRight, tedLeft, tedDown, tedUp]);
  OrgDir := OrgDirValue;
  TgtDir := TgtDirValue;
  List := TList.Create;
end;

function TTERects.CreateRect(ClipWidth, ClipHeight, Left, Top, Right,
  Bottom: Integer): TTERect;
begin
  Result := TTERect.Create(Self);
  if TgtDir in [tedDown, tedUp]
  then
  begin
    Result.ClipWidth  := ClipWidth;
    Result.ClipHeight := ClipHeight;
  end
  else
  begin
    Result.ClipWidth  := ClipHeight;
    Result.ClipHeight := ClipWidth;
  end;
  Result.Left       := Left;
  Result.Top        := Top;
  Result.Right      := Right;
  Result.Bottom     := Bottom;
  List.Add(Result);
end;

destructor TTERects.Destroy;
var
  i: Integer;
begin
  for i:=0 to List.Count-1 do
    TTERect(List[i]).Free;
  List.Free;

  inherited;
end;

function TTERects.TgtBottom(Rect: TTERect): Integer;
begin
  case TgtDir of
    tedDown : Result := Rect.Bottom;
    tedUp   : Result := Rect.ClipHeight - Rect.Top;
    tedRight: Result := Rect.ClipHeight - Rect.Left;
    tedLeft : Result := Rect.ClipHeight - Rect.Left;
    else Result := 0;
  end;
end;

function TTERects.TgtLeft(Rect: TTERect): Integer;
begin
  case TgtDir of
    tedDown : Result := Rect.Left;
    tedUp   : Result := Rect.ClipWidth - Rect.Right;
    tedRight: Result := Rect.Top;
    tedLeft : Result := Rect.ClipWidth - Rect.Bottom;
    else Result := 0;
  end;
end;

function TTERects.TgtRight(Rect: TTERect): Integer;
begin
  case TgtDir of
    tedDown : Result := Rect.Right;
    tedUp   : Result := Rect.ClipWidth - Rect.Left;
    tedRight: Result := Rect.Bottom;
    tedLeft : Result := Rect.ClipWidth - Rect.Top;
    else Result := 0;
  end;
end;

function TTERects.TgtTop(Rect: TTERect): Integer;
begin
  case TgtDir of
    tedDown : Result := Rect.Top;
    tedUp   : Result := Rect.ClipHeight - Rect.Bottom;
    tedRight: Result := Rect.ClipHeight - Rect.Right;
    tedLeft : Result := Rect.ClipHeight - Rect.Right;
    else Result := 0;
  end;
end;

{ TTERect }

constructor TTERect.Create(RectsValue: TTERects);
begin
  Rects   := RectsValue;
end;

function TTERect.GetBottom: Integer;
begin
  Result := R.Bottom;
end;

function TTERect.GetLeft: Integer;
begin
  Result := R.Left;
end;

function TTERect.GetRight: Integer;
begin
  Result := R.Right;
end;

function TTERect.GetTop: Integer;
begin
  Result := R.Top;
end;

function TTERect.Height: Integer;
begin
  Result := R.Bottom - R.Top;
end;

procedure TTERect.SetBottom(const Value: Integer);
begin
  if R.Bottom <> Value then
    R.Bottom := Value;
end;

procedure TTERect.SetLeft(const Value: Integer);
begin
  if R.Left <> Value then
    R.Left := Value;
end;

procedure TTERect.SetRight(const Value: Integer);
begin
  if R.Right <> Value then
    R.Right := Value;
end;

procedure TTERect.SetTop(const Value: Integer);
begin
  if R.Top <> Value then
    R.Top := Value;
end;

function TTERect.TgtBottom: Integer;
begin
  Result := Rects.TgtBottom(Self);
end;

function TTERect.TgtHeight: Integer;
var
  aux: TRect;
begin
  aux := TgtR;
  Result := aux.Bottom - aux.Top;
end;

function TTERect.TgtLeft: Integer;
begin
  Result := Rects.TgtLeft(Self);
end;

function TTERect.TgtR: TRect;
begin
  Result := Rect(TgtLeft, TgtTop, TgtRight, TgtBottom);
end;

function TTERect.UpdR: TRect;
var
  aux: TRect;
begin
  aux := TgtR;
  if aux.Left < aux.Right
  then
  begin
    Result.Left  := aux.Left;
    Result.Right := aux.Right;
  end
  else
  begin
    Result.Left  := aux.Right;
    Result.Right := aux.Left;
  end;
  if aux.Top < aux.Bottom
  then
  begin
    Result.Top    := aux.Top;
    Result.Bottom := aux.Bottom;
  end
  else
  begin
    Result.Top    := aux.Bottom;
    Result.Bottom := aux.Top;
  end;
end;

function TTERect.TgtRight: Integer;
begin
  Result := Rects.TgtRight(Self);
end;

function TTERect.TgtTop: Integer;
begin
  Result := Rects.TgtTop(Self);
end;

function TTERect.TgtWidth: Integer;
var
  aux: TRect;
begin
  aux := TgtR;
  Result := aux.Right - aux.Left;
end;

function TTERect.Width: Integer;
begin
  Result := R.Right - R.Left;
end;

initialization

  TERegisterTransition(TPageTransition);

end.