Custom form - ręcznie rysowane okno

0

Muszę zrobić własny Form (przyciski systemowe, ramki itd). Zazwyczaj w takiej sytuacji po prostu ustawiałem styl obramowania (BorderStyle) na bsNone i normalnie rysowałem to co było mi potrzebne na pozostałym obszarze. Teraz jednak koniecznym jest, by użytkownik mógł zmieniać ręcznie rozmiar okna poprzez chwytanie za krawędź (tak jak w Windowsie). Niestety przy bsNone krawędzi brak, a więc nie ma za co złapać.

Moje pytanie - łatwiej będzie pracować na bsNone i dorobić jakoś możliwość łapania za krawędzie, czy też na normalnym oknie z krawędziami (bsSizable) i na nim rysować moją własną grafikę?

Zasadniczo wiem jak skutecznie zamazać całe okno własną grafiką (włącznie z paskiem tytułowym i krawędziami), jednak nie za bardzo wiem, jak zrobić własne przyciski systemowe. Próbowałem wrzucić na pasek tytułowy jakieś kontrolki ale nie wyszło.

Prosiłbym o wskazówki.

PS. Wiem, że istnieją różne komponenty i zestawy do zmiany wyglądu formy, ale zazwyczaj ich użycie (za darmo) wyklucza zastosowanie komercyjne, a poza tym chciałbym się jednak nauczyć zrobić to samodzielnie.

Pozdrawiam.

0

wydaje mi się, że własna zmiana rozmiaru będzie łatwiejsza

2

Ja też polecam ręczną obsługę rozciągania formy ze stylem bsNone, bo jest banalna; Wystarczy w zdarzeniu OnMouseMove sprawdzać pozycję kursora na formularzu i na jej podstawie określić typ kursora oraz dodatkowo komunikat dla typu operacji (przesuwanie, rozciąganie w odpowiednim kierunku lub brak operacji); Mając te dwie informację (wartość kursora oraz komunikatu), wystarczy w zdarzeniu OnMouseMove ustawić kursor np. poprzez Screen.Cursor, a w zdarzeniu OnMouseDown wysłać komunikat np. przez SendMessage;

Pobawiłem się chwilę i wymodziłem coś takiego:

type
  TMainForm = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure FormPaint(Sender: TObject);
  private
    FCurrentCursor: TCursor;
  private
    function CursorAtPoint(AX, AY: Integer): TCursor;
  end;

var
  MainForm: TMainForm;

implementation

{$R *.dfm}

const
  BORDER_WIDTH  = Integer(10);
  BORDER_HEIGHT = Integer(10);
  BAR_HEIGHT    = Integer(20);

function TMainForm.CursorAtPoint(AX, AY: Integer): TCursor;
begin
  if AY < BORDER_HEIGHT then
  begin
    if AX < BORDER_WIDTH then
      Result := crSizeNWSE
    else
      if AX >= Width - BORDER_WIDTH then
        Result := crSizeNESW
      else
        Result := crSizeNS;
  end
  else
    if AY >= Height - BORDER_HEIGHT then
    begin
      if AX < BORDER_WIDTH then
        Result := crSizeNESW
      else
        if AX >= Width - BORDER_WIDTH then
          Result := crSizeNWSE
        else
          Result := crSizeNS;
    end
    else
      if (AX < BORDER_WIDTH) or (AX >= Width - BORDER_WIDTH) then
        Result := crSizeWE
      else
        if (AY >= BORDER_HEIGHT) and (AY < BORDER_HEIGHT + BAR_HEIGHT) then
          Result := crSize
        else
          Result := crArrow;
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
  FCurrentCursor := crArrow;
end;

procedure TMainForm.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
  crNew: TCursor;
begin
  crNew := CursorAtPoint(X, Y);

  if crNew <> FCurrentCursor then
  begin
    FCurrentCursor := crNew;
    Screen.Cursor  := crNew;
  end;
end;

procedure TMainForm.FormPaint(Sender: TObject);
begin
  with Canvas do
  begin
    Brush.Color := $00909090;
    FillRect(ClientRect);
    Brush.Color := $00C0C0C0;
    FillRect(Rect(BORDER_WIDTH, BORDER_HEIGHT, Width - BORDER_WIDTH, Height - BORDER_HEIGHT));
    Brush.Color := $00FFFFFF;
    FilLRect(Rect(BORDER_WIDTH, BORDER_HEIGHT, Width - BORDER_WIDTH, BORDER_HEIGHT + BAR_HEIGHT));
  end;
end;

end.

Nie wiem czy jest możliwość zmniejszenia ilości warunków w metodzie CursorAtPoint - trzeba by się zastanowić nad tym o ludzkiej porze; W każdym razie kod działa prawidłowo - testowałem pod Delphi7; Pole FCurrentCursor jest potrzebne, aby w każdym wywołaniu zdarzenia OnMouseMove nie ustawiać tego samego kursora; Teraz wystarczy dodać obsługę komunikatów i oprogramować zdarzenie OnMouseDown;

W którymś wątku pokazywałem w jaki sposób dodać obsługę rozciągania, jeśli ramka formularza zbudowana jest z kilku komponentów TImage, ale jakoś nie mogę go znaleźć; W nim podałem listę komunikatów, które trzeba wysłać, aby rozciągnąć lub przesunąć formularz; Może komuś uda się go znaleźć;

Projekt dorzucam do załączników, jakby ktoś chciał przetestować u siebie.

2

To wszystko bardzo prosto załatwia się samodzielną obsługą komunikatu WM_NCHITTEST. Komunikat ten w lParam ma współrzędne kursora ekranu które trzeba przeliczyć na współrzędne okna (funkcja ScreenToClient) i odpowiednio reagować gdy kursor jest przy krawędziach okna czyli zwracać w zależności od pozycji kursora HTLEFT, HTBOTTOM itd. w pozostałych przypadkach domyślna obsługa komunikatu czyli inherited. Tak "oszukany" system sam będzie zmieniał kursor i pozwalał na zmianę rozmiaru okna. Więcej o komunikacie w MSDN http://msdn.microsoft.com/en-us/library/windows/desktop/ms645618%28v=vs.85%29.aspx W razie problemów pytaj ale to nic trudnego.

EDIT:
Łap przykład:

type
  TForm1 = class(TForm)
  private
    { Private declarations }
  protected
    procedure WMNCHitTest(var Msg: TWMNCHitTest); message WM_NCHITTEST;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.WMNCHitTest(var Msg: TWMNCHitTest);
const
  FRAME_SIZE = 3; //można by sobie pobrac prawdziwy funkcja GetSystemMetrics ale to przyklad
var
  p: TPoint;
begin
  p.X:= Msg.XPos;
  p.Y:= Msg.YPos;
  p:= ScreenToClient(p);
  if (p.X <= FRAME_SIZE) and (p.Y <= FRAME_SIZE) then
    Msg.Result:= HTTOPLEFT  //lewy górny róg
  else if (p.X <= FRAME_SIZE) and (p.Y >= Height - FRAME_SIZE) then
    Msg.Result:= HTBOTTOMLEFT  //lewy dolny róg
  else if (p.X >= Width - FRAME_SIZE) and (p.Y <=  FRAME_SIZE) then
    Msg.Result:= HTTOPRIGHT   //prawy górny róg
  else if (p.X >= Width - FRAME_SIZE) and (p.Y >= Height - FRAME_SIZE) then
    Msg.Result:= HTBOTTOMRIGHT //prawy dolny róg
  else if (p.X <= FRAME_SIZE) then
    Msg.Result:= HTLEFT //lewa krawędź
  else if (p.X >= Width - FRAME_SIZE) then
    Msg.Result:= HTRIGHT //prawa krawędź
  else if (p.Y <= FRAME_SIZE) then
    Msg.Result:= HTTOP //górna krawędź
  else if (p.Y >= Height - FRAME_SIZE) then
    Msg.Result:= HTBOTTOM //dolna krawędź
  else
    inherited; //pozostle przypadki domyslna obsluga
end;

PS: Zwracając HTCAPTION można przemieszczać okno

PS2: Gdyby ktoś pytał to wiem że takie drabinki if'ów nie są fajne i można to było rozwiązać inaczej ale za wcześnie było na myślenie...

