tezfran.pas

delphi2007界面效果控件源码

                    Canvas.Handle,
                    LastPaintedRect.Left,
                    LastPaintedRect.Top,
                    LastPaintedRect.Right  - LastPaintedRect.Left,
                    LastPaintedRect.Bottom - LastPaintedRect.Top,
                    DesktopBmp.Canvas.Handle,
                    LastPaintedRect.Left   - AnimationRect.Left,
                    LastPaintedRect.Top    - AnimationRect.Top,
                    cmSrcCopy);
                end
                else
                begin
                  OffsetRect(LastPaintedRect, -AnimationRect.Left, -AnimationRect.Top);
                  BitBlt(
                    WorkBmp.Canvas.Handle,
                    LastPaintedRect.Left,
                    LastPaintedRect.Top,
                    LastPaintedRect.Right  - LastPaintedRect.Left,
                    LastPaintedRect.Bottom - LastPaintedRect.Top,
                    DesktopBmp.Canvas.Handle,
                    LastPaintedRect.Left,
                    LastPaintedRect.Top,
                    cmSrcCopy);

                  if not IsCompositionEnabled then
                  begin
                    // Draw form contents
                    FormR := AnimationData.Form.BoundsRect;
                    OffsetRect(FormR, -AnimationRect.Left, -AnimationRect.Top);
                    SaveIndex := SaveDC(WorkBmp.Canvas.Handle);
                    try
                      RenderWindowToBmp(WorkBmp, AnimationData.Form.Handle, 0,
                        AnimationData.Form, FormR, False, False, True, False,
                        WorkBmp.PixelFormat);
                    finally
                      RestoreDC(WorkBmp.Canvas.Handle, SaveIndex);
                    end;

                    UnionRect(DirtyR, FormR, LastPaintedRect);
                    OffsetRect(DirtyR, AnimationRect.Left, AnimationRect.Top);

                    // Draw to screen
                    BitBlt(
                      Canvas.Handle,
                      DirtyR.Left,
                      DirtyR.Top ,
                      DirtyR.Right  - DirtyR.Left,
                      DirtyR.Bottom - DirtyR.Top,
                      WorkBmp.Canvas.Handle,
                      DirtyR.Left - AnimationRect.Left,
                      DirtyR.Top  - AnimationRect.Top,
                      cmSrcCopy);
                  end;
                end;
              finally
                Chrono.Free;
              end;
            finally
              PanelFrame       .Free;
              PanelDesktop     .Free;
            end;
          finally
            WorkBmp.Canvas.Unlock;
          end;
        finally
          WorkBmp.Free;
        end;
      finally
        DesktopBmp.Free;
      end;
    finally
      ReleaseDC(0, Canvas.Handle);
    end;
  finally
    Canvas.Free;
  end;
end;

procedure TTEZoomFrameAnimation.ExecuteStep(Canvas: TCanvas;
  DesktopBmp, WorkBmp: TBitmap; Panel: TWinControl;
  var LastPaintedRect: TRect; AnimationRect: TRect; R: TRect;
  Chrono: TTEChrono);
var
  PanelR,
  BmpLastR,
  BmpR,
  DirtyR: TRect;
  SaveIndex: Integer;
  SaveTEAPIHooksDisabled: Boolean;
