Delphi控件源码

开发平台：

Delphi

SkinCtrls.pas：源码内容

FPosition := APosition;
end;
RePaint;
end;
procedure TspSkinScrollBar.SetMax;
begin
FMax := AValue;
if FPageSize = 0
then
begin
if FPosition > FMax then FPosition := FMax;
end
else
begin
if FPageSize + FPosition > FMax - FMin
then
FPosition := (FMax - FMin) - FPageSize + 1;
if FPosition < FMin then FPosition := FMin;
end;
RePaint;
end;
procedure TspSkinScrollBar.SetMin;
begin
FMin := AValue;
if FPosition < FMin then FPosition := FMin;
RePaint;
end;
procedure TspSkinScrollBar.SetSmallChange;
begin
FSmallChange := AValue;
RePaint;
end;
procedure TspSkinScrollBar.SetLargeChange;
begin
FLargeChange := AValue;
RePaint;
end;
procedure TspSkinScrollBar.CreateControlDefaultImage;
var
R: TRect;
i: Integer;
j: Integer;
begin
CalcRects;
R := ClientRect;
with B.Canvas do
begin
Brush.Color := clBtnFace;
FillRect(R);
end;
Frame3D(B.Canvas, R, clBtnFace, clBtnFace, 1);
if Enabled then j := 0 else j := 1;
for i := j to BUTCOUNT - 1 do DrawButton(B.Canvas, i);
end;
procedure TspSkinScrollBar.MouseDown;
var
i: Integer;
j: Integer;
begin
inherited;
if Button <> mbLeft
then
begin
inherited;
Exit;
end;
MouseD := True;
CalcRects;
TimerMode := 0;
WaitMode := True;
j := -1;
for i := 0 to BUTCOUNT - 1 do
begin
if PtInRect(Buttons[i].R, Point(X, Y))
then
begin
j := i;
Break;
end;
end;
if j <> -1
then
begin
CaptureButton := j;
ButtonDown(j, X, Y);
end
else
begin
if PtInRect(NewTrackArea, Point(X, Y))
then
case Kind of
sbHorizontal:
begin
if X < Buttons[THUMB].R.Left
then
begin
Position := Position - LargeChange;
TimerMode := 3;
SetTimer(Handle, 1, 500, nil);
end
else
begin
Position := Position + LargeChange;
TimerMode := 4;
SetTimer(Handle, 1, 500, nil);
end;
end;
sbVertical:
begin
if Y < Buttons[THUMB].R.Top
then
begin
Position := Position - LargeChange;
TimerMode := 3;
SetTimer(Handle, 1, 500, nil);
end
else
begin
Position := Position + LargeChange;
TimerMode := 4;
SetTimer(Handle, 1, 500, nil);
end;
end;
end;
end;
end;
procedure TspSkinScrollBar.MouseUp;
begin
inherited;
MouseD := False;
if (TimerMode >= 3) then StopTimer;
if CaptureButton <> -1
then ButtonUp(CaptureButton, X, Y);
CaptureButton := -1;
if (Button = mbLeft) and Assigned(FOnLastChange)
then
FOnLastChange(Self);
end;
function TspSkinScrollBar.CalcValue;
var
kf: Double;
TempPos: Integer;
begin
if FPageSize = 0
then
begin
if (Offset2 - Offset1) <= 0
then kf := 0
else kf := AOffset / (Offset2 - Offset1);
if kf > 1 then kf := 1 else
if kf < 0 then kf := 0;
Result := FMin + Round((FMax - FMin) * kf);
end
else
begin
case Kind of
sbVertical:
begin
Offset1 := NewTrackArea.Top + RectHeight(Buttons[THUMB].R) div 2;
Offset2 := NewTrackArea.Bottom - RectHeight(Buttons[THUMB].R) div 2;
end;
sbHorizontal:
begin
Offset1 := NewTrackArea.Left + RectWidth(Buttons[THUMB].R) div 2;
Offset2 := NewTrackArea.Right - RectWidth(Buttons[THUMB].R) div 2;
end;
end;
TempPos := OldBOffset + AOffset;
if (Offset2 - Offset1) <= 0
then kf := 0
else kf := TempPos / (Offset2 - Offset1);
if kf > 1 then kf := 1 else
if kf < 0 then kf := 0;
Result := FMin + Round((FMax - FMin - FPageSize + 1) * kf);
end;
end;
procedure TspSkinScrollBar.MouseMove;
var
Off: Integer;
begin
MX := X; MY := Y;
TestActive(X, Y);
if FDown
then
case Kind of
sbVertical:
begin
if PageSize = 0
then
begin
Off := Y - OMPos;
Off := OldBOffset + Off;
Position := CalcValue(Off);
end
else
Off := Y - OMPos;
Position := CalcValue(Off);
end;
sbHorizontal:
begin
if PageSize = 0
then
begin
Off := X - OMPos;
Off := OldBOffset + Off;
Position := CalcValue(Off);
end
else
Off := X - OMPos;
Position := CalcValue(Off);
end;
end;
inherited;
end;
procedure TspSkinScrollBar.ButtonDown;
begin
Buttons[i].Down := True;
RePaint;
case i of
THUMB:
with Buttons[THUMB] do
begin
if Kind = sbVertical then OMPos := Y else OMPos := X;
OldBOffset := BOffset;
OldPosition := Position;
case Kind of
sbHorizontal:
begin
FScrollWidth := NewTrackArea.Right - R.Right;
if FScrollWidth <= 0
then FScrollWidth := R.Left - NewTrackArea.Left;
end;
sbVertical:
begin
FScrollWidth := NewTrackArea.Bottom - R.Bottom;
if FScrollWidth <= 0
then FScrollWidth := R.Top - NewTrackArea.Top;
end;
end;
FDown := True;
RePaint;
end;
DOWNBUTTON:
with Buttons[UPBUTTON] do
begin
if Assigned(FOnDownButtonClick)
then
FOnDownButtonClick(Self)
else
Position := Position - SmallChange;
TimerMode := 1;
SetTimer(Handle, 1, 500, nil);
end;
UPBUTTON:
with Buttons[DOWNBUTTON] do
begin
if Assigned(FOnUpButtonClick)
then
FOnUpButtonClick(Self)
else
Position := Position + SmallChange;
TimerMode := 2;
SetTimer(Handle, 1, 500, nil);
end;
end;
end;
procedure TspSkinScrollBar.ButtonUp;
begin
Buttons[i].Down := False;
if ActiveButton <> i then Buttons[i].MouseIn := False;
RePaint;
case i of
THUMB:
begin
FDown := False;
end;
UPBUTTON:
with Buttons[UPBUTTON] do
begin
StopTimer;
end;
DOWNBUTTON:
with Buttons[DOWNBUTTON] do
begin
StopTimer;
end;
end;
end;
procedure TspSkinScrollBar.ButtonEnter(I: Integer);
begin
Buttons[i].MouseIn := True;
RePaint;
case i of
THUMB:
with Buttons[THUMB] do
begin
end;
UPBUTTON:
with Buttons[UPBUTTON] do
begin
if Down then SetTimer(Handle, 1, 50, nil);
end;
DOWNBUTTON:
with Buttons[DOWNBUTTON] do
begin
if Down then SetTimer(Handle, 1, 50, nil);
end;
end;
end;
procedure TspSkinScrollBar.ButtonLeave(I: Integer);
begin
Buttons[i].MouseIn := False;
RePaint;
case i of
THUMB:
with Buttons[THUMB] do
begin
end;
UPBUTTON:
with Buttons[UPBUTTON] do
begin
if Down then KillTimer(Handle, 1);
end;
DOWNBUTTON:
with Buttons[DOWNBUTTON] do
begin
if Down then KillTimer(Handle, 1);
end;
end;
end;
procedure TspSkinScrollBar.StartScroll;
begin
KillTimer(Handle, 1);
SetTimer(Handle, 1, 50, nil);
end;
procedure TspSkinScrollBar.WMTimer;
var
CanScroll: Boolean;
begin
inherited;
if WaitMode
then
begin
WaitMode := False;
StartScroll;
Exit;
end;
case TimerMode of
1:
begin
if Assigned(FOnDownButtonClick)
then
FOnDownButtonClick(Self)
else
Position := Position - SmallChange;
end;
2:
begin
if Assigned(FOnUpButtonClick)
then
FOnUpButtonClick(Self)
else
Position := Position + SmallChange;
end;
3:
begin
TestActive(MX, MY);
case Kind of
sbHorizontal: CanScroll := MX < Buttons[THUMB].R.Left;
sbVertical: CanScroll := MY < Buttons[THUMB].R.Top;
end;
if CanScroll
then
Position := Position - LargeChange
else
StopTimer;
end;
4:
begin
TestActive(MX, MY);
case Kind of
sbHorizontal: CanScroll := MX > Buttons[THUMB].R.Right;
sbVertical: CanScroll := MY > Buttons[THUMB].R.Bottom;
end;
if CanScroll
then
Position := Position + LargeChange
else
StopTimer;
end;
end;
end;
procedure TspSkinScrollBar.CMMouseLeave;
begin
inherited;
if (ActiveButton <> -1) and (CaptureButton = -1) and not FDown
then
begin
Buttons[ActiveButton].MouseIn := False;
RePaint;
ActiveButton := -1;
end;
if MouseD and (TimerMode > 3) then StopTimer;
end;
procedure TspSkinScrollBar.CMMouseEnter;
begin
inherited;
end;
constructor TspSkinSplitter.Create(AOwner: TComponent);
begin
inherited;
ControlStyle := ControlStyle + [csOpaque];
FSkinPicture := nil;
FIndex := -1;
FDefaultSize := 10;
FSkinDataName := 'vsplitter';
end;
destructor TspSkinSplitter.Destroy;
begin
inherited;
end;
procedure TspSkinSplitter.Paint;
var
Buffer: TBitMap;
begin
if (Width <= 0) or (Height <= 0) then Exit;
ControlStyle := ControlStyle - [csOpaque];
GetSkinData;
if (FIndex <> -1) and (Align <> alNone) and (Align <> alClient)
then
begin
Buffer := TBitMap.Create;
if (Align = alTop) or (Align = alBottom)
then
CreateHSkinImage(LTPt.X, RectWidth(SkinRect) - RtPt.X,
Buffer, FSkinPicture, SkinRect, Width, RectHeight(SkinRect))
else
CreateVSkinImage(LTPt.Y, RectHeight(SkinRect) - LBPt.Y,
Buffer, FSkinPicture, SkinRect, RectWidth(SkinRect), Height);
Canvas.Draw(0, 0, Buffer);
Buffer.Free;
end
else
inherited;
ControlStyle := ControlStyle + [csOpaque];
end;
procedure TspSkinSplitter.Notification;
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (AComponent = FSD) then FSD := nil;
end;
procedure TspSkinSplitter.GetSkinData;
begin
if (FSD = nil) or FSD.Empty
then
FIndex := -1
else
FIndex := FSD.GetControlIndex(FSkinDataName);
FSkinPicture := nil;
if FIndex <> -1
then
if TspDataSkinControl(FSD.CtrlList.Items[FIndex]) is TspDataSkinSplitterControl
then
with TspDataSkinSplitterControl(FSD.CtrlList.Items[FIndex]) do
begin
LTPt := LTPoint;
RTPt := RTPoint;
LBPt := LBPoint;
Self.SkinRect := SkinRect;
if (PictureIndex <> -1) and (PictureIndex < FSD.FActivePictures.Count)
then
FSkinPicture := TBitMap(FSD.FActivePictures.Items[PictureIndex])
else
FSkinPicture := nil;
end;
end;
procedure TspSkinSplitter.ChangeSkinData;
begin
GetSkinData;
if (Align = alTop) or (Align = alBottom)
then
begin
if FIndex = -1
then
MinSize := FDefaultSize
else
MinSize := RectHeight(SkinRect);
Height := MinSize;
end
else
begin
if FIndex = -1
then
MinSize := FDefaultSize
else
MinSize := RectWidth(SkinRect);
Width := MinSize;
end;
RePaint;
end;
procedure TspSkinSplitter.SetSkinData;
begin
FSD := Value;
ChangeSkinData;
end;
constructor TspSkinControlBar.Create(AOwner: TComponent);
begin
inherited;
FSkinPicture := nil;
FIndex := -1;
if (csDesigning in ComponentState)
then
begin
AutoSize := True;
AutoDrag := False;
RowSnap := False;
end;
FSkinDataName := 'controlbar';
end;
destructor TspSkinControlBar.Destroy;
begin
inherited;
end;
procedure TspSkinControlBar.Notification;
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (AComponent = FSD) then FSD := nil;
end;
procedure TspSkinControlBar.WMSIZE;
begin
inherited;
GetSkinData;
if (FIndex <> -1) and FSkinBevel then PaintNCSkin;
end;
procedure TspSkinControlBar.SetSkinBevel;
begin
FSkinBevel := Value;
if FIndex <> -1 then RecreateWnd;
end;
procedure TspSkinControlBar.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);
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 TspSkinControlBar.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 TspSkinControlBar.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);
//
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 TspSkinControlBar.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 TspDataSkinControl(FSD.CtrlList.Items[FIndex]) is TspDataSkinControlBar
then
with TspDataSkinControlBar(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 TspSkinControlBar.ChangeSkinData;
var
R: TRect;
begin
GetSkinData;
if FSkinBevel
then
begin
ReCreateWnd;
R := ClientRect;
AdjustClientRect(R);
end
else
RePaint;
end;
procedure TspSkinControlBar.SetSkinData;
begin
FSD := Value;
ChangeSkinData;
end;
procedure TspSkinControlBar.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 TspSkinControlBar.WMNCPAINT(var Message: TMessage);
begin
GetSkinData;
if FIndex <> -1
then
begin
if FSkinBevel then PaintNCSkin;
end
else
inherited;
end;
procedure TspSkinControlBar.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 TspSkinControlBar.WMEraseBkgnd;
begin
GetSkinData;
if FIndex = -1 then inherited else Message.Result := 1;
end;
{ TspGroupButton }
type
TspGroupButton = class(TspSkinCheckRadioBox)
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: TspSkinCustomRadioGroup);
destructor Destroy; override;
end;
TspCheckGroupButton = class(TspSkinCheckRadioBox)
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: TspSkinCustomCheckGroup);
destructor Destroy; override;
end;
constructor TspGroupButton.InternalCreate(RadioGroup: TspSkinCustomRadioGroup);
begin
inherited Create(RadioGroup);
FFlat := True;
FDefaultWidth := 0;
FDefaultHeight := 0;
RadioGroup.FButtons.Add(Self);
Visible := False;
Enabled := RadioGroup.Enabled;
ParentShowHint := False;
OnClick := RadioGroup.ButtonClick;
Parent := RadioGroup;
Radio := True;
CanFocused := True;
SkinDataName := 'radiobox';
GroupIndex := 1;
end;
destructor TspGroupButton .Destroy;
begin
TspSkinCustomRadioGroup(Owner).FButtons.Remove(Self);
inherited Destroy;
end;
procedure TspGroupButton .CNCommand(var Message: TWMCommand);
begin
if not FInClick then
begin
FInClick := True;
try
if ((Message.NotifyCode = BN_CLICKED) or
(Message.NotifyCode = BN_DOUBLECLICKED)) and
TspSkinCustomRadioGroup(Parent).CanModify then
inherited;
except
Application.HandleException(Self);
end;
FInClick := False;
end;
end;
procedure TspGroupButton .KeyPress(var Key: Char);
begin
inherited KeyPress(Key);
TspSkinCustomRadioGroup(Parent).KeyPress(Key);
if (Key = #8) or (Key = ' ') then
begin
if not TspSkinCustomRadioGroup(Parent).CanModify then Key := #0;
end;
end;
procedure TspGroupButton .KeyDown(var Key: Word; Shift: TShiftState);
begin
inherited KeyDown(Key, Shift);
TspSkinCustomRadioGroup(Parent).KeyDown(Key, Shift);
end;
constructor TspCheckGroupButton.InternalCreate(CheckGroup: TspSkinCustomCheckGroup);
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 TspCheckGroupButton .Destroy;
begin
TspSkinCustomCheckGroup(Owner).FButtons.Remove(Self);
inherited Destroy;
end;
function TspSkinCustomCheckGroup.CanModify: Boolean;
begin
Result := True;
end;
procedure TspSkinCustomCheckGroup.GetChildren(Proc: TGetChildProc; Root: TComponent);
begin
end;
procedure TspCheckGroupButton .CNCommand(var Message: TWMCommand);
begin
if not FInClick then
begin
FInClick := True;
try
if ((Message.NotifyCode = BN_CLICKED) or
(Message.NotifyCode = BN_DOUBLECLICKED)) and
TspSkinCustomCheckGroup(Parent).CanModify then
inherited;
except
Application.HandleException(Self);
end;
FInClick := False;
end;
end;
procedure TspCheckGroupButton.KeyPress(var Key: Char);
begin
inherited KeyPress(Key);
TspSkinCustomCheckGroup(Parent).KeyPress(Key);
if (Key = #8) or (Key = ' ') then
begin
if not TspSkinCustomCheckGroup(Parent).CanModify then Key := #0;
end;
end;
procedure TspCheckGroupButton.KeyDown(var Key: Word; Shift: TShiftState);
begin
inherited KeyDown(Key, Shift);
TspSkinCustomCheckGroup(Parent).KeyDown(Key, Shift);
end;
{ TspSkinCustomRadioGroup }
constructor TspSkinCustomRadioGroup.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';
end;
destructor TspSkinCustomRadioGroup.Destroy;
begin
SetButtonCount(0);
TStringList(FItems).OnChange := nil;
FItems.Free;
FButtons.Free;
inherited Destroy;
end;
procedure TspSkinCustomRadioGroup.ChangeSkinData;
begin
inherited;
Self.ArrangeButtons;
end;
procedure TspSkinCustomRadioGroup.SetSkinData;
var
I: Integer;
begin
inherited;
if FButtons.Count > 0
then
for I := 0 to FButtons.Count - 1 do
with TspGroupButton (FButtons[I]) do
SkinData := Value;
end;
procedure TspSkinCustomRadioGroup.SetButtonSkinDataName;
var
I: Integer;
begin
FButtonSkinDataName := Value;
if FButtons.Count > 0
then
for I := 0 to FButtons.Count - 1 do
with TspGroupButton (FButtons[I]) do
SkinDataName := Value;
end;
procedure TspSkinCustomRadioGroup.FlipChildren(AllLevels: Boolean);
begin
{ The radio buttons are flipped using BiDiMode }
end;
procedure TspSkinCustomRadioGroup.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 TspGroupButton (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 TspSkinCustomRadioGroup.ButtonClick(Sender: TObject);
begin
if not FUpdating then
begin
FItemIndex := FButtons.IndexOf(Sender);
Changed;
Click;
end;
end;
procedure TspSkinCustomRadioGroup.ItemsChange(Sender: TObject);
begin
if not FReading then
begin
if FItemIndex >= FItems.Count then FItemIndex := FItems.Count - 1;
UpdateButtons;
end;
end;
procedure TspSkinCustomRadioGroup.Loaded;
begin
inherited Loaded;
ArrangeButtons;
end;
procedure TspSkinCustomRadioGroup.ReadState(Reader: TReader);
begin
FReading := True;
inherited ReadState(Reader);
FReading := False;
UpdateButtons;
end;
procedure TspSkinCustomRadioGroup.SetButtonCount(Value: Integer);
var
i: Integer;
begin
while FButtons.Count < Value do TspGroupButton .InternalCreate(Self);
while FButtons.Count > Value do TspGroupButton (FButtons.Last).Free;
if FButtons.Count > 0
then
for I := 0 to FButtons.Count - 1 do
with TspGroupButton (FButtons[I]) do
begin
SkinData := Self.SkinData;
SkinDataName := ButtonSkinDataName;
end;
end;
procedure TspSkinCustomRadioGroup.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 TspSkinCustomRadioGroup.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
TspGroupButton (FButtons[FItemIndex]).Checked := False;
FItemIndex := Value;
if FItemIndex >= 0 then
TspGroupButton (FButtons[FItemIndex]).Checked := True;
end;
end;
end;
procedure TspSkinCustomRadioGroup.SetItems(Value: TStrings);
begin
FItems.Assign(Value);
end;
procedure TspSkinCustomRadioGroup.UpdateButtons;
var
I: Integer;
begin
SetButtonCount(FItems.Count);
for I := 0 to FButtons.Count - 1 do
TspGroupButton (FButtons[I]).Caption := FItems[I];
if FItemIndex >= 0 then
begin
FUpdating := True;
TspGroupButton (FButtons[FItemIndex]).Checked := True;
FUpdating := False;
end;
ArrangeButtons;
Invalidate;
end;
procedure TspSkinCustomRadioGroup.CMEnabledChanged(var Message: TMessage);
var
I: Integer;
begin
inherited;
for I := 0 to FButtons.Count - 1 do
TspGroupButton(FButtons[I]).Enabled := Enabled;
end;
procedure TspSkinCustomRadioGroup.CMFontChanged(var Message: TMessage);
begin
inherited;
ArrangeButtons;
end;
procedure TspSkinCustomRadioGroup.WMSize(var Message: TWMSize);
begin
inherited;
ArrangeButtons;
end;
function TspSkinCustomRadioGroup.CanModify: Boolean;
begin
Result := True;
end;
procedure TspSkinCustomRadioGroup.GetChildren(Proc: TGetChildProc; Root: TComponent);
begin
end;
constructor TspSkinCustomTreeView.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;
end;
destructor TspSkinCustomTreeView.Destroy;
begin
FDefaultFont.Free;
inherited;
end;
procedure TspSkinCustomTreeView.CMVisibleChanged;
begin
inherited;
if FVScrollBar <> nil then FVScrollBar.Visible := Self.Visible;
if FHScrollBar <> nil then FHScrollBar.Visible := Self.Visible;
end;
procedure TspSkinCustomTreeView.Loaded;
begin
inherited;
ChangeSkinData;
end;
procedure TspSkinCustomTreeView.SetDefaultColor;
begin
FDefaultColor := Value;
if FIndex = -1 then Color := Value;
end;
procedure TspSkinCustomTreeView.SetDefaultFont;
begin
FDefaultFont.Assign(Value);
if FIndex = -1 then Font.Assign(Value);
end;
procedure TspSkinCustomTreeView.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 TspDataSkinControl(FSD.CtrlList.Items[FIndex]) is
TspDataSkinTreeView
then
with TspDataSkinTreeView(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;
UpDateScrollBars;
end;
procedure TspSkinCustomTreeView.SetSkinData;
begin
FSD := Value;
if (FSD <> nil) then
if not FSD.Empty and not (csDesigning in ComponentState)
then
ChangeSkinData;
end;
procedure TspSkinCustomTreeView.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 TspSkinCustomTreeView.Change;
begin
inherited;
UpDateScrollBars;
end;
procedure TspSkinCustomTreeView.WMNCCALCSIZE;
begin
end;
procedure TspSkinCustomTreeView.WMNCPAINT;
begin
end;
procedure TspSkinCustomTreeView.SetVScrollBar;
begin
FVScrollBar := Value;
if FVScrollBar <> nil
then
with FVScrollBar do
begin
Enabled := True;
Visible := False;
OnChange := OnVScrollBarChange;
end;
UpDateScrollBars;
end;
procedure TspSkinCustomTreeView.SetHScrollBar;
begin
FHScrollBar := Value;
if FHScrollBar <> nil
then
with FHScrollBar do
begin
Enabled := True;
Visible := False;
OnChange := OnHScrollBarChange;
end;
UpDateScrollBars;
end;
procedure TspSkinCustomTreeView.WndProc;
begin
inherited;
case Message.Msg of
WM_SIZE:
if not FInCheckScrollBars then UpDateScrollBars;
WM_PAINT, WM_KEYDOWN, WM_LBUTTONUP:
UpDateScrollBars;
end;
end;
procedure TspSkinCustomTreeView.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 TspSkinCustomTreeView.OnVScrollBarChange;
begin
SendMessage(Handle, WM_VSCROLL,
MakeWParam(SB_THUMBPOSITION, FVSCROLLBAR.Position), 0);
end;
procedure TspSkinCustomTreeView.OnHScrollBarChange;
begin
SendMessage(Handle, WM_HSCROLL,
MakeWParam(SB_THUMBPOSITION, FHSCROLLBAR.Position), 0);
end;
procedure TspSkinCustomTreeView.CreateParams;
begin
inherited;
with Params do
Style := Style and not (WS_HSCROLL or WS_VSCROLL);
end;
constructor TspSkinCustomListView.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';
end;
destructor TspSkinCustomListView.Destroy;
begin
FDefaultFont.Free;
if FHeaderHandle <> 0 then
SetWindowLong(FHeaderHandle, GWL_WNDPROC, LongInt(FDefHeaderProc));
FreeObjectInstance(FHeaderInstance);
FHeaderHandle := 0;
inherited;
end;
procedure TspSkinCustomListView.HGetSkinData;
begin
if (FSD = nil) or FSD.Empty
then
FHIndex := -1
else
FHIndex := FSD.GetControlIndex(FHeaderSkinDataName);
if FHIndex <> -1
then
if TspDataSkinControl(FSD.CtrlList.Items[FHIndex]) is TspDataSkinButtonControl
then
with TspDataSkinButtonControl(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 TspSkinCustomListView.CreateWnd;
begin
inherited;
end;
procedure TspSkinCustomListView.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, SP_XP_BTNFRAMECOLOR, SP_XP_BTNFRAMECOLOR, 1);
Brush.Color := SP_XP_BTNDOWNCOLOR;
end
else
if Active
then
begin
Frame3D(B.Canvas, BR, SP_XP_BTNFRAMECOLOR, SP_XP_BTNFRAMECOLOR, 1);
Brush.Color := SP_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;
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 TspSkinCustomListView.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 TspSkinCustomListView.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);
end;
end;
procedure TspSkinCustomListView.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 TspSkinCustomListView.CMVisibleChanged;
begin
inherited;
if FVScrollBar <> nil then FVScrollBar.Visible := Self.Visible;
if FHScrollBar <> nil then FHScrollBar.Visible := Self.Visible;
end;
procedure TspSkinCustomListView.SetDefaultColor;
begin
FDefaultColor := Value;
if FIndex = -1 then Color := Value;
end;
procedure TspSkinCustomListView.Loaded;
begin
ChangeSkinData;
end;
procedure TspSkinCustomListView.ChangeSkinData;
begin
if (FSD = nil) or FSD.Empty
then
FIndex := -1
else
FIndex := FSD.GetControlIndex(FSkinDataName);
if FIndex <> -1
then
begin
if TspDataSkinControl(FSD.CtrlList.Items[FIndex]) is
TspDataSkinListView
then
with TspDataSkinListView(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 := FDefaultFont;
end;
UpDateScrollBars;
if FVScrollBar <> nil then FVScrollBar.Align := FVScrollBar.Align;
if FHScrollBar <> nil then FHScrollBar.Align := FHScrollBar.Align;
end;
procedure TspSkinCustomListView.SetDefaultFont;
begin
FDefaultFont.Assign(Value);
if FIndex = -1 then Font.Assign(Value);
end;
procedure TspSkinCustomListView.SetSkinData;
begin
FSD := Value;
if (FSD <> nil) then
if not FSD.Empty and not (csDesigning in ComponentState)
then
ChangeSkinData;
end;
procedure TspSkinCustomListView.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 TspSkinCustomListView.WMNCCALCSIZE;
begin
end;
procedure TspSkinCustomListView.WMNCPAINT;
begin
end;
procedure TspSkinCustomListView.SetVScrollBar;
begin
FVScrollBar := Value;
if FVScrollBar <> nil
then
with FVScrollBar do
begin
Enabled := True;
Visible := False;
OnChange := OnVScrollBarChange;
end;
UpDateScrollBars;
end;
procedure TspSkinCustomListView.SetHScrollBar;
begin
FHScrollBar := Value;
if FHScrollBar <> nil
then
with FHScrollBar do
begin
Enabled := True;
Visible := False;
OnChange := OnHScrollBarChange;
end;
UpDateScrollBars;
end;
procedure TspSkinCustomListView.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 TspSkinCustomListView.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 TspSkinCustomListView.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 TspSkinCustomListView.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 > 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 := 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 TspSkinCustomListView.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 TspSkinCustomListView.OnVScrollBarChange;
begin
FromSB := True;
if (ViewStyle = vsIcon) or (ViewStyle = vsSmallIcon)
then
Scroll(0, FVSCROLLBAR.Position - FOldVScrollBarPos)
else
Scroll(0, (FVSCROLLBAR.Position - FOldVScrollBarPos) * Font.Height);
FOldVScrollBarPos := FVSCROLLBAR.Position;
FromSB := False;
end;
{procedure TspSkinCustomListView.OnVScrollBarChange;
var
i: Integer;
begin
FromSB := True;
if (ViewStyle = vsIcon) or (ViewStyle = vsSmallIcon)
then
Scroll(0, FVSCROLLBAR.Position - FOldVScrollBarPos)
else
begin
if FOldVScrollBarPos > FVSCROLLBAR.Position
then
begin
for i := 1 to FOldVScrollBarPos - FVSCROLLBAR.Position do
SendMessage(Handle, WM_VSCROLL,
MakeWParam(SB_LINEUP, 0) , 0)
end
else
begin
for i := 1 to FVSCROLLBAR.Position - FOldVScrollBarPos do
SendMessage(Handle, WM_VSCROLL,
MakeWParam(SB_LINEDOWN, 0) , 0);
end;
end;
FOldVScrollBarPos := FVSCROLLBAR.Position;
FromSB := False;
end;}
procedure TspSkinCustomListView.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 TspSkinCustomListView.CreateParams;
begin
inherited;
with Params do
Style := Style and not (WS_HSCROLL or WS_VSCROLL);
end;
constructor TspSkinStatusPanel.Create;
begin
inherited;
FGlyph := TBitMap.Create;
FNumGlyphs := 2;
FSkinDataName := 'statuspanel';
end;
destructor TspSkinStatusPanel.Destroy;
begin
FGlyph.Free;
inherited;
end;
procedure TspSkinStatusPanel.CMEnabledChanged;
begin
inherited;
RePaint;
end;
procedure TspSkinStatusPanel.SetNumGlyphs;
begin
FNumGlyphs := Value;
RePaint;
end;
procedure TspSkinStatusPanel.SetGlyph;
begin
FGlyph.Assign(Value);
RePaint;
end;
procedure TspSkinStatusPanel.CreateControlDefaultImage;
var
R: TRect;
GW: Integer;
GlyphNum: Integer;
begin
R := ClientRect;
with B.Canvas do
begin
Brush.Color := clBtnFace;
FillRect(R);
end;
case FBorderStyle of
bvLowered:
Frame3D(B.Canvas, R, clBtnShadow, clBtnHighLight, 1);
bvRaised:
Frame3D(B.Canvas, R, clBtnHighLight, clBtnShadow, 1);
bvFrame:
Frame3D(B.Canvas, R, clBtnShadow, clBtnShadow, 1);
end;
R := Rect(3, 3, Width - 3, Height - 3);
if not FGlyph.Empty
then
begin
GW := FGlyph.Width div FNumGlyphs;
Inc(R.Left, GW + 2);
if Enabled then GlyphNum := 1 else GlyphNum := 2;
DrawGlyph(B.Canvas, 3, B.Height div 2 - FGlyph.Height div 2, Glyph, NumGlyphs, GlyphNum);
end;
DrawLabelText(B.Canvas, R);
end;
procedure TspSkinStatusPanel.CreateControlSkinImage;
var
R: TRect;
GlyphNum, GX, GY, GW: Integer;
begin
CreateSkinControlImage(B, Picture, SkinRect);
R := NewClRect;
if not FGlyph.Empty
then
begin
GW := FGlyph.Width div FNumGlyphs;
GX := R.Left;
GY := R.Top + RectHeight(R) div 2 - FGlyph.Height div 2;
if Enabled then GlyphNum := 1 else GlyphNum := 2;
DrawGlyph(B.Canvas, GX, GY, Glyph, NumGlyphs, GlyphNum);
Inc(R.Left, GW + 2);
end;
DrawLabelText(B.Canvas, R);
end;
constructor TspSkinRichEdit.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 TspSkinRichEdit.Destroy;
begin
FDefaultFont.Free;
inherited;
end;
procedure TspSkinRichEdit.Change;
begin
inherited;
UpDateScrollBars;
end;
procedure TspSkinRichEdit.SetDefaultColor;
begin
FDefaultColor := Value;
if (FIndex = -1) and FSkinSupport then Color := Value;
end;
procedure TspSkinRichEdit.SetDefaultFont;
begin
FDefaultFont.Assign(Value);
if (FIndex = -1) and FSkinSupport then Font.Assign(Value);
end;
procedure TspSkinRichEdit.Loaded;
begin
ChangeSkinData;
end;
procedure TspSkinRichEdit.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 TspDataSkinControl(FSD.CtrlList.Items[FIndex]) is
TspDataSkinRichEdit
then
with TspDataSkinRichEdit(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;
UpDateScrollBars;
if FVScrollBar <> nil then FVScrollBar.Align := FVScrollBar.Align;
if FHScrollBar <> nil then FHScrollBar.Align := FHScrollBar.Align;
end;
procedure TspSkinRichEdit.SetSkinData;
begin
FSD := Value;
if (FSD <> nil) then
if not FSD.Empty and not (csDesigning in ComponentState)
then
ChangeSkinData;
end;
procedure TspSkinRichEdit.Notification;
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (AComponent = FSD) then FSD := nil;
end;
procedure TspSkinRichEdit.WMNCCALCSIZE;
begin
end;
procedure TspSkinRichEdit.WMNCPAINT;
begin
inherited;
end;
procedure TspSkinRichEdit.SetVScrollBar;
begin
FVScrollBar := Value;
if FVScrollBar <> nil
then
with FVScrollBar do
begin
OnChange := OnVScrollBarChange;
OnUpButtonClick := OnVScrollBarUpButtonClick;
OnDownButtonClick := OnVScrollBarDownButtonClick;
end;
UpDateScrollBars;
end;
procedure TspSkinRichEdit.SetHScrollBar;
begin
FHScrollBar := Value;
if FHScrollBar <> nil
then
with FHScrollBar do
begin
OnChange := OnHScrollBarChange;
end;
UpDateScrollBars;
end;
procedure TspSkinRichEdit.WndProc;
begin
inherited;
case Message.Msg of
WM_SIZE, WM_KEYDOWN, WM_LBUTTONUP, WM_LBUTTONDOWN:
UpDateScrollBars;
end;
end;
procedure TspSkinRichEdit.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);
FVScrollBar.RePaint;
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);
FHScrollBar.RePaint;
end
else
begin
FHScrollBar.Enabled := False;
SetScrollRange(Handle, SB_HORZ, 0, 0, False);
end;
end;
end;
procedure TspSkinRichEdit.OnVScrollBarChange;
begin
SendMessage(Handle, WM_VSCROLL,
MakeWParam(SB_THUMBPOSITION, FVSCROLLBAR.Position), 0);
end;
procedure TspSkinRichEdit.OnVScrollBarUpButtonClick;
begin
if FVScrollBar.Position < FVScrollBar.Max - FVScrollBar.PageSize + 1
then
SendMessage(Handle, WM_VSCROLL,
MakeWParam(SB_LINEDOWN, FVSCROLLBAR.Position), 0);
UpDateScrollBars;
end;
procedure TspSkinRichEdit.OnVScrollBarDownButtonClick;
begin
if FVScrollBar.Position <> 0
then
SendMessage(Handle, WM_VSCROLL,
MakeWParam(SB_LINEUP, FVSCROLLBAR.Position), 0);
UpDateScrollBars;
end;
procedure TspSkinRichEdit.OnHScrollBarChange;
begin
SendMessage(Handle, WM_HSCROLL,
MakeWParam(SB_THUMBPOSITION, FHSCROLLBAR.Position), 0);
end;
procedure TspSkinRichEdit.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 TspGraphicSkinControl.Create;
begin
inherited Create(AOwner);
FSD := nil;
FAreaName := '';
FIndex := -1;
FDrawDefault := True;
CursorIndex := -1;
FAlphaBlend := False;
FAlphaBlendValue := 200;
FUseSkinCursor := False;
end;
destructor TspGraphicSkinControl.Destroy;
begin
inherited Destroy;
end;
procedure TspGraphicSkinControl.SetAlphaBlend;
begin
FAlphaBlend := AValue;
RePaint;
end;
procedure TspGraphicSkinControl.SetAlphaBlendValue;
begin
FAlphaBlendValue := AValue;
RePaint;
end;
procedure TspGraphicSkinControl.CMMouseEnter;
begin
inherited;
if Assigned(FOnMouseEnter) then FOnMouseEnter(Self);
end;
procedure TspGraphicSkinControl.CMMouseLeave;
begin
inherited;
if Assigned(FOnMouseLeave) then FOnMouseLeave(Self);
end;
procedure TspGraphicSkinControl.WMEraseBkGnd;
begin
end;
procedure TspGraphicSkinControl.WMMOVE;
begin
inherited;
if AlphaBlend then RePaint;
end;
procedure TspGraphicSkinControl.BeforeChangeSkinData;
begin
FIndex := -1;
end;
procedure TspGraphicSkinControl.ChangeSkinData;
begin
GetSkinData;
if FUseSkinCursor
then
if CursorIndex <> -1
then
Cursor := FSD.StartCursorIndex + CursorIndex
else
Cursor := crDefault;
RePaint;
end;
procedure TspGraphicSkinControl.SetSkinData;
begin
FSD := Value;
if (FSD <> nil) then
if not FSD.Empty and not (csDesigning in ComponentState)
then
ChangeSkinData;
end;
procedure TspGraphicSkinControl.GetSkinData;
begin
if (FSD = nil) or FSD.Empty
then
FIndex := -1
else
FIndex := FSD.GetControlIndex(FSkinDataName);
end;
procedure TspGraphicSkinControl.Paint;
var
Buffer: TBitMap;
ParentImage: TBitMap;
PBuffer, PIBuffer: TspEffectBmp;
kf: Double;
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
if FDrawDefault
then
CreateControlDefaultImage(Buffer);
if FAlphaBlend
then
begin
ParentImage := TBitMap.Create;
ParentImage.Width := Width;
ParentImage.Height := Height;
GetParentImage2(Self, ParentImage.Canvas);
PBuffer := TspEffectBmp.CreateFromhWnd(Buffer.Handle);
PIBuffer := TspEffectBmp.CreateFromhWnd(ParentImage.Handle);
kf := 1 - FAlphaBlendValue / 255;
PBuffer.Morph(PIBuffer, Kf);
PBuffer.Draw(Canvas.Handle, 0, 0);
PBuffer.Free;
PIBuffer.Free;
ParentImage.Free;
end
else
Canvas.Draw(0, 0, Buffer);
Buffer.Free;
end;
procedure TspGraphicSkinControl.CreateControlDefaultImage;
begin
end;
procedure TspGraphicSkinControl.CreateControlSkinImage;
begin
end;
procedure TspGraphicSkinControl.Notification;
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (AComponent = FSD) then FSD := nil;
end;
constructor TspGraphicSkinCustomControl.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 TspGraphicSkinCustomControl.Destroy;
begin
FDefaultFont.Free;
inherited Destroy;
end;
procedure TspGraphicSkinCustomControl.SetDefaultWidth;
begin
FDefaultWidth := Value;
if (FIndex = -1) and (FDefaultWidth > 0) then Width := FDefaultWidth;
end;
procedure TspGraphicSkinCustomControl.SetDefaultHeight;
begin
FDefaultHeight := Value;
if (FIndex = -1) and (FDefaultHeight > 0) then Height := FDefaultHeight;
end;
procedure TspGraphicSkinCustomControl.DefaultFontChange;
begin
end;
procedure TspGraphicSkinCustomControl.SetDefaultFont;
begin
FDefaultFont.Assign(Value);
DefaultFontChange;
end;
procedure TspGraphicSkinCustomControl.OnDefaultFontChange;
begin
DefaultFontChange;
if FIndex = -1 then RePaint;
end;
procedure TspGraphicSkinCustomControl.CreateControlDefaultImage;
var
R: TRect;
begin
with B.Canvas do
begin
Brush.Color := clBtnFace;
R := ClientRect;
FillRect(R);
end;
end;
procedure TspGraphicSkinCustomControl.ChangeSkinData;
var
W, H: Integer;
UpDate: Boolean;
begin
GetSkinData;
if FUseSkinCursor
then
if CursorIndex <> -1
then
Cursor := FSD.StartCursorIndex + CursorIndex
else
Cursor := crDefault;
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 TspGraphicSkinCustomControl.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 TspGraphicSkinCustomControl.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 TspGraphicSkinCustomControl.CreateControlSkinImage;
begin
CreateSkinControlImage(B, Picture, SkinRect);
end;
procedure TspGraphicSkinCustomControl.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 TspGraphicSkinCustomControl.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 TspGraphicSkinCustomControl.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 TspGraphicSkinCustomControl.GetSkinData;
begin
inherited;
if FIndex <> -1
then
if TspDataSkinControl(FSD.CtrlList.Items[FIndex]) is TspDataSkinCustomControl
then
with TspDataSkinCustomControl(FSD.CtrlList.Items[FIndex]) do
begin
LTPt := LTPoint;
RTPt := RTPoint;
LBPt := LBPoint;
RBPt := RBPoint;
Self.SkinRect := SkinRect;
Self.ClRect := ClRect;
Self.CursorIndex := CursorIndex;
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;
constructor TspSkinSpeedButton.Create;
begin
inherited;
ControlStyle := [csCaptureMouse, csDoubleClicks, csOpaque];
RepeatTimer := nil;
FRepeatMode := False;
FRepeatInterval := 100;
FSkinDataName := 'toolbutton';
FDown := False;
FMouseDown := False;
FMouseIn := False;
Width := 75;
Height := 25;
FGroupIndex := 0;
FGlyph := TBitMap.Create;
FNumGlyphs := 2;
FMargin := -1;
FSpacing := 1;
FLayout := blGlyphLeft;
FMorphKf := 0;
MorphTimer := nil;
Morphing := False;
FMorphKf := 0;
FAllowAllUp := False;
FAllowAllUpCheck := False;
end;
destructor TspSkinSpeedButton.Destroy;
begin
FGlyph.Free;
StopMorph;
inherited;
end;
procedure TspSkinSpeedButton.RepeatTimerProc;
begin
ButtonClick;
end;
procedure TspSkinSpeedButton.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 TspSkinSpeedButton.StopRepeat;
begin
RepeatTimer.Enabled := False;
RepeatTimer.Free;
RepeatTimer := nil;
end;
procedure TspSkinSpeedButton.CMEnabledChanged;
begin
inherited;
if Morphing
then
begin
StopMorph;
FMorphKf := 0;
end;
FMouseIn := False;
RePaint;
end;
procedure TspSkinSpeedButton.SetFlat;
begin
FFlat := Value;
if Value
then ControlStyle := ControlStyle - [csOpaque]
else ControlStyle := ControlStyle + [csOpaque];
RePaint;
end;
procedure TspSkinSpeedButton.StartMorph;
begin
if MorphTimer <> nil then Exit;
MorphTimer := TTimer.Create(Self);
MorphTimer.Interval := MorphTimerInterval;
MorphTimer.OnTimer := DoMorph;
MorphTimer.Enabled := True;
end;
procedure TspSkinSpeedButton.StopMorph;
begin
if MorphTimer = nil then Exit;
MorphTimer.Free;
MorphTimer := nil;
end;
procedure TspSkinSpeedButton.ButtonClick;
begin
if Assigned(FOnClick) then FOnClick(Self);
end;
procedure TspSkinSpeedButton.ChangeSkinData;
begin
StopMorph;
inherited;
if Morphing and (FIndex <> -1) and FMouseIn
then
FMorphKf := 1;
end;
procedure TspSkinSpeedButton.SetGroupIndex;
begin
FGroupIndex := Value;
end;
procedure TspSkinSpeedButton.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 TspSkinSpeedButton.ReDrawControl;
begin
if Morphing and (FIndex <> -1)
then StartMorph
else RePaint;
end;
procedure TspSkinSpeedButton.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 + 0.1;
RePaint;
end
else
if not FMouseIn and (FMorphKf > 0)
then
begin
FMorphKf := FMorphKf - 0.1;
RePaint;
end
else
begin
if FMouseIn then FMorphKf := 1 else FMorphKf := 0;
StopMorph;
RePaint;
end;
end;
procedure TspSkinSpeedButton.SetLayout;
begin
if FLayout <> Value
then
begin
FLayout := Value;
RePaint;
end;
end;
procedure TspSkinSpeedButton.SetSpacing;
begin
if Value <> FSpacing
then
begin
FSpacing := Value;
RePaint;
end;
end;
procedure TspSkinSpeedButton.SetMargin;
begin
if (Value <> FMargin) and (Value >= -1)
then
begin
FMargin := Value;
RePaint;
end;
end;
procedure TspSkinSpeedButton.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 TspSkinSpeedButton.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 TspSkinSpeedButton) and
(PC.Controls[i] <> Self)
then
with TspSkinSpeedButton(PC.Controls[i]) do
if (GroupIndex = Self.GroupIndex) and
(GroupIndex <> 0) and FDown
then
Down := False;
end;
procedure TspSkinSpeedButton.SetGlyph;
begin
FGlyph.Assign(Value);
RePaint;
end;
procedure TspSkinSpeedButton.SetNumGlyphs;
begin
FNumGlyphs := Value;
RePaint;
end;
procedure TspSkinSpeedButton.GetSkinData;
begin
inherited;
if FIndex <> -1
then
begin
if TspDataSkinControl(FSD.CtrlList.Items[FIndex]) is TspDataSkinButtonControl
then
with TspDataSkinButtonControl(FSD.CtrlList.Items[FIndex]) do
begin
Self.FontName := FontName;
Self.FontColor := FontColor;
Self.ActiveFontColor := ActiveFontColor;
Self.DownFontColor := DownFontColor;
Self.FontStyle := FontStyle;
Self.FontHeight := FontHeight;
Self.ActiveSkinRect := ActiveSkinRect;
Self.DownSkinRect := DownSkinRect;
Self.Morphing := Morphing;
Self.MorphKind := MorphKind;
if IsNullRect(ActiveSkinRect) then Self.ActiveSkinRect := SkinRect;
if IsNullRect(DownSkinRect) then Self.DownSkinRect := Self.ActiveSkinRect;
if FFlat and Morphing then Self.Morphing := False;
Self.DisabledSkinRect := DisabledSkinRect;
Self.DisabledFontColor := DisabledFontColor;
end;
end
else
begin
Morphing := False;
end;
end;
procedure TspSkinSpeedButton.CreateButtonImage(B: TBitMap; R: TRect;
ADown, AMouseIn: Boolean);
function GetGlyphNum: Integer;
begin
if ADown and AMouseIn and (FNumGlyphs > 2)
then
Result := 3
else
if AMouseIn and (FNumGlyphs > 3)
then
Result := 4
else
if not Enabled and (FNumGlyphs > 1)
then
Result := 2
else
Result := 1;
end;
begin
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;
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;
DrawGlyphAndText(B.Canvas,
NewClRect, FMargin, FSpacing, FLayout,
Caption, FGlyph, FNumGlyphs, GetGlyphNum, ADown and AMouseIn);
end;
procedure TspSkinSpeedButton.CreateControlDefaultImage;
function GetGlyphNum: Integer;
begin
if FDown and FMouseIn and (FNumGlyphs > 2)
then
Result := 3
else
if FMouseIn and (FNumGlyphs > 3)
then
Result := 4
else
if not Enabled and (FNumGlyphs > 1)
then
Result := 2
else
Result := 1;
end;
var
R: TRect;
IsDown: Boolean;
begin
inherited;
IsDown := False;
R := ClientRect;
if FDown and ((FMouseIn and (GroupIndex = 0)) or (GroupIndex <> 0))
then
begin
Frame3D(B.Canvas, R, SP_XP_BTNFRAMECOLOR, SP_XP_BTNFRAMECOLOR, 1);
B.Canvas.Brush.Color := SP_XP_BTNDOWNCOLOR;
B.Canvas.FillRect(R);
IsDown := True;
end
else
if FMouseIn
then
begin
Frame3D(B.Canvas, R, SP_XP_BTNFRAMECOLOR, SP_XP_BTNFRAMECOLOR, 1);
B.Canvas.Brush.Color := SP_XP_BTNACTIVECOLOR;
B.Canvas.FillRect(R);
end
else
begin
Frame3D(B.Canvas, R, clBtnShadow, clBtnShadow, 1);
B.Canvas.Brush.Color := clBtnFace;
B.Canvas.FillRect(R);
end;
B.Canvas.Font.Assign(FDefaultFont);
if not Enabled then B.Canvas.Font.Color := clBtnShadow;
DrawGlyphAndText(B.Canvas,
ClientRect, FMargin, FSpacing, FLayout,
Caption, FGlyph, FNumGlyphs, GetGlyphNum, IsDown);
end;
procedure TspSkinSpeedButton.CreateControlSkinImage;
begin
end;
procedure TspSkinSpeedButton.Paint;
function GetGlyphNum: Integer;
begin
if FDown and FMouseIn and (FNumGlyphs > 2)
then
Result := 3
else
if FMouseIn and (FNumGlyphs > 3)
then
Result := 4
else
if not Enabled and (FNumGlyphs > 1)
then
Result := 2
else
Result := 1;
end;
var
PBuffer, APBuffer, PIBuffer: TspEffectBmp;
ParentImage, Buffer, ABuffer: TBitMap;
kf: Double;
begin
GetSkinData;
if FIndex = -1
then
begin
if FDown and (((FMouseIn and (GroupIndex = 0)) or (GroupIndex <> 0)))
then
inherited
else
if FMouseIn
then
inherited
else
if FFlat
then
begin
Canvas.Font.Assign(FDefaultFont);
DrawGlyphAndText(Canvas,
ClientRect, FMargin, FSpacing, FLayout,
Caption, FGlyph, FNumGlyphs, GetGlyphNum, False);
end
else
inherited;
end
else
if FFlat and not FMouseIn and not (FDown and (FGroupIndex <> 0))
then
begin
with Canvas.Font do
begin
Name := FontName;
Style := FontStyle;
if Self.Enabled
then
Color := FontColor
else
Color := DisabledFontColor;
Height := FontHeight;
end;
DrawGlyphAndText(Canvas,
NewClRect, FMargin, FSpacing, FLayout,
Caption, FGlyph, FNumGlyphs, GetGlyphNum, False);
end
else
begin
Buffer := TBitMap.Create;
Buffer.Width := Width;
Buffer.Height := Height;
ParentImage := nil;
if FAlphaBlend
then
begin
ParentImage := TBitMap.Create;
ParentImage.Width := Width;
ParentImage.Height := Height;
GetParentImage2(Self, ParentImage.Canvas);
PIBuffer := TspEffectBmp.CreateFromhWnd(ParentImage.Handle);
kf := 1 - FAlphaBlendValue / 255;
end;
if Morphing and (FMorphKf <> 1) and (FMorphKf <> 0) and Enabled
then
begin
ABuffer := TBitMap.Create;
ABuffer.Width := Width;
ABuffer.Height := Height;
CreateButtonImage(Buffer, SkinRect, False, False);
CreateButtonImage(ABuffer, ActiveSkinRect, False, True);
PBuffer := TspEffectBmp.CreateFromhWnd(Buffer.Handle);
APBuffer := TspEffectBmp.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;
if FAlphaBlend then PBuffer.Morph(PIBuffer, Kf);
PBuffer.Draw(Canvas.Handle, 0, 0);
PBuffer.Free;
APBuffer.Free;
ABuffer.Free;
end
else
begin
if (not Enabled) and not IsNullRect(DisabledSkinRect)
then
CreateButtonImage(Buffer, DisabledSkinRect, False, False)
else
if FDown and ((FMouseIn and (GroupIndex = 0)) or (GroupIndex <> 0))
then
CreateButtonImage(Buffer, DownSkinRect, True, True)
else
if FMouseIn or (not FMouseIn and Morphing and (FMorphKf = 1))
then
CreateButtonImage(Buffer, ActiveSkinRect, False, True)
else
CreateButtonImage(Buffer, SkinRect, False, False);
if FAlphaBlend
then
begin
PBuffer := TspEffectBmp.CreateFromhWnd(Buffer.Handle);
PBuffer.Morph(PIBuffer, Kf);
PBuffer.Draw(Canvas.Handle, 0, 0);
PBuffer.Free;
end
else
Canvas.Draw(0, 0, Buffer);
end;
if FAlphaBlend
then
begin
PIBuffer.Free;
ParentImage.Free;
end;
Buffer.Free;
end;
end;
procedure TspSkinSpeedButton.CMTextChanged;
begin
if (FIndex <> -1) or
(csDesigning in ComponentState) or DrawDefault
then
RePaint;
end;
procedure TspSkinSpeedButton.CMMouseEnter(var Message: TMessage);
var
CanPaint: Boolean;
begin
inherited;
FMouseIn := True;
CanPaint := ((GroupIndex <> 0) and not FDown) or (GroupIndex = 0);
if CanPaint
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 TspSkinSpeedButton.CMMouseLeave(var Message: TMessage);
var
CanPaint: Boolean;
begin
inherited;
FMouseIn := False;
CanPaint := ((GroupIndex <> 0) and not FDown) or (GroupIndex = 0);
if CanPaint
then ReDrawControl;
if FDown and RepeatMode and (GroupIndex = 0) then StopRepeat;
end;
procedure TspSkinSpeedButton.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 TspSkinSpeedButton.MouseUp;
begin
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;
inherited;
end;
//==============TspSkinMenuSpeedButton==========//
constructor TspSkinMenuSpeedButton.Create;
begin
inherited;
FSkinDataName := 'menubutton';
FTrackButtonMode := False;
FMenuTracked := False;
FSkinPopupMenu := nil;
end;
destructor TspSkinMenuSpeedButton.Destroy;
begin
inherited;
end;
procedure TspSkinMenuSpeedButton.Paint;
var
R: TRect;
begin
GetSkinData;
if not FMouseIn and not FDown and not FMenuTracked and FFlat
then
begin
if FIndex = -1
then
begin
R := ClientRect;
Dec(R.Right, 15);
end
else
R := NewClRect;
Canvas.Font.Assign(FDefaultFont);
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 TspSkinMenuSpeedButton.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 TspSkinMenuSpeedButton.CreateControlDefaultImage;
var
R, R1: TRect;
isDown: Boolean;
begin
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 := SP_XP_BTNACTIVECOLOR;
B.Canvas.FillRect(R);
Frame3D(B.Canvas, R, SP_XP_BTNFRAMECOLOR, SP_XP_BTNFRAMECOLOR, 1);
B.Canvas.Brush.Color := SP_XP_BTNDOWNCOLOR;
B.Canvas.FillRect(R1);
Frame3D(B.Canvas, R1, SP_XP_BTNFRAMECOLOR, SP_XP_BTNFRAMECOLOR, 1);
end
else
begin
if FDown and FMouseIn
then
begin
Frame3D(B.Canvas, R, SP_XP_BTNFRAMECOLOR, SP_XP_BTNFRAMECOLOR, 1);
B.Canvas.Brush.Color := SP_XP_BTNDOWNCOLOR;
B.Canvas.FillRect(R);
Frame3D(B.Canvas, R1, SP_XP_BTNFRAMECOLOR, SP_XP_BTNFRAMECOLOR, 1);
B.Canvas.Brush.Color := SP_XP_BTNDOWNCOLOR;
B.Canvas.FillRect(R1);
isDown := True;
end
else
if FMouseIn
then
begin
Frame3D(B.Canvas, R, SP_XP_BTNFRAMECOLOR, SP_XP_BTNFRAMECOLOR, 1);
B.Canvas.Brush.Color := SP_XP_BTNACTIVECOLOR;
B.Canvas.FillRect(R);
Frame3D(B.Canvas, R1, SP_XP_BTNFRAMECOLOR, SP_XP_BTNFRAMECOLOR, 1);
B.Canvas.Brush.Color := SP_XP_BTNACTIVECOLOR;
B.Canvas.FillRect(R1);
end
else
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
end;
end
else
begin
if FDown and FMouseIn
then
begin
Frame3D(B.Canvas, R, SP_XP_BTNFRAMECOLOR, SP_XP_BTNFRAMECOLOR, 1);
B.Canvas.Brush.Color := SP_XP_BTNDOWNCOLOR;
B.Canvas.FillRect(R);
IsDown := True;
end
else
if FMouseIn
then
begin
Frame3D(B.Canvas, R, SP_XP_BTNFRAMECOLOR, SP_XP_BTNFRAMECOLOR, 1);
B.Canvas.Brush.Color := SP_XP_BTNACTIVECOLOR;
B.Canvas.FillRect(R);
end
else
begin
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 not Enabled then B.Canvas.Font.Color := clBtnShadow;
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 TspSkinMenuSpeedButton.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 TspSkinMenuSpeedButton.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 TspSkinMenuSpeedButton.WMCLOSESKINMENU;
begin
FMenuTracked := False;
Down := False;
if Assigned(FOnHideTrackMenu) then FOnHideTrackMenu(Self);
end;
procedure TspSkinMenuSpeedButton.TrackMenu;
var
R: TRect;
P: TPoint;
begin
if FSkinPopupMenu = nil then Exit;
if Morphing then FMorphKf := 1;
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 TspSkinMenuSpeedButton.Notification;
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (AComponent = FSkinPopupMenu)
then FSkinPopupMenu := nil;
end;
procedure TspSkinMenuSpeedButton.CMMouseEnter(var Message: TMessage);
begin
if not FMenuTracked then inherited else FMouseIn := True;
end;
procedure TspSkinMenuSpeedButton.CMMouseLeave(var Message: TMessage);
begin
if not FMenuTracked then inherited else FMouseIn := False;
end;
procedure TspSkinMenuSpeedButton.GetSkinData;
begin
inherited;
if FIndex <> -1
then
if TspDataSkinControl(FSD.CtrlList.Items[FIndex]) is TspDataSkinMenuButtonControl
then
with TspDataSkinMenuButtonControl(FSD.CtrlList.Items[FIndex]) do
begin
Self.TrackButtonRect := TrackButtonRect;
end;
end;
procedure TspSkinMenuSpeedButton.SetTrackButtonMode;
begin
FTrackButtonMode := Value;
if FIndex = - 1 then RePaint;
end;
procedure TspSkinMenuSpeedButton.MouseDown;
begin
if Button <> mbLeft
then
begin
inherited;
Exit;
end;
FMenuTracked := CanMenuTrack(X, Y);
if FMenuTracked
then
begin
if not FDown then Down := True;
TrackMenu;
end
else
inherited;
end;
procedure TspSkinMenuSpeedButton.MouseUp;
begin
if not FMenuTracked then inherited;
end;
constructor TspSkinTextLabel.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 TspSkinTextLabel.Destroy;
begin
FLines.Free;
FDefaultFont.Free;
inherited;
end;
procedure TspSkinTextLabel.SetDefaultFont;
begin
FDefaultFont.Assign(Value);
end;
procedure TspSkinTextLabel.Notification;
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (AComponent = FSD) then FSD := nil;
end;
procedure TspSkinTextLabel.GetSkinData;
begin
if (FSD = nil) or FSD.Empty
then
FIndex := -1
else
FIndex := FSD.GetControlIndex(FSkinDataName);
if FIndex <> -1
then
if TspDataSkinControl(FSD.CtrlList.Items[FIndex]) is TspDataSkinStdLabelControl
then
with TspDataSkinStdLabelControl(FSD.CtrlList.Items[FIndex]) do
begin
Self.FontName := FontName;
Self.FontStyle := FontStyle;
Self.FontHeight := FontHeight;
Self.FontColor := FontColor;
end;
end;
procedure TspSkinTextLabel.ChangeSkinData;
begin
GetSkinData;
if FAutoSize then AdjustBounds;
RePaint;
end;
procedure TspSkinTextLabel.SetSkinData;
begin
FSD := Value;
if (FSD <> nil) then ChangeSkinData;
end;
procedure TspSkinTextLabel.SetLines;
begin
FLines.Assign(Value);
if FAutoSize then AdjustBounds;
RePaint;
end;
function TspSkinTextLabel.GetLabelText: string;
begin
Result := FLines.Text;
end;
procedure TspSkinTextLabel.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 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
DrawText(Canvas.Handle, PChar(Text), Length(Text), Rect, Flags);
end;
procedure TspSkinTextLabel.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 TspSkinTextLabel.Loaded;
begin
inherited Loaded;
AdjustBounds;
end;
procedure TspSkinTextLabel.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 TspSkinTextLabel.SetAlignment(Value: TAlignment);
begin
if FAlignment <> Value then
begin
FAlignment := Value;
Invalidate;
end;
end;
procedure TspSkinTextLabel.SetAutoSize(Value: Boolean);
begin
if FAutoSize <> Value then
begin
FAutoSize := Value;
AdjustBounds;
end;
end;
procedure TspSkinTextLabel.SetLayout(Value: TTextLayout);
begin
if FLayout <> Value then
begin
FLayout := Value;
Invalidate;
end;
end;
procedure TspSkinTextLabel.SetWordWrap(Value: Boolean);
begin
if FWordWrap <> Value then
begin
FWordWrap := Value;
AdjustBounds;
Invalidate;
end;
end;
procedure TspSkinTextLabel.CMFontChanged(var Message: TMessage);
begin
inherited;
AdjustBounds;
Invalidate;
end;
// ======================== TspSkinExPanel ============================= //
constructor TspSkinExPanel.Create(AOwner: TComponent);
begin
inherited;
ControlStyle := [csAcceptsControls, csCaptureMouse, csClickEvents,
csSetCaption, csOpaque, csDoubleClicks, csReplicatable];
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;
procedure TspSkinExPanel.ChangeSkinData;
begin
inherited;
if FRollState
then
begin
if FRollKind = rkRollVertical
then Height := GetRollHeight
else Width := GetRollWidth;
end
else
ReAlign;
end;
procedure TspSkinExPanel.Close;
begin
Visible := False;
if not (csDesigning in ComponentState) and
Assigned(FOnClose)
then
FOnClose(Self);
end;
procedure TspSkinExPanel.GetSkinData;
begin
inherited;
if FIndex <> -1
then
if TspDataSkinControl(FSD.CtrlList.Items[FIndex]) is TspDataSkinExPanelControl
then
with TspDataSkinExPanelControl(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;