AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Thema durchsuchen
Ansicht
Themen-Optionen

Size Grip - ohne Statusbar

Ein Thema von turboPASCAL · begonnen am 21. Sep 2005 · letzter Beitrag vom 31. Okt 2005
 
Benutzerbild von Flocke
Flocke

Registriert seit: 9. Jun 2005
Ort: Unna
1.172 Beiträge
 
Delphi 10.2 Tokyo Professional
 
#4

Re: Size Grip - ohne Statusbar

  Alt 21. Sep 2005, 18:26
Erweitere dein Formular im Interface-Teil um:
Delphi-Quellcode:
protected
  procedure WMEraseBkgnd(var Msg: TWMEraseBkgnd); message WM_ERASEBKGND;
  procedure WMNcHitTest(var Msg: TWMNcHitTest); message WM_NCHITTEST;
  procedure WMSize(var Msg: TWMSize); message WM_SIZE;
und im Implementation-Teil um:
Delphi-Quellcode:
procedure TForm1.WMEraseBkgnd(var Msg: TWMEraseBkgnd);
var
  rc: TRect;

  procedure Paint3(dc: HDC; const rc: TRect; clr: COLORREF; delta: integer);
  var
    pen, oldpen: HPen;
  begin
    pen := CreatePen(PS_SOLID, 0, clr);
    try
      oldpen := SelectObject(dc, pen);
      try
        MoveToEx(dc, rc.Right - delta, rc.Bottom - 1, nil);
        LineTo(dc, rc.Right, rc.Bottom - 1 - delta);
        inc(delta, 4);
        MoveToEx(dc, rc.Right - delta, rc.Bottom - 1, nil);
        LineTo(dc, rc.Right, rc.Bottom - 1 - delta);
        inc(delta, 4);
        MoveToEx(dc, rc.Right - delta, rc.Bottom - 1, nil);
        LineTo(dc, rc.Right, rc.Bottom - 1 - delta);
      finally
        SelectObject(dc, oldpen);
      end;
    finally
      DeleteObject(pen);
    end;
  end;

begin
  inherited;

  Windows.GetClientRect(Handle, rc);
  rc.Left := rc.Right - 12;
  rc.Top := rc.Bottom - 12;
  Paint3(Msg.DC, rc, GetSysColor(COLOR_3DSHADOW), 2);
  Paint3(Msg.DC, rc, GetSysColor(COLOR_3DSHADOW), 3);
  Paint3(Msg.DC, rc, GetSysColor(COLOR_3DHILIGHT), 4);
end;

procedure TForm1.WMNcHitTest(var Msg: TWMNcHitTest);
var
  rc: TRect;
  pt: TPoint;
begin
  Windows.GetClientRect(Handle, rc);
  rc.Left := rc.Right - 12;
  rc.Top := rc.Bottom - 12;
  pt.x := Msg.XPos;
  pt.y := Msg.YPos;
  Windows.ScreenToClient(Handle, pt);

  if PtInRect(rc, pt) then
    Msg.Result := HTBOTTOMRIGHT
  else
    inherited;
end;

procedure TForm1.WMSize(var Msg: TWMSize);
begin
  inherited;
  Windows.InvalidateRect(Handle, nil, TRUE);
end;
(TForm1 musst du natürlich durch den Namen deines Formulars ersetzen)

Das InvalidateRect bei WM_SIZE ist ein bisschen blöd, anders geht's aber irgendwie nur mit 'nem Extra-Control für das SizeGrip.
Volker
Besucht meine Garage
Aktuell: RtfLabel 1.3d, PrintToFile 1.4
  Mit Zitat antworten Zitat
 


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 18:24 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz