tflatchecklistboxunit.pas

delphi 商品管理系統

  // Draw the down arrow
  y := ClientRect.Bottom - 7;
  if (firstItem + maxItems + 1 <= FItems.Count) and Enabled then
  begin
    canvas.Brush.Color := FArrowColor;
    canvas.Pen.Color := FArrowColor;
    canvas.Polygon([Point(X + 4, Y), Point(X + 8, Y), Point(X + 6, Y + 2)]);
  end
  else
  begin
    canvas.Brush.Color := clWhite;
    canvas.Pen.Color := clWhite;
    Inc(x); Inc(y);
    canvas.Polygon([Point(X + 4, Y), Point(X + 8, Y), Point(X + 6, Y + 2)]);
    Dec(x); Dec(y);
    canvas.Brush.Color := clGray;
    canvas.Pen.Color := clGray;
    canvas.Polygon([Point(X + 4, Y), Point(X + 8, Y), Point(X + 6, Y + 2)]);
  end;
end;

procedure TFlatCheckListBox.DrawCheckRect (canvas: TCanvas; start: TPoint; checked: Boolean);
var
  CheckboxRect: TRect;
begin

  {$IFDEF DFS_COMPILER_4_UP}
  if BidiMode = bdRightToLeft then
    CheckboxRect := Rect(start.x - 14, start.y + 3, start.x - 3, start.y + 14)
  else
    CheckboxRect := Rect(start.x + 3, start.y + 3, start.x + 14, start.y + 14);
  {$ELSE}
  CheckboxRect := Rect(start.x + 3, start.y + 3, start.x + 14, start.y + 14);
  {$ENDIF}

  canvas.pen.style := psSolid;
  canvas.pen.width := 1;
  // Background
  canvas.brush.color := FItemsRectColor;
  canvas.pen.color := FItemsRectColor;

  canvas.FillRect(CheckboxRect);

  // Tick
  if Checked then
  begin
    canvas.pen.color := FCheckColor;

    canvas.penpos := Point(CheckboxRect.left+2, CheckboxRect.top+4);
    canvas.lineto(CheckboxRect.left+6, CheckboxRect.top+8);
    canvas.penpos := Point(CheckboxRect.left+2, CheckboxRect.top+5);
    canvas.lineto(CheckboxRect.left+5, CheckboxRect.top+8);
    canvas.penpos := Point(CheckboxRect.left+2, CheckboxRect.top+6);
    canvas.lineto(CheckboxRect.left+5, CheckboxRect.top+9);
    canvas.penpos := Point(CheckboxRect.left+8, CheckboxRect.top+2);
    canvas.lineto(CheckboxRect.left+4, CheckboxRect.top+6);
    canvas.penpos := Point(CheckboxRect.left+8, CheckboxRect.top+3);
    canvas.lineto(CheckboxRect.left+4, CheckboxRect.top+7);
    canvas.penpos := Point(CheckboxRect.left+8, CheckboxRect.top+4);
    canvas.lineto(CheckboxRect.left+5, CheckboxRect.top+7);
  end;
  // Border
  canvas.brush.color := FBorderColor;
  canvas.FrameRect(CheckboxRect);
end;

procedure TFlatCheckListBox.Paint;
var
  memoryBitmap: TBitmap;
  counterRect, counterItem: Integer;
  itemRect: ^TRect;
  Format: UINT;
begin
  {$IFDEF DFS_COMPILER_4_UP}
  if BidiMode = bdRightToLeft then
    Format := DT_RIGHT or DT_VCENTER or DT_SINGLELINE or DT_NOPREFIX
  else
    Format := DT_LEFT or DT_VCENTER or DT_SINGLELINE or DT_NOPREFIX;
  {$ELSE}
  Format := DT_LEFT or DT_VCENTER or DT_SINGLELINE or DT_NOPREFIX;
  {$ENDIF}

  // create memory-bitmap to draw flicker-free
  memoryBitmap := TBitmap.Create;
  try
    memoryBitmap.Height := ClientRect.Bottom;
    memoryBitmap.Width := ClientRect.Right;
    memoryBitmap.Canvas.Font.Assign(Self.Font);

    // Clear Background
    case FTransparent of
      tmAlways:
        DrawParentImage(Self, memoryBitmap.Canvas);
      tmNone:
        begin
          memoryBitmap.canvas.Brush.Color := FItemsRectColor;
          memoryBitmap.canvas.FillRect(ClientRect);
        end;
      tmNotFocused:
        if Focused then
        begin
          memoryBitmap.canvas.Brush.Color := FItemsRectColor;
          memoryBitmap.canvas.FillRect(ClientRect);
        end
        else
          DrawParentImage(Self, memoryBitmap.Canvas);
    end;

    // Draw Border
    memoryBitmap.canvas.Brush.Color := FBorderColor;
    memoryBitmap.canvas.FrameRect(ClientRect);

    // Draw ScrollBars
    if ScrollBars then
      DrawScrollBar(memoryBitmap.canvas);

    // Initialize the counter for the Items
    counterItem := firstItem;

    // Draw Items
    for counterRect := 0 to maxItems - 1 do
    begin
      itemRect := FItemsRect.Items[counterRect];
      if (counterItem <= FItems.Count - 1) then
      begin
        // Item is selected
        if counterItem = FSelected then
        begin
          // Fill ItemRect
          memoryBitmap.canvas.brush.color := FItemsSelectColor;
          memoryBitmap.canvas.FillRect(itemRect^);
          // Draw ItemBorder
          memoryBitmap.canvas.brush.color := FBorderColor;
          memoryBitmap.canvas.FrameRect(itemRect^);
        end;
        if counterItem in FChecked then
        {$IFDEF DFS_COMPILER_4_UP}
          if BidiMode = bdRightToLeft then
            DrawCheckRect(memoryBitmap.canvas, Point(itemRect^.Right, itemRect^.top), true)
          else
            DrawCheckRect(memoryBitmap.canvas, Point(itemRect^.left, itemRect^.top), true)
          {$ELSE}
          DrawCheckRect(memoryBitmap.canvas, Point(itemRect^.left, itemRect^.top), true)
          {$ENDIF}
        else
          {$IFDEF DFS_COMPILER_4_UP}
          if BidiMode = bdRightToLeft then
            DrawCheckRect(memoryBitmap.canvas, Point(itemRect^.Right, itemRect^.top), false)
          else
            DrawCheckRect(memoryBitmap.canvas, Point(itemRect^.left, itemRect^.top), false);
          {$ELSE}
          DrawCheckRect(memoryBitmap.canvas, Point(itemRect^.left, itemRect^.top), false);
          {$ENDIF}
        // Draw ItemText
        memoryBitmap.canvas.brush.style := bsClear;
        InflateRect(itemRect^, -19, 0);
        if Enabled then
          DrawText(memoryBitmap.canvas.Handle, PChar(FItems[counterItem]), Length(FItems[counterItem]), itemRect^, Format)
        else
          begin
            OffsetRect(itemRect^, 1, 1);
            memoryBitmap.canvas.Font.Color := clBtnHighlight;
            DrawText(memoryBitmap.canvas.Handle, PChar(FItems[counterItem]), Length(FItems[counterItem]), itemRect^, Format);
            OffsetRect(itemRect^, -1, -1);
            memoryBitmap.canvas.Font.Color := clBtnShadow;
            DrawText(memoryBitmap.canvas.Handle, PChar(FItems[counterItem]), Length(FItems[counterItem]), itemRect^, Format);
          end;
        InflateRect(itemRect^, 19, 0);
        Inc(counterItem);
      end;
    end;
    // Copy bitmap to screen
    canvas.CopyRect(ClientRect, memoryBitmap.canvas, ClientRect);
  finally
    // delete the memory bitmap
    memoryBitmap.free;
  end;
end;

