Size Grip - ohne Statusbar

[turboPASCAL]

Hi,

wie bekommt man das Size-Grip ohne StatusBar auf sein Dialog ? :gruebel:

[Luckie]

So: http://www.delphi-forum.de/viewtopic...light=sizegrip

[turboPASCAL]

Ja danke Luckie, das ist eine gute Idee. Hm, leider gibt es dann bei der Benutzung des XP-Manifestes einen unschönen Effect.

Noch eine andere Idee ?

[Flocke]

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.

[turboPASCAL]

Werde ich nacher gleich mal testen. thx.

:hi:

[Flocke]

Konnte nicht umhin 'ne kleine Kompo dafür zu schreiben 8)

Benutzung ist denkbar einfach:

Delphi-Quellcode:

uses
  SizeGripThemed;

procedure TForm1.FormCreate(Sender: TObject);
begin
  // ...
  TSizeGripThemed.Create(Self);
end;

Source siehe Anlage oder hier.
Screenshot zeigt alle drei Varianten (auf die rechte untere Ecke achten).

[turboPASCAL]

Na toll, jetzt wo ich mir selbst eine Kompo. (nach deinem Hinweis) geschrieben habe kommst Du und macht’s mir nach... äh.. vor. :zwinker:

Leider muss ich zugeben das mir Deine besser gefällt. :?

Danke für diese schöne Komponente(n).

:hi:

// Edit: :gruebel: mach doch einen neuen Thread in Open Source damit man es besser in der Suche findet.

// 2. Edit: (ausgiebig getestet) :bounce1: *juhu* ...man hab ich lange nach so etwas gesucht.

[Flocke]

Es scheint da noch ein kleines Problem zu geben (ich PM-me gerade mit turboPASCAL), also vielleicht erstmal nicht downloaden und installieren.

Mal 'ne technische Frage ...

[Flocke]

So, neue Version fertig (den Download oben lösche ich raus).

@turboPASCAL: die Konstante SP_GRIPPER stammt aus der UxTheme.pas von Delphi, ich habe sie durch den Wert (3) ersetzt. Damit sollte man die Units auch mit der UxTheme.pas von Mike Lischke verwenden können.

Die ge-theme-te Version TSizeGripThemed hat den "Vorteil", dass das Grip wirklich genau wie bei einem StatusBar gezeichnet wird, und damit je nach aktiviertem Stil unterschiedlich aussehen kann.

[retnyg]

den ganzen paint-scheiss hättest du dir sparen können:

Delphi-Quellcode:

DrawFrameControl ( DC, sender.ClientRect ,  DFC_SCROLL, DFCS_SCROLLSIZEGRIP );

[Flocke]

Zitat:

Zitat von retnyg

den ganzen paint-scheiss hättest du dir sparen können

Lass mich dir zunächst zu deiner ausgezeichneten Wortwahl gratulieren 8)

Zitat:

Zitat von retnyg

Delphi-Quellcode:

DrawFrameControl ( DC, sender.ClientRect ,  DFC_SCROLL, DFCS_SCROLLSIZEGRIP );

Danke für den Hinweis, an DrawFrameControl hatte ich in diesem Zusammenhang überhaupt nicht gedacht. Ich mache noch ein paar Tests und schreibe dann mehr...

[retnyg]

Zitat:

Zitat von Flocke

Zitat:

Zitat von retnyg

den ganzen paint-scheiss hättest du dir sparen können

Lass mich dir zunächst zu deiner ausgezeichneten Wortwahl gratulieren 8)

ich bin etwas frustriert weil ich versucht habe deine unit für KOL zu übersetzen und ich doch einige mühe mit deinem (extrem VCL-lastigen und umständlichen) quellcode hatte. ein resultat habe ich nicht, da KOL kein Inherited unterstützt. Ausserdem habe ich keine Möglichkeit gefunden, die windowproc des parents zu hooken.
die ganzen TWMPAInt usw typecasterei hat mich auch einige nerven gekostet (bei kol wird keine TMessage sondern eine tagMsg variable übergeben).
Man kann es mit der "sauberen" programmierung :roll: auch übertreiben :?
ein HDC(msg.lParam) hätte es auch getan

[Flocke]

Zitat:

Zitat von retnyg

Zitat:

Zitat von Flocke

Zitat:

Zitat von retnyg

den ganzen paint-scheiss hättest du dir sparen können

Lass mich dir zunächst zu deiner ausgezeichneten Wortwahl gratulieren 8)

ich bin etwas frustriert weil ich versucht habe deine unit für KOL zu übersetzen und ich doch einige mühe mit deinem (extrem VCL-lastigen und umständlichen) quellcode hatte.

Es tut mir sehr leid, aber es ist eine VCL-Komponente, daher würde ich den Quellcode nicht nur als VCL-lastig bezeichnen. Ich habe nie vorgesehen, dass der Code für KOL verwendet wird (das ich außerdem noch nicht einmal installiert habe).

Zitat:

Zitat von retnyg

Ausserdem habe ich keine Möglichkeit gefunden, die windowproc des parents zu hooken.

Da wird es wohl nur die gute alte Methode geben, die WNDPROC zu ersetzen. Wenn du bis morgen Zeit hast, dann kann ich dir sowas schreiben.

Zitat:

Zitat von retnyg

Man kann es mit der "sauberen" programmierung :roll: auch übertreiben :?

Nein, nie :mrgreen:

//Nachtrag:

Zu DrawFrameControl: es zeichnet immer die diagonalen Linien, könnte also höchsten meine Routine Paint3 ersetzen (was ich ggf. tun werde).

[retnyg]

Zitat:

Zitat von Flocke

Da wird es wohl nur die gute alte Methode geben, die WNDPROC zu ersetzen. Wenn du bis morgen Zeit hast, dann kann ich dir sowas schreiben.

du willst dich bis morgen in KOL einarbeiten ? :lol:
wenn du das schaffst, gerne ;)
ich brauch n SIZEGRIP für die brandneue version von leetMP3, an der ich gerade code ( wird übrigens ein hammer :mrgreen: )

[Flocke]

Neee .. nicht in KOL einarbeiten - als API-Version implementieren.

So geht's bei mir schon mal, allerdings nur mit dem Standardlayout:

Delphi-Quellcode:

unit SizeGripHWND;

interface

uses
  Windows, Messages;

procedure SetSizeGripHook(hWnd: HWND; IsDoubleBuffered: boolean = false);
procedure RemoveSizeGripHook(hWnd: HWND);

implementation

const
  SizeGripProp = 'SizeGrip';

