flatboxs.pas

comerose_flatstyle_v4.42.9.0_d7.rar

   //draw title backgroud
   if TitleHas then
   begin
     if not TitleUseBitmap then
        BoxDrawBackDrop(Canvas,TitleStartColor,TitleStopColor,TitleOrien,TitleRect,TitleColor,UserFace)
     else
        DrawBitmap(Canvas,TitleRect,TitleBitmap);
   end;
  end;
 end;
begin
  // create memory-bitmap to draw flicker-free
  memBitmap := TBitmap.Create;
  try
   memBitmap.Height := ClientRect.Bottom;
   memBitmap.Width  := ClientRect.Right;
   //控制区域
   WorkRect   := ClientRect;
   TitleRect  := ClientRect;
   with FStyle do begin
    if TitleHas then begin
      case TitlePosition of
          tsTop : begin
           WorkRect.Top     := WorkRect.Top  + TitleHeight;
           TitleRect.Bottom := TitleRect.Top + TitleHeight;
         end;
       tsBottom : begin
           WorkRect.Bottom  := WorkRect.Bottom  - TitleHeight;
           TitleRect.Top    := TitleRect.Bottom - TitleHeight;
         end;
      end;
    end;
    with BarsRect do begin
    if ScrollBars then begin
      prevRect := Rect(WorkRect.Left, WorkRect.Top, WorkRect.Right, WorkRect.Top + BarsHeight);
      downRect := Rect(WorkRect.Left, WorkRect.Bottom - BarsHeight, WorkRect.Right, WorkRect.Bottom);
      workRect := Rect(workRect.Left, workRect.Top + BarsHeight, workRect.Right, workRect.Bottom - BarsHeight);
    end;
    end;
    GetStyleText(ItemAlignment, Format);
    GetStyleText(TitleAlignment,TitleFormat);
    // Clear Background
    case Transparent of
          tmAlways: DrawParentImage(Self, memBitmap.Canvas);
            tmNone: DrawImage(memBitmap.Canvas,FStyle,WorkRect,TitleRect,TitleHas);
      tmNotFocused: if Focused then
                       DrawImage(memBitmap.Canvas,FStyle,WorkRect,TitleRect,TitleHas)
                    else
                       DrawParentImage(Self, memBitmap.Canvas);
    end;
    //Draw ScrollBars
    if ScrollBars then begin
       DrawScrollBar(self, Focused, memBitmap.Canvas, BarsRect, FStyle, FirstItem, MaxItems, FItems.Count, Enabled);
    end;
    // Draw Border
    memBitmap.Canvas.Brush.Color := BorderColor;
    memBitmap.Canvas.FrameRect(ClientRect);
    // Draw Focused Frame
    if(fItems.Count <=0)and(Focused) then
       DrawFocusRect(memBitmap.Canvas,WorkRect,ItemHeight);
    // draw titletext
    if TitleHas then begin
       MemBitmap.Canvas.Font.Assign(FStyle.TitleFont);
       FlatDrawText(memBitmap.Canvas, Enabled, FCaption, TitleRect, TitleFormat);
    end;
   end;
   // Initialize the counter for the Items
   memBitmap.Canvas.Font.Assign(Self.Font);
   inxItem := FirstItem;
   // Draw Items
   for inxRect := 0 to MaxItems - 1 do
    begin
      itemRect := FRects.Items[inxRect];
      if(inxItem <= FItems.Count - 1) then
      begin
        // Item is selected
        CurState := FindChecked(inxItem, CurIndex);
        with FStyle do begin
         // Draw ItemBorder
         if ItemLineHas then
         begin
            memBitmap.Canvas.Brush.color := ItemLineColor;
            memBitmap.Canvas.FrameRect(itemRect^);
         end;
         if inxItem = FItemIndex then
         begin
          // Fill ItemRect
          BoxDrawBackDrop(memBitmap.Canvas,ItemStartColor,ItemStopColor,ItemOrien, itemRect^, ItemSelectColor,UserFace);
          if Focused and (not MultiSelect) then
             DrawFocusRect(memBitmap.Canvas,itemRect^,ItemHeight);
          memBitmap.Canvas.Brush.color := ItemFrameColor;
          memBitmap.Canvas.FrameRect(itemRect^);
         end else if CurState then begin
          BoxDrawBackDrop(memBitmap.Canvas,ItemStartColor,ItemStopColor,bsVertical, itemRect^, ItemSelectColor,UserFace);
         end; 
        end;
        // Draw ItemText
        FlatDrawText(memBitmap.Canvas, Enabled, FItems[inxItem], itemRect^, Format);
        // draw next Item
        Inc(inxItem);
      end;
    end;
    // Copy bitmap to screen
    Canvas.CopyRect(ClientRect, memBitmap.Canvas, ClientRect);
  finally
    // delete the memory bitmap
    memBitmap.free;
  end;
end;

procedure TDefineListBox.SelectNotifyEvent;
begin
  if assigned(FOnChange) and IndexInCount(FItemIndex,FItems.Count) then FOnChange(self,FItems.Strings[FItemIndex]);
  if assigned(FOnClick) and IndexInCount(FItemIndex,FItems.Count) then FOnClick(self,FItems.Strings[FItemIndex]);
end;

procedure TDefineListBox.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  curPos: TPoint;
  inxRect: Integer;
  curRect: ^TRect;
  BarsRect: TBarsRect;
begin
  GetCursorPos(curPos);
  curPos := ScreenToClient(curPos);
  with FStyle do
  begin
  if(FItems.Count > 0) and(Button = mbLeft) then
  begin
    for inxRect := 0 to FRects.Count - 1 do
    begin
      curRect := FRects.Items[inxRect];
      if PtInRect(curRect^, curPos) then
      begin
       FItemIndex := FirstItem + inxRect;
       SetSelected(FItemIndex,True);
       SetFocus;
       Invalidate;
       Exit;
      end;
    end;
  end;

  if ScrollBars then
  begin
    GetBarPosition(ClientRect,TitleHas,TitlePosition,BarsRect,TitleHeight,BarsHeight);
    if PtInRect(BarsRect.prevRect, curPos) then
    begin
      if (FirstItem - 1) < 0 then
        FirstItem := 0
      else
        Dec(FirstItem);
      SetFocus;
      Invalidate;
      scrollType := stUp;
      if ScrollTimer.Enabled then
         ScrollTimer.Enabled := False;
      ScrollTimer.OnTimer := ScrollTimerHandler;
      ScrollTimer.Enabled := True;
    end;
    if PtInRect(BarsRect.downRect, curPos) then
    begin
      if FirstItem + MaxItems + 1 <= FItems.Count then
         Inc(FirstItem);
      SetFocus;
      Invalidate;
      scrollType := stDown;
      if ScrollTimer.Enabled then
         ScrollTimer.Enabled := False;
      ScrollTimer.OnTimer := ScrollTimerHandler;
      ScrollTimer.Enabled := True;
    end;
  end;
  end;
  Inherited;
end;

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

procedure TDefineListBox.ScrollTimerHandler(Sender: TObject);
begin
  ScrollTimer.Interval := FScrollSpeed;
  if scrollType = stUp 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 TDefineListBox.Loaded;
begin
  inherited;
  SetItemsRect;
end;

procedure TDefineListBox.WMSize(var Message: TWMSize);
var y,inx:integer;
begin
  inherited;
  with FStyle do begin
  y := 2;
  for inx := 1 to MaxItems do
      y := y +(ItemHeight + 2);
  y := y + 2;
  if ScrollBars then
     y := y + BarsHeight * 2;
  if TitleHas then
     y := y + TitleHeight;
  if not(csLoading in ComponentState) then
     SetBounds(Left,Top,Width,y);
  end;
  // Recalculate the itemRects
  SetItemsRect;
end;

procedure TDefineListBox.WMMove(var Message: TWMMove);
begin
  inherited;
  if not(FStyle.Transparent = tmNone) then
    Invalidate;
end;

procedure TDefineListBox.WMKillFocus(var Message: TWMKillFocus);
begin
  inherited;
  FMouseIn := False;
  if IndexInCount(FItemIndex, FItems.Count) then
     SetSelected(FItemIndex,False);
  Invalidate;
