acmagn.pas

Alpha Controls.v5.46b Source

    if Message.WindowPos^.Y + Height > Screen.DesktopHeight + 140 then Message.WindowPos^.Y := Screen.DesktopHeight + 140 - Height;
  end;

  if (Message.WindowPos^.X = 0) and (Message.WindowPos^.Y = 0)
    then ShowGlass(Left, Top)
    else ShowGlass(Message.WindowPos^.X, Message.WindowPos^.Y);
end;

procedure TacMagnForm.Loaded;
begin
  inherited;
end;

procedure TacMagnForm.WndProc(var Message: TMessage);
begin
{$IFDEF LOGGED}
  case Message.Msg of
    WM_NCHITTEST, WM_MOUSEMOVE, WM_SETCURSOR, WM_WINDOWPOSCHANGING,
    WM_NCCALCSIZE, WM_NCPAINT, WM_MOVE, WM_MOVING, WM_ERASEBKGND,
    WM_WINDOWPOSCHANGED :
    else AddToLog(Message);
  end;
{$ENDIF}
  case Message.Msg of
    WM_ERASEBKGND, WM_NCPAINT : Exit;
  end;
  inherited;
  if Message.Msg = SM_ALPHACMD then case Message.WParamHi of
    AC_REFRESH : begin
      ShowGlass(Left, Top);
    end;
  end;
  case Message.Msg of
    WM_ACTIVATE : if not Refreshing and not (csDestroying in ComponentState) and not (csDestroying in Application.ComponentState) then begin
      RefreshView;
      ShowGlass(Left, Top);
    end;
  end;
end;

procedure TacMagnForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Showed := False;
  Closing := True;
  if Application.MainForm <> Self then begin
    Action := caFree;
    acMagnForm := nil;
  end;
end;

procedure TacMagnForm.Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  inherited;
  if Assigned(TsMagnifier(Caller).OnMouseDown) then TsMagnifier(Caller).OnMouseDown(Caller, Button, Shift, X, Y);
  if not Refreshing and (mbLeft = Button) then begin
    acIsDragging := True;
    ReleaseCapture;
    Perform(WM_SYSCOMMAND, $F012, 0);
  end;
end;

procedure TacMagnForm.CreateAlphaBmp;
var
  FastDst : TacFast32;
  FastShadow : TacFast24;
  x, y : integer;
  c : TsColor;
begin
  FastDst := TacFast32.Create;
  FastShadow := TacFast24.Create;

  AlphaBmp := CreateBmp32(lWidth, lHeight);
  FillDC(AlphaBmp.Canvas.Handle, Rect(0, 0, lWidth, lHeight), 0);

  MaskBmp := CreateBmp24(200, 200);
  MaskBmp.Canvas.Brush.Color := 0;
  MaskBmp.Canvas.Ellipse(0, 0, 200, 200);
  MaskBmp.PixelFormat := pf24bit;

  if FastDst.Attach(AlphaBmp) and FastShadow.Attach(MagnShadowBmp) then
  begin
    for y := 0 to lHeight - 1 do
    for x := 0 to lWidth  - 1 do
    begin
      c.I := 0;
      c.A := 255 - FastShadow.Pixels[x, y].R;
      FastDst[x, y] := c;
    end;
  end;

  FreeAndnil(FastDst);
  FreeAndnil(FastShadow);
end;

{ TsMagnifier }

constructor TsMagnifier.Create(AOwner: TComponent);
begin
  inherited;
  FScaling := 2;
  IsModal := False;
end;

destructor TsMagnifier.Destroy;
begin
  if Assigned(acMagnForm) then FreeAndNil(acMagnForm);
  inherited;
end;

procedure TsMagnifier.Execute(x : integer = -1; y : integer = -1);
var
  i : integer;