0

Dzięki za pomoc a zwłaszcza za kod.

Faktycznie to prostsze niż sądziłem ;d.


Mam jeszcze pytanie troszkę z innej beczki ale powiązane z moim projektem. Podczas zmiany wielkości okna, musi ono zostać przerysowane w czasie rzeczywistym (zmiana rozmiaru choćby o 1 piksel oznacza konieczność przerysowania większości elementów formy, których wielkość musi być zawsze dopasowana do rozmiaru okna).

Robienie tego przez Canvas zda egzamin, czy to zbyt duże marnotrawstwo pod względem wydajności? To znaczy wiadomo, że przy współczesnych komputerach żadna maszyna nie dostanie od tego zadyszki, ale jednak chciałbym by całość była zrobiona porządnie, a nie "byle działało".

Wiem, że w większości przypadków ScanLinie jest bardziej wydajny, ale co np. z rysowaniem linii prostych w pionie? Np. ramka okalająca moje okno formy składa się z 5 różnokolorowych pasków o grubości 1 pixela (taki jakby gradient). Przy zmianie rozmiaru okna, ramka będzie musiała zostać przerysowana na nowo. W poziomie ScanLine jest idealny, ale w pionie? Wiem, że można robić kombinacje z rotacją bitmapy (oczywiście w pamięci) i nanoszenie zmian z użyciem ScanLine właśnie w ten sposób, ale czy to nie będzie niepotrzebne wykonywanie masy czynności, które ostatecznie przegra z Canvasem?

A jeżeli w Canvasie, to jaka metoda? Pixels w pętli? LineTo na każdym boku? Rectangle (rysowałbym 5 prostokątów jeden na drugim, każdy o 1 px mniejszy od poprzedniego. Za jednym zamachem powstałaby cała ramka)?

A może warto zastosować rozwiązanie jak np. w windowsowym Paincie? To znaczy w momencie zmiany rozmiaru płótna nie widzimy tego w czasie rzeczywistym, ale pojawia się taka przerywana ramka wyznaczająca jego nową wielkość. Dopiero gdy użytkownik puści lewy przycisk myszy, płótno zmienia swój rozmiar i zostaje oficjalnie "narysowane" w zaznaczonym zakresie. Przy takiej metodzie, każda zmiana wielkości okna wymuszałaby tylko jednokrotne przerysowywanie formy. Tylko czy takie rozwiązanie jest wykonalne a zarazem praktyczne z punktu widzenia użytkownika? W końcu ta "czarna ramka" wyznaczająca nowy rozmiar okna musiałaby zostać na czym narysowana (wystając - podczas rysowania - poza oficjalne okno aplikacji).

Pozdrawiam.

1

zainteresuj się gdi+ albo graphic32. Ten pierwszy to wrapper na systemowe biblioteki do rysowania, ten drugi to rozbudowana biblioteka graficzna dużo szybsza od standardowego płótna.

1

Podczas zmiany wielkości okna, musi ono zostać przerysowane w czasie rzeczywistym (zmiana rozmiaru choćby o 1 piksel oznacza konieczność przerysowania większości elementów formy, których wielkość musi być zawsze dopasowana do rozmiaru okna).

Robienie tego przez Canvas zda egzamin, czy to zbyt duże marnotrawstwo pod względem wydajności?

To zależy od ilości elementów do narysowania i oczywiście od kodu, który to rysowanie wykonuje;

Jeżeli formularz ma mieć prosty wygląd, np. kilka linii plus jednokolorowe wypełnienie, to spokojnie możesz używać metod klasy TCanvas; Tylko że Twoje podejście opisane wcześniej, nie jest najlepsze; Jeśli formularz ma mieć ramkę z kilku jednopikselowych linii różnego koloru, to nie maluj dla każdej linii prostokąta, np. metodą Rectangle, bo się to nie opłaca; Malowałbyś w kółko całe płótno okna, co jest stratą czasu;

