type 
  TForm1 = class(TForm) 
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton; 
      Shift: TShiftState; X, Y: Integer); 
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton; 
      Shift: TShiftState; X, Y: Integer); 
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; 
      X, Y: Integer); 
    procedure FormCreate(Sender: TObject); 
    procedure FormDblClick(Sender: TObject); 
    procedure FormKeyDown(Sender: TObject; var Key: Word; 
      Shift: TShiftState); 
  private 
    r: TRect; 
    stelle: Byte; 
    dc, wdc: HDC; 
    p1, p2: TPoint; 
    bm, bm2: TBitmap; 
    ok, drin, isDown, isUp: Boolean; 
    diffw, diffs, px, py, links, oben, mw, mh: Integer; 
  public 
    procedure WMNChittest(var aMsg: TWMNChittest); message WM_NChittest; 
    procedure Zeichnen; 
    procedure Zurueck; 
  end; 
 
var 
  Form1: TForm1; 
  AERO: Boolean = TRUE; 
 
implementation 
 
{$R *.DFM} 
{$R xpstyle.res} 
 
const 
  a = 7; 
  pw = 3; 
  ap = a + pw; 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  mw := Width; 
  mh := Height; 
  isDown := FALSE; 
  isUp := FALSE; 
  ok := FALSE; 
end; 
 
procedure TForm1.Zeichnen; 
var ls, rs, x: Integer; 
begin 
  x := (r.right - r.Left) div 2; 
  case stelle of 
    1: begin 
        ls := r.Left; 
        rs := r.right; 
      end; 
    2: begin 
        ls := r.Left; 
        rs := x; 
      end; 
  else begin 
      ls := x; 
      rs := r.right; 
    end; 
  end; 
  wdc := GetWindowDC(Handle); 
  bm := TBitmap.create; 
  bm2 := TBitmap.create; 
  bm2.Width := Width; 
  bm2.Height := Height; 
  BitBlt(bm2.Canvas.Handle, 0, 0, Width, Height, wdc, 0, 0, srcCopy); 
  bm.Canvas.Brush.Style := bsClear; 
  bm.Canvas.Pen.Width := pw; 
  dc := CreateDC('DISPLAY', nil, nil, nil); 
  bm.Width := screen.Width; 
  bm.Height := screen.Height; 
  BitBlt(bm.Canvas.Handle, 0, 0, bm.Width, bm.Height, dc, 0, 0, srcCopy); 
  bm.Canvas.Pen.Color := $606060; 
  bm.Canvas.RoundRect(ls + ap, r.Top + ap, rs - a, 
    r.bottom - a, 12, 12); 
  bm.Canvas.Pen.Color := clWhite; 
  bm.Canvas.RoundRect(ls + a, r.Top + a, rs - ap, 
    r.bottom - ap, 12, 12); 
  BitBlt(dc, 0, 0, bm.Width, bm.Height, bm.Canvas.Handle, 0, 0, srcCopy); 
  BitBlt(wdc, 0, 0, Width, Height, bm2.Canvas.Handle, 0, 0, srcCopy); 
  bm.free; 
end; 
 
procedure TForm1.Zurueck; 
begin 
  Top := oben; 
  Left := links; 
  InvalidateRect(WindowFromDC(dc), nil, TRUE); 
  BitBlt(wdc, 0, 0, Width, Height, bm2.Canvas.Handle, 0, 0, srcCopy); 
  DeleteDC(dc); 
  DeleteDC(wdc); 
  bm2.free; 
  ok := FALSE; 
end; 
 
procedure TForm1.WMNChittest(var aMsg: TWMNChittest); 
begin 
  DefaultHandler(aMsg); 
  drin := (aMsg.Result = HTCAPTION) and AERO; 
  if drin then aMsg.Result := HTCLIENT; 
end; 
 
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; 
  Shift: TShiftState; X, Y: Integer); 
begin 
  if AERO and drin and (Button = mbLeft) and (WindowState = wsNormal) 
    then begin 
    GetCursorPos(p1); 
    diffw := p1.x - Left; 
    diffs := p1.y - Top; 
    isDown := TRUE; 
    SystemParametersInfo(SPI_GETWORKAREA, 0, @r, 0); 
  end; 
 
end; 
 
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton; 
  Shift: TShiftState; X, Y: Integer); 
begin 
  if isDown then begin 
    isDown := FALSE; 
    x := (r.right - r.Left) div 2; 
    mw := Width; 
    mh := Height; 
    isUp := TRUE; 
    case stelle of 
      1: SetBounds(r.Left, r.Top, r.right, r.bottom); 
      2: SetBounds(r.Left, r.Top, x, r.bottom); 
      3: SetBounds(x, r.Top, x, r.bottom); 
    end; 
  end; 
 
end; 
 
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; 
  X, Y: Integer); 
begin 
  if isDown then begin 
    GetCursorPos(p2); 
    if p2.y <= r.Top then stelle := 1 else 
      if p2.x <= r.Left then stelle := 2 else 
        if p2.x >= r.right - 1 then stelle := 3 else 
          stelle := 0; 
    if stelle > 0 then begin 
      isUp := FALSE; 
      oben := Top; 
      links := Left; 
      if not ok then begin 
        px := p2.x; 
        py := p2.y; 
        ok := TRUE; 
        Zeichnen; 
      end; 
      case stelle of 
        1: SetCursorPos(px, r.Top); 
        2: SetCursorPos(r.Left, py); 
        3: SetCursorPos(r.right, py); 
      end; 
    end else begin 
      if ok then begin 
        Width := mw; 
        Height := mh; 
        if isUp then begin 
          ok := FALSE; 
          y := mw div 2; 
          if p2.x > y then 
            diffw := mw div 2; 
        end else 
          Zurueck; 
      end; 
      SetBounds(p2.x - diffw, p2.y - diffs, Width, Height); 
    end; 
  end; 
 
end; 
 
procedure TForm1.FormDblClick(Sender: TObject); 
begin 
  if drin and (biMaximize in BorderIcons) then begin 
    if WindowState = wsNormal then WindowState := wsMaximized 
    else WindowState := wsNormal; 
  end; 
 
end; 
 
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; 
  Shift: TShiftState); 
var x: integer; 
  function IsKeyDown(Key: Integer): Boolean; 
  begin 
    Result := HiWord(DWord(GetKeyState(Key))) <> 0; 
  end; 
  procedure build; 
  begin 
    if not isup then begin 
      mw := Width; 
      mh := Height; 
    end; 
    ok := true; 
    isup := true; 
  end; 
begin 
  if AERO and (iskeydown(91) or iskeydown(92)) then begin 
    SystemParametersInfo(SPI_GETWORKAREA, 0, @r, 0); 
    x := (r.right - r.left) div 2; 
    case key of 
      VK_UP: begin build; SetBounds(r.Left, r.Top, r.right, r.bottom); end; 
      VK_LEFT: begin build; SetBounds(r.Left, r.Top, x, r.bottom); end; 
      VK_RIGHT: begin build; SetBounds(x, r.Top, x, r.bottom); end; 
    end; 
  end; 
 
end;