bsbuttongroup.pas

BusinessSkinForm的控件包与实例

  CIndex := SkinData.GetControlIndex('resizebutton');
  ButtonData := SkinData.CtrlList[CIndex];
  with ButtonData do
  begin
    if bsbdsDown in State then
    begin
      SR := DownSkinRect;
      C := DownFontColor;
    end
    else
    if bsbdsSelected in State
    then
      begin
        SR := ActiveSkinRect;
        C := ActiveFontColor;
      end
    else
    if bsbdsHot in State
    then
      begin
        SR := ActiveSkinRect;
        C := ActiveFontColor;
      end
   else
    begin
      SR := SkinRect;
      C := FontColor;
    end;
    if IsNullRect(SR) then SR := SkinRect;
    XO := RectWidth(Rct) - RectWidth(SR);
    YO := RectHeight(Rct) - RectHeight(SR);
    NewLTPoint := LTPoint;
    NewRTPoint := Point(RTPoint.X + XO, RTPoint.Y);
    NewLBPoint := Point(LBPoint.X, LBPoint.Y + YO);
    NewRBPoint := Point(RBPoint.X + XO, RBPoint.Y + YO);
    NewClRect := Rect(CLRect.Left, ClRect.Top,
      CLRect.Right + XO, ClRect.Bottom + YO);

    FSkinPicture := TBitMap(FSD.FActivePictures.Items[ButtonData.PictureIndex]);

    CreateSkinImage(LTPoint, RTPoint, LBPoint, RBPoint, CLRect,
         NewLtPoint, NewRTPoint, NewLBPoint, NewRBPoint, NewCLRect,
         Buffer, FSkinPicture, SR, Buffer.Width, Buffer.Height, True,
         LeftStretch, TopStretch, RightStretch, BottomStretch, StretchEffect, StretchType);

    //
    if (bsbdsFocused in State) and FShowFocus
    then
      begin
        R := NewClRect;
        InflateRect(R, 1, 1);
        Buffer.Canvas.DrawFocusRect(R);
      end;
    // draw glpyh and text
    if FUseSkinFont
    then
      begin
        Buffer.Canvas.Font.Name := FontName;
        Buffer.Canvas.Font.Style := FontStyle;
        Buffer.Canvas.Font.Height := FontHeight;
      end
    else
      Buffer.Canvas.Font.Assign(Self.Font);
    Buffer.Canvas.Font.Color := C;
    if SkinData.ResourceStrData <>  nil
    then
      Buffer.Canvas.Font.Charset := SkinData.ResourceStrData.CharSet
    else
      Buffer.Canvas.Font.Charset := Font.CharSet;
    //
    ButtonItem := FButtonItems[Index];

    if gboShowCaptions in FButtonOptions
    then
      DrawImageAndText(Buffer.Canvas, NewClRect, -1, 2, blGlyphLeft,
         ButtonItem.Caption, ButtonItem.ImageIndex, FImages, bsbdsDown in State, True, False, 0)
    else
      DrawImageAndText(Buffer.Canvas, NewClRect, -1, 0, blGlyphLeft,
         '', ButtonItem.ImageIndex, FImages, bsbdsDown in State, True, False, 0);
  end;
  Canvas.Draw(Rct.Left, Rct.Top, Buffer);
  Buffer.Free;
end;

procedure TbsSkinButtonGroup.DrawButton(Index: Integer; Canvas: TCanvas;
  Rect: TRect; State: TbsButtonDrawState);
var
  ButtonItem: TbsGrpButtonItem;
  FillColor: TColor;
  EdgeColor: TColor;
  TextRect: TRect;
  R, OrgRect: TRect;
  CIndex: Integer;
begin
  if Assigned(FOnDrawButton) and (not (csDesigning in ComponentState)) then
    FOnDrawButton(Self, Index, Canvas, Rect, State)
  else
  begin
    if (SkinData <> nil) and not (SkinData.Empty)
    then
      begin
        CIndex := SkinData.GetControlIndex('resizebutton');
        if CIndex <> -1
        then
          begin
            DrawSkinButton(Index, Canvas, Rect, State);
            Exit;
          end;
      end;

    OrgRect := Rect;
    Canvas.Font := Font;

    if bsbdsDown in State then
    begin
      EdgeColor := BS_XP_BTNFRAMECOLOR;
      Canvas.Brush.Color := BS_XP_BTNDOWNCOLOR;
      Canvas.Font.Color := clBtnText;
    end
    else
    if bsbdsHot in State then
    begin
       EdgeColor := BS_XP_BTNFRAMECOLOR;
      Canvas.Brush.Color := BS_XP_BTNACTIVECOLOR;
      Canvas.Font.Color := clBtnText;
    end
    else
    if bsbdsSelected in State then
    begin
      EdgeColor := BS_XP_BTNFRAMECOLOR;
      Canvas.Brush.Color := BS_XP_BTNACTIVECOLOR;
      Canvas.Font.Color := clBtnText;
    end

    else
    begin
      EdgeColor := clBtnShadow;
      Canvas.Brush.Color := clBtnFace;
      Canvas.Font.Color := clBtnText;
    end;

    if Assigned(FOnBeforeDrawButton) then
      FOnBeforeDrawButton(Self, Index, Canvas, Rect, State);

    FillColor := Canvas.Brush.Color;
    Canvas.FillRect(Rect);

    InflateRect(Rect, -2, -1);

    { Draw the edge outline }
    Canvas.Brush.Color := EdgeColor;
    Canvas.FrameRect(Rect);
    Canvas.Brush.Color := FillColor;

    TextRect := Rect;
    InflateRect(TextRect, -4, -4);

    if (bsbdsFocused in State) and FShowFocus
    then
      begin
        R := Rect;
        InflateRect(R, -2, -2);
        Canvas.DrawFocusRect(R);
      end;

    ButtonItem := FButtonItems[Index];

    if gboShowCaptions in FButtonOptions
    then
      DrawImageAndText(Canvas, TextRect, -1, 2, blGlyphLeft,
         ButtonItem.Caption, ButtonItem.ImageIndex, FImages, bsbdsDown in State, True, False, 0)
    else
      DrawImageAndText(Canvas, TextRect, -1, 0, blGlyphLeft,
         '', ButtonItem.ImageIndex, FImages, bsbdsDown in State, True, False, 0);


    if Assigned(FOnAfterDrawButton) then
      FOnAfterDrawButton(Self, Index, Canvas, OrgRect, State);
  end;
  Canvas.Brush.Color := Color; { Restore the original color }
end;

procedure TbsSkinButtonGroup.SetOnDrawButton(const Value: TbsGrpButtonDrawEvent);
begin
  FOnDrawButton := Value;
  Invalidate;
end;

procedure TbsSkinButtonGroup.SetOnDrawIcon(const Value: TbsGrpButtonDrawIconEvent);
begin
  FOnDrawIcon := Value;
  Invalidate;
end;

procedure TbsSkinButtonGroup.CreateHandle;
begin
  inherited CreateHandle;
  { Make sure that we are showing the scroll bars, if needed }
  Resize;
end;

procedure TbsSkinButtonGroup.WMMouseLeave(var Message: TMessage);
begin
  FMouseInControl := False;
  if FHotIndex <> -1 then
  begin
    UpdateButton(FHotIndex);
    FHotIndex := -1;
    DoHotButton;
  end;
  if FDragImageList.Dragging then
  begin
    FDragImageList.HideDragImage;
    RemoveInsertionPoints;
    UpdateWindow(Handle);
    FDragImageList.ShowDragImage;
  end;
  DoMouseLeave;
end;