type
  TWndProc = function (hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;

  PGripInfo = ^TGripInfo;
  TGripInfo = record
    OldWndProc: TWndProc;
    GripRect: TRect;
    DoubleBuffered: boolean;
  end;

function SizeGripWndProc(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
var
  Info: PGripInfo;
  ps: TPaintStruct;
  pt: TPoint;

  // Invalidate the current grip rectangular
  procedure InvalidateGrip;
  begin
    with Info^ do
      if (GripRect.Right > GripRect.Left) and
         (GripRect.Bottom > GripRect.Top) then
      begin
        if DoubleBuffered then
          InvalidateRect(hWnd, nil, true)
        else
          InvalidateRect(hWnd, @GripRect, true);
      end;
  end;

  // Update (and invalidate) the current grip rectangular
  procedure UpdateGrip;
  begin
    with Info^ do
    begin
      GetClientRect(hWnd, GripRect);
      GripRect.Left := GripRect.Right - GetSystemMetrics(SM_CXHSCROLL);
      GripRect.Top := GripRect.Bottom - GetSystemMetrics(SM_CYVSCROLL);
    end;

    InvalidateGrip;
  end;

begin
  Info := PGripInfo(GetProp(hWnd, SizeGripProp));
  if Info = nil then
  begin
    Result := DefWindowProc(hWnd, Msg, wParam, lParam);
    exit;
  end;

  case Msg of
    WM_DESTROY: begin
      RemoveProp(hWnd, SizeGripProp);
      SetWindowLong(hWnd, GWL_WNDPROC, LongInt(@Info^.OldWndProc));
      Result := CallWindowProc(@Info^.OldWndProc, hWnd, Msg, wParam, lParam);
      Dispose(Info);
    end;

    WM_PAINT: begin
      if wParam = 0 then
      begin
        wParam := BeginPaint(hWnd, ps);
        //try
          if Info^.DoubleBuffered then
            SendMessage(hWnd, WM_ERASEBKGND, wParam, wParam);
          Result := SendMessage(hWnd, WM_PAINT, wParam, lParam);
        //finally
          EndPaint(hWnd, ps);
        //end;
      end
      else
      begin
        DrawFrameControl(wParam, Info^.GripRect, DFC_SCROLL, DFCS_SCROLLSIZEGRIP);
        Result := CallWindowProc(@Info^.OldWndProc, hWnd, Msg, wParam, lParam);
      end;
    end;

    WM_NCHITTEST: begin
      pt.x := TSmallPoint(lParam).x;
      pt.y := TSmallPoint(lParam).y;
      ScreenToClient(hWnd, pt);
      if PtInRect(Info^.GripRect, pt) then
        Result := HTBOTTOMRIGHT
      else
        Result := CallWindowProc(@Info^.OldWndProc, hWnd, Msg, wParam, lParam);
    end;

    WM_SIZE: begin
      InvalidateGrip;
      Result := CallWindowProc(@Info^.OldWndProc, hWnd, Msg, wParam, lParam);
      UpdateGrip;
    end;

    else
      Result := CallWindowProc(@Info^.OldWndProc, hWnd, Msg, wParam, lParam);
  end;
end;

procedure SetSizeGripHook(hWnd: HWND; IsDoubleBuffered: boolean = false);
var
  Info: PGripInfo;
begin
  RemoveSizeGripHook(hWnd);

  New(Info);
  FillChar(Info^, SizeOf(TGripInfo), 0);

  Info^.OldWndProc := TWndProc(Pointer(GetWindowLong(hWnd, GWL_WNDPROC)));
  Info^.DoubleBuffered := IsDoubleBuffered;

  SetProp(hWnd, SizeGripProp, Cardinal(Info));
  SetWindowLong(hWnd, GWL_WNDPROC, LongInt(@SizeGripWndProc));
end;

procedure RemoveSizeGripHook(hWnd: HWND);
var
  Info: PGripInfo;
begin
  Info := PGripInfo(GetProp(hWnd, SizeGripProp));
  if Info <> nil then
  begin
    RemoveProp(hWnd, SizeGripProp);
    SetWindowLong(hWnd, GWL_WNDPROC, LongInt(@Info^.OldWndProc));
    Dispose(Info);
  end;
end;

end.

[retnyg]

hut ab !

erstaunlich was du in der kurzen zeit gemacht hast. leider funktioniert's mit kol nicht recht.
der grip wird nicht gepainted, und das resizen geht auch nicht ^^
einzig der cursor ändert sich wenn er sich in der ecke befindet - siehe demo

//edit: wenn ich den borderstyle auf bsSingle stelle, funktioniert das resizen

[Luckie]

Das wird aber an kol liegen und nicht an Flockes Code, da dieser korrektes Delphi ist.

[Flocke]

Isch schau Morgen noch mal ... isch bin jetscht ein bischschen angetrunken 8)

[Flocke]

Ich hatte hier einen ähnlichen Effekt (Grip nicht sichtbar), wenn ich DoubleBuffered einstelle. Vielleicht probierst du es mal ohne.

Außerdem habe ich mal 'ne aktuelle Version der Unit angehängt.

[retnyg]

vielen dank für deine mühen!

jetzt gehts ;)