Winproc ärger

[EWeiss]

Delphi-Quellcode:

unit uListBox;

interface

uses Windows, Classes, Messages, uGlobal, uGDIUnit, uSkin, uDrawText,
  uBass, uBassVis, BassVis, SysUtils, StrUtils;

type
  TListBox = class
  private
    FHOwner  :  HWND;
    LStyle:     DWORD;
    hFDefault:    HWND;
    procedure  SubClass(WinHandle: HWND);
    procedure UnSubClass(WinHandle: HWND);
    function DefaultFont: hFont;
    procedure SetCTLFont(hCtL: HWND; Font: hFont);
  public
    constructor Create(hOwner: HWND; FullpathImageName: string; x, y, xW, yH,
      PlayListID: integer; BackColor: COLORREF);
    destructor Destroy; override;
  end;

type
  LBTYPE = Record
    Forecolor         : COLORREF;
    Backcolor         : COLORREF;
    ForeColorSelected : COLORREF;
    BackColorSelected : COLORREF;
    BorderStyle       : Integer;
    DrawStyle         : Integer;
    ItemHeight        : Integer;
    hWnd              : HWND;
    Left              : Integer;
    Top               : Integer;
    Width             : Integer;
    Height            : Integer;
    hFont             : HFONT;
  end;

var
  TMListBox: LBTYPE;
  TempFont: GpFont;
  Img:      cardinal;

function ListBoxProc(WinHandle: HWND; Msg: UINT; wP: WParam; lP: LParam): LRESULT; stdcall;
procedure DrawItem(lP: Integer);

implementation
uses uMainApp;

var
  PrevWndProc, PrevWndProcLB: Integer;

// Erstelle den Default Font.
function TListBox.DefaultFont: hFont;
begin
  if hFDefault = 0 then
    hFDefault := GetStockObject(ANSI_VAR_FONT);

  Result := hFDefault;
end;

// Setze den verwendeten Font zum ausgewählten Control.
procedure TListBox.SetCTLFont(hCtL: HWND; Font: hFont);
begin
  SendMessage(hCtL, WM_SETFONT, Font, 0);
end;

constructor TListBox.Create(hOwner: HWND; FullpathImageName: string; x, y, xW, yH,
  PlayListID: integer; BackColor: COLORREF);

begin

  with SkinEngine do
  begin

      // Erstelle das  GDIPLUS image von Datei
      Img := AddResource(PAnsiChar(FullpathImageName));
      if Img <> 0 then
      begin
        // Hole die Thumb GDIPLUS image größe
        GetImageSize(Img, imgW, imgH);
        // LBS_NOTIFY übergeben ohne wird kein Event
        // auf LBN_DBLCLK ausgelößt
        // LBS_OWNERDRAWFIXED verursacht ärger keine ahnung warum
        LStyle := LBS_HASSTRINGS {Or LBS_OWNERDRAWFIXED} Or
                  LBS_NOINTEGRALHEIGHT Or LBS_NOTIFY or WS_CHILD
                  Or WS_BORDER Or WS_VSCROLL;
        // Propertys der Listbox festlegen
        TMListBox.Forecolor := GetSysColor(COLOR_BTNTEXT);
        TMListBox.Backcolor := RGB(255, 255, 255);
        TMListBox.ForeColorSelected := GetSysColor(COLOR_HIGHLIGHTTEXT);
        TMListBox.BackColorSelected := GetSysColor(COLOR_HIGHLIGHT);
        TMListBox.BorderStyle := EDGE_RAISED;
        TMListBox.Left := x;
        TMListBox.Top := y;
        TMListBox.Width := xW;
        TMListBox.Height := yH;

        // ListBox erstellen
        TMListBox.hWnd := CreateWindowEx(WS_EX_CLIENTEDGE or WS_EX_TRANSPARENT,
          SKLISTBOX, nil, LStyle, TMListBox.Left, TMListBox.Top, TMListBox.Width, TMListBox.Height,
          hOwner, PlayListID, skInstance, nil);

        if TMListBox.hWnd <> 0 then
        begin
          // HinterGrundBitmap ListBox
          SetImageProperty(TMListBox.hWnd, PROP_IMAGE_BACK, Img);
          // Font erstellen
          TMListBox.hFont := DefaultFont;
          SetCTLFont(TMListBox.hWnd, TMListBox.hFont);
          // Font Object entfernen
          DeleteObject(TMListBox.hFont);
          // Itemhöhe zuweisen
          TMListBox.ItemHeight := 16;
          SendMessage(TMListBox.hWnd, LB_SETITEMHEIGHT, 0, TMListBox.ItemHeight);
          // DrawStyle zuweisen
          TMListBox.DrawStyle := CreateSolidBrush(TMListBox.Backcolor);
          FHOwner := hOwner;

          SubClass(FHOwner);
        end else
          // Image löschen wenn Fehler
          DeleteResource(Img);
      end;
  end;
end;

destructor TListBox.Destroy;
begin
  UnSubClass(FHOwner);

  inherited Destroy;
end;


procedure DrawItem(lP: Integer);
var
  PDis:     PDrawItemStruct;
  DTP:      TDRAWTEXTPARAMS;
  BColor,
  FColor:   COLORREF;
  hBrush:   Integer;
  ItemText: PChar;
  l:        Integer;

begin

  CopyMemory(@PDis, @lP, SizeOf(@PDis));
  ItemText := nil;

    If PDis.itemState <> 0 And ODS_SELECTED Then
    begin
      BColor := SetBkColor(PDis.hDC, TMListBox.BackColorSelected);
      hBrush := CreateSolidBrush(TMListBox.BackColorSelected);
      FColor := SetTextColor(PDis.hDC, TMListBox.ForeColorSelected);
    end else
    begin
      BColor := SetBkColor(PDis.hDC, TMListBox.Backcolor);
      hBrush := CreateSolidBrush(TMListBox.Backcolor);
      FColor := SetTextColor(PDis.hDC, TMListBox.Forecolor);
    end;

    //Img := SkinEngine.GetProperty(TMListBox.hWnd, PROP_IMAGE_BACK);
    //SkinEngine.GetImageSize(Img, ImgW, ImgH);

    //BitBlt(PDis.hDC, PDis.rcItem.Left + 4, PDis.rcItem.Top + 1, 13, 11,
    //       GetDc(Img.Handle), 0, 0, SRCCopy);

    PDis.rcItem.Left := PDis.rcItem.Left + 20;
    FillRect(PDis.hDC, PDis.rcItem, hBrush);

    l := SendMessage(TMListBox.hWnd, LB_GETTEXTLEN, PDis.itemID,  0);

    if l > 0 Then
    begin
      GetMem(ItemText, l + 1);
      SendMessage(TMListBox.hWnd, LB_GETTEXT, PDis.itemID, integer(ItemText));
    end;

    DTP.cbSize := SizeOf(DTP);
    DrawTextEx(PDis.hDC, ItemText, l, PDis.rcItem, DT_LEFT
      Or DT_VCENTER Or DT_SINGLELINE, @DTP);

    SetTextColor(PDis.hDC, FColor);
    SetBkColor(PDis.hDC, BColor);

    DeleteObject(hBrush);
    CopyMemory(@lP, @PDis, SizeOf(@PDis));

end;

function WndProc(WinHandle: HWND; Msg: UINT; wP: WParam; lP: LParam): LRESULT; stdcall;
var
  hList : HWND;
  nItem:  Integer;

begin
  with SkinEngine do
  begin
    case msg of
      WM_COMMAND:
      begin
        case HiWord(wP) of
        LBN_DBLCLK:
          begin
            nItem := ListGetCurSel(TMListBox.hWnd);
            hList := GetMainItem(ID_PLAYLISTBOX);
            ListSelectPlus(hList, nItem);
            if nItem > 0 then
            begin

            hList := GetMainItem(ID_PLAYLISTBOX);
            getAudioFile := ListGetText(hList, nItem);
            BassChannelPlay;
          end;
        end;
        end;
        case LoWord(wP) of
          IDM_PlayList:
          begin
            hList := GetMainItem(ID_PLAYLIST);
            if isWindowVisible(hList) then
              begin
                VisBassVis.StartVis(PAnsiChar(PlgFilename));
                ShowWindow(hList, SW_HIDE)
              end else
              begin
                VisBassVis.StopVis;
                SetAnchorMode(hList, ANCHOR_HEIGHT_WIDTH);
                SetZorder(hList, HWND_TOP);
                ShowWindow(hList, SW_SHOW);
              end;
              nItem := LastPlayListTitle;
              ListSelectPlus(hList,nItem);
          end;
        end;
      end;
      WM_MOUSEWHEEL:
      begin
        hList := GetMainItem(ID_PLAYLIST);
        if isWindowVisible(hList) then
          SendMessage(hList, Msg, wP, lP);
      end;
      WM_CTLCOLORLISTBOX:
      begin
        Result := TMListBox.DrawStyle;
        exit;
      end;
      WM_ERASEBKGND:
      begin
        Result := 1;
        exit;
      end;
      WM_DRAWITEM:
      begin
        DrawItem(lP);  //Problem geht auf Main WinProc
        Result := CallWindowProc(Pointer(PrevWndProc), WinHandle, Msg, wP, lP);
        exit;
      end;
    end;
    Result := CallWindowProc(Pointer(PrevWndProc), WinHandle, Msg, wP, lP);
  end;

end;

procedure TListBox.SubClass(WinHandle: HWND);
begin
  PrevWndProc := SetWindowLong(WinHandle, GWL_WNDPROC, integer(@WndProc));
  PrevWndProcLB := SetWindowLong(TMListBox.hWnd, GWL_WNDPROC, integer(@ListBoxProc));

end;

procedure TListBox.UnSubClass(WinHandle: HWND);
begin
  SetWindowLong(WinHandle, GWL_WNDPROC, PrevWndProc);
  SetWindowLong(TMListBox.hWnd, GWL_WNDPROC, integer(@ListBoxProc));
end;

function ListBoxProc(WinHandle: HWND; Msg: UINT; wP: WParam; lP: LParam): LRESULT; stdcall;
begin
    Result := CallWindowProc(Pointer(PrevWndProcLB), WinHandle, Msg, wP, lP);

end;


end.

hab mal die ganze Unit reinkopiert.
Aufruf!

Delphi-Quellcode:

    hPlayList := TListBox.Create(hMain, PAnsiChar(SK_FOLDER + 'Panel.png'),
      19, 56, 583, 423, ID_PLAYLIST, SK_ACTIVECAPTION);

hMain = ApplicationsHandle

Mein Problem ist folgendes .
In der WinProc hMain gibt es so wie in der Listbox die Message 'WM_DRAWITEM:'
Rufe ich nun das Menü auf wird seltsamerweise die Funktion DrawItem(lP); an das Menu anstelle der ListBox
übergeben was sich so auswirkt das alle Einträge des selben um 20 Pixel nach rechts verschoben werden.
Bedingt durch diesen aufruf.

Delphi-Quellcode:

    PDis.rcItem.Left := PDis.rcItem.Left + 20;
    FillRect(PDis.hDC, PDis.rcItem, hBrush);

sag mir mal jemand warum ?
Warum wirkt sich die Proc der ListBox auf die der hMain aus. (ja ne blöde frage) ;)
Finde den Fehler einfach nicht.

gruss Emil

[Union]

Vielleicht deswegen:

Delphi-Quellcode:

FHOwner := hOwner; 
SubClass(FHOwner);

[EWeiss]

Zitat:

Zitat von Union

Vielleicht deswegen:

Delphi-Quellcode:

FHOwner := hOwner; 
SubClass(FHOwner);

Wie begründest du das ?
Das ist dass ParentHandle auf dem die ListBox aufgesetzt ist.

gruss Emil

[Sunlight7]

Ich lehn mich mal weit aism Fenster... (hoffentlich hat wer n Sprungtuch aufgespannt)

Delphi-Quellcode:

procedure DrawItem(lP: Integer);
   ...
   CopyMemory(@lP, @PDis, SizeOf(@PDis));
end

Ganz durchblicke ich Deinen Code nicht auf die Schnelle, aber überschreibst Du damit am Ende von DrawItem nicht die Strukture, die Du im WndProc/WM_DRAWITEM er lParam bekommst mit den veränderten Werten?
Schon ne? :gruebel:

[EWeiss]

Zitat:

Zitat von Sunlight7

Ich lehn mich mal weit aism Fenster... (hoffentlich hat wer n Sprungtuch aufgespannt)

Delphi-Quellcode:

procedure DrawItem(lP: Integer);
   ...
   CopyMemory(@lP, @PDis, SizeOf(@PDis));
end

Ganz durchblicke ich Deinen Code nicht auf die Schnelle, aber überschreibst Du damit am Ende von DrawItem nicht die Strukture, die Du im WndProc/WM_DRAWITEM er lParam bekommst mit den veränderten Werten?
Schon ne? :gruebel:

Ich schreibe ihn wieder zurück .. Jo
Anfang der Function

Delphi-Quellcode:

CopyMemory(@PDis, @lP, SizeOf(@PDis));

Wenn fertig zurücksetzen.

Delphi-Quellcode:

CopyMemory(@lP, @PDis, SizeOf(@PDis));

Kann mir das vereinfachen in dem ich mit dem PDIS auf lP zeige
könnte mir dann CopyMemory sparen.

PDis := Pointer(lP);

Das problem mit dem Menu hab ich geregelt allerdings bekomme ich so kein Event mehr auf die ListBox.
Muss vorher prüfen ob PDis^.CtlType ODT_LISTBOX oder ODT_MENU ist damit kann ich das falsche OwnerDraw abfangen.

gruss Emil

[Sunlight7]

Nun, wenn Du es bereits geköst hast ists egal, aber ich meine, Du kopierst den lp(wParam) nach DPis, dann änderst Du PDis und kopierst das geänderte zurück, deshalb verschiebt sich die Left Position, bei jedem Aufruf von DrawItem.

Oder war das so gewollt?

[EWeiss]

Zitat:

Zitat von Sunlight7

Nun, wenn Du es bereits geköst hast ists egal, aber ich meine, Du kopierst den lp(wParam) nach DPis, dann änderst Du PDis und kopierst das geänderte zurück, deshalb verschiebt sich die Left Position, bei jedem Aufruf von DrawItem.

Oder war das so gewollt?

Jo.
Weil jede zeile für sich 20 Pixel nach rechts verschoben werden muss.
Vor jeden eintrag sollen ja nachher Bitmaps stehen.

Die Funktion wird also so oft aufgerufen wie sich Zeilen in der ListBox befinden.
Nur ich komm nicht rein in ODT_LISTBOX
Muss mal schaun da noch ein aufruf beim erstellen der listBox fehlt.

gruss Emil

[lbccaleb]

Zitat:

Zitat von EWeiss

Mein Problem ist folgendes .
In der WinProc hMain gibt es so wie in der Listbox die Message 'WM_DRAWITEM:'
Rufe ich nun das Menü auf wird seltsamerweise die Funktion DrawItem(lP); an das Menu anstelle der ListBox
übergeben was sich so auswirkt das alle Einträge des selben um 20 Pixel nach rechts verschoben werden.

Also wenn ich mich recht erinnere, ist das so, wenn der wParam Parameter von WM_DRAWITEM "0" ist, dann wird das Menü der Anwendung bearbeitet!

Ich kann so schnell deine Funktion nicht ganz nachverfolgen, aber baue doch mal ne Abfrage auf "0" ein!

Delphi-Quellcode:

if INTEGER(wP) > 0 then DrawItem(lP);

Eventuell musst du auch an anderer Stelle dafür sorgen das wP in dem Fall nicht 0 ist! Aber wie gesagt so genau kenn ich mich da mit deinem Code nicht aus!

Das ist aber nur eine Vermutung... Kein Gewähr^^

mfg

[EWeiss]

Zitat:

Zitat von lbccaleb

Zitat:

Zitat von EWeiss

Mein Problem ist folgendes .
In der WinProc hMain gibt es so wie in der Listbox die Message 'WM_DRAWITEM:'
Rufe ich nun das Menü auf wird seltsamerweise die Funktion DrawItem(lP); an das Menu anstelle der ListBox
übergeben was sich so auswirkt das alle Einträge des selben um 20 Pixel nach rechts verschoben werden.

Also wenn ich mich recht erinnere, ist das so, wenn der wParam Parameter von WM_DRAWITEM "0" ist, dann wird das Menü der Anwendung bearbeitet!

Ich kann so schnell deine Funktion nicht ganz nachverfolgen, aber baue doch mal ne Abfrage auf "0" ein!

Delphi-Quellcode:

if INTEGER(wP) > 0 then DrawItem(lP);

Eventuell musst du auch an anderer Stelle dafür sorgen das wP in dem Fall nicht 0 ist! Aber wie gesagt so genau kenn ich mich da mit deinem Code nicht aus!

Das ist aber nur eine Vermutung... Kein Gewähr^^

mfg

Es gibt da fertige Flags ODT_MENU für Menüs
und ODT_LISTBOX für ListBoxen und einige mehr
ODT_MENU = 1
ODT_LISTBOX = 2 usw.

Abgfragt werden sie

Delphi-Quellcode:

      WM_DRAWITEM:
      begin
        PDis := Pointer(lP);
        case PDis^.CtlType  of
          ODT_MENU: // 1 Ownerdrawn menu item
          begin

Mein Problem ist nun das ich nie in ODT_LISTBOX hineinkommme weiss der Teufel warum.
Alle anderen Messagen der ListBox werden Ordnungsgemäß ausgeführt.
MouseWheel usw..

gruss EMil

[lbccaleb]

Was genau meinst du mit du kommst nicht herrein?
Wie gesagt, wenn der Parameter "0" ist, gehts an Menü...

[EWeiss]

Zitat:

Zitat von lbccaleb

Was genau meinst du mit du kommst nicht herrein?
Wie gesagt, wenn der Parameter "0" ist, gehts an Menü...

Keine Ahnung was du mit 0 hast.
Ich erfrage nicht WP sondern LP hab ich doch geschrieben.

Es geht dann ans Menu wenn
PDis^.CtlType := ODT_MENU ist und das Flag ist mit den wert 1 deklariert.

gruss Emil

[Sunlight7]

Zitat:

WM_DRAWITEM

idCtl = (UINT) wParam; // control identifier
lpdis = (LPDRAWITEMSTRUCT) lParam; // item-drawing information


The WM_DRAWITEM message is sent to the owner window of an owner-drawn button, combo box, list box, or menu when a visual aspect of the button, combo box, list box, or menu has changed.

Parameters

idCtl

Value of wParam. Specifies the identifier of the control that sent the WM_DRAWITEM message. If the message was sent by a menu, this parameter is zero.

lpdis

Value of lParam. Points to a DRAWITEMSTRUCT structure containing information about the item to be drawn and the type of drawing required.

Return Value

If an application processes this message, it should return TRUE.

Das meinte er mit der 0

[EWeiss]

Ja!
aber helfen tut mir das nicht denn wie dort beschrieben muß ein DrawEvent ausgelößt werden

Zitat:

when a visual aspect of the list box has changed.

von der ListBox damit ich in die Message WM_DRAWITEM hineingelange.

damit meine ich in vorherigen Beitrag ich komm da nicht rein
obwohl der Text usw.. gezeichnet wird.

Kann mir nur noch vorstellen das eventuell der Focus zur ListBox verloren geht.

gruss Emil

[Sunlight7]

Wenn Du LBS_OWNERDRAWFIXED auskommentierst irgendwie kein Wunder, das die MSG nicht kommt ;)
Du kannst IMHO Windows nicht direkt zwingen so eine Nachricht zu generieren, das macht es, wenn was neu zu zeichnen ist.

Definiere "// LBS_OWNERDRAWFIXED verursacht ärger keine ahnung warum".

So mal geraten, der Ärger hat mit fehlendem WM_MEASUREITEM zu tun?

[EWeiss]

Zitat:

Wenn Du LBS_OWNERDRAWFIXED auskommentierst irgendwie kein Wunder, das die MSG nicht kommt ;)

Ja stimmt hab es im nachhinein auch bemerkt. ;)
LBS_OWNERDRAWFIXED hat auch kein problem verursacht sondern das zeichnen des Text über

Delphi-Quellcode:

DTP.cbSize := SizeOf(DTP);
    DrawTextEx(PDis.hDC, ItemText, l, PDis.rcItem, DT_LEFT
      or DT_VCENTER or DT_SINGLELINE, @DTP);

DrawTextEx will irgendwie nicht.
Hab mal ne kleine Anwendung in VB gemacht um das gegen zu prüfen da funktioniert alles
Unter Delphi will das nicht.

verwende jetzt

Delphi-Quellcode:

    ExtTextOut(PDis.hDC, 1 + PDis.rcItem.left,
      PDis.rcItem.Top, ETO_OPAQUE,
      @PDis.rcItem, PAnsiChar(ItemText), Length(ItemText),  nil);

anstelle dessen.
Die Frage ist nur was besser ist.

Zitat:

Du kannst IMHO Windows nicht direkt zwingen so eine Nachricht zu generieren, das macht es, wenn was neu zu zeichnen ist.

Das ist klar ... hab mir schon gedacht das was fehlt siehe LBS_NOTIFY in verbindung mit LBN_DBLCLK
Geht ohne LBS_NOTIFY auch nicht ;)

Zitat:

So mal geraten, der Ärger hat mit fehlendem WM_MEASUREITEM zu tun?

Benötige ich nur für das Menü und ist vorhanden.
Die Proc in der ListBox hab ich rausgeschmissen und leite die SubClass jetzt direkt auf
die Winproc der mainform um.

gruss Emil

EDIT:
Noch ein pic
Nur noch ein Bitmap für den Hintergrund der Listbox dann ist es fertig
Und noch was an den farben machen.