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
 
EWeiss
(Gast)

n/a Beiträge
 
#1

Winproc ärger

  Alt 28. Jan 2009, 16: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
 


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 07:14 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