Delphi控件源码

开发平台：

Delphi

SkinBoxCtrls.pas：源码内容

Self.ButtonRect := ButtonRect;
Self.ActiveButtonRect := ActiveButtonRect;
Self.DownButtonRect := DownButtonRect;
if IsNullRect(Self.DownButtonRect)
then Self.DownButtonRect := Self.ActiveButtonRect;
end;
end;
procedure TspSkinCustomEdit.SetSkinData;
begin
FSD := Value;
if (FSD <> nil) then
if not FSD.Empty and not (csDesigning in ComponentState)
then
ChangeSkinData;
end;
procedure TspSkinCustomEdit.Notification;
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (AComponent = FSD) then FSD := nil;
end;
procedure TspSkinCustomEdit.ChangeSkinData;
begin
GetSkinData;
//
if (FIndex <> -1)
then
begin
if FUseSkinFont
then
begin
Font.Name := FontName;
Font.Style := FontStyle;
Height := RectHeight(SkinRect);
Font.Height := FontHeight;
if Focused
then
Font.Color := ActiveFontColor
else
Font.Color := FontColor;
Font.CharSet := FDefaultFont.CharSet;
end
else
begin
Font.Assign(FDefaultFont);
Height := RectHeight(SkinRect);
if Focused
then
Font.Color := ActiveFontColor
else
Font.Color := FontColor;
end;
end
else
begin
Font.Assign(FDefaultFont);
if FDefaultWidth > 0 then Width := FDefaultWidth;
if FDefaultHeight > 0 then Height := FDefaultHeight;
end;
//
ReCreateWnd;
end;
constructor TspSkinMemo.Create;
begin
inherited Create(AOwner);
AutoSize := False;
FIndex := -1;
Font.Name := 'Arial';
Font.Height := 14;
FVScrollBar := nil;
ParentImage := nil;
FDown := False;
FSkinDataName := 'memo';
FDefaultFont := TFont.Create;
FDefaultFont.OnChange := OnDefaultFontChange;
FDefaultFont.Assign(Font);
FUseSkinFont := True;
end;
procedure TspSkinMemo.WMPaint;
var
DC: HDC;
FCanvas: TControlCanvas;
PS: TPaintStruct;
R: TRect;
begin
if not Enabled
then
begin
GetSkinData;
FCanvas := TControlCanvas.Create;
DC := Message.DC;
if DC = 0 then DC := BeginPaint(Handle, PS);
FCanvas.Handle := DC;
try
with FCanvas do
begin
Brush.Style := bsClear;
if (FIndex = -1) or not FUseSkinFont
then
begin
Font := DefaultFont;
Font.Color := clGrayText;
end
else
begin
Font.Name := FontName;
Font.Height := FontHeight;
Font.Color := clGrayText;
Font.Style := FontStyle;
Font.CharSet := FDefaultFont.CharSet;
end;
R := ClientRect;
InflateRect(R, -2, -2);
case Alignment of
taLeftJustify:
DrawText(FCanvas.Handle, PChar(Lines.Text), Length(Lines.Text), R,
DT_LEFT);
taRightJustify:
DrawText(FCanvas.Handle, PChar(Lines.Text), Length(Lines.Text), R,
DT_RIGHT);
taCenter:
DrawText(FCanvas.Handle, PChar(Lines.Text), Length(Lines.Text), R,
DT_CENTER);
end;
end;
finally
FCanvas.Handle := 0;
if Message.DC = 0 then EndPaint(Handle, PS);
FCanvas.Free;
end;
end
else
inherited;
end;
procedure TspSkinMemo.SetDefaultFont;
begin
FDefaultFont.Assign(Value);
if FIndex = -1 then Font.Assign(Value);
end;
procedure TspSkinMemo.OnDefaultFontChange(Sender: TObject);
begin
if FIndex = -1 then Font.Assign(FDefaultFont);
end;
procedure TspSkinMemo.SetBitMapBG;
begin
FBitMapBG := Value;
ReCreateWnd;
end;
procedure TspSkinMemo.WMSize;
begin
inherited;
UpDateScrollRange;
if not FBitMapBG
then
SendMessage(Handle, WM_NCPAINT, 0, 0);
end;
procedure TspSkinMemo.Invalidate;
begin
if FBitMapBG
then
begin
if Parent = nil then Exit;
RedrawWindow(Handle, nil, 0, RDW_FRAME + RDW_INVALIDATE);
end
else
begin
inherited;
end;
end;
procedure TspSkinMemo.Change;
begin
inherited;
UpDateScrollRange;
end;
procedure TspSkinMemo.WMVSCROLL;
begin
inherited;
UpDateScrollRange;
end;
procedure TspSkinMemo.WMHSCROLL;
begin
inherited;
UpDateScrollRange;
end;
procedure TspSkinMemo.WMLBUTTONDOWN;
begin
inherited;
FDown := True;
end;
procedure TspSkinMemo.WMLBUTTONUP;
begin
inherited;
if FDown
then
begin
UpDateScrollRange;
FDown := False;
end;
end;
procedure TspSkinMemo.WMMOUSEMOVE;
begin
inherited;
if FDown then UpDateScrollRange;
end;
procedure TspSkinMemo.SetVScrollBar;
begin
FVScrollBar := Value;
FVScrollBar.Min := 0;
FVScrollBar.Max := 0;
FVScrollBar.Position := 0;
if FVScrollBar <> nil then FVScrollBar.OnChange := OnVScrollBarChange;
end;
procedure TspSkinMemo.OnVScrollBarChange(Sender: TObject);
begin
SendMessage(Handle, WM_VSCROLL,
MakeWParam(SB_THUMBPOSITION, FVScrollBar.Position), 0);
Invalidate;
end;
procedure TspSkinMemo.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
LinesCount: Integer;
VisibleLines: Integer;
Pos: Integer;
P: PPoint;
X: Integer;
begin
if FVScrollBar <> nil
then
with FVScrollBar do
begin
VisibleLines := GetVisibleLines;
LinesCount := SendMessage(Self.Handle, EM_GETLINECOUNT, 0, 0);
Pos := SendMessage(Self.Handle, EM_GETFIRSTVISIBLELINE, 0, 0);
if LinesCount > VisibleLines
then
begin
SetRange(0, LinesCount, Pos, VisibleLines + 1);
if not Enabled then Enabled := True;
end
else
begin
SetRange(0, 0, 0, 0);
if Enabled then Enabled := False;
end;
end;
end;
procedure TspSkinMEmo.WMMove;
begin
inherited;
if FAlphaBlend and (FIndex <> -1) then Invalidate;
end;
procedure TspSkinMemo.WMCut(var Message: TMessage);
begin
if FReadOnly then Exit;
inherited;
if FBitMapBG then Invalidate;
UpDateScrollRange;
end;
procedure TspSkinMemo.WMPaste(var Message: TMessage);
begin
if FReadOnly then Exit;
inherited;
if FBitMapBG then Invalidate;
UpDateScrollRange;
end;
procedure TspSkinMemo.WMClear(var Message: TMessage);
begin
if FReadOnly then Exit;
inherited;
if FBitMapBG then Invalidate;
UpDateScrollRange;
end;
procedure TspSkinMemo.WMUndo(var Message: TMessage);
begin
if FReadOnly then Exit;
inherited;
if FBitMapBG then Invalidate;
UpDateScrollRange;
end;
procedure TspSkinMemo.WMSetText(var Message:TWMSetText);
begin
inherited;
if FBitMapBG then Invalidate;
UpDateScrollRange;
end;
procedure TspSkinMemo.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);
if FBitMapBG then Invalidate;
end;
procedure TspSkinMemo.WMCHAR(var Message:TMessage);
begin
if not FReadOnly then inherited;
UpDateScrollRange;
end;
procedure TspSkinMemo.WMKeyDown(var Message: TWMKeyDown);
begin
if FReadOnly and (Message.CharCode = VK_DELETE) then Exit;
inherited;
if FBitMapBG then Invalidate;
UpDateScrollRange;
end;
procedure TspSkinMemo.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
if FBitMapBG then Invalidate else inherited;
end;
procedure TspSkinMemo.CNCTLCOLOREDIT(var Message:TWMCTLCOLOREDIT);
begin
if FBitMapBG
then
with Message do
begin
SetBkMode(ChildDC, Windows.Transparent);
SetTextColor(ChildDC, Font.Color);
Result := GetStockObject(NULL_BRUSH);
end
else
inherited;
end;
procedure TspSkinMemo.SetParentImage;
begin
if ParentImage <> nil
then
begin
ParentImage.Width := Width;
ParentImage.Height := Height;
GetParentImage(Self, ParentImage.Canvas);
end;
end;
procedure TspSkinMemo.WMNCCALCSIZE;
begin
GetSkinData;
if FIndex = -1
then
with Message.CalcSize_Params^.rgrc[0] do
begin
Inc(Left, 2);
Inc(Top, 2);
Dec(Right, 2);
Dec(Bottom, 2);
end
else
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 TspSkinMemo.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
with Params do
begin
ExStyle := ExStyle and not WS_EX_CLIENTEDGE;
ExStyle := Exstyle and not WS_EX_Transparent;
Style := Style and not WS_BORDER or ES_MULTILINE;
WindowClass.style := WindowClass.style and not (CS_HREDRAW or CS_VREDRAW);
end;
end;
procedure TspSkinMemo.SkinNCPaint(C: TCanvas);
var
B: TBitMap;
R: TRect;
EB1, EB2: TspEffectBMP;
kf: Double;
NewLTPoint, NewRTPoint, NewLBPoint, NewRBPoint: TPoint;
NewClRect: TRect;
OffX, OffY: Integer;
begin
GetSkinData;
B := TBitMap.Create;
B.Width := Width;
B.Height := Height;
//
if FIndex = -1
then
with B.Canvas do
begin
Brush.Color := clWindow;
R := Rect(0, 0, Width, Height);
if FMouseIn or Focused
then
begin
Frame3D(B.Canvas, R, clBtnShadow, clBtnShadow, 1);
Frame3D(B.Canvas, R, clBtnFace, clBtnFace, 1);
end
else
begin
Frame3D(B.Canvas, R, clBtnFace, clBtnFace, 1);
Frame3D(B.Canvas, R, clBtnShadow, clBtnShadow, 1);
end;
end
else
begin
OffX := Width - RectWidth(SkinRect);
OffY := Height - RectHeight(SkinRect);
NewLTPoint := LTPoint;
NewRTPoint := Point(RTPoint.X + OffX, RTPoint.Y);
NewLBPoint := Point(LBPoint.X, LBPoint.Y + OffY);
NewRBPoint := Point(RBPoint.X + OffX, RBPoint.Y + OffY);
NewClRect := Rect(ClRect.Left, ClRect.Top,
ClRect.Right + OffX, ClRect.Bottom + OffY);
if FMouseIn or Focused
then
CreateSkinImage(LTPoint, RTPoint, LBPoint, RBPoint, CLRect,
NewLtPoint, NewRTPoint, NewLBPoint, NewRBPoint, NewCLRect,
B, Picture, ActiveSkinRect, Width, Height, True)
else
CreateSkinImage(LTPoint, RTPoint, LBPoint, RBPoint, CLRect,
NewLtPoint, NewRTPoint, NewLBPoint, NewRBPoint, NewCLRect,
B, Picture, SkinRect, Width, Height, True);
end;
if FAlphaBlend
then
begin
ParentImage.Width := B.Width;
EB1 := TspEffectBmp.CreateFromhWnd(B.Handle);
EB2 := TspEffectBmp.CreateFromhWnd(ParentImage.Handle);
kf := 1 - FAlphaBlendValue / 255;
EB1.Morph(EB2, Kf);
EB1.Draw(C.Handle, 0, 0);
EB1.Free;
EB2.Free;
end
else
C.Draw(0, 0, B);
B.Free;
end;
procedure TspSkinMemo.SkinFramePaint(C: TCanvas);
var
NewLTPoint, NewRTPoint, NewLBPoint, NewRBPoint: TPoint;
R, NewClRect: TRect;
LeftB, TopB, RightB, BottomB: TBitMap;
OffX, OffY: Integer;
begin
GetSkinData;
if FIndex = -1
then
with C do
begin
Brush.Style := bsClear;
R := Rect(0, 0, Width, Height);
if FMouseIn or Focused
then
begin
Frame3D(C, R, clBtnShadow, clBtnShadow, 1);
Frame3D(C, R, clBtnFace, clBtnFace, 1);
end
else
begin
Frame3D(C, R, clBtnFace, clBtnFace, 1);
Frame3D(C, R, clBtnShadow, clBtnShadow, 1);
end;
Exit;
end;
LeftB := TBitMap.Create;
TopB := TBitMap.Create;
RightB := TBitMap.Create;
BottomB := TBitMap.Create;
OffX := Width - RectWidth(SkinRect);
OffY := Height - RectHeight(SkinRect);
NewLTPoint := LTPoint;
NewRTPoint := Point(RTPoint.X + OffX, RTPoint.Y);
NewLBPoint := Point(LBPoint.X, LBPoint.Y + OffY);
NewRBPoint := Point(RBPoint.X + OffX, RBPoint.Y + OffY);
NewClRect := Rect(ClRect.Left, ClRect.Top,
ClRect.Right + OffX, ClRect.Bottom + OffY);
if FMouseIn or Focused
then
CreateSkinBorderImages(LTPoint, RTPoint, LBPoint, RBPoint, CLRect,
NewLtPoint, NewRTPoint, NewLBPoint, NewRBPoint, NewCLRect,
LeftB, TopB, RightB, BottomB, Picture, ActiveSkinRect, Width, Height)
else
CreateSkinBorderImages(LTPoint, RTPoint, LBPoint, RBPoint, 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 TspSkinMemo.WMNCPAINT;
var
DC: HDC;
C: TCanvas;
R: TRect;
EB1, EB2: TspEffectBMP;
kf: Double;
begin
if FAlphaBlend and FBitMapBG
then
begin
ParentImage := TBitMap.Create;
SetParentImage;
end;
DC := GetWindowDC(Handle);
C := TControlCanvas.Create;
C.Handle := DC;
try
if FBitMapBG
then
SkinNCPaint(C)
else
SkinFramePaint(C);
finally
C.Free;
ReleaseDC(Handle, DC);
end;
if FAlphaBlend and FBitMapBG
then
begin
ParentImage.Free;
ParentImage := nil;
end;
end;
destructor TspSkinMemo.Destroy;
begin
FDefaultFont.Free;
inherited;
end;
procedure TspSkinMemo.WMSETFOCUS;
begin
inherited;
if not FMouseIn and (FIndex <> -1)
then
begin
Font.Color := ActiveFontColor;
if not FBitMapBG then Color := ActiveBGColor;
end;
if not FMouseIn then Invalidate;
if not FBitMapBG
then
SendMessage(Handle, WM_NCPAINT, 0, 0);
end;
procedure TspSkinMemo.WMKILLFOCUS;
begin
inherited;
if not FMouseIn and (FIndex <> -1)
then
begin
Font.Color := FontColor;
if not FBitMapBG then Color := BGColor;
end;
if not FMouseIn then Invalidate;
if not FBitMapBG
then
SendMessage(Handle, WM_NCPAINT, 0, 0);
end;
procedure TspSkinMemo.CMMouseEnter;
begin
inherited;
FMouseIn := True;
if not Focused and (FIndex <> -1)
then
begin
Font.Color := ActiveFontColor;
if not FBitMapBG then Color := ActiveBGColor;
end;
if not Focused then Invalidate;
if not FBitMapBG
then
SendMessage(Handle, WM_NCPAINT, 0, 0);
end;
procedure TspSkinMemo.CMMouseLeave;
begin
inherited;
FMouseIn := False;
if not Focused and (FIndex <> -1)
then
begin
Font.Color := FontColor;
if not FBitMapBG then Color := BGColor;
end;
if not Focused then Invalidate;
if not FBitMapBG
then
SendMessage(Handle, WM_NCPAINT, 0, 0);
end;
procedure TspSkinMemo.SetAlphaBlend;
begin
if FAlphaBlend <> AValue
then
begin
FAlphaBlend := AValue;
Invalidate;
end;
end;
procedure TspSkinMemo.SetAlphaBlendValue;
begin
if FAlphaBlendValue <> AValue
then
begin
FAlphaBlendValue := AValue;
if FAlphaBlend then Invalidate;
end;
end;
procedure TspSkinMemo.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
if (PictureIndex <> -1) and (PictureIndex < FSD.FActivePictures.Count)
then
Picture := TBitMap(FSD.FActivePictures.Items[PictureIndex])
else
Picture := nil;
Self.SkinRect := SkinRect;
Self.ActiveSkinRect := ActiveSkinRect;
if isNullRect(ActiveSkinRect)
then
Self.ActiveSkinRect := SkinRect;
Self.LTPoint := LTPoint;
Self.RTPoint := RTPoint;
Self.LBPoint := LBPoint;
Self.RBPoint := RBPoint;
Self.ClRect := ClRect;
Self.FontName := FontName;
Self.FontStyle := FontStyle;
Self.FontHeight := FontHeight;
Self.FontColor := FontColor;
Self.ActiveFontColor := ActiveFontColor;
Self.BGColor := BGColor;
Self.ActiveBGColor := ActiveBGColor;
end;
end;
procedure TspSkinMemo.SetSkinData;
begin
FSD := Value;
if (FSD <> nil) then
if not FSD.Empty and not (csDesigning in ComponentState)
then
ChangeSkinData;
end;
procedure TspSkinMemo.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 TspSkinMemo.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;
end;
constructor TspListBox.Create;
begin
inherited;
SkinListBox := nil;
Ctl3D := False;
BorderStyle := bsNone;
ControlStyle := [csCaptureMouse, csOpaque, csDoubleClicks];
FHorizontalExtentValue := 0;
end;
destructor TspListBox.Destroy;
begin
inherited;
end;
procedure TspListBox.SetBounds;
var
OldWidth: Integer;
begin
OldWidth := Width;
inherited;
if (OldWidth <> Width) and (FHorizontalExtentValue > 0)
then
begin
FHorizontalExtentValue := FHorizontalExtentValue + (OldWidth - Width);
if FHorizontalExtentValue < 0 then FHorizontalExtentValue := 0;
RePaint;
end;
end;
procedure TspListBox.CreateWnd;
begin
inherited;
if SkinListBox <> nil then SkinListBox.ListBoxCreateWnd;
end;
procedure TspListBox.WMNCCALCSIZE;
begin
end;
procedure TspListBox.CMEnter;
begin
if SkinListBox <> nil then SkinListBox.ListBoxEnter;
inherited;
end;
procedure TspListBox.CMExit;
begin
if SkinListBox <> nil then SkinListBox.ListBoxExit;
inherited;
end;
procedure TspListBox.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
if SkinListBox <> nil then SkinListBox.ListBoxMouseDown(Button, Shift, X, Y);
inherited;
end;
procedure TspListBox.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
if SkinListBox <> nil then SkinListBox.ListBoxMouseUp(Button, Shift, X, Y);
inherited;
end;
procedure TspListBox.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
if SkinListBox <> nil then SkinListBox.ListBoxMouseMove(Shift, X, Y);
inherited;
end;
procedure TspListBox.KeyDown(var Key: Word; Shift: TShiftState);
begin
if SkinListBox <> nil then SkinListBox.ListBoxKeyDown(Key, Shift);
if (Key = VK_LEFT) and (SkinListBox.HScrollBar <> nil)
then
with SkinListBox.HScrollBar do
begin
Position := Position - SmallChange;
Key := 0;
end
else
if (Key = VK_RIGHT) and (SkinListBox.HScrollBar <> nil)
then
with SkinListBox.HScrollBar do
begin
Position := Position + SmallChange;
Key := 0;
end;
inherited;
end;
procedure TspListBox.KeyPress(var Key: Char);
begin
if SkinListBox <> nil then SkinListBox.ListBoxKeyPress(Key);
inherited;
end;
procedure TspListBox.Click;
begin
if SkinListBox <> nil then SkinListBox.ListBoxClick;
inherited;
end;
procedure TspListBox.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 TspListBox.GetState;
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 TspListBox.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
Brush.Color := clWindow;
FillRect(Rect(0, 0, Width, Height));
end;
C.Handle := 0;
C.Free;
end;
procedure TspListBox.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, GetState(i))
else
DrawDefaultItem(C, i, IR, GetState(i));
end;
C.Free;
end;
procedure TspListBox.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, GetState(i))
else
DrawDefaultItem(C, i, IR, GetState(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 TspListBox.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 TspListBox.WMPaint;
begin
PaintHandler(Msg);
end;
procedure TspListBox.WMEraseBkgnd;
begin
if (Width > 0) and (Height > 0) then PaintBG(Message.DC);
Message.Result := 1;
end;
procedure TspListBox.DrawDefaultItem(Cnvs: TCanvas; itemID: Integer; rcItem: TRect;
State: TOwnerDrawState);
var
Buffer: TBitMap;
R, R1: TRect;
IIndex, IX, IY, Off: Integer;
begin
if (ItemID < 0) or (ItemID > Items.Count - 1) then Exit;
Buffer := TBitMap.Create;
Buffer.Width := RectWidth(rcItem);
Buffer.Height := RectHeight(rcItem);
R := Rect(0, 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 State
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);
if Assigned(SkinListBox.FOnDrawItem)
then
SkinListBox.FOnDrawItem(Buffer.Canvas, ItemID, Buffer.Width, Buffer.Height,
R1, State)
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 - FHorizontalExtentValue, IY, IIndex);
end;
Off := SkinListBox.Images.Width + 2
end
else
Off := 0;
Buffer.Canvas.Brush.Style := bsClear;
SPDrawText3(Buffer.Canvas, Items[ItemID], R1, - FHorizontalExtentValue + Off);
end;
if odFocused in State then DrawFocusRect(Buffer.Canvas.Handle, R);
Cnvs.Draw(rcItem.Left, rcItem.Top, Buffer);
Buffer.Free;
end;
procedure TspListBox.DrawSkinItem(Cnvs: TCanvas; itemID: Integer; rcItem: TRect;
State: TOwnerDrawState);
var
Buffer: TBitMap;
R: TRect;
W, H: Integer;
IX, IY, IIndex, Off: Integer;
begin
if (SkinListBox.Picture = nil) or (ItemID < 0) or (ItemID > Items.Count - 1) then Exit;
Buffer := TBitMap.Create;
with SkinListBox do
begin
W := RectWidth(rcItem);
H := RectHeight(SItemRect);
Buffer.Width := W;
Buffer.Height := H;
if odFocused in State
then
CreateHSkinImage(ItemLeftOffset, ItemRightOffset, Buffer, Picture,
FocusItemRect, W, H)
else
if odSelected in State
then
CreateHSkinImage(ItemLeftOffset, ItemRightOffset, Buffer, Picture,
ActiveItemRect, W, H)
else
CreateHSkinImage(ItemLeftOffset, ItemRightOffset, Buffer, Picture,
SItemRect, W, H);
R := ItemTextRect;
Inc(R.Right, W - RectWidth(SItemRect));
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 State
then
Font.Color := SkinListBox.FocusFontColor
else
if odSelected in State
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, State)
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 - FHorizontalExtentValue, IY, IIndex);
end;
Off := SkinListBox.Images.Width + 2;
end
else
Off := 0;
SPDrawText3(Buffer.Canvas, Items[ItemID], R, -FHorizontalExtentValue + Off);
end;
Cnvs.Draw(rcItem.Left, rcItem.Top, Buffer);
Buffer.Free;
end;
procedure TspListBox.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 TspListBox.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 TspListBox.WndProc;
var
LParam, WParam: Integer;
Handled: Boolean;
begin
if SkinListBox <> nil then SkinListBox.ListBoxWProc(Message, Handled);
if not Handled then Exit;
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
else
if (SkinListBox <> nil) and (SkinListBox.HScrollBar <> nil)
then
begin
with SkinListBox.HScrollBar do
if Message.WParam > 0
then
Position := Position - SmallChange
else
Position := Position + SmallChange;
end;
WM_ERASEBKGND:
SkinListBox.UpDateScrollBar;
LB_ADDSTRING, LB_INSERTSTRING,
LB_DELETESTRING:
begin
if SkinListBox <> nil
then
SkinListBox.UpDateScrollBar;
end;
end;
end;
constructor TspSkinCustomListBox.Create;
begin
inherited;
ControlStyle := [csCaptureMouse, csClickEvents,
csReplicatable, csOpaque, csDoubleClicks];
ControlStyle := ControlStyle + [csAcceptsControls];
FRowCount := 0;
FImageIndex := -1;
FGlyph := TBitMap.Create;
FNumGlyphs := 1;
FSpacing := 2;
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;
HScrollBar := nil;
ListBox := TspListBox.Create(Self);
ListBox.SkinListBox := Self;
ListBox.Style := lbOwnerDrawFixed;
ListBox.ItemHeight := FDefaultItemHeight;
ListBox.Parent := Self;
ListBox.Visible := True;
Height := 120;
Width := 120;
FSkinDataName := 'listbox';
FHorizontalExtent := False;
FStopUpDateHScrollBar := False;
end;
procedure TspSkinCustomListBox.SetHorizontalExtent(Value: Boolean);
begin
FHorizontalExtent := Value;
UpdateScrollBar;
end;
procedure TspSkinCustomListBox.ListBoxCreateWnd;
begin
end;
function TspSkinCustomListBox.GetColumns;
begin
Result := ListBox.Columns;
end;
procedure TspSkinCustomListBox.SetColumns;
begin
ListBox.Columns := Value;
UpDateScrollBar;
end;
procedure TspSkinCustomListBox.SetRowCount;
begin
FRowCount := Value;
if FRowCount <> 0
then
Height := Self.CalcHeight(FRowCount);
end;
procedure TspSkinCustomListBox.SetNumGlyphs;
begin
FNumGlyphs := Value;
RePaint;
end;
procedure TspSkinCustomListBox.SetGlyph;
begin
FGlyph.Assign(Value);
RePaint;
end;
procedure TspSkinCustomListBox.SetSpacing;
begin
FSpacing := Value;
RePaint;
end;
procedure TspSkinCustomListBox.SetImages(Value: TCustomImageList);
begin
FImages := Value;
ListBox.RePaint;
end;
procedure TspSkinCustomListBox.SetImageIndex(Value: Integer);
begin
FImageIndex := Value;
ListBox.RePaint;
end;
procedure TspSkinCustomListBox.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (AComponent = Images) then
Images := nil;
end;
procedure TspSkinCustomListBox.ListBoxWProc(var Message: TMessage; var Handled: Boolean);
begin
Handled := True;
end;
procedure TspSkinCustomListBox.DefaultFontChange;
begin
if FIndex = -1 then Font.Assign(FDefaultFont);
end;
procedure TspSkinCustomListBox.OnDefaultCaptionFontChange;
begin
if (FIndex = -1) and FCaptionMode then RePaint;
end;
procedure TspSkinCustomListBox.SetDefaultCaptionHeight;
begin
FDefaultCaptionHeight := Value;
if (FIndex = -1) and FCaptionMode
then
begin
CalcRects;
RePaint;
end;
end;
procedure TspSkinCustomListBox.SetDefaultCaptionFont;
begin
FDefaultCaptionFont.Assign(Value);
end;
procedure TspSkinCustomListBox.SetDefaultItemHeight;
begin
FDefaultItemHeight := Value;
if FIndex = -1
then
ListBox.ItemHeight := FDefaultItemHeight;
end;
procedure TspSkinCustomListBox.StartTimer;
begin
KillTimer(Handle, 1);
SetTimer(Handle, 1, 100, nil);
end;
procedure TspSkinCustomListBox.StopTimer;
begin
KillTimer(Handle, 1);
TimerMode := 0;
end;
procedure TspSkinCustomListBox.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 TspSkinCustomListBox.CMMouseEnter;
begin
inherited;
if FCaptionMode
then
TestActive(-1, -1);
end;
procedure TspSkinCustomListBox.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 TspSkinCustomListBox.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 TspSkinCustomListBox.MouseUp;
begin
if FCaptionMode
then
begin
if CaptureButton <> -1
then ButtonUp(CaptureButton, X, Y);
CaptureButton := -1;
end;
inherited;
end;
procedure TspSkinCustomListBox.MouseMove;
begin
inherited;
if FCaptionMode then TestActive(X, Y);
end;
procedure TspSkinCustomListBox.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 TspSkinCustomListBox.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 TspSkinCustomListBox.ButtonUp;
begin
Buttons[i].Down := False;
if ActiveButton <> i then Buttons[i].MouseIn := False;
DrawButton(Canvas, i);
if Buttons[i].MouseIn
then
case i of
0:
if Assigned(FOnUpButtonClick)
then
begin
FOnUpButtonClick(Self);
Exit;
end;
1:
if Assigned(FOnDownButtonClick)
then
begin
FOnDownButtonClick(Self);
Exit;
end;
2:
if Assigned(FOnCheckButtonClick)
then
begin
FOnCheckButtonClick(Self);
Exit;
end;
end;
case i of
1: ItemIndex := ItemIndex + 1;
0: if ItemIndex > 0 then ItemIndex := ItemIndex - 1;
2: ListBox.Click;
end;
if TimerMode <> 0 then StopTimer;
end;
procedure TspSkinCustomListBox.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 TspSkinCustomListBox.ButtonLeave(I: Integer);
begin
Buttons[i].MouseIn := False;
DrawButton(Canvas, i);
if (TimerMode <> 0) and Buttons[i].Down
then KillTimer(Handle, 1);
end;
procedure TspSkinCustomListBox.CMTextChanged;
begin
inherited;
if FCaptionMode then RePaint;
end;
procedure TspSkinCustomListBox.SetAlignment(Value: TAlignment);
begin
if FAlignment <> Value
then
begin
FAlignment := Value;
if FCaptionMode then RePaint;
end;
end;
procedure TspSkinCustomListBox.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 TspSkinCustomListBox.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 TspSkinCustomListBox.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 TspSkinCustomListBox.SetCaptionMode;
begin
FCaptionMode := Value;
if FIndex = -1
then
begin
CalcRects;
RePaint;
end;
end;
function TspSkinCustomListBox.CalcHeight;
begin
if FIndex = -1
then
begin
Result := AitemsCount * ListBox.ItemHeight + 4;
if CaptionMode then Result := Result + FDefaultCaptionHeight;
end
else
Result := ClRect.Top + AitemsCount * ListBox.ItemHeight +
RectHeight(SkinRect) - ClRect.Bottom;
if HScrollBar <> nil
then
Inc(Result, HScrollBar.Height);
end;
procedure TspSkinCustomListBox.Clear;
begin
ListBox.Clear;
UpDateScrollBar;
end;
function TspSkinCustomListBox.ItemAtPos(Pos: TPoint; Existing: Boolean): Integer;
begin
Result := ListBox.ItemAtPos(Pos, Existing);
end;
function TspSkinCustomListBox.ItemRect(Item: Integer): TRect;
begin
Result := ListBox.ItemRect(Item);
end;
function TspSkinCustomListBox.GetListBoxPopupMenu;
begin
Result := ListBox.PopupMenu;
end;
procedure TspSkinCustomListBox.SetListBoxPopupMenu;
begin
ListBox.PopupMenu := Value;
end;
function TspSkinCustomListBox.GetCanvas: TCanvas;
begin
Result := ListBox.Canvas;
end;
function TspSkinCustomListBox.GetExtandedSelect: Boolean;
begin
Result := ListBox.ExtendedSelect;
end;
procedure TspSkinCustomListBox.SetExtandedSelect(Value: Boolean);
begin
ListBox.ExtendedSelect := Value;
end;
function TspSkinCustomListBox.GetSelCount: Integer;
begin
Result := ListBox.SelCount;
end;
function TspSkinCustomListBox.GetSelected(Index: Integer): Boolean;
begin
Result := ListBox.Selected[Index];
end;
procedure TspSkinCustomListBox.SetSelected(Index: Integer; Value: Boolean);
begin
ListBox.Selected[Index] := Value;
end;
function TspSkinCustomListBox.GetSorted: Boolean;
begin
Result := ListBox.Sorted;
end;
procedure TspSkinCustomListBox.SetSorted(Value: Boolean);
begin
ListBox.Sorted := Value;
end;
function TspSkinCustomListBox.GetTopIndex: Integer;
begin
Result := ListBox.TopIndex;
end;
procedure TspSkinCustomListBox.SetTopIndex(Value: Integer);
begin
ListBox.TopIndex := Value;
end;
function TspSkinCustomListBox.GetMultiSelect: Boolean;
begin
Result := ListBox.MultiSelect;
end;
procedure TspSkinCustomListBox.SetMultiSelect(Value: Boolean);
begin
ListBox.MultiSelect := Value;
end;
function TspSkinCustomListBox.GetListBoxFont: TFont;
begin
Result := ListBox.Font;
end;
procedure TspSkinCustomListBox.SetListBoxFont(Value: TFont);
begin
ListBox.Font.Assign(Value);
end;
function TspSkinCustomListBox.GetListBoxTabOrder: TTabOrder;
begin
Result := ListBox.TabOrder;
end;
procedure TspSkinCustomListBox.SetListBoxTabOrder(Value: TTabOrder);
begin
ListBox.TabOrder := Value;
end;
function TspSkinCustomListBox.GetListBoxTabStop: Boolean;
begin
Result := ListBox.TabStop;
end;
procedure TspSkinCustomListBox.SetListBoxTabStop(Value: Boolean);
begin
ListBox.TabStop := Value;
end;
procedure TspSkinCustomListBox.ShowScrollBar;
begin
ScrollBar := TspSkinScrollBar.Create(Self);
with ScrollBar do
begin
if Columns > 0
then
Kind := sbHorizontal
else
Kind := sbVertical;
Height := 100;
Width := 20;
PageSize := 0;
Min := 0;
Position := 0;
OnChange := SBChange;
if Self.FIndex = -1
then
SkinDataName := ''
else
if Columns > 0
then
SkinDataName := HScrollBarName
else
SkinDataName := VScrollBarName;
SkinData := Self.SkinData;
Parent := Self;
Visible := True;
//
if HScrollBar <> nil
then
with HScrollBar do
begin
if Self.FIndex = -1
then
begin
SkinDataName := '';
FBoth := True;
BothMarkerWidth := 19;
end
else
begin
BothSkinDataName := BothScrollBarName;
SkinDataName := BothScrollBarName;
FBoth := True;
end;
SkinData := Self.SkinData;
end;
//
CalcRects;
end;
RePaint;
end;
procedure TspSkinCustomListBox.ShowHScrollBar;
begin
HScrollBar := TspSkinScrollBar.Create(Self);
with HScrollBar do
begin
Kind := sbHorizontal;
Height := 100;
Width := 20;
PageSize := 0;
Min := 0;
Position := 0;
OnChange := HSBChange;
if Self.FIndex = -1
then
begin
SkinDataName := '';
if ScrollBar <> nil
then
begin
FBoth := True;
BothMarkerWidth := 19;
end;
end
else
if ScrollBar <> nil
then
begin
BothSkinDataName := BothScrollBarName;
SkinDataName := BothScrollBarName;
FBoth := True;
end
else
begin
BothSkinDataName := HScrollBarName;
SkinDataName := HScrollBarName;
FBoth := False;
end;
SkinData := Self.SkinData;
Parent := Self;
Visible := True;
CalcRects;
end;
RePaint;
end;
procedure TspSkinCustomListBox.ListBoxEnter;
begin
end;
procedure TspSkinCustomListBox.ListBoxExit;
begin
end;
procedure TspSkinCustomListBox.ListBoxKeyDown;
begin
if Assigned(FOnListBoxKeyDown) then FOnListBoxKeyDown(Self, Key, Shift);
end;
procedure TspSkinCustomListBox.ListBoxKeyUp;
begin
if Assigned(FOnListBoxKeyUp) then FOnListBoxKeyUp(Self, Key, Shift);
end;
procedure TspSkinCustomListBox.ListBoxKeyPress;
begin
if Assigned(FOnListBoxKeyPress) then FOnListBoxKeyPress(Self, Key);
end;
procedure TspSkinCustomListBox.ListBoxDblClick;
begin
if Assigned(FOnListBoxDblClick) then FOnListBoxDblClick(Self);
end;
procedure TspSkinCustomListBox.ListBoxClick;
begin
if Assigned(FOnListBoxClick) then FOnListBoxClick(Self);
end;
procedure TspSkinCustomListBox.ListBoxMouseDown;
begin
if Assigned(FOnListBoxMouseDown) then FOnListBoxMouseDown(Self, Button, Shift, X, Y);
end;
procedure TspSkinCustomListBox.ListBoxMouseMove;
begin
if Assigned(FOnListBoxMouseMove) then FOnListBoxMouseMove(Self, Shift, X, Y);
end;
procedure TspSkinCustomListBox.ListBoxMouseUp;
begin
if Assigned(FOnListBoxMouseUp) then FOnListBoxMouseUp(Self, Button, Shift, X, Y);
end;
procedure TspSkinCustomListBox.HideScrollBar;
begin
ScrollBar.Visible := False;
ScrollBar.Free;
ScrollBar := nil;
CalcRects;
end;
procedure TspSkinCustomListBox.HideHScrollBar;
begin
ListBox.HorizontalExtentValue := 0;
HScrollBar.Visible := False;
HScrollBar.Free;
HScrollBar := nil;
CalcRects;
ListBox.Repaint;
end;
procedure TspSkinCustomListBox.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 TspSkinCustomListBox.HSBChange(Sender: TObject);
begin
ListBox.HorizontalExtentValue := HScrollBar.Position;
ListBox.Repaint;
end;
procedure TspSkinCustomListBox.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
begin
SendMessage(ListBox.Handle, WM_VSCROLL, WParam, LParam);
end;
end;
function TspSkinCustomListBox.GetItemIndex;
begin
Result := ListBox.ItemIndex;
end;
procedure TspSkinCustomListBox.SetItemIndex;
begin
ListBox.ItemIndex := Value;
end;
procedure TspSkinCustomListBox.SetItems;
begin
ListBox.Items.Assign(Value);
UpDateScrollBar;
end;
function TspSkinCustomListBox.GetItems;
begin
Result := ListBox.Items;
end;
destructor TspSkinCustomListBox.Destroy;
begin
if ScrollBar <> nil then ScrollBar.Free;
if ListBox <> nil then ListBox.Free;
FDefaultCaptionFont.Free;
FGlyph.Free;
inherited;
end;
procedure TspSkinCustomListBox.CalcRects;
var
LTop: Integer;
OffX, OffY: Integer;
HSY: 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 (Columns = 0) and (HScrollBar <> nil) and (HScrollBar.Visible)
then
begin
if FIndex = -1
then
begin
HScrollBar.SetBounds(1, Height - 20, Width - 2, 19);
HSY := HScrollBar.Height - 1;
end
else
begin
HScrollBar.SetBounds(NewClRect.Left,
NewClRect.Bottom - HScrollBar.Height,
RectWidth(NewClRect), HScrollBar.Height);
HSY := HScrollBar.Height;
end;
end
else
HSY := 0;
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 - HSY);
ListRect := Rect(2, LTop + 1, ScrollBar.Left, Height - 2 - HSY);
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) - HSY);
ListRect := NewClRect;
Dec(ListRect.Right, ScrollBar.Width);
Dec(ListRect.Bottom, HSY);
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 TspSkinCustomListBox.GetSkinData;
begin
inherited;
if FIndex <> -1
then
if TspDataSkinControl(FSD.CtrlList.Items[FIndex]) is TspDataSkinListBox
then
with TspDataSkinListBox(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.ItemLeftOffset := ItemLeftOffset;
Self.ItemRightOffset := ItemRightOffset;
Self.ItemTextRect := ItemTextRect;
Self.FontColor := FontColor;
Self.ActiveFontColor := ActiveFontColor;
Self.FocusFontColor := FocusFontColor;
//
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;
//
Self.VScrollBarName := VScrollBarName;
Self.HScrollBarName := HScrollBarName;
Self.BothScrollBarName := BothScrollBarName;
end;
end;
procedure TspSkinCustomListBox.ChangeSkinData;
begin
inherited;
//
FStopUpDateHScrollBar := True;
if FIndex <> -1
then
begin
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 HScrollBar <> nil
then
with HScrollBar do
begin
if Self.FIndex = -1
then
begin
SkinDataName := '';
if ScrollBar <> nil then BothMarkerWidth := 19;
end
else
if ScrollBar <> nil
then
SkinDataName := BothScrollBarName
else
SkinDataName := HScrollBarName;
SkinData := Self.SkinData;
end;
if FRowCount <> 0
then
Height := Self.CalcHeight(FRowCount);
CalcRects;
FStopUpDateHScrollBar := False;
UpDateScrollBar;
ListBox.RePaint;
end;
procedure TspSkinCustomListBox.WMSIZE;
begin
inherited;
CalcRects;
UpDateScrollBar;
if ScrollBar <> nil then ScrollBar.RePaint;
end;
procedure TspSkinCustomListBox.SetBounds;
begin
inherited;
if FIndex = -1 then RePaint;
end;
function TspSkinCustomListBox.GetFullItemWidth(Index: Integer; ACnvs: TCanvas): Integer;
begin
Result := ACnvs.TextWidth(Items[Index]);
end;
procedure TspSkinCustomListBox.UpDateScrollBar;
var
I, FMaxWidth, Min, Max, Pos, Page: Integer;
function GetPageSize: Integer;
begin
if FIndex = -1
then Result := ListBox.Width - 4
else
begin
Result := RectWidth(SItemRect) - RectWidth(ItemTextRect);
Result := ListBox.Width - Result;
end;
if Images <> nil then Result := Result - Images.Width - 4;
end;
begin
if (ListBox = nil) 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) and
((ListBox.Height div ListBox.ItemHeight) * Columns < ListBox.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
begin
if FHorizontalExtent and not FStopUpDateHScrollBar
then
begin
FMaxWidth := 0;
with ListBox.Canvas do
begin
if FIndex = -1
then
Font.Assign(ListBox.Font)
else
begin
Font.Name := FontName;
Font.Style := FontStyle;
Font.Height := FontHeight;
end;
end;
for I := 0 to Items.Count - 1 do
FMaxWidth := spUtils.Max(FMaxWidth, GetFullItemWidth(I, ListBox.Canvas));
Page := GetPageSize;
if FMaxWidth > Page
then
begin
if HScrollBar = nil then ShowHScrollBar;
HScrollBar.SetRange(0, FMaxWidth, HScrollBar.Position, Page);
HScrollBar.SmallChange := ListBox.Canvas.TextWidth('0');
HScrollBar.LargeChange := ListBox.Canvas.TextWidth('0');
end
else
if (HScrollBar <> nil) and HScrollBar.Visible then HideHScrollBar;
end
else
if (HScrollBar <> nil) and HScrollBar.Visible then HideHScrollBar;
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;
// combobox
constructor TspSkinCustomComboBox.Create;
begin
inherited Create(AOwner);
ControlStyle := [csCaptureMouse, csOpaque, csDoubleClicks, csAcceptsControls];
FListBoxAlphaBlendAnimation := False;
FListBoxAlphaBlend := False;
FListBoxAlphaBlendValue := 200;
TabStop := True;
Font.Name := 'Arial';
Font.Color := clWindowText;
Font.Style := [];
Font.Height := 14;
Width := 120;
Height := 20;
FromEdit := False;
FEdit := nil;
//
FStyle := spcbFixedStyle;
FOnListBoxDrawItem := nil;
FListBox := TspPopupListBox.Create(Self);
FListBox.Visible := False;
FlistBox.Parent := Self;
FListBox.ListBox.TabStop := False;
FlistBox.ListBox.OnMouseDown := ListBoxMouseDown;
FlistBox.ListBox.OnMouseMove := ListBoxMouseMove;
FlistBox.ListBox.OnMouseUp := ListBoxMouseUp;
FListBoxWindowProc := FlistBox.ListBox.WindowProc;
FlistBox.ListBox.WindowProc := ListBoxWindowProcHook;
FListBox.OnCheckButtonClick := CheckButtonClick;
FLBDown := False;
FDropDownCount := 8;
//
CalcRects;
FSkinDataName := 'combobox';
end;
destructor TspSkinCustomComboBox.Destroy;
begin
if FEdit <> nil then FEdit.Free;
FlistBox.Free;
inherited;
end;
procedure TspSkinCustomComboBox.CMEnabledChanged;
begin
inherited;
RePaint;
end;
function TspSkinCustomComboBox.GetHorizontalExtent: Boolean;
begin
Result := FlistBox.HorizontalExtent;
end;
procedure TspSkinCustomComboBox.SetHorizontalExtent(Value: Boolean);
begin
FlistBox.HorizontalExtent := Value;
end;
procedure TspSkinCustomComboBox.Change;
begin
end;
procedure TspSkinCustomComboBox.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (AComponent = Images) then
Images := nil;
end;
function TspSkinCustomComboBox.GetImages: TCustomImageList;
begin
Result := FListBox.Images;
end;
function TspSkinCustomComboBox.GetImageIndex: Integer;
begin
Result := FListBox.ImageIndex;
end;
procedure TspSkinCustomComboBox.SetImages(Value: TCustomImageList);
begin
FListBox.Images := Value;
RePaint;
end;
procedure TspSkinCustomComboBox.SetImageIndex(Value: Integer);
begin
FListBox.ImageIndex := Value;
RePaint;
end;
procedure TspSkinCustomComboBox.EditCancelMode(C: TControl);
begin
if (C <> Self)and
(C <> Self.FListBox) and
(C <> Self.FListBox.ScrollBar) and
(C <> Self.FListBox.HScrollBar) and
(C <> Self.FListBox.ListBox)
then
CloseUp(False);
end;
procedure TspSkinCustomComboBox.CMCancelMode;
begin
inherited;
if (Message.Sender <> Self)and
(Message.Sender <> Self.FListBox) and
(Message.Sender <> Self.FListBox.ScrollBar) and
(Message.Sender <> Self.FListBox.HScrollBar) and
(Message.Sender <> Self.FListBox.ListBox)
then
CloseUp(False);
end;
function TspSkinCustomComboBox.GetListBoxDefaultFont;
begin
Result := FListBox.DefaultFont;
end;
procedure TspSkinCustomComboBox.SetListBoxDefaultFont;
begin
FListBox.DefaultFont.Assign(Value);
end;
function TspSkinCustomComboBox.GetListBoxDefaultCaptionFont;
begin
Result := FListBox.DefaultCaptionFont;
end;
procedure TspSkinCustomComboBox.SetListBoxDefaultCaptionFont;
begin
FListBox.DefaultCaptionFont.Assign(Value);
end;
function TspSkinCustomComboBox.GetListBoxDefaultItemHeight;
begin
Result := FListBox.DefaultItemHeight;
end;
procedure TspSkinCustomComboBox.SetListBoxDefaultItemHeight;
begin
FListBox.DefaultItemHeight := Value;
end;
function TspSkinCustomComboBox.GetListBoxCaptionAlignment;
begin
Result := FListBox.Alignment;
end;
procedure TspSkinCustomComboBox.SetListBoxCaptionAlignment;
begin
FListBox.Alignment := Value;
end;
procedure TspSkinCustomComboBox.DefaultFontChange;
begin
Font.Assign(FDefaultFont);
end;
procedure TspSkinCustomComboBox.CheckButtonClick;
begin
CloseUp(True);
end;
procedure TspSkinCustomComboBox.SetListBoxCaption;
begin
FListBox.Caption := Value;
end;
function TspSkinCustomComboBox.GetListBoxCaption;
begin
Result := FListBox.Caption;
end;
procedure TspSkinCustomComboBox.SetListBoxCaptionMode;
begin
FListBox.CaptionMode := Value;
end;
function TspSkinCustomComboBox.GetListBoxCaptionMode;
begin
Result := FListBox.CaptionMode;
end;
function TspSkinCustomComboBox.GetSorted: Boolean;
begin
Result := FListBox.Sorted;
end;
procedure TspSkinCustomComboBox.SetSorted(Value: Boolean);
begin
FListBox.Sorted := Value;
end;
procedure TspSkinCustomComboBox.SetListBoxDrawItem;
begin
FOnListboxDrawItem := Value;
FListBox.OnDrawItem := FOnListboxDrawItem;
end;
procedure TspSkinCustomComboBox.ListBoxDrawItem(Cnvs: TCanvas; Index: Integer;
ItemWidth, ItemHeight: Integer; TextRect: TRect; State: TOwnerDrawState);
begin
if Assigned(FOnListBoxDrawItem)
then FOnListBoxDrawItem(Cnvs, Index, ItemWidth, ItemHeight, TextRect, State);
end;
procedure TspSkinCustomComboBox.SetStyle;
begin
if (FStyle = Value) and (csDesigning in ComponentState) then Exit;
FStyle := Value;
case FStyle of
spcbFixedStyle:
begin
TabStop := True;
if FEdit <> nil then HideEditor;
end;
spcbEditStyle:
begin
TabStop := False;
ShowEditor;
FEdit.Text := Text;
if Focused then FEdit.SetFocus;
end;
end;
CalcRects;
ReCreateWnd;
RePaint;
end;
procedure TspSkinCustomComboBox.CMWantSpecialKey(var Msg: TCMWantSpecialKey);
begin
inherited;
case Msg.CharCode of
VK_UP, VK_DOWN, VK_LEFT, VK_RIGHT: Msg.Result := 1;
end;
end;
procedure TspSkinCustomComboBox.KeyDown;
begin
inherited KeyDown(Key, Shift);
case Key of
VK_UP, VK_LEFT:
if ssAlt in Shift
then
begin
if FListBox.Visible then CloseUp(False);
end
else
EditUp1(True);
VK_DOWN, VK_RIGHT:
if ssAlt in Shift
then
begin
if not FListBox.Visible then DropDown;
end
else
EditDown1(True);
VK_NEXT: EditPageDown1(True);
VK_PRIOR: EditPageUp1(True);
VK_ESCAPE: if FListBox.Visible then CloseUp(False);
VK_RETURN: if FListBox.Visible then CloseUp(True);
end;
end;
procedure TspSkinCustomComboBox.WMMOUSEWHEEL;
begin
if FEdit <> nil then Exit;
if Message.WParam > 0
then
EditUp1(not FListBox.Visible)
else
EditDown1(not FListBox.Visible);
end;
procedure TspSkinCustomComboBox.WMSETFOCUS;
begin
if FEdit <> nil
then
FEDit.SetFocus
else
begin
inherited;
RePaint;
end;
end;
procedure TspSkinCustomComboBox.WMKILLFOCUS;
begin
inherited;
if FListBox.Visible and (FEdit = nil)
then CloseUp(False);
RePaint;
end;
procedure TspSkinCustomComboBox.GetSkinData;
begin
inherited;
if FIndex <> -1
then
if TspDataSkinControl(FSD.CtrlList.Items[FIndex]) is TspDataSkinComboBox
then
with TspDataSkinComboBox(FSD.CtrlList.Items[FIndex]) do
begin
Self.SItemRect := SItemRect;
Self.FocusItemRect := FocusItemRect;
if isNullRect(FocusItemRect)
then
Self.FocusItemRect := SItemRect;
Self.ItemLeftOffset := ItemLeftOffset;
Self.ItemRightOffset := ItemRightOffset;
Self.ItemTextRect := ItemTextRect;
Self.FontName := FontName;
Self.FontStyle := FontStyle;
Self.FontHeight := FontHeight;
Self.FontColor := FontColor;
Self.FocusFontColor := FocusFontColor;
Self.ButtonRect := ButtonRect;
Self.ActiveButtonRect := ActiveButtonRect;
Self.DownButtonRect := DownButtonRect;
Self.UnEnabledButtonRect := UnEnabledButtonRect;
Self.ListBoxName := ListBoxName;
end;
end;
procedure TspSkinCustomComboBox.Invalidate;
begin
inherited;
if (FIndex <> -1) and (FEdit <> nil) then FEdit.Invalidate;
end;
function TspSkinCustomComboBox.GetItemIndex;
begin
Result := FListBox.ItemIndex;
end;
procedure TspSkinCustomComboBox.SetItemIndex;
begin
FListBox.ItemIndex := Value;
if (FListBox.Items.Count > 0) and (FListBox.ItemIndex <> -1)
then
Text := FListBox.Items[FListBox.ItemIndex];
FOldItemIndex := FListBox.ItemIndex;
if FEdit = nil then RePaint;
if not (csDesigning in ComponentState) and
not (csLoading in ComponentState)
then
begin
if Assigned(FOnClick) then FOnClick(Self);
Change;
end;
end;
function TspSkinCustomComboBox.IsPopupVisible: Boolean;
begin
Result := FListBox.Visible;
end;
function TspSkinCustomComboBox.CanCancelDropDown;
begin
Result := FListBox.Visible and not FMouseIn;
end;
procedure TspSkinCustomComboBox.EditWindowProcHook(var Message: TMessage);
var
FOld: Boolean;
Index: Integer;
begin
FOld := True;
case Message.Msg of
WM_LBUTTONDOWN, WM_RBUTTONDOWN:
begin
if FListBox.Visible then CloseUp(False);
end;
WM_KILLFOCUS:
begin
if FListBox.Visible then CloseUp(False);
end;
WM_MOUSEWHEEL:
begin
if Message.WParam > 0
then
EditUp(not FListBox.Visible)
else
EditDown(not FListBox.Visible);
end;
WM_CHAR:
case TWMCHAR(Message).CharCode of
VK_RETURN, VK_ESCAPE:
begin
FOLD := False;
end;
end;
WM_KEYDOWN:
begin
case TWMKEYDOWN(Message).CharCode of
VK_PRIOR:
if FListBox.Visible
then
begin
Index := FListBox.ItemIndex - DropDownCount - 1;
if Index < 0
then
Index := 0;
FListBox.ItemIndex := Index;
end;
VK_NEXT:
if FListBox.Visible
then
begin
Index := FListBox.ItemIndex + DropDownCount - 1;
if Index > FListBox.Items.Count - 1
then
Index := FListBox.Items.Count - 1;
FListBox.ItemIndex := Index;
end;
VK_RETURN:
begin
if FListBox.Visible then CloseUp(True) else Text := '';
FOld := False;
end;
VK_ESCAPE:
begin
if FListBox.Visible then CloseUp(False);
FOld := False;
end;
VK_UP:
begin
EditUp(True);
FOld := False;
end;
VK_DOWN:
begin
EditDown(True);
FOld := False;
end;
end;
end;
end;
if FOld then FEditWindowProc(Message);
end;
procedure TspSkinCustomComboBox.ListBoxWindowProcHook(var Message: TMessage);
var
FOld: Boolean;
begin
FOld := True;
case Message.Msg of
WM_LBUTTONUP:
begin
CloseUp(True);
FOLD := False;
end;
WM_RBUTTONDOWN, WM_RBUTTONUP,
WM_MBUTTONDOWN, WM_MBUTTONUP,
WM_LBUTTONDOWN:
begin
FOLd := False;
end;
WM_MOUSEACTIVATE:
begin
Message.Result := MA_NOACTIVATE;
end;
end;
if FOld then FListBoxWindowProc(Message);
end;
procedure TspSkinCustomComboBox.CMMouseEnter;
begin
inherited;
FMouseIn := True;
end;
procedure TspSkinCustomComboBox.CMMouseLeave;
begin
inherited;
FMouseIn := False;
if Button.MouseIn
then
begin
Button.MouseIn := False;
RePaint;
end;
end;
procedure TspSkinCustomComboBox.SetDropDownCount(Value: Integer);
begin
if Value > 0
then
FDropDownCount := Value;
end;
procedure TspSkinCustomComboBox.ListBoxMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
FLBDown := True;
end;
procedure TspSkinCustomComboBox.ListBoxMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
var
Index: Integer;
begin
if not FLBDown
then
begin
Index := FListBox.ItemAtPos(Point (X, Y), True);
if (Index >= 0) and (Index < Items.Count)
then
FListBox.ItemIndex := Index;
end;
end;
procedure TspSkinCustomComboBox.ListBoxMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
FLBDown := False;
CloseUp(True);
end;
procedure TspSkinCustomComboBox.SetItems;
begin
FListBox.Items.Assign(Value);
end;
function TspSkinCustomComboBox.GetItems;
begin
Result := FListBox.Items;
end;
procedure TspSkinCustomComboBox.MouseDown;
begin
inherited;
if not Focused and (FEdit = nil) then SetFocus;
if Button <> mbLeft then Exit;
if Self.Button.MouseIn or
(PtInRect(CBItem.R, Point(X, Y)) and (FEdit = nil))
then
begin
Self.Button.Down := True;
RePaint;
if FListBox.Visible then CloseUp(False) else DropDown;
end
else
if FListBox.Visible then CloseUp(False);
end;
procedure TspSkinCustomComboBox.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
inherited;
if Self.Button.Down
then
begin
Self.Button.Down := False;
RePaint;
end;
end;
procedure TspSkinCustomComboBox.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
inherited;
if PtInRect(Button.R, Point(X, Y)) and not Button.MouseIn
then
begin
Button.MouseIn := True;
RePaint;
end
else
if not PtInRect(Button.R, Point(X, Y)) and Button.MouseIn
then
begin
Button.MouseIn := False;
RePaint;
end;
end;
procedure TspSkinCustomComboBox.CloseUp;
begin
if not FListBox.Visible then Exit;
FListBox.Hide;
if (FListBox.ItemIndex >= 0) and
(FListBox.ItemIndex < FListBox.Items.Count) and Value
then
begin
if FEdit <> nil
then
FEdit.Text := FListBox.Items[FListBox.ItemIndex]
else
begin
Text := FListBox.Items[FListBox.ItemIndex];
RePaint;
end;
if Assigned(FOnClick) then FOnClick(Self);
Change;
end
else
FListBox.ItemIndex := FOldItemIndex;
if Value
then
if Assigned(FOnCloseUp) then FOnCloseUp(Self);
end;
procedure TspSkinCustomComboBox.DropDown;
var
P: TPoint;
WorkArea: TRect;
begin
FListBox.Width := Width;
if Items.Count < DropDownCount
then
FListBox.Height := FListBox.CalcHeight(Items.Count)
else
FListBox.Height := FListBox.CalcHeight(DropDownCount);
P := Point(Left, Top + Height);
P := Parent.ClientToScreen (P);
SystemParametersInfo(SPI_GETWORKAREA, 0, @WorkArea, 0);
if P.Y + FListBox.Height > WorkArea.Bottom
then
P.Y := P.Y - Height - FListBox.Height;
if FEdit <> nil then FEdit.SetFocus;
FOldItemIndex := FListBox.ItemIndex;
if (FListBox.ItemIndex = 0) and (FListBox.Items.Count > 1)
then
begin
FListBox.ItemIndex := 1;
FListBox.ItemIndex := 0;
end;
FListBox.TopIndex := FListBox.ItemIndex;
FListBox.Show(P);
end;
procedure TspSkinCustomComboBox.EditPageUp1(AChange: Boolean);
var
Index: Integer;
begin
Index := FListBox.ItemIndex - DropDownCount - 1;
if Index < 0 then Index := 0;
if AChange
then
ItemIndex := Index
else
FListBox.ItemIndex := Index;
end;
procedure TspSkinCustomComboBox.EditPageDown1(AChange: Boolean);
var
Index: Integer;
begin
Index := FListBox.ItemIndex + DropDownCount - 1;
if Index > FListBox.Items.Count - 1
then
Index := FListBox.Items.Count - 1;
if AChange
then
ItemIndex := Index
else
FListBox.ItemIndex := Index;
end;
procedure TspSkinCustomComboBox.EditUp1;
begin
if FListBox.ItemIndex > 0
then
begin
if AChange
then
ItemIndex := ItemIndex - 1
else
FListBox.ItemIndex := FListBox.ItemIndex - 1;
end;
end;
procedure TspSkinCustomComboBox.EditDown1;
begin
if FListBox.ItemIndex < FListBox.Items.Count - 1
then
begin
if AChange
then
ItemIndex := ItemIndex + 1
else
FListBox.ItemIndex := FListBox.ItemIndex + 1;
end;
end;
procedure TspSkinCustomComboBox.EditUp;
begin
if FListBox.ItemIndex > 0
then
begin
FListBox.ItemIndex := FListBox.ItemIndex - 1;
if AChange
then
begin
Text := FListBox.Items[FListBox.ItemIndex];
if Assigned(FOnClick) then FOnClick(Self);
end;
end;
end;
procedure TspSkinCustomComboBox.EditDown;
begin
if FListBox.ItemIndex < FListBox.Items.Count - 1
then
begin
FListBox.ItemIndex := FListBox.ItemIndex + 1;
if AChange
then
begin
Text := FListBox.Items[FListBox.ItemIndex];
if Assigned(FOnClick) then FOnClick(Self);
end;
end;
end;
procedure TspSkinCustomComboBox.EditChange(Sender: TObject);
begin
FromEdit := True;
Text := FEdit.Text;
FromEdit := False;
end;
procedure TspSkinCustomComboBox.ShowEditor;
begin
FEdit := TspCustomEdit.Create(Self);
FEdit.Parent := Self;
FEdit.AutoSize := False;
FEdit.Visible := True;
FEdit.EditTransparent := False;
FEditWindowProc := FEdit.WindowProc;
FEdit.WindowProc := EditWindowProcHook;
FEdit.OnEditCancelMode := EditCancelMode;
FEdit.OnChange := EditChange;
//
if FIndex <> -1
then
with FEdit.Font do
begin
Style := FontStyle;
Color := FontColor;
Height := FontHeight;
Name := FontName;
end
else
with FEdit.Font do
begin
Name := Self.Font.Name;
Style := Self.Font.Style;
Color := Self.Font.Color;
Height := Self.Font.Height;
end;
if FIndex <> -1
then FEdit.EditTransparent := True
else FEdit.EditTransparent := False;
//
CalcRects;
end;
procedure TspSkinCustomComboBox.HideEditor;
begin
FEdit.Visible := False;
FEdit.Free;
FEdit := nil;
end;
procedure TspSkinCustomComboBox.CMTextChanged;
begin
inherited;
if (FEdit <> nil) and not FromEdit then FEdit.Text := Text;
if Assigned(FOnChange) then FOnChange(Self);
if FromEdit then Change;
end;
procedure TspSkinCustomComboBox.WMSIZE;
begin
inherited;
CalcRects;
end;
procedure TspSkinCustomComboBox.DrawDefaultItem;
var
Buffer: TBitMap;
R, R1: TRect;
Index, IIndex, IX, IY: Integer;
begin
if RectWidth(CBItem.R) <=0 then Exit;
Buffer := TBitMap.Create;
Buffer.Width := RectWidth(CBItem.R);
Buffer.Height := RectHeight(CBItem.R);
R := Rect(0, 0, Buffer.Width, Buffer.Height);
with Buffer.Canvas do
begin
Font.Name := Self.Font.Name;
Font.Style := Self.Font.Style;
Font.Height := Self.Font.Height;
if Focused
then
begin
Brush.Color := clHighLight;
Font.Color := clHighLightText;
end
else
begin
Brush.Color := clWindow;
Font.Color := clWindowText;
end;
FillRect(R);
end;
if FListBox.Visible
then Index := FOldItemIndex
else Index := FListBox.ItemIndex;
CBItem.State := [];
if Focused then CBItem.State := [odFocused];
R1 := Rect(R.Left + 2, R.Top, R.Right - 2, R.Bottom);
if (Index > -1) and (Index < FListBox.Items.Count)
then
if Assigned(FOnComboBoxDrawItem)
then
FOnComboBoxDrawItem(Buffer.Canvas, Index, Buffer.Width, Buffer.Height,
R1, CBItem.State)
else
begin
if Images <> nil
then
begin
if ImageIndex > -1
then IIndex := ImageIndex
else IIndex := Index;
if IIndex < Images.Count
then
begin
IX := R1.Left;
IY := R1.Top + RectHeight(R1) div 2 - Images.Height div 2;
Images.Draw(Buffer.Canvas, IX, IY, IIndex);
end;
Inc(R1.Left, Images.Width + 2);
end;
SPDrawText(Buffer.Canvas, FListBox.Items[Index], R1);
end;
if Focused then DrawFocusRect(Buffer.Canvas.Handle, R);
Cnvs.Draw(CBItem.R.Left, CBItem.R.Top, Buffer);
Buffer.Free;
end;
procedure TspSkinCustomComboBox.DrawSkinItem;
var
Buffer: TBitMap;
R, R2: TRect;
W, H: Integer;
Index, IIndex, IX, IY: Integer;
begin
W := RectWidth(CBItem.R);
if W <= 0 then Exit;
H := RectHeight(SItemRect);
if H = 0 then H := RectHeight(FocusItemRect);
if H = 0 then H := RectWidth(CBItem.R);
Buffer := TBitMap.Create;
if Focused
then
begin
if not IsNullRect(FocusItemRect)
then
CreateHSkinImage(ItemLeftOffset, ItemRightOffset, Buffer, Picture,
FocusItemRect, W, H)
else
begin
Buffer.Width := W;
BUffer.Height := H;
Buffer.Canvas.CopyRect(Rect(0, 0, W, H), Cnvs, CBItem.R);
end;
end
else
begin
if not IsNullRect(SItemRect)
then
CreateHSkinImage(ItemLeftOffset, ItemRightOffset, Buffer, Picture,
SItemRect, W, H)
else
begin
Buffer.Width := W;
BUffer.Height := H;
Buffer.Canvas.CopyRect(Rect(0, 0, W, H), Cnvs, CBItem.R);
end;
end;
R := ItemTextRect;
if not IsNullRect(SItemRect)
then
Inc(R.Right, W - RectWidth(SItemRect))
else
Inc(R.Right, W - RectWidth(ClRect));
with Buffer.Canvas do
begin
if FUseSkinFont
then
begin
Font.Name := FontName;
Font.Style := FontStyle;
Font.Height := FontHeight;
Font.CharSet := FDefaultFont.CharSet;
end
else
Font.Assign(FDefaultFont);
if Focused
then
Font.Color := FocusFontColor
else
Font.Color := FontColor;
Brush.Style := bsClear;
end;
if FListBox.Visible
then Index := FOldItemIndex
else Index := FListBox.ItemIndex;
if (Index > -1) and (Index < FListBox.Items.Count)
then
if Assigned(FOnComboBoxDrawItem)
then
FOnComboBoxDrawItem(Buffer.Canvas, Index, Buffer.Width, Buffer.Height,
R, CBItem.State)
else
begin
if Images <> nil
then
begin
if ImageIndex > -1
then IIndex := ImageIndex
else IIndex := Index;
if IIndex < Images.Count
then
begin
IX := R.Left;
IY := R.Top + RectHeight(R) div 2 - Images.Height div 2;
Images.Draw(Buffer.Canvas, IX, IY, IIndex);
end;
Inc(R.Left, Images.Width + 2);
end;
SPDrawText(Buffer.Canvas, FListBox.Items[Index], R);
end;
Cnvs.Draw(CBItem.R.Left, CBItem.R.Top, Buffer);
Buffer.Free;
end;
procedure TspSkinCustomComboBox.DrawButton;
var
ArrowColor: TColor;
R1: TRect;
begin
if FIndex = -1
then
with Button do
begin
R1 := R;
if Down and MouseIn
then
begin
Frame3D(C, R1, SP_XP_BTNFRAMECOLOR, SP_XP_BTNFRAMECOLOR, 1);
C.Brush.Color := SP_XP_BTNDOWNCOLOR;
C.FillRect(R1);
end
else
if MouseIn
then
begin
Frame3D(C, R1, SP_XP_BTNFRAMECOLOR, SP_XP_BTNFRAMECOLOR, 1);
C.Brush.Color := SP_XP_BTNACTIVECOLOR;
C.FillRect(R1);
end
else
begin
Frame3D(C, R1, clBtnShadow, clBtnShadow, 1);
C.Brush.Color := clBtnFace;
C.FillRect(R1);
end;
if Enabled
then
ArrowColor := clBlack
else
ArrowColor := clBtnShadow;
DrawArrowImage(C, R, ArrowColor, 4);
end
else
with Button do
begin
R1 := NullRect;
if not Enabled and not IsNullRect(UnEnabledButtonRect)
then
R1 := UnEnabledButtonRect
else
if Down and MouseIn
then R1 := DownButtonRect
else if MouseIn then R1 := ActiveButtonRect;
if not IsNullRect(R1)
then
C.CopyRect(R, Picture.Canvas, R1);
end;
end;
procedure TspSkinCustomComboBox.CalcRects;
const
BW = 17;
var
OX: Integer;
begin
if FIndex = -1
then
begin
Button.R := Rect(Width - BW - 2, 2, Width - 2, Height - 2);
CBItem.R := Rect(2, 2, Button.R.Left - 1 , Height - 2);
end
else
begin
OX := Width - RectWidth(SkinRect);
Button.R := ButtonRect;
if ButtonRect.Left >= RectWidth(SkinRect) - RTPt.X
then
OffsetRect(Button.R, OX, 0);
CBItem.R := ClRect;
Inc(CBItem.R.Right, OX);
end;
if FEdit <> nil
then
begin
FEdit.Left := CBItem.R.Left;
FEdit.Top := CBItem.R.Top;
FEdit.Width := RectWidth(CBItem.R);
FEdit.Height := RectHeight(CBItem.R);
end;
end;
procedure TspSkinCustomComboBox.ChangeSkinData;
begin
inherited;
CalcRects;
if FEdit <> nil
then
begin
if FIndex <> -1
then
with FEdit.Font do
begin
Style := FontStyle;
Color := FontColor;
Height := FontHeight;
Name := FontName;
CharSet := FDefaultFont.CharSet;
end
else
FEdit.Font.Assign(FDefaultFont);
if FIndex <> -1
then FEdit.EditTransparent := True
else FEdit.EditTransparent := False;
end;
RePaint;
if FIndex = -1
then
begin
FListBox.SkinDataName := '';
end
else
FListBox.SkinDataName := ListBoxName;
FListBox.SkinData := SkinData;
//
end;
procedure TspSkinCustomComboBox.CreateControlDefaultImage;
var
R: TRect;
begin
with B.Canvas do
begin
Brush.Color := clBtnFace;
R := ClientRect;
FillRect(R);
end;
Frame3D(B.Canvas, R, clbtnShadow, clbtnShadow, 1);
DrawButton(B.Canvas);
if FEdit = nil then DrawDefaultItem(B.Canvas);
end;
procedure TspSkinCustomComboBox.CreateControlSkinImage;
begin
inherited;
DrawButton(B.Canvas);
if FEdit = nil then DrawSkinItem(B.Canvas);
end;
// ==================== TspSkinFontComboBox ======================= //
const
WRITABLE_FONTTYPE = 256;
function IsValidFont(Box: TspSkinFontComboBox; LogFont: TLogFont;
FontType: Integer): Boolean;
begin
Result := True;
if (foAnsiOnly in Box.Options) then
Result := Result and (LogFont.lfCharSet = ANSI_CHARSET);
if (foTrueTypeOnly in Box.Options) then
Result := Result and (FontType and TRUETYPE_FONTTYPE = TRUETYPE_FONTTYPE);
if (foFixedPitchOnly in Box.Options) then
Result := Result and (LogFont.lfPitchAndFamily and FIXED_PITCH = FIXED_PITCH);
if (foOEMFontsOnly in Box.Options) then
Result := Result and (LogFont.lfCharSet = OEM_CHARSET);
if (foNoOEMFonts in Box.Options) then
Result := Result and (LogFont.lfCharSet <> OEM_CHARSET);
if (foNoSymbolFonts in Box.Options) then
Result := Result and (LogFont.lfCharSet <> SYMBOL_CHARSET);
if (foScalableOnly in Box.Options) then
Result := Result and (FontType and RASTER_FONTTYPE = 0);
end;
function EnumFontsProc(var EnumLogFont: TEnumLogFont;
var TextMetric: TNewTextMetric; FontType: Integer; Data: LPARAM): Integer;
export; stdcall;
var
FaceName: string;
begin
FaceName := StrPas(EnumLogFont.elfLogFont.lfFaceName);
with TspSkinFontComboBox(Data) do
if (Items.IndexOf(FaceName) < 0) and
IsValidFont(TspSkinFontComboBox(Data), EnumLogFont.elfLogFont, FontType) then
begin
if EnumLogFont.elfLogFont.lfCharSet <> SYMBOL_CHARSET then
FontType := FontType or WRITABLE_FONTTYPE;
Items.AddObject(FaceName, TObject(FontType));
end;
Result := 1;
end;
constructor TspSkinFontComboBox.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
OnListBoxDrawItem := DrawLBFontItem;
OnComboBoxDrawItem := DrawCBFontItem;
FDevice := fdScreen;
Sorted := True;
end;
procedure TspSkinFontComboBox.DrawTT;
begin
with Cnvs do
begin
Pen.Color := C;
MoveTo(X, Y);
LineTo(X + 7, Y);
LineTo(X + 7, Y + 3);
MoveTo(X, Y);
LineTo(X, Y + 3);
MoveTo(X + 1, Y);
LineTo(X + 1, Y + 1);
MoveTo(X + 6, Y);
LineTo(X + 6, Y + 1);
MoveTo(X + 3, Y);
LineTo(X + 3, Y + 8);
MoveTo(X + 4, Y);
LineTo(X + 4, Y + 8);
MoveTo(X + 2, Y + 8);
LineTo(X + 6, Y + 8);
end;
end;
procedure TspSkinFontComboBox.Reset;
var
SaveName: TFontName;
begin
if HandleAllocated then begin
FUpdate := True;
try
SaveName := FontName;
PopulateList;
FontName := SaveName;
finally
FUpdate := False;
if FontName <> SaveName
then
begin
if not (csReading in ComponentState) then
if not FUpdate and Assigned(FOnChange) then FOnChange(Self);
end;
end;
end;
end;
procedure TspSkinFontComboBox.WMFontChange(var Message: TMessage);
begin
inherited;
Reset;
end;
procedure TspSkinFontComboBox.SetFontName(const NewFontName: TFontName);
var
Item: Integer;
begin
if FontName <> NewFontName then begin
if not (csLoading in ComponentState) then begin
HandleNeeded;
{ change selected item }
for Item := 0 to Items.Count - 1 do
if AnsiCompareText(Items[Item], NewFontName) = 0 then begin
ItemIndex := Item;
//
if not (csReading in ComponentState) then
if not FUpdate and Assigned(FOnChange) then FOnChange(Self);
//
Exit;
end;
if Style = spcbFixedStyle then ItemIndex := -1
else Text := NewFontName;
end
else inherited Text := NewFontName;
//
if not (csReading in ComponentState) then
if not FUpdate and Assigned(FOnChange) then FOnChange(Self);
//
end;
end;
function TspSkinFontComboBox.GetFontName: TFontName;
begin
Result := inherited Text;
end;
function TspSkinFontComboBox.GetTrueTypeOnly: Boolean;
begin
Result := foTrueTypeOnly in FOptions;
end;
procedure TspSkinFontComboBox.SetOptions;
begin
if Value <> Options then begin
FOptions := Value;
Reset;
end;
end;
procedure TspSkinFontComboBox.SetTrueTypeOnly(Value: Boolean);
begin
if Value <> TrueTypeOnly then begin
if Value then FOptions := FOptions + [foTrueTypeOnly]
else FOptions := FOptions - [foTrueTypeOnly];
Reset;
end;
end;
procedure TspSkinFontComboBox.SetDevice;
begin
if Value <> FDevice then begin
FDevice := Value;
Reset;
end;
end;
procedure TspSkinFontComboBox.SetUseFonts(Value: Boolean);
begin
if Value <> FUseFonts then begin
FUseFonts := Value;
Invalidate;
end;
end;
procedure TspSkinFontComboBox.DrawCBFontItem;
var
FName: array[0..255] of Char;
R: TRect;
begin
R := TextRect;
R.Left := R.Left + 2;
with Cnvs do
begin
StrPCopy(FName, Items[Index]);
SPDrawText(Cnvs, FName, R);
end;
end;
procedure TspSkinFontComboBox.DrawLBFontItem;
var
FName: array[0..255] of Char;
R: TRect;
X, Y: Integer;
begin
R := TextRect;
if (Integer(Items.Objects[Index]) and TRUETYPE_FONTTYPE) <> 0
then
begin
X := TextRect.Left;
Y := TextRect.Top + RectHeight(TextRect) div 2 - 7;
DrawTT(Cnvs, X, Y, clGray);
DrawTT(Cnvs, X + 4, Y + 4, clBlack);
end;
Inc(R.Left, 15);
with Cnvs do
begin
Font.Name := Items[Index];
Font.Style := [];
StrPCopy(FName, Items[Index]);
SPDrawText(Cnvs, Items[Index], R);
end;
end;
procedure TspSkinFontComboBox.PopulateList;
var
DC: HDC;
Proc: TFarProc;
FOldItemIndex: Integer;
begin
if not HandleAllocated then Exit;
FOldItemIndex := ItemIndex;
Items.BeginUpdate;
try
Items.Clear;
DC := GetDC(0);
try
if (FDevice = fdScreen) or (FDevice = fdBoth) then
EnumFontFamilies(DC, nil, @EnumFontsProc, Longint(Self));
if (FDevice = fdPrinter) or (FDevice = fdBoth) then
try
EnumFontFamilies(Printer.Handle, nil, @EnumFontsProc, Longint(Self));
except
{ skip any errors }
end;
finally
ReleaseDC(0, DC);
end;
finally
Items.EndUpdate;
end;
ItemIndex := FOldItemIndex;
end;
procedure TspSkinFontComboBox.CreateWnd;
var
OldFont: TFontName;
begin
OldFont := FontName;
inherited CreateWnd;
FUpdate := True;
try
PopulateList;
inherited Text := '';
SetFontName(OldFont);
finally
FUpdate := False;
end;
// if AnsiCompareText(FontName, OldFont) <> 0 then DoChange;
end;
// ==================== TspSkinColorComboBox ======================= //
const
SColorBoxCustomCaption = 'Custom...';
NoColorSelected = TColor($FF000000);
StandardColorsCount = 16;
ExtendedColorsCount = 4;
constructor TspSkinColorComboBox.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Style := spcbFixedStyle;
FExStyle := [spcbStandardColors, spcbExtendedColors, spcbSystemColors];
FSelectedColor := clBlack;
FDefaultColorColor := clBlack;
FNoneColorColor := clBlack;
OnListBoxDrawItem := DrawColorItem;
OnComboBoxDrawItem := DrawColorItem;
OnCloseUp := OnLBCloseUp;
FShowNames := True;
end;
procedure TspSkinColorComboBox.SetShowNames(Value: Boolean);
begin
FShowNames := Value;
RePaint;
end;
procedure TspSkinColorComboBox.DrawColorItem;
var
R: TRect;
MarkerRect: TRect;
begin
if FShowNames
then
MarkerRect := Rect(TextRect.Left + 1, TextRect.Top + 1,
TextRect.Left + RectHeight(TextRect) - 1, TextRect.Bottom - 1)
else
MarkerRect := Rect(TextRect.Left + 1, TextRect.Top + 1,
TextRect.Right - 1, TextRect.Bottom - 1);
with Cnvs do
begin
Brush.Style := bsSolid;
Brush.Color := Colors[Index];
FillRect(MarkerRect);
Brush.Style := bsClear;
end;