Delphi控件源码

开发平台：

Delphi

bsSkinBoxCtrls.pas：源码内容

R := ClientRect;
Frame3D(B.Canvas, R, clBtnShadow, clBtnShadow, 1);
if FCaptionMode
then
with B.Canvas do
begin
R := Rect(3, 2, Width - BW * 3 - 3, FDefaultCaptionHeight - 2);
Font.Assign(FDefaultCaptionFont);
if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
then
Font.Charset := SkinData.ResourceStrData.CharSet;
case Alignment of
taLeftJustify: TX := R.Left;
taCenter: TX := R.Left + RectWidth(R) div 2 - GetGlyphTextWidth div 2;
taRightJustify: TX := R.Right - GetGlyphTextWidth;
end;
TY := (FDefaultCaptionHeight - 2) div 2 - TextHeight(Caption) div 2;
if not FGlyph.Empty
then
begin
GY := R.Top + RectHeight(R) div 2 - FGlyph.Height div 2 - 1;
GX := TX;
if FNumGlyphs = 0 then FNumGlyphs := 1;
TX := GX + FGlyph.Width div FNumGlyphs + FSpacing;
GlyphNum := 1;
if not Enabled and (NumGlyphs = 2) then GlyphNum := 2;
end;
TextRect(R, TX, TY, Caption);
if not FGlyph.Empty
then DrawGlyph(B.Canvas, GX, GY, FGlyph, NumGlyphs, GlyphNum);
Pen.Color := clBtnShadow;
MoveTo(1, FDefaultCaptionHeight - 1); LineTo(Width - 1, FDefaultCaptionHeight - 1);
for i := 0 to 2 do DrawButton(B.Canvas, i);
end;
end;
procedure TbsSkinCheckListBox.CMMouseEnter;
begin
inherited;
if FCaptionMode
then
TestActive(-1, -1);
end;
procedure TbsSkinCheckListBox.CMMouseLeave;
var
i: Integer;
begin
inherited;
if FCaptionMode
then
for i := 0 to 1 do
if Buttons[i].MouseIn
then
begin
Buttons[i].MouseIn := False;
RePaint;
end;
end;
procedure TbsSkinCheckListBox.MouseDown;
begin
if FCaptionMode
then
begin
TestActive(X, Y);
if ActiveButton <> -1
then
begin
CaptureButton := ActiveButton;
ButtonDown(ActiveButton, X, Y);
end;
end;
inherited;
end;
procedure TbsSkinCheckListBox.MouseUp;
begin
if FCaptionMode
then
begin
if CaptureButton <> -1
then ButtonUp(CaptureButton, X, Y);
CaptureButton := -1;
end;
inherited;
end;
procedure TbsSkinCheckListBox.MouseMove;
begin
inherited;
if FCaptionMode then TestActive(X, Y);
end;
procedure TbsSkinCheckListBox.TestActive(X, Y: Integer);
var
i, j: Integer;
begin
if (FIndex <> -1) and IsNullRect(UpButtonRect) and IsNullRect(DownButtonRect)
then Exit;
j := -1;
OldActiveButton := ActiveButton;
for i := 0 to 2 do
begin
if PtInRect(Buttons[i].R, Point(X, Y))
then
begin
j := i;
Break;
end;
end;
ActiveButton := j;
if (CaptureButton <> -1) and
(ActiveButton <> CaptureButton) and (ActiveButton <> -1)
then
ActiveButton := -1;
if (OldActiveButton <> ActiveButton)
then
begin
if OldActiveButton <> - 1
then
ButtonLeave(OldActiveButton);
if ActiveButton <> -1
then
ButtonEnter(ActiveButton);
end;
end;
procedure TbsSkinCheckListBox.ButtonDown;
begin
Buttons[i].MouseIn := True;
Buttons[i].Down := True;
DrawButton(Canvas, i);
case i of
0: if Assigned(FOnUpButtonClick) then Exit;
1: if Assigned(FOnDownButtonClick) then Exit;
2: if Assigned(FOnCheckButtonClick) then Exit;
end;
TimerMode := 0;
case i of
0: TimerMode := 1;
1: TimerMode := 2;
end;
if TimerMode <> 0
then
begin
WaitMode := True;
SetTimer(Handle, 1, 500, nil);
end;
end;
procedure TbsSkinCheckListBox.ButtonUp;
begin
Buttons[i].Down := False;
if ActiveButton <> i then Buttons[i].MouseIn := False;
DrawButton(Canvas, i);
if Buttons[i].MouseIn
then
case i of
0:
if Assigned(FOnUpButtonClick)
then
begin
FOnUpButtonClick(Self);
Exit;
end;
1:
if Assigned(FOnDownButtonClick)
then
begin
FOnDownButtonClick(Self);
Exit;
end;
2:
if Assigned(FOnCheckButtonClick)
then
begin
FOnCheckButtonClick(Self);
Exit;
end;
end;
case i of
1: ItemIndex := ItemIndex + 1;
0: if ItemIndex > 0 then ItemIndex := ItemIndex - 1;
2: if ItemIndex > -1
then
begin
Checked[ItemIndex] := not Checked[ListBox.ItemIndex];
ListBoxOnClickCheck(Self);
end;
end;
if TimerMode <> 0 then StopTimer;
end;
procedure TbsSkinCheckListBox.ButtonEnter(I: Integer);
begin
Buttons[i].MouseIn := True;
DrawButton(Canvas, i);
if (TimerMode <> 0) and Buttons[i].Down
then SetTimer(Handle, 1, 50, nil);
end;
procedure TbsSkinCheckListBox.ButtonLeave(I: Integer);
begin
Buttons[i].MouseIn := False;
DrawButton(Canvas, i);
if (TimerMode <> 0) and Buttons[i].Down
then KillTimer(Handle, 1);
end;
procedure TbsSkinCheckListBox.CMTextChanged;
begin
inherited;
if FCaptionMode then RePaint;
end;
procedure TbsSkinCheckListBox.SetAlignment(Value: TAlignment);
begin
if FAlignment <> Value
then
begin
FAlignment := Value;
if FCaptionMode then RePaint;
end;
end;
procedure TbsSkinCheckListBox.DrawButton;
var
C: TColor;
kf: Double;
R1: TRect;
begin
if FIndex = -1
then
with Buttons[i] do
begin
R1 := R;
if Down and MouseIn
then
begin
Frame3D(Cnvs, R1, BS_XP_BTNFRAMECOLOR, BS_XP_BTNFRAMECOLOR, 1);
Cnvs.Brush.Color := BS_XP_BTNDOWNCOLOR;
Cnvs.FillRect(R1);
end
else
if MouseIn
then
begin
Frame3D(Cnvs, R1, BS_XP_BTNFRAMECOLOR, BS_XP_BTNFRAMECOLOR, 1);
Cnvs.Brush.Color := BS_XP_BTNACTIVECOLOR;
Cnvs.FillRect(R1);
end
else
begin
Cnvs.Brush.Color := clBtnFace;
Cnvs.FillRect(R1);
end;
C := clBlack;
case i of
0: DrawArrowImage(Cnvs, R, C, 3);
1: DrawArrowImage(Cnvs, R, C, 4);
2: DrawCheckImage(Cnvs, R.Left + 4, R.Top + 4, C);
end;
end
else
with Buttons[i] do
if not IsNullRect(R) then
begin
R1 := NullRect;
case I of
0:
begin
if Down and MouseIn
then R1 := DownUpButtonRect
else if MouseIn then R1 := ActiveUpButtonRect;
end;
1:
begin
if Down and MouseIn
then R1 := DownDownButtonRect
else if MouseIn then R1 := ActiveDownButtonRect;
end;
2: begin
if Down and MouseIn
then R1 := DownCheckButtonRect
else if MouseIn then R1 := ActiveCheckButtonRect;
end;
end;
if not IsNullRect(R1)
then
Cnvs.CopyRect(R, Picture.Canvas, R1)
else
begin
case I of
0: R1 := UpButtonRect;
1: R1 := DownButtonRect;
2: R1 := CheckButtonRect;
end;
OffsetRect(R1, SkinRect.Left, SkinRect.Top);
Cnvs.CopyRect(R, Picture.Canvas, R1);
end;
end;
end;
procedure TbsSkinCheckListBox.SetCaptionMode;
begin
FCaptionMode := Value;
if FIndex = -1
then
begin
CalcRects;
RePaint;
end;
end;
procedure TbsSkinCheckListBox.ListBoxOnClickCheck(Sender: TObject);
begin
if Assigned(FOnClickCheck) then FOnClickCheck(Self);
end;
procedure TbsSkinCheckListBox.SetChecked;
begin
ListBox.Checked[Index] := Checked;
end;
function TbsSkinCheckListBox.GetChecked;
begin
Result := ListBox.Checked[Index];
end;
procedure TbsSkinCheckListBox.SetState;
begin
ListBox.State[Index] := AState;
end;
function TbsSkinCheckListBox.GetState;
begin
Result := ListBox.State[Index];
end;
function TbsSkinCheckListBox.CalcHeight;
begin
if FIndex = -1
then
Result := AitemsCount * ListBox.ItemHeight + 4
else
Result := ClRect.Top + AitemsCount * ListBox.ItemHeight +
RectHeight(SkinRect) - ClRect.Bottom;
end;
procedure TbsSkinCheckListBox.Clear;
begin
ListBox.Clear;
end;
function TbsSkinCheckListBox.ItemAtPos(Pos: TPoint; Existing: Boolean): Integer;
begin
Result := ListBox.ItemAtPos(Pos, Existing);
end;
function TbsSkinCheckListBox.ItemRect(Item: Integer): TRect;
begin
Result := ListBox.ItemRect(Item);
end;
function TbsSkinCheckListBox.GetListBoxPopupMenu;
begin
Result := ListBox.PopupMenu;
end;
procedure TbsSkinCheckListBox.SetListBoxPopupMenu;
begin
ListBox.PopupMenu := Value;
end;
function TbsSkinCheckListBox.GetCanvas: TCanvas;
begin
Result := ListBox.Canvas;
end;
function TbsSkinCheckListBox.GetExtandedSelect: Boolean;
begin
Result := ListBox.ExtendedSelect;
end;
procedure TbsSkinCheckListBox.SetExtandedSelect(Value: Boolean);
begin
ListBox.ExtendedSelect := Value;
end;
function TbsSkinCheckListBox.GetSelCount: Integer;
begin
Result := ListBox.SelCount;
end;
function TbsSkinCheckListBox.GetSelected(Index: Integer): Boolean;
begin
Result := ListBox.Selected[Index];
end;
procedure TbsSkinCheckListBox.SetSelected(Index: Integer; Value: Boolean);
begin
ListBox.Selected[Index] := Value;
end;
function TbsSkinCheckListBox.GetSorted: Boolean;
begin
Result := ListBox.Sorted;
end;
procedure TbsSkinCheckListBox.SetSorted(Value: Boolean);
begin
if ScrollBar <> nil then HideScrollBar;
ListBox.Sorted := Value;
end;
function TbsSkinCheckListBox.GetTopIndex: Integer;
begin
Result := ListBox.TopIndex;
end;
procedure TbsSkinCheckListBox.SetTopIndex(Value: Integer);
begin
ListBox.TopIndex := Value;
end;
function TbsSkinCheckListBox.GetMultiSelect: Boolean;
begin
Result := ListBox.MultiSelect;
end;
procedure TbsSkinCheckListBox.SetMultiSelect(Value: Boolean);
begin
ListBox.MultiSelect := Value;
end;
function TbsSkinCheckListBox.GetListBoxFont: TFont;
begin
Result := ListBox.Font;
end;
procedure TbsSkinCheckListBox.SetListBoxFont(Value: TFont);
begin
ListBox.Font.Assign(Value);
end;
function TbsSkinCheckListBox.GetListBoxTabOrder: TTabOrder;
begin
Result := ListBox.TabOrder;
end;
procedure TbsSkinCheckListBox.SetListBoxTabOrder(Value: TTabOrder);
begin
ListBox.TabOrder := Value;
end;
function TbsSkinCheckListBox.GetListBoxTabStop: Boolean;
begin
Result := ListBox.TabStop;
end;
procedure TbsSkinCheckListBox.SetListBoxTabStop(Value: Boolean);
begin
ListBox.TabStop := Value;
end;
procedure TbsSkinCheckListBox.ShowScrollBar;
begin
ScrollBar := TbsSkinScrollBar.Create(Self);
with ScrollBar do
begin
if Columns > 0
then
Kind := sbHorizontal
else
Kind := sbVertical;
Height := 100;
Width := 20;
Parent := Self;
PageSize := 0;
Min := 0;
Position := 0;
OnChange := SBChange;
if Self.FIndex = -1
then
SkinDataName := ''
else
if Columns > 0
then
SkinDataName := HScrollBarName
else
SkinDataName := VScrollBarName;
SkinData := Self.SkinData;
Parent := Self;
CalcRects;
Visible := True;
end;
RePaint;
end;
procedure TbsSkinCheckListBox.ListBoxEnter;
begin
end;
procedure TbsSkinCheckListBox.ListBoxExit;
begin
end;
procedure TbsSkinCheckListBox.ListBoxKeyDown;
begin
if Assigned(FOnListBoxKeyDown) then FOnListBoxKeyDown(Self, Key, Shift);
end;
procedure TbsSkinCheckListBox.ListBoxKeyUp;
begin
if Assigned(FOnListBoxKeyUp) then FOnListBoxKeyUp(Self, Key, Shift);
end;
procedure TbsSkinCheckListBox.ListBoxKeyPress;
begin
if Assigned(FOnListBoxKeyPress) then FOnListBoxKeyPress(Self, Key);
end;
procedure TbsSkinCheckListBox.ListBoxDblClick;
begin
if Assigned(FOnListBoxDblClick) then FOnListBoxDblClick(Self);
end;
procedure TbsSkinCheckListBox.ListBoxClick;
begin
if Assigned(FOnListBoxClick) then FOnListBoxClick(Self);
end;
procedure TbsSkinCheckListBox.ListBoxMouseDown;
begin
if Assigned(FOnListBoxMouseDown) then FOnListBoxMouseDown(Self, Button, Shift, X, Y);
end;
procedure TbsSkinCheckListBox.ListBoxMouseMove;
begin
if Assigned(FOnListBoxMouseMove) then FOnListBoxMouseMove(Self, Shift, X, Y);
end;
procedure TbsSkinCheckListBox.ListBoxMouseUp;
begin
if Assigned(FOnListBoxMouseUp) then FOnListBoxMouseUp(Self, Button, Shift, X, Y);
end;
procedure TbsSkinCheckListBox.HideScrollBar;
begin
ScrollBar.Visible := False;
ScrollBar.Free;
ScrollBar := nil;
CalcRects;
end;
procedure TbsSkinCheckListBox.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
with Params do
begin
WindowClass.style := WindowClass.style and not (CS_HREDRAW or CS_VREDRAW);
end;
end;
procedure TbsSkinCheckListBox.SBChange;
var
LParam, WParam: Integer;
begin
LParam := 0;
WParam := MakeWParam(SB_THUMBPOSITION, ScrollBar.Position);
if Columns > 0
then
SendMessage(ListBox.Handle, WM_HSCROLL, WParam, LParam)
else
SendMessage(ListBox.Handle, WM_VSCROLL, WParam, LParam);
end;
function TbsSkinCheckListBox.GetItemIndex;
begin
Result := ListBox.ItemIndex;
end;
procedure TbsSkinCheckListBox.SetItemIndex;
begin
ListBox.ItemIndex := Value;
end;
procedure TbsSkinCheckListBox.SetItems;
begin
ListBox.Items.Assign(Value);
UpDateScrollBar;
end;
function TbsSkinCheckListBox.GetItems;
begin
Result := ListBox.Items;
end;
destructor TbsSkinCheckListBox.Destroy;
begin
if ScrollBar <> nil then ScrollBar.Free;
if ListBox <> nil then ListBox.Free;
FDefaultCaptionFont.Free;
FGlyph.Free;
inherited;
end;
procedure TbsSkinCheckListBox.CalcRects;
var
LTop: Integer;
OffX, OffY: Integer;
begin
if FIndex <> -1
then
begin
OffX := Width - RectWidth(SkinRect);
OffY := Height - RectHeight(SkinRect);
NewClRect := ClRect;
Inc(NewClRect.Right, OffX);
Inc(NewClRect.Bottom, OffY);
end
else
if FCaptionMode
then
LTop := FDefaultCaptionHeight
else
LTop := 1;
if (ScrollBar <> nil) and ScrollBar.Visible
then
begin
if FIndex = -1
then
begin
if Columns > 0
then
begin
ScrollBar.SetBounds(1, Height - 20, Width - 2, 19);
ListRect := Rect(2, LTop + 1, Width - 2, ScrollBar.Top);
end
else
begin
ScrollBar.SetBounds(Width - 20, LTop, 19, Height - 1 - LTop);
ListRect := Rect(2, LTop + 1, ScrollBar.Left, Height - 2);
end;
end
else
begin
if Columns > 0
then
begin
ScrollBar.SetBounds(NewClRect.Left,
NewClRect.Bottom - ScrollBar.Height,
RectWidth(NewClRect), ScrollBar.Height);
ListRect := NewClRect;
Dec(ListRect.Bottom, ScrollBar.Height);
end
else
begin
ScrollBar.SetBounds(NewClRect.Right - ScrollBar.Width,
NewClRect.Top, ScrollBar.Width, RectHeight(NewClRect));
ListRect := NewClRect;
Dec(ListRect.Right, ScrollBar.Width);
end;
end;
end
else
begin
if FIndex = -1
then
ListRect := Rect(2, LTop + 1, Width - 2, Height - 2)
else
ListRect := NewClRect;
end;
if ListBox <> nil
then
ListBox.SetBounds(ListRect.Left, ListRect.Top,
RectWidth(ListRect), RectHeight(ListRect));
end;
procedure TbsSkinCheckListBox.GetSkinData;
begin
inherited;
if FIndex <> -1
then
if TbsDataSkinControl(FSD.CtrlList.Items[FIndex]) is TbsDataSkinListBox
then
with TbsDataSkinCheckListBox(FSD.CtrlList.Items[FIndex]) do
begin
Self.FontName := FontName;
Self.FontStyle := FontStyle;
Self.FontHeight := FontHeight;
Self.SItemRect := SItemRect;
Self.ActiveItemRect := ActiveItemRect;
if isNullRect(ActiveItemRect)
then
Self.ActiveItemRect := SItemRect;
Self.FocusItemRect := FocusItemRect;
if isNullRect(FocusItemRect)
then
Self.FocusItemRect := SItemRect;
Self.UnCheckImageRect := UnCheckImageRect;
Self.CheckImageRect := CheckImageRect;
Self.ItemLeftOffset := ItemLeftOffset;
Self.ItemRightOffset := ItemRightOffset;
Self.ItemTextRect := ItemTextRect;
Self.ItemCheckRect := ItemCheckRect;
Self.FontColor := FontColor;
Self.ActiveFontColor := ActiveFontColor;
Self.FocusFontColor := FocusFontColor;
Self.VScrollBarName := VScrollBarName;
Self.HScrollBarName := HScrollBarName;
Self.CaptionRect := CaptionRect;
Self.CaptionFontName := CaptionFontName;
Self.CaptionFontStyle := CaptionFontStyle;
Self.CaptionFontHeight := CaptionFontHeight;
Self.CaptionFontColor := CaptionFontColor;
Self.UpButtonRect := UpButtonRect;
Self.ActiveUpButtonRect := ActiveUpButtonRect;
Self.DownUpButtonRect := DownUpButtonRect;
if IsNullRect(Self.DownUpButtonRect)
then Self.DownUpButtonRect := Self.ActiveUpButtonRect;
Self.DownButtonRect := DownButtonRect;
Self.ActiveDownButtonRect := ActiveDownButtonRect;
Self.DownDownButtonRect := DownDownButtonRect;
if IsNullRect(Self.DownDownButtonRect)
then Self.DownDownButtonRect := Self.ActiveDownButtonRect;
Self.CheckButtonRect := CheckButtonRect;
Self.ActiveCheckButtonRect := ActiveCheckButtonRect;
Self.DownCheckButtonRect := DownCheckButtonRect;
if IsNullRect(Self.DownCheckButtonRect)
then Self.DownCheckButtonRect := Self.ActiveCheckButtonRect;
end;
end;
procedure TbsSkinCheckListBox.ChangeSkinData;
begin
inherited;
//
if FIndex <> -1
then
begin
if FUseSkinItemHeight
then
ListBox.ItemHeight := RectHeight(sItemRect);
end
else
begin
ListBox.ItemHeight := FDefaultItemHeight;
Font.Assign(FDefaultFont);
end;
if ScrollBar <> nil
then
with ScrollBar do
begin
if Self.FIndex = -1
then
SkinDataName := ''
else
if Columns > 0
then
SkinDataName := HScrollBarName
else
SkinDataName := VScrollBarName;
SkinData := Self.SkinData;
end;
if FRowCount <> 0
then
Height := Self.CalcHeight(FRowCount);
CalcRects;
UpDateScrollBar;
ListBox.RePaint;
end;
procedure TbsSkinCheckListBox.WMSIZE;
begin
inherited;
CalcRects;
UpDateScrollBar;
if ScrollBar <> nil then ScrollBar.Repaint;
end;
procedure TbsSkinCheckListBox.SetBounds;
begin
inherited;
if FIndex = -1 then RePaint;
end;
procedure TbsSkinCheckListBox.UpDateScrollBar;
var
Min, Max, Pos, Page: Integer;
begin
if (ListBox = nil) or ((FRowCount > 0) and (RowCount = Items.Count))
then Exit;
if Columns > 0
then
begin
GetScrollRange(ListBox.Handle, SB_HORZ, Min, Max);
Pos := GetScrollPos(ListBox.Handle, SB_HORZ);
Page := ListBox.Columns;
if (Max > Min) and (Pos <= Max) and (Page <= Max)
then
begin
if ScrollBar = nil
then ShowScrollBar;
ScrollBar.SetRange(Min, Max, Pos, Page);
end
else
if (ScrollBar <> nil) and (ScrollBar.Visible) then HideScrollBar;
end
else
begin
if not ((FRowCount > 0) and (RowCount = Items.Count))
then
begin
GetScrollRange(ListBox.Handle, SB_VERT, Min, Max);
Pos := GetScrollPos(ListBox.Handle, SB_VERT);
Page := ListBox.Height div ListBox.ItemHeight;
if (Max > Min) and (Pos <= Max) and (Page < Items.Count)
then
begin
if ScrollBar = nil then ShowScrollBar;
ScrollBar.SetRange(Min, Max, Pos, Page);
ScrollBar.LargeChange := Page;
end
else
if (ScrollBar <> nil) and ScrollBar.Visible then HideScrollBar;
end
else
if (ScrollBar <> nil) and ScrollBar.Visible then HideScrollBar;
end;
end;
constructor TbsSkinScrollBox.Create(AOwner: TComponent);
begin
inherited;
ControlStyle := ControlStyle + [csAcceptsControls];
FInCheckScrollBars := False;
FVSizeOffset := 0;
FHSizeOffset := 0;
FVScrollBar := nil;
FHScrollBar := nil;
FOldVScrollBarPos := 0;
FOldHScrollBarPos := 0;
FDown := False;
FSkinDataName := 'scrollbox';
BGPictureIndex := -1;
Width := 150;
Height := 150;
end;
destructor TbsSkinScrollBox.Destroy;
begin
inherited;
end;
procedure TbsSkinScrollBox.UpDateScrollRange;
begin
GetHRange;
GetVRange;
end;
procedure TbsSkinScrollBox.CMVisibleChanged;
begin
inherited;
if FVScrollBar <> nil then FVScrollBar.Visible := Self.Visible;
if FHScrollBar <> nil then FHScrollBar.Visible := Self.Visible;
end;
procedure TbsSkinScrollBox.OnHScrollBarChange(Sender: TObject);
begin
HScrollControls(FHScrollBar.Position - FOldHScrollBarPos);
FOldHScrollBarPos := HScrollBar.Position;
end;
procedure TbsSkinScrollBox.OnVScrollBarChange(Sender: TObject);
begin
VScrollControls(FVScrollBar.Position - FOldVScrollBarPos);
FOldVScrollBarPos := VScrollBar.Position;
end;
procedure TbsSkinScrollBox.OnHScrollBarLastChange(Sender: TObject);
begin
Invalidate;
end;
procedure TbsSkinScrollBox.OnVScrollBarLastChange(Sender: TObject);
begin
Invalidate;
end;
procedure TbsSkinScrollBox.ChangeSkinData;
begin
inherited;
ReCreateWnd;
if FVScrollBar <> nil then FVScrollBar.Align := FVScrollBar.Align;
if FHScrollBar <> nil then FHScrollBar.Align := FHScrollBar.Align;
end;
procedure TbsSkinScrollBox.HScroll;
begin
if (FHScrollBar <> nil) and (FHScrollBar.PageSize <> 0)
then
with FHScrollBar do
begin
HScrollControls(APosition - Position);
Position := APosition;
end;
end;
procedure TbsSkinScrollBox.VScroll;
begin
if (FVScrollBar <> nil) and (FVScrollBar.PageSize <> 0)
then
with FVScrollBar do
begin
if APosition > Max - PageSize then APosition := Max - PageSize;
VScrollControls(APosition - Position);
Position := APosition;
end;
end;
procedure TbsSkinScrollBox.SetBorderStyle;
begin
FBorderStyle := Value;
ReCreateWnd;
end;
procedure TbsSkinScrollBox.GetSkinData;
begin
inherited;
BGPictureIndex := -1;
if FIndex <> -1
then
if TbsDataSkinControl(FSD.CtrlList.Items[FIndex]) is TbsDataSkinScrollBoxControl
then
with TbsDataSkinScrollBoxControl(FSD.CtrlList.Items[FIndex]) do
begin
Self.BGPictureIndex := BGPictureIndex;
end;
end;
procedure TbsSkinScrollBox.Notification;
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (AComponent = FHScrollBar)
then FHScrollBar := nil;
if (Operation = opRemove) and (AComponent = FVScrollBar)
then FVScrollBar := nil;
end;
procedure TbsSkinScrollBox.SetVScrollBar;
begin
FVScrollBar := Value;
if FVScrollBar <> nil
then
with FVScrollBar do
begin
CanFocused := False;
OnChange := OnVScrollBarChange;
OnLastChange := OnVScrollBarLastChange;
Enabled := True;
Visible := False;
end;
GetVRange;
end;
procedure TbsSkinScrollBox.SetHScrollBar;
begin
FHScrollBar := Value;
if FHScrollBar <> nil
then
with FHScrollBar do
begin
CanFocused := False;
Enabled := True;
Visible := False;
OnChange := OnHScrollBarChange;
OnLastChange := OnHScrollBarLastChange;
end;
GetHRange;
end;
procedure TbsSkinScrollBox.CreateControlDefaultImage;
var
R: TRect;
begin
with B.Canvas do
begin
Brush.Color := clBtnFace;
R := ClientRect;
FillRect(R);
end;
end;
type
TParentControl = class(TWinControl);
procedure TbsSkinScrollBox.GetVRange;
var
i, MaxBottom, H, Offset: Integer;
FMax: Integer;
VisibleChanged, IsVisible: Boolean;
R: TRect;
begin
if (FVScrollBar = nil) or FInCheckScrollBars or (Parent = nil) then Exit;
VisibleChanged := False;
H := ClientHeight;
MaxBottom := 0;
for i := 0 to ControlCount - 1 do
with Controls[i] do
begin
if Visible
then
if Top + Height > MaxBottom then MaxBottom := Top + Height;
end;
with FVScrollBar do
begin
FMax := MaxBottom + Position;
if FMax > H
then
begin
if not Visible
then
begin
IsVisible := True;
VisibleChanged := True;
end;
if (Position > 0) and (MaxBottom < H) and (FVSizeOffset > 0)
then
begin
if FVSizeOffset > Position then FVSizeOffset := Position;
SetRange(0, FMax - 1, Position - FVSizeOffset, H);
VScrollControls(- FVSizeOffset);
FVSizeOffset := 0;
FOldVScrollBarPos := Position;
end
else
begin
if (FVSizeOffset = 0) and ((FMax - 1) < Max) and (Position > 0) and
(MaxBottom < H)
then
begin
Offset := Max - (FMax - 1);
Offset := Offset + (Max - PageSize + 1) + Position;
if Offset > Position then Offset := Position;
VScrollControls(-Offset);
SetRange(0, FMax - 1, Position - OffSet, H);
end
else
SetRange(0, FMax - 1, Position, H);
FVSizeOffset := 0;
FOldVScrollBarPos := Position;
end;
end
else
begin
if Position > 0
then VScrollControls(-Position);
FVSizeOffset := 0;
FOldVScrollBarPos := 0;
SetRange(0, 0, 0, 0);
if Visible
then
begin
IsVisible := False;
VisibleChanged := True;
end;
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 VisibleChanged
then
begin
FInCheckScrollBars := True;
FVScrollBar.Visible := IsVisible;
FInCheckScrollBars := False;
if (Align <> alNone)
then
begin
FInCheckScrollBars := True;
R := Parent.ClientRect;
TParentControl(Parent).AlignControls(nil, R);
FInCheckScrollBars := False;
end;
end;
end;
procedure TbsSkinScrollBox.VScrollControls;
begin
ScrollBy(0, -AOffset);
end;
procedure TbsSkinScrollBox.AdjustClientRect(var Rect: TRect);
var
RLeft, RTop, VMax, HMax: Integer;
begin
if (VScrollbar <> nil) and VScrollbar.Visible
then
begin
RTop := -VScrollbar.Position;
VMax := Max(VScrollBar.Max, ClientHeight);
end
else
begin
RTop := 0;
VMax := ClientHeight;
end;
if (HScrollbar <> nil) and HScrollbar.Visible
then
begin
RLeft := -HScrollbar.Position;
HMax := Max(HScrollBar.Max, ClientWidth);
end
else
begin
RLeft := 0;
HMax := ClientWidth;
end;
Rect := Bounds(RLeft, RTop, HMax, VMax);
inherited AdjustClientRect(Rect);
end;
procedure TbsSkinScrollBox.GetHRange;
var
i, MaxRight, W, Offset: Integer;
FMax: Integer;
VisibleChanged, IsVisible: Boolean;
R: TRect;
begin
if (FHScrollBar = nil) or FInCheckScrollBars or (Parent = nil) then Exit;
VisibleChanged := False;
W := ClientWidth;
MaxRight := 0;
for i := 0 to ControlCount - 1 do
with Controls[i] do
begin
if Visible
then
if Left + Width > MaxRight then MaxRight := left + Width;
end;
with FHScrollBar do
begin
FMax := MaxRight + Position;
if FMax > W
then
begin
if not Visible
then
begin
IsVisible := True;
VisibleChanged := True;
end;
if (Position > 0) and (MaxRight < W) and (FHSizeOffset > 0)
then
begin
if FHSizeOffset > Position
then FHSizeOffset := Position;
SetRange(0, FMax - 1, Position - FHSizeOffset , W);
HScrollControls(-FHSizeOffset);
FOldHScrollBarPos := Position;
end
else
begin
if (FHSizeOffset = 0) and ((FMax - 1) < Max) and (Position > 0) and
(MaxRight < W)
then
begin
Offset := Max - (FMax - 1);
Offset := Offset + (Max - PageSize + 1) + Position;
if Offset > Position then Offset := Position;
HScrollControls(-Offset);
SetRange(0, FMax - 1, Position - Offset, W);
end
else
SetRange(0, FMax - 1, Position, W);
FHSizeOffset := 0;
FOldHScrollBarPos := Position;
end;
end
else
begin
if Position > 0
then HScrollControls(-Position);
FHSizeOffset := 0;
FOldHScrollBarPos := 0;
SetRange(0, 0, 0, 0);
if Visible
then
begin
IsVisible := False;
VisibleChanged := True;
end;
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 VisibleChanged
then
begin
FInCheckScrollBars := True;
FHScrollBar.Visible := IsVisible;
FInCheckScrollBars := False;
if (Align <> alNone)
then
begin
R := Parent.ClientRect;
TParentControl(Parent).AlignControls(nil, R);
end;
end;
end;
procedure TbsSkinScrollBox.HScrollControls;
begin
ScrollBy(-AOffset, 0);
end;
procedure TbsSkinScrollBox.WMWindowPosChanging;
begin
inherited;
if HandleAllocated and (Align = alNone)
then
begin
GetVRange;
GetHRange;
end;
end;
procedure TbsSkinScrollBox.SetBounds;
var
OldHeight, OldWidth: Integer;
begin
OldWidth := Width;
OldHeight := Height;
inherited;
if (OldWidth <> Width)
then
begin
if (OldWidth < Width) and (OldWidth <> 0)
then FHSizeOffset := Width - OldWidth
else FHSizeOffset := 0;
end
else
FHSizeOffset := 0;
if (OldHeight <> Height)
then
begin
if (OldHeight < Height) and (OldHeight <> 0)
then FVSizeOffset := Height - OldHeight
else FVSizeOffset := 0;
end
else
FVSizeOffset := 0;
if Align <> alNone
then
begin
GetVRange;
GetHRange;
end;
end;
procedure TbsSkinScrollBox.WMNCCALCSIZE;
begin
GetSkinData;
if (FIndex = -1) and (FBorderStyle <> bvNone)
then
with Message.CalcSize_Params^.rgrc[0] do
begin
if FBorderStyle <> bvNone
then
begin
Inc(Left, 1);
Inc(Top, 1);
Dec(Right, 1);
Dec(Bottom, 1);
end;
end
else
if (BGPictureIndex = -1) and (FBorderStyle <> bvNone) then
with 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);
end;
end;
procedure TbsSkinScrollBox.WMNCPAINT;
var
DC: HDC;
C: TCanvas;
R: TRect;
begin
if (BGPictureIndex <> -1) or (FBorderStyle = bvNone) then Exit;
DC := GetWindowDC(Handle);
C := TControlCanvas.Create;
C.Handle := DC;
try
PaintFrame(C);
finally
C.Free;
ReleaseDC(Handle, DC);
end;
end;
procedure TbsSkinScrollBox.PaintFrame;
var
NewLTPoint, NewRTPoint, NewLBPoint, NewRBPoint: TPoint;
R, NewClRect: TRect;
LeftB, TopB, RightB, BottomB: TBitMap;
OffX, OffY: Integer;
AW, AH: Integer;
begin
GetSkinData;
if (FIndex = -1)
then
with C do
begin
if FBorderStyle <> bvNone
then
begin
Brush.Style := bsClear;
R := Rect(0, 0, Width, Height);
case FBorderStyle of
bvLowered: Frame3D(C, R, clBtnHighLight, clBtnShadow, 1);
bvRaised: Frame3D(C, R, clBtnShadow, clBtnHighLight, 1);
bvFrame: Frame3D(C, R, clBtnShadow, clBtnShadow, 1);
end;
end;
Exit;
end;
LeftB := TBitMap.Create;
TopB := TBitMap.Create;
RightB := TBitMap.Create;
BottomB := TBitMap.Create;
OffX := Width - RectWidth(SkinRect);
OffY := Height - RectHeight(SkinRect);
AW := Width;
AH := Height;
NewLTPoint := LTPt;
NewRTPoint := Point(RTPt.X + OffX, RTPt.Y);
NewLBPoint := Point(LBPt.X, LBPt.Y + OffY);
NewRBPoint := Point(RBPt.X + OffX, RBPt.Y + OffY);
NewClRect := Rect(ClRect.Left, ClRect.Top,
ClRect.Right + OffX, ClRect.Bottom + OffY);
CreateSkinBorderImages(LTPt, RTPt, LBPt, RBPt, CLRect,
NewLtPoint, NewRTPoint, NewLBPoint, NewRBPoint, NewCLRect,
LeftB, TopB, RightB, BottomB, Picture, SkinRect, Width, Height,
False, False, False, False);
C.Draw(0, 0, TopB);
C.Draw(0, TopB.Height, LeftB);
C.Draw(Width - RightB.Width, TopB.Height, RightB);
C.Draw(0, Height - BottomB.Height, BottomB);
TopB.Free;
LeftB.Free;
RightB.Free;
BottomB.Free;
end;
procedure TbsSkinScrollBox.Paint;
var
X, Y, XCnt, YCnt, w, h,
rw, rh, XO, YO: Integer;
Buffer: TBitMap;
R: TRect;
begin
GetSkinData;
if FIndex = -1
then
begin
inherited;
Exit;
end;
if (ClientWidth > 0) and (ClientHeight > 0) then
if BGPictureIndex <> -1
then
begin
Buffer := TBitMap(FSD.FActivePictures.Items[BGPictureIndex]);
XCnt := Width div Buffer.Width;
YCnt := Height div Buffer.Height;
for X := 0 to XCnt do
for Y := 0 to YCnt do
Canvas.Draw(X * Buffer.Width, Y * Buffer.Height, Buffer);
end
else
begin
Buffer := TBitMap.Create;
Buffer.Width := ClientWidth;
Buffer.Height := ClientHeight;
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),
Picture.Canvas,
Rect(SkinRect.Left + ClRect.Left,
SkinRect.Top + ClRect.Top,
SkinRect.Left + ClRect.Right - XO,
SkinRect.Top + ClRect.Bottom - YO));
end;
Canvas.Draw(0, 0, Buffer);
Buffer.Free;
end;
end;
end;
procedure TbsSkinScrollBox.WMSIZE;
begin
inherited;
SendMessage(Handle, WM_NCPAINT, 0, 0);
end;
procedure TbsSkinScrollBox.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
with Params do
begin
WindowClass.style := WindowClass.style and not (CS_HREDRAW or CS_VREDRAW);
end;
end;
constructor TbsSkinTrackEdit.Create(AOwner: TComponent);
begin
inherited;
FPopupKind := tbpRight;
FTrackBarWidth := 0;
FTrackBarSkinDataName := 'htrackbar';
ButtonMode := True;
FMinValue := 0;
FMaxValue := 100;
FValue := 0;
StopCheck := True;
Text := '0';
StopCheck := False;
FromEdit := False;
Width := 120;
Height := 20;
FSkinDataName := 'buttonedit';
OnButtonClick := ButtonClick;
FAlphaBlend := False;
FAlphaBlendValue := 0;
FPopupTrackBar := TbsSkinPopupTrackBar.Create(Self);
FPopupTrackBar.Visible := False;
FPopupTrackBar.TrackEdit := Self;
FPopupTrackBar.Parent := Self;
FPopupTrackBar.OnChange := TrackBarChange;
end;
destructor TbsSkinTrackEdit.Destroy;
begin
FPopupTrackBar.Free;
inherited;
end;
function TbsSkinTrackEdit.GetJumpWhenClick: Boolean;
begin
Result := FPopupTrackBar.JumpWhenClick;
end;
procedure TbsSkinTrackEdit.SetJumpWhenClick(Value: Boolean);
begin
FPopupTrackBar.JumpWhenClick := Value;
end;
procedure TbsSkinTrackEdit.WMMOUSEWHEEL;
begin
if not FPopupTrackBar.Visible
then
begin
if Message.WParam > 0
then
Value := Value - 1
else
Value := Value + 1;
end
else
begin
if Message.WParam > 0
then
FPopupTrackBar.Value := FPopupTrackBar.Value - 1
else
FPopupTrackBar.Value := FPopupTrackBar.Value + 1;
end;
end;
procedure TbsSkinTrackEdit.CMCancelMode(var Message: TCMCancelMode);
begin
if (Message.Sender <> FPopupTrackBar) then CloseUp;
end;
procedure TbsSkinTrackEdit.CloseUp;
begin
if FPopupTrackbar.Visible
then
begin
SetWindowPos(FPopupTrackBar.Handle, 0, 0, 0, 0, 0, SWP_NOZORDER or
SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE or SWP_HIDEWINDOW);
FPopupTrackBar.Visible := False;
if CheckW2KWXP and FAlphaBlend
then
SetWindowLong(FPopupTrackBar.Handle, GWL_EXSTYLE,
GetWindowLong(Handle, GWL_EXSTYLE) and not WS_EX_LAYERED);
end;
end;
procedure TbsSkinTrackEdit.DropDown;
var
P: TPoint;
I, X, Y: Integer;
begin
with FPopupTrackBar do
begin
if FTrackBarWidth = 0
then
Width := Self.Width
else
Width := FTrackBarWidth;
DefaultHeight := Self.Height;
SkinDataName := FTrackBarSkinDataName;
SkinData := Self.SkinData;
MinValue := Self.MinValue;
MaxValue := Self.MaxValue;
Value := Self.Value;
end;
if (PopupKind = tbpRight) or (FPopupTrackBar.Width = Self.Width)
then
P := Parent.ClientToScreen(Point(Left, Top))
else
P := Parent.ClientToScreen(Point(Left + Width - FPopupTrackBar.Width, Top));
Y := P.Y + Height;
if P.X + FPopupTrackBar.Width > Screen.Width
then
P.X := P.X - ((P.X + FPopupTrackBar.Width) - Screen.Width)
else
if P.X < 0 then P.X := 0;
if Y + FPopupTrackBar.Height > Screen.Height
then
Y := P.Y - FPopupTrackBar.Height;
//
if CheckW2KWXP and FAlphaBlend
then
begin
SetWindowLong(FPopupTrackBar.Handle, GWL_EXSTYLE,
GetWindowLong(Handle, GWL_EXSTYLE) or WS_EX_LAYERED);
if FAlphaBlendAnimation
then
SetAlphaBlendTransparent(FPopupTrackBar.Handle, 0)
else
SetAlphaBlendTransparent(FPopupTrackBar.Handle, FAlphaBlendValue);
end;
//
SetWindowPos(FPopupTrackBar.Handle, HWND_TOP, P.X, Y, 0, 0,
SWP_NOSIZE or SWP_NOACTIVATE or SWP_SHOWWINDOW);
FPopupTrackBar.Visible := True;
if FAlphaBlendAnimation and FAlphaBlend and CheckW2KWXP
then
begin
Application.ProcessMessages;
I := 0;
repeat
Inc(i, 1);
if i > FAlphaBlendValue then i := FAlphaBlendValue;
SetAlphaBlendTransparent(FPopupTrackBar.Handle, i);
until i >= FAlphaBlendValue;
end;
end;
procedure TbsSkinTrackEdit.ButtonClick(Sender: TObject);
begin
SetFocus;
if not FPopupTrackBar.Visible then DropDown else CloseUp;
end;
function TbsSkinTrackEdit.CheckValue;
begin
Result := NewValue;
if (FMaxValue <> FMinValue)
then
begin
if NewValue < FMinValue then
Result := FMinValue
else if NewValue > FMaxValue then
Result := FMaxValue;
end;
end;
procedure TbsSkinTrackEdit.SetMinValue;
begin
FMinValue := AValue;
end;
procedure TbsSkinTrackEdit.SetMaxValue;
begin
FMaxValue := AValue;
end;
function TbsSkinTrackEdit.IsNumText;
function GetMinus: Boolean;
var
i: Integer;
S: String;
begin
S := AText;
i := Pos('-', S);
if i > 1
then
Result := False
else
begin
Delete(S, i, 1);
Result := Pos('-', S) = 0;
end;
end;
const
EditChars = '01234567890-';
var
i: Integer;
S: String;
begin
S := EditChars;
Result := True;
if (Text = '') or (Text = '-')
then
begin
Result := False;
Exit;
end;
for i := 1 to Length(Text) do
begin
if Pos(Text[i], S) = 0
then
begin
Result := False;
Break;
end;
end;
Result := Result and GetMinus;
end;
procedure TbsSkinTrackEdit.Change;
var
NewValue, TmpValue: Integer;
begin
if FromEdit then Exit;
if not StopCheck and IsNumText(Text)
then
begin
TmpValue := StrToInt(Text);
NewValue := CheckValue(TmpValue);
if NewValue <> FValue
then
begin
FValue := NewValue;
end;
if NewValue <> TmpValue
then
begin
FromEdit := True;
Text := IntToStr(Round(NewValue));
FromEdit := False;
end;
end;
inherited;
end;
procedure TbsSkinTrackEdit.SetValue;
begin
FValue := CheckValue(AValue);
StopCheck := True;
Text := IntToStr(Round(CheckValue(AValue)));
StopCheck := False;
end;
procedure TbsSkinTrackEdit.KeyPress(var Key: Char);
begin
if Key = Char(VK_ESCAPE)
then
begin
if FPopupTrackBar.Visible then CloseUp;
end
else
if not IsValidChar(Key) then
begin
Key := #0;
MessageBeep(0)
end;
inherited KeyPress(Key);
end;
function TbsSkinTrackEdit.IsValidChar(Key: Char): Boolean;
begin
Result := (Key in ['-', '0'..'9']) or
((Key < #32) and (Key <> Chr(VK_RETURN)));
if (Key = '-') and (Pos('-', Text) <> 0)
then
Result := False;
if ReadOnly and Result and ((Key >= #32) or
(Key = Char(VK_BACK)) or (Key = Char(VK_DELETE)))
then
Result := False;
end;
procedure TbsSkinTrackEdit.WMKillFocus(var Message: TWMKillFocus);
begin
inherited;
CloseUp;
end;
procedure TbsSkinTrackEdit.TrackBarChange(Sender: TObject);
begin
if Value <> FPopupTrackBar.Value
then
Value := FPopupTrackBar.Value;
end;
constructor TbsSkinPopupTrackBar.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := ControlStyle + [csNoDesignVisible, csReplicatable];
SkinDataName := 'htrackbar';
end;
procedure TbsSkinPopupTrackBar.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
with Params do
begin
Style := WS_POPUP;
ExStyle := WS_EX_TOOLWINDOW;
WindowClass.Style := CS_SAVEBITS;
if CheckWXP then
WindowClass.Style := WindowClass.style or CS_DROPSHADOW_;
end;
end;
procedure TbsSkinPopupTrackBar.WMMouseActivate(var Message: TMessage);
begin
Message.Result := MA_NOACTIVATE;
end;
constructor TbsSkinTimeEdit.Create(AOwner: TComponent);
begin
inherited;
fShowMSec := false;
EditMask := '!90:00:00;1; ';
Text := '00' + TimeSeparator + '00' + TimeSeparator + '00';
OnKeyPress := HandleOnKeyPress;
end;
procedure TbsSkinTimeEdit.CheckSpace(var S: String);
var
i: Integer;
begin
for i := 0 to Length(S) do
begin
if S[i] = ' ' then S[i] := '0';
end;
end;
procedure TbsSkinTimeEdit.HandleOnKeyPress(Sender: TObject; var Key: Char);
var
TimeStr: string;
aHour, aMinute, aSecond, aMillisecond: Word;
aHourSt, aMinuteSt, aSecondSt, aMillisecondSt: string;
begin
if (Key <> #13) and (Key <> #8)
then
begin
TimeStr := Text;
if SelLength > 1 then SelLength := 1;
if IsValidChar(Key)
then
begin
Delete(TimeStr,SelStart + 1, 1);
Insert(string(Key), TimeStr, SelStart + 1);
end;
try
aHourSt := Copy(TimeStr, 1, 2);
CheckSpace(aHourSt);
aMinuteSt := Copy(TimeStr, 4, 2);
CheckSpace(aMinuteSt);
aSecondSt := Copy(TimeStr, 7, 2);
CheckSpace(aSecondSt);
if fShowMSec then begin
aMillisecondSt := Copy(TimeStr, 10, 3);
end else begin
aMillisecondSt := '0';
end;
CheckSpace(aMillisecondSt);
aHour := StrToInt(aHourSt);
aMinute := StrToInt(aMinuteSt);
aSecond := StrToInt(aSecondSt);
aMillisecond := StrToInt(aMillisecondSt);
if not IsValidTime(aHour, aMinute, aSecond, aMillisecond) then begin
Key := #0;
end;
except
Key := #0;
end;
end;
end;
procedure TbsSkinTimeEdit.SetShowMilliseconds(const Value: Boolean);
begin
if fShowMSec <> Value then begin
fShowMSec := Value;
if fShowMSec then begin
EditMask := '!90:00:00.000;1; ';
Text := '00:00:00.000';
end else begin
EditMask := '!90:00:00;1; ';
Text := '00:00:00';
end;
end;
end;
procedure TbsSkinTimeEdit.SetMilliseconds(const Value: Integer);
var
aHour, aMinute, aSecond, aMillisecond: Integer;
St: string;
begin
aSecond := Value div 1000;
aMillisecond := Value mod 1000;
aMinute := aSecond div 60;
aSecond := aSecond mod 60;
aHour := aMinute div 60;
aMinute := aMinute mod 60;
St := Format('%2.2d:%2.2d:%2.2d.%3.3d', [aHour, aMinute, aSecond, aMillisecond]);
try
Text := St;
except
Text := '00:00:00.000';
end;
end;
function TbsSkinTimeEdit.GetMilliseconds: Integer;
var
TimeStr: string;
aHour, aMinute, aSecond, aMillisecond: Integer;
aHourSt, aMinuteSt, aSecondSt, aMillisecondSt: string;
begin
TimeStr := Text;
try
aHourSt := Copy(TimeStr, 1, 2);
CheckSpace(aHourSt);
aMinuteSt := Copy(TimeStr, 4, 2);
CheckSpace(aMinuteSt);
aSecondSt := Copy(TimeStr, 7, 2);
CheckSpace(aSecondSt);
aMillisecondSt := Copy(TimeStr, 10, 3);
CheckSpace(aMillisecondSt);
aHour := StrToInt(aHourSt);
aMinute := StrToInt(aMinuteSt);
aSecond := StrToInt(aSecondSt);
aMillisecond := StrToInt(aMillisecondSt);
Result := ((((aHour * 60) + aMinute) * 60) + aSecond) * 1000 + aMillisecond;
except
Result := 0;
end;
end;
procedure TbsSkinTimeEdit.SetTime(const Value: string);
var
TimeStr: string;
aHour, aMinute, aSecond, aMillisecond: Integer;
aHourSt, aMinuteSt, aSecondSt, aMillisecondSt: string;
begin
TimeStr := Value;
try
aHourSt := Copy(TimeStr, 1, 2);
CheckSpace(aHourSt);
aMinuteSt := Copy(TimeStr, 4, 2);
CheckSpace(aMinuteSt);
aSecondSt := Copy(TimeStr, 7, 2);
CheckSpace(aSecondSt);
aHour := StrToInt(aHourSt);
aMinute := StrToInt(aMinuteSt);
aSecond := StrToInt(aSecondSt);
if fShowMSec then begin
aMillisecondSt := Copy(TimeStr, 10, 3);
CheckSpace(aMillisecondSt);
aMillisecond := StrToInt(aMillisecondSt);
Text := Format('%2.2d:%2.2d:%2.2d.%3.3d', [aHour, aMinute, aSecond, aMillisecond]);
end else begin
Text := Format('%2.2d:%2.2d:%2.2d', [aHour, aMinute, aSecond]);
end;
except
if fShowMSec then begin
Text := '00:00:00.000';
end else begin
Text := '00:00:00';
end;
end;
end;
function TbsSkinTimeEdit.GetTime: string;
begin
Result := Text;
end;
function TbsSkinTimeEdit.IsValidTime(const AHour, AMinute, ASecond, AMilliSecond: Word): Boolean;
begin
Result := ((AHour < 24) and (AMinute < 60) and
(ASecond < 60) and (AMilliSecond < 1000)) or
((AHour = 24) and (AMinute = 0) and
(ASecond = 0) and (AMilliSecond = 0));
end;
function TbsSkinTimeEdit.IsValidChar(Key: Char): Boolean;
begin
Result := Key in ['0'..'9'];
end;
procedure TbsSkinTimeEdit.DecodeTime(var Hour, Min, Sec, MSec: Word);
var
TimeStr: string;
aHourSt, aMinuteSt, aSecondSt, aMillisecondSt: string;
begin
TimeStr := Text;
aHourSt := Copy(TimeStr, 1, 2);
CheckSpace(aHourSt);
aMinuteSt := Copy(TimeStr, 4, 2);
CheckSpace(aMinuteSt);
aSecondSt := Copy(TimeStr, 7, 2);
CheckSpace(aSecondSt);
Hour := StrToInt(aHourSt);
Min := StrToInt(aMinuteSt);
Sec := StrToInt(aSecondSt);
if fShowMSec
then
aMillisecondSt := Copy(TimeStr, 10, 3)
else
aMillisecondSt := '000';
CheckSpace(aMillisecondSt);
Msec := StrToInt(aMillisecondSt);
end;
procedure TbsSkinTimeEdit.EncodeTime(Hour, Min, Sec, MSec: Word);
begin
if not IsValidTime(Hour, Min, Sec, MSec) then Exit;
try
if fShowMSec
then
Text := Format('%2.2d:%2.2d:%2.2d.%3.3d', [Hour, Min, Sec, MSec])
else
Text := Format('%2.2d:%2.2d:%2.2d', [Hour, Min, Sec]);
except
if fShowMSec
then
Text := '00:00:00.000'
else
Text := '00:00:00';
end;
end;
constructor TbsSkinPasswordEdit.Create(AOwner: TComponent);
begin
inherited;
Text := '';
FMouseIn := False;
SkinDataName := 'edit';
Width := 121;
DefaultHeight := 21;
TabStop := True;
Color := clWindow;
FTextAlignment := taLeftJustify;
FAutoSelect := True;
FCharCase := ecNormal;
FHideSelection := True;
FMaxLength := 0;
FReadOnly := False;
FLMouseSelecting := False;
FCaretPosition := 0;
FSelStart := 0;
FSelLength := 0;
FFVChar := 1;
ControlStyle := ControlStyle + [csCaptureMouse] - [csSetCaption];
Cursor := Cursor;
end;
destructor TbsSkinPasswordEdit.Destroy;
begin
inherited;
end;
procedure TbsSkinPasswordEdit.PasteFromClipboard;
var
Data: THandle;
Insertion: WideString;
begin
if ReadOnly then Exit;
if Clipboard.HasFormat(CF_UNICODETEXT)
then
begin
Data := Clipboard.GetAsHandle(CF_UNICODETEXT);
try
if Data <> 0
then
Insertion := PWideChar(GlobalLock(Data));
finally
if Data <> 0 then GlobalUnlock(Data);
end;
end
else
Insertion := Clipboard.AsText;
InsertText(Insertion);
end;
procedure TbsSkinPasswordEdit.GetSkinData;
begin
inherited;
if FIndex <> -1
then
if TbsDataSkinControl(FSD.CtrlList.Items[FIndex]) is TbsDataSkinEditControl
then
with TbsDataSkinEditControl(FSD.CtrlList.Items[FIndex]) do
begin
Self.SkinRect := SkinRect;
Self.ActiveSkinRect := ActiveSkinRect;
if IsNullRect(ActiveSkinRect)
then
Self.ActiveSkinRect := SkinRect;
LOffset := LTPoint.X;
ROffset := RectWidth(SkinRect) - RTPoint.X;
CharColor := FontColor;
CharDisabledColor := DisabledFontColor;
CharActiveColor := ActiveFontColor;
end;
end;
procedure TbsSkinPasswordEdit.CreateControlSkinImage(B: TBitMap);
begin
if FMouseIn or Focused
then
CreateHSkinImage(LOffset, ROffset, B, Picture, ActiveSkinRect, Width,
RectHeight(ActiveSkinRect))
else
CreateHSkinImage(LOffset, ROffset, B, Picture, SkinRect, Width,
RectHeight(SkinRect));
if Focused or not HideSelection
then
with B.Canvas do
begin
Brush.Color := clHighlight;
FillRect(GetSelRect);
end;
PaintText(B.Canvas);
if Focused or not HideSelection
then
PaintSelectedText(B.Canvas);
end;
procedure TbsSkinPasswordEdit.CreateControlDefaultImage(B: TBitMap);
var
R: TRect;
begin
R := Rect(0, 0, Width, Height);
with B.Canvas do
begin
Brush.Color := clWindow;
FillRect(R);
Frame3D(B.Canvas, R, clBtnShadow, clBtnShadow, 1);
Frame3D(B.Canvas, R, clBtnFace, clBtnFace, 1);
end;
if Focused or not HideSelection
then
with B.Canvas do
begin
Brush.Color := clHighlight;
FillRect(GetSelRect);
end;
PaintText(B.Canvas);
if Focused or not HideSelection
then
PaintSelectedText(B.Canvas);
end;
procedure TbsSkinPasswordEdit.Loaded;
begin
inherited;
end;
procedure TbsSkinPasswordEdit.WMSETFOCUS(var Message: TWMSETFOCUS);
begin
inherited;
UpdateCarete;
CaretPosition := 0;
if AutoSelect then SelectAll;
end;
procedure TbsSkinPasswordEdit.WMKILLFOCUS(var Message: TWMKILLFOCUS);
begin
inherited;
DestroyCaret;
Invalidate;
end;
function TbsSkinPasswordEdit.GetCharX(a: Integer): Integer;
var
WTextWidth : Integer;
ERWidth : Integer;
begin
Result := GetEditRect.Left;
WTextWidth := Length(Text) * GetPasswordFigureWidth;
if a > 0
then
begin
if a <= Length(Text)
then Result := Result + (a - FFVChar + 1) * GetPasswordFigureWidth
else Result := Result + (Length(Text) - FFVChar + 1) * GetPasswordFigureWidth;
end;
ERWidth := GetEditRect.Right - GetEditRect.Left;
if WTextWidth < ERWidth
then
case TextAlignment of
taRightJustify : Result := Result + (ERWidth - WTextWidth);
taCenter : Result := Result + ((ERWidth - WTextWidth) div 2);
end;
end;
function TbsSkinPasswordEdit.GetCPos(x: Integer): Integer;
var
TmpX,
WTextWidth,
ERWidth : Integer;
begin
Result := FFVChar - 1;
if Length(Text) = 0 then Exit;
WTextWidth := Length(Text) * GetPasswordFigureWidth;
ERWidth := GetEditRect.Right - GetEditRect.Left;
TmpX := x;
if WTextWidth < ERWidth
then
case TextAlignment of
taRightJustify : TmpX := x - (ERWidth - WTextWidth);
taCenter : TmpX := x - ((ERWidth - WTextWidth) div 2);
end;
Result := Result + (TmpX - GetEditRect.Left) div GetPasswordFigureWidth;
if Result < 0
then
Result := 0
else
if Result > Length(Text)
then
Result := Length(Text);
end;
function TbsSkinPasswordEdit.GetEditRect: TRect;
begin
with Result do
begin
if FIndex = -1
then
Result := Rect(2, 2, Width - 2, Height - 2)
else
Result := NewClRect;
end;
end;
function TbsSkinPasswordEdit.GetAlignmentFlags: Integer;
begin
case FTextAlignment of
taCenter: Result := DT_CENTER;
taRightJustify: Result := DT_RIGHT;
else
Result := DT_LEFT;
end;
end;
procedure TbsSkinPasswordEdit.KeyDown(var Key: word; Shift: TShiftState);
var
TmpS: String;
OldCaretPosition: Integer;
begin
inherited KeyDown(Key, Shift);
OldCaretPosition := CaretPosition;
case Key of
Ord('v'), Ord('V'):
if Shift = [ssCtrl] then PasteFromClipboard;
VK_INSERT:
if Shift = [ssShift] then PasteFromClipboard;
VK_END: CaretPosition := Length(Text);
VK_HOME: CaretPosition := 0;
VK_LEFT:
if ssCtrl in Shift then
CaretPosition := GetPrivWPos(CaretPosition)
else
CaretPosition := CaretPosition - 1;
VK_RIGHT:
if ssCtrl in Shift
then
CaretPosition := GetNextWPos(CaretPosition)
else
CaretPosition := CaretPosition + 1;
VK_DELETE, 8:
if not ReadOnly
then
begin
if SelLength <> 0
then
ClearSelection
else
begin
TmpS := Text;
if TmpS <> ''
then
if Key = VK_DELETE
then
Delete(TmpS, CaretPosition + 1, 1)
else
begin
Delete(TmpS, CaretPosition, 1);
CaretPosition := CaretPosition - 1;
end;
Text := TmpS;
end;
end;
end;
if Key in [VK_END, VK_HOME, VK_LEFT, VK_RIGHT]
then
begin
if ssShift in Shift
then
begin
if SelLength = 0
then
FSelStart := OldCaretPosition;
FSelStart := CaretPosition;
FSelLength := FSelLength - (CaretPosition - OldCaretPosition);
end
else
FSelLength := 0;
Invalidate;
end;
UpdateCaretePosition;
end;
procedure TbsSkinPasswordEdit.KeyPress(var Key: Char);
begin
inherited KeyPress(Key);
if (Ord(Key) >= 32) and not ReadOnly then InsertChar(Key);
end;
procedure TbsSkinPasswordEdit.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
inherited;
if Button = mbLeft
then
FLMouseSelecting := True;
SetFocus;
if Button = mbLeft
then
begin
CaretPosition := GetCPos(x);
SelLength := 0;
end;
end;
procedure TbsSkinPasswordEdit.PaintText;
var
TmpRect: TRect;
CurChar: Integer;
LPWCharWidth: Integer;
begin
TmpRect := GetEditRect;
LPWCharWidth := GetPasswordFigureWidth;
for CurChar := 0 to Length(Text) - FFVChar + 1 - 1 do
DrawPasswordChar(Rect(CurChar * LPWCharWidth + GetCharX(0), TmpRect.Top,
(CurChar + 1) * LPWCharWidth + GetCharX(0), TmpRect.Bottom), False, Cnv);
end;
procedure TbsSkinPasswordEdit.UpdateFVC;
var
LEditRect: TRect;
begin
if FFVChar >= (FCaretPosition + 1)
then
begin
FFVChar := FCaretPosition;
if FFVChar < 1 then FFVChar := 1;
end
else
begin
LEditRect := GetEditRect;
while ((FCaretPosition - FFVChar + 1) * GetPasswordFigureWidth >
LEditRect.Right - LEditRect.Left) and (FFVChar < Length(Text)) do
Inc(FFVChar)
end;
Invalidate;
end;
procedure TbsSkinPasswordEdit.MouseMove(Shift: TShiftState; x, y: Integer);
var
OldCaretPosition: Integer;
TmpNewPosition : Integer;
begin
inherited;
if FLMouseSelecting
then
begin
TmpNewPosition := GetCPos(x);
OldCaretPosition := CaretPosition;
if (x > GetEditRect.Right)
then
CaretPosition := TmpNewPosition +1
else
CaretPosition := TmpNewPosition;
if SelLength = 0 then FSelStart := OldCaretPosition;
FSelStart := CaretPosition;
FSelLength := FSelLength - (CaretPosition - OldCaretPosition);
end;
end;
procedure TbsSkinPasswordEdit.MouseUp(Button: TMouseButton; Shift: TShiftState;
x, y: Integer);
begin
inherited;
FLMouseSelecting := false;
end;
procedure TbsSkinPasswordEdit.PaintSelectedText;
var
TmpRect: TRect;
CurChar: Integer;
LPWCharWidth: Integer;
begin
TmpRect := GetSelRect;
LPWCharWidth := GetPasswordFigureWidth;
for CurChar := 0 to Length(GetVisibleSelText) - 1 do
DrawPasswordChar(Rect(CurChar * LPWCharWidth + TmpRect.Left,
TmpRect.Top, (CurChar + 1) * LPWCharWidth + TmpRect.Left, TmpRect.Bottom),
True, Cnv);
end;
function TbsSkinPasswordEdit.GetVisibleSelText: String;
begin
if SelStart + 1 >= FFVChar
then Result := SelText
else Result := Copy(SelText, FFVChar - SelStart, Length(SelText) - (FFVChar - SelStart) + 1);
end;
function TbsSkinPasswordEdit.GetNextWPos(StartPosition: Integer): Integer;
var
SpaceFound,
WordFound: Boolean;
begin
Result := StartPosition;
SpaceFound := false;
WordFound := false;
while (Result + 2 <= Length(Text)) and
((not ((Text[Result + 1] <> ' ') and SpaceFound))
or not WordFound) do
begin
if Text[Result + 1] = ' ' then
SpaceFound := true;
if Text[Result + 1] <> ' ' then begin
WordFound := true;
SpaceFound := false;
end;
Result := Result + 1;
end;
if not SpaceFound then
Result := Result + 1;
end;
function TbsSkinPasswordEdit.GetPrivWPos(StartPosition: Integer): Integer;
var
WordFound: Boolean;
begin
Result := StartPosition;
WordFound := false;
while (Result > 0) and
((Text[Result] <> ' ') or not WordFound) do
begin
if Text[Result] <> ' ' then
WordFound := true;
Result := Result - 1;
end;
end;
procedure TbsSkinPasswordEdit.ClearSelection;
var
TmpS: String;
begin
if ReadOnly then Exit;
TmpS := Text;
Delete(TmpS, SelStart + 1, SelLength);
Text := TmpS;
CaretPosition := SelStart;
SelLength := 0;
end;
procedure TbsSkinPasswordEdit.SelectAll;
begin
SetCaretPosition(Length(Text));
SelStart := 0;
SelLength := Length(Text);
Invalidate;
end;
procedure TbsSkinPasswordEdit.DrawPasswordChar(SymbolRect: TRect; Selected: Boolean; Cnv: TCanvas);
var
R: TRect;
C: TColor;
begin
if not Enabled
then
begin
if FIndex = -1
then C := clGrayText
else C := CharDisabledColor;
end
else
if Selected
then
C := clHighlightText
else
if FIndex = -1
then
C := clWindowText
else
begin
if FMouseIn or Focused
then
C := CharActiveColor
else
C := CharColor;
end;
R := SymbolRect;
InflateRect(R, -2, - (RectHeight(R) - RectWidth(R)) div 2 - 2);
with Cnv do
case FPasswordKind of
pkRect:
begin
Brush.Color := C;
FillRect(R);
end;
pkRoundRect:
begin
Brush.Color := C;
Pen.Color := C;
RoundRect(R.Left, R.Top, R.Right, R.Bottom, RectWidth(R) div 2, Font.Color);
end;
pkTriangle:
begin
R := Rect(0, 0, RectWidth(R), RectWidth(R));
if not Odd(RectWidth(R)) then R.Right := R.Right + 1;
RectToCenter(R, SymbolRect);
Pen.Color := C;
Brush.Color := C;
Polygon([
Point(R.Left + RectWidth(R) div 2 + 1, R.Top),
Point(R.Right, R.Bottom),
Point(R.Left, R.Bottom)]);
end;
end;
end;
procedure TbsSkinPasswordEdit.SelectWord;
begin
SelStart := GetPrivWPos(CaretPosition);
SelLength := GetNextWPos(SelStart) - SelStart;
CaretPosition := SelStart + SelLength;
end;
procedure TbsSkinPasswordEdit.UpdateCarete;
begin
GetSkinData;
if FIndex = -1
then
CreateCaret(Handle, 0, 0, Height - 4)
else
CreateCaret(Handle, 0, 0, RectHeight(NewClRect));
CaretPosition := FCaretPosition;
ShowCaret;
end;
procedure TbsSkinPasswordEdit.HideCaret;
begin
Windows.HideCaret(Handle);
end;
procedure TbsSkinPasswordEdit.ShowCaret;
begin
Windows.ShowCaret(Handle);
end;
function TbsSkinPasswordEdit.GetPasswordFigureWidth: Integer;
begin
Result := RectHeight(GetEditRect) div 2 + 3;
end;
procedure TbsSkinPasswordEdit.Change;
begin
inherited Changed;
if Enabled and HandleAllocated then SetCaretPosition(CaretPosition);
if Assigned(FOnChange) then FOnChange(Self);
end;
procedure TbsSkinPasswordEdit.WMGetDlgCode(var Msg: TWMGetDlgCode);
begin
inherited;
Msg.Result := DLGC_WANTARROWS or DLGC_WANTCHARS;
end;
procedure TbsSkinPasswordEdit.WMLButtonDblClk(var Message: TWMLButtonDblClk);
begin
inherited;
FLMouseSelecting := false;
SelectWord;
end;
procedure TbsSkinPasswordEdit.CMFontChanged(var Message: TMessage);
begin
inherited;
Font.Assign(Font);
UpdateCarete;
end;
function TbsSkinPasswordEdit.GetText: String;
begin
Result := FText;
end;
procedure TbsSkinPasswordEdit.SetText(const Value: String);
var
S, S1: String;
begin
if not ValidText(Value) then Exit;
S := Value;
S1 := Text;
if (Value <> '') and (CharCase <> ecNormal)
then
case CharCase of
ecUpperCase: FText := AnsiUpperCase(S);
ecLowerCase: FText := AnsiLowerCase(S);
end
else
FText := S;
Invalidate;
if S <> S1 then Change;
end;
procedure TbsSkinPasswordEdit.SetCaretPosition(const Value: Integer);
begin
if Value < 0
then
FCaretPosition := 0
else
if Value > Length(Text)
then
FCaretPosition := Length(Text)
else
FCaretPosition := Value;
UpdateFVC;
if SelLength <= 0 then FSelStart := Value;
if Focused then SetCaretPos(GetCharX(FCaretPosition), GetEditRect.Top);
end;
procedure TbsSkinPasswordEdit.SetSelLength(const Value: Integer);
begin
if FSelLength <> Value
then
begin
FSelLength := Value;
Invalidate;
end;
end;
procedure TbsSkinPasswordEdit.SetSelStart(const Value: Integer);
begin
if FSelStart <> Value
then
begin
SelLength := 0;
FSelStart := Value;
CaretPosition := FSelStart;
Invalidate;
end;
end;
procedure TbsSkinPasswordEdit.SetAutoSelect(const Value: Boolean);
begin
if FAutoSelect <> Value then FAutoSelect := Value;
end;
function TbsSkinPasswordEdit.GetSelStart: Integer;
begin
if FSelLength > 0
then
Result := FSelStart
else
if FSelLength < 0
then Result := FSelStart + FSelLength
else Result := CaretPosition;
end;
function TbsSkinPasswordEdit.GetSelRect: TRect;
begin
Result := GetEditRect;
Result.Left := GetCharX(SelStart);
Result.Right := GetCharX(SelStart + SelLength);
IntersectRect(Result, Result, GetEditRect);
end;
function TbsSkinPasswordEdit.GetSelLength: Integer;
begin
Result := Abs(FSelLength);
end;
function TbsSkinPasswordEdit.GetSelText: String;
begin
Result := Copy(Text, SelStart + 1, SelLength);
end;
procedure TbsSkinPasswordEdit.SetCharCase(const Value: TEditCharCase);
var
S: String;
begin
if FCharCase <> Value
then
begin
FCharCase := Value;
if Text <> ''
then
begin
S := Text;
case Value of
ecUpperCase: Text := AnsiUpperCase(S);
ecLowerCase: Text := AnsiLowerCase(S);
end;
end;
end;
end;
procedure TbsSkinPasswordEdit.SetHideSelection(const Value: Boolean);
begin
if FHideSelection <> Value
then
begin
FHideSelection := Value;
Invalidate;
end;
end;
procedure TbsSkinPasswordEdit.SetMaxLength(const Value: Integer);
begin
if FMaxLength <> Value then FMaxLength := Value;
end;
procedure TbsSkinPasswordEdit.SetCursor(const Value: TCursor);
begin
if Value = crDefault
then inherited Cursor := crIBeam
else inherited Cursor := Value;
end;
function TbsSkinPasswordEdit.ValidText(NewText: String): Boolean;
begin
Result := true;
end;
procedure TbsSkinPasswordEdit.SetTextAlignment(const Value: TAlignment);
begin
if FTextAlignment <> Value
then
begin
FTextAlignment := Value;
Invalidate;
end;
end;
procedure TbsSkinPasswordEdit.UpdateCaretePosition;
begin
SetCaretPosition(CaretPosition);
end;
procedure TbsSkinPasswordEdit.InsertText(AText: String);
var
S: String;
begin
if ReadOnly then Exit;
S := Text;
Delete(S, SelStart + 1, SelLength);
Insert(AText, S, SelStart + 1);
if (MaxLength <= 0) or (Length(S) <= MaxLength)
then
begin
Text := S;
CaretPosition := SelStart + Length(AText);
end;
SelLength := 0;
end;
procedure TbsSkinPasswordEdit.InsertChar(Ch: Char);
begin
if ReadOnly then Exit;
InsertText(Ch);
end;
procedure TbsSkinPasswordEdit.InsertAfter(Position: Integer; S: String;
Selected: Boolean);
var
S1: String;
Insertion : String;
begin
S := Text;
Insertion := S;
if MaxLength > 0
then
Insertion := Copy(Insertion, 1, MaxLength - Length(S1));
Insert(Insertion, S1, Position+1);
Text := S1;
if Selected
then
begin
SelStart := Position;
SelLength := Length(Insertion);
CaretPosition := SelStart + SelLength;
end;
end;
procedure TbsSkinPasswordEdit.DeleteFrom(Position, Length: Integer; MoveCaret : Boolean);
var
TmpS: String;
begin
TmpS := Text;
Delete(TmpS,Position,Length);
Text := TmpS;
if MoveCaret
then
begin
SelLength := 0;
SelStart := Position-1;
end;
end;
procedure TbsSkinPasswordEdit.SetPasswordKind(const Value: TbsPasswordKind);
begin
if FPasswordKind <> Value
then
begin
FPasswordKind := Value;
Invalidate;
end;
end;
procedure TbsSkinPasswordEdit.CMTextChanged(var Msg: TMessage);
begin
inherited;
FText := inherited Text;
SelLength := 0;
Invalidate;
end;
procedure TbsSkinPasswordEdit.Clear;
begin
Text := '';
end;
procedure TbsSkinPasswordEdit.CMEnabledChanged(var Msg: TMessage);
begin
inherited;
if HandleAllocated then Invalidate;
end;
procedure TbsSkinPasswordEdit.CMMouseEnter;
begin
inherited;
FMouseIn := True;
if (not Focused) then Invalidate;
end;
procedure TbsSkinPasswordEdit.CMMouseLeave;
begin
inherited;
FMouseIn := False;
if not Focused then Invalidate;
end;
// TbsSkinNumericEdit
constructor TbsSkinNumericEdit.Create(AOwner: TComponent);
begin
inherited;
FMinValue := 0;
FMaxValue := 0;
FValue := 0;
StopCheck := True;
FromEdit := False;
Text := '0';
StopCheck := False;
Width := 120;
Height := 20;
FDecimal := 2;
FSkinDataName := 'edit';
end;
destructor TbsSkinNumericEdit.Destroy;
begin
inherited;
end;
procedure TbsSkinNumericEdit.SetValueType(NewType: TbsValueType);
begin
if FValueType <> NewType
then
begin
FValueType := NewType;
end;
end;
procedure TbsSkinNumericEdit.SetDecimal(NewValue: Byte);
begin
if FDecimal <> NewValue then begin
FDecimal := NewValue;
end;
end;
function TbsSkinNumericEdit.CheckValue;
begin
Result := NewValue;
if (FMaxValue <> FMinValue)
then
begin
if NewValue < FMinValue then
Result := FMinValue
else if NewValue > FMaxValue then
Result := FMaxValue;
end;
end;
procedure TbsSkinNumericEdit.SetMinValue;
begin
FMinValue := AValue;
end;
procedure TbsSkinNumericEdit.SetMaxValue;
begin
FMaxValue := AValue;
end;
function TbsSkinNumericEdit.IsNumText;
function GetMinus: Boolean;
var
i: Integer;
S: String;
begin
S := AText;
i := Pos('-', S);
if i > 1
then
Result := False
else
begin
Delete(S, i, 1);
Result := Pos('-', S) = 0;
end;
end;
function GetP: Boolean;
var
i: Integer;
S: String;
begin
S := AText;
i := Pos(DecimalSeparator, S);
if i = 1
then
Result := False
else
begin
Delete(S, i, 1);
Result := Pos(DecimalSeparator, S) = 0;
end;
end;
const
EditChars = '01234567890-';
var
i: Integer;
S: String;
begin
S := EditChars;
Result := True;
if ValueType = vtFloat
then
S := S + DecimalSeparator;
if (Text = '') or (Text = '-')
then
begin
Result := False;
Exit;
end;
for i := 1 to Length(Text) do
begin
if Pos(Text[i], S) = 0
then
begin
Result := False;
Break;
end;
end;
Result := Result and GetMinus;
if ValueType = vtFloat
then
Result := Result and GetP;
end;
procedure TbsSkinNumericEdit.Change;
var
NewValue, TmpValue: Double;
begin
if FromEdit then Exit;
if not StopCheck and IsNumText(Text)
then
begin
if ValueType = vtFloat
then TmpValue := StrToFloat(Text)
else TmpValue := StrToInt(Text);
NewValue := CheckValue(TmpValue);
if NewValue <> FValue
then
begin
FValue := NewValue;
end;
if NewValue <> TmpValue
then
begin
FromEdit := True;
if ValueType = vtFloat
then Text := FloatToStrF(NewValue, ffFixed, 15, FDecimal)
else Text := IntToStr(Round(FValue));
FromEdit := False;
end;
end;
inherited;
end;
procedure TbsSkinNumericEdit.SetValue;
begin
FValue := CheckValue(AValue);
StopCheck := True;
if ValueType = vtFloat
then
Text := FloatToStrF(CheckValue(AValue), ffFixed, 15, FDecimal)
else
Text := IntToStr(Round(CheckValue(AValue)));
StopCheck := False;
end;
procedure TbsSkinNumericEdit.KeyPress(var Key: Char);
begin
if not IsValidChar(Key)
then
begin
Key := #0;
MessageBeep(0)
end;
inherited KeyPress(Key);
end;
function TbsSkinNumericEdit.IsValidChar(Key: Char): Boolean;
begin
if ValueType = vtFloat
then
Result := (Key in [DecimalSeparator, '-', '0'..'9']) or
((Key < #32) and (Key <> Chr(VK_RETURN)))
else
Result := (Key in ['-', '0'..'9']) or
((Key < #32) and (Key <> Chr(VK_RETURN)));
if (Key = DecimalSeparator) and (Pos(DecimalSeparator, Text) <> 0)
then
Result := False
else
if (Key = '-') and (Pos('-', Text) <> 0)
then
Result := False;
if ReadOnly and Result and ((Key >= #32) or
(Key = Char(VK_BACK)) or (Key = Char(VK_DELETE)))
then
Result := False;
end;
// TbsSkinCheckComboBox
constructor TbsPopupCheckListBox.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := ControlStyle + [csNoDesignVisible, csReplicatable,
csAcceptsControls];
Ctl3D := False;
ParentCtl3D := False;
Visible := False;
FOldAlphaBlend := False;
FOldAlphaBlendValue := 0;
end;
procedure TbsPopupCheckListBox.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
with Params do begin
Style := WS_POPUP or WS_CLIPCHILDREN;
ExStyle := WS_EX_TOOLWINDOW;
WindowClass.Style := WindowClass.Style or CS_SAVEBITS;
if CheckWXP then
WindowClass.Style := WindowClass.style or CS_DROPSHADOW_;
end;
end;
procedure TbsPopupCheckListBox.WMMouseActivate(var Message: TMessage);
begin
Message.Result := MA_NOACTIVATE;
end;
procedure TbsPopupCheckListBox.Hide;
begin
SetWindowPos(Handle, 0, 0, 0, 0, 0, SWP_NOZORDER or
SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE or SWP_HIDEWINDOW);
Visible := False;
end;
procedure TbsPopupCheckListBox.Show(Origin: TPoint);
var
PLB: TbsSkinCustomComboBox;
I: Integer;
begin
PLB := nil;
//
if CheckW2KWXP and (Owner is TbsSkinCustomComboBox)
then
begin
PLB := TbsSkinCustomComboBox(Owner);
if PLB.AlphaBlend and not FOldAlphaBlend
then
begin
SetWindowLong(Handle, GWL_EXSTYLE,
GetWindowLong(Handle, GWL_EXSTYLE) or WS_EX_LAYERED);
end
else
if not PLB.AlphaBlend and FOldAlphaBlend
then
begin
SetWindowLong(Handle, GWL_EXSTYLE,
GetWindowLong(Handle, GWL_EXSTYLE) and (not WS_EX_LAYERED));
end;
FOldAlphaBlend := PLB.AlphaBlend;
if (FOldAlphaBlendValue <> PLB.AlphaBlendValue) and PLB.AlphaBlend
then
begin
if PLB.AlphaBlendAnimation
then
begin
SetAlphaBlendTransparent(Handle, 0);
FOldAlphaBlendValue := 0;
end
else
begin
SetAlphaBlendTransparent(Handle, PLB.AlphaBlendValue);
FOldAlphaBlendValue := PLB.AlphaBlendValue;
end;
end;
end;
//
SetWindowPos(Handle, HWND_TOP, Origin.X, Origin.Y, 0, 0,
SWP_NOACTIVATE or SWP_SHOWWINDOW or SWP_NOSIZE);
Visible := True;
if CheckW2KWXP and (PLB <> nil) and PLB.AlphaBlendAnimation and PLB.AlphaBlend
then
begin
Application.ProcessMessages;
I := 0;
repeat
Inc(i, 2);
if i > PLB.AlphaBlendValue then i := PLB.AlphaBlendValue;
SetAlphaBlendTransparent(Handle, i);
until i >= PLB.FAlphaBlendValue;
end;
end;
// checkcombobox
constructor TbsSkinCustomCheckComboBox.Create;
begin
inherited Create(AOwner);
ControlStyle := [csCaptureMouse, csReplicatable, csOpaque, csDoubleClicks, csAcceptsControls];
FListBoxWidth := 0;
FAlphaBlendAnimation := False;
FAlphaBlend := False;
TabStop := True;
Font.Name := 'Arial';
Font.Color := clWindowText;
Font.Style := [];
Font.Height := 14;
Width := 120;
Height := 20;
FOnListBoxDrawItem := nil;
FListBox := TbsPopupCheckListBox.Create(Self);
FListBox.Visible := False;
FlistBox.Parent := Self;
FListBox.ListBox.TabStop := False;
FListBox.ListBox.OnMouseMove := ListBoxMouseMove;
FListBoxWindowProc := FlistBox.ListBox.WindowProc;
FlistBox.ListBox.WindowProc := ListBoxWindowProcHook;
FLBDown := False;
FDropDownCount := 8;
CalcRects;
FSkinDataName := 'combobox';
end;
destructor TbsSkinCustomCheckComboBox.Destroy;
begin
FlistBox.Free;
FlistBox := nil;
inherited;
end;
procedure TbsSkinCustomCheckComboBox.CheckText;
var
i: Integer;
S: String;
begin
if Items.Count = 0
then
Text := ''
else
begin
S := '';
for i := 0 to Items.Count - 1 do
begin
if Checked[I] then
if S = '' then S := Items[I] else S := S + ',' + Items[I];
end;
Text := S;
end;
end;
procedure TbsSkinCustomCheckComboBox.SetChecked;
begin
FListBox.Checked[Index] := Checked;
CheckText;
RePaint;
end;
function TbsSkinCustomCheckComboBox.GetChecked;
begin
Result := FListBox.Checked[Index];
end;
procedure TbsSkinCustomCheckComboBox.CMEnabledChanged;
begin
inherited;
RePaint;
Change;
end;
function TbsSkinCustomCheckComboBox.GetListBoxUseSkinItemHeight: Boolean;
begin
Result := FListBox.UseSkinItemHeight;
end;
procedure TbsSkinCustomCheckComboBox.SetListBoxUseSkinItemHeight(Value: Boolean);
begin
FListBox.UseSkinItemHeight := Value;
end;
function TbsSkinCustomCheckComboBox.GetListBoxUseSkinFont: Boolean;
begin
Result := FListBox.UseSkinFont;
end;
procedure TbsSkinCustomCheckComboBox.SetListBoxUseSkinFont(Value: Boolean);
begin
FListBox.UseSkinFont := Value;
end;
procedure TbsSkinCustomCheckComboBox.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (AComponent = Images) then
Images := nil;
end;
function TbsSkinCustomCheckComboBox.GetImages: TCustomImageList;
begin
if FListBox <> nil
then
Result := FListBox.Images
else
Result := nil;
end;
function TbsSkinCustomCheckComboBox.GetImageIndex: Integer;
begin
Result := FListBox.ImageIndex;
end;
procedure TbsSkinCustomCheckComboBox.SetImages(Value: TCustomImageList);
begin
FListBox.Images := Value;
RePaint;
end;
procedure TbsSkinCustomCheckComboBox.SetImageIndex(Value: Integer);
begin
FListBox.ImageIndex := Value;
RePaint;
end;
procedure TbsSkinCustomCheckComboBox.CMCancelMode;
begin
inherited;
if (Message.Sender <> Self) and
(Message.Sender <> Self.FListBox) and
(Message.Sender <> Self.FListBox.ScrollBar) and
(Message.Sender <> Self.FListBox.ListBox)
then
CloseUp(False);
end;
procedure TbsSkinCustomCheckComboBox.Change;
begin
if Assigned(FOnChange) then FOnChange(Self);
end;
function TbsSkinCustomCheckComboBox.GetListBoxDefaultFont;
begin
Result := FListBox.DefaultFont;
end;
procedure TbsSkinCustomCheckComboBox.SetListBoxDefaultFont;
begin
FListBox.DefaultFont.Assign(Value);
end;
function TbsSkinCustomCheckComboBox.GetListBoxDefaultCaptionFont;
begin
Result := FListBox.DefaultCaptionFont;
end;
procedure TbsSkinCustomCheckComboBox.SetListBoxDefaultCaptionFont;
begin
FListBox.DefaultCaptionFont.Assign(Value);
end;
function TbsSkinCustomCheckComboBox.GetListBoxDefaultItemHeight;
begin
Result := FListBox.DefaultItemHeight;
end;
procedure TbsSkinCustomCheckComboBox.SetListBoxDefaultItemHeight;
begin
FListBox.DefaultItemHeight := Value;
end;
function TbsSkinCustomCheckComboBox.GetListBoxCaptionAlignment;
begin
Result := FListBox.Alignment;
end;
procedure TbsSkinCustomCheckComboBox.SetListBoxCaptionAlignment;
begin
FListBox.Alignment := Value;
end;
procedure TbsSkinCustomCheckComboBox.DefaultFontChange;
begin
Font.Assign(FDefaultFont);
end;
procedure TbsSkinCustomCheckComboBox.SetListBoxCaption;
begin
FListBox.Caption := Value;
end;
function TbsSkinCustomCheckComboBox.GetListBoxCaption;
begin
Result := FListBox.Caption;
end;
procedure TbsSkinCustomCheckComboBox.SetListBoxCaptionMode;
begin
FListBox.CaptionMode := Value;
end;
function TbsSkinCustomCheckComboBox.GetListBoxCaptionMode;
begin
Result := FListBox.CaptionMode;
end;
function TbsSkinCustomCheckComboBox.GetSorted: Boolean;
begin
Result := FListBox.Sorted;
end;
procedure TbsSkinCustomCheckComboBox.SetSorted(Value: Boolean);
begin
FListBox.Sorted := Value;
end;
procedure TbsSkinCustomCheckComboBox.SetListBoxDrawItem;
begin
FOnListboxDrawItem := Value;
FListBox.OnDrawItem := FOnListboxDrawItem;
end;
procedure TbsSkinCustomCheckComboBox.ListBoxDrawItem(Cnvs: TCanvas; Index: Integer;
ItemWidth, ItemHeight: Integer; TextRect: TRect; State: TOwnerDrawState);
begin
if Assigned(FOnListBoxDrawItem)
then FOnListBoxDrawItem(Cnvs, Index, ItemWidth, ItemHeight, TextRect, State);
end;
procedure TbsSkinCustomCheckComboBox.CMWantSpecialKey(var Msg: TCMWantSpecialKey);
begin
inherited;
case Msg.CharCode of
VK_UP, VK_DOWN, VK_LEFT, VK_RIGHT: Msg.Result := 1;
end;
end;
procedure TbsSkinCustomCheckComboBox.KeyDown;
var
I: Integer;
begin
inherited KeyDown(Key, Shift);
case Key of
VK_SPACE:
begin
Checked[FListBox.ItemIndex] := not Checked[FListBox.ItemIndex];
Change;
if Assigned(OnClick) then OnClick(Self);
end;
VK_UP, VK_LEFT:
if ssAlt in Shift
then
begin
if FListBox.Visible then CloseUp(False);
end
else
EditUp1(True);
VK_DOWN, VK_RIGHT:
if ssAlt in Shift
then
begin
if not FListBox.Visible then DropDown;
end
else
EditDown1(True);
VK_NEXT: EditPageDown1(True);
VK_PRIOR: EditPageUp1(True);
VK_ESCAPE: if FListBox.Visible then CloseUp(False);
VK_RETURN: if FListBox.Visible then CloseUp(True);
end;
end;
procedure TbsSkinCustomCheckComboBox.WMMOUSEWHEEL;
begin
if Message.WParam > 0
then
EditUp1(not FListBox.Visible)
else
EditDown1(not FListBox.Visible);
end;
procedure TbsSkinCustomCheckComboBox.WMSETFOCUS;
begin
inherited;
RePaint;
end;
procedure TbsSkinCustomCheckComboBox.WMKILLFOCUS;
begin
inherited;
if FListBox.Visible then CloseUp(False);
RePaint;
end;
procedure TbsSkinCustomCheckComboBox.GetSkinData;
begin
inherited;
if FIndex <> -1
then
if TbsDataSkinControl(FSD.CtrlList.Items[FIndex]) is TbsDataSkinComboBox
then
with TbsDataSkinComboBox(FSD.CtrlList.Items[FIndex]) do
begin
Self.SItemRect := SItemRect;
Self.FocusItemRect := FocusItemRect;
if isNullRect(FocusItemRect)
then
Self.FocusItemRect := SItemRect;
Self.ItemLeftOffset := ItemLeftOffset;
Self.ItemRightOffset := ItemRightOffset;
Self.ItemTextRect := ItemTextRect;
Self.FontName := FontName;
Self.FontStyle := FontStyle;
Self.FontHeight := FontHeight;
Self.FontColor := FontColor;
Self.FocusFontColor := FocusFontColor;
Self.ButtonRect := ButtonRect;
Self.ActiveButtonRect := ActiveButtonRect;
Self.DownButtonRect := DownButtonRect;
Self.UnEnabledButtonRect := UnEnabledButtonRect;
Self.ListBoxName := 'checklistbox';
end;
end;
procedure TbsSkinCustomCheckComboBox.Invalidate;
begin
inherited;
end;
function TbsSkinCustomCheckComboBox.IsPopupVisible: Boolean;
begin
Result := FListBox.Visible;
end;
function TbsSkinCustomCheckComboBox.CanCancelDropDown;
begin
Result := FListBox.Visible and not FMouseIn;
end;
procedure TbsSkinCustomCheckComboBox.ListBoxWindowProcHook(var Message: TMessage);
var
FOld: Boolean;
begin
FOld := True;
case Message.Msg of
WM_LBUTTONUP:
begin
Checked[FListBox.ItemIndex] := not Checked[FListBox.ItemIndex];
Change;
if Assigned(OnClick) then OnClick(Self);
FOld := False;
end;
WM_RBUTTONDOWN, WM_RBUTTONUP,
WM_MBUTTONDOWN, WM_MBUTTONUP,
WM_LBUTTONDOWN, WM_LBUTTONDBLCLK:
begin
FOLd := False;
end;
end;
if FOld then FListBoxWindowProc(Message);
end;
procedure TbsSkinCustomCheckComboBox.CMMouseEnter;
begin
inherited;
FMouseIn := True;
end;
procedure TbsSkinCustomCheckComboBox.CMMouseLeave;
begin
inherited;
FMouseIn := False;
if Button.MouseIn
then
begin
Button.MouseIn := False;
RePaint;
end;
end;
procedure TbsSkinCustomCheckComboBox.SetDropDownCount(Value: Integer);
begin
if Value > 0
then
FDropDownCount := Value;
end;
procedure TbsSkinCustomCheckComboBox.ListBoxMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
var
Index: Integer;
begin
if not FLBDown
then
begin
Index := FListBox.ItemAtPos(Point (X, Y), True);
if (Index >= 0) and (Index < Items.Count)
then
FListBox.ItemIndex := Index;
end;
end;
procedure TbsSkinCustomCheckComboBox.SetItems;
begin
FListBox.Items.Assign(Value);
end;
function TbsSkinCustomCheckComboBox.GetItems;
begin
Result := FListBox.Items;
end;
procedure TbsSkinCustomCheckComboBox.MouseDown;
begin
inherited;
if not Focused then SetFocus;
if Button <> mbLeft then Exit;
if Self.Button.MouseIn or PtInRect(CBItem.R, Point(X, Y))
then
begin
Self.Button.Down := True;
RePaint;
if FListBox.Visible then CloseUp(False) else DropDown;
end
else
if FListBox.Visible then CloseUp(False);
end;
procedure TbsSkinCustomCheckComboBox.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
inherited;
if Self.Button.Down
then
begin
Self.Button.Down := False;
RePaint;
end;
end;
procedure TbsSkinCustomCheckComboBox.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
inherited;
if PtInRect(Button.R, Point(X, Y)) and not Button.MouseIn
then
begin
Button.MouseIn := True;
RePaint;
end
else
if not PtInRect(Button.R, Point(X, Y)) and Button.MouseIn
then
begin
Button.MouseIn := False;
RePaint;
end;
end;
procedure TbsSkinCustomCheckComboBox.CloseUp;
begin
if not FListBox.Visible then Exit;
FListBox.Hide;
if Value
then
begin
RePaint;
if Assigned(FOnCloseUp) then FOnCloseUp(Self);
if Assigned(FOnClick) then FOnClick(Self);
end;
end;
procedure TbsSkinCustomCheckComboBox.DropDown;
function GetForm(AControl : TControl) : TForm;
var
temp : TControl;
begin
result := nil;
temp := AControl;
repeat
if assigned(temp) then
begin
if temp is TForm then
break;
end;
temp := temp.Parent;
until temp = nil;
end;
var
P: TPoint;
WorkArea: TRect;
begin
if Items.Count = 0 then Exit;
if Assigned(FOnDropDown) then FOnDropDown(Self);
if FListBoxWidth = 0
then
FListBox.Width := Width
else
FListBox.Width := FListBoxWidth;
if Items.Count < DropDownCount
then
FListBox.RowCount := Items.Count
else
FListBox.RowCount := DropDownCount;
P := Point(Left, Top + Height);
P := Parent.ClientToScreen (P);
WorkArea := GetMonitorWorkArea(Handle, True);
if P.Y + FListBox.Height > WorkArea.Bottom
then
P.Y := P.Y - Height - FListBox.Height;
if (FListBox.ItemIndex = 0) and (FListBox.Items.Count > 1)
then
begin
FListBox.ItemIndex := 1;
FListBox.ItemIndex := 0;
end;
FListBox.TopIndex := FListBox.ItemIndex;
FListBox.SkinData := SkinData;
FListBox.Show(P);
end;
procedure TbsSkinCustomCheckComboBox.EditPageUp1(AChange: Boolean);
var
Index: Integer;
begin
Index := FListBox.ItemIndex - DropDownCount - 1;
if Index < 0 then Index := 0;
FListBox.ItemIndex := Index;
end;
procedure TbsSkinCustomCheckComboBox.EditPageDown1(AChange: Boolean);
var
Index: Integer;
begin
Index := FListBox.ItemIndex + DropDownCount - 1;
if Index > FListBox.Items.Count - 1
then
Index := FListBox.Items.Count - 1;
FListBox.ItemIndex := Index;
end;
procedure TbsSkinCustomCheckComboBox.EditUp1;
begin
if FListBox.ItemIndex > 0
then
begin
FListBox.ItemIndex := FListBox.ItemIndex - 1;
end;
end;
procedure TbsSkinCustomCheckComboBox.EditDown1;
begin
if FListBox.ItemIndex < FListBox.Items.Count - 1
then
begin
FListBox.ItemIndex := FListBox.ItemIndex + 1;
end;
end;
procedure TbsSkinCustomCheckComboBox.WMSIZE;
begin
inherited;
CalcRects;
end;
procedure TbsSkinCustomCheckComboBox.DrawButton;
var
ArrowColor: TColor;
R1: TRect;
begin
if FIndex = -1
then
with Button do
begin
R1 := R;
if Down and MouseIn
then
begin
Frame3D(C, R1, BS_XP_BTNFRAMECOLOR, BS_XP_BTNFRAMECOLOR, 1);
C.Brush.Color := BS_XP_BTNDOWNCOLOR;
C.FillRect(R1);
end
else
if MouseIn
then
begin
Frame3D(C, R1, BS_XP_BTNFRAMECOLOR, BS_XP_BTNFRAMECOLOR, 1);
C.Brush.Color := BS_XP_BTNACTIVECOLOR;
C.FillRect(R1);
end
else
begin
Frame3D(C, R1, clBtnShadow, clBtnShadow, 1);
C.Brush.Color := clBtnFace;
C.FillRect(R1);
end;
if Enabled
then
ArrowColor := clBlack
else
ArrowColor := clBtnShadow;
DrawArrowImage(C, R, ArrowColor, 4);
end
else
with Button do
begin
R1 := NullRect;
if not Enabled and not IsNullRect(UnEnabledButtonRect)
then
R1 := UnEnabledButtonRect
else
if Down and MouseIn
then R1 := DownButtonRect
else if MouseIn then R1 := ActiveButtonRect;
if not IsNullRect(R1)
then
C.CopyRect(R, Picture.Canvas, R1);
end;
end;
procedure TbsSkinCustomCheckComboBox.DrawDefaultItem;
var
Buffer: TBitMap;
R, R1: TRect;
IX, IY: Integer;
begin
if RectWidth(CBItem.R) <=0 then Exit;
Buffer := TBitMap.Create;
Buffer.Width := RectWidth(CBItem.R);
Buffer.Height := RectHeight(CBItem.R);
R := Rect(0, 0, Buffer.Width, Buffer.Height);
with Buffer.Canvas do
begin
Font.Name := Self.Font.Name;
Font.Style := Self.Font.Style;
Font.Height := Self.Font.Height;
if Focused
then
begin
Brush.Color := clHighLight;
Font.Color := clHighLightText;
end
else
begin
Brush.Color := clWindow;
Font.Color := clWindowText;
end;
FillRect(R);
end;
CBItem.State := [];
if Focused then CBItem.State := [odFocused];
R1 := Rect(R.Left + 2, R.Top, R.Right - 2, R.Bottom);
BSDrawText2(Buffer.Canvas, Text, R1);
if Focused then DrawFocusRect(Buffer.Canvas.Handle, R);
Cnvs.Draw(CBItem.R.Left, CBItem.R.Top, Buffer);
Buffer.Free;
end;
procedure TbsSkinCustomCheckComboBox.DrawSkinItem;
var
Buffer: TBitMap;
R, R2: TRect;
W, H: Integer;
IX, IY: Integer;
begin
W := RectWidth(CBItem.R);
if W <= 0 then Exit;
H := RectHeight(SItemRect);
if H = 0 then H := RectHeight(FocusItemRect);
if H = 0 then H := RectWidth(CBItem.R);
Buffer := TBitMap.Create;
if Focused
then
begin
if not IsNullRect(FocusItemRect)
then
CreateHSkinImage(ItemLeftOffset, ItemRightOffset, Buffer, Picture,
FocusItemRect, W, H)
else
begin
Buffer.Width := W;
BUffer.Height := H;
Buffer.Canvas.CopyRect(Rect(0, 0, W, H), Cnvs, CBItem.R);
end;
end
else
begin
if not IsNullRect(SItemRect)
then
CreateHSkinImage(ItemLeftOffset, ItemRightOffset, Buffer, Picture,
SItemRect, W, H)
else
begin
Buffer.Width := W;
BUffer.Height := H;
Buffer.Canvas.CopyRect(Rect(0, 0, W, H), Cnvs, CBItem.R);
end;
end;
R := ItemTextRect;
if not IsNullRect(SItemRect)
then
Inc(R.Right, W - RectWidth(SItemRect))
else
Inc(R.Right, W - RectWidth(ClRect));
with Buffer.Canvas do
begin
if FUseSkinFont
then
begin
Font.Name := FontName;
Font.Style := FontStyle;
Font.Height := FontHeight;
end
else
Font.Assign(FDefaultFont);
//
if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
then
Font.Charset := SkinData.ResourceStrData.CharSet
else
Font.CharSet := FDefaultFont.CharSet;
//
if Focused
then
Font.Color := FocusFontColor
else
Font.Color := FontColor;
Brush.Style := bsClear;
end;
BSDrawText2(Buffer.Canvas, Text, R);
Cnvs.Draw(CBItem.R.Left, CBItem.R.Top, Buffer);
Buffer.Free;
end;
procedure TbsSkinCustomCheckComboBox.CalcRects;
const
ButtonW = 17;
var
OX: Integer;
begin
if FIndex = -1
then
begin
Button.R := Rect(Width - ButtonW - 2, 2, Width - 2, Height - 2);
CBItem.R := Rect(2, 2, Button.R.Left - 1 , Height - 2);
end
else
begin
OX := Width - RectWidth(SkinRect);
Button.R := ButtonRect;
if ButtonRect.Left >= RectWidth(SkinRect) - RTPt.X
then
OffsetRect(Button.R, OX, 0);
CBItem.R := ClRect;
Inc(CBItem.R.Right, OX);
end;
end;
procedure TbsSkinCustomCheckComboBox.ChangeSkinData;
begin
inherited;
CalcRects;
RePaint;
if FIndex = -1
then
begin
FListBox.SkinDataName := '';
end
else
if ListBoxCaptionMode
then
FListBox.SkinDataName := 'captionchecklistbox'
else
FListBox.SkinDataName := 'checklistbox';
FListBox.SkinData := SkinData;
FListBox.UpDateScrollBar;
end;
procedure TbsSkinCustomCheckComboBox.CreateControlDefaultImage;
var
R: TRect;
begin
CalcRects;
with B.Canvas do
begin
Brush.Color := clBtnFace;
R := ClientRect;
FillRect(R);
end;
Frame3D(B.Canvas, R, clbtnShadow, clbtnShadow, 1);
DrawButton(B.Canvas);
DrawDefaultItem(B.Canvas);
end;
procedure TbsSkinCustomCheckComboBox.CreateControlSkinImage;
begin
CalcRects;
inherited;
DrawButton(B.Canvas);
DrawSkinItem(B.Canvas);
end;
// TbsSkinFontSizeComboBox
function EnumFontSizes(var EnumLogFont: TEnumLogFont;
PTextMetric: PNewTextMetric; FontType: Integer; Data: LPARAM): Integer;
export; stdcall;
var s: String;
i,v,v2: Integer;
begin
if (FontType and TRUETYPE_FONTTYPE) <> 0
then
begin
TbsSkinFontSizeComboBox(Data).Items.Add('8');
TbsSkinFontSizeComboBox(Data).Items.Add('9');
TbsSkinFontSizeComboBox(Data).Items.Add('10');
TbsSkinFontSizeComboBox(Data).Items.Add('11');
TbsSkinFontSizeComboBox(Data).Items.Add('12');
TbsSkinFontSizeComboBox(Data).Items.Add('14');
TbsSkinFontSizeComboBox(Data).Items.Add('16');
TbsSkinFontSizeComboBox(Data).Items.Add('18');
TbsSkinFontSizeComboBox(Data).Items.Add('20');
TbsSkinFontSizeComboBox(Data).Items.Add('22');
TbsSkinFontSizeComboBox(Data).Items.Add('24');
TbsSkinFontSizeComboBox(Data).Items.Add('26');
TbsSkinFontSizeComboBox(Data).Items.Add('28');
TbsSkinFontSizeComboBox(Data).Items.Add('36');
TbsSkinFontSizeComboBox(Data).Items.Add('48');
TbsSkinFontSizeComboBox(Data).Items.Add('72');
Result := 0;
end
else
begin
v := Round((EnumLogFont.elfLogFont.lfHeight-PTextMetric.tmInternalLeading)*72 /
TbsSkinFontSizeComboBox(Data).PixelsPerInch);
s := IntToStr(v);
Result := 1;
for i := 0 to TbsSkinFontSizeComboBox(Data).Items.Count-1 do
begin
v2 := StrToInt(TbsSkinFontSizeComboBox(Data).Items[i]);
if v2 = v then Exit;
if v2 > v
then
begin
TbsSkinFontSizeComboBox(Data).Items.Insert(i,s);
Exit;
end;
end;
TbsSkinFontSizeComboBox(Data).Items.Add(S);
end;
end;
procedure TbsSkinFontSizeComboBox.Build;
var
DC: HDC;
OC: TNotifyEvent;
begin
DC := GetDC(0);
Items.BeginUpdate;
try
Items.Clear;
if FontName<>'' then begin
PixelsPerInch := GetDeviceCaps(DC, LOGPIXELSY);
EnumFontFamilies(DC, PChar(FontName), @EnumFontSizes, Longint(Self));
OC := OnClick;
OnClick := nil;
ItemIndex := Items.IndexOf(Text);
OnClick := OC;
if Assigned(OnClick) then
OnClick(Self);
end;
finally
Items.EndUpdate;
ReleaseDC(0, DC);
end;
end;
procedure TbsSkinFontSizeComboBox.SetFontName(const Value: TFontName);
begin
FFontName := Value;
Build;
end;
function TbsSkinFontSizeComboBox.GetSizeValue: Integer;
function IsNumText(AText: String): Boolean;
function GetMinus: Boolean;
var
i: Integer;
S: String;
begin
S := AText;
i := Pos('-', S);
if i > 1
then
Result := False
else
begin
Delete(S, i, 1);
Result := Pos('-', S) = 0;
end;
end;
const
EditChars = '01234567890-';
var
i: Integer;
S: String;
begin
S := EditChars;
Result := True;
if (Text = '') or (Text = '-')
then
begin
Result := False;
Exit;
end;
for i := 1 to Length(Text) do
begin
if Pos(Text[i], S) = 0
then
begin
Result := False;
Break;
end;
end;
Result := Result and GetMinus;
end;
begin
if Style = bscbFixedStyle
then
begin
if ItemIndex = -1
then
Result := 0
else
if Items[ItemIndex] <> ''
then
Result := StrToInt(Items[ItemIndex])
else
Result := 0;
end
else
begin
if (Text <> '') and (IsNumText(Text))
then
Result := StrToInt(Text)
else
Result := 0;
end;
end;
end.