rxsplit.pas

灰鸽子1.23源码,,,,,,,

  Parent.DisableAlign;
  try
    if FStyle = spHorizontalFirst then begin
      NewSize := ControlFirst.Height + Y - FOffset.Y;
      if NewSize <= 0 then NewSize := 1;
      if NewSize >= H then NewSize := H - DecSize;
      ControlFirst.Height := NewSize;
    end
    else if FStyle = spHorizontalSecond then begin
      NewSize := ControlSecond.Height + Y - FOffset.Y;
      if NewSize <= 0 then NewSize := 1;
      if NewSize >= H then NewSize := H - DecSize;
      ControlSecond.Height := NewSize;
    end
    else if FStyle = spVerticalFirst then begin
      NewSize := ControlFirst.Width + X - FOffset.X;
      if NewSize <= 0 then NewSize := 1;
      if NewSize >= W then NewSize := W - DecSize;
      ControlFirst.Width := NewSize;
    end
    else if FStyle = spVerticalSecond then begin
      NewSize := ControlSecond.Width + X - FOffset.X;
      if NewSize <= 0 then NewSize := 1;
      if NewSize >= W then NewSize := W - DecSize;
      ControlSecond.Width := NewSize;
    end;
  finally
    Parent.EnableAlign;
  end;
end;

procedure TRxSplitter.MoveInverseRect(X, Y: Integer; AllowChange: Boolean);
var
  P: TPoint;
  NoDrop: Boolean;
begin
  if not AllowChange then begin
    SetCursor(Screen.Cursors[crNoDrop]);
    Exit;
  end;
  P := Point(X, Y);
  CheckPosition(X, Y);
  NoDrop := not AllowChange or (((X <> P.X) and (FStyle in [spVerticalFirst,
    spVerticalSecond])) or ((Y <> P.Y) and (FStyle in [spHorizontalFirst,
    spHorizontalSecond])));
  if NoDrop <> FNoDropCursor then begin
    FNoDropCursor := NoDrop;
    if NoDrop then SetCursor(Screen.Cursors[crNoDrop])
    else SetCursor(Screen.Cursors[Cursor]);
  end;
  ShowInverseRect(X - FOffset.X + Width div 2, Y - FOffset.Y + Height div 2,
    imMove);
end;

procedure TRxSplitter.ShowInverseRect(X, Y: Integer; Mode: TInverseMode);
var
  P: TPoint;
  MaxRect: TRect;
  Horiz: Boolean;
begin
  P := Point(0, 0);
  if FStyle in [spHorizontalFirst, spHorizontalSecond] then begin
    P.Y := Y;
    Horiz := True;
  end
  else begin
    P.X := X;
    Horiz := False;
  end;
  MaxRect := Parent.ClientRect;
  P := ClientToScreen(P);
  with P, MaxRect do begin
    TopLeft := Parent.ClientToScreen(TopLeft);
    BottomRight := Parent.ClientToScreen(BottomRight);
    if X < Left then X := Left;
    if X > Right then X := Right;
    if Y < Top then Y := Top;
    if Y > Bottom then Y := Bottom;
  end;
  if (Mode = imMove) then
    if ((P.X = FPrevOrg.X) and not Horiz) or
      ((P.Y = FPrevOrg.Y) and Horiz) then Exit;
  if Mode in [imClear, imMove] then
    DrawSizingLine(FPrevOrg);
  if Mode in [imNew, imMove] then begin
    DrawSizingLine(P);
    FPrevOrg := P;
  end;
end;

procedure TRxSplitter.DrawSizingLine(Split: TPoint);
var
  P: TPoint;
begin
  if FForm <> nil then begin
    P := FForm.ScreenToClient(Split);
    with FForm.Canvas do begin
      MoveTo(P.X, P.Y);
      if FStyle in [spHorizontalFirst, spHorizontalSecond] then
        LineTo(CToC(FForm, Self, Point(Width, 0)).X, P.Y)
      else LineTo(P.X, CToC(FForm, Self, Point(0, Height)).Y);
    end;
  end;
end;

function TRxSplitter.GetStyle: TSplitterStyle;
begin
  Result := spUnknown;
  if ControlFirst <> nil then begin
    if ((ControlFirst.Align = alTop) and ((ControlSecond = nil) or
       (ControlSecond.Align = alClient))) or
       ((ControlFirst.Align = alBottom) and ((ControlSecond = nil) or
       (ControlSecond.Align = alClient))) then
      Result := spHorizontalFirst
    else if ((ControlFirst.Align = alClient) and (ControlSecond <> nil) and
       (ControlSecond.Align = alBottom)) or
       ((ControlFirst.Align = alClient) and (ControlSecond <> nil) and
       (ControlSecond.Align = alTop)) then
      Result := spHorizontalSecond
    else if ((ControlFirst.Align = alLeft) and ((ControlSecond = nil) or
       (ControlSecond.Align = alClient))) or
       ((ControlFirst.Align = alRight) and ((ControlSecond = nil) or
       (ControlSecond.Align = alClient))) then
      Result := spVerticalFirst
    else if ((ControlFirst.Align = alClient) and (ControlSecond <> nil) and
       (ControlSecond.Align = alRight)) or
       ((ControlFirst.Align = alClient) and (ControlSecond <> nil) and
       (ControlSecond.Align = alLeft)) then
      Result := spVerticalSecond;
    case Result of
      spHorizontalFirst, spVerticalFirst:
        if Align <> FControlFirst.Align then Result := spUnknown;
      spHorizontalSecond, spVerticalSecond:
        if Align <> FControlSecond.Align then Result := spUnknown;
    end;
  end;
