Size Grip - ohne Statusbar

[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 ;)