teimage.pas

delphi2007界面效果控件源码

  try
    BackgroundOptions.DrawBackGround(Bmp.Canvas.Handle, Bmp, R);
    if DrawPic                      and
       FPictureVisible              and
      (FPicture.Graphic <> nil)     and
      (not FPicture.Graphic.Empty)  and
      (FPicture.Graphic.Width  > 0) and
      (FPicture.Graphic.Height > 0) then
    begin
      teBkgrnd.DrawPicture(FPicture.Graphic, FPictureMode, FPictureTranspColor,
        Self, Bmp, R, FPictureMargin ,Self);
    end;
  finally
    SetWindowOrgEx(Bmp.Canvas.Handle, P.X, P.Y, nil);
  end;
end;

procedure TTEImage.Paint;
var
  R,
  RAux,
  RFrame: TRect;
  Save,
  Painted,
  LeaveCSBitmap,
  LeaveCSThread: Boolean;
  LocalBmp,
  FrameBmp: TBitmap;
  DeviceHack: TTransitionDeviceHack;
begin
  Save     := FDrawing;
  FDrawing := True;
  try
    R := Canvas.ClipRect;
    if IsRectEmpty(R) then
      R := Rect(0, 0, ClientWidth, ClientHeight);

    DeviceHack    := TTransitionDeviceHack(FTransitionDevice);
    LeaveCSThread := False;
    if Assigned(DeviceHack) then
    begin
      EnterCriticalSection(DeviceHack.csThread);
      LeaveCSThread := True;
    end;
    try
      Painted := False;
      if TransitionPrepared then
      begin // Painting while transition is prepared
        LeaveCSBitmap := False;
        try
          FrameBmp := FTransitionDevice.GetCurrentFrameBmp(LeaveCSBitmap);
          if Assigned(FrameBmp) then
          begin
            Painted := True;
            IntersectRect(RAux, R, DeviceHack.CtrlRect);
            if not IsRectEmpty(RAux)
            then // Current frame must be repainted
            begin
              if not EqualRect(RAux, R)
              then // The prepared area does not cover all the dirty pixels
              begin
                LocalBmp := TBitmap.Create;
                try
                  AdjustBmpForTransition(LocalBmp, 0, R.Right - R.Left,
                    R.Bottom - R.Top, DevicePixelFormat(False));
                  DoPaint(LocalBmp, R, False); // Paint the background
                  if not IsRectEmpty(RAux) then
                  begin
                    RFrame := RAux;
                    OffsetRect(RFrame, -R.Left, -R.Top);
                    // Paint the current frame
                    BitBlt(
                      LocalBmp.Canvas.Handle,
                      RFrame.Left,
                      RFrame.Top,
                      RFrame.Right  - RFrame.Left,
                      RFrame.Bottom - RFrame.Top,
                      FrameBmp.Canvas.Handle,
                      RAux.Left - DeviceHack.CtrlRect.Left,
                      RAux.Top  - DeviceHack.CtrlRect.Top,
                      cmSrcCopy);
                  end;
                  BitBlt(Canvas.Handle, R.Left, R.Top, R.Right - R.Left,
                    R.Bottom - R.Top, LocalBmp.Canvas.Handle, 0, 0, cmSrcCopy);
                finally
                  LocalBmp.Free;
                end;
              end
              else // The prepared area covers all the dirty pixels
              begin
                // Paint the current frame
                BitBlt(
                  Canvas.Handle,
                  R.Left,
                  R.Top,
                  R.Right - R.Left,
                  R.Bottom - R.Top,
                  FrameBmp.Canvas.Handle,
                  R.Left - DeviceHack.CtrlRect.Left,
                  R.Top  - DeviceHack.CtrlRect.Top,
                  cmSrcCopy);
              end
            end
            else // Only background needs to be painted
            begin
              LocalBmp := TBitmap.Create;
              try
                AdjustBmpForTransition(LocalBmp, 0, R.Right - R.Left, R.Bottom - R.Top,
                  DevicePixelFormat(False));
                DoPaint(LocalBmp, R, False);
                BitBlt(Canvas.Handle, R.Left, R.Top, R.Right - R.Left,
                  R.Bottom - R.Top, LocalBmp.Canvas.Handle, 0, 0, cmSrcCopy);
              finally
                LocalBmp.Free;
              end;
            end;
          end;
        finally
          if LeaveCSBitmap then
            LeaveCriticalSection(TTransitionDeviceHack(FTransitionDevice).CSBitmap);
        end;
      end;

      if not Painted then
      begin  // Standard painting
        LocalBmp := TBitmap.Create;
        try
          AdjustBmpForTransition(LocalBmp, 0, R.Right - R.Left, R.Bottom - R.Top,
            DevicePixelFormat(False));
          DoPaint(LocalBmp, R, True);
          BitBlt(Canvas.Handle, R.Left, R.Top, R.Right - R.Left,
            R.Bottom - R.Top, LocalBmp.Canvas.Handle, 0, 0, cmSrcCopy);
        finally
          LocalBmp.Free;
        end;
      end;
    finally
      if LeaveCSThread then
        LeaveCriticalSection(DeviceHack.csThread);
    end;
  finally
    FDrawing := Save;
  end;
end;

function TTEImage.Transition: TTransitionEffect;
begin
  if TransitionPrepared
  then Result := FTransitionDevice.Transition
  else Result := nil;
end;

function TTEImage.TransitionExecuting: Boolean;
begin
  Result := Assigned(FTransitionDevice) and FTransitionDevice.Executing;
end;

function TTEImage.TransitionPrepared: Boolean;
begin
  Result := Assigned(FTransitionDevice);
end;

procedure TTEImage.InternalPrepareTransition(Transition: TTransitionEffect;
  R: TRect; SrcBmp: TBitmap);
var
  DeviceHack: TTransitionDeviceHack;
begin
  if FTransitionDevice = nil then
    FTransitionDevice := TTEVCLControlTrDevice.Create;
  try
    if FTransitionDevice.Transition = nil then
      FTransitionDevice.Transition := Transition;
    if not TTransitionDeviceHack(FTransitionDevice).AllowTransition then
      exit;
    DeviceHack := TTransitionDeviceHack(FTransitionDevice);
    if FTransitionDevice.Prepare(Self, R, Canvas)
    then
    begin
      DeviceHack.SrcImage := TBitmap.Create;
      AdjustBmpForTransition(DeviceHack.SrcImage, 0,
        TTransitionEffectHack(FTransitionDevice.DelegateTransition).GetBitmapsWidth(DeviceHack.Data),
        DeviceHack.Data.Height,
        TTransitionEffectHack(FTransitionDevice.DelegateTransition).GetPixelFormat(FTransitionDevice));
      if Assigned(SrcBmp)
      then BitBlt(DeviceHack.SrcImage.Canvas.Handle, 0, 0,
             DeviceHack.Data.Width, DeviceHack.Data.Height,
             SrcBmp.Canvas.Handle, R.Left, R.Top, cmSrcCopy)
      else DoPaint(DeviceHack.SrcImage, R, True);
    end
    else FreeAndNil(FTransitionDevice);
  except
    on Exception do
    begin
      FreeAndNil(FTransitionDevice);
      raise;
    end;
  end;
end;

function TTEImage.PrepareTransition(Transition: TTransitionEffect; const
  FullArea: Boolean = True; const DestroyTransition: Boolean = False): Boolean;
var
  aux: TRect;
begin
  AbortTransition;

  Result             := False;
  FullAreaTransition := FullArea;
  FDestroyTransition := DestroyTransition;
  BkgrndHasChanged   := False;

  if FullAreaTransition or (not FPictureVisible) or (FPicture.Graphic = nil)
  then PreparedPicRect := Rect(0, 0, 0, 0)
  else
  begin
    PreparedPicRect := teBkgrnd.PictureRect(FPicture.Graphic, FPictureMode,
      FPictureMargin, Self, Self, aux);
    IntersectRect(PreparedPicRect, PreparedPicRect, ClientRect);
  end;

  try
    InternalPrepareTransition(Transition, Rect(0, 0, ClientWidth, ClientHeight),
      nil);
    Result := Assigned(FTransitionDevice);
  finally
    if not Result then
      UnPrepareTransition;
  end;
end;

procedure TTEImage.InternalUnPrepareTransition(FullUnprepare: Boolean);
var
  SaveTransition: TTransitionEffect;
  SaveFreeDelegateTransition: Boolean;
begin
  if TransitionPrepared and FTransitionDevice.AllowAbort then
  begin
    if FTransitionDevice.Executing or FTransitionDevice.UsingThread
    then AbortTransition
    else
    begin
      if FullUnprepare
      then
      begin
        if FDestroyTransition
        then SaveTransition := FTransitionDevice.Transition
        else SaveTransition := nil;
        FreeAndNil(FTransitionDevice);
        SaveTransition.Free;
        FullAreaTransition := False;
        PreparedPicRect    := Rect(0, 0, 0, 0);
        Invalidate;
      end
      else
      begin
        SaveFreeDelegateTransition :=
          TTransitionDeviceHack(FTransitionDevice).FreeDelegateTransition;
        TTransitionDeviceHack(FTransitionDevice).FreeDelegateTransition := False;
        try
          FTransitionDevice.UnPrepare;
        finally
          TTransitionDeviceHack(FTransitionDevice).FreeDelegateTransition :=
            SaveFreeDelegateTransition;
        end;
      end;
    end;
  end;
end;

procedure TTEImage.UnPrepareTransition;
begin
  InternalUnPrepareTransition(True);
end;

procedure TTEImage.ExecuteTransition(WaitForCompletion: Boolean = True);
var
  DeviceHack: TTransitionDeviceHack;
  R,
  NewPicRect,
  aux: TRect;
  DoUnprepare: Boolean;
  Bmp: TBitmap;
  SaveTransition: TTransitionEffect;
begin
  Update;
  if TransitionPrepared then
  begin
    DoUnprepare := True;
    try
      if FullAreaTransition or BkgrndHasChanged
      then R := ClientRect
      else
      begin
        if FPictureVisible
        then
        begin
          NewPicRect := teBkgrnd.PictureRect(FPicture.Graphic, FPictureMode,
            FPictureMargin, Self, Self, aux);
          IntersectRect(NewPicRect, NewPicRect, ClientRect);
        end
        else NewPicRect := Rect(0, 0, 0, 0);
        UnionRect(R, PreparedPicRect, NewPicRect);
      end;

      if not IsRectEmpty(R) then
      begin
        DeviceHack := TTransitionDeviceHack(FTransitionDevice);

        if not EqualRect(R, DeviceHack.CtrlRect) then
        begin
          Bmp := DeviceHack.SrcImage;
          try
            DeviceHack.SrcImage := nil;
            SaveTransition      := DeviceHack.Transition;
            InternalUnPrepareTransition(False);
            InternalPrepareTransition(SaveTransition, R, Bmp);
          finally
            FreeAndNil(Bmp);
          end;
          if Assigned(FTransitionDevice) then
            DeviceHack := TTransitionDeviceHack(FTransitionDevice);
        end;

        DeviceHack.DstImage := TBitmap.Create;
        AdjustBmpForTransition(DeviceHack.DstImage, 0,
          TTransitionEffectHack(DeviceHack.DelegateTransition).GetBitmapsWidth(DeviceHack.Data),
          DeviceHack.Data.Height,
          TTransitionEffectHack(DeviceHack.DelegateTransition).GetPixelFormat(FTransitionDevice));
        DoPaint(DeviceHack.DstImage, R, True);

        if FPictureVisible                                            and
          (DeviceHack.TransitionToUse.Passes(DeviceHack) = 2)         and
          (not DeviceHack.TransitionToUse.Pass2Options.UseSolidColor) then
        begin
          DeviceHack.Pass2Image := TBitmap.Create;
          AdjustBmpForTransition(DeviceHack.Pass2Image, 0,
            TTransitionEffectHack(DeviceHack.TransitionToUse).GetBitmapsWidth(DeviceHack.Data),
            DeviceHack.Data.Height,
            TTransitionEffectHack(DeviceHack.DelegateTransition).GetPixelFormat(FTransitionDevice));
          DoPaint(DeviceHack.Pass2Image, R, False);
        end;

        FTransitionDevice.Execute(WaitForCompletion);
        DoUnprepare := WaitForCompletion;
      end;
    finally
      if DoUnprepare then
        UnPrepareTransition;
    end;
  end;
end;

procedure TTEImage.CMTEThreadTerminated(var Message: TWMNoParams);
begin
  if TransitionPrepared then
  begin
    try
      TTransitionDeviceHack(FTransitionDevice).OnTransitionThreadTerminated;
    finally
      UnPrepareTransition;
    end;
  end;
end;

end.