Среди готовых компонент я не увидел компонента, который бы позволял растягивать визуальный компонент за нижний правый угол. Поэтому пришлось искать и делать многое своими руками. А также с помощью форумчан. Данная тема очень хорошо описана здесь. Я повторил данный код и внес свои минимальные изменения под свою задачу. Огромное спасибо участнику volvo, который выложил основную часть кода.
Во время растягивания панель немного подергивается, но мне этот эффект понравился. Думаю, если нужно будет убрать этот эффект, можно поиграться с WMPaint.
Идея кода с форума в чем, при наведении на правый нижний угол и нажатии на левую кнопку мыши – запускается наш механизм. При отпускании – кнопки – действие нашего кода заканчивается. Но я немного доработал, положил на панель StatusBar, потому что там этот уголок уже нарисован (появляется при запуске программы) и в результате меньше работы. Итак, вот что у меня получилось.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 |
unit uMain; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.ComCtrls, Vcl.OleCtrls, WMPLib_TLB, Vcl.Buttons; type TfTestForm = class(TForm) pSizingPanel: TPanel; stbStatusBar: TStatusBar; pTopPanel: TPanel; WindowsMediaPlayer1: TWindowsMediaPlayer; sbCloseButton: TSpeedButton; procedure stbStatusBarMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure stbStatusBarMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure stbStatusBarMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure sbCloseButtonClick(Sender: TObject); procedure FormCreate(Sender: TObject); private MouseButtonDown, Sizing: Boolean; StartPosition, MousePosition: TPoint; MemoRect: TRect; public { Public declarations } end; var fTestForm: TfTestForm; implementation {$R *.dfm} procedure TfTestForm.FormCreate(Sender: TObject); begin sbCloseButton.Left:=pTopPanel.Width-30; end; procedure TfTestForm.sbCloseButtonClick(Sender: TObject); begin FreeAndNil(pSizingPanel); end; procedure TfTestForm.stbStatusBarMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin // if Button = mbLeft then begin StartPosition := Point(X, Y); MemoRect := pSizingPanel.BoundsRect; MouseButtonDown := True; end; end; procedure TfTestForm.stbStatusBarMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); var InnerRect: TRect; XOffset: Integer; YOffset: Integer; begin //Выделяем маленький квадратик в нижнем правом углу InnerRect := Bounds(stbStatusBar.Width - 20, stbStatusBar.Height - 20, 20, 20); MousePosition := Point(X, Y); if (PtInRect(InnerRect, MousePosition)) or Sizing then begin Cursor := crSizeNWSE; if MouseButtonDown then begin Sizing := True; XOffset := MousePosition.x - StartPosition.x; YOffset := MousePosition.y - StartPosition.y; StartPosition := MousePosition; Inc(MemoRect.Right, XOffset); Inc(MemoRect.Bottom, YOffset); pSizingPanel.BoundsRect := MemoRect; sbCloseButton.Left:=pTopPanel.Width-30; end; end else Cursor := crDefault; end; procedure TfTestForm.stbStatusBarMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin Cursor := crDefault; MouseButtonDown := False; Sizing := False; end; end. |
Думаю, на основе этого кода, можно создать свой компонент TMediaPanel.