Form am Bildschirmrand andocken Problem

[turboPASCAL]

Zitat:

Es geht also nur über eine Komponente?

Nein, ist aber einfacher.

Die Komponente ist hier mit dabei: http://homepages.borland.com/jedi/jvcl/


Ein Formsnap to Screen ohne Komponente geht so:

Delphi-Quellcode:

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

type
  TMovingSide = wmsz_Left..wmsz_BottomRight;
  TMovingSides = set of TMovingSide;

  TWMMoving = record
    Msg: Cardinal;
    Side: TMovingSides;
    Rect: PRect;
    Result: Longint;
  end;

  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private-Deklarationen }
    FDockable: boolean;
    FSnapArea: integer;
    DispLeft, DispTop, DispRight, DispBottom: Integer;
    procedure WMEnterSizeMove(var Message: TMessage); message WM_ENTERSIZEMOVE;
    procedure WMMoving(var Message: TWMMoving); message WM_MOVING;
  public
    { Public-Deklarationen }
    property Dockable: boolean read FDockable write FDockable;
    property SnapArea: integer read FSnapArea write FSnapArea;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  SnapArea := 30;
  Dockable := True;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
end;

procedure TForm1.WMEnterSizeMove(var Message: TMessage);
begin
  if not Dockable then exit;
  DispLeft:=0;
  DispTop:=0;
  DispRight:=0;
  DispBottom:=0;
end;

procedure TForm1.WMMoving(var Message: TWMMoving);
var
  OfsX, OfsY: Integer;
  r: TRect;
begin
  if not Dockable then exit;
  SystemParametersInfo( SPI_GETWORKAREA, 0, @r, 0 );
  with Message.Rect^ do begin

    if Abs(DispLeft + Left - r.Left) < SnapArea then begin
      OfsX:=r.Left-Left;
      DispLeft:=DispLeft + Left-r.Left;
    end else begin
      OfsX:=DispLeft;
      DispLeft:=0;
    end;

    if Abs(DispRight+Right-r.Right)<SnapArea then begin
      OfsX:=r.Right-Right;
      DispRight:=DispRight+Right-r.Right;
    end else begin
      OfsX:=OfsX+DispRight;
      DispRight:=0;
    end;

    if Abs(DispTop+Top-r.Top)<SnapArea then begin
      OfsY:=r.Top-Top;
      DispTop:=DispTop+Top-r.Top;
    end else begin
      OfsY:=DispTop;
      DispTop:=0;
    end;

    if Abs(DispBottom+Bottom-r.Bottom)<SnapArea then begin
      OfsY:=r.Bottom-Bottom;
      DispBottom:=DispBottom+Bottom-r.Bottom;
    end else begin
      OfsY:=OfsY+DispBottom;
      DispBottom:=0;
    end;

  end;
  OffsetRect(Message.Rect^,OfsX,OfsY);
end; 

end.