home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / kolekce / d6 / RX275D6.ZIP / Units / RXSPLIT.PAS < prev    next >
Pascal/Delphi Source File  |  1999-10-12  |  17KB  |  565 lines
  1. {*******************************************************}
  2. {                                                       }
  3. {         Delphi VCL Extensions (RX)                    }
  4. {                                                       }
  5. {         Copyright (c) 1995, 1996 AO ROSNO             }
  6. {         Copyright (c) 1997 Master-Bank                }
  7. {                                                       }
  8. {*******************************************************}
  9.  
  10. unit RXSplit;
  11.  
  12. interface
  13.  
  14. {$I RX.INC}
  15.  
  16. uses Classes, {$IFDEF WIN32} Windows, {$ELSE} WinTypes, WinProcs, {$ENDIF}
  17.   Controls, ExtCtrls, Forms, Graphics, VCLUtils;
  18.  
  19. type
  20.  
  21. { TRxSplitter }
  22.  
  23.   TSplitterStyle = (spUnknown, spHorizontalFirst, spHorizontalSecond,
  24.     spVerticalFirst, spVerticalSecond);
  25.   TInverseMode = (imNew, imClear, imMove);
  26.   TSplitterMoveEvent = procedure (Sender: TObject; X, Y: Integer;
  27.     var AllowChange: Boolean) of object;
  28.  
  29.   TRxSplitter = class(TCustomPanel)
  30.   private
  31.     FControlFirst: TControl;
  32.     FControlSecond: TControl;
  33.     FSizing: Boolean;
  34.     FStyle: TSplitterStyle;
  35.     FPrevOrg: TPoint;
  36.     FOffset: TPoint;
  37.     FNoDropCursor: Boolean;
  38.     FLimitRect: TRect;
  39.     FTopLeftLimit: Integer;
  40.     FBottomRightLimit: Integer;
  41.     FForm: TCustomForm;
  42.     FActiveControl: TWinControl;
  43.     FAppShowHint: Boolean;
  44.     FOldKeyDown: TKeyEvent;
  45.     FOnPosChanged: TNotifyEvent;
  46.     FOnPosChanging: TSplitterMoveEvent;
  47.     function FindControl: TControl;
  48.     procedure ControlKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
  49.     procedure StartInverseRect;
  50.     procedure EndInverseRect(X, Y: Integer; AllowChange, Apply: Boolean);
  51.     function GetAlign: TAlign;
  52.     procedure MoveInverseRect(X, Y: Integer; AllowChange: Boolean);
  53.     procedure ShowInverseRect(X, Y: Integer; Mode: TInverseMode);
  54.     procedure DrawSizingLine(Split: TPoint);
  55.     function GetStyle: TSplitterStyle;
  56.     function GetCursor: TCursor;
  57.     procedure SetControlFirst(Value: TControl);
  58.     procedure SetControlSecond(Value: TControl);
  59.     procedure SetAlign(Value: TAlign);
  60.     procedure StopSizing(X, Y: Integer; Apply: Boolean);
  61.     procedure CheckPosition(var X, Y: Integer);
  62.     procedure ReadOffset(Reader: TReader);
  63.     procedure WriteOffset(Writer: TWriter);
  64.   protected
  65.     procedure DefineProperties(Filer: TFiler); override;
  66.     procedure Loaded; override;
  67.     procedure Notification(AComponent: TComponent; AOperation: TOperation); override;
  68.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
  69.       X, Y: Integer); override;
  70.     procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
  71.     procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
  72.       X, Y: Integer); override;
  73.     procedure Changed; dynamic;
  74.     procedure Changing(X, Y: Integer; var AllowChange: Boolean); dynamic;
  75.   public
  76.     constructor Create(AOwner: TComponent); override;
  77.     procedure UpdateState;
  78.   published
  79.     property ControlFirst: TControl read FControlFirst write SetControlFirst;
  80.     property ControlSecond: TControl read FControlSecond write SetControlSecond;
  81.     property Align: TAlign read GetAlign write SetAlign default alNone;
  82. {$IFDEF RX_D4}
  83.     property Constraints;
  84. {$ENDIF}
  85.     property BevelInner;
  86.     property BevelOuter;
  87.     property BevelWidth;
  88.     property BorderStyle;
  89.     property Enabled;
  90.     property Color;
  91.     property Ctl3D {$IFDEF WIN32} default False {$ENDIF};
  92.     property Cursor read GetCursor stored False;
  93.     property TopLeftLimit: Integer read FTopLeftLimit write FTopLeftLimit default 20;
  94.     property BottomRightLimit: Integer read FBottomRightLimit write FBottomRightLimit default 20;
  95.     property ParentColor;
  96.     property ParentCtl3D default False;
  97.     property ParentShowHint;
  98.     property ShowHint;
  99.     property Visible;
  100.     property OnPosChanged: TNotifyEvent read FOnPosChanged write FOnPosChanged;
  101.     property OnPosChanging: TSplitterMoveEvent read FOnPosChanging write FOnPosChanging;
  102.     property OnClick;
  103.     property OnDblClick;
  104.     property OnEnter;
  105.     property OnExit;
  106.     property OnMouseDown;
  107.     property OnMouseMove;
  108.     property OnMouseUp;
  109.     property OnResize;
  110.   end;
  111.  
  112. implementation
  113.  
  114. uses SysUtils;
  115.  
  116. const
  117.   InverseThickness = 2;
  118.   DefWidth = 3;
  119.  
  120. function CToC(C1, C2: TControl; P: TPoint): TPoint;
  121. begin
  122.   Result := C1.ScreenToClient(C2.ClientToScreen(P));
  123. end;
  124.  
  125. type
  126.   THack = class(TWinControl);
  127.  
  128. { TRxSplitter }
  129.  
  130. constructor TRxSplitter.Create(AOwner: TComponent);
  131. begin
  132.   inherited Create(AOwner);
  133.   ControlStyle := [csAcceptsControls, csCaptureMouse, csClickEvents,
  134.     csOpaque, csDoubleClicks];
  135.   Width := 185;
  136.   Height := DefWidth;
  137.   FSizing := False;
  138.   FTopLeftLimit := 20;
  139.   FBottomRightLimit := 20;
  140.   FControlFirst := nil;
  141.   FControlSecond := nil;
  142.   ParentCtl3D := False;
  143. {$IFDEF WIN32}
  144.   Ctl3D := False;
  145. {$ENDIF}
  146. end;
  147.  
  148. procedure TRxSplitter.Loaded;
  149. begin
  150.   inherited Loaded;
  151.   UpdateState;
  152. end;
  153.  
  154. procedure TRxSplitter.DefineProperties(Filer: TFiler); { for backward compatibility }
  155. begin
  156.   inherited DefineProperties(Filer);
  157.   Filer.DefineProperty('LimitOffset', ReadOffset, WriteOffset, False);
  158. end;
  159.  
  160. procedure TRxSplitter.ReadOffset(Reader: TReader);
  161. var
  162.   I: Integer;
  163. begin
  164.   I := Reader.ReadInteger;
  165.   FTopLeftLimit := I;
  166.   FBottomRightLimit := I;
  167. end;
  168.  
  169. procedure TRxSplitter.WriteOffset(Writer: TWriter);
  170. begin
  171.   Writer.WriteInteger(FTopLeftLimit);
  172. end;
  173.  
  174. procedure TRxSplitter.UpdateState;
  175. begin
  176.   inherited Cursor := Cursor;
  177. end;
  178.  
  179. function TRxSplitter.FindControl: TControl;
  180. var
  181.   P: TPoint;
  182.   I: Integer;
  183. begin
  184.   Result := nil;
  185.   P := Point(Left, Top);
  186.   case Align of
  187.     alLeft: Dec(P.X);
  188.     alRight: Inc(P.X, Width);
  189.     alTop: Dec(P.Y);
  190.     alBottom: Inc(P.Y, Height);
  191.     else Exit;
  192.   end;
  193.   for I := 0 to Parent.ControlCount - 1 do begin
  194.     Result := Parent.Controls[I];
  195.     if PtInRect(Result.BoundsRect, P) then Exit;
  196.   end;
  197.   Result := nil;
  198. end;
  199.  
  200. procedure TRxSplitter.CheckPosition(var X, Y: Integer);
  201. begin
  202.   if X - FOffset.X < FLimitRect.Left then
  203.     X := FLimitRect.Left + FOffset.X
  204.   else if X - FOffset.X + Width > FLimitRect.Right then
  205.     X := FLimitRect.Right - Width + FOffset.X;
  206.   if Y - FOffset.Y < FLimitRect.Top then
  207.     Y := FLimitRect.Top + FOffset.Y
  208.   else if Y - FOffset.Y + Height > FLimitRect.Bottom then
  209.     Y := FLimitRect.Bottom + FOffset.Y - Height;
  210. end;
  211.  
  212. procedure TRxSplitter.StartInverseRect;
  213. var
  214.   R: TRect;
  215.   W: Integer;
  216. begin
  217.   if Parent = nil then Exit;
  218.   R := Parent.ClientRect;
  219.   FLimitRect.TopLeft := CToC(Self, Parent, Point(R.Left + FTopLeftLimit,
  220.     R.Top + FTopLeftLimit));
  221.   FLimitRect.BottomRight := CToC(Self, Parent, Point(R.Right - R.Left -
  222.     FBottomRightLimit, R.Bottom - R.Top - FBottomRightLimit));
  223.   FNoDropCursor := False;
  224.   FForm := ValidParentForm(Self);
  225.   FForm.Canvas.Handle := GetDCEx(FForm.Handle, 0, DCX_CACHE or DCX_CLIPSIBLINGS
  226.     or DCX_LOCKWINDOWUPDATE);
  227.   with FForm.Canvas do begin
  228.     Pen.Color := clWhite;
  229.     if FStyle in [spHorizontalFirst, spHorizontalSecond] then W := Height
  230.     else W := Width;
  231.     if W > InverseThickness + 1 then W := W - InverseThickness
  232.     else W := InverseThickness;
  233.     Pen.Width := W;
  234.     Pen.Mode := pmXOR;
  235.   end;
  236.   ShowInverseRect(Width div 2, Height div 2, imNew);
  237. end;
  238.  
  239. procedure TRxSplitter.EndInverseRect(X, Y: Integer; AllowChange,
  240.   Apply: Boolean);
  241. const
  242.   DecSize = 3;
  243. var
  244.   NewSize: Integer;
  245.   Rect: TRect;
  246.   W, H: Integer;
  247.   DC: HDC;
  248.   P: TPoint;
  249. begin
  250.   if FForm <> nil then begin
  251.     ShowInverseRect(0, 0, imClear);
  252.     with FForm do begin
  253.       DC := Canvas.Handle;
  254.       Canvas.Handle := 0;
  255.       ReleaseDC(Handle, DC);
  256.     end;
  257.     FForm := nil;
  258.   end;
  259.   FNoDropCursor := False;
  260.   if Parent = nil then Exit;
  261.   Rect := Parent.ClientRect;
  262.   H := Rect.Bottom - Rect.Top - Height;
  263.   W := Rect.Right - Rect.Left - Width;
  264.   if not AllowChange then begin
  265.     P := ScreenToClient(FPrevOrg);
  266.     X := P.X + FOffset.X - Width div 2;
  267.     Y := P.Y + FOffset.Y - Height div 2
  268.   end;
  269.   if not Apply then Exit;
  270.   CheckPosition(X, Y);
  271.   if (ControlFirst.Align = alRight) or
  272.     ((ControlSecond <> nil) and (ControlSecond.Align = alRight)) then
  273.   begin
  274.     X := -X;
  275.     FOffset.X := -FOffset.X;
  276.   end;
  277.   if (ControlFirst.Align = alBottom) or
  278.     ((ControlSecond <> nil) and (ControlSecond.Align = alBottom)) then
  279.   begin
  280.     Y := -Y;
  281.     FOffset.Y := -FOffset.Y;
  282.   end;
  283.   Parent.DisableAlign;
  284.   try
  285.     if FStyle = spHorizontalFirst then begin
  286.       NewSize := ControlFirst.Height + Y - FOffset.Y;
  287.       if NewSize <= 0 then NewSize := 1;
  288.       if NewSize >= H then NewSize := H - DecSize;
  289.       ControlFirst.Height := NewSize;
  290.     end
  291.     else if FStyle = spHorizontalSecond then begin
  292.       NewSize := ControlSecond.Height + Y - FOffset.Y;
  293.       if NewSize <= 0 then NewSize := 1;
  294.       if NewSize >= H then NewSize := H - DecSize;
  295.       ControlSecond.Height := NewSize;
  296.     end
  297.     else if FStyle = spVerticalFirst then begin
  298.       NewSize := ControlFirst.Width + X - FOffset.X;
  299.       if NewSize <= 0 then NewSize := 1;
  300.       if NewSize >= W then NewSize := W - DecSize;
  301.       ControlFirst.Width := NewSize;
  302.     end
  303.     else if FStyle = spVerticalSecond then begin
  304.       NewSize := ControlSecond.Width + X - FOffset.X;
  305.       if NewSize <= 0 then NewSize := 1;
  306.       if NewSize >= W then NewSize := W - DecSize;
  307.       ControlSecond.Width := NewSize;
  308.     end;
  309.   finally
  310.     Parent.EnableAlign;
  311.   end;
  312. end;
  313.  
  314. procedure TRxSplitter.MoveInverseRect(X, Y: Integer; AllowChange: Boolean);
  315. var
  316.   P: TPoint;
  317.   NoDrop: Boolean;
  318. begin
  319.   if not AllowChange then begin
  320.     SetCursor(Screen.Cursors[crNoDrop]);
  321.     Exit;
  322.   end;
  323.   P := Point(X, Y);
  324.   CheckPosition(X, Y);
  325.   NoDrop := not AllowChange or (((X <> P.X) and (FStyle in [spVerticalFirst,
  326.     spVerticalSecond])) or ((Y <> P.Y) and (FStyle in [spHorizontalFirst,
  327.     spHorizontalSecond])));
  328.   if NoDrop <> FNoDropCursor then begin
  329.     FNoDropCursor := NoDrop;
  330.     if NoDrop then SetCursor(Screen.Cursors[crNoDrop])
  331.     else SetCursor(Screen.Cursors[Cursor]);
  332.   end;
  333.   ShowInverseRect(X - FOffset.X + Width div 2, Y - FOffset.Y + Height div 2,
  334.     imMove);
  335. end;
  336.  
  337. procedure TRxSplitter.ShowInverseRect(X, Y: Integer; Mode: TInverseMode);
  338. var
  339.   P: TPoint;
  340.   MaxRect: TRect;
  341.   Horiz: Boolean;
  342. begin
  343.   P := Point(0, 0);
  344.   if FStyle in [spHorizontalFirst, spHorizontalSecond] then begin
  345.     P.Y := Y;
  346.     Horiz := True;
  347.   end
  348.   else begin
  349.     P.X := X;
  350.     Horiz := False;
  351.   end;
  352.   MaxRect := Parent.ClientRect;
  353.   P := ClientToScreen(P);
  354.   with P, MaxRect do begin
  355.     TopLeft := Parent.ClientToScreen(TopLeft);
  356.     BottomRight := Parent.ClientToScreen(BottomRight);
  357.     if X < Left then X := Left;
  358.     if X > Right then X := Right;
  359.     if Y < Top then Y := Top;
  360.     if Y > Bottom then Y := Bottom;
  361.   end;
  362.   if (Mode = imMove) then
  363.     if ((P.X = FPrevOrg.X) and not Horiz) or
  364.       ((P.Y = FPrevOrg.Y) and Horiz) then Exit;
  365.   if Mode in [imClear, imMove] then
  366.     DrawSizingLine(FPrevOrg);
  367.   if Mode in [imNew, imMove] then begin
  368.     DrawSizingLine(P);
  369.     FPrevOrg := P;
  370.   end;
  371. end;
  372.  
  373. procedure TRxSplitter.DrawSizingLine(Split: TPoint);
  374. var
  375.   P: TPoint;
  376. begin
  377.   if FForm <> nil then begin
  378.     P := FForm.ScreenToClient(Split);
  379.     with FForm.Canvas do begin
  380.       MoveTo(P.X, P.Y);
  381.       if FStyle in [spHorizontalFirst, spHorizontalSecond] then
  382.         LineTo(CToC(FForm, Self, Point(Width, 0)).X, P.Y)
  383.       else LineTo(P.X, CToC(FForm, Self, Point(0, Height)).Y);
  384.     end;
  385.   end;
  386. end;
  387.  
  388. function TRxSplitter.GetStyle: TSplitterStyle;
  389. begin
  390.   Result := spUnknown;
  391.   if ControlFirst <> nil then begin
  392.     if ((ControlFirst.Align = alTop) and ((ControlSecond = nil) or
  393.        (ControlSecond.Align = alClient))) or
  394.        ((ControlFirst.Align = alBottom) and ((ControlSecond = nil) or
  395.        (ControlSecond.Align = alClient))) then
  396.       Result := spHorizontalFirst
  397.     else if ((ControlFirst.Align = alClient) and (ControlSecond <> nil) and
  398.        (ControlSecond.Align = alBottom)) or
  399.        ((ControlFirst.Align = alClient) and (ControlSecond <> nil) and
  400.        (ControlSecond.Align = alTop)) then
  401.       Result := spHorizontalSecond
  402.     else if ((ControlFirst.Align = alLeft) and ((ControlSecond = nil) or
  403.        (ControlSecond.Align = alClient))) or
  404.        ((ControlFirst.Align = alRight) and ((ControlSecond = nil) or
  405.        (ControlSecond.Align = alClient))) then
  406.       Result := spVerticalFirst
  407.     else if ((ControlFirst.Align = alClient) and (ControlSecond <> nil) and
  408.        (ControlSecond.Align = alRight)) or
  409.        ((ControlFirst.Align = alClient) and (ControlSecond <> nil) and
  410.        (ControlSecond.Align = alLeft)) then
  411.       Result := spVerticalSecond;
  412.     case Result of
  413.       spHorizontalFirst, spVerticalFirst:
  414.         if Align <> FControlFirst.Align then Result := spUnknown;
  415.       spHorizontalSecond, spVerticalSecond:
  416.         if Align <> FControlSecond.Align then Result := spUnknown;
  417.     end;
  418.   end;
  419. end;
  420.  
  421. procedure TRxSplitter.SetAlign(Value: TAlign);
  422. begin
  423.   if not (Align in [alTop, alBottom, alLeft, alRight]) then begin
  424.     inherited Align := Value;
  425.     if not (csReading in ComponentState) then begin
  426.       if Value in [alTop, alBottom] then Height := DefWidth
  427.       else if Value in [alLeft, alRight] then Width := DefWidth;
  428.     end;
  429.   end
  430.   else inherited Align := Value;
  431.   if (ControlFirst = nil) and (ControlSecond = nil) then
  432.     ControlFirst := FindControl;
  433. end;
  434.  
  435. function TRxSplitter.GetAlign: TAlign;
  436. begin
  437.   Result := inherited Align;
  438. end;
  439.  
  440. function TRxSplitter.GetCursor: TCursor;
  441. begin
  442.   Result := crDefault;
  443.   case GetStyle of
  444.     spHorizontalFirst, spHorizontalSecond: Result := crVSplit;
  445.     spVerticalFirst, spVerticalSecond: Result := crHSplit;
  446.   end;
  447. end;
  448.  
  449. procedure TRxSplitter.SetControlFirst(Value: TControl);
  450. begin
  451.   if Value <> FControlFirst then begin
  452.     if (Value = Self) or (Value is TForm) then FControlFirst := nil
  453.     else begin
  454.       FControlFirst := Value;
  455. {$IFDEF WIN32}
  456.       if Value <> nil then Value.FreeNotification(Self);
  457. {$ENDIF}
  458.     end;
  459.     UpdateState;
  460.   end;
  461. end;
  462.  
  463. procedure TRxSplitter.SetControlSecond(Value: TControl);
  464. begin
  465.   if Value <> FControlSecond then begin
  466.     if (Value = Self) or (Value is TForm) then FControlSecond := nil
  467.     else begin
  468.       FControlSecond := Value;
  469. {$IFDEF WIN32}
  470.       if Value <> nil then Value.FreeNotification(Self);
  471. {$ENDIF}
  472.     end;
  473.     UpdateState;
  474.   end;
  475. end;
  476.  
  477. procedure TRxSplitter.Notification(AComponent: TComponent; AOperation: TOperation);
  478. begin
  479.   inherited Notification(AComponent, AOperation);
  480.   if AOperation = opRemove then begin
  481.     if AComponent = ControlFirst then ControlFirst := nil
  482.     else if AComponent = ControlSecond then ControlSecond := nil;
  483.   end;
  484. end;
  485.  
  486. procedure TRxSplitter.Changed;
  487. begin
  488.   if Assigned(FOnPosChanged) then FOnPosChanged(Self);
  489. end;
  490.  
  491. procedure TRxSplitter.Changing(X, Y: Integer; var AllowChange: Boolean);
  492. begin
  493.   if Assigned(FOnPosChanging) then FOnPosChanging(Self, X, Y, AllowChange);
  494. end;
  495.  
  496. procedure TRxSplitter.StopSizing(X, Y: Integer; Apply: Boolean);
  497. var
  498.   AllowChange: Boolean;
  499. begin
  500.   if FSizing then begin
  501.     ReleaseCapture;
  502.     AllowChange := Apply;
  503.     if Apply then Changing(X, Y, AllowChange);
  504.     EndInverseRect(X, Y, AllowChange, Apply);
  505.     FSizing := False;
  506.     Application.ShowHint := FAppShowHint;
  507.     if Assigned(FActiveControl) then begin
  508.       THack(FActiveControl).OnKeyDown := FOldKeyDown;
  509.       FActiveControl := nil;
  510.     end;
  511.     if Apply then Changed;
  512.   end;
  513. end;
  514.  
  515. procedure TRxSplitter.ControlKeyDown(Sender: TObject; var Key: Word;
  516.   Shift: TShiftState);
  517. begin
  518.   if Key = VK_ESCAPE then StopSizing(0, 0, False)
  519.   else if Assigned(FOldKeyDown) then FOldKeyDown(Sender, Key, Shift);
  520. end;
  521.  
  522. procedure TRxSplitter.MouseDown(Button: TMouseButton; Shift: TShiftState;
  523.   X, Y: Integer);
  524. begin
  525.   inherited MouseDown(Button, Shift, X, Y);
  526.   if not (csDesigning in ComponentState) and (Button = mbLeft) then begin
  527.     FStyle := GetStyle;
  528.     if FStyle <> spUnknown then begin
  529.       FSizing := True;
  530.       FAppShowHint := Application.ShowHint;
  531.       SetCapture(Handle);
  532.       with ValidParentForm(Self) do begin
  533.         if ActiveControl <> nil then FActiveControl := ActiveControl
  534.         else FActiveControl := GetParentForm(Self);
  535.         FOldKeyDown := THack(FActiveControl).OnKeyDown;
  536.         THack(FActiveControl).OnKeyDown := ControlKeyDown;
  537.       end;
  538.       Application.ShowHint := False;
  539.       FOffset := Point(X, Y);
  540.       StartInverseRect;
  541.     end;
  542.   end;
  543. end;
  544.  
  545. procedure TRxSplitter.MouseMove(Shift: TShiftState; X, Y: Integer);
  546. var
  547.   AllowChange: Boolean;
  548. begin
  549.   inherited MouseMove(Shift, X, Y);
  550.   if (GetCapture = Handle) and FSizing then begin
  551.     AllowChange := True;
  552.     Changing(X, Y, AllowChange);
  553.     MoveInverseRect(X, Y, AllowChange);
  554.   end;
  555. end;
  556.  
  557. procedure TRxSplitter.MouseUp(Button: TMouseButton; Shift: TShiftState;
  558.   X, Y: Integer);
  559. begin
  560.   StopSizing(X, Y, True);
  561.   inherited MouseUp(Button, Shift, X, Y);
  562. end;
  563.  
  564. end.
  565.