end;

procedure TDefineListBox.WMSetFocus(var Message: TWMSetFocus);
begin
  inherited;
  if FItemIndex >= 0 then
     SetSelected(FItemIndex,True)
  else if FItems.Count > 0 then begin
     FItemIndex := 0;
     SetSelected(FItemIndex,True);
  end;
  Invalidate;
end;

procedure TDefineListBox.WMKeyDown(var Message: TWMKeyDown);
begin
  case Message.CharCode of
    VK_UP: begin
       if(FirstItem - 1) < 0 then
          FirstItem := 0
       else
          Dec(FirstItem);
       if FItems.Count > 0 then begin
        if FItemIndex > 0 then
           Dec(FItemIndex)
        else
           FItemIndex := 0;
        //SetSelected(FItemIndex,True);
        SelectNotifyEvent;
       end;
      end;
    VK_DOWN:begin
      if FirstItem + MaxItems + 1 <= FItems.Count then
         Inc(FirstItem);
         
      if FItems.Count > 0 then begin
       if FItemIndex < FItems.Count-1 then
          Inc(FItemIndex)
       else
          FItemIndex := FItems.Count-1;
       //SetSelected(FItemIndex,True);
       SelectNotifyEvent;
      end;
      end;
    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: begin
      SetSelected(FItemIndex,True);
      SelectNotifyEvent;
      end;
  else
    inherited;
  end;
  Invalidate;
end;

function TDefineListBox.GetItemIndex: Integer;
begin
  Result := FItemIndex;
end;

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

procedure TDefineListBox.SetMultiSelect(Value: Boolean);
begin
  FMultiSelect := Value;
  if Value then
     FItemIndex := 0;
end;

procedure TDefineListBox.SetName(const Value: TComponentName);
begin
  if(csDesigning in ComponentState) and((Length(FCaption) = 0) or
    (CompareText(FCaption, Name) = 0)) then
    FCaption   := Value;
  inherited SetName(Value);
end;

procedure TDefineListBox.SetListStyle(const Value: TListStyle);
begin
 FStyle.Assign(Value);
end;

procedure TDefineListBox.StyleChange(Sender: TObject);
begin
 SetItemsRect;
 Invalidate;
end;

function TDefineListBox.GetMaxItems: Integer;
begin
  result := ClientRect.Bottom - ClientRect.Top;
  with FStyle do begin
  if TitleHas then
     result := result - TitleHeight;
  if ScrollBars then
     result := result - BarsHeight * 2;
  result :=(result - 4) div(ItemHeight + 2);
  end;
end;

procedure TDefineListBox.SetCaption(const Value: TCaption);
begin
 if FCaption <> Value then
 begin
    FCaption := Value;
    Invalidate;
 end;
end;

procedure TDefineListBox.WMEnabledChanged(var Message: TMessage);
begin
  inherited;
  Invalidate;
end;

procedure TDefineListBox.Clear;
begin
  RemoveList(FChecks);
  RemoveList(FRects);
  FItems.Clear;
end;

procedure TDefineListBox.CMParentFontChanged(var Message: TMessage);
begin
  inherited;
  if ParentFont and Assigned(FStyle) then
  begin
     if FStyle.ParentFont then
        FStyle.TitleFont.Assign(Font);
  end;
end;

procedure TDefineListBox.CMFontChanged(var Message: TMessage);
begin
  inherited;
  if Assigned(FStyle) then
  begin
     if FStyle.ParentFont then
        FStyle.TitleFont.Assign(Font);
  end;
end;

function TDefineListBox.GetItemCount: Integer;
begin
  result := Items.Count;
end;

procedure TDefineListBox.CMMouseEnter(var Message: TMessage);
begin
  inherited;
  if not(csDesigning in ComponentState) and
        (GetActiveWindow <> 0) and (not FMouseIn) then
  begin
    FMouseIn := True;
    Invalidate;
  end;  
end;

procedure TDefineListBox.CMMouseLeave(var Message: TMessage);
begin
  inherit