AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Win32/Win64 API (native code) Delphi [nonVCL] Subclassing eines StcCtrl's / falscher Font...

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

Ein Thema von turboPASCAL · begonnen am 30. Jun 2007 · letzter Beitrag vom 1. Jul 2007
Antwort Antwort
Seite 1 von 2  1 2   
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
Reinhard Kern

Registriert seit: 22. Okt 2006
772 Beiträge
 
#2

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

  Alt 30. Jun 2007, 10:25
Zitat von turboPASCAL:
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 ?
Ja (Zitat aus MSDN):
>
GWL_WNDPROC
Sets a new address for the window procedure.

Windows NT/2000/XP: You cannot change this attribute if the window does not belong to the same process as the calling thread.
<

Was du machen möchtest, hat mit Win16 mal funktioniert.

Gruss Reinhard
  Mit Zitat antworten Zitat
Dezipaitor

Registriert seit: 14. Apr 2003
Ort: Stuttgart
1.701 Beiträge
 
Delphi 7 Professional
 
#3

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

  Alt 30. Jun 2007, 11:53
Soweit ich das sehe, bleibt alles im eigenen Prozess.


Du könntest auf WM_GETFONTreagieren und dort dein korrektes FONT zurückliefern:
Christian
Windows, Tokens, Access Control List, Dateisicherheit, Desktop, Vista Elevation?
Goto: JEDI API LIB & Windows Security Code Library (JWSCL)
  Mit Zitat antworten Zitat
Benutzerbild von Luckie
Luckie

Registriert seit: 29. Mai 2002
37.621 Beiträge
 
Delphi 2006 Professional
 
#4

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

  Alt 30. Jun 2007, 13:55
Setz die Schrift doch im WM_CREATE des Statics.
Michael
Ein Teil meines Codes würde euch verunsichern.
  Mit Zitat antworten Zitat
Benutzerbild von turboPASCAL
turboPASCAL

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

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

  Alt 30. Jun 2007, 17:05
WM_CREATE wird leider im Subcass nicht aufgerufen.

Ich habe es erst einmal so gelöst:
Delphi-Quellcode:
var
  OldProc: Pointer;
  Font, olf: 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));

        olf := SelectObject(DC, Font);
        DrawText(DC, PChar(_MyText), length(_MyText), r,
          DT_SINGLELINE   or DT_NOPREFIX or DT_CENTER or DT_VCENTER);
        SelectObject(DC, olf);

        EndPaint(hWnd, ps);
      end;
    else
      Result := CallWindowProc(OldProc, hWnd, uMsg, wParam, lParam);
  end;
end;
nur hätt ich's gern als echtes Subclassing mit WM_SETFONT. Ich habe es auch mit SetClassLong versucht, jedoch ohne Erfolg.
Matti
Meine Software-Projekte - Homepage - Grüße vom Rüsselmops -Mops Mopser
  Mit Zitat antworten Zitat
Olli
(Gast)

n/a Beiträge
 
#6

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

  Alt 1. Jul 2007, 02:23
Wie wäre es denn mit SuperClassing statt Subclassing? Schon mal daran gedacht?
  Mit Zitat antworten Zitat
Benutzerbild von turboPASCAL
turboPASCAL

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

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

  Alt 1. Jul 2007, 10:56
Zitat von Olli:
Wie wäre es denn mit SuperClassing statt Subclassing? Schon mal daran gedacht?
Nein, habe auch nicht den geringsten Schimmer was das ist.
Matti
Meine Software-Projekte - Homepage - Grüße vom Rüsselmops -Mops Mopser
  Mit Zitat antworten Zitat
Benutzerbild von Flocke
Flocke

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

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

  Alt 1. Jul 2007, 11:40
Ersetze doch einfach diese Zeile:
Delphi-Quellcode:
// olf := SelectObject(DC, Font);
olf := SelectObject(DC, THandle(SendMessage(hWnd, WM_GETFONT, 0, 0)));
Volker
Besucht meine Garage
Aktuell: RtfLabel 1.3d, PrintToFile 1.4
  Mit Zitat antworten Zitat