Sam teraz parcuję nad aplikacją z własnym i niezależnym od systemu i ustawionego schematu interfejsem, używając do tego celu formularza bez obramowania; Na to kładę sobie komponent dziedziczący po TGraphicControl, który "symuluje" obramowanie okna; W jego nadpisanej metodzie Paint rysuję za pomocą Rectangle zewnętrzną ramkę i wypełnienie, następnie ramkę poświaty metodą FrameRect (aby namalować samą ramkę, bez wypełnienia), następnie za pomocą Rectangle maluję wewnętrzną ramkę plus wypełnienie na biało "klienta", a na koniec metodą FrameRect wewnętrzną ramkę poświaty i przez Pixels przejście z poświaty do koloru wypełnienia obramowania; Przykład:

empty_form.png

Całość rysowana jest na tyle szybko, że nawet jak dodam na formularz różne inne komponenty, to podczas rozciągania nic nie migocze; A mój sprzęt jest naprawdę powolny - 1,13GHz procesor i 48MiB na grafice często nie wystarcza; Ale z drugiej strony wiem, że na współczesnych komputerach wszystko będzie działać płynnie, skoro i u mnie tak działa;

Wiem, że w większości przypadków ScanLinie jest bardziej wydajny, ale co np. z rysowaniem linii prostych w pionie? Np. ramka okalająca moje okno formy składa się z 5 różnokolorowych pasków o grubości 1 pixela (taki jakby gradient). Przy zmianie rozmiaru okna, ramka będzie musiała zostać przerysowana na nowo. W poziomie ScanLine jest idealny, ale w pionie?

Wiele to nie zmienia;

Jeżeli chcesz narysować linię w poziomie, to wystarczy jeden ScanLine i uzupełnienie kolejnych komórek w konkretne wartości; W przypadku malowania linii w pionie - musisz dla każdego wiersza użyć ScanLine aby otrzymać pointer na pierwszą komórkę wiersza, a następnie skorzystać z odpowiedniego indeksu, aby dostać się do konkretnej komórki piksela; Czyli nadal będzie to jedna pętla, tyle że ScanLine będziesz musiał wywoływać w każdej jej iteracji;

Obstawiam, że to rozwiązanie będzie szybsze od metody Line, ale nie aż na tyle, aby było się czym przejmować;

A jeżeli w Canvasie, to jaka metoda? Pixels w pętli?

Pixels służy do odczytu/modyfikacji pojedynczego piksela, więc jedynie w takich przypadkach opłaca się z niego skorzystać; Użycie tej właściwości do malowania linii czy prostokątów jest najwolniejsze z możliwych, więc już lepiej użyć Line czy MoveTo + LineTo;

Rectangle (rysowałbym 5 prostokątów jeden na drugim, każdy o 1 px mniejszy od poprzedniego. Za jednym zamachem powstałaby cała ramka)?

To tutaj o tym pisałeś;

Rectangle powinno się używać tylko i wyłącznie w przypadku, gdy potrzeba narysować prostokąt z obramowaniem o innym kolorze, niż wypełnienie - w każdym innym przypadku jest to nadmiarowe; Ty potrzebujesz narysować pięć ramek o róznych kolorach i o grubości 1px, więc Rectangle możesz użyć raz (aby dodatkowo wypełnić kolorem formularz), a pozostałe linie ramki namaluj za pomocą FrameRect;

A może warto zastosować rozwiązanie jak np. w windowsowym Paincie? To znaczy w momencie zmiany rozmiaru płótna nie widzimy tego w czasie rzeczywistym, ale pojawia się taka przerywana ramka wyznaczająca jego nową wielkość.

Zauważ, że typ odświeżania wnętrza formularza określają ustawienia systemowe, więc implementując rozciąganie w typowy sposób - i tak nic nie zmienisz; Ja mam wyłączone pokazywanie zawartości formularza podczas przeciągania i rozciągania, więc zawsze widzę jedynie samą ramkę, aż do czasu puszczenia LPM;

Aby uniezależnić styl odświeżania zawartości okna, musiałbyś albo grzebać w ustawieniach systemowych, albo to rozciąganie zaimplementować w nietypowy sposób, na który ustawienia systemowe nie wpływają; Sugeruję więc zawsze przemalowywać całe okno, a typ jego aktualizowania pozostawić do wyboru użytkownikowi (co ustawi w systemie, to będzie miał);