begin
  // Restore screen
  BmpLastR := LastPaintedRect;
  if IsRectEmpty(LastPaintedRect)
  then LastPaintedRect := R
  else
  begin
    OffsetRect(BmpLastR, -AnimationRect.Left, -AnimationRect.Top);
    BitBlt(
      WorkBmp.Canvas.Handle,
      BmpLastR.Left,
      BmpLastR.Top,
      BmpLastR.Right  - BmpLastR.Left,
      BmpLastR.Bottom - BmpLastR.Top,
      DesktopBmp.Canvas.Handle,
      BmpLastR.Left,
      BmpLastR.Top,
      cmSrcCopy);
  end;

  // Draw step
  BmpR := R;
  OffsetRect(BmpR, -AnimationRect.Left, -AnimationRect.Top);
  if WorkBmp.Canvas.Brush.Style <> bsSolid then
  begin
    // Repos panel
    PanelR := BmpR;
    if FBorderPen.Style <> psClear
    then
    begin
      InflateRect(PanelR, -FBorderPen.Width, -FBorderPen.Width);
      Panel.BoundsRect := PanelR;
    end
    else Panel.BoundsRect := PanelR;

    // Draw contents
    SaveTEAPIHooksDisabled := TEAPIHooksDisabled;
    TEAPIHooksDisabled     := True;
    SaveIndex := SaveDC(WorkBmp.Canvas.Handle);
    try
      RenderWindowToBmp(WorkBmp, Panel.Handle, 0, Panel, PanelR, False, False,
        False, False, WorkBmp.PixelFormat);
    finally
      TEAPIHooksDisabled := SaveTEAPIHooksDisabled;
      RestoreDC(WorkBmp.Canvas.Handle, SaveIndex);
    end;
  end;

  // Draw rect
  if(FBorderPen.Style <> psClear) or (FFillBrush.Style <> bsClear) then
    WorkBmp.Canvas.Rectangle(BmpR.Left, BmpR.Top, BmpR.Right, BmpR.Bottom);

  UnionRect(DirtyR, R, LastPaintedRect);

  if not Chrono.IsReset then
    while Chrono.Milliseconds < FMinStepMilliseconds do;
  Chrono.Reset;
  Chrono.Start;

  // Draw to screen
  BitBlt(
    Canvas.Handle,
    DirtyR.Left,
    DirtyR.Top ,
    DirtyR.Right  - DirtyR.Left,
    DirtyR.Bottom - DirtyR.Top,
    WorkBmp.Canvas.Handle,
    DirtyR.Left - AnimationRect.Left,
    DirtyR.Top  - AnimationRect.Top,
    cmSrcCopy);

  LastPaintedRect := R;
end;

function TTEZoomFrameAnimation.GetGlassColor: TColor;
begin
  Result := BkgrndOptions.GlassColor;
end;

function TTEZoomFrameAnimation.GetGlassTranslucency: TFCTranslucency;
begin
  Result := BkgrndOptions.GlassTranslucency;
end;

function TTEZoomFrameAnimation.GetGlassVisible: Boolean;
begin
  Result := BkgrndOptions.GlassVisible;
end;

function TTEZoomFrameAnimation.GetPicture: TPicture;
begin
  Result := BkgrndOptions.Picture;
end;

function TTEZoomFrameAnimation.GetPictureMode: TFCPictureMode;
begin
  Result := BkgrndOptions.PictureMode;
end;

function TTEZoomFrameAnimation.GetPictureTranspColor: TColor;
begin
  Result := BkgrndOptions.PictureTranspColor;
end;

function TTEZoomFrameAnimation.GetPictureVisible: Boolean;
begin
  Result := BkgrndOptions.PictureVisible;
end;

procedure TTEZoomFrameAnimation.SetGlassColor(const Value: TColor);
begin
  BkgrndOptions.GlassColor := Value;
end;

procedure TTEZoomFrameAnimation.SetGlassTranslucency(
  const Value: TFCTranslucency);
begin
  BkgrndOptions.GlassTranslucency := Value;
end;

procedure TTEZoomFrameAnimation.SetGlassVisible(const Value: Boolean);
begin
  BkgrndOptions.GlassVisible := Value;
end;

procedure TTEZoomFrameAnimation.SetMinStepIncrement(const Value: Integer);
begin
  if Value > 0
  then FMinStepIncrement := Value
  else FMinStepIncrement := 1;
end;

procedure TTEZoomFrameAnimation.SetPicture(const Value: TPicture);
begin
  BkgrndOptions.Picture := Value;
end;

procedure TTEZoomFrameAnimation.SetPictureMode(const Value: TFCPictureMode);
begin
  BkgrndOptions.PictureMode := Value;
end;

procedure TTEZoomFrameAnimation.SetPictureTranspColor(const Value: TColor);
begin
  BkgrndOptions.PictureTranspColor := Value;
end;

