Component handling win msgs screws up source load in IDE - why?

Giganews Newsgroups
Subject: Component handling win msgs screws up source load in IDE - why?
Posted by:  Jan Doggen
Date: Tue, 13 Jul 2010

Hi everyone

My D2007 IDE sometimes hangs when opening a form. I narrowed it down to a component being installed. That component is handling Windows messages, and I suspect that is the cause (probably doing something at design time that is not supposed to be done, or not correctly implemented).

Below are the suspect routines (sorry, long). Can anyone point me to the error(s) causing the hang?

Thanks very much
Jan

{code}
type
  TListViewExZw = class(TListView)
  private
    { Private declarations }
    FBKColor    :TColor;
    FVScrollBar :TALScrollBar;  // This is a 'flat' scrollbar component elsewhere
    FHScrollBar :TALScrollBar;
    FVPos, FHPos:integer;
    BHScroll,BVScroll:boolean;
    procedure SetHeaderStyle(phd:PHDNotify);
    procedure DrawHeaderItem(pDS:PDrawItemStruct);
      { Protected declarations }
    procedure LVMSETCOLUMN(var  Message:  TMessage); message  LVM_SETCOLUMN;
    procedure WMSIZE(var Message:TMessage); message WM_SIZE;
    procedure DoHScroll(Sender:TObject;ScrollCode: TScrollCode;var ScrollPos: Integer);
    procedure DoVScroll(Sender:TObject;ScrollCode: TScrollCode;var ScrollPos: Integer);
  public
    { Public declarations }
    procedure WndProc(var Message : TMessage); override;
    procedure RefreshScrollBar;
    procedure CreateScrollBar;
  published
    { Published declarations }
    property BackColor: TColor read FBKColor write SetBackColor;
    property VScrollBar: TALScrollBar read FVScrollBar write FVScrollBar;
    property HScrollBar: TALScrollBar read FHScrollBar write FHScrollBar;
  end;

implementation

procedure TListViewExZw.WndProc(var Message : TMessage);
var
  pDS :PDrawItemStruct;
  phd :PHDNotify;
begin
  inherited WndProc(Message);
  with Message do
  case Msg of
    WM_DRAWITEM :
    begin
      pDS := PDrawItemStruct(Message.lParam);
      if pDS.CtlType<>ODT_MENU then
      begin
        DrawHeaderItem(pDS);
        Result := 1;
      end;
    end;
    WM_NOTIFY:
    begin
      phd := PHDNotify(Message.lParam);
      if (phd.Hdr.hwndFrom = GetDlgItem(Handle, 0)) then
      Case phd.Hdr.code of
      HDN_ENDTRACK,HDN_ENDTRACKW,HDN_ITEMCHANGED:
      begin
        SetHeaderStyle(phd);
        InvalidateRect(GetDlgItem(Handle, 0), nil, true);
      end;
      end;
    end;
    WM_MOUSEWHEEL:
    begin
      BHScroll := false;
      BVScroll := False;
      RefreshScrollBar;
    end;
    WM_KEYDOWN:
    begin
      if (wparam=VK_RIGHT) or  (wparam=VK_LEFT) then
      begin
        BHScroll := false;
        RefreshScrollBar;
      end;
      if (wparam=VK_UP) or  (wparam=VK_DOWN) or (wparam=VK_HOME) or (wparam=VK_END)
      or (wparam=VK_PRIOR) or (wparam=VK_NEXT) then
      begin
        BVScroll := False;
        RefreshScrollBar;
      end;
    end;
  end;
end; { WndProc }

procedure TListViewExZw.DrawHeaderItem(pDS :PDrawItemStruct);
var
  tmpCanvas :TCanvas;
  MaxWidth : Integer;
begin
  tmpCanvas := TCanvas.Create;
  tmpCanvas.Handle:=pDS.hDC;
  tmpCanvas.Brush.Color := FBKColor;
