zusammenfalten · markieren

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!

markieren

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.

markieren

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

Vielleicht deswegen:

markieren

Delphi-Quellcode:

FHOwner := hOwner;
SubClass(FHOwner);

Zitat von Union:

Vielleicht deswegen:

markieren

Delphi-Quellcode:

FHOwner := hOwner;
SubClass(FHOwner);

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

gruss Emil

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

markieren

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?

Zitat von Sunlight7:

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

markieren

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?

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

CopyMemory(@PDis, @lP, SizeOf(@PDis)); Wenn fertig zurücksetzen.
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

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?

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

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!

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

Zitat von lbccaleb:

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!

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

markieren

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

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