end;

procedure TRxSplitter.SetAlign(Value: TAlign);
begin
  if not (Align in [alTop, alBottom, alLeft, alRight]) then begin
    inherited Align := Value;
    if not (csReading in ComponentState) then begin
      if Value in [alTop, alBottom] then Height := DefWidth
      else if Value in [alLeft, alRight] then Width := DefWidth;
    end;
  end
  else inherited Align := Value;
  if (ControlFirst = nil) and (ControlSecond = nil) then
    ControlFirst := FindControl;
end;

function TRxSplitter.GetAlign: TAlign;
begin
  Result := inherited Align;
end;

function TRxSplitter.GetCursor: TCursor;
begin
  Result := crDefault;
  case GetStyle of
    spHorizontalFirst, spHorizontalSecond: Result := crVSplit;
    spVerticalFirst, spVerticalSecond: Result := crHSplit;
  end;
end;

procedure TRxSplitter.SetControlFirst(Value: TControl);
begin
  if Value <> FControlFirst then begin
    if (Value = Self) or (Value is TForm) then FControlFirst := nil
    else begin
      FControlFirst := Value;
{$IFDEF WIN32}
      if Value <> nil then Value.FreeNotification(Self);
{$ENDIF}
    end;
    UpdateState;
  end;
end;

procedure TRxSplitter.SetControlSecond(Value: TControl);
begin
  if Value <> FControlSecond then begin
    if (Value = Self) or (Value is TForm) then FControlSecond := nil
    else begin
      FControlSecond := Value;
{$IFDEF WIN32}
      if Value <> nil then Value.FreeNotification(Self);
{$ENDIF}
    end;
    UpdateState;
  end;
end;

procedure TRxSplitter.Notification(AComponent: TComponent; AOperation: TOperation);
begin
  inherited Notification(AComponent, AOperation);
  if AOperation = opRemove then begin
    if AComponent = ControlFirst then ControlFirst := nil
    else if AComponent = ControlSecond then ControlSecond := nil;
  end;
end;

procedure TRxSplitter.Changed;
begin
  if Assigned(FOnPosChanged) then FOnPosChanged(Self);
end;

procedure TRxSplitter.Changing(X, Y: Integer; var AllowChange: Boolean);
begin
  if Assigned(FOnPosChanging) then FOnPosChanging(Self, X, Y, AllowChange);
end;

procedure TRxSplitter.StopSizing(X, Y: Integer; Apply: Boolean);
var
  AllowChange: Boolean;
begin
  if FSizing then begin
    ReleaseCapture;
    AllowChange := Apply;
    if Apply then Changing(X, Y, AllowChange);
    EndInverseRect(X, Y, AllowChange, Apply);
    FSizing := False;
    Application.ShowHint := FAppShowHint;
    if Assigned(FActiveControl) then begin
      THack(FActiveControl).OnKeyDown := FOldKeyDown;
      FActiveControl := nil;
    end;
    if Apply then Changed;
  end;
end;

procedure TRxSplitter.ControlKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_ESCAPE then StopSizing(0, 0, False)
  else if Assigned(FOldKeyDown) then FOldKeyDown(Sender, Key, Shift);
end;

procedure TRxSplitter.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  inherited MouseDown(Button, Shift, X, Y);
  if not (csDesigning in ComponentState) and (Button = mbLeft) then begin
    FStyle := GetStyle;
    if FStyle <> spUnknown then begin
      FSizing := True;
      FAppShowHint := Application.ShowHint;
      SetCapture(Handle);
      with ValidParentForm(Self) do begin
        if ActiveControl <> nil then FActiveControl := ActiveControl
        else FActiveControl := GetParentForm(Self);
        FOldKeyDown := THack(FActiveControl).OnKeyDown;
        THack(FActiveControl).OnKeyDown := ControlKeyDown;
      end;
      Application.ShowHint := False;
      FOffset := Point(X, Y);
      StartInverseRect;
    end;
  end;
end;

procedure TRxSplitter.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  AllowChange: Boolean;
begin
  inherited MouseMove(Shift, X, Y);
  if (GetCapture = Handle) and FSizing then begin
    AllowChange := True;
    Changing(X, Y, AllowChange);
    MoveInverseRect(X, Y, AllowChange);
  end;
end;

procedure TRxSplitter.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  StopSizing(X, Y, True);
  inherited MouseUp(Button, Shift, X, Y);
end;

end.