AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Thema durchsuchen
Ansicht
Themen-Optionen

Winproc ärger

Ein Thema von EWeiss · begonnen am 28. Jan 2009 · letzter Beitrag vom 29. Jan 2009
Antwort Antwort
Seite 1 von 2  1 2      
EWeiss
(Gast)

n/a Beiträge
 
#1

Winproc ärger

  Alt 28. Jan 2009, 17:57
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
  Mit Zitat antworten Zitat
Benutzerbild von Union
Union

Registriert seit: 18. Mär 2004
Ort: Luxembourg
3.492 Beiträge
 
Delphi 7 Enterprise
 
#2

Re: Winproc ärger

  Alt 28. Jan 2009, 19:49
Vielleicht deswegen:
Delphi-Quellcode:
FHOwner := hOwner;
SubClass(FHOwner);
Ibi fas ubi proxima merces
sudo /Developer/Library/uninstall-devtools --mode=all
  Mit Zitat antworten Zitat
EWeiss
(Gast)

n/a Beiträge
 
#3

Re: Winproc ärger

  Alt 28. Jan 2009, 19:55
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
  Mit Zitat antworten Zitat
Benutzerbild von Sunlight7
Sunlight7

Registriert seit: 17. Sep 2006
Ort: Sonnensystem, Zentral
1.522 Beiträge
 
Delphi 5 Standard
 
#4

Re: Winproc ärger

  Alt 28. Jan 2009, 19:56
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?
Windows: Ja - Microsoft: Nein -> www.ReactOS.org
  Mit Zitat antworten Zitat
EWeiss
(Gast)

n/a Beiträge
 
#5

Re: Winproc ärger

  Alt 28. Jan 2009, 20:12
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?
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
  Mit Zitat antworten Zitat
Benutzerbild von Sunlight7
Sunlight7

Registriert seit: 17. Sep 2006
Ort: Sonnensystem, Zentral
1.522 Beiträge
 
Delphi 5 Standard
 
#6

Re: Winproc ärger

  Alt 28. Jan 2009, 20:26
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?
Windows: Ja - Microsoft: Nein -> www.ReactOS.org
  Mit Zitat antworten Zitat
EWeiss
(Gast)

n/a Beiträge
 
#7

Re: Winproc ärger

  Alt 28. Jan 2009, 20:38
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
  Mit Zitat antworten Zitat
Benutzerbild von lbccaleb
lbccaleb

Registriert seit: 25. Mai 2006
Ort: Rostock / Bremen
2.037 Beiträge
 
Delphi 7 Enterprise
 
#8

Re: Winproc ärger

  Alt 28. Jan 2009, 22:25
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
Martin
MFG Caleb
TheSmallOne (MediaPlayer)
Die Dinge werden berechenbar, wenn man die Natur einer Sache durchschaut hat (Blade)
  Mit Zitat antworten Zitat
EWeiss
(Gast)

n/a Beiträge
 
#9

Re: Winproc ärger

  Alt 28. Jan 2009, 22:41
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
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
  Mit Zitat antworten Zitat
Benutzerbild von lbccaleb
lbccaleb

Registriert seit: 25. Mai 2006
Ort: Rostock / Bremen
2.037 Beiträge
 
Delphi 7 Enterprise
 
#10

Re: Winproc ärger

  Alt 28. Jan 2009, 22:45
Was genau meinst du mit du kommst nicht herrein?
Wie gesagt, wenn der Parameter "0" ist, gehts an Menü...
Martin
MFG Caleb
TheSmallOne (MediaPlayer)
Die Dinge werden berechenbar, wenn man die Natur einer Sache durchschaut hat (Blade)
  Mit Zitat antworten Zitat
Antwort Antwort
Seite 1 von 2  1 2      


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 21:40 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