Einzelnen Beitrag anzeigen

Benutzerbild von turboPASCAL
turboPASCAL

Registriert seit: 8. Mai 2005
Ort: Sondershausen
4.274 Beiträge
 
Delphi 6 Personal
 
#1

[nonVCL] Subclassing eines StcCtrl's / falscher Font...

  Alt 30. Jun 2007, 08:54
Hi,

ich möchte in einem Dialogfenster ein Staticcontrol subclassen. Leider wird nicht wie ich
dachte der an das Staticcontrol, ein Statictext, der von mir gesetzte Font verwendet sondern
der Systemfont.
Wenn man SetWindowLong auskommentiert ist der gewünschte Font richtig gesetzt worden.

Habe ich was übersehen ?

Delphi-Quellcode:
program Test;

{$R '_res\resources.res' '_res\resources.rc'}

uses
  Windows, Messages;

const
  IDD_MAINDLG = 100;
  IDC_STC1 = 101;
  MyText = 'Hellow !';

var
  OldProc: Pointer;
  _Font: HFONT;

function WndProc(hWnd: HWND; uMsg: UINT; wParam, lParam: Integer): LRESULT; stdcall;
var
  ps: PAINTSTRUCT;
  DC: HDC;
  r: trect;
begin
  Result := 0;

  case uMsg of
    WM_PAINT:
      begin
        DC := BeginPaint(hWnd, ps);
        SetBkMode(DC, TRANSPARENT);

        GetClientRect(hWnd, r);
        windows.FrameRect(DC, r, GetStockObject(WHITE_BRUSH));
        DrawText(DC, PChar(MyText), length(MyText), r,
          DT_SINGLELINE   or DT_NOPREFIX or DT_CENTER or DT_VCENTER);

        EndPaint(hWnd, ps);
      end;
    else
      Result := CallWindowProc(OldProc, hWnd, uMsg, wParam, lParam);
  end;
end;

function DialogProc(hDlg: HWND; uMsg: UINT; wParam, lParam: Integer): BOOL; stdcall;
begin
  Result := TRUE;

  case uMsg of
    WM_INITDIALOG:
      begin
        _Font := CreateFont(-24, 0, 0, 0, FW_BOLD, 0, 0, 0,
          ANSI_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY,
          DEFAULT_PITCH, 'arial');
        SendMessage(GetDlgItem(hDlg, IDC_STC1), WM_SETFONT, Integer(_Font), 0);

        OldProc := Pointer(GetWindowLong(GetDlgItem(hDlg, IDC_STC1), GWL_WNDPROC));
        
        //*
        SetWindowLong(GetDlgItem(hDlg, IDC_STC1), GWL_WNDPROC, Integer(@WndProc));
      end;

    WM_CLOSE: DestroyWindow(hDlg);
    WM_DESTROY: DeleteObject(_Font);
    else Result := FALSE;
  end;
end;

BEGIN
  DialogBox(hInstance, MAKEINTRESOURCE(IDD_MAINDLG), 0, @DialogProc);
END
Matti
Meine Software-Projekte - Homepage - Grüße vom Rüsselmops -Mops Mopser
  Mit Zitat antworten Zitat