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.
Feliratkozás:
Megjegyzések küldése (Atom)
Nincsenek megjegyzések:
Megjegyzés küldése