flatboxs.pas

comerose_flatstyle_v4.42.9.0_d7.rar

procedure TDefineGroupBox.SetBackgropOrien(const Value: TStyleOrien);
begin
  if FBackgropOrien <> Value then begin
     FBackgropOrien := Value;
     Invalidate;
  end;
end;

procedure TDefineGroupBox.SetStyleFace(const Value: TStyleFace);
begin
  if FStyleFace <> Value then begin
     FStyleFace := Value;
     Invalidate;
  end;
end;

procedure TDefineGroupBox.CMParentColorChanged(var Message: TWMNoParams);
begin
  inherited;
  FTransParent := not ParentColor;
  if (Parent <> nil)and(ParentColor) then
  begin
      Color := TForm(Parent).Color;
  end;
  Invalidate;
end;

procedure TDefineGroupBox.CMSysColorChange(var Message: TMessage);
begin
  inherited;
  if (Parent <> nil)and(ParentColor) then
      Color := TForm(Parent).Color;
  Invalidate;
end;

procedure TDefineGroupBox.CMDialogChar(var Message: TCMDialogChar);
begin
  with Message do
    if IsAccel(Message.CharCode, Caption) and CanFocus then
    begin
      SetFocus; 
      Result := 1;
    end;
end;

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

procedure TDefineGroupBox.SetTransparent(const Value: Boolean);
begin
  FTransparent := Value;
  Invalidate;
end;

procedure TDefineGroupBox.WMMove(var Message: TWMMove);
begin
  inherited;
  if FTransparent then
    Invalidate;
end;

procedure TDefineGroupBox.WMSize(var Message: TWMSize);
begin
  inherited;
  if FTransparent then
    Invalidate;
end;

procedure TDefineGroupBox.SetAlignment(const Value: TAlignmentText);
begin
 if FAlignment <> Value then
 begin
    FAlignment := Value;
    Invalidate;
 end;
end;

{ TDefineListBox }

var
  ScrollTimer: TTimer = nil;

const
  FTimerInterval = 600;
  FScrollSpeed   = 100;

procedure DrawScrollBar(control:TControl; Focused:boolean; canvas: TCanvas; BarsRect: TBarsRect; Style: TFlatSkin;
                        FirstItem, MaxItems, ItemsCount: Integer; Enabled: Boolean);
var
 x, y: Integer;
 procedure DrawImage;
 begin
   with Style, BarsRect do begin
    if not BarUseBitmap then
    begin
     if UserFace = fsDefault then
     begin
        canvas.Brush.Color := BarColor;
        canvas.FillRect(prevRect);
        canvas.FillRect(downRect);
     end else begin
     DrawBackdrop(Canvas,BarStartColor,BarStopColor,prevRect,BarOrien);
     case Style.BarOrien of
         bsHorizontal:DrawBackdrop(Canvas,BarStartColor,BarStopColor,downRect,BarOrien);  //水平
         bsVertical  :DrawBackdrop(Canvas,BarStopColor,BarStartColor,downRect,BarOrien);  //垂直
     end;
     end;
    end else begin
     DrawBitmap(Canvas,prevRect,BarTopBitmap);
     DrawBitmap(Canvas,downRect,BarDownBitmap);
    end;
   end;
 end;
begin
  // 画滚动条背景
  with Style,BarsRect do begin
  case Transparent of
          tmAlways: DrawParentImage(control, Canvas);
            tmNone: DrawImage;
      tmNotFocused: if Focused then
                       DrawImage
                    else
                       DrawParentImage(control, Canvas);
  end;
  // 画滚动条边框
  canvas.Brush.Color := BorderColor;
  canvas.FrameRect(prevRect);
  canvas.FrameRect(downRect);

  // Draw the up arrow
  x := (prevRect.Right - prevRect.Left) div 2 - 6;
  y :=  prevRect.Top + 4;

  if (firstItem <> 0) and Enabled then
  begin
    canvas.Brush.Color := BarArrowColor;
    canvas.Pen.Color   := BarArrowColor;
    canvas.Polygon([Point(x + 4, y + 2), Point(x + 8, y + 2), Point(x + 6, y)]);
  end
  else
  begin
    canvas.Brush.Color := clWhite;
    canvas.Pen.Color   := clWhite;
    Inc(x); Inc(y);
    canvas.Polygon([Point(x + 4, y + 2), Point(x + 8, y + 2), Point(x + 6, y)]);
    Dec(x); Dec(y);
    canvas.Brush.Color := clGray;
    canvas.Pen.Color   := clGray;
    canvas.Polygon([Point(x + 4, y + 2), Point(x + 8, y + 2), Point(x + 6, y)]);
  end;

  // Draw the down arrow
  x := (downRect.Right - downRect.Left) div 2 - 6;
  y :=  downRect.Bottom - 7;
  if (firstItem + maxItems + 1 <= ItemsCount) and Enabled then
  begin
    canvas.Brush.Color := BarArrowColor;
    canvas.Pen.Color   := BarArrowColor;
    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;
