多进程窗口的“磁性”

Tags: /超级猛料/Friends.网友专栏/zswang/ Date Created:

Zswang 的这个例程，是用来让一个程序的多个实例的窗口互相粘连的，犹如Winamp的窗口一样。

//pas

//wjhu111@21cn.com

unit MagnetismUnit;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,

Dialogs, Buttons, ExtCtrls, StdCtrls, Menus;

const

WM_MAGNETISM = WM_USER + 10;

const

MT_CLOSEU = 1;

MT_CLOSED = 2;

MT_MOVE = 5;

MT_CREATE = 6;

MT_PRIOR = 7;

MT_NEXT = 8;

type

TFormMagnetism = class(TForm)

BevelUp: TBevel;

BevelDown: TBevel;

LabelCaption: TLabel;

LabelTitle: TLabel;

PanelButton: TPanel;

SpeedButtonDown: TSpeedButton;

SpeedButtonClose: TSpeedButton;

SpeedButtonUp: TSpeedButton;

ImageNWSE: TImage;

MemoNote: TMemo;

PanelMenu: TPanel;

SpeedButtonMenu: TSpeedButton;

PopupMenuOne: TPopupMenu;

MenuItemAbout: TMenuItem;

SaveDialogOne: TSaveDialog;

OpenDialogOne: TOpenDialog;

MenuItemSave: TMenuItem;

MenuItemLoad: TMenuItem;

LabelHttp: TLabel;

procedure SpeedButtonCloseClick(Sender: TObject);

procedure SpeedButtonUpClick(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure LabelCaptionMouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure LabelCaptionMouseUp(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure LabelCaptionMouseMove(Sender: TObject; Shift: TShiftState; X,

Y: Integer);

procedure FormResize(Sender: TObject);

procedure ImageNWSEMouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure ImageNWSEMouseUp(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure ImageNWSEMouseMove(Sender: TObject; Shift: TShiftState; X,

Y: Integer);

procedure FormShow(Sender: TObject);

procedure FormClose(Sender: TObject; var Action: TCloseAction);

procedure MenuItemAboutClick(Sender: TObject);

procedure SpeedButtonMenuClick(Sender: TObject);

procedure MenuItemSaveClick(Sender: TObject);

procedure MenuItemLoadClick(Sender: TObject);

procedure LabelHttpClick(Sender: TObject);

private

{ Private declarations }

FMouseDown: Boolean;

FOldLeft: Integer;

FOldTop: Integer;

FPriorForm: THandle;

FNextForm: THandle;

FCoalition: Boolean;

FOldHeight: Integer;

FRect: TRect;

procedure WMMAGNETISM(var Msg: TMessage); message WM_MAGNETISM;

procedure SetCoalition(const Value: Boolean);

public

{ Public declarations }

property PriorForm: THandle read FPriorForm write FPriorForm;

property NextForm: THandle read FNextForm write FNextForm;

property Coalition: Boolean read FCoalition write SetCoalition;

end;

var

FormMagnetism: TFormMagnetism;

const

cSoftwareName = 'Zswang Note 1.1';

const

cShellOpenCount = 5;

cShellOpenList: array[0..cShellOpenCount - 1] of string =

(

'http://kingron.myetang.com',

'http://www.csdn.net',

'http://www.delphi3000.com',

'http://vcl.vclxx.org',

'mailto:wjhu111@21cn.com'

);

implementation

{$R *.dfm}

uses

Math, ShellApi;

procedure TFormMagnetism.SpeedButtonCloseClick(Sender: TObject);

begin

Close;

end;

procedure TFormMagnetism.SpeedButtonUpClick(Sender: TObject);

begin

Coalition := not Coalition;

end;

procedure TFormMagnetism.FormCreate(Sender: TObject);

begin

Application.Title := cSoftwareName;

FPriorForm := FindWindow(PChar(string(Self.ClassName)), PChar(Application.Title));

Randomize;

Color := RGB(Random(256), Random(256), Random(256));

MemoNote.Clear;

Caption := Application.Title;

LabelTitle.Caption := Application.Title;

LabelHttp.Caption := cShellOpenList[Random(cShellOpenCount)];

FNextForm := 0;

Randomize;

SpeedButtonUp.Visible := False;

FormResize(Sender);

end;

procedure TFormMagnetism.LabelCaptionMouseDown(Sender: TObject;

Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

FMouseDown := True;

FOldLeft := X;

FOldTop := Y;

end;

procedure TFormMagnetism.LabelCaptionMouseUp(Sender: TObject;

Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

FMouseDown := False;

end;

procedure TFormMagnetism.LabelCaptionMouseMove(Sender: TObject;

Shift: TShiftState; X, Y: Integer);

begin

if FMouseDown then begin

Left := Left + (X - FOldLeft);

Top := Top + (Y- FOldTop);

SendMessage(FPriorForm, WM_MAGNETISM, MT_MOVE, Handle);

SendMessage(FNextForm, WM_MAGNETISM, MT_MOVE, Handle);

end;

procedure TFormMagnetism.FormResize(Sender: TObject);

begin

PanelButton.Left := TWinControl(Sender).ClientWidth - PanelButton.Width - 10;

LabelCaption.Width := TWinControl(Sender).ClientWidth;

BevelDown.Width := TWinControl(Sender).ClientWidth;

BevelUp.Width := TWinControl(Sender).ClientWidth;

FMouseDown := False;

ImageNWSE.Left := TWinControl(Sender).ClientWidth - ImageNWSE.Width - 1;

ImageNWSE.Top := TWinControl(Sender).ClientHeight - ImageNWSE.Height - 1;

MemoNote.Width := TWinControl(Sender).ClientWidth - MemoNote.Left * 2;

MemoNote.Height := TWinControl(Sender).ClientHeight - MemoNote.Top * 2;

LabelHttp.Left := (TWinControl(Sender).ClientWidth - LabelHttp.Width) div 2;

LabelHttp.Top := TWinControl(Sender).ClientHeight - LabelHttp.Height - 2;

SendMessage(FPriorForm, WM_MAGNETISM, MT_MOVE, Handle);

SendMessage(FNextForm, WM_MAGNETISM, MT_MOVE, Handle);

end;

procedure TFormMagnetism.ImageNWSEMouseDown(Sender: TObject;

Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

FMouseDown := True;

FOldLeft := X;

FOldTop := Y;

end;

procedure TFormMagnetism.ImageNWSEMouseUp(Sender: TObject;

Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

FMouseDown := False;

end;

procedure TFormMagnetism.ImageNWSEMouseMove(Sender: TObject;

Shift: TShiftState; X, Y: Integer);

begin

if FMouseDown then begin

FMouseDown := False;

Width := Max(LabelTitle.Width + LabelTitle.Left + PanelButton.Width + 20,

Width + (X - FOldLeft));

Height := Max(LabelTitle.Height + 40, Height + (Y - FOldTop));

FMouseDown := True;

end;

procedure TFormMagnetism.FormShow(Sender: TObject);

begin

FOldHeight := ClientHeight;

Coalition := True;

SendMessage(FPriorForm, WM_MAGNETISM, MT_CREATE, Handle);

if FPriorForm <> 0 then begin

GetWindowRect(FPriorForm, FRect);

Top := FRect.Top + (FRect.Bottom - FRect.Top);

Left := FRect.Left;

Width := FRect.Right - FRect.Left;

end else begin

Top := 10;

Left := (Screen.Width - Width) div 2;

end;

procedure TFormMagnetism.WMMAGNETISM(var Msg: TMessage);

begin

case Msg.WParam of

MT_CLOSEU: PriorForm := Msg.LParam;

MT_CLOSED: NextForm := Msg.LParam;

MT_MOVE:

if Msg.LParam = Integer(FPriorForm) then begin

GetWindowRect(FPriorForm, FRect);

Top := FRect.Top + (FRect.Bottom - FRect.Top);

Left := FRect.Left;

Width := FRect.Right - FRect.Left;

SendMessage(FNextForm, WM_MAGNETISM, MT_MOVE, Handle);

end else if Msg.LParam = Integer(FNextForm) then begin

GetWindowRect(FNextForm, FRect);

Top := FRect.Top - Height;

Left := FRect.Left;

Width := FRect.Right - FRect.Left;

SendMessage(FPriorForm, WM_MAGNETISM, MT_MOVE, Handle);

end;

MT_CREATE:

if FNextForm = 0 then

FNextForm := Msg.LParam

else SendMessage(Msg.LParam, WM_MAGNETISM, MT_PRIOR, FNextForm);

MT_PRIOR: begin

PriorForm := Msg.LParam;

SendMessage(Msg.LParam, WM_MAGNETISM, MT_CREATE, Handle);

end;

MT_NEXT: NextForm := Msg.LParam;

end;

procedure TFormMagnetism.FormClose(Sender: TObject;

var Action: TCloseAction);

begin

SendMessage(FPriorForm, WM_MAGNETISM, MT_CLOSED, FNextForm);

SendMessage(FNextForm, WM_MAGNETISM, MT_CLOSEU, FPriorForm);

SendMessage(FPriorForm, WM_MAGNETISM, MT_MOVE, FNextForm);

end;

procedure TFormMagnetism.SetCoalition(const Value: Boolean);

begin

FCoalition := Value;

if FCoalition then begin

ClientHeight := FOldHeight;

SpeedButtonUp.Visible := True;

SpeedButtonDown.Visible := False;

ImageNWSE.Visible := True;

LabelHttp.Visible := True;

SendMessage(FNextForm, WM_MAGNETISM, MT_MOVE, Handle);

end else begin

FOldHeight := ClientHeight;

ClientHeight := LabelCaption.Height;

SpeedButtonUp.Visible := False;

SpeedButtonDown.Visible := True;

ImageNWSE.Visible := False;

LabelHttp.Visible := False;

SendMessage(FNextForm, WM_MAGNETISM, MT_MOVE, Handle);

end;

procedure TFormMagnetism.MenuItemAboutClick(Sender: TObject);

begin

MessageDlg(cSoftwareName + #13#10'E-Mail:wjhu111@21cn.com'#13#10'OICQ:45531143',

mtInformation, [mbOk], 0);

end;

procedure TFormMagnetism.SpeedButtonMenuClick(Sender: TObject);

begin

PopupMenuOne.Popup(Mouse.CursorPos.X, Mouse.CursorPos.Y);

end;

procedure TFormMagnetism.MenuItemSaveClick(Sender: TObject);

begin

if SaveDialogOne.Execute then

MemoNote.Lines.SaveToFile(SaveDialogOne.FileName);

end;

procedure TFormMagnetism.MenuItemLoadClick(Sender: TObject);

begin

if OpenDialogOne.Execute then

MemoNote.Lines.LoadFromFile(OpenDialogOne.FileName);

end;

procedure TFormMagnetism.LabelHttpClick(Sender: TObject);

begin

ShellExecute(Handle, 'OPEN', PChar(TLabel(Sender).Caption), nil, nil, SW_SHOW);

end;

end.

//dfm

object FormMagnetism: TFormMagnetism

Left = 191

Top = 108

BorderStyle = bsNone

Caption = 'FormMagnetism'

ClientHeight = 100

ClientWidth = 358

Color = clSkyBlue

Font.Charset = DEFAULT_CHARSET

Font.Color = clWindowText

Font.Height = -11

Font.Name = 'MS Sans Serif'

Font.Style = []

OldCreateOrder = False

OnClose = FormClose

OnCreate = FormCreate

OnResize = FormResize

OnShow = FormShow

PixelsPerInch = 96

TextHeight = 13

object BevelUp: TBevel

Left = 0

Top = 3

Width = 356

Height = 2

Shape = bsTopLine

end

object BevelDown: TBevel

Left = 0

Top = 7

Width = 356

Height = 4

Shape = bsTopLine

end

object LabelCaption: TLabel

Left = 0

Top = 0

Width = 348

Height = 13

Cursor = crSizeAll

AutoSize = False

Transparent = True

OnMouseDown = LabelCaptionMouseDown

OnMouseMove = LabelCaptionMouseMove

OnMouseUp = LabelCaptionMouseUp

end

object LabelTitle: TLabel

Left = 23

Top = 0

Width = 46

Height = 13

Caption = 'LabelTitle'

OnMouseDown = LabelCaptionMouseDown

OnMouseMove = LabelCaptionMouseMove

OnMouseUp = LabelCaptionMouseUp

end

object ImageNWSE: TImage

Left = 349

Top = 89

Width = 7

Height = 7

Cursor = crSizeNWSE

AutoSize = True

Picture.Data = {

07544269746D6170DE000000424DDE0000000000000036000000280000000700

0000070000000100180000000000A8000000C40E0000C40E0000000000000000

0000FFFFFF808080C8D0D4FFFFFF808080C8D0D4FFFFFF000000C8D0D4FFFFFF

808080C8D0D4FFFFFF808080C8D0D4000000C8D0D4C8D0D4FFFFFF808080C8D0

D4FFFFFF808080000000C8D0D4C8D0D4C8D0D4FFFFFF808080C8D0D4FFFFFF00

0000C8D0D4C8D0D4C8D0D4C8D0D4FFFFFF808080C8D0D4000000C8D0D4C8D0D4

C8D0D4C8D0D4C8D0D4FFFFFF808080000000C8D0D4C8D0D4C8D0D4C8D0D4C8D0

D4C8D0D4FFFFFF000000}

OnMouseDown = ImageNWSEMouseDown

OnMouseMove = ImageNWSEMouseMove

OnMouseUp = ImageNWSEMouseUp

end

object LabelHttp: TLabel

Left = 101

Top = 83

Width = 132

Height = 13

Cursor = crHandPoint

Caption = 'http://kingron.myetang.com'

DragCursor = crDefault

Font.Charset = DEFAULT_CHARSET

Font.Color = clBlue

Font.Height = -11

Font.Name = 'MS Sans Serif'

Font.Style = [fsUnderline]

ParentFont = False

OnClick = LabelHttpClick

end

object PanelButton: TPanel

Left = 320

Top = 1

Width = 25

Height = 12

BevelOuter = bvNone

ParentColor = True

TabOrder = 0

object SpeedButtonDown: TSpeedButton

Left = 3

Top = 1

Width = 9

Height = 9

Flat = True

Glyph.Data = {

DE000000424DDE00000000000000360000002800000007000000070000000100

180000000000A8000000C40E0000C40E00000000000000000000FFFFFFFFFFFF

FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000FFFFFFFFFFFFFFFFFF00FF00FFFF

FFFFFFFFFFFFFF000000FFFFFFFFFFFF00FF00FFFFFF00FF00FFFFFFFFFFFF00

0000FFFFFF00FF0000FF00FFFFFF00FF0000FF00FFFFFF00000000FF0000FF00

FFFFFFFFFFFFFFFFFF00FF0000FF00000000FFFFFFFFFFFFFFFFFFFFFFFFFFFF

FFFFFFFFFFFFFF000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF00

0000}

OnClick = SpeedButtonUpClick

end

object SpeedButtonClose: TSpeedButton

Left = 13

Top = 1

Width = 9

Height = 9

Flat = True

Glyph.Data = {

DE000000424DDE00000000000000360000002800000007000000070000000100

180000000000A8000000C40E0000C40E00000000000000000000FFFFFFFFFFFF

FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000FFFFFF00FF0000FF00FFFFFF00FF

0000FF00FFFFFF000000FFFFFFFFFFFF00FF00FFFFFF00FF00FFFFFFFFFFFF00

0000FFFFFFFFFFFFFFFFFF00FF00FFFFFFFFFFFFFFFFFF000000FFFFFFFFFFFF

00FF00FFFFFF00FF00FFFFFFFFFFFF000000FFFFFF00FF0000FF00FFFFFF00FF

0000FF00FFFFFF000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF00

0000}

OnClick = SpeedButtonCloseClick

end

object SpeedButtonUp: TSpeedButton

Left = 3

Top = 1

Width = 9

Height = 9

Flat = True

Glyph.Data = {

DE000000424DDE00000000000000360000002800000007000000070000000100

180000000000A8000000C40E0000C40E00000000000000000000FFFFFFFFFFFF

FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000FFFFFFFFFFFFFFFFFFFFFFFFFFFF

FFFFFFFFFFFFFF00000000FF0000FF00FFFFFFFFFFFFFFFFFF00FF0000FF0000

0000FFFFFF00FF0000FF00FFFFFF00FF0000FF00FFFFFF000000FFFFFFFFFFFF

00FF00FFFFFF00FF00FFFFFFFFFFFF000000FFFFFFFFFFFFFFFFFF00FF00FFFF

FFFFFFFFFFFFFF000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF00

0000}

OnClick = SpeedButtonUpClick

end

object MemoNote: TMemo

Left = 4

Top = 17

Width = 349

Height = 64

BevelInner = bvNone

BevelOuter = bvNone

BorderStyle = bsNone

Lines.Strings = (

'MemoNote')

TabOrder = 1

end

object PanelMenu: TPanel

Left = 2

Top = 1

Width = 14

Height = 12

BevelOuter = bvNone

ParentColor = True

TabOrder = 2

object SpeedButtonMenu: TSpeedButton

Left = 3

Top = 2

Width = 9

Height = 9

Flat = True

Glyph.Data = {

DE000000424DDE00000000000000360000002800000007000000070000000100

180000000000A8000000C40E0000C40E00000000000000000000FFFFFFFFFFFF

FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF00000000FF0000FF0000FF0000FF0000FF

0000FF0000FF0000000000FF00FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF00FF0000

000000FF0000FF0000FF0000FF0000FF0000FF0000FF0000000000FF00FFFFFF

FFFFFFFFFFFFFFFFFFFFFFFF00FF0000000000FF0000FF0000FF0000FF0000FF

0000FF0000FF00000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF00

0000}

OnClick = SpeedButtonMenuClick

end

object PopupMenuOne: TPopupMenu

Left = 160

Top = 16

object MenuItemAbout: TMenuItem

Caption = 'About'

OnClick = MenuItemAboutClick

end

object MenuItemSave: TMenuItem

Caption = 'Save'

OnClick = MenuItemSaveClick

end

object MenuItemLoad: TMenuItem

Caption = 'Load'

OnClick = MenuItemLoadClick

end

object SaveDialogOne: TSaveDialog

Filter = 'Text files(*.txt)files(*.*)

Left = 188

Top = 16

end

object OpenDialogOne: TOpenDialog

Filter = 'Text files(*.txt)files(*.*)

Left = 216

Top = 16

end

///DPR文件

//dpr

program MagnetismApp;

uses

Forms,

Windows,

MagnetismUnit in 'MagnetismUnit.pas' {FormMagnetism};

{$R *.res}

begin

Application.Initialize;

Application.CreateForm(TFormMagnetism, FormMagnetism);

Application.Run;

end.

Step.1 打开记事本

Step.2 Copy//pas//另存为"MagnetismUnit.pas"

Step.3 Copy//dfm//另存为"MagnetismUnit.dfm"

Step.4 Copy//dpr//另存为"MagnetismApp.dpr"

Strp.5 Open//"MagnetismApp.dpr"