flatview.pas

comerose_flatstyle_v4.42.9.0_d7.rar

  BR, RA, CR: TRect;
  S: String;
  B: TBitMap;
  TX, TY, GX, GY: Integer;
begin
 if (RectWidth(R) <= 0) or (RectHeight(R) <= 0) then Exit;
 S := Column.Caption;
 B := TBitMap.Create;
 try
  B.Width  := RectWidth(R)+1;
  B.Height := RectHeight(R);
  BR := Rect(0, 0, B.Width, B.Height);
  with B.Canvas do
  begin
    if Pressed then begin
      if (not FCheckInBox)and(ColumnClick) then
         Brush.Color := BS_XP_BTNDOWNCOLOR
      else
         Brush.Color := FTitleFaceColor;
      if not(Column.Index = 0) then
         Inc(Br.Left);
      Dec(Br.Right);
    end else if Active then begin
       if (not FCheckInBox)and(ColumnClick) then
         Brush.Color := BS_XP_BTNACTIVECOLOR
       else
         Brush.Color := FTitleFaceColor;
    end else begin
       DrawFrame(B.Canvas, BR, FTitleFaceColor, FTitleFaceColor, 1);
       Brush.Color := FTitleFaceColor;// clBtnFace;
    end;
    FillRect(BR);
    if (Column.Index = 0)and(CheckBoxes) then
    begin
     RA := RECT(0,0,HeaderHeight,HeaderHeight);
     FillRect(RA);
     CR := RECT(RA.Left+1,RA.Top+1,RA.Right-1,RA.Bottom-1);
     // 画选定
     if AllCheck then
     begin
      DrawInCheck(B.Canvas,CR,FTitleCheckColor);
     end;
     BR := RECT(RA.Right+2,BR.Top,BR.Right,BR.Bottom);
    end;
    Frame3d(B.Canvas, CR, FTitleCheckColor, FTitleCheckColor, 2);
    Brush.Style := bsClear;
    Font.Assign(Self.Font);
    Font.Color  := clBtnText;
  end;
  if Assigned(FOnDrawTitle) then
     FOnDrawTitle(B.Canvas, Column, Pressed, Rect(0, 0, B.Width, B.Height))
  else with B.Canvas do begin
    Brush.Style := bsClear;
    Inc(BR.Left, 2); Dec(BR.Right, 2);
    if (SmallImages <> nil) and (Column.ImageIndex >= 0) and
       (Column.ImageIndex < SmallImages.Count) then
    begin
        CorrectTextbyWidth(B.Canvas, S, RectWidth(BR) - 4 - SmallImages.Width);
        GX := BR.Left;
        if S = Column.Caption then
         case Column.Alignment of
           taRightJustify: GX := BR.Right - TextWidth(S) - SmallImages.Width - 4;
                 taCenter: GX := BR.Left + RectWidth(BR) div 2 - (TextWidth(S) + SmallImages.Width + 4) div 2;
         end;
        TX := GX + SmallImages.Width + 4;
        TY := BR.Top + (RectHeight(BR) - TextHeight(S)) div 2;
        GY := BR.Top + (RectHeight(BR) - SmallImages.Height) div 2;
        SmallImages.Draw(B.Canvas, GX, GY, Column.ImageIndex, True);
    end else begin
        CorrectTextbyWidth(B.Canvas, S, RectWidth(BR));
        TX := BR.Left;
        TY := BR.Top + (RectHeight(BR) - TextHeight(S)) div 2;
        case Column.Alignment of
            taRightJustify: TX := BR.Right - TextWidth(S);
                  taCenter: TX := (RectWidth(BR) - TextWidth(S) + 4) div 2;
        end;
    end;
    TextRect(BR, TX, TY, S);
  end;
  Cnvs.Draw(R.Left, R.Top, B);
 finally
  B.Free;
 end;

end;

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

procedure TDefineListView.DrawHeader(DC: HDC);
var
  Cnvs: TControlCanvas;
  i, RightOffset, HeaderCount: Integer;
  R, BGR, HR: TRect;
  PS: TPaintStruct;
begin
  Cnvs := TControlCanvas.Create;
  try
    Cnvs.Handle := BeginPaint(FHeaderHandle, PS);
    HeaderCount := Header_GetItemCount(FHeaderHandle);
    RightOffset := 0;
    for i := 0 to HeaderCount - 1 do begin
        R := GetHeaderSectionRect(i);
        DrawTitle(Cnvs, Columns[i], False, (FActiveSection = I) and FHeaderDown, R);
        if RightOffset < R.Right then RightOffset := R.Right;
    end;
    GetWindowRect(FHeaderHandle, HR);
    BGR := Rect(RightOffset+1, 0, RectWidth(HR), RectHeight(HR));
    if BGR.Left < BGR.Right then begin
       Cnvs.Brush.Color := FTitleFaceColor;//clBtnFace;
       Cnvs.FillRect(BGR);
       DrawFrame(Cnvs, BGR, FTitleFaceColor, FTitleFaceColor, 1);
    end;;
  finally
    Cnvs.Free;
    EndPaint(FHeaderHandle, PS)
  end;
end;

procedure TDefineListView.HeaderWndProc(var Message: TMessage);
var
  X, Y: Integer;

 procedure GetSectionFromPoint(P: TPoint);
 var
  i: Integer;
  R,RA,BR: TRect;
 begin
  FActiveSection := -1;
  RA   := RECT(0,0,HeaderHeight,HeaderHeight);
  for i := 0 to Columns.Count - 1 do
  begin
    R := GetHeaderSectionRect(i);
    FCheckInBox := False;
    if i = 0 then
    begin
       BR := Rect(RA.Right,R.Top,R.Right,R.Bottom);
       if PtInRect(RA, Point(X, Y)) then
       begin
          FActiveSection := i;
          FCheckInBox    := True;
          Break;
       end
       else if PtInRect(BR, Point(X, Y)) then
       begin
          FActiveSection := i;
          Break;
       end;
    end else begin
     if PtInRect(R, Point(X, Y)) then
     begin
       FActiveSection := i;
       Break;
     end;
    end;
  end;
 end;

var
  Info: THDHitTestInfo;
begin
  with Message do begin
   case Msg of
      WM_WINDOWPOSCHANGING :
      begin
       with TWMWINDOWPOSCHANGING(Message) do
            WindowPos.cx := WindowPos.cx + 4;
      end;
      WM_PAINT:DrawHeader(TWMPAINT(Message).DC);
      WM_ERASEBKGND : result := 1;
   else
      Result := CallWindowProc(FDefHeaderProc, FHeaderHandle, Msg, WParam, LParam);
   end;
   case Msg of
      WM_LBUTTONDOWN:
      begin
        X := TWMLBUTTONDOWN(Message).XPos;
        Y := TWMLBUTTONDOWN(Message).YPos;
        GetSectionFromPoint(Point(X, Y));
        Info.Point.X := X;
        Info.Point.Y := Y;
        SendMessage(FHeaderHandle, HDM_HITTEST, 0, Integer(@Info));
        FHeaderDown := not (Info.Flags = HHT_ONDIVIDER);
        if FCheckInBox then SetAllCheck(not FAllCheck);
        RedrawWindow(FHeaderHandle, nil, 0, RDW_INVALIDATE);
      end;
    WM_LBUTTONUP:
      begin
        FHeaderDown := False;
        FActiveSection := -1;
        RedrawWindow(FHeaderHandle, nil, 0, RDW_INVALIDATE);
      end;
   end;
  end;
end;

procedure TDefineListView.WndProc(var Message: TMessage);
var WndClass: String;
begin
  case Message.Msg of
    WM_PARENTNOTIFY:
       with TWMPARENTNOTIFY(Message) do
       begin
         SetLength(WndClass, 80);
         SetLength(WndClass, GetClassName(ChildWnd, PChar(WndClass), Length(WndClass)));
         if (Event = WM_CREATE) and (FHeaderHandle <> 0) and ShowColumnHeaders and
            (WndClass = 'SysHeader32') then
         begin
             SetWindowLong(FHeaderHandle, GWL_WNDPROC, LongInt(FDefHeaderProc));
             FHeaderHandle := 0;
         end;

         if (Event = WM_CREATE) and (FHeaderHandle = 0) and ShowColumnHeaders and
            (WndClass = 'SysHeader32') then
         begin
             FHeaderHandle := ChildWnd;
             FDefHeaderProc := Pointer(GetWindowLong(FHeaderHandle, GWL_WNDPROC));
             SetWindowLong(FHeaderHandle, GWL_WNDPROC, LongInt(FHeaderInstance));
         end;
        end; 
    WM_HSCROLL,
    WM_VSCROLL: if (GroundHas) then InvalidateRect(Handle, nil, False);
  end;
  inherited;
end;

procedure TDefineListView.RedrawBorder(const Clip: HRGN = 0);
var ViewBorder:TBorderAttrib;
    clColor:TColor;
begin
  with ViewBorder do
  begin
    Ctrl := Self;
    BorderColor := ColorBorder;
    if Enabled then
    begin
       FlatColor   := ColorFlat;
       FocusColor  := ColorFocused;
    end
    else
    begin
       FlatColor   := clSilver;
       FocusColor  := clSilver;
    end;
    MouseState  := FMouseIn;
    DesignState := ComponentState;
    FocusState  := Focused;
    HasBars     := False;
  end;
  clColor := DrawViewBorder(ViewBorder);
  if ((GroundPic.Graphic <> nil) and GroundHas) then
     Color := clNone
  else if Assigned(OnCustomDraw) then
     Color := clNone
  else   
     Color := clColor;
end;

procedure TDefineListView.SetParentColor(Value: Boolean);
begin
  if Value <> FParentColor then
  begin
    FParentColor := Value;
    if FParentColor then
    begin
      if Parent <> nil then
         FFlatColor := TForm(Parent).Color;
    end;
    RedrawBorder;
  end;
end;

procedure TDefineListView.CMSysColorChange(var Message: TMessage);
begin
  if FParentColor then
  begin
      if Parent <> nil then
        FFlatColor := TForm(Parent).Color;
  end;
  RedrawBorder;      
end;

procedure TDefineListView.CMParentColorChanged(var Message: TWMNoParams);
begin
  if FParentColor then
  begin
      if Parent <> nil then
        FFlatColor := TForm(Parent).Color;
  end;
  RedrawBorder;
end;

procedure TDefineListView.SetColors(Index: Integer; Value: TColor);
begin
  case Index of
    0: FFocusedColor := Value;
    1: FBorderColor  := Value;
    2: begin
          FFlatColor    := Value;
          FParentColor  := False;
       end;
    3: if FTitleFaceColor <> Value then
       begin
          FTitleFaceColor   := Value;
          RedrawWindow(FHeaderHandle, nil, 0, RDW_INVALIDATE);
       end;
    4: if FTitleCheckColor <> Value then
       begin
          FTitleCheckColor   := Value;
          RedrawWindow(FHeaderHandle, nil, 0, RDW_INVALIDATE);
       end;
  end;
  RedrawBorder;
end;

procedure TDefineListView.CMMouseEnter(var Message: TMessage);
begin
  inherited;
  if (GetActiveWindow <> 0) then
  begin
    FMouseIn := True;
    RedrawBorder;
  end;
end;

procedure TDefineListView.CMMouseLeave(var Message: TMessage);
begin
  inherited;
  FMouseIn := False;
  RedrawBorder;
end;

procedure TDefineListView.CMEnabledChanged(var Message: TMessage);
begin
  inherited;
  RedrawBorder;
end;

procedure TDefineListView.WMSetFocus(var Message: TWMSetFocus);
begin
  inherited;
  if not(csDesigning in ComponentState) then
    RedrawBorder;
end;

procedure TDefineListView.WMKillFocus(var Message: TWMKillFocus);
begin
  inherited;
  if not(csDesigning in ComponentState) then
    RedrawBorder;
end;

procedure TDefineListView.WMNCCalcSize(var Message: TWMNCCalcSize);
begin
  inherited;
  InflateRect(Message.CalcSize_Params^.rgrc[0], -1, -1);
end;

procedure TDefineListView.WMNCPaint(var Message: TMessage);
begin
  inherited;
  RedrawBorder(HRGN(Message.WParam));
end;

function TDefineListView.GetColumnCount: Integer;
begin
  result := inherited Columns.Count;
end;

function TDefineListView.GetItemsCount: Integer;
begin
  result := inherited Items.Count;
end;

procedure TDefineListView.SetGroundPic(const Value: TPicture);
begin
  FGroundPic.Assign(Value);
  if FGroundPic.Graphic = nil then
     FGroundHas := false;
  RedrawBorder;
  Invalidate;
end;

procedure TDefineListView.DrawBackground(Sender: TCustomListView; const ARect: TRect; var DefaultDraw: Boolean);
var
  x,y:integer;
  R:TRect;
begin
  if GroundPic.Graphic <> nil then
  begin
   with Canvas, ClientRect do
   begin
    Lock;
    R := Rect(Left, Top + HeaderHeight, Right, Bottom);
    if not GroundStretch then
    begin
      x:=0; y:=HeaderHeight;
      while x < Width do
      begin
       while y < Height do
       begin
        Draw(x, y, GroundPic.Graphic);
        y := y + GroundPic.Height;
       end;
       x := x + GroundPic.Width;
       y := HeaderHeight;
      end;
    end else begin
      StretchDraw(R, GroundPic.Graphic);
    end;
    SetBkMode(Handle, TRANSPARENT);
    Unlock;
   end;
   Perform(LVM_SETTEXTBKCOLOR, 0, LongInt(CLR_NONE));
   ListView_SetBKColor(Handle, CLR_NONE);
  end;
end;

procedure TDefineListView.SetGroundHas(const Value: Boolean);
begin
  FGroundHas := Value;
  if FGroundHas and (FGroundPic.Graphic <> nil) then
     OnCustomDraw := DrawBackground
  else if not(csDesigning in ComponentState) then
     OnCustomDraw := FOnDrawBackground
  else begin
     OnCustomDraw := Nil;
  end;
  RedrawBorder;
  Invalidate;
end;

procedure TDefineListView.Loaded;
begin
  inherited;
  if (GroundHas)and(GroundPic.Graphic <> nil) then
      OnCustomDraw := DrawBackground
  else
      OnCustomDraw := OnDrawBackground;
end;

function TDefineListView.GetHeaderHeight: Integer;
begin
  result := RectHeight(GetHeaderSectionRect(0));
  if not (ShowColumnHeaders and (ViewStyle = vsReport)) then
     result := 0;
end;

procedure TDefineListView.SetGroundStretch(const Value: Boolean);
begin
  if FGroundStretch <> value then
  begin
     FGroundStretch := Value;
     RedrawBorder;
     Invalidate;
  end;
end;

procedure TDefineListView.WMPaint(var Message: TWMPaint);
begin
  inherited;
  RedrawWindow(FHeaderHandle, nil, 0, RDW_INVALIDATE);
end;

procedure TDefineListView.SetAllCheck(const Value: Boolean);
var
  inx : integer;
begin
  if FAllCheck <> Value then
  begin
     FAllCheck := Value;
     for inx:=0 to Items.Count - 1 do
         Items.Item[inx].Checked := FAllCheck;
  end;
end;

function TDefineListView.GetListCount: integer;
begin
  result := Items.Count;
end;

function TDefineListView.GetCheckCount: integer;
var inx:integer;
begin
  result := 0;
  for inx := 0 to Items.Count - 1 do
  begin
    if Items.Item[inx].Checked then
       result := result + 1;
  end;
end;

end.