Ogólnie to pamiętaj, aby jak najmniej pikseli przerysowywać wielokrotnie; Czasem zamiast używać kilku Line, lepiej jest użyć FrameRect, a zamiast Rectangle np. FillRect.

0

Dzięki, wykorzystałem porady i chyba udało mi się nieźle zoptymalizować cały proces rysowania. Nic nie przycina, nie migocze, grafika ukazuje się bardzo płynnie.

Pojawił się za to inny, dosyć nieoczekiwany problem. Użycie rozciagania okna na cały ekran (WindowState ustawione na wsMaximized) przy jednoczesnym braku windowsowych ramek (BorderStyle na bsNone) powoduje coś takiego, że Forma zakrywa dosłownie cały ekran, zamiast "dokleić się" na dole do paska zadań.

Co robić? Próbować pobrać jakoś wysokość paska zadań w systemie danego użytkownika i na tej podstawie ręcznie ustawić wielkość okna? To w ogóle możliwe?

0

No tak - dokładnie tak samo wygląda to pod Lazarusem, formularz przykrywa pasek zadań (lub nie); W moim przypadku to akurat dobrze, bo aplikacja ma być na pełny ekran, przykrywając pasek zadań (fsSystemStayOnTop i wsMaximized) i spełnia swoją rolę;

Jeśli chodzi o pasek zadań, to zobacz do tego wątku - u mnie pod Windows XP działa prawidłowo:

procedure TForm1.btnGetDataClick(Sender: TObject);
var
  Data: TAppBarData;
begin
  Data.cbSize := SizeOf(TAppBarData);
  Data.hWnd := FindWindow('Shell_TrayWnd', nil);

  if (Data.hWnd <> 0) and (SHAppBarMessage(ABM_GETTASKBARPOS, Data) = 1) then
  begin
    edtLeft.Text   := IntToStr(Data.rc.Left);
    edtTop.Text    := IntToStr(Data.rc.Top);
    edtWidth.Text  := IntToStr(Data.rc.Right - Data.rc.Left);
    edtHeight.Text := IntToStr(Data.rc.Bottom - Data.rc.Top);
  end;
end;

Kodu raczej nie trzeba tłumaczyć - wkleiłem go z aplikacji testowej; Pasek mam u góry, więc Left i Top poprawnie wskazuje na 0, długość i szerokość tak samo - 1024 i 30;

Ewentualnie można też skorzystać z Screen.WorkAreaRect typu TRect;

Z racji tej, że standardowa maksymalizacja w przypadku formularza ze stylem obramowania jako bsNone pomija pasek zadań, trzeba maksymalizację zasymulować; Czyli po prostu dosunąć formularz do lewego górnego rogu ekranu (nie pulpitu!) i rozciągnąć go do prawego dolnego rogu; A że pozycję i rozmiar paska zadań zapewni powyższy kod, większego problemu być nie powinno - trochę arytmetyki i warunków;

Tutaj pojawi się kolejna rzecz do obsłużenia, a mianowicie zablokowanie możliwości rozciągania i przeciągania formularza, ewentualnie inne rysowanie, jeśli zmaksymalizowany formularz ma posiadać nieco inaczej namalowaną ramkę; Wszystkie powyższe funkcje można oprzeć o jedno pole logiczne, np. FIsMaximized - jeśli formularz jest zmaksymalizowany, wpisać do niej True, w przeciwnym razie wiadome - wpisać False; Wartość z tego pola wystarczy użyć podczas obsługi komunikatu WM_NCHITTEST, aby obsłużyć lub nie przeciąganie, a także w metodzie Paint, jeśli obramowanie ma być namalowane nieco inaczej;

Inne rzeczy do obsłużenia to na pewno obsługa maksymalizacji na wieloekranowym pulpicie, czy zmiana rozmiaru formularza po wykryciu zmiany rozdzielczości ekranu;

Trochę testów z tym będzie, ale poradzisz sobie; Sam też coś pokombinuję, bo jak zwykle - dobrze wiedzieć, w przyszłości może się przydać.

1 użytkowników online, w tym zalogowanych: 0, gości: 1