end;

function CurItemRect(CurPos:TPoint;CurRect:TRect;ItemHeight:integer):TRect;
begin
 result := Rect(CurPos.x, CurPos.y, CurRect.Right - 3, CurPos.y + ItemHeight);
end;

procedure CreateRects(List:TList;MaxItems,ItemHeight:integer;CurPos:TPoint;CurRect:TRect);
var
  ItemRect: ^TRect;
  inx:integer;
begin
  RemoveList(List);
  for inx := 0 to MaxItems - 1 do
  begin
    New(ItemRect);
    ItemRect^ := CurItemRect(CurPos,CurRect,ItemHeight);
    List.Add(ItemRect);
    CurPos    := Point(CurPos.x, CurPos.y + ItemHeight + 2);
  end;
end;

constructor TDefineListBox.Create(AOwner: TComponent);
begin
  if ScrollTimer = nil then begin
     ScrollTimer := TTimer.Create(nil);
     ScrollTimer.Enabled  := False;
     ScrollTimer.Interval := FTimerInterval;
  end;
  inherited Create(AOwner);
  ControlStyle    := ControlStyle + [csOpaque];
  SetBounds(0, 0, 140, 158);
  ParentColor     := True;
  ParentFont      := True;
  Enabled         := true;
  Visible         := true;
  TabStop         := True;
  FStyle          := TListStyle.Create;
  FStyle.Parent   := self;
  FStyle.OnChange := StyleChange;
  FItems          := TStringList.Create;
  //FItems          := TListBoxStrings.Create;
  //TListBoxStrings(FItems).ListBox := Self;
  FItems.OnChange := StyleChange;
  FRects          := TList.Create;
  FChecks         := TList.Create;
  FMultiSelect    := false;
  FSorted         := false;
  FirstItem       := 0;
  FItemIndex      := -1;
  FCaption        := '';
end;

destructor TDefineListBox.Destroy;
begin
  ScrollTimer.Free;
  ScrollTimer := nil;
  //释放 FRect
  RemoveList(FRects, lsFree);
  //释放 FChecks
  RemoveList(FChecks, lsFree);
  FItems.Free;
  FStyle.Free;
  inherited Destroy;
end;

procedure TDefineListBox.WMMouseWheel(var Message: TMessage);
var
  fScrollLines: Integer;
begin
  if not(csDesigning in ComponentState) then
  begin
    SystemParametersInfo(SPI_GETWHEELSCROLLLINES, 0, @fScrollLines, 0);

    if(fScrollLines = 0) then
       fScrollLines := MaxItems;

    if ShortInt(Message.WParamHi) = -WHEEL_DELTA then
      if FirstItem + MaxItems + fScrollLines <= FItems.Count then
         Inc(FirstItem, fScrollLines)
      else
        if FItems.Count - MaxItems < 0 then
           FirstItem := 0
        else
           FirstItem := FItems.Count - MaxItems
    else
      if ShortInt(Message.WParamHi) = WHEEL_DELTA then
        if FirstItem - fScrollLines < 0 then
           FirstItem := 0
        else
           dec(FirstItem, fScrollLines);
    Invalidate;
  end;
end;

function TDefineListBox.GetItemText: TCaption;
begin
  if IndexInCount(FItemIndex,FItems.Count) then
     result := FItems.Strings[FItemIndex]
  else
     result := '';
end;

function TDefineListBox.Find(Value: String; var Index: Integer): boolean;
begin
  result := false;
  index  := -1;
  while(index < Items.Count) and(not result) do begin
     inc(Index);
     if IndexInCount(Index,Items.Count) then
        result := Items.Strings[index]=Value;
  end;
end;

function TDefineListBox.FindChecked(Value:Integer; var index:integer):boolean;
var inx:integer;
    tmp:^Integer;
begin
  inx    := 0;
  result := false;
  while (inx < FChecks.Count)and(not result) do
  begin
    tmp := FChecks.Items[inx];
    result := Tmp^ = Value;
    if result then index := inx else index := -1;
    inc(inx);
  end;
end;

procedure TDefineListBox.AddCheck(Index:integer);
var inx:^Integer;
    x:integer;
begin
 if not FindChecked(index,x) then begin
    new(inx);
    inx^:=Index;
    FChecks.Add(inx);
 end;
end;

procedure TDefineListBox.DeleteChecked(Index:Integer);
begin
  Dispose(FChecks.Items[index]);
  FChecks.Delete(index);
end;

procedure TDefineListBox.Click;
begin
  inherited Click;
  if not Focused then SetFocus;
  if assigned(FOnClick) and IndexInCount(FItemIndex,FItems.Count) then begin
     FOnClick(self,FItems.Strings[FItemIndex]);
  end;
end;

procedure TDefineListBox.SetSorted(Value: Boolean);
begin
  if Value <> FSorted then
  begin
    FSorted       := Value;
    FItems.Sorted := Value;
    Invalidate;
  end;
end;

procedure TDefineListBox.SetItems(Value: TStringList);
begin
  FItems.Assign(Value);
end;

procedure TDefineListBox.SetItemsRect;
var
  CurPos: TPoint;
  curRect: TRect;
begin
  CurRect := ClientRect;
  with FStyle do begin
  if TitleHas then begin
    case TitlePosition of
      tsTop   : CurRect.Top    := CurRect.Top + TitleHeight;
      tsBottom: CurRect.Bottom := CurRect.Bottom - TitleHeight;
    end;
  end;
  // set left/top PosR for the the first item
  if ScrollBars then
     CurPos := Point(CurRect.left + 3, CurRect.top + 3 + BarsHeight)
  else
     CurPos := Point(CurRect.left + 3, CurRect.top + 3);

  // recreate all items-rect
  CreateRects(FRects,MaxItems,ItemHeight,CurPos,CurRect);
  end;
  Invalidate;
end;

function TDefineListBox.GetSelected(Index: Integer): Boolean;
begin
  Result := FindChecked(index, FItemIndex);
end;

procedure TDefineListBox.SetSelected(Index: Integer; Value: Boolean);
var inx:Integer;
begin
  if MultiSelect then
  begin
   if FindChecked(Index , inx) and Value then
      DeleteChecked(inx)
   else
      AddCheck(index);
  end else begin
      RemoveList(FChecks);
      FChecks.Clear;
  end;
  Invalidate;
end;

function TDefineListBox.GetSelCount: Integer;
begin
  if MultiSelect then
     Result := FChecks.Count
  else
     Result := -1;
end;

procedure TDefineListBox.Paint;
var
 memBitmap: TBitmap;
 inxRect, inxItem, CurIndex: Integer;
 itemRect: ^TRect;
 Format, TitleFormat: UINT;
 WorkRect, TitleRect:TRect;
 BarsRect: TBarsRect;
 curState: Boolean;
 procedure DrawImage(Canvas:TCanvas;Skin:TListStyle;WorkRect,TitleRect:TRect;TitleHas:Boolean);
 begin
  with Skin do begin
   //draw backgroud
   if not BackUseBitmap then
   begin
      if (Enabled)and(Focused or FMouseIn) then
         BoxDrawBackDrop(Canvas,BackStartColor,BackStopColor,BackdropOrien,WorkRect,BackdropColor,UserFace)
      else
         BoxDrawBackDrop(Canvas,BackStartColor,BackStopColor,BackdropOrien,WorkRect,BackFocusColor,UserFace);
   end
   else
      DrawBitmap(Canvas,WorkRect,BackBitmap);