//  if pDS.itemID = 0 then
//    tmpCanvas.FillRect(Rect(pDS^.rcItem.Left,pDS^.rcItem.Top,pDS^.rcItem.Left + ClientWidth,pDS^.rcItem.Bottom));
  if pDS^.rcItem.Right > ClientWidth then  //max(pDS^.rcItem.Right,pDS^.rcItem.Left + ClientWidth)
    MaxWidth := pDS^.rcItem.Right
  else
    MaxWidth := ClientWidth;
  tmpCanvas.FillRect(Rect(pDS^.rcItem.Left, pDS^.rcItem.Top, MaxWidth, pDS^.rcItem.Bottom));
  tmpCanvas.Brush.Style:=bsClear;
  tmpCanvas.TextRect(pDS^.rcItem,pDS^.rcItem.Left+6,pDS^.rcItem.Top+2,Columns[pDS^.itemID].Caption);
  tmpCanvas.Free;
end; { DrawHeaderItem }

procedure TListViewExZw.SetHeaderStyle(phd:PHDNotify);
var
  i :integer;
  hdi :THDItem;
begin
  for i := 0 to Columns.Count - 1 do
  begin
    hdi.Mask:= HDF_STRING or HDI_FORMAT;
    hdi.fmt := HDF_STRING or HDF_OWNERDRAW;
    Header_SetItem(phd.Hdr.hwndFrom, i, hdi);
  end;
end; { SetHeaderStyle }

procedure  TListViewExZw.LVMSETCOLUMN(var  Message:  TMessage);
var
  Lv:  PLVColumn;
begin
  inherited;
  Lv  :=  Pointer(Message.LParam);
  if  LVCF_WIDTH and  Lv.mask  <>  0  then
    Repaint;
  RefreshScrollBar;
end; { LVMSETCOLUMN }

procedure TListViewExZw.RefreshScrollBar;
var
  nStyle :integer;
  sbInfo: TScrollBarInfo;
  scInfo :TScrollInfo;
  rc:TRect;
begin
  nStyle := GetWindowlong(Handle, GWL_STYLE);
  if (nStyle and WS_HSCROLL) <> 0 then
  begin
    if Assigned(FHScrollBar) then
    begin
      sbInfo.cbSize := sizeof(sbInfo);
      GetScrollBarInfo(Handle,OBJID_HSCROLL,sbInfo);
      rc.TopLeft := Parent.ScreenToClient(sbInfo.rcScrollBar.TopLeft);
      rc.BottomRight := Parent.ScreenToClient(sbInfo.rcScrollBar.BottomRight);
      FHScrollBar.Visible := True;
      FHScrollBar.Left := rc.Left;
      FHScrollBar.Top := rc.Top;
      FHScrollBar.Width := rc.Right - rc.Left;
      FHScrollBar.Height := rc.Bottom - rc.Top;

      scInfo.cbSize := sizeof(scInfo);
      scInfo.fMask := SIF_ALL;
      GetScrollInfo(Handle,SB_HORZ,scInfo);
      FHScrollBar.Min := scInfo.nMin;
      FHScrollBar.Max := scInfo.nMax - scInfo.nPage + 1;
      FHScrollBar.LargeChange  := scInfo.nPage;
      FHScrollBar.SmallChange := 6;
      FHScrollBar.Position := scInfo.nPos;
      FHPos := FHScrollBar.Position;
      BHScroll := true;
    end;
  end
  else
  begin
    if Assigned(FHScrollBar) then
    begin
      FHScrollBar.Visible := False;
    end;
  end;

  if (nStyle and WS_VSCROLL) <> 0 then
  begin
    if Assigned(FVScrollBar) then
    begin
      sbInfo.cbSize := sizeof(sbInfo);
      GetScrollBarInfo(Handle,OBJID_VSCROLL,sbInfo);
      rc.TopLeft := Parent.ScreenToClient(sbInfo.rcScrollBar.TopLeft);
      rc.BottomRight := Parent.ScreenToClient(sbInfo.rcScrollBar.BottomRight);
      FVScrollBar.Visible := True;
      FVScrollBar.Left := rc.Left;
      FVScrollBar.Top := rc.Top;
      FVScrollBar.Width := rc.Right - rc.Left;
      FVScrollBar.Height := rc.Bottom - rc.Top;

      scInfo.cbSize := sizeof(scInfo);
      scInfo.fMask := SIF_ALL;
      GetScrollInfo(Handle,SB_VERT,scInfo);
      FVScrollBar.Min := scInfo.nMin;
      FVScrollBar.Max := scInfo.nMax - scInfo.nPage + 1;
      FVScrollBar.LargeChange  := scInfo.nPage;
      FVScrollBar.SmallChange := 1;
      FVScrollBar.Position := scInfo.nPos;
      FVPos := FVScrollBar.Position;
      BVscroll := True;
    end;
  end
  else
  begin
    if Assigned(FVScrollBar) then
    begin
      FVScrollBar.Visible := False;
    end;
  end;
end; { RefreshScrollBar }

procedure TListViewExZw.CreateScrollBar;
begin
  FVScrollBar := TALScrollBar.Create(Self);
  FVScrollBar.Parent := Parent;
  FVScrollBar.Color := FBKColor;
  FVScrollBar.Kind := sbVertical;
  FVScrollBar.Visible := False;
  FVScrollBar.OnScroll := DoVScroll;
  FVPos := 0;

  FHScrollBar := TALScrollBar.Create(Self);
  FHScrollBar.Parent := Parent;
  FHScrollBar.Color := FBKColor;
  FHScrollBar.Kind := sbHorizontal;
  FHScrollBar.Visible := False;
  FHScrollBar.OnScroll := DoHScroll;
  FHPos := 0;

//  RefreshScrollBar;
end; { CreateScrollBar }

procedure TListViewExZw.DoHScroll(Sender:TObject;ScrollCode: TScrollCode;var ScrollPos: Integer);
var
  dis: integer;
  dir: boolean;
begin
  inherited;
  if not BHScroll then
    exit;

  if ScrollPos >= FHScrollBar.Max then
  begin
    SendMessage(Handle,WM_HSCROLL,SB_RIGHT,0);
    exit;
  end;
  if ScrollPos <= FHScrollBar.Min then
  begin
    SendMessage(Handle,WM_HSCROLL,SB_LEFT,0);
    exit;
  end;
  dis := ScrollPos - FHPos;
  if dis < 0  then
    dir := False
  else
    dir := True;
  dis := abs(dis);
  while (dis >= FHScrollBar.SmallChange) do
  begin
    if dis >= FHScrollBar.LargeChange then
    begin
      if dir then
        SendMessage(Handle,WM_HSCROLL,SB_PAGERIGHT,0)
      else
        SendMessage(Handle,WM_HSCROLL,SB_PAGELEFT,0);
      dis := dis - FHScrollBar.LargeChange;
    end
    else
    begin
      if dir then
        SendMessage(Handle,WM_HSCROLL,SB_LINERIGHT,0)
      else
        SendMessage(Handle,WM_HSCROLL,SB_LINELEFT,0);
      dis := dis - FHScrollBar.SmallChange;
    end;
  end;
  if dir then
    ScrollPos := ScrollPos - dis
  else
    ScrollPos := ScrollPos + dis;
  FHPos := ScrollPos;
end; { DoHScroll }

procedure TListViewExZw.DoVScroll(Sender:TObject;ScrollCode: TScrollCode;var ScrollPos: Integer);
var
  dis: integer;
  dir: boolean;
begin
  inherited;
  if not BVScroll then
    exit;

  dis := ScrollPos - FVPos;
  if dis < 0  then
    dir := False
  else
    dir := True;
  dis := abs(dis);

  while dis >= FVScrollBar.SmallChange do
  begin
    if dis >= FVScrollBar.LargeChange then
    begin
      if dir then
        SendMessage(Handle,WM_VSCROLL,SB_PAGEDOWN,0)
      else
        SendMessage(Handle,WM_VSCROLL,SB_PAGEUP,0);
      dis := dis - FVScrollBar.LargeChange;
    end
    else
    begin
      if dir then
        SendMessage(Handle,WM_VSCROLL,SB_LINEDOWN,0)
      else
        SendMessage(Handle,WM_VSCROLL,SB_LINEUP,0);
      dis := dis - FVScrollBar.SmallChange;
    end;
  end;
  if dir then
    ScrollPos := ScrollPos - dis
  else
    ScrollPos := ScrollPos + dis;

  FVPos := ScrollPos;
end; { DoVScroll }

procedure TListViewExZw.WMSIZE(var Message:TMessage);
var
  sbInfo: TScrollBarInfo;
  scInfo :TScrollInfo;
  rc:TRect;
begin
  if Message.WParam = SIZE_RESTORED then
  begin
    if (Height - Message.LParamHi) > 13 then
    begin
      if Assigned(FHScrollBar) then
      begin
        sbInfo.cbSize := sizeof(sbInfo);
        GetScrollBarInfo(Handle,OBJID_HSCROLL,sbInfo);
        rc.TopLeft := Parent.ScreenToClient(sbInfo.rcScrollBar.TopLeft);
        rc.BottomRight := Parent.ScreenToClient(sbInfo.rcScrollBar.BottomRight);
        FHScrollBar.Visible := True;
        FHScrollBar.Left := rc.Left;
        FHScrollBar.Top := rc.Top;
        FHScrollBar.Width := rc.Right - rc.Left;
        FHScrollBar.Height := rc.Bottom - rc.Top;

        scInfo.cbSize := sizeof(scInfo);
        scInfo.fMask := SIF_ALL;
        GetScrollInfo(Handle,SB_HORZ,scInfo);
        FHScrollBar.Min := scInfo.nMin;
        FHScrollBar.Max := scInfo.nMax - scInfo.nPage + 1;
        FHScrollBar.LargeChange  := scInfo.nPage;
        FHScrollBar.SmallChange := 6;
        FHScrollBar.Position := scInfo.nPos;
      end;
    end
    else
    begin
      if Assigned(FHScrollBar) then
      begin
        FHScrollBar.Visible := False;
      end;
    end;

    if (Width - Message.LParamLo) > 13 then
    begin
      if Assigned(FVScrollBar) then
      begin
        sbInfo.cbSize := sizeof(sbInfo);
        GetScrollBarInfo(Handle,OBJID_VSCROLL,sbInfo);
        rc.TopLeft := Parent.ScreenToClient(sbInfo.rcScrollBar.TopLeft);
        rc.BottomRight := Parent.ScreenToClient(sbInfo.rcScrollBar.BottomRight);
        FVScrollBar.Visible := True;
        FVScrollBar.Left := rc.Left;
        FVScrollBar.Top := rc.Top;
        FVScrollBar.Width := rc.Right - rc.Left;
        FVScrollBar.Height := rc.Bottom - rc.Top;

        scInfo.cbSize := sizeof(scInfo);
        scInfo.fMask := SIF_ALL;
        GetScrollInfo(Handle,SB_VERT,scInfo);
        FVScrollBar.Min := scInfo.nMin;
        FVScrollBar.Max := scInfo.nMax - scInfo.nPage + 1;
        FVScrollBar.LargeChange  := scInfo.nPage;
        FVScrollBar.SmallChange := 1;
        FVScrollBar.Position := scInfo.nPos;
      end;
    end
    else
    begin
      if Assigned(FVScrollBar) then
      begin
        FVScrollBar.Visible := False;
      end;
    end;
  end;
  if Assigned(OnResize) then
    OnResize(Self);
end; { WMSIZE }
{code}

Replies