procedure TFlatCheckListBox.MouseDown (Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  cursorPos: TPoint;
  counterRect: Integer;
  currentRect: ^TRect;
  checkRect: TRect;
begin
  GetCursorPos(cursorPos);
  cursorPos := ScreenToClient(cursorPos);

  if (FItems.Count > 0) and (Button = mbLeft) then
  begin
    for counterRect := 0 to FItemsRect.Count - 1 do
    begin
      currentRect := FItemsRect.Items[counterRect];
      {$IFDEF DFS_COMPILER_4_UP}
      if BidiMode = bdRightToLeft then
        checkRect := Rect(currentRect.right - 14, currentRect.top + 3, currentRect.right - 3, currentRect.Top + 14)
      else
        checkRect := Rect(currentRect.left + 3, currentRect.top + 3, currentRect.left + 14, currentRect.Top + 14);
      {$ELSE}
      checkRect := Rect(currentRect.left + 3, currentRect.top + 3, currentRect.left + 14, currentRect.Top + 14);
      {$ENDIF}
      if PtInRect(checkRect, cursorPos) then
      begin
        if (firstItem + counterRect) in FChecked then
          Exclude(FChecked, firstItem + counterRect)
        else
          Include(FChecked, firstItem + counterRect);
        SetFocus;
        if Assigned(FOnClickCheck) then
          FOnClickCheck(Self);
        Invalidate;
        Exit;
      end
      else
        if PtInRect(currentRect^, cursorPos) then
        begin
          FSelected := firstItem + counterRect;
          SetFocus;
          Invalidate;
          Exit;
        end;
    end;
  end;

  if ScrollBars then
  begin
    if PtInRect(Rect(ClientRect.Left, ClientRect.Top, ClientRect.Right, ClientRect.Top + 11), cursorPos) then
    begin
      if (firstItem - 1) < 0 then
        firstItem := 0
      else
        Dec(firstItem);
      SetFocus;
      Invalidate;
      scrollType := up;
      if ScrollTimer.Enabled then
        ScrollTimer.Enabled := False;
      ScrollTimer.OnTimer := ScrollTimerHandler;
      ScrollTimer.Enabled := True;
    end;
    if PtInRect(Rect(ClientRect.Left, ClientRect.Bottom - 11, ClientRect.Right, ClientRect.Bottom), cursorPos) then
    begin
      if firstItem + maxItems + 1 <= FItems.Count then
        Inc(firstItem);
      SetFocus;
      Invalidate;
      scrollType := down;
      if ScrollTimer.Enabled then
        ScrollTimer.Enabled := False;
      ScrollTimer.OnTimer := ScrollTimerHandler;
      ScrollTimer.Enabled := True;
    end;
  end;
  Inherited;
end;

procedure TFlatCheckListBox.MouseUp (Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  ScrollTimer.Enabled := False;
  ScrollTimer.Interval := FTimerInterval;
  inherited MouseUp(Button, Shift, X, Y);
end;

procedure TFlatCheckListBox.ScrollTimerHandler (Sender: TObject);
begin
  ScrollTimer.Interval := FScrollSpeed;
  if scrollType = up then
    if (firstItem - 1) < 0 then
    begin
      firstItem := 0;
      ScrollTimer.Enabled := False;
    end
    else
      Dec(firstItem)
  else
    if firstItem + maxItems + 1 <= FItems.Count then
      Inc(firstItem)
    else
      ScrollTimer.Enabled := False;
  Invalidate;
end;

procedure TFlatCheckListBox.Loaded;
begin
  inherited;
  SetItemsRect;
end;

procedure TFlatCheckListBox.WMSize (var Message: TWMSize);
begin
  inherited;
  // Calculate the maximum items to draw
  if ScrollBars then
    maxItems := (Height - 24) div (FItemsHeight + 2)
  else
    maxItems := (Height - 4) div (FItemsHeight + 2);

  // Set the new Bounds
  if ScrollBars then
    SetBounds(Left, Top, Width, maxItems * (FItemsHeight + 2) + 24)
  else
    SetBounds(Left, Top, Width, maxItems * (FItemsHeight + 2) + 4);

  // Recalculate the itemRects
  SetItemsRect;
  if not (FTransparent = tmNone) then
    Invalidate;
end;

procedure TFlatCheckListBox.WMMove (var Message: TWMMove);
begin
  inherited;
  if not (FTransparent = tmNone) then
    Invalidate;
end;

procedure TFlatCheckListBox.CMEnabledChanged (var Message: TMessage);
begin
  inherited;
  Invalidate;
end;

procedure TFlatCheckListBox.CMSysColorChange (var Message: TMessage);
begin
  if FUseAdvColors then
  begin
    ParentColor := True;
    CalcAdvColors;
  end;
  Invalidate;
end;

procedure TFlatCheckListBox.CMParentColorChanged (var Message: TWMNoParams);
begin
  inherited;
  if FUseAdvColors then
  begin
    ParentColor := True;
    CalcAdvColors;
  end;
  Invalidate;
end;

procedure TFlatCheckListBox.Clear;
begin
  FItems.Clear;
  FChecked := FChecked - [0..High(Byte)];
  FSelected := -1;
  Invalidate;
end;

procedure TFlatCheckListBox.SetTransparent (const Value: TTransparentMode);
begin
  FTransparent := Value;
  Invalidate;
end;

procedure TFlatCheckListBox.WMKillFocus (var Message: TWMKillFocus);
begin
  inherited;
  FSelected := -1;
  Invalidate;
end;

procedure TFlatCheckListBox.WMSetFocus (var Message: TWMSetFocus);
begin
  inherited;
  if not (FTransparent = tmNone) then
    Invalidate;
end;

procedure TFlatCheckListBox.CNKeyDown (var Message: TWMKeyDown);
begin
  case Message.CharCode of
    VK_UP: 
      if (firstItem - 1) < 0 then
        firstItem := 0
      else
        Dec(firstItem);
    VK_DOWN:
      if firstItem + maxItems + 1 <= FItems.Count then
        Inc(firstItem);
    VK_PRIOR:
      if (firstItem - maxItems) < 0 then
        firstItem := 0
      else
        Dec(firstItem, maxItems);
    VK_NEXT:
      if firstItem + (maxItems * 2) <= FItems.Count then
        Inc(firstItem, maxItems)
      else
        firstItem := FItems.Count - maxItems;
    VK_SPACE:
      if FSelected in FChecked then
          Exclude(FChecked, FSelected)
        else
          Include(FChecked, FSelected);
  else                                          
    inherited;
  end;
  Invalidate;
end;

function TFlatCheckListBox.GetItemIndex: Integer;
begin
  Result := FSelected;
end;

procedure TFlatCheckListBox.SetItemIndex(Value: Integer);
begin
  if GetItemIndex <> Value then
  begin
    FSelected := Value;
    Invalidate;
  end;
end;

end.