Benutzerbild von turboPASCAL
turboPASCAL

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

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

  Alt 1. Jul 2007, 15:16
Zitat von Flocke:
Ersetze doch einfach diese Zeile ...
Nö.

Es geht mir ja darum das ich den Font auch für das Control bereitstellen könnte, zB einem Edit etc.
Matti
Meine Software-Projekte - Homepage - Grüße vom Rüsselmops -Mops Mopser
  Mit Zitat antworten Zitat
Olli
(Gast)

n/a Beiträge
 
#10

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

  Alt 1. Jul 2007, 17:48
Zitat von turboPASCAL:
Zitat von Olli:
Wie wäre es denn mit SuperClassing statt Subclassing? Schon mal daran gedacht?
Nein, habe auch nicht den geringsten Schimmer was das ist.
Das Prinzip ist in etwa genauso, aber eben ein kleines bißchen einfacher wenn man es von Anfang an durchzieht. Ach ja, kannst du auch bei dialogbasierten nonVCL-Programmen einsetzen, insofern du sicherstellst, daß du ein "custom control" mit dem von dir für die Superklasse vergeben Namen erstellst.

Das Prinzip:
  • Du lädst alle notwendigen DLLs (weil das nicht automatisch passiert), also bspw. die Common Controls. Bei einem Static kannst du diesen Schritt weglassen.
  • Dann ermittelst du die Eigenschaften der Klasse die su superclassen willst.
  • Dann überschreibst du jene Eigenschaften, die du überschreiben willst.
  • Dann registrierst du die neue Klasse im System.
Nähmen wir an die Fensterfunktion der neuen Klasse wäre jetzt nicht in deiner EXE sondern in einer DLL und nähmen wir weiterhin an, daß diese DLL nicht relozierbar ist (wahr für die System-DLLs), dann könntest du innerhalb eines anderen Prozesses auch ein Fenster dieser Fensterklasse erzeugen. Beschränkt wird das wohl nur durch den Desktop oder so (Reichweite von Atoms).

Logischerweise könntest du auch einfach ein Static in der Dialogvorlage erstellen lassen, welches du in WM_INITDIALOG wieder killst, aber zuvor dessen Parameter (Position, Text usw.) übernimmst. Manchmal ist eine solche Vorgehensweise sogar unumgänglich, bspw. wenn du ein einziges Control in einer Anwendung die UNICODE ist als ANSI haben möchstest. Da hilft dann nur das erneute Erstellen mit bekannten Parametern

ACHTUNG: Wenn die in der Dialogvorlage referenzierte Fensterklasse nicht existiert, wird der Dialog nicht erzeugt. Es gibt allerdings ein Flag, um solche Fehler einfach zu ignorieren (DS_NOFAILCREATE).

Nun zum eigentlichen Thema, das Beispiel. Habe mal ganz frech deinen Code als Vorlage genommen. An einigen Stellen noch sichtbar, woanders eher weniger
HINWEIS: Um einen Dialog zu Beenden nehme man bitte MSDN-Library durchsuchenEndDialog, nicht MSDN-Library durchsuchenDestroyWindow!

Hier erstmal die Dialogvorlage (veranschaulicht!!!, der eigentliche Klassenname ist unten ersichtlich):
Code:
IDD_DIALOG1 DIALOGEX 0, 0, 186, 84
STYLE DS_SETFONT | DS_MODALFRAME | DS_FIXEDSYS | [color=green]/* DS_NOFAILCREATE |*/[/color] WS_POPUP | WS_CAPTION | WS_SYSMENU
CAPTION "Dialog"
FONT 8, "MS Shell Dlg", 400, 0, 0x1
BEGIN
    DEFPUSHBUTTON  "OK",IDOK,129,63,50,14
    LTEXT          "Static",IDC_STC1,7,7,172,8
    CONTROL        [color=red]"Text des Controls"[/color],IDC_CUSTOM1,[color=blue]"Klassenname"[/color],WS_TABSTOP | WS_CHILD | WS_VISIBLE,7,22,172,8