procedure TbsSkinButtonGroup.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  inherited;
  if Button = mbLeft then
  begin
    { Focus ourselves, when clicked, like a button would }
    if not Focused then
      Windows.SetFocus(Handle);

    FDragStarted := False;
    FDownIndex := IndexOfButtonAt(X, Y);
    if FDownIndex <> -1 then
    begin
      if bsgboAllowReorder in ButtonOptions then
        FDragIndex := FDownIndex;
      FDragStartPos := Point(X, Y);
      { If it is the same as the selected, don't do anything }
      if FDownIndex <> FItemIndex then
        UpdateButton(FDownIndex)
      else
        FDownIndex := -1;
    end;
  end;
end;

procedure TbsSkinButtonGroup.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  NewHotIndex, OldHotIndex: Integer;
  EventTrack: TTrackMouseEvent;
  DragThreshold: Integer;
begin
  inherited;
  { Was the drag threshold met? }
  if (bsgboAllowReorder in ButtonOptions) and (FDragIndex <> -1) then
  begin
    DragThreshold := Mouse.DragThreshold;
    if (Abs(FDragStartPos.X - X) >= DragThreshold) or
        (Abs(FDragStartPos.Y - Y) >= DragThreshold) then
    begin
      FDragStartPos.X := X; { Used in the start of the drag }
      FDragStartPos.Y := Y;
      FDownIndex := -1; { Stops repaints and clicks }
      if FHotIndex <> -1 then
      begin
        OldHotIndex := FHotIndex;
        FHotIndex := -1;
        UpdateButton(OldHotIndex);
        { We must have the window process the paint message before
          the drag operation starts }
        UpdateWindow(Handle);
        DoHotButton;
      end;
      FDragStarted := True;
      BeginDrag(True, -1);
      Exit;
    end;
  end;

  NewHotIndex := IndexOfButtonAt(X, Y);
  if NewHotIndex <> FHotIndex then
  begin
    OldHotIndex := FHotIndex;
    FHotIndex := NewHotIndex;
    UpdateButton(OldHotIndex);
    if FHotIndex <> -1 then
      UpdateButton(FHotIndex);
    DoHotButton;
  end;
  if not FMouseInControl then
  begin
    FMouseInControl := True;
    if FIs9XOS
    then
      FMouseTimer.Enabled := True
    else
      begin
        EventTrack.cbSize := SizeOf(TTrackMouseEvent);
        EventTrack.dwFlags := TME_LEAVE;
        EventTrack.hwndTrack := Handle;
        EventTrack.dwHoverTime := 0;
        TrackMouseEvent(EventTrack);
      end;
  end;
end;

procedure TbsSkinButtonGroup.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
var
  LastDown: Integer;
begin
  inherited;
  if (Button = mbLeft) and (not FDragStarted) then
  begin
    LastDown := FDownIndex;
    FDownIndex := -1;
    FDragIndex := -1;
    if (LastDown <> -1) and (IndexOfButtonAt(X, Y) = LastDown)
      and (FDragIndex = -1) then
    begin
      UpdateButton(LastDown);
      DoItemClicked(LastDown);
      if bsgboGroupStyle in ButtonOptions then
        ItemIndex := LastDown;
    end
    else if LastDown <> -1 then
      UpdateButton(LastDown);
    if Assigned(FOnClick) then
      FOnClick(Self);
  end;
  FDragStarted := False;
end;

function TbsSkinButtonGroup.IndexOfButtonAt(const X, Y: Integer): Integer;
var
  ButtonsPerRow: Integer;
  HiddenCount: Integer;
  Row, Col: Integer;
begin
  Result := -1;
  { Is it within our X and Y bounds first? }
  if (X >= 0) and (X < ClientWidth) and (Y >= 0) and (Y < Height) then
  begin
    ButtonsPerRow := CalcButtonsPerRow;
    HiddenCount := FHiddenItems*ButtonsPerRow;
    Row := Y div FButtonHeight;
    if bsgboFullSize in FButtonOptions then
      Col := 0
    else
      Col := X div FButtonWidth;

    Result := HiddenCount + Row*ButtonsPerRow + Col;

    if Result >= FButtonItems.Count then
      Result := -1
    else if (Row+1)*FButtonHeight > Height then
      Result := -1 { Item is clipped }
    else if not (bsgboFullSize in FButtonOptions)
    then
      begin
        if (Col + 1) * FButtonWidth > ClientWidth - GetScrollSize
        then
          Result := -1;
      end;
  end;
end;

procedure TbsSkinButtonGroup.DoItemClicked(const Index: Integer);
begin
  if Assigned(FButtonItems[Index].OnClick) then
    FButtonItems[Index].OnClick(Self)
  else if Assigned(FOnButtonClicked) then
    FOnButtonClicked(Self, Index);
end;

procedure TbsSkinButtonGroup.DragDrop(Source: TObject; X, Y: Integer);
var
  TargetIndex: Integer;
begin
  if (Source = Self) and (bsgboAllowReorder in ButtonOptions) then
  begin
    RemoveInsertionPoints;
    TargetIndex := TargetIndexAt(X, Y);
    if TargetIndex > FDragIndex then
      Dec(TargetIndex); { Account for moving ourselves }
    if TargetIndex <> -1 then
      DoReorderButton(FDragIndex, TargetIndex);
    FDragIndex := -1;
  end
  else
    inherited;
end;

const
  cScrollBuffer = 6;

procedure TbsSkinButtonGroup.DragOver(Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
var
  OverIndex: Integer;
begin
  if (Source = Self) and (bsgboAllowReorder in ButtonOptions) then
  begin
    { If the mouse is within the bottom cScrollBuffer pixels,
      then "auto-scroll" }
    if (FHiddenItems < FScrollBarMax) and (Y <= Height) and
         (Y >= Height - cScrollBuffer) and (X >= 0) and (X <= Width) then
      AutoScroll(scLineDown)
    else if (FHiddenItems > 0) and (Y >= 0) and
         (Y <= cScrollBuffer) and (X >= 0) and (X <= Width) then
      AutoScroll(scLineUp);

    OverIndex := TargetIndexAt(X, Y);
    { Don't accept when it is the same as the start or right after us }
    Accept := (OverIndex <> -1) and (OverIndex <> FDragIndex) and
      (OverIndex <> FDragIndex + 1) and (Items.Count > 1);
    FDragImageList.HideDragImage;
    if Accept and (State <> dsDragLeave) then
      SetInsertionPoints(OverIndex)
    else
      RemoveInsertionPoints;
    UpdateWindow(Handle);
    FDragImageList.ShowDragImage;
  end
  else
    inherited DragOver(Source, X, Y, State, Accept);
end;

procedure TbsSkinButtonGroup.DoHotButton;
begin
  if Assigned(FOnHotButton) then
    FOnHotButton(Self, FHotIndex);