Image+Rect

← →
Klim (2007-12-19 12:27) [0]

Есть форма, целиком состоящая из рисунков(bsNone), форма должна изменять свои размеры, если потянуть за нижний правый угол. Решил делать это следующим образом: пользователь "тянет" за угол- рисуется пунктирная рамочка (Rect), отпускает- форма меняет размер.
Делаю это следующим образом:
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin resiz:=true; DC := GetDC(0); Canvas_ := TCanvas.Create; Canvas_.Handle := DC; // mx:=mouse.CursorPos.X; my:=mouse.CursorPos.y; dx:=form1.Left+form1.Width-mx; dy:=form1.Top+form1.Height-my; // Rec:= Rect(Form1.Left,Form1.Top,mouse.CursorPos.X+dx,mouse.CursorPos.y+dy);// Rec_:=Rect(0,0,x+dx,y+dy); // Canvas_.DrawFocusRect(rec); //рисуем рамку // end; procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin fl:=form1.Left; ft:=form1.top; mx:=mouse.CursorPos.X; my:=mouse.CursorPos.y; if (resiz=true) then begin Canvas_.DrawFocusRect(rec); //стираем старую // if (mx+dx)-rec.Left>150 then //50 ограничение на минимум размера формы rec.Right:=mx+dx; // if (my+dy)-rec.Top>150 then rec.Bottom:=my+dy; Canvas_.DrawFocusRect(rec); // рисуем рамку на новом месте end; // end; procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if resiz then begin form1.Width:= rec.Right-rec.Left; form1.height:=rec.Bottom-rec.Top; end; // Canvas_.DrawFocusRect(rec); // рисуем рамку на новом месте, ракрашивая старую // resiz:=false; ReleaseDC(0, DC); Canvas_.Free; end;

Все работает замечательно, НО, когда TransparentColor формы в true, то рамка рисуется везде, кроме самой формы(если происходит уменьшение формы).
Что делать? Как быть?

← →
{RASkov} © (2007-12-19 14:35) [1]

> [0] Klim (19.12.07 12:27)

А попробуй вот такой примерно вариант:
function TForm1.MouseInRectSizing(const X, Y: Integer): Boolean; begin Result:=(X>ClientWidth-10) and (Y>ClientHeight-10); end; procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if not MouseInRectSizing(X, Y) then Exit; if Button=mbLeft then begin ReleaseCapture; Perform(WM_SYSCOMMAND, $F008, 0); end; end; procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin if MouseInRectSizing(X, Y) then Cursor:=crSizeNWSE else Cursor:=crDefault; end;

Или тебе необходимо рисвовать "фокусную рамку" и потом менять размер?

← →
Klim (2007-12-19 15:57) [2]

необходимо рисовать фокусную рамку

Image+Rect Найти похожие ветки