Mega Code Archive
How to make move your forms like WinAMP (BETTERED!)
<![CDATA[
Title: How to make move your forms like WinAMP (BETTERED!)
Question: Do you remember my article: http://www.delphi3000.com/article.asp?id=2242 ???
That was god, but now I bettered it out. 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 ) frmSplash.Left := frmSplash.Left - ( FOldX - X )
Else
If ( ( frmSplash.Left - ( FOldX - X ) ) 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 ) frmSplash.Top := frmSplash.Top - ( FOldY - Y );
FSide := [fasNone];
End Else
If ( ( frmSplash.Top - ( FOldY - Y ) ) 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.
]]>