acmagn.pas

Alpha Controls.v5.46b Source

unit acMagn;
{$I sDefs.inc}
{.$DEFINE LOGGED}

interface

uses
  Windows, Messages, Graphics, Forms, Menus, Classes, Controls,
  ExtCtrls{$IFDEF LOGGED}, sDebugMsgs, sPanel{$ENDIF};

type
  TPosChangingEvent = procedure(var X : integer; var Y : integer) of object;

  TsMagnifier = class(TComponent)
{$IFNDEF NOTFORHELP}
  private
    FScaling: integer;
    FPopupMenu: TPopupMenu;
    FOnMouseUp: TMouseEvent;
    FOnMouseDown: TMouseEvent;
    FOnPosChanging: TPosChangingEvent;
    FOnDblClick: TNotifyEvent;
    procedure SetScaling(const Value: integer);
  public
    IsModal : boolean;
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
{$ENDIF}
    procedure Execute(x : integer = -1; y : integer = -1);
    procedure Hide;
    function  IsVisible : Boolean;
    function  GetPosition : TPoint;
  published
    property PopupMenu : TPopupMenu read FPopupMenu write FPopupMenu;
    property Scaling : integer read FScaling write SetScaling default 2;

    property OnDblClick : TNotifyEvent read FOnDblClick write FOnDblClick;
    property OnMouseDown : TMouseEvent read FOnMouseDown write FOnMouseDown;
    property OnMouseUp : TMouseEvent read FOnMouseUp write FOnMouseUp;
    property OnPosChanging : TPosChangingEvent read FOnPosChanging write FOnPosChanging;
  end;

{$IFNDEF NOTFORHELP}
  TacMagnForm = class(TForm)
    PopupMenu1: TPopupMenu;
    Image1: TImage;
    N1x1: TMenuItem;
    N2x1: TMenuItem;
    N8x1: TMenuItem;
    N1: TMenuItem;
    Close1: TMenuItem;
    N16x1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure Close1Click(Sender: TObject);
    procedure Zoom1x1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure FormShow(Sender: TObject);
    procedure Image1DblClick(Sender: TObject);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
  protected
    procedure WMPosChanging (var Message: TWMWindowPosChanging); message WM_WINDOWPOSCHANGING;
  public
    Caller        : TObject;
    Fregion       : hrgn;
    FTempBmp      : TBitMap;
    FCacheBmp     : TBitmap;
    AlphaBmp      : TBitmap;
    MaskBmp       : TBitmap;
    Scale         : Smallint;
    Size          : Smallint;
    MagnBmp       : TBitmap;
    MagnShadowBmp : TBitmap;
    destructor Destroy; override;
    procedure WndProc(var Message : TMessage); override;
    procedure Loaded; override;
    procedure RefreshView;
    procedure SetZooming(k : integer);
    procedure ShowGlass(x, y : integer);
    procedure CreateAlphaBmp;
  end;

var
  FDowned      : boolean;
  OldTop       : integer = -1;
  Closing      : boolean = False;
  Showed       : boolean = False;
  Refreshing   : boolean = False;
  acIsDragging : boolean = False;
  
{$ENDIF}

implementation

{$R *.DFM}

uses sGraphUtils, sConst, SysUtils, sAlphaGraph, sSkinManager, sVclUtils, sMessages, acntUtils;

const
  HiddenTop = -300;
  lWidth = 230;
  lHeight = 230;

procedure TacMagnForm.ShowGlass(x, y : integer);
var
  R : TRect;
  DC : hdc;
  FBmpSize: TSize;
  FBmpTopLeft: TPoint;
  FBlend: TBlendFunction;
  FastMask : TacFast24;
  FastBody : TacFast24;
  FastDst : TacFast32;
  c : TsColor;
  XOffs, YOffs, i, p, StepCount : integer;
begin
  if MagnBmp = nil then Exit;
