Delphi控件源码

开发平台：

Delphi

SkinBoxCtrls.pas：源码内容

if FShowNames
then
begin
R := TextRect;
R := Rect(R.Left + 5 + RectWidth(MarkerRect), R.Top, R.Right - 2, R.Bottom);
SPDrawText(Cnvs, FListBox.Items[Index], R);
end;
end;
procedure TspSkinColorComboBox.OnLBCloseUp;
begin
if (spcbCustomColor in ExStyle) and (ItemIndex = 0) then
PickCustomColor;
end;
function TspSkinColorComboBox.PickCustomColor: Boolean;
var
LColor: TColor;
begin
with TColorDialog.Create(nil) do
try
LColor := ColorToRGB(TColor(Items.Objects[0]));
Color := LColor;
CustomColors.Text := Format('ColorA=%.8x', [LColor]);
Result := Execute;
if Result then
begin
Items.Objects[0] := TObject(Color);
Self.Invalidate;
if Assigned(FOnClick) then FOnClick(Self);
if Assigned(FOnChange) then FOnChange(Self);
end;
finally
Free;
end;
end;
procedure TspSkinColorComboBox.KeyDown;
begin
if (spcbCustomColor in ExStyle) and (Key = VK_RETURN) and (ItemIndex = 0)
then
begin
PickCustomColor;
Key := 0;
end;
inherited;
end;
procedure TspSkinColorComboBox.CreateWnd;
begin
inherited;
PopulateList;
end;
procedure TspSkinColorComboBox.SetDefaultColorColor(const Value: TColor);
begin
if Value <> FDefaultColorColor then
begin
FDefaultColorColor := Value;
Invalidate;
end;
end;
procedure TspSkinColorComboBox.SetNoneColorColor(const Value: TColor);
begin
if Value <> FNoneColorColor then
begin
FNoneColorColor := Value;
Invalidate;
end;
end;
procedure TspSkinColorComboBox.ColorCallBack(const AName: String);
var
I, LStart: Integer;
LColor: TColor;
LName: string;
begin
LColor := StringToColor(AName);
if spcbPrettyNames in ExStyle then
begin
if Copy(AName, 1, 2) = 'cl' then
LStart := 3
else
LStart := 1;
LName := '';
for I := LStart to Length(AName) do
begin
case AName[I] of
'A'..'Z':
if LName <> '' then
LName := LName + ' ';
end;
LName := LName + AName[I];
end;
end
else
LName := AName;
Items.AddObject(LName, TObject(LColor));
end;
procedure TspSkinColorComboBox.SetSelected(const AColor: TColor);
var
I: Integer;
begin
if HandleAllocated and (FListBox <> nil) then
begin
I := FListBox.Items.IndexOfObject(TObject(AColor));
if (I = -1) and (spcbCustomColor in ExStyle) and (AColor <> NoColorSelected) then
begin
Items.Objects[0] := TObject(AColor);
I := 0;
end;
ItemIndex := I;
end;
FSelectedColor := AColor;
end;
procedure TspSkinColorComboBox.PopulateList;
procedure DeleteRange(const AMin, AMax: Integer);
var
I: Integer;
begin
for I := AMax downto AMin do
Items.Delete(I);
end;
procedure DeleteColor(const AColor: TColor);
var
I: Integer;
begin
I := Items.IndexOfObject(TObject(AColor));
if I <> -1 then
Items.Delete(I);
end;
var
LSelectedColor, LCustomColor: TColor;
begin
if HandleAllocated then
begin
Items.BeginUpdate;
try
LCustomColor := clBlack;
if (spcbCustomColor in ExStyle) and (Items.Count > 0) then
LCustomColor := TColor(Items.Objects[0]);
LSelectedColor := FSelectedColor;
Items.Clear;
GetColorValues(ColorCallBack);
if not (spcbIncludeNone in ExStyle) then
DeleteColor(clNone);
if not (spcbIncludeDefault in ExStyle) then
DeleteColor(clDefault);
if not (spcbSystemColors in ExStyle) then
DeleteRange(StandardColorsCount + ExtendedColorsCount, Items.Count - 1);
if not (spcbExtendedColors in ExStyle) then
DeleteRange(StandardColorsCount, StandardColorsCount + ExtendedColorsCount - 1);
if not (spcbStandardColors in ExStyle) then
DeleteRange(0, StandardColorsCount - 1);
if spcbCustomColor in ExStyle then
Items.InsertObject(0, SColorBoxCustomCaption, TObject(LCustomColor));
Self.Selected := LSelectedColor;
finally
Items.EndUpdate;
FNeedToPopulate := False;
end;
end
else
FNeedToPopulate := True;
end;
procedure TspSkinColorComboBox.SetExStyle(AStyle: TspColorBoxStyle);
begin
FExStyle := AStyle;
Enabled := ([spcbStandardColors, spcbExtendedColors, spcbSystemColors, spcbCustomColor] * FExStyle) <> [];
PopulateList;
if (Items.Count > 0) and (ItemIndex = -1) then ItemIndex := 0;
end;
function TspSkinColorComboBox.GetColor(Index: Integer): TColor;
begin
Result := TColor(Items.Objects[Index]);
end;
function TspSkinColorComboBox.GetColorName(Index: Integer): string;
begin
Result := Items[Index];
end;
function TspSkinColorComboBox.GetSelected: TColor;
begin
if HandleAllocated then
if ItemIndex <> -1 then
Result := Colors[ItemIndex]
else
Result := NoColorSelected
else
Result := FSelectedColor;
end;
///////////////////check listbox//////////////////////////
type
TspCheckListBoxDataWrapper = class
private
FData: LongInt;
FState: TCheckBoxState;
procedure SetChecked(Check: Boolean);
function GetChecked: Boolean;
public
class function GetDefaultState: TCheckBoxState;
property Checked: Boolean read GetChecked write SetChecked;
property State: TCheckBoxState read FState write FState;
end;
procedure TspCheckListBoxDataWrapper.SetChecked(Check: Boolean);
begin
if Check then FState := cbChecked else FState := cbUnchecked;
end;
function TspCheckListBoxDataWrapper.GetChecked: Boolean;
begin
Result := FState = cbChecked;
end;
class function TspCheckListBoxDataWrapper.GetDefaultState: TCheckBoxState;
begin
Result := cbUnchecked;
end;
constructor TspCheckListBox.Create;
begin
inherited;
SkinListBox := nil;
Ctl3D := False;
BorderStyle := bsNone;
ControlStyle := [csCaptureMouse, csOpaque, csDoubleClicks];
end;
destructor TspCheckListBox.Destroy;
begin
inherited;
end;
procedure TspCheckListBox.SkinDrawCheckImage(X, Y: Integer; Cnvs: TCanvas; IR: TRect; DestCnvs: TCanvas);
var
B: TBitMap;
begin
B := TBitMap.Create;
B.Width := RectWidth(IR);
B.Height := RectHeight(IR);
B.Canvas.CopyRect(Rect(0, 0, B.Width, B.Height), Cnvs, IR);
B.Transparent := True;
DestCnvs.Draw(X, Y, B);
B.Free;
end;
procedure TspCheckListBox.WMNCCALCSIZE;
begin
end;
procedure TspCheckListBox.CMEnter;
begin
if SkinListBox <> nil then SkinListBox.ListBoxEnter;
inherited;
end;
procedure TspCheckListBox.CMExit;
begin
if SkinListBox <> nil then SkinListBox.ListBoxExit;
inherited;
end;
procedure TspCheckListBox.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
if SkinListBox <> nil then SkinListBox.ListBoxMouseUp(Button, Shift, X, Y);
inherited;
end;
procedure TspCheckListBox.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
if SkinListBox <> nil then SkinListBox.ListBoxMouseMove(Shift, X, Y);
inherited;
end;
procedure TspCheckListBox.KeyDown(var Key: Word; Shift: TShiftState);
begin
if SkinListBox <> nil then SkinListBox.ListBoxKeyDown(Key, Shift);
inherited;
end;
procedure TspCheckListBox.Click;
begin
if SkinListBox <> nil then SkinListBox.ListBoxClick;
inherited;
end;
procedure TspCheckListBox.PaintBGWH;
var
X, Y, XCnt, YCnt, XO, YO, w, h, w1, h1: Integer;
Buffer: TBitMap;
begin
w1 := AW;
h1 := AH;
Buffer := TBitMap.Create;
Buffer.Width := w1;
Buffer.Height := h1;
with Buffer.Canvas, SkinListBox do
begin
w := RectWidth(ClRect);
h := RectHeight(ClRect);
XCnt := w1 div w;
YCnt := h1 div h;
for X := 0 to XCnt do
for Y := 0 to YCnt do
begin
if X * w + w > w1 then XO := X * w + w - w1 else XO := 0;
if Y * h + h > h1 then YO := Y * h + h - h1 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;
end;
Cnvs.Draw(AX, AY, Buffer);
Buffer.Free;
end;
function TspCheckListBox.GetItemData(Index: Integer): LongInt;
begin
Result := 0;
if HaveWrapper(Index) then
Result := TspCheckListBoxDataWrapper(GetWrapper(Index)).FData;
end;
procedure TspCheckListBox.SetItemData(Index: Integer; AData: LongInt);
var
Wrapper: TspCheckListBoxDataWrapper;
begin
Wrapper := TspCheckListBoxDataWrapper(GetWrapper(Index));
Wrapper.FData := AData;
if FSaveStates <> nil then
if FSaveStates.Count > 0 then
begin
Wrapper.FState := TCheckBoxState(FSaveStates[0]);
FSaveStates.Delete(0);
end;
end;
procedure TspCheckListBox.ResetContent;
var
I: Integer;
begin
for I := 0 to Items.Count - 1 do
if HaveWrapper(I) then
GetWrapper(I).Free;
inherited;
end;
procedure TspCheckListBox.CreateWnd;
begin
inherited CreateWnd;
if FSaveStates <> nil then
begin
FSaveStates.Free;
FSaveStates := nil;
end;
end;
procedure TspCheckListBox.DestroyWnd;
var
I: Integer;
begin
if Items.Count > 0 then
begin
FSaveStates := TList.Create;
for I := 0 to Items.Count -1 do
FSaveStates.Add(TObject(State[I]));
end;
inherited DestroyWnd;
end;
procedure TspCheckListBox.WMDestroy(var Msg: TWMDestroy);
var
i: Integer;
begin
for i := 0 to Items.Count -1 do
ExtractWrapper(i).Free;
inherited;
end;
procedure TspCheckListBox.DeleteString(Index: Integer);
begin
if HaveWrapper(Index) then
GetWrapper(Index).Free;
inherited;
end;
procedure TspCheckListBox.KeyPress(var Key: Char);
begin
inherited;
if (Key = ' ') then ToggleClickCheck(ItemIndex);
if SkinListBox <> nil then SkinListBox.ListBoxKeyPress(Key);
end;
procedure TspCheckListBox.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
function InCheckArea(IR: TRect): Boolean;
var
R, R1: TRect;
OX: Integer;
begin
R := SkinListBox.ItemTextRect;
OX := RectWidth(IR) - RectWidth(SkinListBox.SItemRect);
Inc(R.Right, OX);
R1 := SkinListBox.ItemCheckRect;
if R1.Left >= SkinListBox.ItemTextRect.Right
then OffsetRect(R1, OX, 0);
OffsetRect(R1, IR.Left, IR.Top);
Result := PtInRect(R1, Point(X, Y));
end;
var
Index: Integer;
begin
inherited;
Index := ItemAtPos(Point(X,Y),True);
if (Index <> -1)
then
if (SkinListBox <> nil) and (SkinListBox.FIndex <> -1)
then
begin
if InCheckArea(ItemRect(Index)) then ToggleClickCheck(Index);
end
else
begin
if X - ItemRect(Index).Left < 20 then ToggleClickCheck(Index);
end;
if SkinListBox <> nil then SkinListBox.ListBoxMouseDown(Button, Shift, X, Y);
end;
procedure TspCheckListBox.ToggleClickCheck;
var
State: TCheckBoxState;
begin
if (Index >= 0) and (Index < Items.Count) then
begin
State := Self.State[Index];
case State of
cbUnchecked: State := cbChecked;
cbChecked: State := cbUnchecked;
end;
Self.State[Index] := State;
if Assigned(FOnClickCheck) then FOnClickCheck(Self);
end;
end;
procedure TspCheckListBox.InvalidateCheck(Index: Integer);
var
R: TRect;
begin
R := ItemRect(Index);
InvalidateRect(Handle, @R, not (csOpaque in ControlStyle));
UpdateWindow(Handle);
end;
function TspCheckListBox.GetWrapper(Index: Integer): TObject;
begin
Result := ExtractWrapper(Index);
if Result = nil then
Result := CreateWrapper(Index);
end;
function TspCheckListBox.ExtractWrapper(Index: Integer): TObject;
begin
Result := TspCheckListBoxDataWrapper(inherited GetItemData(Index));
if LB_ERR = Integer(Result) then
raise EListError.CreateFmt('List index out of bounds (%d)', [Index]);
if (Result <> nil) and (not (Result is TspCheckListBoxDataWrapper)) then
Result := nil;
end;
function TspCheckListBox.CreateWrapper(Index: Integer): TObject;
begin
Result := TspCheckListBoxDataWrapper.Create;
inherited SetItemData(Index, LongInt(Result));
end;
function TspCheckListBox.HaveWrapper(Index: Integer): Boolean;
begin
Result := ExtractWrapper(Index) <> nil;
end;
procedure TspCheckListBox.SetChecked(Index: Integer; Checked: Boolean);
begin
if Checked <> GetChecked(Index) then
begin
TspCheckListBoxDataWrapper(GetWrapper(Index)).SetChecked(Checked);
InvalidateCheck(Index);
end;
end;
procedure TspCheckListBox.SetState(Index: Integer; AState: TCheckBoxState);
begin
if AState <> GetState(Index) then
begin
TspCheckListBoxDataWrapper(GetWrapper(Index)).State := AState;
InvalidateCheck(Index);
end;
end;
function TspCheckListBox.GetChecked(Index: Integer): Boolean;
begin
if HaveWrapper(Index) then
Result := TspCheckListBoxDataWrapper(GetWrapper(Index)).GetChecked
else
Result := False;
end;
function TspCheckListBox.GetState(Index: Integer): TCheckBoxState;
begin
if HaveWrapper(Index) then
Result := TspCheckListBoxDataWrapper(GetWrapper(Index)).State
else
Result := TspCheckListBoxDataWrapper.GetDefaultState;
end;
function TspCheckListBox.GetState1;
begin
Result := [];
if AItemID = ItemIndex
then
begin
Result := Result + [odSelected];
if Focused then Result := Result + [odFocused];
end
else
if SelCount > 0
then
if Selected[AItemID] then Result := Result + [odSelected];
end;
procedure TspCheckListBox.PaintBG(DC: HDC);
var
C: TControlCanvas;
begin
C := TControlCanvas.Create;
C.Handle := DC;
SkinListBox.GetSkinData;
if SkinListBox.FIndex <> -1
then
PaintBGWH(C, Width, Height, 0, 0)
else
with C do
begin
C.Brush.Color := clWindow;
FillRect(Rect(0, 0, Width, Height));
end;
C.Handle := 0;
C.Free;
end;
procedure TspCheckListBox.PaintColumnsList(DC: HDC);
var
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
DrawSkinItem(C, i, IR, GetState1(i))
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
DrawSkinItem(C, i, IR, GetState1(i))
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.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
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);
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
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(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
DrawSkinItem(Canvas, itemID, rcItem, State)
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];
ControlStyle := ControlStyle + [csAcceptsControls];
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.GetColumns;
begin
Result := ListBox.Columns;
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
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
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;
Parent := Self;
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
ListBox.ItemHeight := RectHeight(sItemRect)
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);
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.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;
GetVRange;
GetHRange;
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);
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;
ButtonMode := True;
FSkinDataName := 'buttonedit';
FMonthCalendar := TspPopupCalendar.Create(Self);
FMonthCalendar.Parent := Self;
FMonthCalendar.Visible := False;
FMonthCalendar.OnNumberClick := CalendarClick;
OnButtonClick := ButtonClick;
StopCheck := True;
Text := DateToStr(FMonthCalendar.Date);
StopCheck := False;
MaxLength := Length(Text);
FCalendarAlphaBlend := False;
FCalendarAlphaBlendValue := 0;
FCalendarAlphaBlendAnimation := False;
end;
destructor TspSkinDateEdit.Destroy;
begin
FMonthCalendar.Free;
inherited;
end;
function TspSkinDateEdit.GetFirstDayOfWeek;
begin
Result := FMonthCalendar.FirstDayOfWeek;
end;
procedure TspSkinDateEdit.SetFirstDayOfWeek;
begin
FMonthCalendar.FirstDayOfWeek := Value;
end;
procedure TspSkinDateEdit.CheckSelect;
var
Pos: Integer;
begin
Pos := GetSelStart;
if Text[Pos + 1] <> DateSeparator
then
begin
SetSelStart(Pos);
end
else
SetSelStart(Pos + 1);
SetSelLength(1);
end;
function TspSkinDateEdit.GetDate: TDate;
begin
Result := FMonthCalendar.Date;
end;
procedure TspSkinDateEdit.SetDate(Value: TDate);
begin
FMonthCalendar.Date := Value;
StopCheck := True;
Text := DateToStr(Value);
StopCheck := False;
if Assigned(FOnDateChange) then FOnDateChange(Self);
end;
procedure TspSkinDateEdit.Loaded;
begin
inherited;
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;
function TspSkinDateEdit.IsValidText;
var
F: String;
s1, s2: array[1..3] of String;
D: TDate;
i, j: Integer;
MPos, DPos, YPos: Integer;
begin
D := EncodeDate(9999, 12, 31);
F := DateToStr(D);
FillChar(s1, 3, #0);
FillChar(s2, 3, #0);
j := 1;
YPos := 0;
for i := 1 to Length(F) do
begin
if F[i] = DateSeparator
then
inc(j)
else
s1[j] := s1[j] + F[i];
end;
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
begin
if S[i] = DateSeparator
then
inc(j)
else
s2[j] := s2[j] + S[i];
end;
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.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;
procedure TspSkinDateEdit.KeyDown;
var
Pos: Integer;
C: Char;
begin
if Key = VK_DELETE then Key := 0;
inherited;
end;
procedure TspSkinDateEdit.KeyPress(var Key: Char);
var
Pos: Integer;
C: Char;
begin
if not IsValidChar(Key) then
begin
Key := #0;
MessageBeep(0)
end;
if Key <> #0
then
begin
inherited KeyPress(Key);
end;
end;
function TspSkinDateEdit.IsValidChar(Key: Char): Boolean;
begin
Result := (Key in ['0'..'9']) or
((Key < #32) and (Key <> Chr(VK_RETURN)) and (Key <> Chr(VK_BACK)));
end;
procedure TspSkinDateEdit.CMCancelMode;
begin
if (Message.Sender <> FMonthCalendar) and
not FMonthCalendar.ContainsControl(Message.Sender)
then
CloseUp(False);
end;
procedure TspSkinDateEdit.WndProc;
begin
if Message.Msg = WM_CHAR then CheckSelect;
if (Message.Msg <> WM_CUT) and (Message.Msg <> WM_PASTE)
then
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);
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
//
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 PLB.ListBoxAlphaBlendAnimation and PLB.ListBoxAlphaBlend and CheckW2KWXP
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;
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;
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
Width := Self.Width ;
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 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: Integer;
begin
inherited;
if not StopCheck and IsNumText(Text)
then
begin
NewValue := CheckValue(StrToInt(Text));
if NewValue <> FValue
then
begin
FValue := NewValue;
Change;
end;
if NewValue <> StrToInt(Text)
then
Text := IntToStr(Round(Value));
end;
end;
procedure TspSkinTrackEdit.CMTextChanged;
var
NewValue: Integer;
begin
inherited;
if not StopCheck and IsNumText(Text)
then
begin
NewValue := CheckValue(StrToInt(Text));
if NewValue <> FValue
then
begin
FValue := NewValue;
StopCheck := True;
Change;
StopCheck := False;
end;
if NewValue <> StrToInt(Text)
then
Text := IntToStr(Round(Value));
end;
end;
procedure TspSkinTrackEdit.SetValue;
begin
FValue := CheckValue(AValue);
StopCheck := True;
Text := IntToStr(Round(CheckValue(AValue)));
StopCheck := False;
Change;
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 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
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;
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;
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;
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;
end.