begin
  if acMagnForm = nil then begin
    acMagnForm := TacMagnForm.Create(nil);
    TacMagnForm(acMagnForm).Caller := Self;

    TacMagnForm(acMagnForm).Scale := FScaling;

    if FPopupMenu <> nil then TacMagnForm(acMagnForm).Image1.PopupMenu := FPopupMenu else begin
      for i := 0 to TacMagnForm(acMagnForm).PopupMenu1.Items.Count - 1 do if TacMagnForm(acMagnForm).PopupMenu1.Items[i].Tag = FScaling then begin
        TacMagnForm(acMagnForm).PopupMenu1.Items[i].Checked := True;
        Break;
      end;
    end;
    if (x <> -1) or (y <> -1) then begin
      TacMagnForm(acMagnForm).Position := poDesigned;
      acMagnForm.Left := x;
      acMagnForm.Top := y;
    end;

    if @UpdateLayeredWindow = nil then begin
      TacMagnForm(acMagnForm).FormStyle := fsNormal;
      TacMagnForm(acMagnForm).FRegion := CreateEllipticRgn(1, 1, 200, 200);
      SetWindowRgn(TacMagnForm(acMagnForm).Handle, TacMagnForm(acMagnForm).Fregion, true);
      TacMagnForm(acMagnForm).RefreshView;
    end
    else begin
      TacMagnForm(acMagnForm).Width := lWidth;
      TacMagnForm(acMagnForm).Height := lHeight;
      SetWindowLong(TacMagnForm(acMagnForm).Handle, GWL_EXSTYLE, GetWindowLong(acMagnForm.Handle, GWL_EXSTYLE) or $00080000);
    end;

    if IsModal then TacMagnForm(acMagnForm).ShowModal else TacMagnForm(acMagnForm).Show;
  end
  else TacMagnForm(acMagnForm).BringToFront
end;

var
  User32Lib: Cardinal = 0;

procedure TacMagnForm.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  if Key = 27 then Close;
end;

function TsMagnifier.IsVisible: Boolean;
begin
  if acMagnForm <> nil
    then Result := TForm(acMagnForm).Visible
    else Result := False;
end;

function TsMagnifier.GetPosition: TPoint;
begin
  if acMagnForm <> nil then begin
    Result.X := TForm(acMagnForm).Left;
    Result.Y := TForm(acMagnForm).Top ;
  end
  else begin
    Result.X := -1;
    Result.Y := -1;
  end;
end;

procedure TsMagnifier.Hide;
begin
  if acMagnForm <> nil then TForm(acMagnForm).Close //FreeAndNil(acMagnForm);
end;

procedure TsMagnifier.SetScaling(const Value: integer);
begin
  if FScaling = Value then Exit;
  if Value < 2 then FScaling := 2 else if Value > 16 then FScaling := 16 else FScaling := Value;
  if acMagnForm <> nil then TacMagnForm(acMagnForm).SetZooming(FScaling);
end;

procedure TacMagnForm.RefreshView;
var
  DC: HDC;
begin
  if (@UpdateLayeredWindow = nil) and not Refreshing and not (csDestroying in ComponentState) and (FCacheBmp <> nil) {and (Left > 0) and (Top > 0) and (Left + Width < Screen.Width) and (Top + Height < Screen.Height)} then begin
    Refreshing := True;
    OldTop := Top;
    Top := HiddenTop;
    Delay(100);

    DC := GetDC(0);
    BitBlt(FCacheBmp.Canvas.Handle, 0, 0, FCacheBmp.Width, FCacheBmp.Height, DC, 0, 0, SrcCopy);
    ReleaseDC(0, DC);

    Top := OldTop;

    OldTop := -1;
    Refreshing := False
  end;
end;

procedure TacMagnForm.FormShow(Sender: TObject);
begin
  Closing := False;
end;

procedure TacMagnForm.Image1DblClick(Sender: TObject);
begin
  if Assigned(TsMagnifier(Caller).OnDblClick) then TsMagnifier(Caller).OnDblClick(Caller);
end;

procedure TacMagnForm.Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
{$IFDEF DELPHI7UP}
  if not Mouse.IsDragging and acIsDragging then
{$ENDIF}
  begin
    if Assigned(TsMagnifier(Caller).OnMouseUp) then TsMagnifier(Caller).OnMouseUp(Caller, mbLeft, Shift, X, Y);
    acIsDragging := False;
  end
end;

destructor TacMagnForm.Destroy;
begin
  if Assigned(MagnBmp) then FreeAndNil(MagnBmp);
  if Assigned(MagnShadowBmp) then FreeAndNil(MagnShadowBmp);

  if (@UpdateLayeredWindow = nil) and Assigned(FCacheBmp) then FreeAndNil(FCacheBmp);
  if Assigned(FTempBmp) then FreeAndNil(FTempBmp);
  if Assigned(AlphaBmp) then FreeAndNil(AlphaBmp);
  if Assigned(MaskBmp) then FreeAndNil(MaskBmp);
  inherited;
end;

initialization
  if @UpdateLayeredWindow = nil then begin
    User32Lib := LoadLibrary('USER32');
    try
      if User32Lib <> 0
        then UpdateLayeredWindow := GetProcAddress(User32Lib, 'UpdateLayeredWindow')
        else @UpdateLayeredWindow := nil;
    finally
    end;
  end;

finalization
  if User32Lib <> 0 then FreeLibrary(User32Lib);

end.