END
Delphi-Quellcode:
program SuperClassBsp;
// [...]
type
  HANDLE = THandle;
  TMyClassDescriptor = record classname: PAnsiChar; parentclass: PAnsiChar; wndproc: TFNWndProc; oldwndproc: TFNWndProc; atom: TAtom; end;
  TMyWndClasses = (wcMyStatic);

// Forward-Deklaration, da es in der Variableninitialisierung benutzt wird!
function MyStaticWndProc(hWnd: HWND; uMsg: UINT; wParam, lParam: Integer): LRESULT; stdcall; forward;

var
  _WndClasses: array[TMyWndClasses] of TMyClassDescriptor =
  (
    (
    classname: 'MeineStaticKlasse';
    parentclass: 'STATIC';
    wndproc: @MyStaticWndProc;
    oldwndproc: nil;
    )
    );

function MyStaticWndProc(hWnd: HWND; uMsg: UINT; wParam, lParam: Integer): LRESULT; stdcall;
// [...]

function DialogProc(hDlg: HWND; uMsg: UINT; wParam, lParam: Integer): BOOL; stdcall;
// [...]

// Generische Funktion um Fensterklassen hinsichtlich ihrer Fensterfunktion zu
// superclassen. _WndClasses muß als globale Variable vorinitialisiert sein!!!
function RegisterMyWindowClasses(): Boolean;
var
  i: TMyWndClasses;
  wc: WNDCLASSEX;
begin
  Result := True;
  for i := Low(_WndClasses) to High(_WndClasses) do
  begin
    ZeroMemory(@wc, sizeof(wc));
    wc.cbSize := sizeof(wc);
    if (GetClassInfoEx(NULL, _WndClasses[i].parentclass, wc)) then
    begin
      // Sichern der alten Fensterfunktion
      _WndClasses[i].oldwndproc := wc.lpfnWndProc;
      // Zuweisen der neuen Fensterfunktion
      wc.lpfnWndProc := _WndClasses[i].wndproc;
      // Neuer Klassenname (so wird er auch in der Dialogvorlage benutzt!)
      wc.lpszClassName := _WndClasses[i].classname;
      // Diese Klasse wurde von uns erzeugt/registriert!
      wc.hInstance := hInstance;
      wc.style := (not CS_GLOBALCLASS) and wc.style;
      // Jetzt sollte alles stimmen (der Rest muß hier schon korrekt sein)
      _WndClasses[i].atom := RegisterClassEx(wc);
// Writeln('Atom == ', _WndClasses[i].atom, ' (', String(_WndClasses[i].classname), ')');
      // Im Fehlerfall ...
      if (0 = _WndClasses[i].atom) then
      begin
        // ... sicherstellen, daß die Kombination aller Resultate False wird!
        Result := Result and False;
      end;
    end;
  end;
end;

// Generischer Gegenpart zur Funktion RegisterMyWindowClasses().
procedure UnRegisterMyWindowClasses();
var i: TMyWndClasses;
begin
  // ... und abermals gehen wir durch das Array mit den Werten
  for i := Low(_WndClasses) to High(_WndClasses) do
  begin
    if (_WndClasses[i].atom <> 0) then
      if (UnregisterClass(_WndClasses[i].classname, hInstance)) then
      begin
        _WndClasses[i].atom := 0;
      end;
  end;
end;

begin
  if (RegisterMyWindowClasses()) then
  begin
    DialogBox(hInstance, MAKEINTRESOURCE(IDD_DIALOG1), 0, @DialogProc);
  end;
  // Aufräumen in jedem Fall!
  UnRegisterMyWindowClasses();
end.
Zum Thema wo man noch Daten des Fensters/der Fensterklasse abspeichern kann, findet sich hier ein guter Beitrag.
Angehängte Dateien
Dateityp: rar superclassbeispiel_194.rar (11,4 KB, 22x aufgerufen)
  Mit Zitat antworten Zitat
Antwort Antwort
Seite 1 von 2  1 2   

Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

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 20:31 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz