![]() |
Winproc ärger
Delphi-Quellcode:
hab mal die ganze Unit reinkopiert.
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. Aufruf!
Delphi-Quellcode:
hMain = ApplicationsHandle
hPlayList := TListBox.Create(hMain, PAnsiChar(SK_FOLDER + 'Panel.png'),
19, 56, 583, 423, ID_PLAYLIST, SK_ACTIVECAPTION); 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:
sag mir mal jemand warum ?
PDis.rcItem.Left := PDis.rcItem.Left + 20;
FillRect(PDis.hDC, PDis.rcItem, hBrush); Warum wirkt sich die Proc der ListBox auf die der hMain aus. (ja ne blöde frage) ;) Finde den Fehler einfach nicht. gruss Emil |
Re: Winproc ärger
Vielleicht deswegen:
Delphi-Quellcode:
FHOwner := hOwner;
SubClass(FHOwner); |
Re: Winproc ärger
Zitat:
Das ist dass ParentHandle auf dem die ListBox aufgesetzt ist. gruss Emil |
Re: Winproc ärger
Ich lehn mich mal weit aism Fenster... (hoffentlich hat wer n Sprungtuch aufgespannt)
Delphi-Quellcode:
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?
procedure DrawItem(lP: Integer);
... CopyMemory(@lP, @PDis, SizeOf(@PDis)); end Schon ne? :gruebel: |
Re: Winproc ärger
Zitat:
Anfang der Function
Delphi-Quellcode:
Wenn fertig zurücksetzen.
CopyMemory(@PDis, @lP, SizeOf(@PDis));
Delphi-Quellcode:
Kann mir das vereinfachen in dem ich mit dem PDIS auf lP zeige
CopyMemory(@lP, @PDis, SizeOf(@PDis));
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 |
Re: Winproc ärger
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? |
Re: Winproc ärger
Zitat:
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 |
Re: Winproc ärger
Zitat:
Ich kann so schnell deine Funktion nicht ganz nachverfolgen, aber baue doch mal ne Abfrage auf "0" ein!
Delphi-Quellcode:
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!
if INTEGER(wP) > 0 then DrawItem(lP);
Das ist aber nur eine Vermutung... Kein Gewähr^^ mfg |
Re: Winproc ärger
Zitat:
und ODT_LISTBOX für ListBoxen und einige mehr ODT_MENU = 1 ODT_LISTBOX = 2 usw. Abgfragt werden sie
Delphi-Quellcode:
Mein Problem ist nun das ich nie in ODT_LISTBOX hineinkommme weiss der Teufel warum.
WM_DRAWITEM:
begin PDis := Pointer(lP); case PDis^.CtlType of ODT_MENU: // 1 Ownerdrawn menu item begin Alle anderen Messagen der ListBox werden Ordnungsgemäß ausgeführt. MouseWheel usw.. gruss EMil |
Re: Winproc ärger
Was genau meinst du mit du kommst nicht herrein?
Wie gesagt, wenn der Parameter "0" ist, gehts an Menü... |
Alle Zeitangaben in WEZ +1. Es ist jetzt 09:53 Uhr. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz