Форум: "Основная";
Текущий архив: 2002.04.15;
Скачать: [xml.tar.bz2];

Вниз

Как сделать липкие формы?   Найти похожие ветки 

← →
Walker   (2002-04-03 05:51) [6]

вот простенький пример:


{
Article:

Sticky Windows
http://delphi.about.com/library/weekly/aa070301a.htm
This article shows how to dock your Delphi forms to
the edges of your desktop screen.


********************************************
Zarko Gajic, BSCS
About Guide to Delphi Programming
http://delphi.about.com
email: delphi.guide@about.com
free newsletter: http://delphi.about.com/library/blnewsletter.htm
forum: http://forums.about.com/ab-delphi/start/
advertising: http://delphi.about.com/library/bladvertise.htm
********************************************
}

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;

type
TfrMain = class(TForm)
edStickAt: TEdit;
Label1: TLabel;
chkTop: TCheckBox;
chkBottom: TCheckBox;
chkRight: TCheckBox;
chkLeft: TCheckBox;
procedure edStickAtKeyPress(Sender: TObject; var Key: Char);
private
procedure WMWINDOWPOSCHANGING (Var Msg: TWMWINDOWPOSCHANGING); message WM_WINDOWPOSCHANGING;
public
{ Public declarations }
end;

var
frMain: TfrMain;

implementation
{$R *.DFM}


procedure TfrMain.WMWINDOWPOSCHANGING (var Msg: TWMWINDOWPOSCHANGING);
const
Docked: Boolean = FALSE;
var
rWorkArea: TRect;
StickAt : Word;
begin
StickAt := StrToInt(edStickAt.Text);

SystemParametersInfo (SPI_GETWORKAREA, 0, @rWorkArea, 0);

with Msg.WindowPos^ do begin
if chkLeft.Checked then
if x <= rWorkArea.Left + StickAt then begin
x := rWorkArea.Left;
Docked := TRUE;
end;

if chkRight.Checked then
if x + cx >= rWorkArea.Right - StickAt then begin
x := rWorkArea.Right - cx;
Docked := TRUE;
end;

if chkTop.Checked then
if y <= rWorkArea.Top + StickAt then begin
y := rWorkArea.Top;
Docked := TRUE;
end;

if chkBottom.Checked then
if y + cy >= rWorkArea.Bottom - StickAt then begin
y := rWorkArea.Bottom - cy;
Docked := TRUE;
end;

if Docked then begin
with rWorkArea do begin
// no moving out of the screen
if x < Left then x := Left;
if x + cx > Right then x := Right - cx;
if y < Top then y := Top;
if y + cy > Bottom then y := Bottom - cy;
end; {with rWorkArea}
end; {if Docked}
end; {with Msg.WindowPos^}

inherited;
end;

procedure TfrMain.edStickAtKeyPress(Sender: TObject; var Key: Char);
begin
if not (key in ["0".."9"]) then Abort;
end;

end.



а это текст формы (unit1.dfm)

object frMain: TfrMain
Left = 198
Top = 139
Width = 232
Height = 118
Caption = "frMain"
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = "MS Sans Serif"
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object Label1: TLabel
Left = 8
Top = 20
Width = 36
Height = 13
Caption = "Stick at"
end
object edStickAt: TEdit
Left = 8
Top = 36
Width = 65
Height = 21
TabOrder = 0
Text = "20"
OnKeyPress = edStickAtKeyPress
end
object chkTop: TCheckBox
Left = 116
Top = 12
Width = 61
Height = 17
Caption = "chkTop"
Checked = True
State = cbChecked
TabOrder = 1
end
object chkBottom: TCheckBox
Left = 116
Top = 64
Width = 73
Height = 17
Caption = "chkBottom"
Checked = True
State = cbChecked
TabOrder = 2
end
object chkRight: TCheckBox
Left = 148
Top = 36
Width = 65
Height = 17
Caption = "chkRight"
Checked = True
State = cbChecked
TabOrder = 3
end
object chkLeft: TCheckBox
Left = 84
Top = 36
Width = 61
Height = 17
Caption = "chkLeft"
Checked = True
State = cbChecked
TabOrder = 4
end
end

---

Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2002.04.15;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.45 MB
Время: 0.004 c