//  if not Active or (Top = HiddenTop) then Exit;
  if DefaultManager <> nil then DefaultManager.SkinableMenus.HookPopupMenu(Image1.PopupMenu, DefaultManager.Active);

  XOffs := Round(X + (Size - Size / Scale) / 2);
  YOffs := Round(Y + (Size - Size / Scale) / 2);

  if @UpdateLayeredWindow = nil then begin
    StretchBlt(FTempBmp.Canvas.Handle, 0, 0, 200, 200, FCacheBmp.Canvas.Handle,
               XOffs,
               YOffs,
               Size div Scale, Size div Scale, SrcCopy);
  end
  else begin
    DC := GetDC(0); 
    StretchBlt(FTempBmp.Canvas.Handle, 0, 0, 200, 200, DC,
                 XOffs,
                 YOffs,
                 Size div Scale, Size div Scale, SrcCopy);
    ReleaseDC(0, DC);
  end;

  R := Rect(0, 0, 200, 200);
  CopyByMask(R, R, FTempBmp, MagnBmp, EmptyCI, True);

  if @UpdateLayeredWindow <> nil then begin // If Layered

    FBmpSize.cx := lWidth;
    FBmpSize.cy := lHeight;
    FBmpTopLeft := Point(0, 0);

    with FBlend do begin
      BlendOp := AC_SRC_OVER;
      BlendFlags := 0;
      AlphaFormat := $01;
      SourceConstantAlpha := 255;
    end;

    if AlphaBmp = nil then CreateAlphaBmp;

    FastMask := TacFast24.Create;
    FastBody := TacFast24.Create;
    FastDst := TacFast32.Create;
    if FastDst.Attach(AlphaBmp) and FastMask.Attach(MaskBmp) and FastBody.Attach(FTempBmp) then begin
      for y := 0 to 200 - 1 do for x := 0 to 200 - 1 do begin
        if FastMask.Pixels[x, y].R = 0 then begin
          c := FastBody.Pixels[x, y];
          c.A := 255;
          FastDst[x + 10, y + 10] := c;
        end;
      end;
    end;
    FreeAndnil(FastMask);
    FreeAndnil(FastBody);
    FreeAndnil(FastDst);

    DC := GetDC(0);
    if not Showed and (DefaultManager <> nil) and DefaultManager.AnimEffects.DialogShow.Active then begin
      StepCount := 200{DefaultManager.AnimEffects.DialogShow.Time} div 10;
      if StepCount > 0 then begin
        p := 255 div StepCount;
        i := 0;
        while i <= StepCount do begin
          FBlend.SourceConstantAlpha := i * p;
          UpdateLayeredWindow(Handle, DC, nil, @FBmpSize, AlphaBmp.Canvas.Handle, @FBmpTopLeft, clNone, @FBlend, $00000002);
          inc(i);
          if (i > StepCount) then Break;
          if StepCount > 0 then Sleep(10);
        end;
      end;
    end
    else UpdateLayeredWindow(Handle, DC, nil, @FBmpSize, AlphaBmp.Canvas.Handle, @FBmpTopLeft, clNone, @FBlend, $00000002);
    Showed := True;
    ReleaseDC(0, DC);
  end
  else begin
    Image1.Picture.Assign(FTempBmp);
  end
end;

{$R magn.res}

procedure TacMagnForm.FormCreate(Sender: TObject);
begin
  Size := Width;
  if @UpdateLayeredWindow = nil then FCacheBmp := CreateBmp24(Screen.Width, Screen.Height);
  FTempBmp := CreateBmp24(200, 200);

  MagnBmp := TBitmap.Create;
  MagnBmp.LoadFromResourceName(HInstance, 'MAGN');
  MagnBmp.PixelFormat := pf24bit;
  MagnShadowBmp := TBitmap.Create;
  MagnShadowBmp.LoadFromResourceName(HInstance, 'MAGNSHADOW');
  MagnShadowBmp.PixelFormat := pf24bit;
end;

procedure TacMagnForm.Close1Click(Sender: TObject);
begin
  Close;
end;

procedure TacMagnForm.SetZooming(k: integer);
begin
  Scale := k;
  ShowGlass(Left, Top);
end;

procedure TacMagnForm.Zoom1x1Click(Sender: TObject);
begin
  TsMagnifier(Caller).Scaling := TMenuItem(Sender).Tag;
  TMenuItem(Sender).Checked := True;
end;

procedure TacMagnForm.WMPosChanging(var Message: TWMWindowPosChanging);
  function DesktopLeft : integer;
  var
    i : integer;
  begin
    Result := Monitor.Left;
    for i := 0 to Screen.MonitorCount - 1 do if Screen.Monitors[i].Left < Result then Result := Screen.Monitors[i].Left;
  end;
  function DesktopRight : integer;
  var
    i : integer;
  begin
    Result := Monitor.Left + Monitor.Width;
    for i := 0 to Screen.MonitorCount - 1 do if Screen.Monitors[i].Left + Screen.Monitors[i].Width > Result then Result := Screen.Monitors[i].Left + Screen.Monitors[i].Width;
  end;
begin
  if not Showed or Closing or (csloading in ComponentState) or
    (csCreating in ControlState) or (OldTop <> -1) or (csDestroying in ComponentState) or
      (csDestroying in Application.ComponentState) then Exit;

  if Assigned(TsMagnifier(Caller).OnPosChanging) and (Message.WindowPos^.cx <> 0) and (Message.WindowPos^.cy <> 0) then begin
    TsMagnifier(Caller).OnPosChanging(Message.WindowPos^.X, Message.WindowPos^.Y)
  end
  else begin
    if Message.WindowPos^.X < DesktopLeft - 90 then Message.WindowPos^.X := DesktopLeft - 90 else
    if Message.WindowPos^.X + Width > DesktopRight + 140 then Message.WindowPos^.X := DesktopRight + 140 - Width;
    if Message.WindowPos^.Y < - 90 then Message.WindowPos^.Y := - 90 else