procedure TTEZoomFrameAnimation.SetPictureVisible(const Value: Boolean);
begin
  BkgrndOptions.PictureVisible := Value;
end;

procedure TTEZoomFrameAnimation.SetMinStepMilliseconds(const Value: Integer);
begin
  if Value > 0
  then FMinStepMilliseconds := Value
  else FMinStepMilliseconds := 1;
end;

procedure TTEZoomFrameAnimation.ShowForm(Form: TCustomForm);
begin
  DoShowForm(
    Form,
    False,
    CreateAnimationData(Form));
end;

procedure TTEZoomFrameAnimation.ShowFormEx(Form: TCustomForm; Origin: TRect;
  Control: TControl; ClientCoordinates: Boolean);
begin
  DoShowForm(
    Form,
    False,
    TTEZoomFrameAnimationData.CreateEx(Self, Form, Control, Origin, False));
end;

function TTEZoomFrameAnimation.ShowModalForm(Form: TCustomForm): Integer;
begin
  Result :=
    DoShowForm(
      Form,
      True,
      CreateAnimationData(Form));
end;

function TTEZoomFrameAnimation.ShowModalFormEx(Form: TCustomForm;
  Origin: TRect; Control: TControl; ClientCoordinates: Boolean): Integer;
begin
  Result :=
    DoShowForm(
      Form,
      True,
      TTEZoomFrameAnimationData.CreateEx(Self, Form, Control, Origin, False));
end;

procedure TTEZoomFrameAnimation.ExecuteHiding(
  AnimationData: TTEFormAnimationData);
begin
  Execute(True, False, AnimationData as TTEZoomFrameAnimationData);
end;

procedure TTEZoomFrameAnimation.ExecuteShowing(HasTransition: Boolean;
  AnimationData: TTEFormAnimationData; var CanDestroyAnimationData: Boolean);
var
  SaveOrigin: TRect;
begin
  SaveOrigin := AnimationData.Origin;
  Execute(False, HasTransition, AnimationData as TTEZoomFrameAnimationData);
  CanDestroyAnimationData :=
    not
    (
      EqualRect(SaveOrigin, Rect(-1, -1, -1, -1)) and
      (DefaultOrigin = tezoCursor) 
    );
end;

function TTEZoomFrameAnimation.CreateAnimationData(
  Form: TCustomForm): TTEFormAnimationData;
begin
  Result := TTEZoomFrameAnimationData.CreateEx(
    Self, Form, nil, Rect(-1, -1, -1, -1), False);
end;

class function TTEZoomFrameAnimation.Description: String;
begin
  Result := 'Zoom frames';
end;

procedure TTEZoomFrameAnimation.SetBorderPen(const Value: TPen);
begin
  FBorderPen.Assign(Value);
end;

procedure TTEZoomFrameAnimation.SetFillBrush(const Value: TBrush);
begin
  FFillBrush.Assign(Value);
end;

{ TTEZoomFrameAnimationData }

constructor TTEZoomFrameAnimationData.CreateEx(AnAnimation: TTEZoomFrameAnimation;
  AForm: TCustomForm; AControl: TControl; AnOrigin: TRect;
  AClientCoordinates: Boolean);
begin
  Create(AnAnimation, AForm, AControl, AnOrigin);

  ClientCoordinates := AClientCoordinates;
end;

{ TTEDesktopPaintPanel }

procedure TTEDesktopPaintPanel.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);

  with Params do
  begin
    if (Parent = nil) and (ParentWindow = 0) then
    begin
      Style := WS_POPUP;
      WndParent := Application.Handle;
    end;
  end;
end;

constructor TTEPen.Create;
begin
  inherited Create;

  Color := clNavy;
  Width := 2;
end;

{ TTEBrush }

constructor TTEBrush.Create;
begin
  inherited Create;

  Style := bsClear;
end;

initialization
  {$ifdef D6UP}
  StartClassGroup(TControl);
  ActivateClassGroup(TControl);
  GroupDescendentsWith(TTEZoomFrameAnimation, Controls.TControl);
  {$endif D6UP}

  Classes.RegisterClass(TTEZoomFrameAnimation);
end.