Delphi控件源码

开发平台：

Delphi

SkinBoxCtrls.pas：源码内容

C: TCanvas;
i, j, DrawCount: Integer;
IR: TRect;
begin
C := TCanvas.Create;
C.Handle := DC;
DrawCount := (Height div ItemHeight) * Columns;
i := TopIndex;
j := i + DrawCount;
if j > Items.Count - 1 then j := Items.Count - 1;
if Items.Count > 0
then
for i := TopIndex to j do
begin
IR := ItemRect(i);
if SkinListBox.FIndex <> -1
then
begin
if SkinListBox.UseSkinItemHeight
then
DrawSkinItem(C, i, IR, GetState1(i))
else
DrawStretchSkinItem(C, i, IR, GetState1(i));
end
else
DrawDefaultItem(C, i, IR, GetState1(i));
end;
C.Free;
end;
procedure TspCheckListBox.PaintList(DC: HDC);
var
C: TCanvas;
i, j, k, DrawCount: Integer;
IR: TRect;
begin
C := TCanvas.Create;
C.Handle := DC;
DrawCount := Height div ItemHeight;
i := TopIndex;
j := i + DrawCount;
if j > Items.Count - 1 then j := Items.Count - 1;
k := 0;
if Items.Count > 0
then
for i := TopIndex to j do
begin
IR := ItemRect(i);
if SkinListBox.FIndex <> -1
then
begin
if SkinListBox.UseSkinItemHeight
then
DrawSkinItem(C, i, IR, GetState1(i))
else
DrawStretchSkinItem(C, i, IR, GetState1(i));
end
else
DrawDefaultItem(C, i, IR, GetState1(i));
k := IR.Bottom;
end;
if k < Height
then
begin
SkinListBox.GetSkinData;
if SkinListBox.FIndex <> -1
then
PaintBGWH(C, Width, Height - k, 0, k)
else
with C do
begin
C.Brush.Color := clWindow;
FillRect(Rect(0, k, Width, Height));
end;
end;
C.Free;
end;
procedure TspCheckListBox.PaintWindow;
var
SaveIndex: Integer;
begin
if (Width <= 0) or (Height <=0) then Exit;
SaveIndex := SaveDC(DC);
try
if Columns > 0
then
PaintColumnsList(DC)
else
PaintList(DC);
finally
RestoreDC(DC, SaveIndex);
end;
end;
procedure TspCheckListBox.WMPaint;
begin
PaintHandler(Msg);
end;
procedure TspCheckListBox.WMEraseBkgnd;
begin
PaintBG(Message.DC);
Message.Result := 1;
end;
procedure TspCheckListBox.DrawDefaultItem;
var
Buffer: TBitMap;
R, R1, CR: TRect;
AState: TCheckBoxState;
IIndex, IX, IY: Integer;
begin
if (ItemID < 0) or (ItemID > Items.Count - 1) then Exit;
AState := GetState(itemID);
Buffer := TBitMap.Create;
Buffer.Width := RectWidth(rcItem);
Buffer.Height := RectHeight(rcItem);
R := Rect(20, 0, Buffer.Width, Buffer.Height);
with Buffer.Canvas do
begin
Font.Name := SkinListBox.Font.Name;
Font.Style := SkinListBox.Font.Style;
Font.Height := SkinListBox.Font.Height;
if odSelected in State1
then
begin
Brush.Color := clHighLight;
Font.Color := clHighLightText;
end
else
begin
Brush.Color := clWindow;
Font.Color := SkinListBox.Font.Color;
end;
FillRect(R);
end;
R1 := Rect(R.Left + 2, R.Top, R.Right - 2, R.Bottom);
CR := Rect(3, Buffer.Height div 2 - 6, 16, Buffer.Height div 2 + 7);
Frame3D(Buffer.Canvas, CR, clBtnShadow, clBtnShadow, 1);
if AState = cbChecked
then
DrawCheckImage(Buffer.Canvas, 6, Buffer.Height div 2 - 4, clWindowText);
if Assigned(SkinListBox.FOnDrawItem)
then
SkinListBox.FOnDrawItem(Buffer.Canvas, ItemID, Buffer.Width, Buffer.Height,
R1, State1)
else
begin
if (SkinListBox.Images <> nil)
then
begin
if SkinListBox.ImageIndex > -1
then IIndex := SkinListBox.FImageIndex
else IIndex := itemID;
if IIndex < SkinListBox.Images.Count
then
begin
IX := R1.Left;
IY := R1.Top + RectHeight(R1) div 2 - SkinListBox.Images.Height div 2;
SkinListBox.Images.Draw(Buffer.Canvas, IX, IY, IIndex);
end;
Inc(R1.Left, SkinListBox.Images.Width + 2);
end;
SPDrawText(Buffer.Canvas, Items[ItemID], R1);
end;
if odFocused in State1 then DrawFocusRect(Buffer.Canvas.Handle, R);
Cnvs.Draw(rcItem.Left, rcItem.Top, Buffer);
Buffer.Free;
end;
procedure TspCheckListBox.DrawStretchSkinItem;
var
Buffer, Buffer2: TBitMap;
R, R1: TRect;
W, H: Integer;
OX, OY: Integer;
AState: TCheckBoxState;
cw, ch, cx, cy: Integer;
IIndex, IX, IY: Integer;
begin
if (SkinListBox.Picture = nil) or (ItemID < 0) or (ItemID > Items.Count - 1) then Exit;
AState := GetState(itemID);
Buffer := TBitMap.Create;
with SkinListBox do
begin
W := RectWidth(rcItem);
H := RectHeight(SItemRect);
Buffer.Width := W;
Buffer.Height := H;
if odFocused in State1
then
CreateHSkinImage(ItemLeftOffset, ItemRightOffset, Buffer, Picture,
FocusItemRect, W, H)
else
if odSelected in State1
then
CreateHSkinImage(ItemLeftOffset, ItemRightOffset, Buffer, Picture,
ActiveItemRect, W, H)
else
CreateHSkinImage(ItemLeftOffset, ItemRightOffset, Buffer, Picture,
SItemRect, W, H);
R := ItemTextRect;
OX := W - RectWidth(SItemRect);
OY := RectHeight(rcItem) - RectHeight(SItemRect);
Inc(R.Right, OX);
Inc(R.Bottom, OY);
R1 := ItemCheckRect;
if R1.Left >= ItemTextRect.Right then OffsetRect(R1, OX, 0);
Inc(R1.Bottom, OY);
cw := RectWidth(CheckImageRect);
ch := RectHeight(CheckImageRect);
cx := R1.Left + RectWidth(R1) div 2;
cy := R1.Top + RectHeight(R1) div 2;
R1 := Rect(cx - cw div 2, cy - ch div 2,
cx - cw div 2 + cw, cy - ch div 2 + ch);
end;
W := RectWidth(rcItem);
H := RectHeight(rcItem);
Buffer2 := TBitMap.Create;
Buffer2.Width := W;
Buffer2.Height := H;
Buffer2.Canvas.StretchDraw(Rect(0, 0, Buffer2.Width, Buffer2.Height), Buffer);
Buffer.Free;
//
if AState = cbChecked
then
SkinDrawCheckImage(R1.Left, R1.Top, SkinListBox.Picture.Canvas, SkinListBox.CheckImageRect, Buffer2.Canvas)
else
SkinDrawCheckImage(R1.Left, R1.Top, SkinListBox.Picture.Canvas, SkinListBox.UnCheckImageRect, Buffer2.Canvas);
//
with Buffer2.Canvas do
begin
if SkinListBox.UseSkinFont
then
begin
Font.Name := SkinListBox.FontName;
Font.Style := SkinListBox.FontStyle;
Font.Height := SkinListBox.FontHeight;
Font.CharSet := SkinListBox.DefaultFont.CharSet;
end
else
Font.Assign(SkinListBox.DefaultFont);
if odFocused in State1
then
Font.Color := SkinListBox.FocusFontColor
else
if odSelected in State1
then
Font.Color := SkinListBox.ActiveFontColor
else
Font.Color := SkinListBox.FontColor;
Brush.Style := bsClear;
end;
if Assigned(SkinListBox.FOnDrawItem)
then
SkinListBox.FOnDrawItem(Buffer2.Canvas, ItemID, Buffer2.Width, Buffer2.Height,
R, State1)
else
begin
if (SkinListBox.Images <> nil)
then
begin
if SkinListBox.ImageIndex > -1
then IIndex := SkinListBox.FImageIndex
else IIndex := itemID;
if IIndex < SkinListBox.Images.Count
then
begin
IX := R.Left;
IY := R.Top + RectHeight(R) div 2 - SkinListBox.Images.Height div 2;
SkinListBox.Images.Draw(Buffer2.Canvas, IX, IY, IIndex);
end;
Inc(R.Left, SkinListBox.Images.Width + 2);
end;
SPDrawText2(Buffer2.Canvas, Items[ItemID], R);
end;
Cnvs.Draw(rcItem.Left, rcItem.Top, Buffer2);
Buffer2.Free;
end;
procedure TspCheckListBox.DrawSkinItem;
var
Buffer: TBitMap;
R, R1: TRect;
W, H: Integer;
OX: Integer;
AState: TCheckBoxState;
cw, ch, cx, cy: Integer;
IIndex, IX, IY: Integer;
begin
if (SkinListBox.Picture = nil) or (ItemID < 0) or (ItemID > Items.Count - 1) then Exit;
AState := GetState(itemID);
Buffer := TBitMap.Create;
with SkinListBox do
begin
W := RectWidth(rcItem);
H := RectHeight(SItemRect);
Buffer.Width := W;
Buffer.Height := H;
if odFocused in State1
then
begin
if not (odSelected in State1)
then
begin
CreateHSkinImage(ItemLeftOffset, ItemRightOffset, Buffer, Picture,
SItemRect, W, H);
R := Rect(0, 0, Buffer.Width, Buffer.Height);
DrawFocusRect(Buffer.Canvas.Handle, R);
end
else
CreateHSkinImage(ItemLeftOffset, ItemRightOffset, Buffer, Picture,
FocusItemRect, W, H)
end
else
if odSelected in State1
then
CreateHSkinImage(ItemLeftOffset, ItemRightOffset, Buffer, Picture,
ActiveItemRect, W, H)
else
CreateHSkinImage(ItemLeftOffset, ItemRightOffset, Buffer, Picture,
SItemRect, W, H);
R := ItemTextRect;
OX := W - RectWidth(SItemRect);
Inc(R.Right, OX);
R1 := ItemCheckRect;
if R1.Left >= ItemTextRect.Right then OffsetRect(R1, OX, 0);
cw := RectWidth(CheckImageRect);
ch := RectHeight(CheckImageRect);
cx := R1.Left + RectWidth(R1) div 2;
cy := R1.Top + RectHeight(R1) div 2;
R1 := Rect(cx - cw div 2, cy - ch div 2,
cx - cw div 2 + cw, cy - ch div 2 + ch);
if AState = cbChecked
then
SkinDrawCheckImage(R1.Left, R1.Top, Picture.Canvas, CheckImageRect, Buffer.Canvas)
else
SkinDrawCheckImage(R1.Left, R1.Top, Picture.Canvas, UnCheckImageRect, Buffer.Canvas);
end;
with Buffer.Canvas do
begin
if SkinListBox.UseSkinFont
then
begin
Font.Name := SkinListBox.FontName;
Font.Style := SkinListBox.FontStyle;
Font.Height := SkinListBox.FontHeight;
Font.CharSet := SkinListBox.DefaultFont.CharSet;
end
else
Font.Assign(SkinListBox.DefaultFont);
if odFocused in State1
then
begin
if not (odSelected in State1)
then
Font.Color := SkinListBox.FontColor
else
Font.Color := SkinListBox.FocusFontColor;
end
else
if odSelected in State1
then
Font.Color := SkinListBox.ActiveFontColor
else
Font.Color := SkinListBox.FontColor;
Brush.Style := bsClear;
end;
if Assigned(SkinListBox.FOnDrawItem)
then
SkinListBox.FOnDrawItem(Buffer.Canvas, ItemID, Buffer.Width, Buffer.Height,
R, State1)
else
begin
if (SkinListBox.Images <> nil)
then
begin
if SkinListBox.ImageIndex > -1
then IIndex := SkinListBox.FImageIndex
else IIndex := itemID;
if IIndex < SkinListBox.Images.Count
then
begin
IX := R.Left;
IY := R.Top + RectHeight(R) div 2 - SkinListBox.Images.Height div 2;
SkinListBox.Images.Draw(Buffer.Canvas, IX, IY, IIndex);
end;
Inc(R.Left, SkinListBox.Images.Width + 2);
end;
SPDrawText(Buffer.Canvas, Items[ItemID], R);
end;
Cnvs.Draw(rcItem.Left, rcItem.Top, Buffer);
Buffer.Free;
end;
procedure TspCheckListBox.CreateParams;
begin
inherited CreateParams(Params);
with Params do
begin
Style := Style and not WS_BORDER;
ExStyle := ExStyle and not WS_EX_CLIENTEDGE;
WindowClass.style := CS_DBLCLKS;
Style := Style or WS_TABSTOP;
end;
end;
procedure TspCheckListBox.CNDrawItem;
var
State: TOwnerDrawState;
begin
with Message.DrawItemStruct^ do
begin
{$IFDEF VER120}
State := TOwnerDrawState(WordRec(LongRec(itemState).Lo).Lo);
{$ELSE}
{$IFDEF VER125}
State := TOwnerDrawState(WordRec(LongRec(itemState).Lo).Lo);
{$ELSE}
State := TOwnerDrawState(LongRec(itemState).Lo);
{$ENDIF}
{$ENDIF}
Canvas.Handle := hDC;
Canvas.Font := Font;
Canvas.Brush := Brush;
if SkinListBox.FIndex <> -1
then
begin
if SkinListBox.UseSkinItemHeight
then
DrawSkinItem(Canvas, itemID, rcItem, State)
else
DrawStretchSkinItem(Canvas, itemID, rcItem, State);
end
else
DrawDefaultItem(Canvas, itemID, rcItem, State);
Canvas.Handle := 0;
end;
end;
procedure TspCheckListBox.WndProc;
var
LParam, WParam: Integer;
begin
inherited;
case Message.Msg of
WM_LBUTTONDBLCLK:
begin
if SkinListBox <> nil then SkinListBox.ListBoxDblClick;
end;
WM_MOUSEWHEEL:
if (SkinListBox <> nil) and (SkinListBox.ScrollBar <> nil)
then
begin
LParam := 0;
if Message.WParam > 0
then
WParam := MakeWParam(SB_LINEUP, 0)
else
WParam := MakeWParam(SB_LINEDOWN, 0);
SendMessage(Handle, WM_VSCROLL, WParam, LParam);
SkinListBox.UpDateScrollBar;
end;
WM_ERASEBKGND:
SkinListBox.UpDateScrollBar;
LB_ADDSTRING, LB_INSERTSTRING,
LB_DELETESTRING:
begin
if SkinListBox <> nil
then
SkinListBox.UpDateScrollBar;
end;
end;
end;
constructor TspSkinCheckListBox.Create;
begin
inherited;
ControlStyle := [csCaptureMouse, csClickEvents,
csOpaque, csDoubleClicks, csReplicatable, csAcceptsControls];
FUseSkinItemHeight := True;
FRowCount := 0;
FGlyph := TBitMap.Create;
FNumGlyphs := 1;
FSpacing := 2;
FImageIndex := -1;
FDefaultCaptionFont := TFont.Create;
FDefaultCaptionFont.OnChange := OnDefaultCaptionFontChange;
FDefaultCaptionFont.Name := 'Arial';
FDefaultCaptionFont.Height := 14;
FDefaultCaptionHeight := 20;
ActiveButton := -1;
OldActiveButton := -1;
CaptureButton := -1;
FCaptionMode := False;
FDefaultItemHeight := 20;
TimerMode := 0;
WaitMode := False;
Font.Name := 'Arial';
Font.Height := 14;
Font.Color := clWindowText;
Font.Style := [];
ScrollBar := nil;
ListBox := TspCheckListBox.Create(Self);
ListBox.SkinListBox := Self;
ListBox.Style := lbOwnerDrawFixed;
ListBox.ItemHeight := FDefaultItemHeight;
ListBox.Parent := Self;
ListBox.Visible := True;
Height := 120;
Width := 120;
FSkinDataName := 'checklistbox';
end;
function TspSkinCheckListBox.GetAutoComplete: Boolean;
begin
Result := ListBox.AutoComplete;
end;
procedure TspSkinCheckListBox.SetAutoComplete(Value: Boolean);
begin
ListBox.AutoComplete := Value;
end;
function TspSkinCheckListBox.GetOnListBoxEndDrag: TEndDragEvent;
begin
Result := ListBox.OnEndDrag;
end;
procedure TspSkinCheckListBox.SetOnListBoxEndDrag(Value: TEndDragEvent);
begin
ListBox.OnEndDrag := Value;
end;
function TspSkinCheckListBox.GetOnListBoxStartDrag: TStartDragEvent;
begin
Result := ListBox.OnStartDrag;
end;
procedure TspSkinCheckListBox.SetOnListBoxStartDrag(Value: TStartDragEvent);
begin
ListBox.OnStartDrag := Value;
end;
function TspSkinCheckListBox.GetOnListBoxDragOver: TDragOverEvent;
begin
Result := ListBox.OnDragOver;
end;
procedure TspSkinCheckListBox.SetOnListBoxDragOver(Value: TDragOverEvent);
begin
ListBox.OnDragOver := Value;
end;
function TspSkinCheckListBox.GetOnListBoxDragDrop: TDragDropEvent;
begin
Result := ListBox.OnDragDrop;
end;
procedure TspSkinCheckListBox.SetOnListBoxDragDrop(Value: TDragDropEvent);
begin
ListBox.OnDragDrop := Value;
end;
function TspSkinCheckListBox.GetColumns;
begin
Result := ListBox.Columns;
end;
function TspSkinCheckListBox.GetListBoxDragMode: TDragMode;
begin
Result := ListBox.DragMode;
end;
procedure TspSkinCheckListBox.SetListBoxDragMode(Value: TDragMode);
begin
ListBox.DragMode := Value;
end;
function TspSkinCheckListBox.GetListBoxDragKind: TDragKind;
begin
Result := ListBox.DragKind;
end;
procedure TspSkinCheckListBox.SetListBoxDragKind(Value: TDragKind);
begin
ListBox.DragKind := Value;
end;
function TspSkinCheckListBox.GetListBoxDragCursor: TCursor;
begin
Result := ListBox.DragCursor;
end;
procedure TspSkinCheckListBox.SetListBoxDragCursor(Value: TCursor);
begin
ListBox.DragCursor := Value;
end;
procedure TspSkinCheckListBox.SetColumns;
begin
ListBox.Columns := Value;
UpDateScrollBar;
end;
procedure TspSkinCheckListBox.SetRowCount;
begin
FRowCount := Value;
if FRowCount <> 0
then
Height := Self.CalcHeight(FRowCount);
end;
procedure TspSkinCheckListBox.SetImages(Value: TCustomImageList);
begin
FImages := Value;
ListBox.RePaint;
end;
procedure TspSkinCheckListBox.SetImageIndex(Value: Integer);
begin
FImageIndex := Value;
ListBox.RePaint;
end;
procedure TspSkinCheckListBox.SetNumGlyphs;
begin
FNumGlyphs := Value;
RePaint;
end;
procedure TspSkinCheckListBox.SetGlyph;
begin
FGlyph.Assign(Value);
RePaint;
end;
procedure TspSkinCheckListBox.SetSpacing;
begin
FSpacing := Value;
RePaint;
end;
procedure TspSkinCheckListBox.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (AComponent = Images) then
Images := nil;
end;
procedure TspSkinCheckListBox.OnDefaultCaptionFontChange;
begin
if (FIndex = -1) and FCaptionMode then RePaint;
end;
procedure TspSkinCheckListBox.SetDefaultCaptionHeight;
begin
FDefaultCaptionHeight := Value;
if (FIndex = -1) and FCaptionMode
then
begin
CalcRects;
RePaint;
end;
end;
procedure TspSkinCheckListBox.SetDefaultCaptionFont;
begin
FDefaultCaptionFont.Assign(Value);
end;
procedure TspSkinCheckListBox.StartTimer;
begin
KillTimer(Handle, 1);
SetTimer(Handle, 1, 100, nil);
end;
procedure TspSkinCheckListBox.SetDefaultItemHeight;
begin
FDefaultItemHeight := Value;
if FIndex = -1
then
ListBox.ItemHeight := FDefaultItemHeight;
end;
procedure TspSkinCheckListBox.StopTimer;
begin
KillTimer(Handle, 1);
TimerMode := 0;
end;
procedure TspSkinCheckListBox.WMTimer;
begin
inherited;
if WaitMode
then
begin
WaitMode := False;
StartTimer;
Exit;
end;
case TimerMode of
1: if ItemIndex > 0 then ItemIndex := ItemIndex - 1;
2: ItemIndex := ItemIndex + 1;
end;
end;
procedure TspSkinCheckListBox.CreateControlSkinImage;
var
GX, GY, GlyphNum, TX, TY, i, OffX, OffY: Integer;
function GetGlyphTextWidth: Integer;
begin
Result := B.Canvas.TextWidth(Caption);
if not FGlyph.Empty then Result := Result + FGlyph.Width div FNumGlyphs + FSpacing;
end;
function CalcBRect(BR: TRect): TRect;
var
R: TRect;
begin
R := BR;
if BR.Top <= LTPt.Y
then
begin
if BR.Left > RTPt.X then OffsetRect(R, OffX, 0);
end
else
begin
OffsetRect(R, 0, OffY);
if BR.Left > RBPt.X then OffsetRect(R, OffX, 0);
end;
Result := R;
end;
begin
inherited;
// calc rects
OffX := Width - RectWidth(SkinRect);
OffY := Height - RectHeight(SkinRect);
NewClRect := ClRect;
Inc(NewClRect.Right, OffX);
Inc(NewClRect.Bottom, OffY);
if FCaptionMode
then
begin
NewCaptionRect := CaptionRect;
if CaptionRect.Right >= RTPt.X
then
Inc(NewCaptionRect.Right, OffX);
Buttons[0].R := CalcBRect(UpButtonRect);
Buttons[1].R := CalcBRect(DownButtonRect);
Buttons[2].R := CalcBRect(CheckButtonRect);
end;
// paint caption
if not IsNullRect(CaptionRect)
then
with B.Canvas do
begin
Font.Name := CaptionFontName;
Font.Height := CaptionFontHeight;
Font.Color := CaptionFontColor;
Font.Style := CaptionFontStyle;
Font.CharSet := DefaultCaptionFont.CharSet;
TY := NewCaptionRect.Top + RectHeight(NewCaptionRect) div 2 -
TextHeight(Caption) div 2;
TX := NewCaptionRect.Left + 2;
case Alignment of
taCenter: TX := TX + RectWidth(NewCaptionRect) div 2 - GetGlyphTextWidth div 2;
taRightJustify: TX := NewCaptionRect.Right - GetGlyphTextWidth - 2;
end;
Brush.Style := bsClear;
if not FGlyph.Empty
then
begin
GY := NewCaptionRect.Top + RectHeight(NewCaptionRect) div 2 - FGlyph.Height div 2;
GX := TX;
TX := GX + FGlyph.Width div FNumGlyphs + FSpacing;
GlyphNum := 1;
if not Enabled and (NumGlyphs = 2) then GlyphNum := 2;
end;
TextRect(NewCaptionRect, TX, TY, Caption);
if not FGlyph.Empty
then DrawGlyph(B.Canvas, GX, GY, FGlyph, NumGlyphs, GlyphNum);
end;
// paint buttons
for i := 0 to 2 do DrawButton(B.Canvas, i);
end;
procedure TspSkinCheckListBox.CreateControlDefaultImage;
function GetGlyphTextWidth: Integer;
begin
Result := B.Canvas.TextWidth(Caption);
if not FGlyph.Empty then Result := Result + FGlyph.Width div FNumGlyphs + FSpacing;
end;
var
BW, i, TX, TY: Integer;
R: TRect;
GX, GY: Integer;
GlyphNum: Integer;
begin
inherited;
if FCaptionMode
then
begin
BW := 17;
if BW > FDefaultCaptionHeight - 3 then BW := FDefaultCaptionHeight - 3;
Buttons[0].R := Rect(Width - BW - 2, 2, Width - 2, 1 + BW);
Buttons[1].R := Rect(Buttons[0].R.Left - BW, 2, Buttons[0].R.Left, 1 + BW);
Buttons[2].R := Rect(Buttons[1].R.Left - BW, 2, Buttons[1].R.Left, 1 + BW);
end;
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);
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 TspSkinCheckListBox.CMMouseEnter;
begin
inherited;
if FCaptionMode
then
TestActive(-1, -1);
end;
procedure TspSkinCheckListBox.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 TspSkinCheckListBox.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 TspSkinCheckListBox.MouseUp;
begin
if FCaptionMode
then
begin
if CaptureButton <> -1
then ButtonUp(CaptureButton, X, Y);
CaptureButton := -1;
end;
inherited;
end;
procedure TspSkinCheckListBox.MouseMove;
begin
inherited;
if FCaptionMode then TestActive(X, Y);
end;
procedure TspSkinCheckListBox.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 TspSkinCheckListBox.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 TspSkinCheckListBox.ButtonUp;
begin
Buttons[i].Down := False;
if ActiveButton <> i then Buttons[i].MouseIn := False;
DrawButton(Canvas, i);
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 TspSkinCheckListBox.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 TspSkinCheckListBox.ButtonLeave(I: Integer);
begin
Buttons[i].MouseIn := False;
DrawButton(Canvas, i);
if (TimerMode <> 0) and Buttons[i].Down
then KillTimer(Handle, 1);
end;
procedure TspSkinCheckListBox.CMTextChanged;
begin
inherited;
if FCaptionMode then RePaint;
end;
procedure TspSkinCheckListBox.SetAlignment(Value: TAlignment);
begin
if FAlignment <> Value
then
begin
FAlignment := Value;
if FCaptionMode then RePaint;
end;
end;
procedure TspSkinCheckListBox.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, SP_XP_BTNFRAMECOLOR, SP_XP_BTNFRAMECOLOR, 1);
Cnvs.Brush.Color := SP_XP_BTNDOWNCOLOR;
Cnvs.FillRect(R1);
end
else
if MouseIn
then
begin
Frame3D(Cnvs, R1, SP_XP_BTNFRAMECOLOR, SP_XP_BTNFRAMECOLOR, 1);
Cnvs.Brush.Color := SP_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 TspSkinCheckListBox.SetCaptionMode;
begin
FCaptionMode := Value;
if FIndex = -1
then
begin
CalcRects;
RePaint;
end;
end;
procedure TspSkinCheckListBox.ListBoxOnClickCheck(Sender: TObject);
begin
if Assigned(FOnClickCheck) then FOnClickCheck(Self);
end;
procedure TspSkinCheckListBox.SetChecked;
begin
ListBox.Checked[Index] := Checked;
end;
function TspSkinCheckListBox.GetChecked;
begin
Result := ListBox.Checked[Index];
end;
procedure TspSkinCheckListBox.SetState;
begin
ListBox.State[Index] := AState;
end;
function TspSkinCheckListBox.GetState;
begin
Result := ListBox.State[Index];
end;
function TspSkinCheckListBox.CalcHeight;
begin
if FIndex = -1
then
Result := AitemsCount * ListBox.ItemHeight + 4
else
Result := ClRect.Top + AitemsCount * ListBox.ItemHeight +
RectHeight(SkinRect) - ClRect.Bottom;
end;
procedure TspSkinCheckListBox.Clear;
begin
ListBox.Clear;
end;
function TspSkinCheckListBox.ItemAtPos(Pos: TPoint; Existing: Boolean): Integer;
begin
Result := ListBox.ItemAtPos(Pos, Existing);
end;
function TspSkinCheckListBox.ItemRect(Item: Integer): TRect;
begin
Result := ListBox.ItemRect(Item);
end;
function TspSkinCheckListBox.GetListBoxPopupMenu;
begin
Result := ListBox.PopupMenu;
end;
procedure TspSkinCheckListBox.SetListBoxPopupMenu;
begin
ListBox.PopupMenu := Value;
end;
function TspSkinCheckListBox.GetCanvas: TCanvas;
begin
Result := ListBox.Canvas;
end;
function TspSkinCheckListBox.GetExtandedSelect: Boolean;
begin
Result := ListBox.ExtendedSelect;
end;
procedure TspSkinCheckListBox.SetExtandedSelect(Value: Boolean);
begin
ListBox.ExtendedSelect := Value;
end;
function TspSkinCheckListBox.GetSelCount: Integer;
begin
Result := ListBox.SelCount;
end;
function TspSkinCheckListBox.GetSelected(Index: Integer): Boolean;
begin
Result := ListBox.Selected[Index];
end;
procedure TspSkinCheckListBox.SetSelected(Index: Integer; Value: Boolean);
begin
ListBox.Selected[Index] := Value;
end;
function TspSkinCheckListBox.GetSorted: Boolean;
begin
Result := ListBox.Sorted;
end;
procedure TspSkinCheckListBox.SetSorted(Value: Boolean);
begin
if ScrollBar <> nil then HideScrollBar;
ListBox.Sorted := Value;
end;
function TspSkinCheckListBox.GetTopIndex: Integer;
begin
Result := ListBox.TopIndex;
end;
procedure TspSkinCheckListBox.SetTopIndex(Value: Integer);
begin
ListBox.TopIndex := Value;
end;
function TspSkinCheckListBox.GetMultiSelect: Boolean;
begin
Result := ListBox.MultiSelect;
end;
procedure TspSkinCheckListBox.SetMultiSelect(Value: Boolean);
begin
ListBox.MultiSelect := Value;
end;
function TspSkinCheckListBox.GetListBoxFont: TFont;
begin
Result := ListBox.Font;
end;
procedure TspSkinCheckListBox.SetListBoxFont(Value: TFont);
begin
ListBox.Font.Assign(Value);
end;
function TspSkinCheckListBox.GetListBoxTabOrder: TTabOrder;
begin
Result := ListBox.TabOrder;
end;
procedure TspSkinCheckListBox.SetListBoxTabOrder(Value: TTabOrder);
begin
ListBox.TabOrder := Value;
end;
function TspSkinCheckListBox.GetListBoxTabStop: Boolean;
begin
Result := ListBox.TabStop;
end;
procedure TspSkinCheckListBox.SetListBoxTabStop(Value: Boolean);
begin
ListBox.TabStop := Value;
end;
procedure TspSkinCheckListBox.ShowScrollBar;
begin
ScrollBar := TspSkinScrollBar.Create(Self);
with ScrollBar do
begin
Parent := Self;
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;
CalcRects;
Visible := True;
end;
RePaint;
end;
procedure TspSkinCheckListBox.ListBoxEnter;
begin
end;
procedure TspSkinCheckListBox.ListBoxExit;
begin
end;
procedure TspSkinCheckListBox.ListBoxKeyDown;
begin
if Assigned(FOnListBoxKeyDown) then FOnListBoxKeyDown(Self, Key, Shift);
end;
procedure TspSkinCheckListBox.ListBoxKeyUp;
begin
if Assigned(FOnListBoxKeyUp) then FOnListBoxKeyUp(Self, Key, Shift);
end;
procedure TspSkinCheckListBox.ListBoxKeyPress;
begin
if Assigned(FOnListBoxKeyPress) then FOnListBoxKeyPress(Self, Key);
end;
procedure TspSkinCheckListBox.ListBoxDblClick;
begin
if Assigned(FOnListBoxDblClick) then FOnListBoxDblClick(Self);
end;
procedure TspSkinCheckListBox.ListBoxClick;
begin
if Assigned(FOnListBoxClick) then FOnListBoxClick(Self);
end;
procedure TspSkinCheckListBox.ListBoxMouseDown;
begin
if Assigned(FOnListBoxMouseDown) then FOnListBoxMouseDown(Self, Button, Shift, X, Y);
end;
procedure TspSkinCheckListBox.ListBoxMouseMove;
begin
if Assigned(FOnListBoxMouseMove) then FOnListBoxMouseMove(Self, Shift, X, Y);
end;
procedure TspSkinCheckListBox.ListBoxMouseUp;
begin
if Assigned(FOnListBoxMouseUp) then FOnListBoxMouseUp(Self, Button, Shift, X, Y);
end;
procedure TspSkinCheckListBox.HideScrollBar;
begin
ScrollBar.Visible := False;
ScrollBar.Free;
ScrollBar := nil;
CalcRects;
end;
procedure TspSkinCheckListBox.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 TspSkinCheckListBox.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 TspSkinCheckListBox.GetItemIndex;
begin
Result := ListBox.ItemIndex;
end;
procedure TspSkinCheckListBox.SetItemIndex;
begin
ListBox.ItemIndex := Value;
end;
procedure TspSkinCheckListBox.SetItems;
begin
ListBox.Items.Assign(Value);
UpDateScrollBar;
end;
function TspSkinCheckListBox.GetItems;
begin
Result := ListBox.Items;
end;
destructor TspSkinCheckListBox.Destroy;
begin
if ScrollBar <> nil then ScrollBar.Free;
if ListBox <> nil then ListBox.Free;
FDefaultCaptionFont.Free;
FGlyph.Free;
inherited;
end;
procedure TspSkinCheckListBox.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 TspSkinCheckListBox.GetSkinData;
begin
inherited;
if FIndex <> -1
then
if TspDataSkinControl(FSD.CtrlList.Items[FIndex]) is TspDataSkinListBox
then
with TspDataSkinCheckListBox(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 TspSkinCheckListBox.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 TspSkinCheckListBox.WMSIZE;
begin
inherited;
CalcRects;
UpDateScrollBar;
if ScrollBar <> nil then ScrollBar.Repaint;
end;
procedure TspSkinCheckListBox.SetBounds;
begin
inherited;
if FIndex = -1 then RePaint;
end;
procedure TspSkinCheckListBox.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 TspSkinScrollBox.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 TspSkinScrollBox.Destroy;
begin
inherited;
end;
procedure TspSkinScrollBox.UpdateScrollRange;
begin
GetHRange;
GetVRange;
end;
procedure TspSkinScrollBox.CMVisibleChanged;
begin
inherited;
if FVScrollBar <> nil then FVScrollBar.Visible := Self.Visible;
if FHScrollBar <> nil then FHScrollBar.Visible := Self.Visible;
end;
procedure TspSkinScrollBox.OnHScrollBarChange(Sender: TObject);
begin
HScrollControls(FHScrollBar.Position - FOldHScrollBarPos);
FOldHScrollBarPos := HScrollBar.Position;
end;
procedure TspSkinScrollBox.OnVScrollBarChange(Sender: TObject);
begin
VScrollControls(FVScrollBar.Position - FOldVScrollBarPos);
FOldVScrollBarPos := VScrollBar.Position;
end;
procedure TspSkinScrollBox.OnHScrollBarLastChange(Sender: TObject);
begin
Invalidate;
end;
procedure TspSkinScrollBox.OnVScrollBarLastChange(Sender: TObject);
begin
Invalidate;
end;
procedure TspSkinScrollBox.ChangeSkinData;
begin
inherited;
ReCreateWnd;
if FVScrollBar <> nil then FVScrollBar.Align := FVScrollBar.Align;
if FHScrollBar <> nil then FHScrollBar.Align := FHScrollBar.Align;
end;
procedure TspSkinScrollBox.HScroll;
begin
if (FHScrollBar <> nil) and (FHScrollBar.PageSize <> 0)
then
with FHScrollBar do
begin
HScrollControls(APosition - Position);
Position := APosition;
end;
end;
procedure TspSkinScrollBox.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 TspSkinScrollBox.SetBorderStyle;
begin
FBorderStyle := Value;
ReCreateWnd;
end;
procedure TspSkinScrollBox.GetSkinData;
begin
inherited;
BGPictureIndex := -1;
if FIndex <> -1
then
if TspDataSkinControl(FSD.CtrlList.Items[FIndex]) is TspDataSkinScrollBoxControl
then
with TspDataSkinScrollBoxControl(FSD.CtrlList.Items[FIndex]) do
begin
Self.BGPictureIndex := BGPictureIndex;
end;
end;
procedure TspSkinScrollBox.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 TspSkinScrollBox.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 TspSkinScrollBox.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 TspSkinScrollBox.CreateControlDefaultImage;
var
R: TRect;
begin
with B.Canvas do
begin
Brush.Color := clBtnFace;
R := ClientRect;
FillRect(R);
end;
end;
type
TParentControl = class(TWinControl);
procedure TspSkinScrollBox.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;
if (Align <> alNone)
then
begin
R := Parent.ClientRect;
TParentControl(Parent).AlignControls(nil, R);
end;
FInCheckScrollBars := False;
end;
end;
procedure TspSkinScrollBox.VScrollControls;
begin
ScrollBy(0, -AOffset);
end;
procedure TspSkinScrollBox.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 TspSkinScrollBox.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 TspSkinScrollBox.HScrollControls;
begin
ScrollBy(-AOffset, 0);
end;
procedure TspSkinScrollBox.WMWindowPosChanging;
begin
inherited;
if HandleAllocated and (Align = alNone)
then
begin
GetVRange;
GetHRange;
end;
end;
procedure TspSkinScrollBox.SetBounds;
var
OldHeight, OldWidth: Integer;
R: TRect;
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 TspSkinScrollBox.WMNCCALCSIZE;
begin
GetSkinData;
if FIndex = -1
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 TspSkinScrollBox.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 TspSkinScrollBox.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 TspSkinScrollBox.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 TspSkinScrollBox.WMSIZE;
begin
inherited;
SendMessage(Handle, WM_NCPAINT, 0, 0);
end;
procedure TspSkinScrollBox.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 TspPopupCalendar.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := ControlStyle + [csNoDesignVisible, csReplicatable];
end;
procedure TspPopupCalendar.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
with Params do
begin
Style := WS_POPUP;
ExStyle := WS_EX_TOOLWINDOW;
WindowClass.Style := CS_SAVEBITS;
end;
end;
procedure TspPopupCalendar.WMMouseActivate(var Message: TMessage);
begin
Message.Result := MA_NOACTIVATE;
end;
constructor TspSkinDateEdit.Create(AOwner: TComponent);
begin
inherited;
EditMask := GetDateMask;
FTodayDefault := False;
ButtonMode := True;
FSkinDataName := 'buttonedit';
FMonthCalendar := TspPopupCalendar.Create(Self);
FMonthCalendar.Parent := Self;
FMonthCalendar.Visible := False;
FMonthCalendar.OnNumberClick := CalendarClick;
OnButtonClick := ButtonClick;
FCalendarAlphaBlend := False;
FCalendarAlphaBlendValue := 0;
FCalendarAlphaBlendAnimation := False;
end;
destructor TspSkinDateEdit.Destroy;
begin
FMonthCalendar.Free;
inherited;
end;
function TspSkinDateEdit.IsDateInput: Boolean;
begin
Result := IsValidText(Text);
end;
function TspSkinDateEdit.GetFirstDayOfWeek;
begin
Result := FMonthCalendar.FirstDayOfWeek;
end;
procedure TspSkinDateEdit.SetFirstDayOfWeek;
begin
FMonthCalendar.FirstDayOfWeek := Value;
end;
function TspSkinDateEdit.GetDate: TDate;
begin
Result := FMonthCalendar.Date;
end;
procedure TspSkinDateEdit.SetDate(Value: TDate);
begin
FMonthCalendar.Date := Value;
StopCheck := True;
if not (csLoading in ComponentState) or FTodayDefault
then
begin
Text := DateToStr(Value);
end;
StopCheck := False;
if Assigned(FOnDateChange) then FOnDateChange(Self);
end;
function TspSkinDateEdit.GetDateMask: String;
var
S: String;
S1: array[1..3] of String;
i, j: Integer;
MPos, DPos, YPos: Integer;
begin
S := DateToStr(EncodeDate(9999, 12, 31));
YPos := 1;
MPos := 1;
Dpos := 1;
j := 1;
for i := 1 to 3 do s1[i] := '';
for i := 1 to Length(S) do
if S[i] = DateSeparator then inc(j) else s1[j] := s1[j] + S[i];
for i := 1 to 3 do
begin
j := StrToInt(s1[i]);
case j of
12: MPos := i;
31: DPos := i;
9999: YPos := i;
99: YPos := i;
end;
end;
Result := '!';
for i := 1 to Length(s1[DPos]) do S1[DPos][i] := '9';
for i := 1 to Length(s1[MPos]) do S1[MPos][i] := '9';
for i := 1 to Length(s1[YPos]) do S1[YPos][i] := '0';
Result := Result + s1[1] + '/' + s1[2] + '/' + s1[3] + ';1; ';
end;
procedure TspSkinDateEdit.Loaded;
begin
inherited;
EditMask := GetDateMask;
if FTodayDefault then Date := Now;
end;
procedure TspSkinDateEdit.SetTodayDefault;
begin
FTodayDefault := Value;
if FTodayDefault then Date := Now;
end;
function TspSkinDateEdit.GetCalendarFont;
begin
Result := FMonthCalendar.DefaultFont;
end;
procedure TspSkinDateEdit.SetCalendarFont;
begin
FMonthCalendar.DefaultFont.Assign(Value);
end;
function TspSkinDateEdit.GetCalendarWidth: Integer;
begin
Result := FMonthCalendar.Width;
end;
procedure TspSkinDateEdit.SetCalendarWidth(Value: Integer);
begin
FMonthCalendar.Width := Value;
end;
function TspSkinDateEdit.GetCalendarHeight: Integer;
begin
Result := FMonthCalendar.Height;
end;
procedure TspSkinDateEdit.SetCalendarHeight(Value: Integer);
begin
FMonthCalendar.Height := Value;
end;
procedure TspSkinDateEdit.Change;
begin
inherited;
if not StopCheck
then
if IsValidText(Text) then CheckValidDate;
end;
procedure TspSkinDateEdit.CheckValidDate;
var
OldDate: TDate;
begin
OldDate := FMonthCalendar.Date;
try
FMonthCalendar.Date := StrToDate(Text);
finally
if OldDate <> FMonthCalendar.Date
then
if Assigned(FOnDateChange) then FOnDateChange(Self);
end;
end;
function TspSkinDateEdit.IsValidText;
var
F: String;
s1, s2: array[1..3] of String;
i, j: Integer;
MPos, DPos, YPos: Integer;
begin
Result := Pos(' ', S) = 0;
if not Result then Exit;
F := DateToStr(EncodeDate(9999, 12, 31));
for i := 1 to 3 do s1[i] := '';
for i := 1 to 3 do s2[i] := '';
j := 1;
YPos := 1;
MPos := 1;
Dpos := 1;
for i := 1 to Length(F) do
if F[i] = DateSeparator then inc(j) else s1[j] := s1[j] + F[i];
for i := 1 to 3 do
begin
j := StrToInt(s1[i]);
case j of
12: MPos := i;
31: DPos := i;
9999: YPos := i;
99: YPos := i;
end;
end;
j := 1;
for i := 1 to Length(S) do
if S[i] = DateSeparator then inc(j) else s2[j] := s2[j] + S[i];
if StrToInt(s2[Ypos]) = 0
then
Result := Length(s2[YPos]) < 2
else
Result := True;
Result := Result and
(Length(s1) = Length(s2)) and
(StrToInt(s2[Mpos]) > 0) and
(StrToInt(s2[Dpos]) > 0) and
(StrToInt(s2[1]) <= StrToInt(s1[1])) and
(StrToInt(s2[2]) <= StrToInt(s1[2])) and
(StrToInt(s2[3]) <= StrToInt(s1[3]));
end;
procedure TspSkinDateEdit.CMCancelMode;
begin
if (Message.Sender <> FMonthCalendar) and
not FMonthCalendar.ContainsControl(Message.Sender)
then
CloseUp(False);
end;
procedure TspSkinDateEdit.WndProc;
begin
inherited;
case Message.Msg of
WM_KILLFOCUS:
begin
if not FMonthCalendar.Visible
then
begin
StopCheck := True;
Text := DateToStr(FMonthCalendar.Date);
StopCheck := False;
end
else
if Message.wParam <> FMonthCalendar.Handle
then
CloseUp(False);
end;
WM_KEYDOWN:
CloseUp(False);
end;
end;
procedure TspSkinDateEdit.DropDown;
var
P: TPoint;
Y, I: Integer;
begin
P := Parent.ClientToScreen(Point(Left, Top));
Y := P.Y + Height;
if Y + FMonthCalendar.Height > Screen.Height then Y := P.Y - FMonthCalendar.Height;
//
if CheckW2KWXP and FCalendarAlphaBlend
then
begin
SetWindowLong(FMonthCalendar.Handle, GWL_EXSTYLE,
GetWindowLong(Handle, GWL_EXSTYLE) or WS_EX_LAYERED);
SetAlphaBlendTransparent(FMonthCalendar.Handle, 0)
end;
//
FMonthCalendar.SkinData := Self.SkinData;
SetWindowPos(FMonthCalendar.Handle, HWND_TOP, P.X, Y, 0, 0,
SWP_NOSIZE or SWP_NOACTIVATE or SWP_SHOWWINDOW);
FMonthCalendar.Visible := True;
//
if FCalendarAlphaBlend and not FCalendarAlphaBlendAnimation and CheckW2KWXP
then
begin
Application.ProcessMessages;
SetAlphaBlendTransparent(FMonthCalendar.Handle, FCalendarAlphaBlendValue)
end
else
if FCalendarAlphaBlendAnimation and FCalendarAlphaBlend and CheckW2KWXP
then
begin
Application.ProcessMessages;
I := 0;
repeat
Inc(i, 2);
if i > FCalendarAlphaBlendValue then i := FCalendarAlphaBlendValue;
SetAlphaBlendTransparent(FMonthCalendar.Handle, i);
until i >= FCalendarAlphaBlendValue;
end;
end;
procedure TspSkinDateEdit.CloseUp(AcceptValue: Boolean);
begin
if FMonthCalendar.Visible
then
begin
SetWindowPos(FMonthCalendar.Handle, 0, 0, 0, 0, 0, SWP_NOZORDER or
SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE or SWP_HIDEWINDOW);
FMonthCalendar.Visible := False;
if CheckW2KWXP and FCalendarAlphaBlend
then
SetWindowLong(FMonthCalendar.Handle, GWL_EXSTYLE,
GetWindowLong(Handle, GWL_EXSTYLE) and not WS_EX_LAYERED);
if AcceptValue
then
begin
StopCheck := True;
Text := DateToStr(FMonthCalendar.Date);
if Assigned(FOnDateChange) then FOnDateChange(Self);
StopCheck := False;
end;
SetFocus;
end;
end;
procedure TspSkinDateEdit.ButtonClick(Sender: TObject);
begin
if FMonthCalendar.Visible
then
CloseUp(False)
else
DropDown;
end;
procedure TspSkinDateEdit.CalendarClick;
begin
CloseUp(True);
end;
constructor TspPopupListBox.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := ControlStyle + [csNoDesignVisible, csReplicatable,
csAcceptsControls];
Ctl3D := False;
ParentCtl3D := False;
Visible := False;
FOldAlphaBlend := False;
FOldAlphaBlendValue := 0;
end;
procedure TspPopupListBox.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;
end;
end;
procedure TspPopupListBox.WMMouseActivate(var Message: TMessage);
begin
Message.Result := MA_NOACTIVATE;
end;
procedure TspPopupListBox.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 TspPopupListBox.Show(Origin: TPoint);
var
PLB: TspSkinCustomComboBox;
I: Integer;
begin
PLB := nil;
//
if CheckW2KWXP and (Owner is TspSkinCustomComboBox)
then
begin
PLB := TspSkinCustomComboBox(Owner);
if PLB.ListBoxAlphaBlend and not FOldAlphaBlend
then
begin
SetWindowLong(Handle, GWL_EXSTYLE,
GetWindowLong(Handle, GWL_EXSTYLE) or WS_EX_LAYERED);
end
else
if not PLB.ListBoxAlphaBlend and FOldAlphaBlend
then
begin
SetWindowLong(Handle, GWL_EXSTYLE,
GetWindowLong(Handle, GWL_EXSTYLE) and (not WS_EX_LAYERED));
end;
FOldAlphaBlend := PLB.ListBoxAlphaBlend;
if (FOldAlphaBlendValue <> PLB.ListBoxAlphaBlendValue) and PLB.ListBoxAlphaBlend
then
begin
if PLB.ListBoxAlphaBlendAnimation
then
begin
SetAlphaBlendTransparent(Handle, 0);
FOldAlphaBlendValue := 0;
end
else
begin
SetAlphaBlendTransparent(Handle, PLB.ListBoxAlphaBlendValue);
FOldAlphaBlendValue := PLB.ListBoxAlphaBlendValue;
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.ListBoxAlphaBlendAnimation and PLB.ListBoxAlphaBlend
then
begin
Application.ProcessMessages;
I := 0;
repeat
Inc(i, 2);
if i > PLB.ListBoxAlphaBlendValue then i := PLB.ListBoxAlphaBlendValue;
SetAlphaBlendTransparent(Handle, i);
until i >= PLB.ListBoxAlphaBlendValue;
end;
end;
// ======================== TspSkinTrackEdit ========================== //
constructor TspSkinTrackEdit.Create(AOwner: TComponent);
begin
inherited;
FTrackBarWidth := 0;
FTrackBarSkinDataName := 'htrackbar';
ButtonMode := True;
FMinValue := 0;
FMaxValue := 100;
FValue := 0;
StopCheck := True;
Text := '0';
StopCheck := False;
Width := 120;
Height := 20;
FSkinDataName := 'buttonedit';
OnButtonClick := ButtonClick;
FPopupTrackBar := TspSkinPopupTrackBar.Create(Self);
FPopupTrackBar.Visible := False;
FPopupTrackBar.TrackEdit := Self;
FPopupTrackBar.Parent := Self;
FPopupTrackBar.OnChange := TrackBarChange;
FTrackBarAlphaBlend := False;
FTrackBarAlphaBlendAnimation := False;
FTrackBarAlphaBlendValue := 0;
end;
destructor TspSkinTrackEdit.Destroy;
begin
FPopupTrackBar.Free;
inherited;
end;
function TspSkinTrackEdit.GetJumpWhenClick: Boolean;
begin
Result := FPopupTrackBar.JumpWhenClick;
end;
procedure TspSkinTrackEdit.SetJumpWhenClick(Value: Boolean);
begin
FPopupTrackBar.JumpWhenClick := Value;
end;
procedure TspSkinTrackEdit.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 TspSkinTrackEdit.CMCancelMode(var Message: TCMCancelMode);
begin
if (Message.Sender <> FPopupTrackBar)
then
CloseUp;
end;
procedure TspSkinTrackEdit.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 FTrackBarAlphaBlend
then
SetWindowLong(FPopupTrackBar.Handle, GWL_EXSTYLE,
GetWindowLong(Handle, GWL_EXSTYLE) and not WS_EX_LAYERED);
end;
end;
procedure TspSkinTrackEdit.DropDown;
var
P: TPoint;
X, Y, I: 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;
P := Parent.ClientToScreen(Point(Left, Top));
Y := P.Y + Height;
if P.X + FPopupTrackBar.Width > Screen.Width
then
P.X := P.X - ((P.X + FPopupTrackBar.Width) - Screen.Width);
if Y + FPopupTrackBar.Height > Screen.Height
then
Y := P.Y - FPopupTrackBar.Height;
//
if CheckW2KWXP and FTrackBarAlphaBlend
then
begin
SetWindowLong(FPopupTrackBar.Handle, GWL_EXSTYLE,
GetWindowLong(Handle, GWL_EXSTYLE) or WS_EX_LAYERED);
if FTrackBarAlphaBlendAnimation
then
SetAlphaBlendTransparent(FPopupTrackBar.Handle, 0)
else
SetAlphaBlendTransparent(FPopupTrackBar.Handle, FTrackBarAlphaBlendValue);
end;
//
SetWindowPos(FPopupTrackBar.Handle, HWND_TOP, P.X, Y, 0, 0,
SWP_NOSIZE or SWP_NOACTIVATE or SWP_SHOWWINDOW);
FPopupTrackBar.Visible := True;
if FTrackBarAlphaBlendAnimation and FTrackBarAlphaBlend and CheckW2KWXP
then
begin
Application.ProcessMessages;
I := 0;
repeat
Inc(i, 1);
if i > FTrackBarAlphaBlendValue then i := FTrackBarAlphaBlendValue;
SetAlphaBlendTransparent(FPopupTrackBar.Handle, i);
until i >= FTrackBarAlphaBlendValue;
end;
end;
procedure TspSkinTrackEdit.ButtonClick(Sender: TObject);
begin
SetFocus;
if not FPopupTrackBar.Visible then DropDown else CloseUp;
end;
function TspSkinTrackEdit.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 TspSkinTrackEdit.SetMinValue;
begin
FMinValue := AValue;
end;
procedure TspSkinTrackEdit.SetMaxValue;
begin
FMaxValue := AValue;
end;
function TspSkinTrackEdit.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 TspSkinTrackEdit.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 TspSkinTrackEdit.SetValue;
begin
FValue := CheckValue(AValue);
StopCheck := True;
Text := IntToStr(Round(CheckValue(AValue)));
StopCheck := False;
end;
procedure TspSkinTrackEdit.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 TspSkinTrackEdit.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 TspSkinTrackEdit.WMKillFocus(var Message: TWMKillFocus);
begin
inherited;
CloseUp;
end;
procedure TspSkinTrackEdit.TrackBarChange(Sender: TObject);
begin
if Value <> FPopupTrackBar.Value
then
Value := FPopupTrackBar.Value;
end;
constructor TspSkinPopupTrackBar.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := ControlStyle + [csNoDesignVisible, csReplicatable];
SkinDataName := 'htrackbar';
end;
procedure TspSkinPopupTrackBar.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
with Params do
begin
Style := WS_POPUP;
ExStyle := WS_EX_TOOLWINDOW;
WindowClass.Style := CS_SAVEBITS;
end;
end;
procedure TspSkinPopupTrackBar.WMMouseActivate(var Message: TMessage);
begin
Message.Result := MA_NOACTIVATE;
end;
constructor TspSkinTimeEdit.Create(AOwner: TComponent);
begin
inherited;
fShowMSec := false;
EditMask := '!90:00:00;1; ';
Text := '00:00:00';
OnKeyPress := HandleOnKeyPress;
end;
procedure TspSkinTimeEdit.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 TspSkinTimeEdit.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 TspSkinTimeEdit.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 TspSkinTimeEdit.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 TspSkinTimeEdit.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 TspSkinTimeEdit.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 TspSkinTimeEdit.GetTime: string;
begin
Result := Text;
end;
function TspSkinTimeEdit.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 TspSkinTimeEdit.IsValidChar(Key: Char): Boolean;
begin
Result := Key in ['0'..'9'];
end;
procedure TspSkinTimeEdit.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 TspSkinTimeEdit.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 TspSkinMemo2.Create;
begin
inherited Create(AOwner);
AutoSize := False;
FIndex := -1;
Font.Name := 'Arial';
Font.Height := 14;
FVScrollBar := nil;
FHScrollBar := nil;
FDown := False;
FSkinDataName := 'memo';
FDefaultFont := TFont.Create;
FDefaultFont.OnChange := OnDefaultFontChange;
FDefaultFont.Assign(Font);
ScrollBars := ssBoth;
FUseSkinFont := True;
FSysPopupMenu := nil;
end;
procedure TspSkinMemo2.WMCONTEXTMENU;
var
X, Y: Integer;
P: TPoint;
begin
if PopupMenu <> nil
then
inherited
else
begin
CreateSysPopupMenu;
X := Message.XPos;
Y := Message.YPos;
if (X < 0) or (Y < 0)
then
begin
X := Width div 2;
Y := Height div 2;
P := Point(0, 0);
P := ClientToScreen(P);
X := X + P.X;
Y := Y + P.Y;
end;
if FSysPopupMenu <> nil
then
FSysPopupMenu.Popup2(Self, X, Y)
end;
end;
procedure TspSkinMemo2.WMAFTERDISPATCH;
begin
if FSysPopupMenu <> nil
then
begin
FSysPopupMenu.Free;
FSysPopupMenu := nil;
end;
end;
procedure TspSkinMemo2.DoUndo;
begin
Undo;
end;
procedure TspSkinMemo2.DoCut;
begin
CutToClipboard;
end;
procedure TspSkinMemo2.DoCopy;
begin
CopyToClipboard;
end;
procedure TspSkinMemo2.DoPaste;
begin
PasteFromClipboard;
end;
procedure TspSkinMemo2.DoDelete;
begin
ClearSelection;
end;
procedure TspSkinMemo2.DoSelectAll;
begin
SelectAll;
end;
procedure TspSkinMemo2.CreateSysPopupMenu;
function IsSelected: Boolean;
begin
Result := GetSelLength > 0;
end;
function IsFullSelected: Boolean;
begin
Result := GetSelText = Text;
end;
var
Item: TMenuItem;
begin
if FSysPopupMenu <> nil then FSysPopupMenu.Free;
FSysPopupMenu := TspSkinPopupMenu.Create(Self);
FSysPopupMenu.ComponentForm := TForm(GetParentForm(Self));
Item := TMenuItem.Create(FSysPopupMenu);
with Item do
begin
Caption := SP_Edit_Undo;
OnClick := DoUndo;
Enabled := Self.CanUndo;
end;
FSysPopupMenu.Items.Add(Item);
Item := TMenuItem.Create(FSysPopupMenu);
Item.Caption := '-';
FSysPopupMenu.Items.Add(Item);
Item := TMenuItem.Create(FSysPopupMenu);
with Item do
begin
Caption := SP_Edit_Cut;
Enabled := IsSelected and not Self.ReadOnly;
OnClick := DoCut;
end;
FSysPopupMenu.Items.Add(Item);
Item := TMenuItem.Create(FSysPopupMenu);
with Item do
begin
Caption := SP_Edit_Copy;
Enabled := IsSelected;
OnClick := DoCopy;
end;
FSysPopupMenu.Items.Add(Item);
Item := TMenuItem.Create(FSysPopupMenu);
with Item do
begin
Caption := SP_Edit_Paste;
Enabled := (ClipBoard.AsText <> '') and not ReadOnly;
OnClick := DoPaste;
end;
FSysPopupMenu.Items.Add(Item);
Item := TMenuItem.Create(FSysPopupMenu);
with Item do
begin
Caption := SP_Edit_Delete;
Enabled := IsSelected and not Self.ReadOnly;
OnClick := DoDelete;
end;
FSysPopupMenu.Items.Add(Item);
Item := TMenuItem.Create(FSysPopupMenu);
Item.Caption := '-';
FSysPopupMenu.Items.Add(Item);
Item := TMenuItem.Create(FSysPopupMenu);
with Item do
begin
Caption := SP_Edit_SelectAll;
Enabled := not IsFullSelected;
OnClick := DoSelectAll;
end;
FSysPopupMenu.Items.Add(Item);
end;
procedure TspSkinMemo2.CMEnabledChanged;
begin
inherited;
UpDateScrollRange;
end;
procedure TspSkinMemo2.SetDefaultFont;
begin
FDefaultFont.Assign(Value);
if FIndex = -1 then Font.Assign(Value);
end;
procedure TspSkinMemo2.OnDefaultFontChange(Sender: TObject);
begin
if FIndex = -1 then Font.Assign(FDefaultFont);
end;
procedure TspSkinMemo2.WMSize;
begin
inherited;
UpDateScrollRange;
end;
procedure TspSkinMemo2.Invalidate;
begin
inherited;
end;
procedure TspSkinMemo2.Change;
begin
inherited;
UpDateScrollRange;
end;
procedure TspSkinMemo2.WMVSCROLL;
begin
inherited;
UpDateScrollRange;
end;
procedure TspSkinMemo2.WMHSCROLL;
begin
inherited;
UpDateScrollRange;
end;
procedure TspSkinMemo2.WMLBUTTONDOWN;
begin
inherited;
FDown := True;
end;
procedure TspSkinMemo2.WMLBUTTONUP;
begin
inherited;
if FDown
then
begin
UpDateScrollRange;
FDown := False;
end;
end;
procedure TspSkinMemo2.WMMOUSEMOVE;
begin
inherited;
if FDown then UpDateScrollRange;
end;
procedure TspSkinMemo2.SetVScrollBar;
begin
FVScrollBar := Value;
FVScrollBar.Min := 0;
FVScrollBar.Max := 0;
FVScrollBar.Position := 0;
if FVScrollBar <> nil then FVScrollBar.OnChange := OnVScrollBarChange;
UpDateScrollRange;
end;
procedure TspSkinMemo2.OnVScrollBarChange(Sender: TObject);
begin
SendMessage(Handle, WM_VSCROLL,
MakeWParam(SB_THUMBPOSITION, FVScrollBar.Position), 0);
Invalidate;
end;
procedure TspSkinMemo2.SetHScrollBar;
begin
FHScrollBar := Value;
FHScrollBar.Min := 0;
FHScrollBar.Max := 0;
FHScrollBar.Position := 0;
if FHScrollBar <> nil then FHScrollBar.OnChange := OnHScrollBarChange;
UpDateScrollRange;
end;
procedure TspSkinMemo2.OnHScrollBarChange(Sender: TObject);
begin
SendMessage(Handle, WM_HSCROLL,
MakeWParam(SB_THUMBPOSITION, FHScrollBar.Position), 0);
Invalidate;
end;
procedure TspSkinMemo2.UpDateScrollRange;
function GetVisibleLines: Integer;
var
R: TRect;
C: TCanvas;
DC: HDC;
LineHeight: Integer;
begin
C := TCanvas.Create;
C.Font.Assign(Font);
DC := GetDC(0);
C.Handle := DC;
R := GetClientRect;
LineHeight := C.TextHeight('Wq');
if LineHeight <> 0
then
Result := RectHeight(R) div LineHeight
else
Result := 1;
ReleaseDC(0, DC);
C.Free;
end;
var
SMin, SMax, SPos, SPage: Integer;
begin
if FVScrollBar <> nil
then
if not Enabled
then
FVScrollBar.Enabled := False
else
with FVScrollBar do
begin
SPage := GetVisibleLines;
SPos := GetScrollPos(Self.Handle, SB_VERT);
GetScrollRange(Self.Handle, SB_VERT, SMin, SMax);
if SMax > SPage
then
begin
SetRange(0, SMax, SPos, SPage + 1);
if not Enabled then Enabled := True;
end
else
begin
SetRange(0, 0, 0, 0);
if Enabled then Enabled := False;
end;
end;
if FHScrollBar <> nil
then
if not Enabled
then
FHScrollBar.Enabled := False
else
with FHScrollBar do
begin
SPage := Width;
SPos := GetScrollPos(Self.Handle, SB_HORZ);
GetScrollRange(Self.Handle, SB_HORZ, SMin, SMax);
if SMax > SPage
then
begin
SetRange(0, SMax, SPos, SPage + 1);
if not Enabled then Enabled := True;
end
else
begin
SetRange(0, 0, 0, 0);
if Enabled then Enabled := False;
end;
end;
end;
procedure TspSkinMemo2.WMMove;
begin
inherited;
end;
procedure TspSkinMemo2.WMCut(var Message: TMessage);
begin
inherited;
UpDateScrollRange;
end;
procedure TspSkinMemo2.WMPaste(var Message: TMessage);
begin
inherited;
UpDateScrollRange;
end;
procedure TspSkinMemo2.WMClear(var Message: TMessage);
begin
inherited;
UpDateScrollRange;
end;
procedure TspSkinMemo2.WMUndo(var Message: TMessage);
begin
inherited;
UpDateScrollRange;
end;
procedure TspSkinMemo2.WMSetText(var Message:TWMSetText);
begin
inherited;
UpDateScrollRange;
end;
procedure TspSkinMemo2.WMMOUSEWHEEL;
var
LParam, WParam: Integer;
begin
LParam := 0;
if Message.WParam > 0
then
WParam := MakeWParam(SB_LINEUP, 0)
else
WParam := MakeWParam(SB_LINEDOWN, 0);
SendMessage(Handle, WM_VSCROLL, WParam, LParam);
end;
procedure TspSkinMemo2.WMCHAR(var Message:TMessage);
begin
inherited;
UpDateScrollRange;
end;
procedure TspSkinMemo2.WMKeyDown(var Message: TWMKeyDown);
begin
inherited;
UpDateScrollRange;
end;
procedure TspSkinMemo2.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
inherited;
end;
procedure TspSkinMemo2.CNCTLCOLOREDIT(var Message:TWMCTLCOLOREDIT);
begin
inherited;
end;
procedure TspSkinMemo2.WMNCCALCSIZE;
begin
end;
procedure TspSkinMemo2.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
with Params do
begin
ExStyle := ExStyle and not WS_EX_CLIENTEDGE;
Style := Style and not WS_BORDER;
WindowClass.style := WindowClass.style and not (CS_HREDRAW or CS_VREDRAW);
end;
end;
destructor TspSkinMemo2.Destroy;
begin
FDefaultFont.Free;
if FSysPopupMenu <> nil then FSysPopupMenu.Free;
inherited;
end;
procedure TspSkinMemo2.WMSETFOCUS;
begin
inherited;
if not FMouseIn and (FIndex <> -1)
then
begin
Font.Color := ActiveFontColor;
Color := ActiveBGColor;
end;
end;
procedure TspSkinMemo2.WMKILLFOCUS;
begin
inherited;
if not FMouseIn and (FIndex <> -1)
then
begin
Font.Color := FontColor;
Color := BGColor;
end;
end;
procedure TspSkinMemo2.CMMouseEnter;
begin
inherited;
FMouseIn := True;
if not Focused and (FIndex <> -1)
then
begin
Font.Color := ActiveFontColor;
Color := ActiveBGColor;
end;
end;
procedure TspSkinMemo2.CMMouseLeave;
begin
inherited;
FMouseIn := False;
if not Focused and (FIndex <> -1)
then
begin
Font.Color := FontColor;
Color := BGColor;
end;
end;
procedure TspSkinMemo2.GetSkinData;
begin
if FSD = nil
then
begin
FIndex := -1;
Exit;
end;
if FSD.Empty
then
FIndex := -1
else
FIndex := FSD.GetControlIndex(FSkinDataName);
if FIndex <> -1
then
if TspDataSkinControl(FSD.CtrlList.Items[FIndex]) is TspDataSkinMemoControl
then
with TspDataSkinMemoControl(FSD.CtrlList.Items[FIndex]) do
begin
Self.FontName := FontName;
Self.FontStyle := FontStyle;
Self.FontHeight := FontHeight;
Self.FontColor := FontColor;
Self.ActiveFontColor := ActiveFontColor;
Self.BGColor := BGColor;
Self.ActiveBGColor := ActiveBGColor;
end;
end;
procedure TspSkinMemo2.SetSkinData;
begin
FSD := Value;
if (FSD <> nil) then
if not FSD.Empty and not (csDesigning in ComponentState)
then
ChangeSkinData;
end;
procedure TspSkinMemo2.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 TspSkinMemo2.ChangeSkinData;
begin
GetSkinData;
//
if FIndex <> -1
then
begin
if FUseSkinFont
then
begin
Font.Name := FontName;
Font.Style := FontStyle;
Font.Height := FontHeight;
if Focused
then
Font.Color := ActiveFontColor
else
Font.Color := FontColor;
Font.CharSet := FDefaultFont.CharSet;
end
else
begin
Font.Assign(FDefaultFont);
if Focused
then
Font.Color := ActiveFontColor
else
Font.Color := FontColor;
end;
Color := BGColor;
end
else
Font.Assign(FDefaultFont);
//
UpDateScrollRange;
ReCreateWnd;
if FVScrollBar <> nil then FVScrollBar.Align := FVScrollBar.Align;
end;
constructor TspSkinPasswordEdit.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;
FFirstVisibleChar := 1;
ControlStyle := ControlStyle + [csCaptureMouse] - [csSetCaption];
Cursor := Cursor;
end;
destructor TspSkinPasswordEdit.Destroy;
begin
inherited;
end;
procedure TspSkinPasswordEdit.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 TspSkinPasswordEdit.GetSkinData;
begin
inherited;
if FIndex <> -1
then
if TspDataSkinControl(FSD.CtrlList.Items[FIndex]) is TspDataSkinEditControl
then
with TspDataSkinEditControl(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 TspSkinPasswordEdit.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 TspSkinPasswordEdit.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 TspSkinPasswordEdit.Loaded;
begin
inherited;
end;
procedure TspSkinPasswordEdit.WMSETFOCUS(var Message: TWMSETFOCUS);
begin
inherited;
HAsFocus;
end;
procedure TspSkinPasswordEdit.WMKILLFOCUS(var Message: TWMKILLFOCUS);
begin
inherited;
KillFocus;
end;
procedure TspSkinPasswordEdit.HasFocus;
begin
inherited;
UpdateCarete;
CaretPosition := 0;
if AutoSelect then SelectAll;
end;
procedure TspSkinPasswordEdit.KillFocus;
begin
inherited;
DestroyCaret;
Invalidate;
end;
function TspSkinPasswordEdit.GetCharX(a: integer): integer;
var
WholeTextWidth : integer;
EditRectWidth : integer;
begin
Result := GetEditRect.Left;
WholeTextWidth := Length(Text) * GetPasswordCharWidth;
if a > 0 then
begin
if a <= Length(Text)
then
Result := Result + (a - FFirstVisibleChar + 1) * GetPasswordCharWidth
else
Result := Result + (Length(Text) - FFirstVisibleChar + 1) * GetPasswordCharWidth;
end;
EditRectWidth := GetEditRect.Right - GetEditRect.Left;
if WholeTextWidth < EditRectWidth then
case TextAlignment of
taRightJustify : Result := Result + (EditRectWidth - WholeTextWidth);
taCenter : Result := Result + ((EditRectWidth - WholeTextWidth) div 2);
end;
end;
function TspSkinPasswordEdit.GetCoordinatePosition(x: integer): integer;
var
TmpX,
WholeTextWidth,
EditRectWidth : integer;
begin
Result := FFirstVisibleChar - 1;
if Length(Text) = 0 then Exit;
WholeTextWidth := Length(Text) * GetPasswordCharWidth;
EditRectWidth := GetEditRect.Right - GetEditRect.Left;
TmpX := x;
if WholeTextWidth < EditRectWidth
then
case TextAlignment of
taRightJustify : TmpX := x - (EditRectWidth - WholeTextWidth);
taCenter : TmpX := x - ((EditRectWidth - WholeTextWidth) div 2);
end;
Result := Result + (TmpX - GetEditRect.Left) div GetPasswordCharWidth;
if Result < 0
then
Result := 0
else
if Result > Length(Text)
then
Result := Length(Text);
end;
function TspSkinPasswordEdit.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 TspSkinPasswordEdit.GetAlignmentFlags: integer;
begin
case FTextAlignment of
taCenter: Result := DT_CENTER;
taRightJustify: Result := DT_RIGHT;
else
Result := DT_LEFT;
end;
end;
procedure TspSkinPasswordEdit.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 := GetPrivWordBeging(CaretPosition)
else
CaretPosition := CaretPosition - 1;
VK_RIGHT:
if ssCtrl in Shift then
CaretPosition := GetNextWordBeging(CaretPosition)
else
CaretPosition := CaretPosition + 1;
VK_DELETE, 8:
if not ReadOnly then
begin
if SelLength <> 0 then
begin
ClearSelection;
end
else
begin
TmpS := Text;
if TmpS <> '' then
if Key = VK_DELETE then
begin
Delete(TmpS, CaretPosition + 1, 1);
end
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 TspSkinPasswordEdit.KeyPress(var Key: Char);
begin
inherited KeyPress(Key);
if (Ord(Key) >= 32) and not ReadOnly then InsertChar(Key);
end;
procedure TspSkinPasswordEdit.MouseDown(Button: TMouseButton; Shift: TShiftState;
x, y: integer);
begin
inherited;
if Button = mbLeft then FLMouseSelecting := true;
SetFocus;
if Button = mbLeft
then
begin
CaretPosition := GetCoordinatePosition(x);
SelLength := 0;
end;
end;
procedure TspSkinPasswordEdit.PaintText;
var
TmpRect: TRect;
CurChar: integer;
LPWCharWidth: integer;
begin
TmpRect := GetEditRect;
LPWCharWidth := GetPasswordCharWidth;
for CurChar := 0 to Length(Text) - FFirstVisibleChar + 1 - 1 do
DrawPasswordChar(Rect(CurChar * LPWCharWidth + GetCharX(0), TmpRect.Top,
(CurChar + 1) * LPWCharWidth + GetCharX(0), TmpRect.Bottom), False, Cnv);
end;
procedure TspSkinPasswordEdit.UpdateFirstVisibleChar;
var
LEditRect: TRect;
begin
if FFirstVisibleChar >= (FCaretPosition + 1)
then
begin
FFirstVisibleChar := FCaretPosition;
if FFirstVisibleChar < 1 then FFirstVisibleChar := 1;
end
else
begin
LEditRect := GetEditRect;
while ((FCaretPosition - FFirstVisibleChar + 1) * GetPasswordCharWidth >
LEditRect.Right - LEditRect.Left) and (FFirstVisibleChar < Length(Text)) do
Inc(FFirstVisibleChar)
end;
Invalidate;
end;
procedure TspSkinPasswordEdit.MouseMove(Shift: TShiftState; x, y: integer);
var
OldCaretPosition: integer;
TmpNewPosition : integer;
begin
inherited;
if FLMouseSelecting then
begin
TmpNewPosition := GetCoordinatePosition(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 TspSkinPasswordEdit.MouseUp(Button: TMouseButton; Shift: TShiftState;
x, y: integer);
begin
inherited;
FLMouseSelecting := false;
end;
procedure TspSkinPasswordEdit.PaintSelectedText;
var
TmpRect: TRect;
CurChar: integer;
LPWCharWidth: integer;
begin
TmpRect := GetSelRect;
LPWCharWidth := GetPasswordCharWidth;
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 TspSkinPasswordEdit.GetVisibleSelText: String;
begin
if SelStart + 1 >= FFirstVisibleChar then
Result := SelText
else
Result := Copy(SelText, FFirstVisibleChar - SelStart, Length(SelText) - (FFirstVisibleChar - SelStart) + 1);
end;
function TspSkinPasswordEdit.GetNextWordBeging(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 TspSkinPasswordEdit.GetPrivWordBeging(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 TspSkinPasswordEdit.ClearSelection;
var
TmpS: String;
begin
if ReadOnly then Exit;
TmpS := Text;
Delete(TmpS, SelStart + 1, SelLength);
Text := TmpS;
CaretPosition := SelStart;
SelLength := 0;
end;
procedure TspSkinPasswordEdit.SelectAll;
begin
SetCaretPosition(Length(Text));
SelStart := 0;
SelLength := Length(Text);
Invalidate;
end;
procedure TspSkinPasswordEdit.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 TspSkinPasswordEdit.SelectWord;
begin
SelStart := GetPrivWordBeging(CaretPosition);
SelLength := GetNextWordBeging(SelStart) - SelStart;
CaretPosition := SelStart + SelLength;
end;
procedure TspSkinPasswordEdit.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 TspSkinPasswordEdit.HideCaret;
begin
Windows.HideCaret(Handle);
end;
procedure TspSkinPasswordEdit.ShowCaret;
begin
Windows.ShowCaret(Handle);
end;
function TspSkinPasswordEdit.GetPasswordCharWidth: integer;
begin
Result := RectHeight(GetEditRect) div 2 + 3;
end;
procedure TspSkinPasswordEdit.Change;
begin
inherited Changed;
if Enabled and HandleAllocated then SetCaretPosition(CaretPosition);
if Assigned(FOnChange) then FOnChange(Self);
end;
procedure TspSkinPasswordEdit.WMGetDlgCode(var Msg: TWMGetDlgCode);
begin
inherited;
Msg.Result := DLGC_WANTARROWS or DLGC_WANTCHARS;
end;
procedure TspSkinPasswordEdit.WMLButtonDblClk(var Message: TWMLButtonDblClk);
begin
inherited;
FLMouseSelecting := false;
SelectWord;
end;
procedure TspSkinPasswordEdit.CMFontChanged(var Message: TMessage);
begin
inherited;
Font.Assign(Font);
UpdateCarete;
end;
function TspSkinPasswordEdit.GetText: String;
begin
Result := FText;
end;
procedure TspSkinPasswordEdit.SetText(const Value: String);
var
TmpS: String;
LOldText: String;
begin
if not ValidText(Value) then
Exit;
TmpS := Value;
LOldText := Text;
if (Value <> '') and (CharCase <> ecNormal) then
case CharCase of
ecUpperCase: FText := AnsiUpperCase(TmpS);
ecLowerCase: FText := AnsiLowerCase(TmpS);
end
else
FText := TmpS;
Invalidate;
if Text <> LOldText then
Change;
end;
procedure TspSkinPasswordEdit.SetCaretPosition(const Value: integer);
begin
if Value < 0 then
FCaretPosition := 0
else
if Value > Length(Text) then
FCaretPosition := Length(Text)
else
FCaretPosition := Value;
UpdateFirstVisibleChar;
if SelLength <= 0 then
FSelStart := Value;
if Focused then
SetCaretPos(GetCharX(FCaretPosition), GetEditRect.Top);
end;
procedure TspSkinPasswordEdit.SetSelLength(const Value: integer);
begin
if FSelLength <> Value then
begin
FSelLength := Value;
Invalidate;
end;
end;
procedure TspSkinPasswordEdit.SetSelStart(const Value: integer);
begin
if FSelStart <> Value then
begin
SelLength := 0;
FSelStart := Value;
CaretPosition := FSelStart;
Invalidate;
end;
end;
procedure TspSkinPasswordEdit.SetAutoSelect(const Value: boolean);
begin
if FAutoSelect <> Value then
FAutoSelect := Value;
end;
function TspSkinPasswordEdit.GetSelStart: integer;
begin
if FSelLength > 0 then
Result := FSelStart
else
if FSelLength < 0 then
Result := FSelStart + FSelLength
else
Result := CaretPosition;
end;
function TspSkinPasswordEdit.GetSelRect: TRect;
begin
Result := GetEditRect;
Result.Left := GetCharX(SelStart);
Result.Right := GetCharX(SelStart + SelLength);
IntersectRect(Result, Result, GetEditRect);
end;
function TspSkinPasswordEdit.GetSelLength: integer;
begin
Result := Abs(FSelLength);
end;
function TspSkinPasswordEdit.GetSelText: String;
begin
Result := Copy(Text, SelStart + 1, SelLength);
end;
procedure TspSkinPasswordEdit.SetCharCase(const Value: TEditCharCase);
var
TmpS: String;
begin
if FCharCase <> Value then
begin
FCharCase := Value;
if Text <> '' then
begin
TmpS := Text;
case Value of
ecUpperCase: Text := AnsiUpperCase(TmpS);
ecLowerCase: Text := AnsiLowerCase(TmpS);
end;
end;
end;
end;
procedure TspSkinPasswordEdit.SetHideSelection(const Value: Boolean);
begin
if FHideSelection <> Value then
begin
FHideSelection := Value;
Invalidate;
end;
end;
procedure TspSkinPasswordEdit.SetMaxLength(const Value: Integer);
begin
if FMaxLength <> Value then
begin
FMaxLength := Value;
end;
end;
procedure TspSkinPasswordEdit.SetCursor(const Value: TCursor);
begin
if Value = crDefault then
inherited Cursor := crIBeam
else
inherited Cursor := Value;
end;
function TspSkinPasswordEdit.ValidText(NewText: String): boolean;
begin
Result := true;
end;
procedure TspSkinPasswordEdit.SetTextAlignment(const Value: TAlignment);
begin
if FTextAlignment <> Value then begin
FTextAlignment := Value;
Invalidate;
end;
end;
procedure TspSkinPasswordEdit.UpdateCaretePosition;
begin
SetCaretPosition(CaretPosition);
end;
procedure TspSkinPasswordEdit.InsertText(AText: String);
var
TmpS: String;
begin
if ReadOnly then Exit;
TmpS := Text;
Delete(TmpS, SelStart + 1, SelLength);
Insert(AText, TmpS, SelStart + 1);
if (MaxLength <= 0) or (Length(TmpS) <= MaxLength) then
begin
Text := TmpS;
CaretPosition := SelStart + Length(AText);
end;
SelLength := 0;
end;
procedure TspSkinPasswordEdit.InsertChar(Ch: Char);
begin
if ReadOnly then Exit;
InsertText(Ch);
end;
procedure TspSkinPasswordEdit.InsertAfter(Position: integer; S: String;
Selected: boolean);
var
TmpS : String;
Insertion : String;
begin
TmpS := Text;
Insertion := S;
if MaxLength > 0 then
Insertion := Copy(Insertion, 1, MaxLength - Length(TmpS));
Insert(Insertion, TmpS, Position+1);
Text := TmpS;
if Selected then begin
SelStart := Position;
SelLength := Length(Insertion);
CaretPosition := SelStart + SelLength;
end;
end;
procedure TspSkinPasswordEdit.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 TspSkinPasswordEdit.SetPasswordKind(const Value: TspPasswordKind);
begin
if FPasswordKind <> Value
then
begin
FPasswordKind := Value;
Invalidate;
end;
end;
procedure TspSkinPasswordEdit.CMTextChanged(var Msg: TMessage);
begin
inherited;
FText := inherited Text;
SelLength := 0;
Invalidate;
end;
procedure TspSkinPasswordEdit.Clear;
begin
Text := '';
end;
procedure TspSkinPasswordEdit.CMEnabledChanged(var Msg: TMessage);
begin
inherited;
if HandleAllocated then Invalidate;
end;
procedure TspSkinPasswordEdit.CMMouseEnter;
begin
inherited;
FMouseIn := True;
if (not Focused) then Invalidate;
end;
procedure TspSkinPasswordEdit.CMMouseLeave;
begin
inherited;
FMouseIn := False;
if not Focused then Invalidate;
end;
// TspSkinNumericEdit
constructor TspSkinNumericEdit.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 TspSkinNumericEdit.Destroy;
begin
inherited;
end;
procedure TspSkinNumericEdit.SetValueType(NewType: TspValueType);
begin
if FValueType <> NewType
then
begin
FValueType := NewType;
end;
end;
procedure TspSkinNumericEdit.SetDecimal(NewValue: Byte);
begin
if FDecimal <> NewValue then begin
FDecimal := NewValue;
end;
end;
function TspSkinNumericEdit.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 TspSkinNumericEdit.SetMinValue;
begin
FMinValue := AValue;
end;
procedure TspSkinNumericEdit.SetMaxValue;
begin
FMaxValue := AValue;
end;
function TspSkinNumericEdit.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 TspSkinNumericEdit.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 TspSkinNumericEdit.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 TspSkinNumericEdit.KeyPress(var Key: Char);
begin
if not IsValidChar(Key)
then
begin
Key := #0;
MessageBeep(0)
end;
inherited KeyPress(Key);
end;
function TspSkinNumericEdit.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;
end.