slistview.pas

Alpha Controls.v5.46b Source

procedure TsCustomListView.CMMouseLeave(var Msg: TMessage);
var
  p : TPoint;
  r : TRect;
begin
  if FCommonData.Skinned and (ViewStyle = vsReport) then begin
    p := ClientToScreen(Point(Left, Top));
    r := Rect(p.x, p.y, p.x + Width, p.y + Height);
    p := Mouse.CursorPos;

    if not PtInRect(r, p) then inherited;

    if (HoverColIndex >= 0) then begin
      HoverColIndex := -2;
      PaintHeader;
    end;
  end;
  inherited;
end;

procedure TsCustomListView.HeaderWndProc(var Message: TMessage);
var
  Info : THDHitTestInfo;
  CurIndex, w : integer;
  function MouseToColIndex(p : TSmallPoint) : integer;
  var
    ltPoint : TPoint;
    i, c : integer;
    rc : TRect;
  begin
    w := 0;
    if Assigned(ListSW.sBarHorz) then w := ListSW.sBarHorz.ScrollInfo.nPos else w := 0;
    ltPoint := ScreenToClient(Point(p.x + w, p.y));
    Result := -2;
    c := (Header_GetItemCount(FhWndHeader) - 1);
    for i := 0 to c do begin
      rc := GetHeaderColumnRect(i);
      if PtInRect(rc, ltPoint) then begin
        Result := i;
        exit;
      end;
    end;
  end;
begin
  if (ViewStyle = vsReport) and Assigned(FCommonData) and FCommonData.Skinned then begin
    try
      with Message do begin
        case Msg of
          WM_NCHITTEST : if ColumnClick then begin
            Result := CallWindowProc(FhDefHeaderProc, FhWndHeader, Msg, WParam, LParam);
            if FCommonData.Skinned and FHighLightHeaders then begin
              CurIndex := MouseToColIndex(TWMNCHitTest(Message).Pos);
              if HoverColIndex <> CurIndex then begin
                HoverColIndex := CurIndex;
                PaintHeader;
              end;
            end;
          end;
          WM_LBUTTONUP: if ColumnClick then begin
            FPressedColumn := -1;
            FFlag := False;
          end;
          WM_PRINT : begin
            PaintHeader
          end;
          WM_PAINT: if FCommonData.Skinned then begin
            PaintHeader;
            Exit;
          end;
          WM_ERASEBKGND: Exit;
          WM_NCDESTROY: begin
            Result := CallWindowProc(FhDefHeaderProc, FhWndHeader, Msg, WParam, LParam);
            FhWndHeader := 0;
            FhDefHeaderProc := nil;
            Exit;
          end;
        end;
        Result := CallWindowProc(FhDefHeaderProc, FhWndHeader, Msg, WParam, LParam);
        case Msg of
          WM_LBUTTONDOWN: if ColumnClick then begin
            FFlag := True;
            Info.Point.X := TWMMouse(Message).XPos;
            Info.Point.Y := TWMMouse(Message).YPos;
            SendMessage(FhWndHeader, HDM_HITTEST, 0, Integer(@Info));

            if (Info.Flags and HHT_ONDIVIDER = 0) and (Info.Flags and HHT_ONDIVOPEN = 0) then begin
              FPressedColumn := {a[}Info.Item//] else FPressedColumn := -1;
            end
            else FPressedColumn := -1;
            RedrawWindow(FhWndHeader, nil, 0, RDW_INVALIDATE);
          end;
          WM_MOUSEMOVE : begin
            if FFlag then UpdateScrolls(ListSW, True)
          end;
        end;
      end;
    except
      Application.HandleException(Self);
    end;
  end
  else with Message do
    Result := CallWindowProc(FhDefHeaderProc, FhWndHeader, Msg, WParam, LParam);
end;

procedure TsCustomListView.WMParentNotify(var Message: TWMParentNotify);
var
  WndName : string;
begin
  try
    with Message do begin
      SetLength(WndName, 96);
      SetLength(WndName, GetClassName(ChildWnd, PChar(WndName), Length(WndName)));
      if (Event = WM_CREATE) and (WndName = 'SysHeader32') then begin
        if (FhWndHeader <> 0) then begin
          SetWindowLong(FhWndHeader, GWL_WNDPROC, LongInt(FhDefHeaderProc));
          FhWndHeader := 0;
        end;
        if (FhWndHeader = 0) then begin
          FhWndHeader := ChildWnd;
          FhDefHeaderProc := Pointer(GetWindowLong(FhWndHeader, GWL_WNDPROC));
          SetWindowLong(FhWndHeader, GWL_WNDPROC, LongInt(FhHeaderProc));
        end;
      end else
      if (Event = WM_DESTROY) and (WndName = 'SysHeader32') then begin
        if (FhWndHeader <> 0) then begin
          SetWindowLong(FhWndHeader, GWL_WNDPROC, LongInt(FhDefHeaderProc));
          FhWndHeader := 0;
        end;
        if (FhWndHeader = 0) then begin
          FhWndHeader := ChildWnd;
          FhDefHeaderProc := Pointer(GetWindowLong(FhWndHeader, GWL_WNDPROC));
          SetWindowLong(FhWndHeader, GWL_WNDPROC, LongInt(FhHeaderProc));
        end;
      end;
    end;
  except
    Application.HandleException(Self);
  end;
  inherited;
end;

procedure TsCustomListView.PaintHeader;
var
  i, count, RightPos : Integer;
  rc, HeaderR : TRect;
  PS : TPaintStruct;
begin
  BeginPaint(FhWndHeader, PS);
  try
    if not FCommonData.FCacheBmp.Empty then begin
      RightPos := 0;
      count := Header_GetItemCount(FhWndHeader) - 1;
      if count > -1 then begin
        // Draw Columns Headers
        for i := 0 to count do begin
          rc := GetHeaderColumnRect(i);
          if not IsRectEmpty(rc) then begin
            ListLineHeight := HeightOf(rc);
            ColumnSkinPaint(rc, i);
          end;
          if RightPos < rc.Right then RightPos := rc.Right;
        end;
      end
      else begin
        rc := GetHeaderColumnRect(0);
        ListLineHeight := HeightOf(rc);
      end;

      // Draw background section
      if Windows.GetWindowRect(FhWndHeader, HeaderR) then begin
        rc := Rect(RightPos, 0, WidthOf(HeaderR), HeightOf(HeaderR));
        if not IsRectEmpty(rc) then begin ColumnSkinPaint(rc, -1); end;
      end;
    end;
  finally
    EndPaint(FhWndHeader, PS);
  end;
end;

function TsCustomListView.GetHeaderColumnRect(Index: Integer): TRect;
var
  SectionOrder : array of Integer;
  rc : TRect;
begin
  if Self.FullDrag then begin
    SetLength(SectionOrder, Columns.Count);
    Header_GetOrderArray(FhWndHeader, Columns.Count, PInteger(SectionOrder));
    Header_GETITEMRECT(FhWndHeader, SectionOrder[Index] , @rc);
  end
  else begin
    Header_GETITEMRECT(FhWndHeader, Index, @rc);
  end;
  Result := rc;
end;

procedure TsCustomListView.ColumnSkinPaint(ControlRect : TRect; cIndex : Integer);
var
  CI : TCacheInfo;
  R, TextRC   : TRect;
  tmpdc : HDC;
  TempBmp : Graphics.TBitmap;
  State, si, bWidth : integer;
  sci : TScrollInfo;
begin
  try
    TempBmp := CreateBmp24(WidthOf(ControlRect), HeightOf(ControlRect));
    bWidth := 1 + integer(BorderStyle) * (1 + integer(Ctl3D));
    CI := MakeCacheInfo(FCommonData.FCacheBmp, ControlRect.Left + bWidth, ControlRect.Top + bWidth);
    R := Rect(0, 0, TempBmp.Width, TempBmp.Height);

    if FPressedColumn >= 0 then begin
      State := iffi(FPressedColumn = cIndex, 2, 0);
    end
    else begin
      if HoverColIndex = cIndex then State := 1 else State := 0;
    end;

    si := FCommonData.SkinManager.GetSkinIndex(s_ColHeader);
    if (ListSW <> nil) and (ListSW.sBarHorz <> nil) and ListSW.sBarHorz.fScrollVisible then begin
      sci.cbSize := SizeOf(TScrollInfo);
      sci.fMask := SIF_ALL;
      GetScrollInfo(Handle, SB_HORZ, sci);
    end
    else sci.npos := 0;
    if FCommonData.SkinManager.IsValidSkinIndex(si) then begin
      PaintItem(si, s_ColHeader, Ci, True, State, r, Point(-sci.npos, 0), TempBmp)
    end
    else begin
      si := FCommonData.SkinManager.GetSkinIndex(s_Button);
      PaintItem(si, s_Button, Ci, True, State, r, Point(-sci.npos, 0), TempBmp);
    end;

    TempBmp.Canvas.Font.Assign(Font);
    TextRC := R;
    InflateRect(TextRC, 0, -1);
    TextRc.Left := TextRc.Left + 4 + integer(State = 2);
    TextRc.Right := TextRc.Right - TextRc.Left - 4 + integer(State = 2);
    TextRc.Top := TextRc.Top + integer(State = 2);
    TextRc.Bottom := TextRc.Bottom + integer(State = 2);

    TempBmp.Canvas.Brush.Style := bsClear;
    if cIndex >= 0 then begin
      if (Length(Columns[cIndex].Caption) > 0) or (Columns[cIndex].ImageIndex >= 0) then begin
        if Assigned(SmallImages) and (Columns[cIndex].ImageIndex >= 0) then begin
          if Columns[cIndex].Alignment <> taRightJustify then OffsetRect(TextRc, SmallImages.Width, 0);
          {$IFDEF TNTUNICODE}
          WriteTextExW(TempBmp.Canvas, PWideChar(Columns[cIndex].Caption), True, TextRc,
             DrawTextBiDiModeFlags(DT_EXPANDTABS or DT_WORDBREAK or GetStringFlags(Self, Columns[cIndex].Alignment)),
             Si, (State <> 0), FCommonData.SkinManager);
          {$ELSE}
          WriteTextEx(TempBmp.Canvas, PChar(Columns[cIndex].Caption), True, TextRc,
             DrawTextBiDiModeFlags(DT_EXPANDTABS or DT_WORDBREAK or GetStringFlags(Self, Columns[cIndex].Alignment)),
             Si, (State <> 0), FCommonData.SkinManager);
          {$ENDIF}
          SmallImages.Draw(TempBmp.Canvas, 4 + integer(State = 2), integer(State = 2), Columns[cIndex].ImageIndex, Enabled);
        end
        else begin
          {$IFDEF TNTUNICODE}
          WriteTextExW(TempBmp.Canvas, PWideChar(Columns[cIndex].Caption), True, TextRc,
             DrawTextBiDiModeFlags(DT_EXPANDTABS or DT_WORDBREAK or GetStringFlags(Self, Columns[cIndex].Alignment)),
             Si, (State <> 0), FCommonData.SkinManager);
          {$ELSE}
          WriteTextEx(TempBmp.Canvas, PChar(Columns[cIndex].Caption), True, TextRc,
             DrawTextBiDiModeFlags(DT_EXPANDTABS or DT_WORDBREAK or GetStringFlags(Self, Columns[cIndex].Alignment)),
             Si, (State <> 0), FCommonData.SkinManager);
          {$ENDIF}
        end;
      end;
    end;

    if acPrintDC = 0 then tmpdc := GetDC(FhWndHeader) else tmpdc := acPrintDC;
    try
      BitBlt(tmpdc, ControlRect.Left, ControlRect.Top, R.Right, R.Bottom, TempBmp.Canvas.Handle, 0, 0, SRCCOPY);
    finally
      if acPrintDC = 0 then ReleaseDC(FhWndHeader, tmpdc);
    end;
    TempBmp.Free
  except
    Application.HandleException(Self);
  end;
end;

procedure TsCustomListView.PrepareCache;
begin
  try
    FCommonData.InitCacheBmp;
    GetParentCache(FCommonData);
    PaintItem(FCommonData,
                 GlobalCacheInfo,
                 False, 0,
                 Rect(0, 0, Width, Height),
                 Point(Left, Top),
                 FCommonData.FCacheBmp, False
               );
    FCommonData.BGChanged := False;
  except
  end;
end;

procedure TsCustomListView.WMHitTest(var Message: TMessage);
begin
  inherited;
  if FCommonData.Skinned and (HoverColIndex > -1) and FHighLightHeaders then begin
    HoverColIndex := -2;
    PaintHeader;
  end;
end;

function TsCustomListView.AllColWidth: integer;
var
  i, w, c : integer;
begin
  Result := 0;
  c := Columns.Count - 1;
  for i := 0 to c do begin
    try
      w := integer(ListView_GetColumnWidth(Handle, i));
      if abs(w) > 999999 then Exit;
      Result := integer(Result + w);
    except
    end;
  end
end;

procedure TsCustomListView.NewAdvancedCustomDraw(Sender: TCustomListView; const ARect: TRect; Stage: TCustomDrawStage; var DefaultDraw: Boolean);
var
  SavedDC : hdc;
  i, TopIndex, LastIndex : integer; // v4.71
  R : TRect;
begin
  // inherite...
  if not (csDesigning in ComponentState) and Assigned(FOldAdvancedCustomDraw) then FOldAdvancedCustomDraw(Sender, Arect, Stage, DefaultDraw) else begin
    if (Stage in [cdPreErase, cdPrePaint]) then begin
      FCommonData.Updating := FCommonData.Updating;
      if FCommonData.Updating then Exit;
      if SkinData.BGChanged then PrepareCache;
      if FullRepaint then begin
        SavedDC := SaveDC(Canvas.Handle);
        if (Stage in [cdPrePaint]) and LocalFlag then begin
          if not (ViewStyle in [vsSmallIcon, vsIcon]) then TopIndex := ListView_GetTopIndex(Handle) else TopIndex := 0;
          if ViewStyle in [vsReport, vsList] then LastIndex:= TopIndex + ListView_GetCountPerPage(Handle) -1 else LastIndex := Items.Count - 1;
          for i := TopIndex to LastIndex do begin
            if ListView_GetItemRect(Handle, i, R, LVIR_ICON) then ExcludeClipRect(Canvas.Handle, R.Left, R.Top, R.Right, R.Bottom);
            if ListView_GetItemRect(Handle, i, R, LVIR_LABEL) then ExcludeClipRect(Canvas.Handle, R.Left, R.Top, R.Right, R.Bottom);
          end;
        end;
        BitBlt(Canvas.Handle, 0, 0, ClientWidth, ClientHeight, FCommonData.FCacheBmp.Canvas.Handle,
                        integer(BorderStyle = bsSingle) * 2, integer(BorderStyle = bsSingle) * 2, SRCCOPY);
        RestoreDC(Canvas.Handle, SavedDC);
        if (Stage in [cdPrePaint]) and not SkinData.CustomColor then begin
          // Ensure that the items are drawn transparently
          SetBkMode(Canvas.Handle, TRANSPARENT);
          ListView_SetTextBkColor(Handle, CLR_NONE);
          ListView_SetBKColor(Handle, CLR_NONE);
        end;
      end
      else if not SkinData.CustomColor then begin
        ParentCenterColor := clFuchsia;
        SendMessage(Handle, SM_ALPHACMD, MakeWParam(0, AC_GETCONTROLCOLOR), 0);
        if (ParentCenterColor <> clFuchsia) and (ParentCenterColor <> Color) then Color := ColorToRGB(ParentCenterColor);
        ParentCenterColor := clFuchsia;
      end;
      if Stage = cdPreErase then DefaultDraw := False
    end else if Stage = cdPostErase then DefaultDraw := False
  end
end;

function TsCustomListView.FullRepaint: boolean;
begin
Result := False;
//  Result := (GetBoolMsg(Self, AC_CHILDCHANGED) or FCommonData.RepaintIfMoved);// and not (csDesigning in ComponentState);
end;

procedure TsCustomListView.InvalidateSmooth(Always : boolean);
begin
  if FullRepaint then begin
    if Always then InvalidateRect(Handle, nil, False) else case ViewStyle of
      vsList : begin
        if (ListSW.sBarHorz.ScrollInfo.nPos < ListSW.sBarHorz.ScrollInfo.nMax - 1) and
          (ListSW.sBarHorz.ScrollInfo.nPos > ListSW.sBarHorz.ScrollInfo.nMin) then InvalidateRect(Handle, nil, False);
      end;
      vsReport : begin
        GetScrollInfo(Handle, SB_VERT, ListSW.sBarVert.ScrollInfo);
        if (ListSW.sBarVert.ScrollInfo.nPos < ListSW.sBarVert.ScrollInfo.nMax - Font.Size - 3) and
          (ListSW.sBarVert.ScrollInfo.nPos > ListSW.sBarVert.ScrollInfo.nMin) then InvalidateRect(Handle, nil, False);
      end;
    end;
  end;
end;

end.