handles.pas

详细说明:毕业论文中关于小型宾馆管理系统的详细设计毕 业论文中关于小型宾馆...一个酒店管理系统VB+Access [学生学籍管理系统(VB+Acess).zip] - !这个是刚刚编的毕业设计,可能

                                       { Handles stay in front of everything, always }
      inherited BringToFront;
      if Visible and Enabled then
        SetFocus;
    end;

end;

procedure TStretchHandle.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
                                       { only process MouseDown if it is over a Child, else forward }
  if PointOverChild(Point(Left + X, Top + Y)) then
    begin
      if (Button = mbLeft) and not FLocked then
        begin
          FDragOffset := Point(X, Y);
          FDragging := True;
        end;
      inherited MouseDown(Button, Shift, X, Y);
    end
  else
    begin
      Cursor := crDefault;
      SetCursor(Screen.Cursors[Cursor]);
      ForwardMessage(fmMouseDown, Button, Shift, Left + X, Top + Y);
    end;

end;

procedure TStretchHandle.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  ARect: TRect;
begin
                                       { resize, reposition if anything changed }
  if FDragging and (Button = mbLeft) then
    begin
                                       { disallow drop off Parent }
      if (Left + X) < 0 then
        X := -Left;
      if (Top + Y) < 0 then
        Y := -Top;
      if (Left + X) > Parent.Width then
        X := Parent.Width - Left;
      if (Top + Y) > Parent.Height then
        Y := Parent.Height - Top;
                                       { force Paint when size doesn't change but position does }
      if (X <> FDragOffset.X) or (Y <> FDragOffset.Y) then
        begin
          Invalidate;
          ARect := GetModifiedRect(X, Y);
          SetBounds(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);
        end;
                                       { clear drag outline }
      RubberBand(0, 0, False);
                                       { seem to need this for keyboard events }
      if Visible and Enabled then
        SetFocus;

      FDragging := False;
      Cursor := crDefault;
      ReleaseCapture;
                                       { perform default processing }
      { inherited MouseUp(Button, Shift, X, Y); Remove By Tom Lee }

    end
  else
    ForwardMessage(fmMouseUp, Button, Shift, Left + X, Top + Y);

   inherited MouseUp(Button, Shift, X, Y); { Modify By Tom Lee }
end;

procedure TStretchHandle.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  ARect: TRect;
  DragStyle: TDragStyle;
begin
                                       { this may be a move immediately on Attach instead of MouseDown }
  if (ssLeft in Shift) and not FDragging and not FLocked then
    begin
      FDragOffset := Point(X, Y);
      FDragging := True;
    end
                                       { only recognize move after simulated MouseDown }
  else
    begin
                                       { let's not hog mouse events unnecessarily } 
      if not (ssLeft in Shift) then
        ReleaseCapture;
                                       { default to drag cursor only when dragging }
      DragStyle := dsMove;
      Cursor := crDefault;
                                       { disallow resize if multiple children }
      if FChildList.Count = 1 then
        begin

          ARect := GetClientRect;
                                       { so I don't like long nested if statements... }
          if ((Abs(X - ARect.Left) < 5) and (Abs(Y - ARect.Top) < 5)) then
            begin
              DragStyle := dsSizeTopLeft;
              Cursor := crSizeNWSE;
            end;

          if ((Abs(X - ARect.Right) < 5) and (Abs(Y - ARect.Bottom) < 5)) then
            begin
              DragStyle := dsSizeBottomRight;
              Cursor := crSizeNWSE;
            end;

          if ((Abs(X - ARect.Right) < 5) and (Abs(Y - ARect.Top) < 5)) then
            begin
              DragStyle := dsSizeTopRight;
              Cursor := crSizeNESW;
            end;

          if ((Abs(X - ARect.Left) < 5) and (Abs(Y - ARect.Bottom) < 5)) then
            begin
              DragStyle := dsSizeBottomLeft;
              Cursor := crSizeNESW;
            end;

          if ((Abs(X - trunc(ARect.Right - ARect.Left) / 2) < 3) and (Abs(Y - ARect.Top) < 5)) then
            begin
              DragStyle := dsSizeTop;
              Cursor := crSizeNS;
            end;

          if ((Abs(X - trunc(ARect.Right - ARect.Left) / 2) < 3) and (Abs(Y - ARect.Bottom) < 5)) then
            begin
              DragStyle := dsSizeBottom;
              Cursor := crSizeNS;
            end;

          if ((Abs(Y - trunc(ARect.Bottom - ARect.Top) / 2) < 3) and (Abs(X - ARect.Left) < 5)) then
            begin
              DragStyle := dsSizeLeft;
              Cursor := crSizeWE;
            end;

          if ((Abs(Y - trunc(ARect.Bottom - ARect.Top) / 2) < 3) and (Abs(X - ARect.Right) < 5)) then
            begin
              DragStyle := dsSizeRight;
              Cursor := crSizeWE;
            end;

        end;
                                       { if position-locked, override cursor change }
      if FLocked then
        Cursor := crNoDrop;

      if FDragging then
        begin
                                       { disallow drag off Parent }
          if (Left + X) < 0 then
            X := -Left;
          if (Top + Y) < 0 then
            Y := -Top;
          if (Left + X) > Parent.Width then
            X := Parent.Width - Left;
          if (Top + Y) > Parent.Height then
            Y := Parent.Height - Top;
                                       { display cursor & drag outline }
          if FDragStyle = dsMove then
            Cursor := DragCursor;
          SetCursor(Screen.Cursors[Cursor]);
          RubberBand(X, Y, True);

        end
      else
        FDragStyle := DragStyle;

  end;
                                       { perform default processing }
  inherited MouseMove(Shift, X, Y);

end;

procedure TStretchHandle.ForwardMessage(FwdMsg: TForwardMessage; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  i: integer;
  Found: boolean;
  Msg: Word;
  ARect: TRect;
  AControl: TControl;
  AMessage: TMessage;
begin
                                       { construct the message to be sent }
  case FwdMsg of
    fmMouseDown:
      case Button of
        mbLeft:
          Msg := WM_LBUTTONDOWN;
        mbMiddle:
          Msg := WM_MBUTTONDOWN;
        mbRight:
          Msg := WM_RBUTTONDOWN;
      end;
    fmMouseUp:
      case Button of
        mbLeft:
          Msg := WM_LBUTTONUP;
        mbMiddle:
          Msg := WM_MBUTTONUP;
        mbRight:
          Msg := WM_RBUTTONUP;
      end;
  end;

  AMessage.WParam := 0;
                                       { determine whether X, Y is over any other windowed control }
  Found := False;
  for i := 0 to Parent.ControlCount - 1 do
    begin
      AControl := TControl(Parent.Controls[i]);
      if (AControl is TWinControl) and not (AControl is TStretchHandle) then
        begin
          ARect := Rect(AControl.Left,
                        AControl.Top,
                        AControl.Left + AControl.Width,
                        AControl.Top + AControl.Height);
                                        { X, Y are relative to Parent }
          if PtInRect(ARect, Point(X, Y)) then
            begin
              Found := True;
              break;
            end;
        end;
    end;
                                        { forward the message to the control if found, else to the Parent }
  if Found then
    begin
      AMessage.LParamLo := X - AControl.Left;
      AMessage.LParamHi := Y - AControl.Top;
      SendMessage(TWinControl(AControl).Handle, Msg, AMessage.WParam, AMessage.LParam);
    end
  else
    begin
      AMessage.LParamLo := X;
      AMessage.LParamHi := Y;
      SendMessage(Parent.Handle, Msg, AMessage.WParam, AMessage.LParam);
    end;

end;

procedure TStretchHandle.KeyDown(var Key: Word; Shift: TShiftState);
begin
                                       { process arrow keys to move/resize Handles & Child, also move siblings }
  case Key of
    VK_UP:
      begin
        Invalidate;
        SetBounds(Left, Top - 1, Width, Height);
      end;
    VK_DOWN:
      begin
        Invalidate;
        SetBounds(Left, Top + 1, Width, Height);
      end;
    VK_LEFT:
      begin
        Invalidate;
        SetBounds(Left - 1, Top, Width, Height);
      end;
    VK_RIGHT:
      begin
        Invalidate;
        SetBounds(Left + 1, Top, Width, Height);
      end;
  end;

  inherited KeyDown(Key, Shift);

end;

function TStretchHandle.GetModifiedRect(XPos, YPos: integer): TRect;
var
  ARect: TRect;
begin
                                       { compute new position/size, depending on FDragStyle}
  case FDragStyle of

    dsSizeTopLeft:
      begin
        ARect.Left := XGridAdjust(Left + (XPos - FDragOffset.X)) - 2;
        ARect.Top := YGridAdjust(Top + (YPos - FDragOffset.Y)) - 2;
        ARect.Right := Width - (ARect.Left - Left);
        ARect.Bottom := Height - (ARect.Top - Top);
      end;

    dsSizeTopRight:
      begin
        ARect.Left := Left;
        ARect.Top := YGridAdjust(Top + (YPos - FDragOffset.Y)) - 2;
        ARect.Right := XGridAdjust(Width + (XPos - FDragOffset.X)) - 3;
        ARect.Bottom := Height - (ARect.Top - Top);
      end;

    dsSizeBottomLeft:
      begin
        ARect.Left := XGridAdjust(Left + (XPos - FDragOffset.X)) - 2;
        ARect.Top := Top;
        ARect.Right := Width - (ARect.Left - Left);
        ARect.Bottom := YGridAdjust(Height + (YPos - FDragOffset.Y)) - 3;
      end;

    dsSizeBottomRight:
      begin
        ARect.Left := Left;
        ARect.Top := Top;
        ARect.Right := XGridAdjust(Width + (XPos - FDragOffset.X)) - 3;
        ARect.Bottom := YGridAdjust(Height + (YPos - FDragOffset.Y)) - 3;
      end;

    dsSizeTop:
      begin
        ARect.Left := Left;
        ARect.Top := YGridAdjust(Top + (YPos - FDragOffset.Y)) - 2;
        ARect.Right := Width;
        ARect.Bottom := Height - (ARect.Top - Top);
      end;