2006. február 1., szerda

Make move your forms like WinAMP


Problem/Question/Abstract:

The form remember on what side you put it and returns there when Windows Taskbar is moved!!! Try it out: full source code.

Answer:

unit frmSplashUnit;

interface

uses
  Windows, Messages, SysUtils, Classes,
  Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, ComCtrls, Buttons,
  Menus, ImgList;

const
  MagneticField = 10;

type
  TAlignSide1 = (fasNone, fasTop, fasBottom, fasRight, fasLeft);
  TAlignSide = set of TAlignSide1;
  TfrmSplash =
    class(TForm)
    bvlForm: TBevel;
    lblAction: TLabel;
    lblFile: TLabel;
    bvlTitle: TBevel;
    imgTitle: TImage;
    lblProgress: TLabel;
    pbProgress: TProgressBar;
    bvlLine: TBevel;
    cmdCancel: TSpeedButton;
    popSystemMenu: TPopupMenu;
    mnuRestore: TMenuItem;
    mnuMove: TMenuItem;
    mnuSize: TMenuItem;
    mnuMinimize: TMenuItem;
    mnuMaximize: TMenuItem;
    mnuBar1: TMenuItem;
    mnuClose: TMenuItem;
    ilSystemMenu: TImageList;
    mnuBar2: TMenuItem;
    mnuAbout: TMenuItem;
    cmdAbout: TSpeedButton;
    procedure imgTitleMouseDown(Sender: TObject; Button: TMouseButton; Shift:
      TShiftState; X, Y: Integer);
    procedure imgTitleMouseUp(Sender: TObject; Button: TMouseButton; Shift:
      TShiftState; X, Y: Integer);
    procedure imgTitleMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure ClientAreaVerify(var Msg: TWMSettingChange); message WM_SETTINGCHANGE;
    procedure FormCreate(Sender: TObject);
    procedure cmdCancelClick(Sender: TObject);
    procedure FormResize(Sender: TObject);
  private
  public
    FSide: TAlignSide;
    FMoving: Boolean;
    FOldX: Integer;
    FOldY: Integer;
    FArea: TRect;
  end;

var
  frmSplash: TfrmSplash;

implementation

{$R *.DFM}

procedure TfrmSplash.imgTitleMouseDown(Sender: TObject; Button: TMouseButton; Shift:
  TShiftState; X, Y: Integer);
begin
  FMoving := True;
  FOldX := X;
  FOldY := Y;
end;

procedure TfrmSplash.imgTitleMouseUp(Sender: TObject; Button: TMouseButton; Shift:
  TShiftState; X, Y: Integer);
begin
  FMoving := False;
end;

procedure TfrmSplash.imgTitleMouseMove(Sender: TObject; Shift: TShiftState; X, Y:
  Integer);
var
  WorkArea: TRect;
begin
  if (SystemParametersInfo(SPI_GETWORKAREA, 0, @WorkArea, 0)) then
    FArea := WorkArea;
  if (FMoving) then
  begin
    FSide := [fasNone];
    if (((frmSplash.Left - (FOldX - X)) > (WorkArea.Left + MagneticField)) and
      ((frmSplash.Left - (FOldX - X) + frmSplash.Width) < (WorkArea.Right -
      MagneticField))) then
      frmSplash.Left := frmSplash.Left - (FOldX - X)
    else if ((frmSplash.Left - (FOldX - X)) <= (WorkArea.Left + MagneticField)) then
    begin
      frmSplash.Left := WorkArea.Left;
      FSide := FSide + [fasLeft];
    end
    else
    begin
      frmSplash.Left := WorkArea.Right - frmSplash.Width;
      FSide := FSide + [fasRight];
    end;
    if (((frmSplash.Top - (FOldY - Y)) > (WorkArea.Top + MagneticField)) and
      ((frmSplash.Top - (FOldY - Y) + frmSplash.Height) < (WorkArea.Bottom -
      MagneticField))) then
    begin
      frmSplash.Top := frmSplash.Top - (FOldY - Y);
      FSide := [fasNone];
    end
    else if ((frmSplash.Top - (FOldY - Y)) <= (WorkArea.Top + MagneticField)) then
    begin
      frmSplash.Top := WorkArea.Top;
      FSide := FSide + [fasTop];
    end
    else
    begin
      frmSplash.Top := WorkArea.Bottom - frmSplash.Height;
      FSide := FSide + [fasBottom];
    end;
    // Removes [fasNone] if anything else is found in FSide.
    if (((fasBottom in FSide) or (fasTop in FSide) or (fasLeft in FSide) or (fasRight
      in FSide)) and (fasNone in FSide)) then
      FSide := FSide - [fasNone];
  end;
end;

procedure TfrmSplash.ClientAreaVerify(var Msg: TWMSettingChange);
var
  WorkArea: TRect;
begin
  if (not (FMoving)) then
    if (SystemParametersInfo(SPI_GETWORKAREA, 0, @WorkArea, 0)) then
    begin
      if (fasLeft in FSide) then
        frmSplash.Left := WorkArea.Left;
      if (fasRight in FSide) then
        frmSplash.Left := WorkArea.Right - frmSplash.Width;
      if (fasTop in FSide) then
        frmSplash.Top := WorkArea.Top;
      if (fasBottom in FSide) then
        frmSplash.Top := WorkArea.Bottom - frmSplash.Height;
    end;
end;

procedure TfrmSplash.FormCreate(Sender: TObject);
begin
  // TO DO: Check if form is on one of the corners.
  FSide := [fasNone];
  FMoving := False;
end;

procedure TfrmSplash.cmdCancelClick(Sender: TObject);
begin
  Application.Terminate;
end;

procedure TfrmSplash.FormResize(Sender: TObject);
begin
  imgTitle.Width := bvlTitle.Width;
  bvlLine.Width := frmSplash.Width - (2 * bvlLine.Left);
  pbProgress.Width := frmSplash.Width - pbProgress.Left - bvlLine.Left;
  cmdCancel.Left := frmSplash.Width - cmdCancel.Width - cmdAbout.Left;
  cmdAbout.Top := frmSplash.Height - cmdAbout.Height - cmdAbout.Left;
  cmdCancel.Top := cmdAbout.Top;
  bvlLine.Top := cmdAbout.Top - bvlLine.Height;
end;

end.

Nincsenek megjegyzések:

Megjegyzés küldése