Delphi控件源码

开发平台：

Delphi

bsSkinCtrls.pas：源码内容

end;
procedure TbsSkinControlBar.WMSIZE;
begin
inherited;
GetSkinData;
if (FIndex <> -1) and FSkinBevel then PaintNCSkin;
end;
procedure TbsSkinControlBar.SetSkinBevel;
begin
FSkinBevel := Value;
if FIndex <> -1 then RecreateWnd;
end;
procedure TbsSkinControlBar.PaintNCSkin;
var
LeftBitMap, TopBitMap, RightBitMap, BottomBitMap: TBitMap;
DC: HDC;
Cnvs: TControlCanvas;
OX, OY: Integer;
begin
DC := GetWindowDC(Handle);
Cnvs := TControlCanvas.Create;
Cnvs.Handle := DC;
LeftBitMap := TBitMap.Create;
TopBitMap := TBitMap.Create;
RightBitMap := TBitMap.Create;
BottomBitMap := TBitMap.Create;
//
OX := Width - RectWidth(SkinRect);
OY := Height - RectHeight(SkinRect);
NewLTPoint := LTPt;
NewRTPoint := Point(RTPt.X + OX, RTPt.Y);
NewLBPoint := Point(LBPt.X, LBPt.Y + OY);
NewRBPoint := Point(RBPt.X + OX, RBPt.Y + OY);
NewClRect := Rect(ClRect.Left, ClRect.Top,
ClRect.Right + OX, ClRect.Bottom + OY);
//
CreateSkinBorderImages(LTPt, RTPt, LBPt, RBPt, ClRect,
NewLTPoint, NewRTPoint, NewLBPoint, NewRBPoint, NewCLRect,
LeftBitMap, TopBitMap, RightBitMap, BottomBitMap,
FSkinPicture, SkinRect, Width, Height, False, False, False, False);
if NewClRect.Bottom > NewClRect.Top
then
ExcludeClipRect(Cnvs.Handle,
NewClRect.Left, NewClRect.Top, NewClRect.Right, NewClRect.Bottom);
Cnvs.Draw(0, 0, TopBitMap);
Cnvs.Draw(0, TopBitMap.Height, LeftBitMap);
Cnvs.Draw(Width - RightBitMap.Width, TopBitMap.Height, RightBitMap);
Cnvs.Draw(0, Height - BottomBitMap.Height, BottomBitMap);
//
TopBitMap.Free;
LeftBitMap.Free;
RightBitMap.Free;
BottomBitMap.Free;
Cnvs.Handle := 0;
ReleaseDC(Handle, DC);
Cnvs.Free;
end;
procedure TbsSkinControlBar.Paint;
var
X, Y, XCnt, YCnt, w, h,
rw, rh, XO, YO: Integer;
Buffer: TBitMap;
i: Integer;
R: TRect;
B: TBitMap;
begin
GetSkinData;
if FIndex = -1
then
begin
inherited;
Exit
end;
if (ClientWidth > 0) and (ClientHeight > 0)
then
begin
Buffer := TBitMap.Create;
Buffer.Width := ClientWidth;
Buffer.Height := ClientHeight;
if BGPictureIndex = -1
then
begin
w := RectWidth(ClRect);
h := RectHeight(ClRect);
rw := Buffer.Width;
rh := Buffer.Height;
with Buffer.Canvas do
begin
XCnt := rw div w;
YCnt := rh div h;
for X := 0 to XCnt do
for Y := 0 to YCnt do
begin
if X * w + w > rw then XO := X * W + W - rw else XO := 0;
if Y * h + h > rh then YO := Y * h + h - rh else YO := 0;
CopyRect(Rect(X * w, Y * h,X * w + w - XO, Y * h + h - YO),
FSkinPicture.Canvas,
Rect(SkinRect.Left + ClRect.Left,
SkinRect.Top + ClRect.Top,
SkinRect.Left + ClRect.Right - XO,
SkinRect.Top + ClRect.Bottom - YO));
end;
end;
end
else
begin
B := TBitMap(FSD.FActivePictures.Items[BGPictureIndex]);
XCnt := Width div B.Width;
YCnt := Height div B.Height;
for X := 0 to XCnt do
for Y := 0 to YCnt do
Buffer.Canvas.Draw(X * B.Width, Y * B.Height, B);
end;
// draw controls frame
for i := 0 to ControlCount - 1 do
if Controls[i].Visible
then
begin
R := Controls[i].BoundsRect;
Dec(R.Left, 11);
Dec(R.Top, 2);
Inc(R.Right, 2);
Inc(R.Bottom, 2);
PaintControlFrame(Buffer.Canvas, Controls[i], R);
end;
Canvas.Draw(0, 0, Buffer);
Buffer.Free;
end;
end;
procedure TbsSkinControlBar.PaintControlFrame;
var
LeftB, TopB, RightB, BottomB: TBitMap;
W, H, IW, IH: Integer;
begin
GetSkinData;
if FIndex <> -1
then
begin
LeftB := TBitMap.Create;
TopB := TBitMap.Create;
RightB := TBitMap.Create;
BottomB := TBitMap.Create;
W := RectWidth(ARect);
H := RectHeight(ARect);
IW := RectWidth(ItemRect);
IH := RectHeight(ItemRect);
//
CreateSkinBorderImages(
Point(12, 3), Point(IW - 3, 3),
Point(12, IH - 3), Point(IW - 3, IH - 3),
Rect(11, 2, IW - 2, IH - 2),
Point(12, 3), Point(W - 3, 3),
Point(12, H - 3), Point(W - 3, H - 3),
Rect(11, 2, W - 2, H - 2),
LeftB, TopB, RightB, BottomB,
FSkinPicture, ItemRect, W, H, False, False, False, False);
//
Canvas.Draw(ARect.Left, ARect.Top, TopB);
Canvas.Draw(ARect.Left, ARect.Top + TopB.Height, LeftB);
Canvas.Draw(ARect.Right - RightB.Width, ARect.Top + TopB.Height, RightB);
Canvas.Draw(ARect.Left, ARect.Bottom - BottomB.Height, BottomB);
//
LeftB.Free;
TopB.Free;
RightB.Free;
BottomB.Free;
end
else
inherited;
end;
procedure TbsSkinControlBar.GetSkinData;
begin
if (FSD = nil) or FSD.Empty
then
FIndex := -1
else
FIndex := FSD.GetControlIndex(FSkinDataName);
BGPictureIndex := -1;
FSkinPicture := nil;
if FIndex <> -1
then
if TbsDataSkinControl(FSD.CtrlList.Items[FIndex]) is TbsDataSkinControlBar
then
with TbsDataSkinControlBar(FSD.CtrlList.Items[FIndex]) do
begin
LTPt := LTPoint;
RTPt := RTPoint;
LBPt := LBPoint;
RBPt := RBPoint;
Self.SkinRect := SkinRect;
Self.ClRect := ClRect;
if (PictureIndex <> -1) and (PictureIndex < FSD.FActivePictures.Count)
then
FSkinPicture := TBitMap(FSD.FActivePictures.Items[PictureIndex])
else
FSkinPicture := nil;
Self.ItemRect := ItemRect;
Self.BGPictureIndex := BGPictureIndex;
end;
end;
procedure TbsSkinControlBar.ChangeSkinData;
var
R: TRect;
begin
GetSkinData;
if FSkinBevel then ReCreateWnd;
R := ClientRect;
AdjustClientRect(R);
RePaint;
end;
procedure TbsSkinControlBar.SetSkinData;
begin
FSD := Value;
ChangeSkinData;
end;
procedure TbsSkinControlBar.WMNCCALCSIZE;
begin
GetSkinData;
if FIndex <> -1
then
begin
if FSkinBevel then
with TWMNCCALCSIZE(Message).CalcSize_Params^.rgrc[0] do
begin
Inc(Left, ClRect.Left);
Inc(Top, ClRect.Top);
Dec(Right, RectWidth(SkinRect) - ClRect.Right);
Dec(Bottom, RectHeight(SkinRect) - ClRect.Bottom);
if Right < Left then Right := Left;
if Bottom < Top
then Bottom := Top;
end;
end
else
inherited;
end;
procedure TbsSkinControlBar.WMNCPAINT(var Message: TMessage);
begin
GetSkinData;
if FIndex <> -1
then
begin
if FSkinBevel then PaintNCSkin;
end
else
inherited;
end;
procedure TbsSkinControlBar.CreateParams;
begin
inherited CreateParams(Params);
with Params do
begin
Style := Style and not WS_BORDER;
ExStyle := ExStyle and not WS_EX_CLIENTEDGE;
end;
end;
procedure TbsSkinControlBar.WMEraseBkgnd;
begin
if FIndex = -1 then inherited else Message.Result := 1;
end;
{ TbsGroupButton }
type
TbsGroupButton = class(TbsSkinCheckRadioBox)
private
FInClick: Boolean;
procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
protected
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure KeyPress(var Key: Char); override;
public
constructor InternalCreate(RadioGroup: TbsSkinCustomRadioGroup);
destructor Destroy; override;
end;
TbsCheckGroupButton = class(TbsSkinCheckRadioBox)
private
FInClick: Boolean;
procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
protected
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure KeyPress(var Key: Char); override;
public
constructor InternalCreate(CheckGroup: TbsSkinCustomCheckGroup);
destructor Destroy; override;
end;
constructor TbsGroupButton.InternalCreate(RadioGroup: TbsSkinCustomRadioGroup);
begin
inherited Create(RadioGroup);
RadioGroup.FButtons.Add(Self);
Visible := False;
Enabled := RadioGroup.Enabled;
ParentShowHint := False;
OnClick := RadioGroup.ButtonClick;
Parent := RadioGroup;
Radio := True;
CanFocused := True;
SkinDataName := 'radiobox';
GroupIndex := 1;
Flat := True;
end;
destructor TbsGroupButton .Destroy;
begin
TbsSkinCustomRadioGroup(Owner).FButtons.Remove(Self);
inherited Destroy;
end;
procedure TbsGroupButton .CNCommand(var Message: TWMCommand);
begin
if not FInClick then
begin
FInClick := True;
try
if ((Message.NotifyCode = BN_CLICKED) or
(Message.NotifyCode = BN_DOUBLECLICKED)) and
TbsSkinCustomRadioGroup(Parent).CanModify then
inherited;
except
Application.HandleException(Self);
end;
FInClick := False;
end;
end;
procedure TbsGroupButton.KeyPress(var Key: Char);
begin
inherited KeyPress(Key);
TbsSkinCustomRadioGroup(Parent).KeyPress(Key);
if (Key = #8) or (Key = ' ') then
begin
if not TbsSkinCustomRadioGroup(Parent).CanModify then Key := #0;
end;
end;
procedure TbsGroupButton.KeyDown(var Key: Word; Shift: TShiftState);
begin
inherited KeyDown(Key, Shift);
TbsSkinCustomRadioGroup(Parent).KeyDown(Key, Shift);
end;
constructor TbsCheckGroupButton.InternalCreate(CheckGroup: TbsSkinCustomCheckGroup);
begin
inherited Create(CheckGroup);
CheckGroup.FButtons.Add(Self);
Visible := False;
Enabled := CheckGroup.Enabled;
ParentShowHint := False;
OnClick := CheckGroup.ButtonClick;
Parent := CheckGroup;
Radio := False;
CanFocused := True;
SkinDataName := 'checkbox';
Flat := True;
end;
destructor TbsCheckGroupButton .Destroy;
begin
TbsSkinCustomCheckGroup(Owner).FButtons.Remove(Self);
inherited Destroy;
end;
function TbsSkinCustomCheckGroup.CanModify: Boolean;
begin
Result := True;
end;
procedure TbsSkinCustomCheckGroup.GetChildren(Proc: TGetChildProc; Root: TComponent);
begin
end;
procedure TbsCheckGroupButton .CNCommand(var Message: TWMCommand);
begin
if not FInClick then
begin
FInClick := True;
try
if ((Message.NotifyCode = BN_CLICKED) or
(Message.NotifyCode = BN_DOUBLECLICKED)) and
TbsSkinCustomCheckGroup(Parent).CanModify then
inherited;
except
Application.HandleException(Self);
end;
FInClick := False;
end;
end;
procedure TbsCheckGroupButton .KeyPress(var Key: Char);
begin
inherited KeyPress(Key);
TbsSkinCustomCheckGroup(Parent).KeyPress(Key);
if (Key = #8) or (Key = ' ') then
begin
if not TbsSkinCustomCheckGroup(Parent).CanModify then Key := #0;
end;
end;
procedure TbsCheckGroupButton .KeyDown(var Key: Word; Shift: TShiftState);
begin
inherited KeyDown(Key, Shift);
TbsSkinCustomCheckGroup(Parent).KeyDown(Key, Shift);
end;
{ TbsSkinCustomRadioGroup }
constructor TbsSkinCustomRadioGroup.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := [csSetCaption, csDoubleClicks];
FButtons := TList.Create;
FItems := TStringList.Create;
TStringList(FItems).OnChange := ItemsChange;
FItemIndex := -1;
FColumns := 1;
FButtonSkinDataName := 'radiobox';
FButtonDefaultFont := TFont.Create;
with FButtonDefaultFont do
begin
Name := 'Arial';
Style := [];
Height := 14;
end;
end;
procedure TbsSkinCustomRadioGroup.SetImages(Value: TCustomImageList);
var
I: Integer;
begin
FImages := Value;
if FButtons.Count > 0
then
for I := 0 to FButtons.Count - 1 do
with TbsGroupButton (FButtons[I]) do
Images := Self.Images;
end;
procedure TbsSkinCustomRadioGroup.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if Operation = opRemove then
begin
if AComponent = FImages then Images := nil;
end;
end;
procedure TbsSkinCustomRadioGroup.SetButtonDefaultFont;
var
I: Integer;
begin
FButtonDefaultFont.Assign(Value);
if FButtons.Count > 0
then
for I := 0 to FButtons.Count - 1 do
with TbsGroupButton (FButtons[I]) do
begin
DefaultFont.Assign(FButtonDefaultFont);
end;
end;
destructor TbsSkinCustomRadioGroup.Destroy;
begin
FButtonDefaultFont.Free;
SetButtonCount(0);
TStringList(FItems).OnChange := nil;
FItems.Free;
FButtons.Free;
inherited Destroy;
end;
procedure TbsSkinCustomRadioGroup.ChangeSkinData;
begin
inherited;
Self.ArrangeButtons;
end;
procedure TbsSkinCustomRadioGroup.SetSkinData;
var
I: Integer;
begin
inherited;
if FButtons.Count > 0
then
for I := 0 to FButtons.Count - 1 do
with TbsGroupButton (FButtons[I]) do
SkinData := Value;
end;
procedure TbsSkinCustomRadioGroup.SetButtonSkinDataName;
var
I: Integer;
begin
FButtonSkinDataName := Value;
if FButtons.Count > 0
then
for I := 0 to FButtons.Count - 1 do
with TbsGroupButton (FButtons[I]) do
SkinDataName := Value;
end;
procedure TbsSkinCustomRadioGroup.FlipChildren(AllLevels: Boolean);
begin
{ The radio buttons are flipped using BiDiMode }
end;
procedure TbsSkinCustomRadioGroup.ArrangeButtons;
var
ButtonsPerCol, ButtonWidth, ButtonHeight, TopMargin, I: Integer;
DeferHandle: THandle;
ALeft: Integer;
ButtonsRect: TRect;
begin
if (FButtons.Count <> 0) and not FReading then
begin
ButtonsRect := Rect(0, 0, Width, Height);
AdjustClientRect(ButtonsRect);
ButtonsPerCol := (FButtons.Count + FColumns - 1) div FColumns;
ButtonWidth := RectWidth(ButtonsRect) div FColumns - 2;
I := RectHeight(ButtonsRect);
ButtonHeight := I div ButtonsPerCol;
TopMargin := ButtonsRect.Top;
DeferHandle := BeginDeferWindowPos(FButtons.Count);
try
for I := 0 to FButtons.Count - 1 do
with TbsGroupButton(FButtons[I]) do
begin
BiDiMode := Self.BiDiMode;
ALeft := (I div ButtonsPerCol) * ButtonWidth + ButtonsRect.Left + 1;
if UseRightToLeftAlignment then
ALeft := RectWidth(ButtonsRect) - ALeft - ButtonWidth;
DeferHandle := DeferWindowPos(DeferHandle, Handle, 0,
ALeft,
(I mod ButtonsPerCol) * ButtonHeight + TopMargin,
ButtonWidth, ButtonHeight,
SWP_NOZORDER or SWP_NOACTIVATE);
Visible := True;
end;
finally
EndDeferWindowPos(DeferHandle);
end;
end;
end;
procedure TbsSkinCustomRadioGroup.ButtonClick(Sender: TObject);
begin
if not FUpdating then
begin
FItemIndex := FButtons.IndexOf(Sender);
Changed;
Click;
end;
end;
procedure TbsSkinCustomRadioGroup.ItemsChange(Sender: TObject);
begin
if not FReading then
begin
if FItemIndex >= FItems.Count then FItemIndex := FItems.Count - 1;
UpdateButtons;
end;
end;
procedure TbsSkinCustomRadioGroup.Loaded;
begin
inherited Loaded;
ArrangeButtons;
end;
procedure TbsSkinCustomRadioGroup.ReadState(Reader: TReader);
begin
FReading := True;
inherited ReadState(Reader);
FReading := False;
UpdateButtons;
end;
procedure TbsSkinCustomRadioGroup.SetButtonCount(Value: Integer);
var
i: Integer;
begin
while FButtons.Count < Value do TbsGroupButton .InternalCreate(Self);
while FButtons.Count > Value do TbsGroupButton (FButtons.Last).Free;
if FButtons.Count > 0
then
for I := 0 to FButtons.Count - 1 do
with TbsGroupButton (FButtons[I]) do
begin
ImageIndex := I;
SkinData := Self.SkinData;
SkinDataName := ButtonSkinDataName;
DefaultFont.Assign(FButtonDefaultFont);
UseSkinFont := Self.UseSkinFont;
end;
end;
procedure TbsSkinCustomRadioGroup.SetColumns(Value: Integer);
begin
if Value < 1 then Value := 1;
if Value > 16 then Value := 16;
if FColumns <> Value then
begin
FColumns := Value;
ArrangeButtons;
Invalidate;
end;
end;
procedure TbsSkinCustomRadioGroup.SetItemIndex(Value: Integer);
begin
if FReading then FItemIndex := Value else
begin
if Value < -1 then Value := -1;
if Value >= FButtons.Count then Value := FButtons.Count - 1;
if FItemIndex <> Value then
begin
if FItemIndex >= 0 then
TbsGroupButton (FButtons[FItemIndex]).Checked := False;
FItemIndex := Value;
if FItemIndex >= 0 then
TbsGroupButton (FButtons[FItemIndex]).Checked := True;
end;
end;
end;
procedure TbsSkinCustomRadioGroup.SetItems(Value: TStrings);
begin
FItems.Assign(Value);
end;
procedure TbsSkinCustomRadioGroup.UpdateButtons;
var
I: Integer;
begin
SetButtonCount(FItems.Count);
for I := 0 to FButtons.Count - 1 do
TbsGroupButton (FButtons[I]).Caption := FItems[I];
if FItemIndex >= 0 then
begin
FUpdating := True;
TbsGroupButton (FButtons[FItemIndex]).Checked := True;
FUpdating := False;
end;
ArrangeButtons;
Invalidate;
end;
procedure TbsSkinCustomRadioGroup.CMEnabledChanged(var Message: TMessage);
var
I: Integer;
begin
inherited;
for I := 0 to FButtons.Count - 1 do
TbsGroupButton(FButtons[I]).Enabled := Enabled;
end;
procedure TbsSkinCustomRadioGroup.CMFontChanged(var Message: TMessage);
begin
inherited;
ArrangeButtons;
end;
procedure TbsSkinCustomRadioGroup.WMSize(var Message: TWMSize);
begin
inherited;
ArrangeButtons;
end;
function TbsSkinCustomRadioGroup.CanModify: Boolean;
begin
Result := True;
end;
procedure TbsSkinCustomRadioGroup.GetChildren(Proc: TGetChildProc; Root: TComponent);
begin
end;
{ TbsSkinCustomCheckGroup }
constructor TbsSkinCustomCheckGroup.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := [csSetCaption, csDoubleClicks];
FButtons := TList.Create;
FItems := TStringList.Create;
TStringList(FItems).OnChange := ItemsChange;
FColumns := 1;
FItemIndex := -1;
FButtonSkinDataName := 'checkbox';
FButtonDefaultFont := TFont.Create;
with FButtonDefaultFont do
begin
Name := 'Arial';
Style := [];
Height := 14;
end;
end;
procedure TbsSkinCustomCheckGroup.SetButtonDefaultFont;
var
I: Integer;
begin
FButtonDefaultFont.Assign(Value);
if FButtons.Count > 0
then
for I := 0 to FButtons.Count - 1 do
with TbsCheckGroupButton (FButtons[I]) do
DefaultFont.Assign(FButtonDefaultFont);
end;
destructor TbsSkinCustomCheckGroup.Destroy;
begin
FButtonDefaultFont.Free;
SetButtonCount(0);
TStringList(FItems).OnChange := nil;
FItems.Free;
FButtons.Free;
inherited Destroy;
end;
procedure TbsSkinCustomCheckGroup.SetImages(Value: TCustomImageList);
var
I: Integer;
begin
FImages := Value;
if FButtons.Count > 0
then
for I := 0 to FButtons.Count - 1 do
with TbsCheckGroupButton (FButtons[I]) do
Images := Self.Images;
end;
procedure TbsSkinCustomCheckGroup.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if Operation = opRemove then
begin
if AComponent = FImages then Images := nil;
end;
end;
function TbsSkinCustomCheckGroup.GetCheckedStatus(Index: Integer): Boolean;
begin
if (Index >= 0) and (Index < FButtons.Count)
then
Result := TbsCheckGroupButton(FButtons[Index]).Checked
else
Result := False;
end;
procedure TbsSkinCustomCheckGroup.SetCheckedStatus(Index: Integer; Value: Boolean);
begin
if (Index >= 0) and (Index < FButtons.Count)
then
TbsCheckGroupButton(FButtons[Index]).Checked := Value;
end;
procedure TbsSkinCustomCheckGroup.UpdateButtons;
var
I: Integer;
begin
SetButtonCount(FItems.Count);
for I := 0 to FButtons.Count - 1 do
TbsGroupButton (FButtons[I]).Caption := FItems[I];
ArrangeButtons;
Invalidate;
end;
procedure TbsSkinCustomCheckGroup.ChangeSkinData;
begin
inherited;
Self.ArrangeButtons;
end;
procedure TbsSkinCustomCheckGroup.SetSkinData;
var
I: Integer;
begin
inherited;
if FButtons.Count > 0
then
for I := 0 to FButtons.Count - 1 do
with TbsCheckGroupButton (FButtons[I]) do
SkinData := Value;
end;
procedure TbsSkinCustomCheckGroup.SetButtonSkinDataName;
var
I: Integer;
begin
FButtonSkinDataName := Value;
if FButtons.Count > 0
then
for I := 0 to FButtons.Count - 1 do
with TbsCheckGroupButton (FButtons[I]) do
SkinDataName := Value;
end;
procedure TbsSkinCustomCheckGroup.FlipChildren(AllLevels: Boolean);
begin
{ The radio buttons are flipped using BiDiMode }
end;
procedure TbsSkinCustomCheckGroup.ArrangeButtons;
var
ButtonsPerCol, ButtonWidth, ButtonHeight, TopMargin, I: Integer;
DeferHandle: THandle;
ALeft: Integer;
ButtonsRect: TRect;
begin
if (FButtons.Count <> 0) and not FReading then
begin
ButtonsRect := Rect(0, 0, Width, Height);
AdjustClientRect(ButtonsRect);
ButtonsPerCol := (FButtons.Count + FColumns - 1) div FColumns;
ButtonWidth := RectWidth(ButtonsRect) div FColumns - 2;
I := RectHeight(ButtonsRect);
ButtonHeight := I div ButtonsPerCol;
TopMargin := ButtonsRect.Top;
DeferHandle := BeginDeferWindowPos(FButtons.Count);
try
for I := 0 to FButtons.Count - 1 do
with TbsCheckGroupButton(FButtons[I]) do
begin
BiDiMode := Self.BiDiMode;
ALeft := (I div ButtonsPerCol) * ButtonWidth + ButtonsRect.Left + 1;
if UseRightToLeftAlignment then
ALeft := RectWidth(ButtonsRect) - ALeft - ButtonWidth;
DeferHandle := DeferWindowPos(DeferHandle, Handle, 0,
ALeft,
(I mod ButtonsPerCol) * ButtonHeight + TopMargin,
ButtonWidth, ButtonHeight,
SWP_NOZORDER or SWP_NOACTIVATE);
Visible := True;
end;
finally
EndDeferWindowPos(DeferHandle);
end;
end;
end;
procedure TbsSkinCustomCheckGroup.ButtonClick(Sender: TObject);
begin
if not FUpdating then
begin
FItemIndex := FButtons.IndexOf(Sender);
Changed;
Click;
end;
end;
procedure TbsSkinCustomCheckGroup.ItemsChange(Sender: TObject);
begin
if not FReading then
begin
UpdateButtons;
end;
end;
procedure TbsSkinCustomCheckGroup.Loaded;
begin
inherited Loaded;
ArrangeButtons;
end;
procedure TbsSkinCustomCheckGroup.ReadState(Reader: TReader);
begin
FReading := True;
inherited ReadState(Reader);
FReading := False;
UpdateButtons;
end;
procedure TbsSkinCustomCheckGroup.SetButtonCount(Value: Integer);
var
i: Integer;
begin
while FButtons.Count < Value do TbsCheckGroupButton .InternalCreate(Self);
while FButtons.Count > Value do TbsCheckGroupButton (FButtons.Last).Free;
if FButtons.Count > 0
then
for I := 0 to FButtons.Count - 1 do
with TbsCheckGroupButton (FButtons[I]) do
begin
ImageIndex := I;
SkinData := Self.SkinData;
SkinDataName := ButtonSkinDataName;
DefaultFont.Assign(FButtonDefaultFont);
UseSkinFont := Self.UseSkinFont;
end;
end;
procedure TbsSkinCustomCheckGroup.SetColumns(Value: Integer);
begin
if Value < 1 then Value := 1;
if Value > 16 then Value := 16;
if FColumns <> Value then
begin
FColumns := Value;
ArrangeButtons;
Invalidate;
end;
end;
procedure TbsSkinCustomCheckGroup.SetItems(Value: TStrings);
begin
FItems.Assign(Value);
end;
procedure TbsSkinCustomCheckGroup.CMEnabledChanged(var Message: TMessage);
var
I: Integer;
begin
inherited;
for I := 0 to FButtons.Count - 1 do
TbsCheckGroupButton(FButtons[I]).Enabled := Enabled;
end;
procedure TbsSkinCustomCheckGroup.CMFontChanged(var Message: TMessage);
begin
inherited;
ArrangeButtons;
end;
procedure TbsSkinCustomCheckGroup.WMSize(var Message: TWMSize);
begin
inherited;
ArrangeButtons;
end;
constructor TbsSkinCustomTreeView.Create(AOwner: TComponent);
begin
inherited;
FVScrollBar := nil;
FHScrollBar := nil;
FSD := nil;
FIndex := -1;
FDefaultFont := TFont.Create;
with FDefaultFont do
begin
Name := 'Arial';
Style := [];
Height := 14;
end;
FDefaultColor := clWindow;
FSkinDataName := 'treeview';
FInCheckScrollBars := False;
FUseSkinFont := True;
end;
destructor TbsSkinCustomTreeView.Destroy;
begin
FDefaultFont.Free;
inherited;
end;
procedure TbsSkinCustomTreeView.CMVisibleChanged;
begin
inherited;
if FVScrollBar <> nil then FVScrollBar.Visible := Self.Visible;
if FHScrollBar <> nil then FHScrollBar.Visible := Self.Visible;
end;
procedure TbsSkinCustomTreeView.Loaded;
begin
inherited;
ChangeSkinData;
end;
procedure TbsSkinCustomTreeView.SetDefaultColor;
begin
FDefaultColor := Value;
if FIndex = -1 then Color := Value;
end;
procedure TbsSkinCustomTreeView.SetDefaultFont;
begin
FDefaultFont.Assign(Value);
if FIndex = -1 then Font.Assign(Value);
end;
procedure TbsSkinCustomTreeView.ChangeSkinData;
begin
if (csLoading in ComponentState) then Exit;
if (FSD = nil) or FSD.Empty
then
FIndex := -1
else
FIndex := FSD.GetControlIndex(FSkinDataName);
if FIndex <> -1
then
begin
if TbsDataSkinControl(FSD.CtrlList.Items[FIndex]) is
TbsDataSkinTreeView
then
with TbsDataSkinTreeView(FSD.CtrlList.Items[FIndex]) do
begin
if FUseSkinFont
then
begin
Font.Name := FontName;
Font.Style := FontStyle;
Font.Height := FontHeight;
end
else
Font.Assign(FDefaultFont);
Font.Color := FontColor;
Color := BGColor;
end;
end
else
begin
Color := FDefaultColor;
Font.Assign(FDefaultFont);
end;
if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
then
Font.Charset := SkinData.ResourceStrData.CharSet
else
Font.Charset := FDefaultFont.Charset;
if Images <> nil then Images.BkColor := Self.Color;
if StateImages <> nil then StateImages.BkColor := Self.Color;
UpDateScrollBars;
if FVScrollBar <> nil then FVScrollBar.Align := FVScrollBar.Align;
if FHScrollBar <> nil then FHScrollBar.Align := FHScrollBar.Align;
end;
procedure TbsSkinCustomTreeView.SetSkinData;
begin
FSD := Value;
if (FSD <> nil) then
if not FSD.Empty and not (csDesigning in ComponentState)
then
ChangeSkinData;
end;
procedure TbsSkinCustomTreeView.Notification;
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (AComponent = FSD) then FSD := nil;
if (Operation = opRemove) and (AComponent = FVScrollBar)
then FVScrollBar := nil;
if (Operation = opRemove) and (AComponent = FHScrollBar)
then FHScrollBar := nil;
end;
procedure TbsSkinCustomTreeView.Change;
begin
inherited;
UpDateScrollBars;
end;
procedure TbsSkinCustomTreeView.WMNCCALCSIZE;
begin
end;
procedure TbsSkinCustomTreeView.WMNCPAINT;
begin
end;
procedure TbsSkinCustomTreeView.SetVScrollBar;
begin
FVScrollBar := Value;
if FVScrollBar <> nil
then
with FVScrollBar do
begin
Enabled := True;
Visible := False;
OnChange := OnVScrollBarChange;
end;
UpDateScrollBars;
end;
procedure TbsSkinCustomTreeView.SetHScrollBar;
begin
FHScrollBar := Value;
if FHScrollBar <> nil
then
with FHScrollBar do
begin
Enabled := True;
Visible := False;
OnChange := OnHScrollBarChange;
end;
UpDateScrollBars;
end;
procedure TbsSkinCustomTreeView.WndProc;
begin
inherited;
case Message.Msg of
WM_SIZE, WM_PAINT:
if not FInCheckScrollBars then UpDateScrollBars;
WM_KEYDOWN, WM_LBUTTONUP:
UpDateScrollBars;
end;
end;
procedure TbsSkinCustomTreeView.UpDateScrollBars;
var
Min, Max, Pos, Page: Integer;
R: TRect;
OldVisible, HVisibleChanged, VVisibleChanged: Boolean;
begin
if (csLoading in ComponentState) or FInCheckScrollBars then Exit;
VVisibleChanged := False;
HVisibleChanged := False;
if FVScrollBar <> nil
then
begin
GetScrollRange(Handle, SB_VERT, Min, Max);
Pos := GetScrollPos(Handle, SB_VERT);
Page := TreeView_GetVisibleCount(Handle);
FInCheckScrollBars := True;
OldVisible := FVScrollBar.Visible;
FVScrollBar.Visible := (Max > 0) and (Max >= Page) and
(Max < treeview_GetCount(Handle)) and Self.Visible;
VVisibleChanged := FVScrollBar.Visible <> OldVisible;
FInCheckScrollBars := False;
if FVScrollBar.Visible
then
FVScrollBar.SetRange(Min, Max, Pos, Page);
end;
if FHScrollBar <> nil
then
begin
GetScrollRange(Handle, SB_HORZ, Min, Max);
Pos := GetScrollPos(Handle, SB_HORZ);
FInCheckScrollBars := True;
OldVisible := FHScrollBar.Visible;
FHScrollBar.Visible := (Max > Width) and Self.Visible;
HVisibleChanged := FHScrollBar.Visible <> OldVisible;
FInCheckScrollBars := False;
if FHScrollBar.Visible
then
FHScrollBar.SetRange(Min, Max, Pos, Width);
end;
if (FVScrollBar <> nil) and (FHScrollBar <> nil)
then
begin
if not FVScrollBar.Visible and FHScrollBar.Both
then
FHScrollBar.Both := False
else
if FVScrollBar.Visible and not FHScrollBar.Both
then
FHScrollBar.Both := True;
end;
if (Self.Align <> alNone) and (HVisibleChanged or VVisibleChanged)
then
begin
FInCheckScrollBars := True;
R := Parent.ClientRect;
TParentControl(Parent).AlignControls(nil, R);
FInCheckScrollBars := False;
end;
end;
procedure TbsSkinCustomTreeView.OnVScrollBarChange;
begin
SendMessage(Handle, WM_VSCROLL,
MakeWParam(SB_THUMBPOSITION, FVSCROLLBAR.Position), 0);
end;
procedure TbsSkinCustomTreeView.OnHScrollBarChange;
begin
SendMessage(Handle, WM_HSCROLL,
MakeWParam(SB_THUMBPOSITION, FHSCROLLBAR.Position), 0);
end;
procedure TbsSkinCustomTreeView.CreateParams;
begin
inherited;
with Params do
Style := Style and not (WS_HSCROLL or WS_VSCROLL);
end;
constructor TbsSkinCustomListView.Create(AOwner: TComponent);
begin
inherited;
FHeaderSkinDataName := 'resizebutton';
FHIndex := -1;
FHeaderHandle := 0;
FHeaderInstance := MakeObjectInstance(HeaderWndProc);
FDefHeaderProc := nil;
FInCheckScrollBars := False;
FVScrollBar := nil;
FHScrollBar := nil;
FOldVScrollBarPos := 0;
FOldHScrollBarPos := 0;
FSD := nil;
FIndex := -1;
FDefaultFont := TFont.Create;
with FDefaultFont do
begin
Name := 'Arial';
Style := [];
Height := 14;
end;
Font.Assign(FDefaultFont);
FDefaultColor := clWindow;
FSkinDataName := 'listview';
FUseSkinFont := True;
end;
destructor TbsSkinCustomListView.Destroy;
begin
FDefaultFont.Free;
if FHeaderHandle <> 0 then
SetWindowLong(FHeaderHandle, GWL_WNDPROC, LongInt(FDefHeaderProc));
FreeObjectInstance(FHeaderInstance);
FHeaderHandle := 0;
inherited;
end;
procedure TbsSkinCustomListView.HGetSkinData;
begin
if (FSD = nil) or FSD.Empty
then
FHIndex := -1
else
FHIndex := FSD.GetControlIndex(FHeaderSkinDataName);
if FHIndex <> -1
then
if TbsDataSkinControl(FSD.CtrlList.Items[FHIndex]) is TbsDataSkinButtonControl
then
with TbsDataSkinButtonControl(FSD.CtrlList.Items[FHIndex]) do
begin
HLTPt := LTPoint;
HRTPt := RTPoint;
HLBPt := LBPoint;
HRBPt := RBPoint;
HSkinRect := SkinRect;
HClRect := ClRect;
if (PictureIndex <> -1) and (PictureIndex < FSD.FActivePictures.Count)
then
HPicture := TBitMap(FSD.FActivePictures.Items[PictureIndex])
else
HPicture := nil;
//
HFontColor := FontColor;
HActiveFontColor := ActiveFontColor;
HDownFontColor := DownFontColor;
HActiveSkinRect := ActiveSkinRect;
HDownSkinRect := DownSkinRect;
if IsNullRect(HActiveSkinRect) then HActiveSkinRect := SkinRect;
if IsNullRect(HDownSkinRect) then HDownSkinRect := HActiveSkinRect;
end
else
HPicture := nil;
end;
procedure TbsSkinCustomListView.CreateWnd;
begin
inherited;
end;
procedure TbsSkinCustomListView.DrawHeaderSection;
var
SR, BR, DR: TRect;
S: String;
B, B1: TBitMap;
W, H, TX, TY, GX, GY, XO, YO: Integer;
begin
if (RectWidth(R) <= 0) or (RectHeight(R) <= 0) then Exit;
S := Column.Caption;
B := TBitMap.Create;
W := RectWidth(R);
H := RectHeight(R);
B.Width := W;
B.Height := H;
BR := Rect(0, 0, B.Width, B.Height);
HGetSkinData;
if FHIndex = -1
then
with B.Canvas do
begin
//
if Pressed
then
begin
Frame3D(B.Canvas, BR, BS_XP_BTNFRAMECOLOR, BS_XP_BTNFRAMECOLOR, 1);
Brush.Color := BS_XP_BTNDOWNCOLOR;
end
else
if Active
then
begin
Frame3D(B.Canvas, BR, BS_XP_BTNFRAMECOLOR, BS_XP_BTNFRAMECOLOR, 1);
Brush.Color := BS_XP_BTNACTIVECOLOR;
end
else
begin
Frame3D(B.Canvas, BR, clBtnShadow, clBtnShadow, 1);
Brush.Color := clBtnFace;
end;
//
FillRect(BR);
Brush.Style := bsClear;
Font := Self.Font;
Font.Color := clBtnText;
end
else
with B.Canvas do
begin
Font := Self.Font;
if Pressed
then
begin
SR := HDownSkinRect;
Font.Color := HDownFontColor;
end
else
begin
SR := HSkinRect;
Font.Color := HFontColor;
end;
//
XO := RectWidth(BR) - RectWidth(HSkinRect);
YO := RectHeight(BR) - RectHeight(HSkinRect);
if (HLBPt.X = 0) and (HLBPt.Y = 0)
then
begin
B1 := TBitMap.Create;
B1.Width := RectWidth(R);
B1.Height := RectHeight(HSkinRect);
CreateHSkinImage(HLTPt.X, RectWidth(SR) - HRTPt.X,
B1, HPicture, SR, B1.Width, B1.Height);
DR := Rect(0, 0, B.Width, B.Height);
B.Canvas.StretchDraw(DR, B1);
B1.Free;
end
else
begin
HNewLTPoint := HLTPt;
HNewRTPoint := Point(HRTPt.X + XO, HRTPt.Y);
HNewLBPoint := Point(HLBPt.X, HLBPt.Y + YO);
HNewRBPoint := Point(HRBPt.X + XO, HRBPt.Y + YO);
HNewClRect := Rect(HCLRect.Left, HClRect.Top,
HCLRect.Right + XO, HClRect.Bottom + YO);
CreateSkinImage(HLTPt, HRTPt, HLBPt, HRBPt, hCLRect,
HNewLtPoint, HNewRTPoint, HNewLBPoint, HNewRBPoint, HNewCLRect,
B, HPicture, SR, B.Width, B.Height, True);
end;
end;
if Assigned(FOnDrawHeaderSection)
then
FOnDrawHeaderSection(B.Canvas, Column, Pressed, Rect(0, 0, B.Width, B.Height))
else
with B.Canvas do
begin
Brush.Style := bsClear;
Inc(BR.Left, 5); Dec(BR.Right, 5);
if (SmallImages <> nil) and (Column.ImageIndex >= 0) and
(Column.ImageIndex < SmallImages.Count)
then
begin
CorrectTextbyWidth(B.Canvas, S, RectWidth(BR) - 10 - SmallImages.Width);
GX := BR.Left;
if S = Column.Caption then
case Column.Alignment of
taRightJustify: GX := BR.Right - TextWidth(S) - SmallImages.Width - 10;
taCenter: GX := BR.Left + RectWidth(BR) div 2 -
(TextWidth(S) + SmallImages.Width + 10) div 2;
end;
TX := GX + SmallImages.Width + 10;
TY := BR.Top + RectHeight(BR) div 2 - TextHeight(S) div 2;
GY := BR.Top + RectHeight(BR) div 2 - SmallImages.Height div 2;
SmallImages.Draw(B.Canvas, GX, GY, Column.ImageIndex, True);
end
else
begin
CorrectTextbyWidth(B.Canvas, S, RectWidth(BR));
TX := BR.Left;
TY := BR.Top + RectHeight(BR) div 2 - TextHeight(S) div 2;
case Column.Alignment of
taRightJustify: TX := BR.Right - TextWidth(S) - 10;
taCenter: TX := RectWidth(BR) div 2 - TextWidth(S) div 2;
end;
end;
TextRect(BR, TX, TY, S);
end;
Cnvs.Draw(R.Left, R.Top, B);
B.Free;
end;
function TbsSkinCustomListView.GetHeaderSectionRect(Index: Integer): TRect;
var
SectionOrder: array of Integer;
R: TRect;
begin
if Self.FullDrag
then
begin
SetLength(SectionOrder, Columns.Count);
Header_GetOrderArray(FHeaderHandle, Columns.Count, PInteger(SectionOrder));
Header_GETITEMRECT(FHeaderHandle, SectionOrder[Index] , @R);
end
else
Header_GETITEMRECT(FHeaderHandle, Index, @R);
Result := R;
end;
procedure TbsSkinCustomListView.PaintHeader;
var
Cnvs: TControlCanvas;
i, RightOffset, Xo, YO: Integer;
DR, R, BGR, HR: TRect;
PS: TPaintStruct;
B, B1: TBitMap;
begin
if DC = 0 then DC := BeginPaint(FHeaderHandle, PS);
try
Cnvs := TControlCanvas.Create;
Cnvs.Handle := DC;
RightOffset := 0;
with Cnvs do
begin
for i := 0 to Header_GetItemCount(FHeaderHandle) - 1 do
begin
R := GetHeaderSectionRect(i);
DrawHeaderSection(Cnvs, Columns[i], False, (FActiveSection = I) and FHeaderDown, R);
if RightOffset < R.Right then RightOffset := R.Right;
end;
end;
Windows.GetWindowRect(FHeaderHandle, HR);
BGR := Rect(RightOffset, 0, RectWidth(HR) + 1, RectHeight(R));
HGetSkinData;
if BGR.Left < BGR.Right then
if FhIndex = -1
then
with Cnvs do
begin
Brush.Color := clBtnFace;
Fillrect(BGR);
Frame3D(Cnvs, BGR, clBtnShadow, clBtnShadow, 1);
end
else
begin
//
B := TBitMap.Create;
B.Width := RectWidth(BGR);
B.Height := RectHeight(BGR);
XO := RectWidth(BGR) - RectWidth(HSkinRect);
YO := RectHeight(BGR) - RectHeight(HSkinRect);
if (HLBPt.X = 0) and (HLBPt.Y = 0)
then
begin
B1 := TBitMap.Create;
B1.Width := RectWidth(BGR);
B1.Height := RectHeight(HSkinRect);
CreateHSkinImage2(HLtPt.X, RectWidth(HSkinRect) - HRTPt.X,
B1, HPicture, HSkinRect, B1.Width, B1.Height);
DR := Rect(0, 0, B.Width, B.Height);
B.Canvas.StretchDraw(DR, B1);
B1.Free;
end
else
begin
HNewLTPoint := HLTPt;
HNewRTPoint := Point(HRTPt.X + XO, HRTPt.Y);
HNewLBPoint := Point(HLBPt.X, HLBPt.Y + YO);
HNewRBPoint := Point(HRBPt.X + XO, HRBPt.Y + YO);
HNewClRect := Rect(HCLRect.Left, HClRect.Top,
HCLRect.Right + XO, HClRect.Bottom + YO);
CreateSkinImage2(HLTPt, HRTPt, HLBPt, HRBPt, HCLRect,
HNewLtPoint, HNewRTPoint, HNewLBPoint, HNewRBPoint, HNewCLRect,
B, HPicture, HSkinRect, B.Width, B.Height, True);
end;
Cnvs.Draw(BGR.Left, BGR.Top, B);
B.Free;
end;
Cnvs.Handle := 0;
Cnvs.Free;
finally
if DC = 0
then
EndPaint(FHeaderHandle, PS)
else
ReleaseDC(FHeaderHandle, DC);
end;
end;
procedure TbsSkinCustomListView.HeaderWndProc(var Message: TMessage);
var
X, Y: Integer;
function GetSectionFromPoint(P: TPoint): Integer;
var
i: Integer;
R: TRect;
begin
FActiveSection := -1;
for i := 0 to Columns.Count - 1 do
begin
R := GetHeaderSectionRect(i);
if PtInRect(R, Point(X, Y))
then
begin
FActiveSection := i;
Break;
end;
end;
end;
var
Info: THDHitTestInfo;
begin
if Message.Msg = WM_PAINT
then
begin
PaintHeader(TWMPAINT(MESSAGE).DC);
end
else
if Message.Msg = WM_ERASEBKGND
then
begin
Message.Result := 1;
end
else
Message.Result := CallWindowProc(FDefHeaderProc, FHeaderHandle,
Message.Msg, Message.WParam, Message.LParam);
case Message.Msg of
WM_LBUTTONDOWN:
begin
X := TWMLBUTTONDOWN(Message).XPos;
Y := TWMLBUTTONDOWN(Message).YPos;
GetSectionFromPoint(Point(X, Y));
//
Info.Point.X := X;
Info.Point.Y := Y;
SendMessage(FHeaderHandle, HDM_HITTEST, 0, Integer(@Info));
FHeaderDown := not (Info.Flags = HHT_ONDIVIDER);
//
RedrawWindow(FHeaderHandle, 0, 0, RDW_INVALIDATE);
end;
WM_LBUTTONUP:
begin
FHeaderDown := False;
FActiveSection := -1;
RedrawWindow(FHeaderHandle, 0, 0, RDW_INVALIDATE);
end;
end;
end;
procedure TbsSkinCustomListView.CMVisibleChanged;
begin
inherited;
if FVScrollBar <> nil then FVScrollBar.Visible := Self.Visible;
if FHScrollBar <> nil then FHScrollBar.Visible := Self.Visible;
end;
procedure TbsSkinCustomListView.SetDefaultColor;
begin
FDefaultColor := Value;
if FIndex = -1 then Color := Value;
end;
procedure TbsSkinCustomListView.Loaded;
begin
ChangeSkinData;
end;
procedure TbsSkinCustomListView.ChangeSkinData;
begin
if (FSD = nil) or FSD.Empty
then
FIndex := -1
else
FIndex := FSD.GetControlIndex(FSkinDataName);
if FIndex <> -1
then
begin
if TbsDataSkinControl(FSD.CtrlList.Items[FIndex]) is
TbsDataSkinListView
then
with TbsDataSkinListView(FSD.CtrlList.Items[FIndex]) do
begin
if FUseSkinFont
then
begin
Font.Name := FontName;
Font.Style := FontStyle;
Font.Height := FontHeight;
end
else
Font.Assign(FDefaultFont);
Font.Color := FontColor;
Color := BGColor;
end;
end
else
begin
Color := FDefaultColor;
Font := FDefaultFont;
end;
if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
then
Font.Charset := SkinData.ResourceStrData.CharSet
else
Font.CharSet := FDefaultFont.CharSet;
UpDateScrollBars;
if FVScrollBar <> nil then FVScrollBar.Align := FVScrollBar.Align;
if FHScrollBar <> nil then FHScrollBar.Align := FHScrollBar.Align;
end;
procedure TbsSkinCustomListView.SetDefaultFont;
begin
FDefaultFont.Assign(Value);
if FIndex = -1 then Font.Assign(Value);
end;
procedure TbsSkinCustomListView.SetSkinData;
begin
FSD := Value;
if (FSD <> nil) then
if not FSD.Empty and not (csDesigning in ComponentState)
then
ChangeSkinData;
end;
procedure TbsSkinCustomListView.Notification;
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (AComponent = FSD) then FSD := nil;
if (Operation = opRemove) and (AComponent = FVScrollBar)
then FVScrollBar := nil;
if (Operation = opRemove) and (AComponent = FHScrollBar)
then FHScrollBar := nil;
end;
procedure TbsSkinCustomListView.WMNCCALCSIZE;
begin
end;
procedure TbsSkinCustomListView.WMNCPAINT;
begin
end;
procedure TbsSkinCustomListView.SetVScrollBar;
begin
FVScrollBar := Value;
if FVScrollBar <> nil
then
with FVScrollBar do
begin
Enabled := True;
Visible := False;
OnChange := OnVScrollBarChange;
end;
UpDateScrollBars;
end;
procedure TbsSkinCustomListView.SetHScrollBar;
begin
FHScrollBar := Value;
if FHScrollBar <> nil
then
with FHScrollBar do
begin
Enabled := True;
Visible := False;
OnChange := OnHScrollBarChange;
end;
UpDateScrollBars;
end;
procedure TbsSkinCustomListView.WndProc;
var
WndClass: String;
begin
case Message.Msg of
WM_PARENTNOTIFY:
with TWMPARENTNOTIFY(Message) do
begin
SetLength(WndClass, 80);
SetLength(WndClass, GetClassName(ChildWnd, PChar(WndClass), Length(WndClass)));
if (Event = WM_CREATE) and (FHeaderHandle <> 0) and ShowColumnHeaders and
(WndClass = 'SysHeader32')
then
begin
SetWindowLong(FHeaderHandle, GWL_WNDPROC, LongInt(FDefHeaderProc));
FHeaderHandle := 0;
end;
if (Event = WM_CREATE) and (FHeaderHandle = 0) and ShowColumnHeaders and
(WndClass = 'SysHeader32')
then
begin
FHeaderHandle := ChildWnd;
FDefHeaderProc := Pointer(GetWindowLong(FHeaderHandle, GWL_WNDPROC));
SetWindowLong(FHeaderHandle, GWL_WNDPROC, LongInt(FHeaderInstance));
end;
end;
end;
inherited;
case Message.Msg of
WM_SIZE, WM_PAINT:
if not FInCheckScrollBars then UpDateScrollBars;
WM_KEYDOWN, WM_LBUTTONUP:
UpDateScrollBars;
end;
end;
procedure TbsSkinCustomListView.UpDateScrollBars;
begin
if HandleAllocated and not FromSB and (Width > 5) and (Height > 5) then
case ViewStyle of
vsIcon, vsSmallIcon: UpDateScrollBars1;
vsReport: UpDateScrollBars2;
vsList: UpDateScrollBars3;
end;
end;
procedure TbsSkinCustomListView.UpDateScrollBars3;
var
IC, IPP, Min, Max, Pos, Page: Integer;
R: TRect;
IH: Integer;
OldVisible, HVisibleChanged, VVisibleChanged: Boolean;
begin
if FInCheckScrollBars then Exit;
VVisibleChanged := False;
HVisibleChanged := False;
if (FVScrollBar <> nil) and FVScrollBar.Visible
then
begin
FInCheckScrollBars := True;
FVScrollBar.Visible := False;
FInCheckScrollBars := False;
VVisibleChanged := True;
end;
if FHScrollBar <> nil
then
begin
GetScrollRange(Handle, SB_HORZ, Min, Max);
Pos := GetScrollPos(Handle, SB_HORZ);
IH := 1;
if Items.Count > 0
then
begin
ListView_GetItemRect(Handle, 0, R, LVIR_BOUNDS);
IH := RectWidth(R);
end;
if IH = 0 then IH := 1;
Page := Width div IH;
IC := ListView_GetItemCount(Handle);
IPP := ListView_GetCountPerPage(Handle);
OldVisible := FHScrollBar.Visible;
FInCheckScrollBars := True;
FHScrollBar.Visible := (IC > IPP) and Self.Visible;
FInCheckScrollBars := False;
HVisibleChanged := FHScrollBar.Visible <> OldVisible;
if FHScrollBar.Visible
then
begin
FHScrollBar.SetRange(Min, Max, Pos, Page);
FHScrollBar.SmallChange := 1;
FHScrollBar.LargeChange := 1;
FOldHScrollBarPos := Pos;
end;
end;
if (FVScrollBar <> nil) and (FHScrollBar <> nil)
then
begin
if not FVScrollBar.Visible and FHScrollBar.Both
then
FHScrollBar.Both := False
else
if FVScrollBar.Visible and not FHScrollBar.Both
then
FHScrollBar.Both := True;
end;
if (Self.Align <> alNone) and (HVisibleChanged or VVisibleChanged)
then
begin
FInCheckScrollBars := True;
R := Parent.ClientRect;
TParentControl(Parent).AlignControls(nil, R);
FInCheckScrollBars := False;
end;
end;
procedure TbsSkinCustomListView.UpDateScrollBars2;
var
Min, Max, Pos: Integer;
OldVisible, HVisibleChanged, VVisibleChanged: Boolean;
R: TRect;
begin
if FInCheckScrollBars then Exit;
VVisibleChanged := False;
HVisibleChanged := False;
if FVScrollBar <> nil
then
begin
GetScrollRange(Handle, SB_VERT, Min, Max);
Pos := GetScrollPos(Handle, SB_VERT);
OldVisible := FVScrollBar.Visible;
FInCheckScrollBars := True;
FVScrollBar.Visible := (Max + 1 > ListView_GetCountPerPage(Handle)) and Self.Visible;;
FInCheckScrollBars := False;
VVisibleChanged := FVScrollBar.Visible <> OldVisible;
if FVScrollBar.Visible
then
begin
FVScrollBar.SetRange(Min, Max, Pos, ListView_GetCountPerPage(Handle));
FOldVScrollBarPos := Pos;
FVScrollBar.SmallChange := 1;
FVScrollBar.LargeChange := ListView_GetCountPerPage(Handle);
if FVScrollBar.LargeChange < 1 then FVScrollBar.LargeChange := 1;
end;
end;
if FHScrollBar <> nil
then
begin
GetScrollRange(Handle, SB_HORZ, Min, Max);
Pos := GetScrollPos(Handle, SB_HORZ);
OldVisible := FHScrollBar.Visible;
FInCheckScrollBars := True;
FHScrollBar.Visible := (Max > Width) and Self.Visible;
FInCheckScrollBars := False;
HVisibleChanged := FHScrollBar.Visible <> OldVisible;
if FHScrollBar.Visible
then
begin
FHScrollBar.SetRange(Min, Max, Pos, Width);
FOldHScrollBarPos := Pos;
end;
end;
if (FVScrollBar <> nil) and (FHScrollBar <> nil)
then
begin
if not FVScrollBar.Visible and FHScrollBar.Both
then
FHScrollBar.Both := False
else
if FVScrollBar.Visible and not FHScrollBar.Both
then
FHScrollBar.Both := True;
end;
if (Self.Align <> alNone) and (HVisibleChanged or VVisibleChanged)
then
begin
FInCheckScrollBars := True;
R := Parent.ClientRect;
TParentControl(Parent).AlignControls(nil, R);
FInCheckScrollBars := False;
end;
end;
procedure TbsSkinCustomListView.UpDateScrollBars1;
var
Min, Max, Pos: Integer;
R: TRect;
OldVisible, HVisibleChanged, VVisibleChanged: Boolean;
begin
if FInCheckScrollBars then Exit;
VVisibleChanged := False;
HVisibleChanged := False;
if FVScrollBar <> nil
then
begin
GetScrollRange(Handle, SB_VERT, Min, Max);
Pos := GetScrollPos(Handle, SB_VERT);
OldVisible := FVScrollBar.Visible;
FInCheckScrollBars := True;
FVScrollBar.Visible := (Max > Height) and Self.Visible;;
FInCheckScrollBars := False;
VVisibleChanged := FVScrollBar.Visible <> OldVisible;
if FVScrollBar.Visible
then
begin
Listview_GEtItemRect(Handle, 0, R, LVIR_BOUNDS);
FVScrollBar.SmallChange := RectHeight(R) div 2;
FVScrollBar.LargeChange := RectHeight(R) div 2;
if FVScrollBar.SmallChange = 0 then FVScrollBar.SmallChange := 1;
if FVScrollBar.LargeChange = 0 then FVScrollBar.LargeChange := 1;
FVScrollBar.SetRange(Min, Max, Pos, Height);
FOldVScrollBarPos := Pos;
end;
end;
if FHScrollBar <> nil
then
begin
GetScrollRange(Handle, SB_HORZ, Min, Max);
Pos := GetScrollPos(Handle, SB_HORZ);
OldVisible := FHScrollBar.Visible;
FInCheckScrollBars := True;
FHScrollBar.Visible := (Max > Width) and Self.Visible;
FInCheckScrollBars := False;
HVisibleChanged := FHScrollBar.Visible <> OldVisible;
if FHScrollBar.Visible
then
begin
Listview_GEtItemRect(Handle, 0, R, LVIR_BOUNDS);
FHScrollBar.SmallChange := RectHeight(R) div 2;
FHScrollBar.LargeChange := RectHeight(R) div 2;
if FHScrollBar.SmallChange = 0 then FHScrollBar.SmallChange := 1;
if FHScrollBar.LargeChange = 0 then FHScrollBar.LargeChange := 1;
FHScrollBar.SetRange(Min, Max, Pos, Width);
FOldHScrollBarPos := Pos;
end;
end;
if (FVScrollBar <> nil) and (FHScrollBar <> nil)
then
begin
if not FVScrollBar.Visible and FHScrollBar.Both
then
FHScrollBar.Both := False
else
if FVScrollBar.Visible and not FHScrollBar.Both
then
FHScrollBar.Both := True;
end;
if (Self.Align <> alNone) and (HVisibleChanged or VVisibleChanged)
then
begin
FInCheckScrollBars := True;
R := Parent.ClientRect;
TParentControl(Parent).AlignControls(nil, R);
FInCheckScrollBars := False;
end;
end;
procedure TbsSkinCustomListView.OnVScrollBarChange;
var
H: Integer;
R: TRect;
begin
FromSB := True;
if (ViewStyle = vsIcon) or (ViewStyle = vsSmallIcon)
then
Scroll(0, FVSCROLLBAR.Position - FOldVScrollBarPos)
else
begin
ListView_GetItemRect(Handle, 0, R, LVIR_BOUNDS);
H := RectHeight(R);
Scroll(0, (FVSCROLLBAR.Position - FOldVScrollBarPos) * H);
end;
FOldVScrollBarPos := FVSCROLLBAR.Position;
FromSB := False;
end;
procedure TbsSkinCustomListView.OnHScrollBarChange;
var
i: Integer;
begin
FromSB := True;
if ViewStyle = vsList
then
begin
if FOldHScrollBarPos > FHSCROLLBAR.Position
then
begin
for i := 1 to FOldHScrollBarPos - FHSCROLLBAR.Position do
SendMessage(Handle, WM_HSCROLL, MakeWParam(SB_LINEUP, 0) , 0)
end
else
begin
for i := 1 to FHSCROLLBAR.Position - FOldHScrollBarPos do
SendMessage(Handle, WM_HSCROLL, MakeWParam(SB_LINEDOWN, 0), 0);
end;
end
else
Scroll(FHSCROLLBAR.Position - FOldHScrollBarPos, 0);
FOldHScrollBarPos := FHSCROLLBAR.Position;
FromSB := False;
end;
procedure TbsSkinCustomListView.CreateParams;
begin
inherited;
with Params do
Style := Style and not (WS_HSCROLL or WS_VSCROLL);
end;
constructor TbsSkinRichEdit.Create(AOwner: TComponent);
begin
inherited;
FSkinSupport := False;
FVScrollBar := nil;
FHScrollBar := nil;
FOldVScrollBarPos := 0;
FOldHScrollBarPos := 0;
FSD := nil;
FIndex := -1;
FDefaultFont := TFont.Create;
with FDefaultFont do
begin
Name := 'Arial';
Style := [];
Height := 14;
end;
Font.Assign(FDefaultFont);
FDefaultColor := clWindow;
FSkinDataName := 'richedit';
ScrollBars := ssBoth;
end;
destructor TbsSkinRichEdit.Destroy;
begin
FDefaultFont.Free;
inherited;
end;
procedure TbsSkinRichEdit.Change;
begin
inherited;
UpDateScrollBars;
end;
procedure TbsSkinRichEdit.WMMOUSEWHEEL;
begin
inherited;
UpDateScrollBars;
end;
procedure TbsSkinRichEdit.SetDefaultColor;
begin
FDefaultColor := Value;
if (FIndex = -1) and FSkinSupport then Color := Value;
end;
procedure TbsSkinRichEdit.SetDefaultFont;
begin
FDefaultFont.Assign(Value);
if (FIndex = -1) and FSkinSupport then Font.Assign(Value);
end;
procedure TbsSkinRichEdit.Loaded;
begin
ChangeSkinData;
end;
procedure TbsSkinRichEdit.ChangeSkinData;
begin
if (FSD = nil) or FSD.Empty
then
FIndex := -1
else
FIndex := FSD.GetControlIndex(FSkinDataName);
if FSkinSupport
then
if FIndex <> -1
then
begin
if TbsDataSkinControl(FSD.CtrlList.Items[FIndex]) is
TbsDataSkinRichEdit
then
with TbsDataSkinRichEdit(FSD.CtrlList.Items[FIndex]) do
begin
Font.Name := FontName;
Font.Color := FontColor;
Font.Style := FontStyle;
Font.Height := FontHeight;
Color := BGColor;
end;
end
else
begin
Color := FDefaultColor;
Font.Assign(FDefaultFont);
end;
if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
then
Font.Charset := SkinData.ResourceStrData.CharSet
else
Font.CharSet := FDefaultFont.CharSet;
UpDateScrollBars;
if FVScrollBar <> nil then FVScrollBar.Align := FVScrollBar.Align;
if FHScrollBar <> nil then FHScrollBar.Align := FHScrollBar.Align;
end;
procedure TbsSkinRichEdit.SetSkinData;
begin
FSD := Value;
if (FSD <> nil) then
if not FSD.Empty and not (csDesigning in ComponentState)
then
ChangeSkinData;
end;
procedure TbsSkinRichEdit.Notification;
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (AComponent = FSD) then FSD := nil;
end;
procedure TbsSkinRichEdit.WMNCCALCSIZE;
begin
end;
procedure TbsSkinRichEdit.WMNCPAINT;
begin
inherited;
end;
procedure TbsSkinRichEdit.SetVScrollBar;
begin
FVScrollBar := Value;
if FVScrollBar <> nil
then
with FVScrollBar do
begin
OnChange := OnVScrollBarChange;
OnUpButtonClick := OnVScrollBarUpButtonClick;
OnDownButtonClick := OnVScrollBarDownButtonClick;
end;
UpDateScrollBars;
end;
procedure TbsSkinRichEdit.SetHScrollBar;
begin
FHScrollBar := Value;
if FHScrollBar <> nil
then
with FHScrollBar do
begin
OnChange := OnHScrollBarChange;
end;
UpDateScrollBars;
end;
procedure TbsSkinRichEdit.WndProc;
begin
inherited;
case Message.Msg of
WM_SIZE, WM_KEYDOWN, WM_LBUTTONUP, WM_LBUTTONDOWN:
UpDateScrollBars;
end;
end;
procedure TbsSkinRichEdit.UpDateScrollBars;
var
Min, Max, Pos, Page: Integer;
begin
if FVScrollBar <> nil
then
begin
GetScrollRange(Handle, SB_VERT, Min, Max);
Pos := GetScrollPos(Handle, SB_VERT);
Page := Height;
if (Max > Min) and (Page < Max) and (Lines.Count > 0)
then
begin
if not FVScrollBar.Enabled
then
FVScrollBar.Enabled := True;
FVScrollBar.SetRange(Min, Max, Pos, Page);
end
else
begin
FVScrollBar.Enabled := False;
SetScrollRange(Handle, SB_VERT, 0, 0, False);
end;
end;
if FHScrollBar <> nil
then
begin
GetScrollRange(Handle, SB_HORZ, Min, Max);
Pos := GetScrollPos(Handle, SB_HORZ);
Page := Width;
if (Max > Min) and (Page < Max) and (Lines.Count > 0)
then
begin
if not FHScrollBar.Enabled
then
FHScrollBar.Enabled := True;
FHScrollBar.SetRange(Min, Max, Pos, Page);
end
else
begin
FHScrollBar.Enabled := False;
SetScrollRange(Handle, SB_HORZ, 0, 0, False);
end;
end;
end;
procedure TbsSkinRichEdit.OnVScrollBarChange;
begin
SendMessage(Handle, WM_VSCROLL,
MakeWParam(SB_THUMBPOSITION, FVSCROLLBAR.Position), 0);
end;
procedure TbsSkinRichEdit.OnVScrollBarUpButtonClick;
begin
if FVScrollBar.Position < FVScrollBar.Max - FVScrollBar.PageSize + 1
then
SendMessage(Handle, WM_VSCROLL,
MakeWParam(SB_LINEDOWN, FVSCROLLBAR.Position), 0);
UpDateScrollBars;
end;
procedure TbsSkinRichEdit.OnVScrollBarDownButtonClick;
begin
if FVScrollBar.Position <> 0
then
SendMessage(Handle, WM_VSCROLL,
MakeWParam(SB_LINEUP, FVSCROLLBAR.Position), 0);
UpDateScrollBars;
end;
procedure TbsSkinRichEdit.OnHScrollBarChange;
begin
SendMessage(Handle, WM_HSCROLL,
MakeWParam(SB_THUMBPOSITION, FHSCROLLBAR.Position), 0);
end;
procedure TbsSkinRichEdit.CreateParams;
begin
inherited CreateParams(Params);
with Params do
begin
Style := Style and not WS_BORDER;
ExStyle := ExStyle and not WS_EX_CLIENTEDGE;
end;
end;
constructor TbsGraphicSkinControl.Create;
begin
inherited Create(AOwner);
ControlStyle := ControlStyle + [csOpaque];
FSD := nil;
FIndex := -1;
end;
destructor TbsGraphicSkinControl.Destroy;
begin
inherited Destroy;
end;
procedure TbsGraphicSkinControl.CMMouseEnter;
begin
inherited;
if (csDesigning in ComponentState) then Exit;
if Assigned(FOnMouseEnter) then FOnMouseEnter(Self);
end;
procedure TbsGraphicSkinControl.CMMouseLeave;
begin
inherited;
if (csDesigning in ComponentState) then Exit;
if Assigned(FOnMouseLeave) then FOnMouseLeave(Self);
end;
procedure TbsGraphicSkinControl.BeforeChangeSkinData;
begin
FIndex := -1;
end;
procedure TbsGraphicSkinControl.ChangeSkinData;
begin
GetSkinData;
RePaint;
end;
procedure TbsGraphicSkinControl.SetSkinData;
begin
FSD := Value;
if (FSD <> nil) then
if not FSD.Empty and not (csDesigning in ComponentState)
then
ChangeSkinData;
end;
procedure TbsGraphicSkinControl.GetSkinData;
begin
if (FSD = nil) or FSD.Empty
then
FIndex := -1
else
FIndex := FSD.GetControlIndex(FSkinDataName);
end;
procedure TbsGraphicSkinControl.Paint;
var
Buffer: TBitMap;
begin
if (Width <= 0) or (Height <= 0) then Exit;
GetSkinData;
Buffer := TBitMap.Create;
Buffer.Width := Width;
Buffer.Height := Height;
if FIndex <> -1
then
CreateControlSkinImage(Buffer)
else
CreateControlDefaultImage(Buffer);
Canvas.Draw(0, 0, Buffer);
Buffer.Free;
end;
procedure TbsGraphicSkinControl.CreateControlDefaultImage;
begin
end;
procedure TbsGraphicSkinControl.CreateControlSkinImage;
begin
end;
procedure TbsGraphicSkinControl.Notification;
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (AComponent = FSD) then FSD := nil;
end;
constructor TbsGraphicSkinCustomControl.Create;
begin
inherited Create(AOwner);
FDefaultWidth := 0;
FDefaultHeight := 0;
FDefaultFont := TFont.Create;
FDefaultFont.OnChange := OnDefaultFontChange;
with FDefaultFont do
begin
Name := 'Arial';
Style := [];
Height := 14;
end;
FUseSkinFont := True;
end;
destructor TbsGraphicSkinCustomControl.Destroy;
begin
FDefaultFont.Free;
inherited Destroy;
end;
procedure TbsGraphicSkinCustomControl.SetDefaultWidth;
begin
FDefaultWidth := Value;
if (FIndex = -1) and (FDefaultWidth > 0) then Width := FDefaultWidth;
end;
procedure TbsGraphicSkinCustomControl.SetDefaultHeight;
begin
FDefaultHeight := Value;
if (FIndex = -1) and (FDefaultHeight > 0) then Height := FDefaultHeight;
end;
procedure TbsGraphicSkinCustomControl.DefaultFontChange;
begin
end;
procedure TbsGraphicSkinCustomControl.SetDefaultFont;
begin
FDefaultFont.Assign(Value);
DefaultFontChange;
end;
procedure TbsGraphicSkinCustomControl.OnDefaultFontChange;
begin
DefaultFontChange;
if FIndex = -1 then RePaint;
end;
procedure TbsGraphicSkinCustomControl.CreateControlDefaultImage;
var
R: TRect;
begin
with B.Canvas do
begin
Brush.Color := clBtnFace;
R := ClientRect;
FillRect(R);
end;
end;
procedure TbsGraphicSkinCustomControl.ChangeSkinData;
var
W, H: Integer;
UpDate: Boolean;
begin
GetSkinData;
W := Width;
H := Height;
if FIndex <> -1
then
begin
CalcSize(W, H);
Update := (W <> Width) or (H <> Height);
if W <> Width then Width := W;
if H <> Height then Height := H;
end
else
begin
UpDate := False;
if FDefaultWidth > 0 then Width := FDefaultWidth;
if FDefaultHeight > 0 then Height := FDefaultHeight;
end;
if (not UpDate) or (FIndex = -1) then RePaint;
end;
procedure TbsGraphicSkinCustomControl.SetBounds;
var
UpDate: Boolean;
begin
GetSkinData;
UpDate := ((Width <> AWidth) or (Height <> AHeight)) and (FIndex <> -1);
if UpDate
then
begin
CalcSize(AWidth, AHeight);
if ResizeMode = 0 then NewClRect := ClRect;
end;
inherited;
if UpDate then RePaint;
end;
procedure TbsGraphicSkinCustomControl.CalcSize;
var
XO, YO: Integer;
begin
if ResizeMode > 0
then
begin
XO := W - RectWidth(SkinRect);
YO := H - RectHeight(SkinRect);
NewLTPoint := LTPt;
case ResizeMode of
1:
begin
NewRTPoint := Point(RTPt.X + XO, RTPt.Y);
NewLBPoint := Point(LBPt.X, LBPt.Y + YO);
NewRBPoint := Point(RBPt.X + XO, RBPt.Y + YO);
NewClRect := Rect(CLRect.Left, ClRect.Top,
CLRect.Right + XO, ClRect.Bottom + YO);
end;
2:
begin
H := RectHeight(SkinRect);
NewRTPoint := Point(RTPt.X + XO, RTPt.Y );
NewClRect := ClRect;
Inc(NewClRect.Right, XO);
end;
3:
begin
W := RectWidth(SkinRect);
NewLBPoint := Point(LBPt.X, LBPt.Y + YO);
NewClRect := ClRect;
Inc(NewClRect.Bottom, YO);
end;
end;
end
else
if (FIndex <> -1) and (ResizeMode = 0)
then
begin
W := RectWidth(SkinRect);
H := RectHeight(SkinRect);
NewClRect := CLRect;
end;
end;
procedure TbsGraphicSkinCustomControl.CreateControlSkinImage;
begin
CreateSkinControlImage(B, Picture, SkinRect);
end;
procedure TbsGraphicSkinCustomControl.CreateSkinControlImage;
begin
case ResizeMode of
0:
begin
B.Width := RectWidth(R);
B.Height := RectHeight(R);
B.Canvas.CopyRect(Rect(0, 0, B.Width, B.Height), SB.Canvas, R);
end;
1: CreateSkinImage(LTPt, RTPt, LBPt, RBPt, CLRect,
NewLtPoint, NewRTPoint, NewLBPoint, NewRBPoint, NewCLRect,
B, SB, R, Width, Height, True);
2: CreateHSkinImage(LTPt.X, RectWidth(SkinRect) - RTPt.X,
B, SB, R, Width, Height);
3: CreateVSkinImage(LTPt.Y, RectHeight(SkinRect) - LBPt.Y,
B, SB, R, Width, Height);
end;
end;
function TbsGraphicSkinCustomControl.GetResizeMode;
begin
if IsNullRect(SkinRect)
then
Result := -1
else
if (RBPt.X <> 0) and (RBPt.Y <> 0)
then
Result := 1
else
if (RTPt.X <> 0) or (RTPT.Y <> 0)
then
Result := 2
else
if (LBPt.X <> 0) or (LBPt.Y <> 0)
then
Result := 3
else
Result := 0;
end;
function TbsGraphicSkinCustomControl.GetNewRect;
var
XO, YO: Integer;
LeftTop, LeftBottom, RightTop, RightBottom: TRect;
function CorrectResizeRect: TRect;
var
NR: TRect;
begin
NR := R;
if PointInRect(LeftTop, R.TopLeft) and
PointInRect(RightBottom, R.BottomRight)
then
begin
Inc(NR.Right, XO);
Inc(NR.Bottom, YO);
end
else
if PointInRect(LeftTop, R.TopLeft) and
PointInRect(RightTop, R.BottomRight)
then
Inc(NR.Right, XO)
else
if PointInRect(LeftBottom, R.TopLeft) and
PointInRect(RightBottom, R.BottomRight)
then
begin
Inc(NR.Right, XO);
OffsetRect(NR, 0, YO);
end
else
if PointInRect(LeftTop, R.TopLeft) and
PointInRect(LeftBottom, R.BottomRight)
then
Inc(NR.Bottom, YO)
else
if PointInRect(RightTop, R.TopLeft) and
PointInRect(RightBottom, R.BottomRight)
then
begin
OffsetRect(NR, XO, 0);
Inc(NR.Bottom, YO);
end;
Result := NR;
end;
begin
XO := Width - RectWidth(SkinRect);
YO := Height - RectHeight(SkinRect);
Result := R;
case ResizeMode of
1:
begin
LeftTop := Rect(0, 0, LTPt.X, LTPt.Y);
LeftBottom := Rect(0, LBPt.Y, LBPt.X, RectHeight(SkinRect));
RightTop := Rect(RTPt.X, 0, RectWidth(SkinRect), RTPt.Y);
RightBottom := Rect(RBPt.X, RBPt.Y,
RectWidth(SkinRect), RectHeight(SkinRect));
Result := R;
if RectInRect(R, LeftTop)
then Result := R
else
if RectInRect(R, RightTop)
then OffsetRect(Result, XO, 0)
else
if RectInRect(R, LeftBottom)
then OffsetRect(Result, 0, YO)
else
if RectInRect(R, RightBottom)
then
OffsetRect(Result, XO, YO)
else
Result := CorrectResizeRect;
end;
2:
begin
if (R.Left <= LTPt.X) and (R.Right >= RTPt.X)
then
Inc(Result.Right, XO)
else
if (R.Left >= RTPt.X) and (R.Right > RTPt.X)
then
OffsetRect(Result, XO, 0);
end;
3:
begin
if (R.Top <= LTPt.Y) and (R.Bottom >= LBPt.Y)
then
Inc(Result.Bottom, YO)
else
if (R.Top >= LBPt.Y) and (R.Bottom > LBPt.X)
then
OffsetRect(Result, 0, YO);
end;
end;
end;
procedure TbsGraphicSkinCustomControl.GetSkinData;
begin
inherited;
if FIndex <> -1
then
if TbsDataSkinControl(FSD.CtrlList.Items[FIndex]) is TbsDataSkinCustomControl
then
with TbsDataSkinCustomControl(FSD.CtrlList.Items[FIndex]) do
begin
LTPt := LTPoint;
RTPt := RTPoint;
LBPt := LBPoint;
RBPt := RBPoint;
Self.SkinRect := SkinRect;
Self.ClRect := ClRect;
if (PictureIndex <> -1) and (PictureIndex < FSD.FActivePictures.Count)
then
Picture := TBitMap(FSD.FActivePictures.Items[PictureIndex])
else
Picture := nil;
ResizeMode := GetResizeMode;
end
else
begin
ResizeMode := 0;
Picture := nil;
end;
end;
//=========== TbsSkinButton ===============
constructor TbsSkinSpeedButton.Create;
begin
inherited;
FImageIndex := 0;
RepeatTimer := nil;
FRepeatMode := False;
FRepeatInterval := 100;
MorphTimer := nil;
FAllowAllUpCheck := False;
FAllowAllUp := False;
ControlStyle := [csCaptureMouse, csDoubleClicks, csOpaque];
Transparent := False;
FSkinDataName := 'toolbutton';
FDown := False;
FMouseDown := False;
FMouseIn := False;
Width := 25;
Height := 25;
FGroupIndex := 0;
FGlyph := TBitMap.Create;
FNumGlyphs := 1;
FMargin := -1;
FSpacing := 1;
FLayout := blGlyphLeft;
FShowCaption := True;
FWidthWithCaption := 0;
FWidthWithoutCaption := 0;
end;
destructor TbsSkinSpeedButton.Destroy;
begin
if RepeatTimer <> nil then StopRepeat;
FGlyph.Free;
StopMorph;
inherited;
end;
procedure TbsSkinSpeedButton.SetShowCaption(const Value: Boolean);
begin
if FShowCaption <> Value
then
begin
FShowCaption := Value;
if (FWidthWithCaption > 0) and (FWidthWithoutCaption > 0)
then
begin
if FShowCaption
then Width := FWidthWithCaption
else Width := FWidthWithoutCaption;
end
else
RePaint;
end;
end;
procedure TbsSkinSpeedButton.SetImageIndex(Value: Integer);
begin
FImageIndex := Value;
if Parent is TbsSkinToolBar then RePaint;
end;
procedure TbsSkinSpeedButton.RepeatTimerProc;
begin
ButtonClick;
end;
procedure TbsSkinSpeedButton.StartRepeat;
begin
if RepeatTimer <> nil then RepeatTimer.Free;
RepeatTimer := TTimer.Create(Self);
RepeatTimer.Enabled := False;
RepeatTimer.OnTimer := RepeatTimerProc;
RepeatTimer.Interval := FRepeatInterval;
RepeatTimer.Enabled := True;
end;
procedure TbsSkinSpeedButton.StopRepeat;
begin
if RepeatTimer = nil then Exit;
RepeatTimer.Enabled := False;
RepeatTimer.Free;
RepeatTimer := nil;
end;
procedure TbsSkinSpeedButton.DoMorph;
begin
if (FIndex = -1) or not Morphing
then
begin
if FMouseIn then FMorphKf := 1 else FMorphKf := 0;
StopMorph;
end
else
if FMouseIn and (FMorphKf < 1)
then
begin
FMorphKf := FMorphKf + MorphInc;
RePaint;
end
else
if not FMouseIn and (FMorphKf > 0)
then
begin
FMorphKf := FMorphKf - MorphInc;
RePaint;
end
else
begin
if FMouseIn then FMorphKf := 1 else FMorphKf := 0;
StopMorph;
RePaint;
end;
end;
procedure TbsSkinSpeedButton.StartMorph;
begin
if MorphTimer <> nil then Exit;
MorphTimer := TTimer.Create(Self);
MorphTimer.Interval := MorphTimerInterval;
MorphTimer.OnTimer := DoMorph;
MorphTimer.Enabled := True;
end;
procedure TbsSkinSpeedButton.StopMorph;
begin
if MorphTimer = nil then Exit;
MorphTimer.Free;
MorphTimer := nil;
end;
procedure TbsSkinSpeedButton.SetTransparent;
begin
if Value
then ControlStyle := ControlStyle - [csOpaque]
else ControlStyle := ControlStyle + [csOpaque];
RePaint;
end;
function TbsSkinSpeedButton.GetTransparent;
begin
Result := not (csOpaque in ControlStyle);
end;
procedure TbsSkinSpeedButton.SetFlat;
begin
FFlat := Value;
Transparent := FFlat;
RePaint;
end;
procedure TbsSkinSpeedButton.ButtonClick;
begin
if Assigned(OnClick) then OnClick(Self);
end;
procedure TbsSkinSpeedButton.CMEnabledChanged;
begin
inherited;
if Morphing
then
begin
StopMorph;
FMorphKf := 0;
end;
FMouseIn := False;
RePaint;
end;
procedure TbsSkinSpeedButton.ChangeSkinData;
begin
StopMorph;
inherited;
if Morphing and (FIndex <> -1) and FMouseIn and not Transparent
then
FMorphKf := 1;
end;
procedure TbsSkinSpeedButton.SetGroupIndex;
begin
FGroupIndex := Value;
end;
procedure TbsSkinSpeedButton.ActionChange(Sender: TObject; CheckDefaults: Boolean);
procedure CopyImage(ImageList: TCustomImageList; Index: Integer);
begin
with FGlyph do
begin
Width := ImageList.Width;
Height := ImageList.Height;
Canvas.Brush.Color := clFuchsia;
Canvas.FillRect(Rect(0, 0, Width, Height));
ImageList.Draw(Canvas, 0, 0, Index);
end;
end;
begin
inherited ActionChange(Sender, CheckDefaults);
if Sender is TCustomAction then
with TCustomAction(Sender) do
begin
if (FGlyph.Empty) and (ActionList <> nil) and (ActionList.Images <> nil) and
(ImageIndex >= 0) and (ImageIndex < ActionList.Images.Count) then
begin
CopyImage(ActionList.Images, ImageIndex);
RePaint;
end;
end;
end;
procedure TbsSkinSpeedButton.ReDrawControl;
begin
if Morphing and (FIndex <> -1) and not Transparent
then StartMorph
else RePaint;
end;
procedure TbsSkinSpeedButton.SetLayout;
begin
if FLayout <> Value
then
begin
FLayout := Value;
RePaint;
end;
end;
procedure TbsSkinSpeedButton.SetSpacing;
begin
if Value <> FSpacing
then
begin
FSpacing := Value;
RePaint;
end;
end;
procedure TbsSkinSpeedButton.SetMargin;
begin
if (Value <> FMargin) and (Value >= -1)
then
begin
FMargin := Value;
RePaint;
end;
end;
procedure TbsSkinSpeedButton.SetDown;
begin
FDown := Value;
if Morphing
then
begin
FMorphKf := 1;
if not FDown then StartMorph else StopMorph;
end;
RePaint;
if (GroupIndex <> 0) and FDown and not FAllowAllUp then DoAllUp;
end;
procedure TbsSkinSpeedButton.DoAllUp;
var
PC: TWinControl;
i: Integer;
begin
if Parent = nil then Exit;
PC := TWinControl(Parent);
for i := 0 to PC.ControlCount - 1 do
if (PC.Controls[i] is TbsSkinSpeedButton) and
(PC.Controls[i] <> Self)
then
with TbsSkinSpeedButton(PC.Controls[i]) do
if (GroupIndex = Self.GroupIndex) and
(GroupIndex <> 0) and FDown
then
Down := False;
end;
procedure TbsSkinSpeedButton.SetGlyph;
begin
FGlyph.Assign(Value);
RePaint;
end;
procedure TbsSkinSpeedButton.SetNumGlyphs;
begin
FNumGlyphs := Value;
RePaint;
end;
procedure TbsSkinSpeedButton.GetSkinData;
begin
inherited;
if FIndex <> -1
then
begin
if TbsDataSkinControl(FSD.CtrlList.Items[FIndex]) is TbsDataSkinButtonControl
then
with TbsDataSkinButtonControl(FSD.CtrlList.Items[FIndex]) do
begin
Self.FontName := FontName;
Self.FontColor := FontColor;
Self.ActiveFontColor := ActiveFontColor;
Self.DownFontColor := DownFontColor;
Self.DisabledFontColor := DisabledFontColor;
Self.FontStyle := FontStyle;
Self.FontHeight := FontHeight;
Self.ActiveSkinRect := ActiveSkinRect;
Self.DownSkinRect := DownSkinRect;
if IsNullRect(ActiveSkinRect) then Self.ActiveSkinRect := SkinRect;
if IsNullRect(DownSkinRect) then Self.DownSkinRect := Self.ActiveSkinRect;
Self.DisabledSkinRect := DisabledSkinRect;
Self.Morphing := Morphing;
Self.MorphKind := MorphKind;
if Transparent then Self.Morphing := False;
end;
end;
end;
function TbsSkinSpeedButton.GetGlyphNum;
begin
if AIsDown and AIsMouseIn and (FNumGlyphs > 2)
then
Result := 3
else
if AIsMouseIn and (FNumGlyphs > 3)
then
Result := 4
else
if not Enabled and (FNumGlyphs > 1)
then
Result := 2
else
Result := 1;
end;
procedure TbsSkinSpeedButton.CreateButtonImage;
var
IL: TCustomImageList;
E: Boolean;
_Caption: String;
begin
if FShowCaption then _Caption := Caption else _Caption := '';
CreateSkinControlImage(B, Picture, R);
if not FUseSkinFont
then
B.Canvas.Font.Assign(FDefaultFont)
else
with B.Canvas.Font do
begin
Name := FontName;
Height := FontHeight;
Style := FontStyle;
end;
if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
then
B.Canvas.Font.Charset := SkinData.ResourceStrData.CharSet
else
B.Canvas.Font.CharSet := FDefaultFont.Charset;
with B.Canvas.Font do
begin
if not Enabled
then
Color := DisabledFontColor
else
if ADown and AMouseIn
then
Color := DownFontColor
else
if AMouseIn
then Color := ActiveFontColor
else Color := FontColor;
end;
if FGlyph.Empty and (Parent is TbsSkinToolBar)
then
begin
if not Enabled and (TbsSkinToolBar(Parent).DisabledImages <> nil)
then
IL := TbsSkinToolBar(Parent).DisabledImages
else
if (AMouseIn or ADown) and (TbsSkinToolBar(Parent).HotImages <> nil)
then
IL := TbsSkinToolBar(Parent).HotImages
else
IL := TbsSkinToolBar(Parent).Images;
E := Enabled;
if not Enabled and (TbsSkinToolBar(Parent).DisabledImages <> nil)
then
E := True;
DrawImageAndText(B.Canvas, NewClRect, FMargin, FSpacing, FLayout,
_Caption, FImageIndex, IL, ADown and AMouseIn, E);
end
else
DrawGlyphAndText(B.Canvas,
NewClRect, FMargin, FSpacing, FLayout,
_Caption, FGlyph, FNumGlyphs, GetGlyphNum(ADown, AMouseIn), ADown and AMouseIn);
end;
procedure TbsSkinSpeedButton.CreateControlDefaultImage;
var
R: TRect;
IsDown: Boolean;
IL: TCustomImageList;
E: Boolean;
_Caption: String;
begin
if FShowCaption then _Caption := Caption else _Caption := '';
IsDown := False;
R := ClientRect;
if FDown and ((FMouseIn and (GroupIndex = 0)) or (GroupIndex <> 0))
then
begin
Frame3D(B.Canvas, R, BS_XP_BTNFRAMECOLOR, BS_XP_BTNFRAMECOLOR, 1);
B.Canvas.Brush.Color := BS_XP_BTNDOWNCOLOR;
B.Canvas.FillRect(R);
IsDown := True;
end
else
if FMouseIn
then
begin
Frame3D(B.Canvas, R, BS_XP_BTNFRAMECOLOR, BS_XP_BTNFRAMECOLOR, 1);
B.Canvas.Brush.Color := BS_XP_BTNACTIVECOLOR;
B.Canvas.FillRect(R);
end
else
begin
if not (csDesigning in ComponentState) and FFlat
then
begin
if not Transparent
then
begin
B.Canvas.Brush.Color := clBtnFace;
B.Canvas.FillRect(R);
end;
end
else
begin
Frame3D(B.Canvas, R, clBtnShadow, clBtnShadow, 1);
B.Canvas.Brush.Color := clBtnFace;
B.Canvas.FillRect(R);
end;
end;
B.Canvas.Font.Assign(FDefaultFont);
if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
then
B.Canvas.Font.Charset := SkinData.ResourceStrData.CharSet
else
B.Canvas.Font.CharSet := FDefaultFont.Charset;
if not Enabled then B.Canvas.Font.Color := clBtnShadow;
if FGlyph.Empty and (Parent is TbsSkinToolBar)
then
begin
if not Enabled and (TbsSkinToolBar(Parent).DisabledImages <> nil)
then
IL := TbsSkinToolBar(Parent).DisabledImages
else
if (FMouseIn or FDown) and (TbsSkinToolBar(Parent).HotImages <> nil)
then
IL := TbsSkinToolBar(Parent).HotImages
else
IL := TbsSkinToolBar(Parent).Images;
E := Enabled;
if not Enabled and (TbsSkinToolBar(Parent).DisabledImages <> nil)
then
E := True;
DrawImageAndText(B.Canvas, ClientRect, FMargin, FSpacing, FLayout,
_Caption, FImageIndex, IL, FDown and FMouseIn, E);
end
else
DrawGlyphAndText(B.Canvas,
ClientRect, FMargin, FSpacing, FLayout,
_Caption, FGlyph, FNumGlyphs, GetGlyphNum(FDown, FMouseIn), IsDown);
end;
procedure TbsSkinSpeedButton.CreateControlSkinImage;
begin
end;
procedure TbsSkinSpeedButton.Paint;
var
Buffer, ABuffer: TBitMap;
PBuffer, APBuffer: TbsEffectBmp;
IL: TCustomImageList;
E: Boolean;
_Caption: String;
begin
GetSkinData;
if FShowCaption then _Caption := Caption else _Caption := '';
if FIndex = -1
then
begin
if FDown and (((FMouseIn and (GroupIndex = 0)) or (GroupIndex <> 0)))
then
inherited
else
if FMouseIn
then
inherited
else
if Transparent
then
begin
Canvas.Font.Assign(FDefaultFont);
if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
then
Canvas.Font.Charset := SkinData.ResourceStrData.CharSet
else
Canvas.Font.CharSet := FDefaultFont.Charset;
if not Enabled then Canvas.Font.Color := clBtnShadow;
if FGlyph.Empty and (Parent is TbsSkinToolBar)
then
begin
if not Enabled and (TbsSkinToolBar(Parent).DisabledImages <> nil)
then
IL := TbsSkinToolBar(Parent).DisabledImages
else
IL := TbsSkinToolBar(Parent).Images;
E := Enabled;
if not Enabled and (TbsSkinToolBar(Parent).DisabledImages <> nil)
then
E := False;
DrawImageAndText(Canvas, ClientRect, FMargin, FSpacing, FLayout,
_Caption, FImageIndex, IL, False, E);
end
else
DrawGlyphAndText(Canvas,
ClientRect, FMargin, FSpacing, FLayout,
_Caption, FGlyph, FNumGlyphs, GetGlyphNum(FDown, FMouseIn), False);
end
else
inherited;
end
else
begin
if Morphing and (FMorphKf <> 1) and (FMorphKf <> 0) and not Transparent
then
begin
Buffer := TBitMap.Create;
ABuffer := TBitMap.Create;
ABuffer.Width := Width;
ABuffer.Height := Height;
CreateButtonImage(Buffer, SkinRect, False, False);
CreateButtonImage(ABuffer, ActiveSkinRect, False, True);
PBuffer := TbsEffectBmp.CreateFromhWnd(Buffer.Handle);
APBuffer := TbsEffectBmp.CreateFromhWnd(ABuffer.Handle);
case MorphKind of
mkDefault: PBuffer.Morph(APBuffer, FMorphKf);
mkGradient: PBuffer.MorphGrad(APBuffer, FMorphKf);
mkLeftGradient: PBuffer.MorphLeftGrad(APBuffer, FMorphKf);
mkRightGradient: PBuffer.MorphRightGrad(APBuffer, FMorphKf);
mkLeftSlide: PBuffer.MorphLeftSlide(APBuffer, FMorphKf);
mkRightSlide: PBuffer.MorphRightSlide(APBuffer, FMorphKf);
mkPush: PBuffer.MorphPush(APBuffer, FMorphKf);
end;
PBuffer.Draw(Canvas.Handle, 0, 0);
PBuffer.Free;
APBuffer.Free;
Buffer.Free;
ABuffer.Free;
end
else
if FDown and (((FMouseIn and (GroupIndex = 0)) or (GroupIndex <> 0)))
then
begin
Buffer := TBitMap.Create;
Buffer.Width := Width;
Buffer.Height := Height;
CreateButtonImage(Buffer, DownSkinRect, True, True);
Canvas.Draw(0, 0, Buffer);
Buffer.Free;
end
else
if FMouseIn or (not FMouseIn and Morphing and (FMorphKf = 1))
then
begin
Buffer := TBitMap.Create;
Buffer.Width := Width;
Buffer.Height := Height;
CreateButtonImage(Buffer, ActiveSkinRect, False, True);
Canvas.Draw(0, 0, Buffer);
Buffer.Free;
end
else
begin
if Transparent
then
begin
with Canvas.Font do
begin
Name := FontName;
Style := FontStyle;
if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
then
Charset := SkinData.ResourceStrData.CharSet
else
CharSet := FDefaultFont.Charset;
if Self.Enabled
then
Color := FontColor
else
Color := DisabledFontColor;
Height := FontHeight;
end;
if FGlyph.Empty and (Parent is TbsSkinToolBar)
then
begin
if not Enabled and (TbsSkinToolBar(Parent).DisabledImages <> nil)
then
IL := TbsSkinToolBar(Parent).DisabledImages
else
IL := TbsSkinToolBar(Parent).Images;
E := Enabled;
if not Enabled and (TbsSkinToolBar(Parent).DisabledImages <> nil)
then
E := True;
DrawImageAndText(Canvas, NewClRect, FMargin, FSpacing, FLayout,
_Caption, FImageIndex, IL, False, E);
end
else
DrawGlyphAndText(Canvas,
NewClRect, FMargin, FSpacing, FLayout,
_Caption, FGlyph, FNumGlyphs, GetGlyphNum(FDown, FMouseIn), False);
end
else
begin
Buffer := TBitMap.Create;
Buffer.Width := Width;
Buffer.Height := Height;
if not Enabled and not IsNullRect(DisabledSkinRect)
then
CreateButtonImage(Buffer, DisabledSkinRect, False, False)
else
CreateButtonImage(Buffer, SkinRect, False, False);
Canvas.Draw(0, 0, Buffer);
Buffer.Free;
end;
end;
end;
end;
procedure TbsSkinSpeedButton.CMTextChanged;
begin
inherited;
RePaint;
end;
procedure TbsSkinSpeedButton.CMMouseEnter(var Message: TMessage);
begin
inherited;
if not Enabled then Exit;
if (csDesigning in ComponentState) then Exit;
FMouseIn := True;
if ((GroupIndex <> 0) and not FDown) or (GroupIndex = 0)
then
begin
if FDown
then
begin
if Morphing then FMorphKf := 1;
RePaint;
end
else
ReDrawControl;
end;
if FDown and RepeatMode and (GroupIndex = 0) then StartRepeat;
end;
procedure TbsSkinSpeedButton.CMMouseLeave(var Message: TMessage);
begin
inherited;
if not Enabled then Exit;
if (csDesigning in ComponentState) then Exit;
FMouseIn := False;
if ((GroupIndex <> 0) and not FDown) or (GroupIndex = 0)
then
ReDrawControl;
if FDown and RepeatMode and (RepeatTimer <> nil) and (GroupIndex = 0) then StopRepeat;
end;
procedure TbsSkinSpeedButton.MouseDown;
begin
inherited;
if Button = mbLeft
then
begin
FMouseDown := True;
if not FDown
then
begin
FMouseIn := True;
Down := True;
if FRepeatMode and (GroupIndex = 0)
then
StartRepeat
else
if (GroupIndex <> 0) then ButtonClick;
FAllowAllUpCheck := False;
end
else
if (GroupIndex <> 0) then FAllowAllUpCheck := True;
end;
end;
procedure TbsSkinSpeedButton.MouseUp;
begin
inherited;
if Button = mbLeft
then
begin
FMouseDown := False;
if GroupIndex = 0
then
begin
if FMouseIn
then
begin
Down := False;
if RepeatMode then StopRepeat;
ButtonClick;
end
else
begin
FDown := False;
if RepeatMode and (RepeatTimer <> nil) then StopRepeat;
end;
end
else
if (GroupIndex <> 0) and FDown and FAllowAllUp and
FAllowAllUpCheck and FMouseIn
then
begin
Down := False;
ButtonClick;
end;
end;
end;
constructor TbsSkinMenuSpeedButton.Create;
begin
inherited;
FSkinDataName := 'toolmenubutton';
FTrackButtonMode := False;
FMenuTracked := False;
FSkinPopupMenu := nil;
end;
destructor TbsSkinMenuSpeedButton.Destroy;
begin
inherited;
end;
procedure TbsSkinMenuSpeedButton.CreateButtonImage;
begin
if FMenuTracked and FTrackButtonMode and
not IsNullRect(TrackButtonRect) and not IsNullRect(DownSkinRect)
then
begin
inherited CreateButtonImage(B, ActiveSkinRect, False, True);
R := TrackButtonRect;
OffsetRect(R, DownSkinRect.Left, DownSkinRect.Top);
B.Canvas.CopyRect(GetNewTrackButtonRect, Picture.Canvas,
R);
end
else
inherited;
end;
procedure TbsSkinMenuSpeedButton.Paint;
var
R: TRect;
IL: TCustomImageList;
E: Boolean;
_Caption: String;
begin
if FShowCaption then _Caption := Caption else _Caption := '';
GetSkinData;
if not FMouseIn and not FDown and not FMenuTracked and Transparent
then
begin
if FIndex = -1
then
begin
R := ClientRect;
Dec(R.Right, 15);
end
else
R := NewClRect;
Canvas.Font.Assign(FDefaultFont);
if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
then
Canvas.Font.Charset := SkinData.ResourceStrData.CharSet
else
Canvas.Font.CharSet := FDefaultFont.Charset;
if not Enabled then Canvas.Font.Color := clBtnShadow;
if FGlyph.Empty and (Parent is TbsSkinToolBar)
then
begin
if not Enabled and (TbsSkinToolBar(Parent).DisabledImages <> nil)
then
IL := TbsSkinToolBar(Parent).DisabledImages
else
IL := TbsSkinToolBar(Parent).Images;
E := Enabled;
if not Enabled and (TbsSkinToolBar(Parent).DisabledImages <> nil)
then
E := False;
DrawImageAndText(Canvas, R, FMargin, FSpacing, FLayout,
_Caption, FImageIndex, IL, False, E);
end
else
DrawGlyphAndText(Canvas, R, FMargin, FSpacing, FLayout,
_Caption, FGlyph, FNumGlyphs, 1, False);
if FIndex <> -1
then
begin
R.Left := R.Right;
R.Right := Width;
end
else
begin
R.Left := Width - 15;
R.Right := Width;
end;
if (FDown and FMouseIn) or FMenuTracked
then
begin
Inc(R.Top, 2);
Inc(R.Left, 2);
end;
DrawTrackArrowImage(Canvas, R, clBtnText);
end
else
inherited;
end;
procedure TbsSkinMenuSpeedButton.CreateControlDefaultImage;
var
R, R1: TRect;
isDown: Boolean;
IL: TCustomImageList;
E: Boolean;
_Caption: String;
begin
if FShowCaption then _Caption := Caption else _Caption := '';
isDown := False;
R := Rect(0, 0, Width, Height);
if FTrackButtonMode
then
begin
R := Rect(0, 0, Width - 15, Height);
R1 := Rect(Width - 15, 0, Width, Height);
if FMenuTracked
then
begin
B.Canvas.Brush.Color := BS_XP_BTNACTIVECOLOR;
B.Canvas.FillRect(R);
Frame3D(B.Canvas, R, BS_XP_BTNFRAMECOLOR, BS_XP_BTNFRAMECOLOR, 1);
B.Canvas.Brush.Color := BS_XP_BTNDOWNCOLOR;
B.Canvas.FillRect(R1);
Frame3D(B.Canvas, R1, BS_XP_BTNFRAMECOLOR, BS_XP_BTNFRAMECOLOR, 1);
end
else
begin
if FDown and FMouseIn
then
begin
Frame3D(B.Canvas, R, BS_XP_BTNFRAMECOLOR, BS_XP_BTNFRAMECOLOR, 1);
B.Canvas.Brush.Color := BS_XP_BTNDOWNCOLOR;
B.Canvas.FillRect(R);
Frame3D(B.Canvas, R1, BS_XP_BTNFRAMECOLOR, BS_XP_BTNFRAMECOLOR, 1);
B.Canvas.Brush.Color := BS_XP_BTNDOWNCOLOR;
B.Canvas.FillRect(R1);
isDown := True;
end
else
if FMouseIn
then
begin
Frame3D(B.Canvas, R, BS_XP_BTNFRAMECOLOR, BS_XP_BTNFRAMECOLOR, 1);
B.Canvas.Brush.Color := BS_XP_BTNACTIVECOLOR;
B.Canvas.FillRect(R);
Frame3D(B.Canvas, R1, BS_XP_BTNFRAMECOLOR, BS_XP_BTNFRAMECOLOR, 1);
B.Canvas.Brush.Color := BS_XP_BTNACTIVECOLOR;
B.Canvas.FillRect(R1);
end
else
if not FFlat
then
begin
Frame3D(B.Canvas, R, clBtnShadow, clBtnShadow, 1);
B.Canvas.Brush.Color := clBtnFace;
B.Canvas.FillRect(R);
Frame3D(B.Canvas, R1, clBtnShadow, clBtnShadow, 1);
B.Canvas.Brush.Color := clBtnFace;
B.Canvas.FillRect(R1);
end
else
begin
B.Canvas.Brush.Color := clBtnFace;
B.Canvas.FillRect(R);
B.Canvas.FillRect(R1);
end;
end;
end
else
begin
if FDown and FMouseIn
then
begin
Frame3D(B.Canvas, R, BS_XP_BTNFRAMECOLOR, BS_XP_BTNFRAMECOLOR, 1);
B.Canvas.Brush.Color := BS_XP_BTNDOWNCOLOR;
B.Canvas.FillRect(R);
IsDown := True;
end
else
if FMouseIn
then
begin
Frame3D(B.Canvas, R, BS_XP_BTNFRAMECOLOR, BS_XP_BTNFRAMECOLOR, 1);
B.Canvas.Brush.Color := BS_XP_BTNACTIVECOLOR;
B.Canvas.FillRect(R);
end
else
begin
if not FFlat
then
Frame3D(B.Canvas, R, clBtnShadow, clBtnShadow, 1);
B.Canvas.Brush.Color := clBtnFace;
B.Canvas.FillRect(R);
end;
end;
R := ClientRect;
Dec(R.Right, 15);
B.Canvas.Font.Assign(FDefaultFont);
if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
then
B.Canvas.Font.Charset := SkinData.ResourceStrData.CharSet
else
B.Canvas.Font.CharSet := FDefaultFont.Charset;
if not Enabled then B.Canvas.Font.Color := clBtnShadow;
if FGlyph.Empty and (Parent is TbsSkinToolBar)
then
begin
if not Enabled and (TbsSkinToolBar(Parent).DisabledImages <> nil)
then
IL := TbsSkinToolBar(Parent).DisabledImages
else
if (FMouseIn or FDown) and (TbsSkinToolBar(Parent).HotImages <> nil)
then
IL := TbsSkinToolBar(Parent).HotImages
else
IL := TbsSkinToolBar(Parent).Images;
E := Enabled;
if not Enabled and (TbsSkinToolBar(Parent).DisabledImages <> nil)
then
E := False;
DrawImageAndText(B.Canvas, R, FMargin, FSpacing, FLayout,
_Caption, FImageIndex, IL, isDown, E);
end
else
DrawGlyphAndText(B.Canvas, R, FMargin, FSpacing, FLayout,
_Caption, FGlyph, FNumGlyphs, 1, isDown);
R.Left := Width - 15;
Inc(R.Right, 15);
if (FDown and FMouseIn) or FMenuTracked
then
begin
Inc(R.Top, 2);
Inc(R.Left, 2);
end;
DrawTrackArrowImage(B.Canvas, R, clBtnText);
end;
function TbsSkinMenuSpeedButton.GetNewTrackButtonRect;
var
RM, Off: Integer;
R: TRect;
begin
RM := GetResizeMode;
R := TrackButtonRect;
case RM of
2:
begin
Off := Width - RectWidth(SkinRect);
OffsetRect(R, Off, 0);
end;
3:
begin
Off := Height - RectHeight(SkinRect);
OffsetRect(R, 0, Off);
end;
end;
Result := R;
end;
function TbsSkinMenuSpeedButton.CanMenuTrack;
var
R: TRect;
begin
if FSkinPopupMenu = nil
then
begin
Result := False;
Exit;
end
else
begin
if not FTrackButtonMode
then
Result := True
else
begin
if FIndex <> -1
then R := GetNewTrackButtonRect
else R := Rect(Width - 15, 0, Width, Height);
Result := PointInRect(R, Point(X, Y));
end;
end
end;
procedure TbsSkinMenuSpeedButton.WMCLOSESKINMENU;
begin
FMenuTracked := False;
Down := False;
if Assigned(FOnHideTrackMenu) then FOnHideTrackMenu(Self);
end;
procedure TbsSkinMenuSpeedButton.TrackMenu;
var
R: TRect;
P: TPoint;
begin
if FSkinPopupMenu = nil then Exit;
P := ClientToScreen(Point(0, 0));
R := Rect(P.X, P.Y, P.X + Width, P.Y + Height);
FSkinPopupMenu.PopupFromRect2(Self, R, False);
if Assigned(FOnShowTrackMenu) then FOnShowTrackMenu(Self);
end;
procedure TbsSkinMenuSpeedButton.Notification;
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (AComponent = FSkinPopupMenu)
then FSkinPopupMenu := nil;
end;
procedure TbsSkinMenuSpeedButton.CMMouseEnter(var Message: TMessage);
begin
if (csDesigning in ComponentState) then Exit;
if not FMenuTracked then inherited else FMouseIn := True;
end;
procedure TbsSkinMenuSpeedButton.CMMouseLeave(var Message: TMessage);
begin
if (csDesigning in ComponentState) then Exit;
if not FMenuTracked then inherited else FMouseIn := False;
end;
procedure TbsSkinMenuSpeedButton.GetSkinData;
begin
inherited;
if FIndex <> -1
then
if TbsDataSkinControl(FSD.CtrlList.Items[FIndex]) is TbsDataSkinMenuButtonControl
then
with TbsDataSkinMenuButtonControl(FSD.CtrlList.Items[FIndex]) do
begin
Self.TrackButtonRect := TrackButtonRect;
end;
end;
procedure TbsSkinMenuSpeedButton.SetTrackButtonMode;
begin
FTrackButtonMode := Value;
if FIndex = - 1 then RePaint;
end;
procedure TbsSkinMenuSpeedButton.MouseDown;
begin
if Button <> mbLeft
then
begin
inherited;
Exit;
end;
FMenuTracked := CanMenuTrack(X, Y);
FMouseIn := True;
if FMenuTracked
then
begin
if not FDown then Down := True;
TrackMenu;
end
else
inherited;
end;
procedure TbsSkinMenuSpeedButton.MouseUp;
begin
if not FMenuTracked then inherited;
end;
constructor TbsSkinTextLabel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := ControlStyle + [csReplicatable] - [csOpaque];
Width := 65;
Height := 65;
FAutoSize := True;
FLines := TStringList.Create;
FSkinDataName := 'stdlabel';
FDefaultFont := TFont.Create;
FUseSkinFont := True;
end;
destructor TbsSkinTextLabel.Destroy;
begin
FLines.Free;
FDefaultFont.Free;
inherited;
end;
procedure TbsSkinTextLabel.SetDefaultFont;
begin
FDefaultFont.Assign(Value);
end;
procedure TbsSkinTextLabel.Notification;
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (AComponent = FSD) then FSD := nil;
end;
procedure TbsSkinTextLabel.GetSkinData;
begin
if (FSD = nil) or FSD.Empty
then
FIndex := -1
else
FIndex := FSD.GetControlIndex(FSkinDataName);
if FIndex <> -1
then
if TbsDataSkinControl(FSD.CtrlList.Items[FIndex]) is TbsDataSkinStdLabelControl
then
with TbsDataSkinStdLabelControl(FSD.CtrlList.Items[FIndex]) do
begin
Self.FontName := FontName;
Self.FontStyle := FontStyle;
Self.FontHeight := FontHeight;
Self.FontColor := FontColor;
end;
end;
procedure TbsSkinTextLabel.ChangeSkinData;
begin
GetSkinData;
if FAutoSize then AdjustBounds;
RePaint;
end;
procedure TbsSkinTextLabel.SetSkinData;
begin
FSD := Value;
if (FSD <> nil) then ChangeSkinData;
end;
procedure TbsSkinTextLabel.SetLines;
begin
FLines.Assign(Value);
if FAutoSize then AdjustBounds;
RePaint;
end;
function TbsSkinTextLabel.GetLabelText: string;
begin
Result := FLines.Text;
end;
procedure TbsSkinTextLabel.DoDrawText(var Rect: TRect; Flags: Longint);
var
Text: string;
begin
GetSkinData;
Text := GetLabelText;
Flags := DrawTextBiDiModeFlags(Flags);
if FIndex <> -1
then
with Canvas.Font do
begin
if FUseSkinFont
then
begin
Name := FontName;
Style := FontStyle;
Height := FontHeight;
end
else
Canvas.Font := Self.Font;
Color := FontColor;
end
else
if FUseSkinFont
then
Canvas.Font := DefaultFont
else
Canvas.Font := Self.Font;
if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
then
Canvas.Font.Charset := SkinData.ResourceStrData.CharSet
else
Canvas.Font.CharSet := FDefaultFont.Charset;
if not Enabled then
begin
OffsetRect(Rect, 1, 1);
Canvas.Font.Color := clBtnHighlight;
DrawText(Canvas.Handle, PChar(Text), Length(Text), Rect, Flags);
OffsetRect(Rect, -1, -1);
Canvas.Font.Color := clBtnShadow;
DrawText(Canvas.Handle, PChar(Text), Length(Text), Rect, Flags);
end
else
begin
Canvas.Font := Self.Font;
if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
then
Canvas.Font.Charset := SkinData.ResourceStrData.CharSet;
DrawText(Canvas.Handle, PChar(Text), Length(Text), Rect, Flags);
end;
end;
procedure TbsSkinTextLabel.Paint;
const
Alignments: array[TAlignment] of Word = (DT_LEFT, DT_RIGHT, DT_CENTER);
WordWraps: array[Boolean] of Word = (0, DT_WORDBREAK);
var
Rect, CalcRect: TRect;
DrawStyle: Longint;
begin
with Canvas do
begin
Brush.Style := bsClear;
Rect := ClientRect;
{ DoDrawText takes care of BiDi alignments }
DrawStyle := DT_EXPANDTABS or WordWraps[FWordWrap] or Alignments[FAlignment];
{ Calculate vertical layout }
if FLayout <> tlTop then
begin
CalcRect := Rect;
DoDrawText(CalcRect, DrawStyle or DT_CALCRECT);
if FLayout = tlBottom then OffsetRect(Rect, 0, Height - CalcRect.Bottom)
else OffsetRect(Rect, 0, (Height - CalcRect.Bottom) div 2);
end;
DoDrawText(Rect, DrawStyle);
end;
end;
procedure TbsSkinTextLabel.Loaded;
begin
inherited Loaded;
AdjustBounds;
end;
procedure TbsSkinTextLabel.AdjustBounds;
const
WordWraps: array[Boolean] of Word = (0, DT_WORDBREAK);
var
DC: HDC;
X: Integer;
Rect: TRect;
AAlignment: TAlignment;
begin
if not (csReading in ComponentState) and FAutoSize then
begin
Rect := ClientRect;
DC := GetDC(0);
Canvas.Handle := DC;
DoDrawText(Rect, (DT_EXPANDTABS or DT_CALCRECT) or WordWraps[FWordWrap]);
Canvas.Handle := 0;
ReleaseDC(0, DC);
X := Left;
AAlignment := FAlignment;
if UseRightToLeftAlignment then ChangeBiDiModeAlignment(AAlignment);
if AAlignment = taRightJustify then Inc(X, Width - Rect.Right);
SetBounds(X, Top, Rect.Right, Rect.Bottom);
end;
end;
procedure TbsSkinTextLabel.SetAlignment(Value: TAlignment);
begin
if FAlignment <> Value then
begin
FAlignment := Value;
Invalidate;
end;
end;
procedure TbsSkinTextLabel.SetAutoSize(Value: Boolean);
begin
if FAutoSize <> Value then
begin
FAutoSize := Value;
AdjustBounds;
end;
end;
procedure TbsSkinTextLabel.SetLayout(Value: TTextLayout);
begin
if FLayout <> Value then
begin
FLayout := Value;
Invalidate;
end;
end;
procedure TbsSkinTextLabel.SetWordWrap(Value: Boolean);
begin
if FWordWrap <> Value then
begin
FWordWrap := Value;
AdjustBounds;
Invalidate;
end;
end;
procedure TbsSkinTextLabel.CMFontChanged(var Message: TMessage);
begin
inherited;
AdjustBounds;
Invalidate;
end;
// ======================== TbsSkinExPanel ============================= //
constructor TbsSkinExPanel.Create(AOwner: TComponent);
begin
inherited;
ControlStyle := [csAcceptsControls, csCaptureMouse, csClickEvents,
csSetCaption, csOpaque, csDoubleClicks, csReplicatable];
FNumGlyphs := 1;
FGlyph := TBitMap.Create;
FSpacing := 2;
FDefaultCaptionHeight := 21;
Width := 150;
Height := 100;
VisibleControls := nil;
FRollKind := rkRollVertical;
ActiveButton := -1;
OldActiveButton := -1;
CaptureButton := -1;
FShowRollButton := True;
FShowCloseButton := True;
FRollState := False;
FRealWidth := 0;
FRealHeight := 0;
StopCheckSize := False;
FSkinDataName := 'expanel';
end;
destructor TbsSkinExPanel.Destroy;
begin
FGlyph.Free;
inherited;
end;
procedure TbsSkinExPanel.SetNumGlyphs;
begin
FNumGlyphs := Value;
RePaint;
end;
procedure TbsSkinExPanel.SetGlyph;
begin
FGlyph.Assign(Value);
RePaint;
end;
procedure TbsSkinExPanel.SetSpacing;
begin
FSpacing := Value;
RePaint;
end;
procedure TbsSkinExPanel.ChangeSkinData;
begin
inherited;
if FRollState
then
begin
if FRollKind = rkRollVertical
then Height := GetRollHeight
else Width := GetRollWidth;
end
else
ReAlign;
end;
procedure TbsSkinExPanel.Close;
begin
Visible := False;
if not (csDesigning in ComponentState) and
Assigned(FOnClose)
then
FOnClose(Self);
end;
procedure TbsSkinExPanel.GetSkinData;
begin
inherited;
if FIndex <> -1
then
if TbsDataSkinControl(FSD.CtrlList.Items[FIndex]) is TbsDataSkinExPanelControl
then
with TbsDataSkinExPanelControl(FSD.CtrlList.Items[FIndex]) do
begin
Self.CaptionRect := CaptionRect;
Self.FontName := FontName;
Self.FontColor := FontColor;
Self.FontStyle := FontStyle;
Self.FontHeight := FontHeight;
Self.RollHSkinRect := RollHSkinRect;
Self.RollVSkinRect := RollVSkinRect;
Self.RollLeftOffset := RollLeftOffset;
Self.RollRightOffset := RollRightOffset;
Self.RollTopOffset := RollTopOffset;
Self.RollBottomOffset := RollBottomOffset;
Self.RollVCaptionRect := RollVCaptionRect;
Self.RollHCaptionRect := RollHCaptionRect;
Self.CloseButtonRect := CloseButtonRect;
Self.CloseButtonActiveRect := CloseButtonActiveRect;
Self.CloseButtonDownRect := CloseButtonDownRect;
Self.HRollButtonRect := HRollButtonRect;
Self.HRollButtonActiveRect := HRollButtonActiveRect;
if IsNullRect(Self.HRollButtonActiveRect)
then Self.HRollButtonActiveRect := Self.HRollButtonRect;
Self.HRollButtonDownRect := HRollButtonDownRect;
if IsNullRect(Self.HRollButtonDownRect)
then Self.HRollButtonDownRect := Self.HRollButtonActiveRect;
Self.HRestoreButtonRect := HRestoreButtonRect;
Self.HRestoreButtonActiveRect := HRestoreButtonActiveRect;
if IsNullRect(Self.HRestoreButtonActiveRect)
then Self.HRestoreButtonActiveRect := Self.HRestoreButtonRect;
Self.HRestoreButtonDownRect := HRestoreButtonDownRect;
if IsNullRect(Self.HRestoreButtonDownRect)
then Self.HRestoreButtonDownRect := Self.HRestoreButtonActiveRect;
Self.VRollButtonRect := VRollButtonRect;
Self.VRollButtonActiveRect := VRollButtonActiveRect;
if IsNullRect(Self.VRollButtonActiveRect)
then Self.VRollButtonActiveRect := Self.VRollButtonRect;
Self.VRollButtonDownRect := VRollButtonDownRect;
if IsNullRect(Self.VRollButtonDownRect)
then Self.VRollButtonDownRect := Self.VRollButtonActiveRect;
Self.VRestoreButtonRect := VRestoreButtonRect;
Self.VRestoreButtonActiveRect := VRestoreButtonActiveRect;
if IsNullRect(Self.VRestoreButtonActiveRect)
then Self.VRestoreButtonActiveRect := Self.VRestoreButtonRect;
Self.VRestoreButtonDownRect := VRestoreButtonDownRect;
if IsNullRect(Self.VRestoreButtonDownRect)
then Self.VRestoreButtonDownRect := Self.VRestoreButtonActiveRect;
end;
end;
procedure TbsSkinExPanel.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
if FRollState and not StopCheckSize
then
begin
if (FRollKind = rkRollHorizontal) and (AWidth <> GetRollWidth)
then AWidth := GetRollWidth
else
if (FRollKind = rkRollVertical) and (AHeight <> GetRollHeight)
then AHeight := GetRollHeight
end;
inherited;
end;
procedure TbsSkinExPanel.CMTextChanged;
begin
inherited;
RePaint;
end;
procedure TbsSkinExPanel.SetShowRollButton(Value: Boolean);
begin
FShowRollButton := Value;
RePaint;
end;
procedure TbsSkinExPanel.SetShowCloseButton(Value: Boolean);
begin
FShowCloseButton := Value;
RePaint;
end;
function TbsSkinExPanel.GetRollWidth: Integer;
begin
if FIndex = -1
then
Result := FDefaultCaptionHeight
else
Result := RectWidth(RollHSkinRect);
end;
function TbsSkinExPanel.GetRollHeight: Integer;
begin
if FIndex = -1
then
Result := FDefaultCaptionHeight
else
Result := RectHeight(RollVSkinRect);
end;
procedure TbsSkinExPanel.SetRollKind(Value: TbsExPanelRollKind);
begin
FRollKind := Value;
RePaint;
end;
procedure TbsSkinExPanel.SetDefaultCaptionHeight;
begin
FDefaultCaptionHeight := Value;
if FIndex = -1
then
begin
RePaint;
ReAlign;
end
end;
procedure TbsSkinExPanel.CreateControlDefaultImage(B: TBitMap);
var
R, CR: TRect;
GlyphNum, BW, CROffset, TX, TY, GX, GY: Integer;
F: TLogFont;
begin
BW := FDefaultCaptionHeight - 6;
R := Rect(0, 0, Width, Height);
if FRollState and (FRollKind = rkRollHorizontal)
then
with B.Canvas do
begin
Brush.Color := clBtnFace;
FillRect(R);
CR := R;
Frame3D(B.Canvas, R, clBtnShadow, clBtnShadow, 1);
Frame3D(B.Canvas, R, clBtnHighLight, clBtnFace, 1);
CROffset := 0;
if FShowCloseButton
then
begin
begin
Buttons[0].R := Rect(3, 3, 3 + BW, 3 + BW);
CROffset := CROffset + RectHeight(Buttons[0].R);
end;
end
else
Buttons[0].R := Rect(0, 0, 0, 3);
if FShowRollButton
then
begin
Buttons[1].R := Rect(3, Buttons[0].R.Bottom, 3 + BW, Buttons[0].R.Bottom + BW);
CROffset := CROffset + RectHeight(Buttons[1].R);
end
else
Buttons[1].R := Rect(0, 0, 0, 0);
//
Font := DefaultFont;
if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
then
Font.Charset := SkinData.ResourceStrData.CharSet;
GetObject(Font.Handle, SizeOf(F), @F);
F.lfEscapement := round(900);
Font.Handle := CreateFontIndirect(F);
Inc(CR.Top, CROffset + 2);
TX := CR.Left + RectWidth(CR) div 2 - TextHeight(Caption) div 2;
TY := CR.Bottom - 2 ;
Brush.Style := bsClear;
if not FGlyph.Empty
then
begin
GX := CR.Left + RectWidth(CR) div 2 - FGlyph.Width div 2;
GY := CR.Bottom - FGlyph.Height - 2;
GlyphNum := 1;
if not Enabled and (NumGlyphs = 2) then GlyphNum := 2;
DrawGlyph(B.Canvas, GX, GY, FGlyph, NumGlyphs, GlyphNum);
TY := TY - FGlyph.Height - FSpacing - 2;
end;
TextRect(CR, TX, TY, Caption);
//
end
else
with B.Canvas do
begin
Frame3D(B.Canvas, R, clBtnShadow, clBtnShadow, 1);
Brush.Color := clBtnFace;
FillRect(R);
CR := Rect(0, 0, Width, FDefaultCaptionHeight);
CROffset := 0;
Frame3D(B.Canvas, CR, clBtnShadow, clBtnShadow, 1);
Frame3D(B.Canvas, CR, clBtnHighLight, clBtnFace, 1);
if FShowCloseButton
then
begin
Buttons[0].R := Rect(Width - BW - 2, 3, Width - 2, 3 + BW);
CROffset := CROffset + RectWidth(Buttons[1].R);
end
else
Buttons[0].R := Rect(Width - 2, 0, 0, 0);
if FShowRollButton
then
begin
Buttons[1].R := Rect(Buttons[0].R.Left - BW, 3, Buttons[0].R.Left, 3 + BW);
CROffset := CROffset + RectWidth(Buttons[1].R);
end
else
Buttons[1].R := Rect(0, 0, 0, 0);
//
Inc(CR.Left, 2);
Dec(CR.Right, CROffset + 2);
//
Brush.Style := bsClear;
Font := DefaultFont;
if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
then
Font.Charset := SkinData.ResourceStrData.CharSet;
//
if not FGlyph.Empty
then
begin
GX := CR.Left;
GY := CR.Top + RectHeight(CR) div 2 - FGlyph.Height div 2;
GlyphNum := 1;
if not Enabled and (NumGlyphs = 2) then GlyphNum := 2;
DrawGlyph(B.Canvas, GX, GY, FGlyph, NumGlyphs, GlyphNum);
Inc(CR.Left, FGlyph.Width + FSpacing);
end;
BSDrawText2(B.Canvas, Caption, CR);
end;
if FShowCloseButton then DrawButton(B.Canvas, 0);
if FShowRollButton then DrawButton(B.Canvas, 1);
end;
procedure TbsSkinExPanel.CreateControlSkinImage(B: TBitMap);
var
CR: TRect;
F: TLogFont;
CROffset, BO, TX, TY, GX, GY, GlyphNum: Integer;
begin
with B.Canvas.Font do
begin
if FUseSkinFont
then
begin
Name := FontName;
Style := FontStyle;
Height := FontHeight;
end
else
Assign(FDefaultFont);
Color := FontColor;
end;
if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
then
B.Canvas.Font.Charset := SkinData.ResourceStrData.CharSet
else
B.Canvas.Font.CharSet := FDefaultFont.Charset;
B.Canvas.Brush.Style := bsClear;
if FRollState and (FRollKind = rkRollHorizontal)
then
begin
CreateVSkinImage(RollTopOffset, RollBottomOffset,
B, Picture, RollHSkinRect, GetRollWidth, Height);
CR := RollHCaptionRect;
Inc(CR.Bottom, Height - RectHeight(RollHSkinRect));
CROffset := 0;
BO := 0;
if FShowCloseButton
then
begin
begin
Buttons[0].R := Rect(CR.Left, CR.Top,
CR.Left + RectWidth(Self.CloseButtonRect),
CR.Top + RectHeight(Self.CloseButtonRect));
CROffset := CROffset + RectHeight(Buttons[0].R);
BO := 2;
end;
end
else
Buttons[0].R := Rect(0, 0, 0, CR.Top);
if FShowRollButton
then
begin
Buttons[1].R := Rect(CR.Left, Buttons[0].R.Bottom + BO,
CR.Left + RectWidth(Self.HRollButtonRect),
Buttons[0].R.Bottom + RectHeight(Self.HRollButtonRect) + BO);
CROffset := CROffset + RectHeight(Buttons[1].R) + BO;
end
else
Buttons[1].R := Rect(0, 0, 0, 0);
Inc(CR.Top, CROffset);
GetObject(B.Canvas.Font.Handle, SizeOf(F), @F);
F.lfEscapement := round(900);
B.Canvas.Font.Handle := CreateFontIndirect(F);
TX := CR.Left + RectWidth(CR) div 2 - B.Canvas.TextHeight(Caption) div 2;
TY := CR.Bottom;
if not FGlyph.Empty
then
begin
GX := CR.Left + RectWidth(CR) div 2 - FGlyph.Width div 2;
GY := CR.Bottom - FGlyph.Height;
GlyphNum := 1;
if not Enabled and (NumGlyphs = 2) then GlyphNum := 2;
DrawGlyph(B.Canvas, GX, GY, FGlyph, NumGlyphs, GlyphNum);
TY := TY - FGlyph.Height - FSpacing;
end;
B.Canvas.TextRect(CR, TX, TY, Caption);
end
else
if FRollState and (FRollKind = rkRollVertical)
then
begin
CreateHSkinImage(RollLeftOffset, RollRightOffset,
B, Picture, RollVSkinRect, Width, GetRollHeight);
CR := RollVCaptionRect;
Inc(CR.Right, Width - RectWidth(RollVSkinRect));
CROffset := 0;
BO := 0;
if FShowCloseButton
then
begin
Buttons[0].R := Rect(CR.Right - RectWidth(CloseButtonRect), CR.Top,
CR.Right, CR.Top + RectHeight(CloseButtonRect));
CROffset := CROffset + RectWidth(Buttons[1].R);
BO := 2;
end
else
Buttons[0].R := Rect(CR.Right, 0, 0, 0);
if FShowRollButton
then
begin
Buttons[1].R := Rect(Buttons[0].R.Left - RectWidth(VRollButtonRect) - BO,
CR.Top, Buttons[0].R.Left - BO, CR.Top + RectHeight(VRollButtonRect));
CROffset := CROffset + RectWidth(Buttons[1].R) + BO;
end
else
Buttons[1].R := Rect(0, 0, 0, 0);
Dec(CR.Right, CROffset);
if not FGlyph.Empty
then
begin
GX := CR.Left;
GY := CR.Top + RectHeight(CR) div 2 - FGlyph.Height div 2;
GlyphNum := 1;
if not Enabled and (NumGlyphs = 2) then GlyphNum := 2;
DrawGlyph(B.Canvas, GX, GY, FGlyph, NumGlyphs, GlyphNum);
Inc(CR.Left, FGlyph.Width + FSpacing);
end;
BSDrawText2(B.Canvas, Caption, CR);
end
else
begin
inherited;
CR := CaptionRect;
Inc(CR.Right, Width - RectWidth(SkinRect));
CROffset := 0;
BO := 0;
if FShowCloseButton
then
begin
Buttons[0].R := Rect(CR.Right - RectWidth(CloseButtonRect), CR.Top,
CR.Right, CR.Top + RectHeight(CloseButtonRect));
CROffset := CROffset + RectWidth(Buttons[1].R);
BO := 2;
end
else
Buttons[0].R := Rect(CR.Right, 0, 0, 0);
if FShowRollButton
then
begin
Buttons[1].R := Rect(Buttons[0].R.Left - RectWidth(VRollButtonRect) - BO,
CR.Top, Buttons[0].R.Left - BO, CR.Top + RectHeight(VRollButtonRect));
CROffset := CROffset + RectWidth(Buttons[1].R) + BO;
end
else
Buttons[1].R := Rect(0, 0, 0, 0);
Dec(CR.Right, CROffset);
if not FGlyph.Empty
then
begin
GX := CR.Left;
GY := CR.Top + RectHeight(CR) div 2 - FGlyph.Height div 2;
GlyphNum := 1;
if not Enabled and (NumGlyphs = 2) then GlyphNum := 2;
DrawGlyph(B.Canvas, GX, GY, FGlyph, NumGlyphs, GlyphNum);
Inc(CR.Left, FGlyph.Width + FSpacing);
end;
BSDrawText2(B.Canvas, Caption, CR);
end;
if FShowCloseButton then DrawButton(B.Canvas, 0);
if FShowRollButton then DrawButton(B.Canvas, 1);
end;
procedure TbsSkinExPanel.AdjustClientRect(var Rect: TRect);
begin
inherited AdjustClientRect(Rect);
if (FIndex <> -1) and not (csDesigning in ComponentState)
then
Rect := NewClRect
else
begin
Rect.Top := Rect.Top + FDefaultCaptionHeight;
Inc(Rect.Left, 1);
Dec(Rect.Right, 1);
Dec(Rect.Bottom, 1);
end;
end;
procedure TbsSkinExPanel.ShowControls;
var
i: Integer;
begin
if VisibleControls = nil then Exit;
for i := 0 to VisibleControls.Count - 1 do
TControl(VisibleControls.Items[i]).Visible := True;
VisibleControls.Clear;
VisibleControls.Free;
VisibleControls := nil;
end;
procedure TbsSkinExPanel.HideControls;
var
i: Integer;
begin
if VisibleControls <> nil then VisibleControls.Free;
VisibleControls := TList.Create;
VisibleControls.Clear;
for i := 0 to ControlCount - 1 do
begin
if Controls[i].Visible
then
begin
VisibleControls.Add(Controls[i]);
Controls[i].Visible := False;
end;
end;
end;
procedure TbsSkinExPanel.SetRollState;
begin
if FRollState = Value then Exit;
FRollState := Value;
StopCheckSize := True;
if FRollState
then
begin
HideControls;
case FRollKind of
rkRollVertical:
if FRealHeight = 0 then
begin
FRealHeight := Height;
Height := GetRollHeight;
end;
rkRollHorizontal:
if FRealWidth = 0 then
begin
FRealWidth := Width;
Width := GetRollWidth;
end;
end;
end
else
begin
case FRollKind of
rkRollVertical:
begin
Height := FRealHeight;
FRealHeight := 0;
end;
rkRollHorizontal:
begin
Width := FRealWidth;
FRealWidth := 0;
end;
end;
ShowControls;
end;
StopCheckSize := False;
if not (csDesigning in ComponentState) and
Assigned(FOnChangeRollState)
then
FOnChangeRollState(Self);
end;
procedure TbsSkinExPanel.CMMouseEnter;
begin
inherited;
if (csDesigning in ComponentState) then Exit;
TestActive(-1, -1);
end;
procedure TbsSkinExPanel.CMMouseLeave;
var
i: Integer;
begin
inherited;
if (csDesigning in ComponentState) then Exit;
for i := 0 to 1 do
if Buttons[i].MouseIn
then
begin
Buttons[i].MouseIn := False;
DrawButton(Canvas, i);
end;
end;
procedure TbsSkinExPanel.MouseDown;
begin
TestActive(X, Y);
if ActiveButton <> -1
then
begin
CaptureButton := ActiveButton;
ButtonDown(ActiveButton, X, Y);
end;
inherited;
end;
procedure TbsSkinExPanel.MouseUp;
begin
inherited;
if CaptureButton <> -1
then ButtonUp(CaptureButton, X, Y);