?? bsbuttongroup.pas
字號:
end;
end;
procedure TbsSkinButtonGroup.DoFillRect(const Rect: TRect);
begin
Canvas.FillRect(Rect);
end;
procedure TbsSkinButtonGroup.DrawSkinButton(Index: Integer; Canvas: TCanvas;
Rct: TRect; State: TbsButtonDrawState);
var
R, SR: TRect;
ButtonData: TbsDataSkinButtonControl;
Buffer: TBitMap;
CIndex: Integer;
NewLTPoint, NewRTPoint, NewLBPoint, NewRBPoint: TPoint;
NewClRect: TRect;
XO, YO: Integer;
C: TColor;
FSkinPicture: TBitMap;
ButtonItem: TbsGrpButtonItem;
begin
Buffer := TBitMap.Create;
Buffer.Width := RectWidth(Rct);
Buffer.Height := RectHeight(Rct);
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);
//
if (bsbdsFocused in State) and FShowFocus
then
begin
R := NewClRect;
InflateRect(R, 1, 1);
Buffer.Canvas.DrawFocusRect(R);
end;
// draw glpyh and text
Buffer.Canvas.Font.Name := FontName;
Buffer.Canvas.Font.Style := FontStyle;
Buffer.Canvas.Font.Height := FontHeight;
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)
else
DrawImageAndText(Buffer.Canvas, NewClRect, -1, 0, blGlyphLeft,
'', ButtonItem.ImageIndex, FImages, bsbdsDown in State, True);
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)
else
DrawImageAndText(Canvas, TextRect, -1, 0, blGlyphLeft,
'', ButtonItem.ImageIndex, FImages, bsbdsDown in State, True);
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;
EventTrack.cbSize := SizeOf(TTrackMouseEvent);
EventTrack.dwFlags := TME_LEAVE;
EventTrack.hwndTrack := Handle;
EventTrack.dwHoverTime := 0;
TrackMouseEvent(EventTrack);
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);
end;
procedure TbsSkinButtonGroup.DoStartDrag(var DragObject: TDragObject);
var
ButtonRect: TRect;
State: TbsButtonDrawState;
DragImage: TBitmap;
begin
inherited DoStartDrag(DragObject);
if FDragIndex <> -1 then
begin
DragImage := TBitmap.Create;
try
ButtonRect := GetButtonRect(FDragIndex);
DragImage.Width := ButtonRect.Right - ButtonRect.Left;
DragImage.Height := ButtonRect.Bottom - ButtonRect.Top;
State := [bsbdsDragged];
if FItemIndex = FDragIndex then
State := State + [bsbdsSelected];
DrawButton(FDragIndex, DragImage.Canvas,
Rect(0, 0, DragImage.Width, DragImage.Height), State);
FDragImageList.Clear;
FDragImageList.Width := DragImage.Width;
FDragImageList.Height := DragImage.Height;
FDragImageList.Add(DragImage, nil);
{ with FDragImageList.DragHotspot do
begin
X := FDragStartPos.X - ButtonRect.Left - Mouse.DragThreshold;
Y := FDragStartPos.Y - ButtonRect.Top - Mouse.DragThreshold;
end;}
finally
DragImage.Free;
end;
end
else
FDragImageList.Clear; { No drag image }
end;
function TbsSkinButtonGroup.GetDragImages: TDragImageList;
begin
Result := FDragImageList;
end;
procedure TbsSkinButtonGroup.RemoveInsertionPoints;
procedure ClearSelection(var Index: Integer);
var
OldIndex: Integer;
begin
if Index <> -1 then
begin
OldIndex := Index;
Index := -1;
UpdateButton(OldIndex);
end;
end;
begin
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -