Delphi控件源码

开发平台：

Delphi

bsSkinBoxCtrls.pas：源码内容

procedure TbsCustomEdit.DoCut;
begin
CutToClipboard;
end;
procedure TbsCustomEdit.DoCopy;
begin
CopyToClipboard;
end;
procedure TbsCustomEdit.DoPaste;
begin
PasteFromClipboard;
end;
procedure TbsCustomEdit.DoDelete;
begin
ClearSelection;
end;
procedure TbsCustomEdit.DoSelectAll;
begin
SelectAll;
end;
procedure TbsCustomEdit.CreateSysPopupMenu;
function FindBSFComponent(AForm: TForm): TbsBusinessSkinForm;
var
i: Integer;
begin
Result := nil;
for i := 0 to AForm.ComponentCount - 1 do
if AForm.Components[i] is TbsBusinessSkinForm
then
begin
Result := TbsBusinessSkinForm(AForm.Components[i]);
Break;
end;
end;
function GetResourceStrData: TbsResourceStrData;
var
BSF: TbsBusinessSkinForm;
begin
BSF := FindBSFComponent(TForm(GetParentForm(Self)));
if (BSF <> nil) and (BSF.SkinData <> nil) and (BSF.SkinData.ResourceStrData <> nil)
then
Result := BSF.SkinData.ResourceStrData
else
Result := nil;
end;
function IsSelected: Boolean;
var
i, j: Integer;
begin
GetSel(i, j);
Result := (i < j);
end;
function IsFullSelected: Boolean;
var
i, j: Integer;
begin
GetSel(i, j);
Result := (i = 0) and (j = Length(Text));
end;
var
Item: TMenuItem;
ResStrData: TbsResourceStrData;
begin
if FSysPopupMenu <> nil then FSysPopupMenu.Free;
FSysPopupMenu := TbsSkinPopupMenu.Create(Self);
FSysPopupMenu.ComponentForm := TForm(GetParentForm(Self));
ResStrData := GetResourceStrData;
Item := TMenuItem.Create(FSysPopupMenu);
with Item do
begin
if ResStrData <> nil
then
Caption := ResStrData.GetResStr('EDIT_UNDO')
else
Caption := BS_Edit_Undo;
OnClick := DoUndo;
Enabled := Self.CanUndo;
end;
FSysPopupMenu.Items.Add(Item);
Item := TMenuItem.Create(FSysPopupMenu);
Item.Caption := '-';
FSysPopupMenu.Items.Add(Item);
Item := TMenuItem.Create(FSysPopupMenu);
with Item do
begin
if ResStrData <> nil
then
Caption := ResStrData.GetResStr('EDIT_CUT')
else
Caption := BS_Edit_Cut;
Enabled := IsSelected and not Self.ReadOnly;
OnClick := DoCut;
end;
FSysPopupMenu.Items.Add(Item);
Item := TMenuItem.Create(FSysPopupMenu);
with Item do
begin
if ResStrData <> nil
then
Caption := ResStrData.GetResStr('EDIT_COPY')
else
Caption := BS_Edit_Copy;
Enabled := IsSelected;
OnClick := DoCopy;
end;
FSysPopupMenu.Items.Add(Item);
Item := TMenuItem.Create(FSysPopupMenu);
with Item do
begin
if ResStrData <> nil
then
Caption := ResStrData.GetResStr('EDIT_PASTE')
else
Caption := BS_Edit_Paste;
Enabled := (ClipBoard.AsText <> '') and not ReadOnly;
OnClick := DoPaste;
end;
FSysPopupMenu.Items.Add(Item);
Item := TMenuItem.Create(FSysPopupMenu);
with Item do
begin
if ResStrData <> nil
then
Caption := ResStrData.GetResStr('EDIT_DELETE')
else
Caption := BS_Edit_Delete;
Enabled := IsSelected and not Self.ReadOnly;
OnClick := DoDelete;
end;
FSysPopupMenu.Items.Add(Item);
Item := TMenuItem.Create(FSysPopupMenu);
Item.Caption := '-';
FSysPopupMenu.Items.Add(Item);
Item := TMenuItem.Create(FSysPopupMenu);
with Item do
begin
if ResStrData <> nil
then
Caption := ResStrData.GetResStr('EDIT_SELECTALL')
else
Caption := BS_Edit_SelectAll;
Enabled := not IsFullSelected;
OnClick := DoSelectAll;
end;
FSysPopupMenu.Items.Add(Item);
end;
procedure TbsCustomEdit.CMCancelMode;
begin
inherited;
if Assigned(FOnEditCancelMode)
then FOnEditCancelMode(Message.Sender);
end;
procedure TbsCustomEdit.SetEditTransparent(Value: Boolean);
begin
FEditTransparent := Value;
ReCreateWnd;
end;
procedure TbsCustomEdit.WMSetFont;
begin
inherited;
SendMessage(Handle, EM_SETMARGINS, EC_LEFTMARGIN or EC_RIGHTMARGIN, MakeLong(2, 0));
end;
procedure TbsCustomEdit.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
with Params do
begin
Style := Style and not WS_BORDER;
ExStyle := ExStyle and not WS_EX_CLIENTEDGE;
if FEditTransparent then ExStyle := ExStyle or WS_EX_TRANSPARENT;
if PasswordChar <> #0
then
Style := Style or ES_PASSWORD and not ES_MULTILINE
else
Style := Style or ES_MULTILINE;
end;
end;
procedure TbsCustomEdit.WMCHAR;
var
Key: Char;
Key1: Word;
begin
if Message.CharCode in [VK_ESCAPE]
then
begin
Key1 := Message.CharCode;
if Assigned(OnKeyDown) then OnKeyDown(Self, Key1, []);
Key := #27;
if Assigned(OnKeyPress) then OnKeyPress(Self, Key);
end;
if Message.CharCode in [VK_RETURN]
then
begin
Key := #13;
if Assigned(OnKeyPress) then OnKeyPress(Self, Key);
end
else
if not ReadOnly then inherited;
end;
procedure TbsCustomEdit.CNCtlColorStatic;
begin
if FEditTransparent
then
begin
with Message do
begin
SetBkMode(ChildDC, Windows.Transparent);
SetTextColor(ChildDC, Font.Color);
Result := GetStockObject(NULL_BRUSH);
end
end
else
inherited;
end;
procedure TbsCustomEdit.CNCTLCOLOREDIT(var Message:TWMCTLCOLOREDIT);
begin
if FEditTransparent
then
begin
with Message do
begin
SetBkMode(ChildDC, Windows.Transparent);
SetTextColor(ChildDC, Font.Color);
Result := GetStockObject(NULL_BRUSH);
end
end
else
inherited;
end;
procedure TbsCustomEdit.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
if FEditTransparent then Invalidate else inherited;
end;
procedure TbsCustomEdit.Invalidate;
var
R: TRect;
begin
if FEditTransparent
then
begin
if Parent = nil then Exit;
R := ClientRect;
R.TopLeft := Parent.ScreenToClient(ClientToScreen(R.TopLeft));
R.BottomRight := Parent.ScreenToClient(ClientToScreen(R.BottomRight));
InvalidateRect(Parent.Handle, @R, True);
RedrawWindow(Handle, nil, 0, RDW_FRAME + RDW_INVALIDATE);
end
else
inherited;
end;
procedure TbsCustomEdit.Change;
begin
inherited;
if FEditTransparent then Invalidate;
end;
procedure TbsCustomEdit.WMKeyDown(var Message: TWMKeyDown);
begin
if FReadOnly and (Message.CharCode = VK_DELETE) then Exit;
inherited;
if FEditTransparent then Invalidate;
end;
procedure TbsCustomEdit.WMKeyUp;
begin
inherited;
end;
procedure TbsCustomEdit.WMSetText(var Message:TWMSetText);
begin
inherited;
if FEditTransparent then Invalidate;
end;
procedure TbsCustomEdit.WMMove(var Message: TMessage);
begin
inherited;
if FEditTransparent then Invalidate;
end;
procedure TbsCustomEdit.WMCut(var Message: TMessage);
begin
if FReadOnly then Exit;
inherited;
if FEditTransparent then Invalidate;
end;
procedure TbsCustomEdit.WMPaste(var Message: TMessage);
begin
if FReadOnly then Exit;
inherited;
if FEditTransparent then Invalidate;
end;
procedure TbsCustomEdit.WMClear(var Message: TMessage);
begin
if FReadOnly then Exit;
inherited;
if FEditTransparent then Invalidate;
end;
procedure TbsCustomEdit.WMUndo(var Message: TMessage);
begin
if FReadOnly then Exit;
inherited;
if FEditTransparent then Invalidate;
end;
procedure TbsCustomEdit.WMCONTEXTMENU;
var
X, Y: Integer;
P: TPoint;
begin
if PopupMenu <> nil
then
inherited
else
begin
CreateSysPopupMenu;
X := Message.XPos;
Y := Message.YPos;
if (X < 0) or (Y < 0)
then
begin
X := Width div 2;
Y := Height div 2;
P := Point(0, 0);
P := ClientToScreen(P);
X := X + P.X;
Y := Y + P.Y;
end;
if FSysPopupMenu <> nil
then
FSysPopupMenu.Popup2(Self, X, Y)
end;
end;
procedure TbsCustomEdit.WMLButtonDown(var Message: TMessage);
begin
inherited;
FDown := True;
if FEditTransparent then Invalidate;
end;
procedure TbsCustomEdit.WMSETFOCUS;
begin
inherited;
if FEditTransparent then Invalidate;
if AutoSelect then SelectAll;
end;
procedure TbsCustomEdit.WMKILLFOCUS;
begin
inherited;
if FEditTransparent then Invalidate;
end;
procedure TbsCustomEdit.WMMOUSEMOVE;
begin
inherited;
if FDown and EditTransparent then Invalidate;
end;
procedure TbsCustomEdit.WMLButtonUp;
begin
inherited;
FDown := False;
end;
constructor TbsSkinNumEdit.Create(AOwner: TComponent);
begin
inherited;
FEditorEnabled := True;
end;
procedure TbsSkinNumEdit.CMMouseEnter;
begin
inherited;
if Assigned(FOnMouseEnter) then FOnMouseEnter(Self);
end;
procedure TbsSkinNumEdit.CMMouseLeave;
begin
inherited;
if Assigned(FOnMouseLeave) then FOnMouseLeave(Self);
end;
procedure TbsSkinNumEdit.WMMOUSEWHEEL;
begin
if Message.WParam > 0
then
begin
if Assigned(FOnDownClick) then FOnDownClick(Self);
end
else
begin
if Assigned(FOnUpClick) then FOnUpClick(Self);
end;
end;
procedure TbsSkinNumEdit.KeyDown(var Key: Word; Shift: TShiftState);
begin
if Key = VK_UP
then
begin
if Assigned(FOnUpClick) then FOnUpClick(Self);
end
else
if Key = VK_DOWN
then
begin
if Assigned(FOnDownClick) then FOnDownClick(Self);
end
else
inherited KeyDown(Key, Shift);
end;
procedure TbsSkinNumEdit.KeyPress(var Key: Char);
begin
if not IsValidChar(Key) then
begin
Key := #0;
MessageBeep(0)
end;
if Key <> #0 then inherited KeyPress(Key);
end;
function TbsSkinNumEdit.IsValidChar(Key: Char): Boolean;
begin
if FLoat
then
Result := (Key in [DecimalSeparator, '-', '0'..'9']) or
((Key < #32) and (Key <> Chr(VK_RETURN)))
else
Result := (Key in ['-', '0'..'9']) or
((Key < #32) and (Key <> Chr(VK_RETURN)));
if not FEditorEnabled and Result and ((Key >= #32) or
(Key = Char(VK_BACK)) or (Key = Char(VK_DELETE)))
then
Result := False;
if (Key = DecimalSeparator) and (Pos(DecimalSeparator, Text) <> 0)
then
Result := False
else
if (Key = '-') and (Pos('-', Text) <> 0)
then
Result := False;
end;
const
HTEDITBUTTON = HTSIZE + 2;
HTEDITFRAME = HTSIZE + 3;
constructor TbsSkinCustomEdit.Create;
begin
inherited Create(AOwner);
ControlStyle := ControlStyle + [csOpaque];
AutoSize := False;
FIndex := -1;
Font.Name := 'Arial';
Font.Color := clWindowText;
Font.Style := [];
Font.Height := 14;
Height := 20;
BorderStyle := bsNone;
Picture := nil;
EditTransparent := True;
FSkinDataName := 'edit';
FDefaultFont := TFont.Create;
FDefaultFont.OnChange := OnDefaultFontChange;
FDefaultFont.Assign(Font);
FDefaultWidth := 0;
FDefaultHeight := 20;
FUseSkinFont := True;
end;
destructor TbsSkinCustomEdit.Destroy;
begin
FDefaultFont.Free;
inherited;
end;
procedure TbsSkinCustomEdit.Loaded;
begin
inherited;
if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
then
Font.Charset := SkinData.ResourceStrData.CharSet;
end;
procedure TbsSkinCustomEdit.CMEnabledChanged;
begin
inherited;
if Enabled
then
begin
if FIndex = -1
then Font.Color := FDefaultFont.Color
else Font.Color := FontColor;
end
else
begin
if FIndex = -1
then Font.Color := clGrayText
else Font.Color := DisabledFontColor;
end;
Invalidate;
end;
procedure TbsSkinCustomEdit.SetAlignment(Value: TAlignment);
begin
if FAlignment <> Value then
begin
FAlignment := Value;
RecreateWnd;
end;
end;
procedure TbsSkinCustomEdit.SetDefaultWidth;
begin
FDefaultWidth := Value;
if (FIndex = -1) and (FDefaultWidth > 0) then Width := FDefaultWidth;
end;
procedure TbsSkinCustomEdit.SetDefaultHeight;
begin
FDefaultHeight := Value;
if (FIndex = -1) and (FDefaultHeight > 0) then Height := FDefaultHeight;
end;
procedure TbsSkinCustomEdit.SetDefaultFont;
begin
FDefaultFont.Assign(Value);
if FIndex = -1 then Font.Assign(Value);
end;
procedure TbsSkinCustomEdit.OnDefaultFontChange(Sender: TObject);
begin
if FIndex = -1 then Font.Assign(FDefaultFont);
end;
procedure TbsSkinCustomEdit.CalcRects;
var
Off: Integer;
begin
if FIndex = -1
then
begin
if FButtonMode
then
begin
FButtonRect := Rect(Width - Height, 0, Width, Height);
FEditRect := Rect(2, 2, FButtonRect.Left - 2, Height - 2);
end
else
FEditRect := Rect(2, 2, Width - 2, Height - 2);
end
else
begin
Off := Width - RectWidth(SkinRect);
FEditRect := ClRect;
Inc(FEditRect.Right, Off);
FButtonRect := ButtonRect;
if ButtonRect.Left >= RectWidth(SkinRect) - ROffset
then OffsetRect(FButtonRect, Off, 0);
end;
end;
procedure TbsSkinCustomEdit.WMMOUSEMOVE;
begin
inherited;
if FButtonMode and FButtonActive
then
begin
FButtonActive := False;
Invalidate;
end;
end;
procedure TbsSkinCustomEdit.WMNCHITTEST;
var
P: TPoint;
BR: TRect;
ER: TRect;
begin
if FButtonMode and not (csDesigning in ComponentState)
then
begin
P.X := Message.XPos;
P.Y := Message.YPos;
P := ScreenToClient(P);
if FIndex = -1
then
begin
Inc(P.X, 2);
Inc(P.Y, 2);
end
else
begin
Inc(P.X, ClRect.Left);
Inc(P.Y, ClRect.Top);
end;
CalcRects;
BR := FButtonRect;
ER := FEditRect;
if PtInRect(BR, P)
then
Message.Result := HTEDITBUTTON
else
if not PtInRect(ER, P)
then
Message.Result := HTEDITFRAME
else
inherited;
end
else
inherited;
end;
procedure TbsSkinCustomEdit.WMNCLBUTTONDBCLK;
begin
if FButtonMode and (Message.HitTest = HTEDITBUTTON) and
not (csDesigning in ComponentState)
then
begin
FButtonDown := True;
Invalidate;
end
else
inherited;
end;
procedure TbsSkinCustomEdit.WMNCLBUTTONDOWN;
begin
if FButtonMode and (Message.HitTest = HTEDITBUTTON) and
not (csDesigning in ComponentState)
then
begin
FButtonDown := True;
Invalidate;
end
else
inherited;
end;
procedure TbsSkinCustomEdit.WMNCLBUTTONUP;
begin
if FButtonMode and (Message.HitTest = HTEDITBUTTON) and
not (csDesigning in ComponentState)
then
begin
FButtonDown := False;
Invalidate;
if not Focused then SetFocus;
if Assigned(FOnButtonClick) then FOnButtonClick(Self);
end
else
inherited;
end;
procedure TbsSkinCustomEdit.WMNCMOUSEMOVE;
begin
if FButtonMode and not (csDesigning in ComponentState)
then
begin
if Message.HitTest = HTEDITBUTTON
then
begin
if not FButtonActive
then
begin
FButtonActive := True;
Invalidate;
end
end
else
begin
if FButtonActive
then
begin
FButtonActive := False;
Invalidate;
end;
inherited;
end
end
else
inherited;
end;
procedure TbsSkinCustomEdit.SetButtonMode;
begin
FButtonMode := Value;
ReCreateWnd;
if (csDesigning in ComponentState) and not
(csLoading in ComponentState)
then
begin
if FButtonMode
then FSkinDataName := 'buttonedit'
else FSkinDataName := 'edit';
end;
end;
procedure TbsSkinCustomEdit.Invalidate;
begin
if Parent = nil then Exit;
RedrawWindow(Handle, nil, 0, RDW_FRAME + RDW_INVALIDATE);
end;
procedure TbsSkinCustomEdit.WMSETFOCUS;
begin
inherited;
if not FMouseIn and (FIndex <> -1) then Font.Color := ActiveFontColor;
end;
procedure TbsSkinCustomEdit.WMKILLFOCUS;
begin
inherited;
if not FMouseIn and (FIndex <> -1) then Font.Color := FontColor;
end;
procedure TbsSkinCustomEdit.CMMouseEnter;
begin
inherited;
FMouseIn := True;
if not Focused and (FIndex <> -1)
then
begin
Font.Color := ActiveFontColor;
Invalidate;
end;
if Assigned(FOnMouseEnter) then FOnMouseEnter(Self);
end;
procedure TbsSkinCustomEdit.CMMouseLeave;
begin
inherited;
FMouseIn := False;
if not Focused and (FIndex <> -1)
then
begin
Font.Color := FontColor;
Invalidate;
end;
if FButtonDown or FButtonActive
then
begin
FButtonActive := False;
FButtonDown := False;
Invalidate;
end;
if Assigned(FOnMouseLeave) then FOnMouseLeave(Self);
end;
procedure TbsSkinCustomEdit.SetBounds;
var
UpDate: Boolean;
begin
GetSkinData;
UpDate := ((Width <> AWidth) or (Height <> AHeight)) and (FIndex <> -1);
if UpDate then AHeight := RectHeight(SkinRect);
inherited;
Invalidate;
end;
procedure TbsSkinCustomEdit.WMNCCALCSIZE;
begin
GetSkinData;
if FIndex = -1
then
with Message.CalcSize_Params^.rgrc[0] do
begin
Inc(Left, 2);
Inc(Top, 2);
if FButtonMode
then Dec(Right, 22)
else 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 TbsSkinCustomEdit.CreateParams(var Params: TCreateParams);
const
Alignments: array[TAlignment] of DWORD = (ES_LEFT, ES_RIGHT, ES_CENTER);
begin
inherited CreateParams(Params);
with Params do
begin
ExStyle := Exstyle and not WS_EX_Transparent;
Style := Style and not WS_BORDER or Alignments[FAlignment];
end;
end;
procedure TbsSkinCustomEdit.DrawSkinEdit;
var
R: TRect;
TX, TY, Offset: Integer;
BR: TRect;
B: TBitMap;
begin
GetSkinData;
CalcRects;
if FButtonMode then Offset := Width - FButtonRect.Left else Offset := 0;
B := TBitMap.Create;
B.Width := Width;
B.Height := Height;
try
if FIndex = -1
then
with B.Canvas do
begin
Brush.Color := clWindow;
// draw frame
R := Rect(0, 0, Width - Offset, Height);
Frame3D(B.Canvas, R, clBtnShadow, clBtnShadow, 1);
Frame3D(B.Canvas, R, clBtnFace, clBtnFace, 1);
// draw button
if FButtonMode
then
begin
CalcRects;
R := FButtonRect;
if FButtonDown and FButtonActive
then
begin
Frame3D(B.Canvas, R, BS_XP_BTNFRAMECOLOR, BS_XP_BTNFRAMECOLOR, 1);
Brush.Color := BS_XP_BTNDOWNCOLOR;
FillRect(R);
end
else
if FButtonActive
then
begin
Frame3D(B.Canvas, R, BS_XP_BTNFRAMECOLOR, BS_XP_BTNFRAMECOLOR, 1);
Brush.Color := BS_XP_BTNACTIVECOLOR;
FillRect(R);
end
else
begin
Frame3D(B.Canvas, R, clBtnShadow, clBtnShadow, 1);
Brush.Color := clBtnFace;
FillRect(R);
end;
end;
end
else
begin
if FMouseIn or Focused
then
CreateHSkinImage(LOffset, ROffset, B, Picture, ActiveSkinRect, Width,
RectHeight(ActiveSkinRect))
else
CreateHSkinImage(LOffset, ROffset, B, Picture, SkinRect, Width,
RectHeight(SkinRect));
// draw button
if FButtonMode
then
begin
BR := NullRect;
if not Enabled and not IsNullRect(UnEnabledButtonRect)
then
BR := UnEnabledButtonRect
else
if FButtonDown and FButtonActive
then
BR := DownButtonRect
else if FButtonActive then BR := ActiveButtonRect;
if not IsNullRect(BR) then
B.Canvas.CopyRect(FButtonRect, Picture.Canvas, BR);
end;
//
end;
// Draw text
if ADrawText
then
with B.Canvas do
begin
Brush.Style := bsClear;
if (FIndex = -1) or not FUseSkinFont
then
Font := DefaultFont
else
begin
Font.Name := FontName;
Font.Height := FontHeight;
Font.Color := FontColor;
Font.Style := FontStyle;
end;
if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
then
Font.Charset := SkinData.ResourceStrData.CharSet
else
Font.CharSet := FDefaultFont.CharSet;
TY := FEditRect.Top - 1;
TX := FEditRect.Left + 1;
case Alignment of
taCenter:
TX := TX + RectWidth(FEditRect) div 2 - TextWidth(Text) div 2;
taRightJustify:
TX := FEditRect.Right - 1 - TextWidth(Text);
end;
TextRect(FEditRect, TX, TY, Text);
end;
//
C.Draw(0, 0, B);
finally
B.Free;
end;
end;
procedure TbsSkinCustomEdit.WMNCPAINT;
var
DC: HDC;
C: TCanvas;
begin
DC := GetWindowDC(Handle);
C := TControlCanvas.Create;
C.Handle := DC;
try
DrawSkinEdit(C, False);
finally
C.Free;
ReleaseDC(Handle, DC);
end;
end;
procedure TbsSkinCustomEdit.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 TbsDataSkinControl(FSD.CtrlList.Items[FIndex]) is TbsDataSkinEditControl
then
with TbsDataSkinEditControl(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;
LOffset := LTPoint.X;
ROffset := RectWidth(SkinRect) - RTPoint.X;
Self.ClRect := ClRect;
Self.FontName := FontName;
Self.FontStyle := FontStyle;
Self.FontHeight := FontHeight;
Self.FontColor := FontColor;
Self.DisabledFontColor := DisabledFontColor;
Self.ActiveFontColor := ActiveFontColor;
Self.ButtonRect := ButtonRect;
Self.ActiveButtonRect := ActiveButtonRect;
Self.DownButtonRect := DownButtonRect;
Self.UnEnabledButtonRect := UnEnabledButtonRect;
if IsNullRect(Self.DownButtonRect)
then Self.DownButtonRect := Self.ActiveButtonRect;
end;
end;
procedure TbsSkinCustomEdit.SetSkinData;
begin
FSD := Value;
if (FSD <> nil) then
if not FSD.Empty and not (csDesigning in ComponentState)
then
ChangeSkinData;
end;
procedure TbsSkinCustomEdit.Notification;
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (AComponent = FSD) then FSD := nil;
end;
procedure TbsSkinCustomEdit.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;
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;
//
if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
then
Font.Charset := SkinData.ResourceStrData.CharSet
else
Font.CharSet := FDefaultFont.CharSet;
//
ReCreateWnd;
if Enabled
then
begin
if FIndex = -1
then
Font.Color := FDefaultFont.Color
else
if Focused
then
Font.Color := ActiveFontColor
else
Font.Color := FontColor;
end
else
begin
if FIndex = -1
then Font.Color := clGrayText
else Font.Color := DisabledFontColor;
end;
end;
constructor TbsSkinPopupMonthCalendar.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := ControlStyle + [csNoDesignVisible, csReplicatable];
end;
procedure TbsSkinPopupMonthCalendar.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
with Params do
begin
Style := WS_POPUP;
ExStyle := WS_EX_TOOLWINDOW;
WindowClass.Style := CS_SAVEBITS;
if CheckWXP then
WindowClass.Style := WindowClass.style or CS_DROPSHADOW_;
end;
end;
procedure TbsSkinPopupMonthCalendar.WMMouseActivate(var Message: TMessage);
begin
Message.Result := MA_NOACTIVATE;
end;
constructor TbsSkinDateEdit.Create(AOwner: TComponent);
begin
inherited;
EditMask := GetDateMask;
FTodayDefault := False;
ButtonMode := True;
FSkinDataName := 'buttonedit';
FMonthCalendar := TbsSkinPopupMonthCalendar.Create(Self);
FMonthCalendar.Parent := Self;
FMonthCalendar.Visible := False;
FMonthCalendar.OnNumberClick := CalendarClick;
FAlphaBlend := False;
FAlphaBlendValue := 0;
FAlphaBlendAnimation := False;
OnButtonClick := ButtonClick;
end;
destructor TbsSkinDateEdit.Destroy;
begin
FMonthCalendar.Free;
inherited;
end;
function TbsSkinDateEdit.IsDateInput: Boolean;
begin
Result := IsValidText(Text);
end;
function TbsSkinDateEdit.MyStrToDate;
var
S1: array[1..3] of String;
i, j: Integer;
M, Y, D: Word;
MPos, YPos, DPos: Word;
F: String;
begin
F := DateToStr(EncodeDate(9999, 12, 31));
YPos := 1;
MPos := 1;
Dpos := 1;
j := 1;
for i := 1 to 3 do s1[i] := '';
for i := 1 to Length(F) do
if F[i] = DateSeparator then inc(j) else s1[j] := s1[j] + F[i];
for i := 1 to 3 do
begin
if not IsOnlyNumbers(s1[i])
then
MPos := i
else
begin
j := StrToInt(s1[i]);
case j of
31: DPos := i;
9999: YPos := i;
99: YPos := i;
end;
end;
end;
j := 1;
for i := 1 to 3 do s1[i] := '';
for i := 1 to Length(S) do
if S[i] = DateSeparator then inc(j) else s1[j] := s1[j] + S[i];
M := DecodeMonth(s1[MPos]);
D := StrToInt(s1[DPos]);
Y := StrToInt(s1[YPos]);
Result := EncodeDate(Y, M, D);
end;
function TbsSkinDateEdit.ExtactMonth;
var
F: String;
S1: array[1..3] of String;
i, j: Integer;
begin
F := DateToStr(ADate);
j := 1;
for i := 1 to 3 do s1[i] := '';
for i := 1 to Length(F) do
if F[i] = DateSeparator then inc(j) else s1[j] := s1[j] + F[i];
Result := '';
for i := 1 to 3 do
begin
if not IsOnlyNumbers(s1[i])
then
begin
Result := s1[i];
Break;
end;
end;
end;
function TbsSkinDateEdit.DecodeMonth(S: String): Word;
var
S1: String;
i: Integer;
begin
Result := 1;
for i := 1 to 12 do
begin
S1 := ExtactMonth(EncodeDate(9999, i, 1));
if LowerCase(S1) = LowerCase(S)
then
begin
Result := i;
Break;
end
end;
end;
function TbsSkinDateEdit.IsMonth(S: String): Boolean;
var
S1: String;
i: Integer;
begin
Result := False;
for i := 1 to 12 do
begin
S1 := ExtactMonth(EncodeDate(9999, i, 1));
if LowerCase(S1) = LowerCase(S)
then
begin
Result := True;
Break;
end
end;
end;
function TbsSkinDateEdit.IsOnlyNumbers;
const
DateSymbols = '0123456789';
var
i: Integer;
begin
Result := True;
for i := 1 to Length(S) do
begin
if (Pos(S[i], DateSymbols) = 0) and (S[i] <> DateSeparator)
then
begin
Result := False;
Break;
end;
end;
end;
function TbsSkinDateEdit.GetDateMask: String;
var
S: String;
S1: array[1..3] of String;
i, j: Integer;
MPos, DPos, YPos: Integer;
FL: Boolean;
begin
S := DateToStr(EncodeDate(9999, 12, 31));
YPos := 1;
MPos := 1;
Dpos := 1;
j := 1;
for i := 1 to 3 do s1[i] := '';
for i := 1 to Length(S) do
if S[i] = DateSeparator then inc(j) else s1[j] := s1[j] + S[i];
FL := False;
for i := 1 to 3 do
begin
if not IsOnlyNumbers(s1[i])
then
begin
MPos := i;
FL := True;
end
else
begin
j := StrToInt(s1[i]);
case j of
12: MPos := i;
31: DPos := i;
9999: YPos := i;
99: YPos := i;
end;
end;
end;
Result := '!';
for i := 1 to Length(s1[DPos]) do S1[DPos][i] := '9';
if FL
then
for i := 1 to Length(s1[MPos]) do S1[MPos][i] := 'L'
else
for i := 1 to Length(s1[MPos]) do S1[MPos][i] := '9';
for i := 1 to Length(s1[YPos]) do S1[YPos][i] := '0';
Result := Result + s1[1] + '/' + s1[2] + '/' + s1[3] + ';1; ';
end;
procedure TbsSkinDateEdit.Loaded;
begin
inherited;
EditMask := GetDateMask;
if FTodayDefault then Date := Now;
end;
procedure TbsSkinDateEdit.SetTodayDefault;
begin
FTodayDefault := Value;
if FTodayDefault then Date := Now;
end;
function TbsSkinDateEdit.GetCalendarFont;
begin
Result := FMonthCalendar.DefaultFont;
end;
procedure TbsSkinDateEdit.SetCalendarFont;
begin
FMonthCalendar.DefaultFont.Assign(Value);
end;
function TbsSkinDateEdit.GetCalendarWidth: Integer;
begin
Result := FMonthCalendar.Width;
end;
procedure TbsSkinDateEdit.SetCalendarWidth(Value: Integer);
begin
FMonthCalendar.Width := Value;
end;
function TbsSkinDateEdit.GetCalendarHeight: Integer;
begin
Result := FMonthCalendar.Height;
end;
procedure TbsSkinDateEdit.SetCalendarHeight(Value: Integer);
begin
FMonthCalendar.Height := Value;
end;
function TbsSkinDateEdit.GetDate: TDate;
begin
Result := FMonthCalendar.Date;
end;
procedure TbsSkinDateEdit.SetDate(Value: TDate);
begin
FMonthCalendar.Date := Value;
StopCheck := True;
if not (csLoading in ComponentState) or FTodayDefault
then
begin
Text := DateToStr(Value);
end;
StopCheck := False;
if Assigned(FOnDateChange) then FOnDateChange(Self);
end;
function TbsSkinDateEdit.IsValidText;
var
F: String;
s1, s2: array[1..3] of String;
i, j: Integer;
MPos, DPos, YPos: Integer;
FL: Boolean;
begin
Result := Pos(' ', S) = 0;
if not Result then Exit;
F := DateToStr(EncodeDate(9999, 12, 31));
if (IsOnlyNumbers(F) and not IsOnlyNumbers(S)) or
(IsOnlyNumbers(S) and not IsOnlyNumbers(F))
then
begin
Result := False;
Exit;
end;
for i := 1 to 3 do s1[i] := '';
for i := 1 to 3 do s2[i] := '';
j := 1;
YPos := 1;
MPos := 1;
Dpos := 1;
for i := 1 to Length(F) do
if F[i] = DateSeparator then inc(j) else s1[j] := s1[j] + F[i];
FL := False;
for i := 1 to 3 do
begin
if not IsOnlyNumbers(s1[i])
then
begin
MPos := i;
FL := True;
end
else
begin
j := StrToInt(s1[i]);
case j of
12: MPos := i;
31: DPos := i;
9999: YPos := i;
99: YPos := i;
end;
end;
end;
j := 1;
for i := 1 to Length(S) do
if S[i] = DateSeparator then inc(j) else s2[j] := s2[j] + S[i];
if StrToInt(s2[Ypos]) = 0
then
Result := Length(s2[YPos]) < 2
else
Result := True;
Result := Result and (Length(s2[1]) > 0) and (Length(s2[2]) > 0) and
(Length(s2[3]) > 0);
if not FL
then
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]))
else
Result := Result and
(Length(s1) = Length(s2)) and
(Length(s1[Mpos]) = Length(s2[Mpos])) and
IsMonth(s2[Mpos]) and
(StrToInt(s2[Dpos]) > 0) and
(StrToInt(s2[DPos]) <= StrToInt(s1[DPos])) and
(StrToInt(s2[YPos]) <= StrToInt(s1[YPos]))
end;
procedure TbsSkinDateEdit.Change;
begin
inherited;
if not StopCheck
then
if IsValidText(Text)
then CheckValidDate;
end;
procedure TbsSkinDateEdit.CheckValidDate;
var
OldDate: TDate;
begin
if FMonthCalendar = nil then Exit;
OldDate := FMonthCalendar.Date;
try
if IsOnlyNumbers(Text)
then
FMonthCalendar.Date := StrToDate(Text)
else
FMonthCalendar.Date := MyStrToDate(Text);
finally
if OldDate <> FMonthCalendar.Date
then
if Assigned(FOnDateChange) then FOnDateChange(Self);
end;
end;
procedure TbsSkinDateEdit.CMCancelMode;
begin
if (Message.Sender <> FMonthCalendar) and
not FMonthCalendar.ContainsControl(Message.Sender)
then
CloseUp(False);
end;
procedure TbsSkinDateEdit.WndProc;
begin
inherited;
case Message.Msg of
WM_KILLFOCUS:
begin
if not FMonthCalendar.Visible
then
begin
StopCheck := True;
Text := DateToStr(FMonthCalendar.Date);
StopCheck := False;
end
else
if Message.wParam <> FMonthCalendar.Handle
then
CloseUp(False);
end;
WM_KEYDOWN:
CloseUp(False);
end;
end;
procedure TbsSkinDateEdit.DropDown;
var
P: TPoint;
I, Y: 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 FAlphaBlend
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 FAlphaBlend and not FAlphaBlendAnimation and CheckW2KWXP
then
begin
Application.ProcessMessages;
SetAlphaBlendTransparent(FMonthCalendar.Handle, FAlphaBlendValue)
end
else
if FAlphaBlendAnimation and FAlphaBlend and CheckW2KWXP
then
begin
Application.ProcessMessages;
I := 0;
repeat
Inc(i, 2);
if i > FAlphaBlendValue then i := FAlphaBlendValue;
SetAlphaBlendTransparent(FMonthCalendar.Handle, i);
until i >= FAlphaBlendValue;
end;
end;
procedure TbsSkinDateEdit.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 FAlphaBlend
then
SetWindowLong(FMonthCalendar.Handle, GWL_EXSTYLE,
GetWindowLong(Handle, GWL_EXSTYLE) and not WS_EX_LAYERED);
if AcceptValue
then
begin
StopCheck := True;
Text := DateToStr(FMonthCalendar.Date);
if Assigned(FOnDateChange) then FOnDateChange(Self);
StopCheck := False;
end;
SetFocus;
end;
end;
procedure TbsSkinDateEdit.ButtonClick(Sender: TObject);
begin
if FMonthCalendar.Visible
then
CloseUp(False)
else
DropDown;
end;
procedure TbsSkinDateEdit.CalendarClick;
begin
CloseUp(True);
end;
function TbsSkinDateEdit.GetFirstDayOfWeek: TbsDaysOfWeek;
begin
Result := FMonthCalendar.FirstDayOfWeek;
end;
procedure TbsSkinDateEdit.SetFirstDayOfWeek(Value: TbsDaysOfWeek);
begin
FMonthCalendar.FirstDayOfWeek := Value;
end;
constructor TbsSkinMemo.Create;
begin
inherited Create(AOwner);
AutoSize := False;
FIndex := -1;
Font.Name := 'Arial';
Font.Height := 14;
FVScrollBar := nil;
FDown := False;
FSkinDataName := 'memo';
FDefaultFont := TFont.Create;
FDefaultFont.OnChange := OnDefaultFontChange;
FDefaultFont.Assign(Font);
ScrollBars := ssNone;
FUseSkinFont := True;
FSysPopupMenu := nil;
end;
procedure TbsSkinMemo.WMCONTEXTMENU;
var
X, Y: Integer;
P: TPoint;
begin
if PopupMenu <> nil
then
inherited
else
begin
CreateSysPopupMenu;
X := Message.XPos;
Y := Message.YPos;
if (X < 0) or (Y < 0)
then
begin
X := Width div 2;
Y := Height div 2;
P := Point(0, 0);
P := ClientToScreen(P);
X := X + P.X;
Y := Y + P.Y;
end;
if FSysPopupMenu <> nil
then
FSysPopupMenu.Popup2(Self, X, Y)
end;
end;
procedure TbsSkinMemo.WMAFTERDISPATCH;
begin
if FSysPopupMenu <> nil
then
begin
FSysPopupMenu.Free;
FSysPopupMenu := nil;
end;
end;
procedure TbsSkinMemo.DoUndo;
begin
Undo;
end;
procedure TbsSkinMemo.DoCut;
begin
CutToClipboard;
end;
procedure TbsSkinMemo.DoCopy;
begin
CopyToClipboard;
end;
procedure TbsSkinMemo.DoPaste;
begin
PasteFromClipboard;
end;
procedure TbsSkinMemo.DoDelete;
begin
ClearSelection;
end;
procedure TbsSkinMemo.DoSelectAll;
begin
SelectAll;
end;
procedure TbsSkinMemo.CreateSysPopupMenu;
function IsSelected: Boolean;
begin
Result := GetSelLength > 0;
end;
function IsFullSelected: Boolean;
begin
Result := GetSelText = Text;
end;
var
Item: TMenuItem;
begin
if FSysPopupMenu <> nil then FSysPopupMenu.Free;
FSysPopupMenu := TbsSkinPopupMenu.Create(Self);
FSysPopupMenu.ComponentForm := TForm(GetParentForm(Self));
Item := TMenuItem.Create(FSysPopupMenu);
with Item do
begin
if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
then
Caption := SkinData.ResourceStrData.GetResStr('EDIT_UNDO')
else
Caption := BS_Edit_Undo;
OnClick := DoUndo;
Enabled := Self.CanUndo;
end;
FSysPopupMenu.Items.Add(Item);
Item := TMenuItem.Create(FSysPopupMenu);
Item.Caption := '-';
FSysPopupMenu.Items.Add(Item);
Item := TMenuItem.Create(FSysPopupMenu);
with Item do
begin
if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
then
Caption := SkinData.ResourceStrData.GetResStr('EDIT_CUT')
else
Caption := BS_Edit_Cut;
Enabled := IsSelected and not Self.ReadOnly;
OnClick := DoCut;
end;
FSysPopupMenu.Items.Add(Item);
Item := TMenuItem.Create(FSysPopupMenu);
with Item do
begin
if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
then
Caption := SkinData.ResourceStrData.GetResStr('EDIT_COPY')
else
Caption := BS_Edit_Copy;
Enabled := IsSelected;
OnClick := DoCopy;
end;
FSysPopupMenu.Items.Add(Item);
Item := TMenuItem.Create(FSysPopupMenu);
with Item do
begin
if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
then
Caption := SkinData.ResourceStrData.GetResStr('EDIT_PASTE')
else
Caption := BS_Edit_Paste;
Enabled := (ClipBoard.AsText <> '') and not ReadOnly;
OnClick := DoPaste;
end;
FSysPopupMenu.Items.Add(Item);
Item := TMenuItem.Create(FSysPopupMenu);
with Item do
begin
if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
then
Caption := SkinData.ResourceStrData.GetResStr('EDIT_DELETE')
else
Caption := BS_Edit_Delete;
Enabled := IsSelected and not Self.ReadOnly;
OnClick := DoDelete;
end;
FSysPopupMenu.Items.Add(Item);
Item := TMenuItem.Create(FSysPopupMenu);
Item.Caption := '-';
FSysPopupMenu.Items.Add(Item);
Item := TMenuItem.Create(FSysPopupMenu);
with Item do
begin
if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
then
Caption := SkinData.ResourceStrData.GetResStr('EDIT_SELECTALL')
else
Caption := BS_Edit_SelectAll;
Enabled := not IsFullSelected;
OnClick := DoSelectAll;
end;
FSysPopupMenu.Items.Add(Item);
end;
procedure TbsSkinMemo.CMEnabledChanged;
begin
inherited;
UpDateScrollRange;
if Enabled
then
begin
if FIndex = -1
then Font.Color := FDefaultFont.Color
else Font.Color := FontColor;
end
else
begin
if FIndex = -1
then Font.Color := clGrayText
else Font.Color := clGrayText;
end;
end;
procedure TbsSkinMemo.SetDefaultFont;
begin
FDefaultFont.Assign(Value);
if FIndex = -1 then Font.Assign(Value);
end;
procedure TbsSkinMemo.OnDefaultFontChange(Sender: TObject);
begin
if FIndex = -1 then Font.Assign(FDefaultFont);
end;
procedure TbsSkinMemo.SetBitMapBG;
begin
FBitMapBG := Value;
ReCreateWnd;
end;
procedure TbsSkinMemo.WMSize;
begin
inherited;
UpDateScrollRange;
if not FBitMapBG
then
SendMessage(Handle, WM_NCPAINT, 0, 0);
end;
procedure TbsSkinMemo.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 TbsSkinMemo.Change;
begin
inherited;
UpDateScrollRange;
end;
procedure TbsSkinMemo.WMVSCROLL;
begin
inherited;
UpDateScrollRange;
end;
procedure TbsSkinMemo.WMHSCROLL;
begin
inherited;
end;
procedure TbsSkinMemo.WMLBUTTONDOWN;
begin
inherited;
FDown := True;
end;
procedure TbsSkinMemo.WMLBUTTONUP;
begin
inherited;
if FDown
then
begin
UpDateScrollRange;
FDown := False;
end;
end;
procedure TbsSkinMemo.WMMOUSEMOVE;
begin
inherited;
if FDown then UpDateScrollRange;
end;
procedure TbsSkinMemo.SetVScrollBar;
begin
FVScrollBar := Value;
FVScrollBar.Min := 0;
FVScrollBar.Max := 0;
FVScrollBar.Position := 0;
if FVScrollBar <> nil then FVScrollBar.OnChange := OnVScrollBarChange;
UpDateScrollRange;
end;
procedure TbsSkinMemo.OnVScrollBarChange(Sender: TObject);
begin
SendMessage(Handle, WM_VSCROLL,
MakeWParam(SB_THUMBPOSITION, FVScrollBar.Position), 0);
Invalidate;
end;
procedure TbsSkinMemo.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, Pos: Integer;
P: PPoint;
X: Integer;
R: TRect;
begin
if FVScrollBar <> nil
then
if not Enabled
then
FVScrollBar.Enabled := False
else
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 TbsSkinMEmo.WMMove;
begin
inherited;
end;
procedure TbsSkinMemo.WMCut(var Message: TMessage);
begin
if FReadOnly then Exit;
inherited;
if FBitMapBG then Invalidate;
UpDateScrollRange;
end;
procedure TbsSkinMemo.WMPaste(var Message: TMessage);
begin
if FReadOnly then Exit;
inherited;
if FBitMapBG then Invalidate;
UpDateScrollRange;
end;
procedure TbsSkinMemo.WMClear(var Message: TMessage);
begin
if FReadOnly then Exit;
inherited;
if FBitMapBG then Invalidate;
UpDateScrollRange;
end;
procedure TbsSkinMemo.WMUndo(var Message: TMessage);
begin
if FReadOnly then Exit;
inherited;
if FBitMapBG then Invalidate;
UpDateScrollRange;
end;
procedure TbsSkinMemo.WMSetText(var Message:TWMSetText);
begin
inherited;
if FBitMapBG then Invalidate;
UpDateScrollRange;
end;
procedure TbsSkinMemo.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 TbsSkinMemo.WMCHAR(var Message:TMessage);
begin
if not FReadOnly or (FReadOnly and (TWMCHar(Message).CharCode = 3))
then
inherited;
UpDateScrollRange;
end;
procedure TbsSkinMemo.WMKeyDown(var Message: TWMKeyDown);
begin
if FReadOnly and (TWMCHar(Message).CharCode = VK_DELETE) then Exit;
inherited;
if FBitMapBG then Invalidate;
UpDateScrollRange;
end;
procedure TbsSkinMemo.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
if FBitMapBG then Invalidate else inherited;
end;
procedure TbsSkinMemo.CNCtlColorStatic;
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 TbsSkinMemo.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 TbsSkinMemo.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 TbsSkinMemo.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;
Style := Style and not WS_VSCROLL and not WS_HSCROLL;
WindowClass.style := WindowClass.style and not (CS_HREDRAW or CS_VREDRAW);
end;
end;
procedure TbsSkinMemo.SkinNCPaint(C: TCanvas);
var
B: TBitMap;
R: TRect;
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);
Frame3D(B.Canvas, R, clBtnShadow, clBtnShadow, 1);
Frame3D(B.Canvas, R, clBtnFace, clBtnFace, 1);
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;
C.Draw(0, 0, B);
B.Free;
end;
procedure TbsSkinMemo.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);
Frame3D(C, R, clBtnShadow, clBtnShadow, 1);
Frame3D(C, R, clBtnFace, clBtnFace, 1);
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,
False, False, False, False)
else
CreateSkinBorderImages(LTPoint, RTPoint, LBPoint, RBPoint, CLRect,
NewLtPoint, NewRTPoint, NewLBPoint, NewRBPoint, NewCLRect,
LeftB, TopB, RightB, BottomB, Picture, SkinRect, Width, Height,
False, False, False, False);
C.Draw(0, 0, TopB);
C.Draw(0, TopB.Height, LeftB);
C.Draw(Width - RightB.Width, TopB.Height, RightB);
C.Draw(0, Height - BottomB.Height, BottomB);
TopB.Free;
LeftB.Free;
RightB.Free;
BottomB.Free;
end;
procedure TbsSkinMemo.WMNCPAINT;
var
DC: HDC;
C: TCanvas;
R: TRect;
kf: Double;
begin
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;
end;
destructor TbsSkinMemo.Destroy;
begin
FDefaultFont.Free;
if FSysPopupMenu <> nil then FSysPopupMenu.Free;
inherited;
end;
procedure TbsSkinMemo.WMSETFOCUS;
begin
inherited;
if not FMouseIn and (FIndex <> -1)
then
begin
Font.Color := ActiveFontColor;
if not FBitMapBG then Color := ActiveBGColor;
Invalidate;
end;
if not FBitMapBG
then
SendMessage(Handle, WM_NCPAINT, 0, 0);
end;
procedure TbsSkinMemo.WMKILLFOCUS;
begin
inherited;
if not FMouseIn and (FIndex <> -1)
then
begin
Font.Color := FontColor;
if not FBitMapBG then Color := BGColor;
Invalidate;
end;
if not FBitMapBG
then
SendMessage(Handle, WM_NCPAINT, 0, 0);
end;
procedure TbsSkinMemo.CMMouseEnter;
begin
inherited;
FMouseIn := True;
if not Focused and (FIndex <> -1)
then
begin
Font.Color := ActiveFontColor;
if not FBitMapBG then Color := ActiveBGColor;
Invalidate;
end;
if not FBitMapBG
then
SendMessage(Handle, WM_NCPAINT, 0, 0);
end;
procedure TbsSkinMemo.CMMouseLeave;
begin
inherited;
FMouseIn := False;
if not Focused and (FIndex <> -1)
then
begin
Font.Color := FontColor;
if not FBitMapBG then Color := BGColor;
Invalidate;
end;
if not FBitMapBG
then
SendMessage(Handle, WM_NCPAINT, 0, 0);
end;
procedure TbsSkinMemo.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 TbsDataSkinControl(FSD.CtrlList.Items[FIndex]) is TbsDataSkinMemoControl
then
with TbsDataSkinMemoControl(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 TbsSkinMemo.SetSkinData;
begin
FSD := Value;
if (FSD <> nil) then
if not FSD.Empty and not (csDesigning in ComponentState)
then
ChangeSkinData;
end;
procedure TbsSkinMemo.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 TbsSkinMemo.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;
end
else
begin
Font.Assign(FDefaultFont);
if Focused
then
Font.Color := ActiveFontColor
else
Font.Color := FontColor;
end;
Color := BGColor;
end
else
Font.Assign(FDefaultFont);
//
if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
then
Font.Charset := SkinData.ResourceStrData.CharSet
else
Font.CharSet := FDefaultFont.CharSet;
//
UpDateScrollRange;
ReCreateWnd;
if FVScrollBar <> nil then FVScrollBar.Align := FVScrollBar.Align;
if Enabled
then
begin
if FIndex = -1
then Font.Color := FDefaultFont.Color
else Font.Color := FontColor;
end
else
begin
if FIndex = -1
then Font.Color := clGrayText
else Font.Color := clGrayText;
end;
end;
constructor TbsSkinMemo2.Create;
begin
inherited Create(AOwner);
AutoSize := False;
FIndex := -1;
Font.Name := 'Arial';
Font.Height := 14;
FVScrollBar := nil;
FHScrollBar := nil;
FDown := False;
FSkinDataName := 'memo';
FDefaultFont := TFont.Create;
FDefaultFont.OnChange := OnDefaultFontChange;
FDefaultFont.Assign(Font);
ScrollBars := ssBoth;
FUseSkinFont := True;
FSysPopupMenu := nil;
end;
procedure TbsSkinMemo2.WMAFTERDISPATCH;
begin
if FSysPopupMenu <> nil
then
begin
FSysPopupMenu.Free;
FSysPopupMenu := nil;
end;
end;
procedure TbsSkinMemo2.WMCONTEXTMENU;
var
X, Y: Integer;
P: TPoint;
begin
if PopupMenu <> nil
then
inherited
else
begin
CreateSysPopupMenu;
X := Message.XPos;
Y := Message.YPos;
if (X < 0) or (Y < 0)
then
begin
X := Width div 2;
Y := Height div 2;
P := Point(0, 0);
P := ClientToScreen(P);
X := X + P.X;
Y := Y + P.Y;
end;
if FSysPopupMenu <> nil
then
FSysPopupMenu.Popup2(Self, X, Y)
end;
end;
procedure TbsSkinMemo2.DoUndo;
begin
Undo;
end;
procedure TbsSkinMemo2.DoCut;
begin
CutToClipboard;
end;
procedure TbsSkinMemo2.DoCopy;
begin
CopyToClipboard;
end;
procedure TbsSkinMemo2.DoPaste;
begin
PasteFromClipboard;
end;
procedure TbsSkinMemo2.DoDelete;
begin
ClearSelection;
end;
procedure TbsSkinMemo2.DoSelectAll;
begin
SelectAll;
end;
procedure TbsSkinMemo2.CreateSysPopupMenu;
function IsSelected: Boolean;
begin
Result := GetSelLength > 0;
end;
function IsFullSelected: Boolean;
begin
Result := GetSelText = Text;
end;
var
Item: TMenuItem;
begin
if FSysPopupMenu <> nil then FSysPopupMenu.Free;
FSysPopupMenu := TbsSkinPopupMenu.Create(Self);
FSysPopupMenu.ComponentForm := TForm(GetParentForm(Self));
Item := TMenuItem.Create(FSysPopupMenu);
with Item do
begin
if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
then
Caption := SkinData.ResourceStrData.GetResStr('EDIT_UNDO')
else
Caption := BS_Edit_Undo;
OnClick := DoUndo;
Enabled := Self.CanUndo;
end;
FSysPopupMenu.Items.Add(Item);
Item := TMenuItem.Create(FSysPopupMenu);
Item.Caption := '-';
FSysPopupMenu.Items.Add(Item);
Item := TMenuItem.Create(FSysPopupMenu);
with Item do
begin
if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
then
Caption := SkinData.ResourceStrData.GetResStr('EDIT_CUT')
else
Caption := BS_Edit_Cut;
Enabled := IsSelected and not Self.ReadOnly;
OnClick := DoCut;
end;
FSysPopupMenu.Items.Add(Item);
Item := TMenuItem.Create(FSysPopupMenu);
with Item do
begin
if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
then
Caption := SkinData.ResourceStrData.GetResStr('EDIT_COPY')
else
Caption := BS_Edit_Copy;
Enabled := IsSelected;
OnClick := DoCopy;
end;
FSysPopupMenu.Items.Add(Item);
Item := TMenuItem.Create(FSysPopupMenu);
with Item do
begin
if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
then
Caption := SkinData.ResourceStrData.GetResStr('EDIT_PASTE')
else
Caption := BS_Edit_Paste;
Enabled := (ClipBoard.AsText <> '') and not ReadOnly;
OnClick := DoPaste;
end;
FSysPopupMenu.Items.Add(Item);
Item := TMenuItem.Create(FSysPopupMenu);
with Item do
begin
if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
then
Caption := SkinData.ResourceStrData.GetResStr('EDIT_DELETE')
else
Caption := BS_Edit_Delete;
Enabled := IsSelected and not Self.ReadOnly;
OnClick := DoDelete;
end;
FSysPopupMenu.Items.Add(Item);
Item := TMenuItem.Create(FSysPopupMenu);
Item.Caption := '-';
FSysPopupMenu.Items.Add(Item);
Item := TMenuItem.Create(FSysPopupMenu);
with Item do
begin
if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
then
Caption := SkinData.ResourceStrData.GetResStr('EDIT_SELECTALL')
else
Caption := BS_Edit_SelectAll;
Enabled := not IsFullSelected;
OnClick := DoSelectAll;
end;
FSysPopupMenu.Items.Add(Item);
end;
procedure TbsSkinMemo2.CMEnabledChanged;
begin
inherited;
UpDateScrollRange;
end;
procedure TbsSkinMemo2.SetDefaultFont;
begin
FDefaultFont.Assign(Value);
if FIndex = -1 then Font.Assign(Value);
end;
procedure TbsSkinMemo2.OnDefaultFontChange(Sender: TObject);
begin
if FIndex = -1 then Font.Assign(FDefaultFont);
end;
procedure TbsSkinMemo2.WMSize;
begin
inherited;
UpDateScrollRange;
end;
procedure TbsSkinMemo2.Invalidate;
begin
inherited;
end;
procedure TbsSkinMemo2.Change;
begin
inherited;
UpDateScrollRange;
end;
procedure TbsSkinMemo2.WMVSCROLL;
begin
inherited;
UpDateScrollRange;
end;
procedure TbsSkinMemo2.WMHSCROLL;
begin
inherited;
UpDateScrollRange;
end;
procedure TbsSkinMemo2.WMLBUTTONDOWN;
begin
inherited;
FDown := True;
end;
procedure TbsSkinMemo2.WMLBUTTONUP;
begin
inherited;
if FDown
then
begin
UpDateScrollRange;
FDown := False;
end;
end;
procedure TbsSkinMemo2.WMMOUSEMOVE;
begin
inherited;
if FDown then UpDateScrollRange;
end;
procedure TbsSkinMemo2.SetVScrollBar;
begin
FVScrollBar := Value;
FVScrollBar.Min := 0;
FVScrollBar.Max := 0;
FVScrollBar.Position := 0;
if FVScrollBar <> nil then FVScrollBar.OnChange := OnVScrollBarChange;
UpDateScrollRange;
end;
procedure TbsSkinMemo2.OnVScrollBarChange(Sender: TObject);
begin
SendMessage(Handle, WM_VSCROLL,
MakeWParam(SB_THUMBPOSITION, FVScrollBar.Position), 0);
Invalidate;
end;
procedure TbsSkinMemo2.SetHScrollBar;
begin
FHScrollBar := Value;
FHScrollBar.Min := 0;
FHScrollBar.Max := 0;
FHScrollBar.Position := 0;
if FHScrollBar <> nil then FHScrollBar.OnChange := OnHScrollBarChange;
UpDateScrollRange;
end;
procedure TbsSkinMemo2.OnHScrollBarChange(Sender: TObject);
begin
SendMessage(Handle, WM_HSCROLL,
MakeWParam(SB_THUMBPOSITION, FHScrollBar.Position), 0);
Invalidate;
end;
procedure TbsSkinMemo2.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 TbsSkinMemo2.WMMove;
begin
inherited;
end;
procedure TbsSkinMemo2.WMCut(var Message: TMessage);
begin
inherited;
UpDateScrollRange;
end;
procedure TbsSkinMemo2.WMPaste(var Message: TMessage);
begin
inherited;
UpDateScrollRange;
end;
procedure TbsSkinMemo2.WMClear(var Message: TMessage);
begin
inherited;
UpDateScrollRange;
end;
procedure TbsSkinMemo2.WMUndo(var Message: TMessage);
begin
inherited;
UpDateScrollRange;
end;
procedure TbsSkinMemo2.WMSetText(var Message:TWMSetText);
begin
inherited;
UpDateScrollRange;
end;
procedure TbsSkinMemo2.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 TbsSkinMemo2.WMCHAR(var Message:TMessage);
begin
inherited;
UpDateScrollRange;
end;
procedure TbsSkinMemo2.WMKeyDown(var Message: TWMKeyDown);
begin
inherited;
UpDateScrollRange;
end;
procedure TbsSkinMemo2.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
inherited;
end;
procedure TbsSkinMemo2.CNCTLCOLOREDIT(var Message:TWMCTLCOLOREDIT);
begin
inherited;
end;
procedure TbsSkinMemo2.WMNCCALCSIZE;
begin
end;
procedure TbsSkinMemo2.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 TbsSkinMemo2.Destroy;
begin
FDefaultFont.Free;
if FSysPopupMenu <> nil then FSysPopupMenu.Free;
inherited;
end;
procedure TbsSkinMemo2.WMSETFOCUS;
begin
inherited;
if not FMouseIn and (FIndex <> -1)
then
begin
Font.Color := ActiveFontColor;
Color := ActiveBGColor;
end;
end;
procedure TbsSkinMemo2.WMKILLFOCUS;
begin
inherited;
if not FMouseIn and (FIndex <> -1)
then
begin
Font.Color := FontColor;
Color := BGColor;
end;
end;
procedure TbsSkinMemo2.CMMouseEnter;
begin
inherited;
FMouseIn := True;
if not Focused and (FIndex <> -1)
then
begin
Font.Color := ActiveFontColor;
Color := ActiveBGColor;
end;
end;
procedure TbsSkinMemo2.CMMouseLeave;
begin
inherited;
FMouseIn := False;
if not Focused and (FIndex <> -1)
then
begin
Font.Color := FontColor;
Color := BGColor;
end;
end;
procedure TbsSkinMemo2.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 TbsDataSkinControl(FSD.CtrlList.Items[FIndex]) is TbsDataSkinMemoControl
then
with TbsDataSkinMemoControl(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 TbsSkinMemo2.SetSkinData;
begin
FSD := Value;
if (FSD <> nil) then
if not FSD.Empty and not (csDesigning in ComponentState)
then
ChangeSkinData;
end;
procedure TbsSkinMemo2.Notification;
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (AComponent = FSD) then FSD := nil;
if (Operation = opRemove) and (AComponent = FVScrollBar)
then FVScrollBar := nil;
if (Operation = opRemove) and (AComponent = FHScrollBar)
then FHScrollBar := nil;
end;
procedure TbsSkinMemo2.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;
end
else
begin
Font.Assign(FDefaultFont);
if Focused
then
Font.Color := ActiveFontColor
else
Font.Color := FontColor;
end;
Color := BGColor;
end
else
Font.Assign(FDefaultFont);
//
if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
then
Font.Charset := SkinData.ResourceStrData.CharSet
else
Font.CharSet := FDefaultFont.CharSet;
//
UpDateScrollRange;
ReCreateWnd;
if FVScrollBar <> nil then FVScrollBar.Align := FVScrollBar.Align;
end;
constructor TbsListBox.Create;
begin
inherited;
SkinListBox := nil;
Ctl3D := False;
BorderStyle := bsNone;
ControlStyle := [csCaptureMouse, csOpaque, csDoubleClicks];
FHorizontalExtentValue := 0;
{$IFDEF VER130}
FAutoComplete := True;
{$ENDIF}
end;
destructor TbsListBox.Destroy;
begin
inherited;
end;
procedure TbsListBox.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 TbsListBox.CreateWnd;
begin
inherited;
if SkinListBox <> nil then SkinListBox.ListBoxCreateWnd;
end;
procedure TbsListBox.WMNCCALCSIZE;
begin
end;
procedure TbsListBox.CMEnter;
begin
if SkinListBox <> nil then SkinListBox.ListBoxEnter;
inherited;
end;
procedure TbsListBox.CMExit;
begin
if SkinListBox <> nil then SkinListBox.ListBoxExit;
inherited;
end;
procedure TbsListBox.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
if SkinListBox <> nil then SkinListBox.ListBoxMouseDown(Button, Shift, X, Y);
inherited;
end;
procedure TbsListBox.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
if SkinListBox <> nil then SkinListBox.ListBoxMouseUp(Button, Shift, X, Y);
inherited;
end;
procedure TbsListBox.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
if SkinListBox <> nil then SkinListBox.ListBoxMouseMove(Shift, X, Y);
inherited;
end;
procedure TbsListBox.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 TbsListBox.KeyPress(var Key: Char);
{$IFDEF VER130}
procedure FindString;
var
Idx: Integer;
begin
if Length(FFilter) = 1
then
Idx := SendMessage(Handle, LB_FINDSTRING, ItemIndex, LongInt(PChar(FFilter)))
else
Idx := SendMessage(Handle, LB_FINDSTRING, -1, LongInt(PChar(FFilter)));
if Idx <> LB_ERR then
begin
if MultiSelect then
begin
SendMessage(Handle, LB_SELITEMRANGE, 1, MakeLParam(Idx, Idx))
end;
ItemIndex := Idx;
Click;
end;
if not Ord(Key) in [VK_RETURN, VK_BACK, VK_ESCAPE] then
Key := #0;
end;
{$ENDIF}
begin
if SkinListBox <> nil then SkinListBox.ListBoxKeyPress(Key);
inherited;
{$IFDEF VER130}
if not FAutoComplete then Exit;
if GetTickCount - FLastTime >= 500 then
FFilter := '';
FLastTime := GetTickCount;
if Ord(Key) <> VK_BACK then
begin
FFilter := FFilter + Key;
Key := #0;
end
else
Delete(FFilter, Length(FFilter), 1);
if Length(FFilter) > 0 then
FindString
else
begin
ItemIndex := 0;
Click;
end;
{$ENDIF}
end;
procedure TbsListBox.Click;
begin
if SkinListBox <> nil then SkinListBox.ListBoxClick;
inherited;
end;
procedure TbsListBox.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 TbsListBox.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 TbsListBox.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 TbsListBox.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
begin
if SkinListBox.UseSkinItemHeight
then
DrawSkinItem(C, i, IR, GetState(i))
else
DrawStretchSkinItem(C, i, IR, GetState(i));
end
else
DrawDefaultItem(C, i, IR, GetState(i));
end;
C.Free;
end;
procedure TbsListBox.PaintList(DC: HDC);
var
C: TCanvas;
i, j, k, DrawCount: Integer;
IR: TRect;
begin
C := TCanvas.Create;
C.Handle := DC;
DrawCount := Height div ItemHeight;
i := TopIndex;
j := i + DrawCount;
if j > Items.Count - 1 then j := Items.Count - 1;
k := 0;
if Items.Count > 0
then
for i := TopIndex to j do
begin
IR := ItemRect(i);
if SkinListBox.FIndex <> -1
then
begin
if SkinListBox.UseSkinItemHeight
then
DrawSkinItem(C, i, IR, GetState(i))
else
DrawStretchSkinItem(C, i, IR, GetState(i));
end
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 TbsListBox.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 TbsListBox.WMPaint;
begin
PaintHandler(Msg);
end;
procedure TbsListBox.WMEraseBkgnd;
begin
if (Width > 0) and (Height > 0) then PaintBG(Message.DC);
Message.Result := 1;
end;
procedure TbsListBox.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 (SkinListBox.SkinData <> nil) and (SkinListBox.SkinData.ResourceStrData <> nil)
then
Font.Charset := SkinListBox.SkinData.ResourceStrData.CharSet
else
Font.CharSet := SkinListBox.DefaultFont.CharSet;
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;
BSDrawText3(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 TbsListBox.DrawStretchSkinItem(Cnvs: TCanvas; itemID: Integer; rcItem: TRect;
State: TOwnerDrawState);
var
Buffer, Buffer2: 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;
if UseSkinItemHeight
then
Buffer.Height := H
else
Buffer.Height := RectHeight(SItemRect);
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));
Inc(R.Bottom, RectHeight(rcItem) - RectHeight(SItemRect));
end;
W := RectWidth(rcItem);
H := RectHeight(rcItem);
Buffer2 := TBitMap.Create;
Buffer2.Width := W;
Buffer2.Height := H;
Buffer2.Canvas.StretchDraw(Rect(0, 0, Buffer2.Width, Buffer2.Height), Buffer);
Buffer.Free;
with Buffer2.Canvas do
begin
if SkinListBox.UseSkinFont
then
begin
Font.Name := SkinListBox.FontName;
Font.Style := SkinListBox.FontStyle;
Font.Height := SkinListBox.FontHeight;
end
else
Font.Assign(SkinListBox.DefaultFont);
if (SkinListBox.SkinData <> nil) and (SkinListBox.SkinData.ResourceStrData <> nil)
then
Font.Charset := SkinListBox.SkinData.ResourceStrData.CharSet
else
Font.CharSet := SkinListBox.DefaultFont.CharSet;
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(Buffer2.Canvas, ItemID, W, H, 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(Buffer2.Canvas,
IX - FHorizontalExtentValue, IY, IIndex);
end;
Off := SkinListBox.Images.Width + 2;
end
else
Off := 0;
BSDrawText3(Buffer2.Canvas, Items[ItemID], R, -FHorizontalExtentValue + Off);
end;
Cnvs.Draw(rcItem.Left, rcItem.Top, Buffer2);
Buffer2.Free;
end;
procedure TbsListBox.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
begin
if not (odSelected in State)
then
begin
CreateHSkinImage(ItemLeftOffset, ItemRightOffset, Buffer, Picture,
SItemRect, W, H);
R := Rect(0, 0, Buffer.Width, Buffer.Height);
DrawFocusRect(Buffer.Canvas.Handle, R);
end
else
CreateHSkinImage(ItemLeftOffset, ItemRightOffset, Buffer, Picture,
FocusItemRect, W, H)
end
else
if odSelected in 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;
end
else
Font.Assign(SkinListBox.DefaultFont);
if (SkinListBox.SkinData <> nil) and (SkinListBox.SkinData.ResourceStrData <> nil)
then
Font.Charset := SkinListBox.SkinData.ResourceStrData.CharSet
else
Font.CharSet := SkinListBox.DefaultFont.CharSet;
if odFocused in State
then
begin
if not (odSelected in State)
then
Font.Color := SkinListBox.FontColor
else
Font.Color := SkinListBox.FocusFontColor;
end
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;
BSDrawText3(Buffer.Canvas, Items[ItemID], R, -FHorizontalExtentValue + Off);
end;
Cnvs.Draw(rcItem.Left, rcItem.Top, Buffer);
Buffer.Free;
end;
procedure TbsListBox.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 TbsListBox.CNDrawItem;
var
State: TOwnerDrawState;
begin
with Message.DrawItemStruct^ do
begin
{$IFDEF VER120}
State := TOwnerDrawState(WordRec(LongRec(itemState).Lo).Lo);
{$ELSE}
{$IFDEF VER125}
State := TOwnerDrawState(WordRec(LongRec(itemState).Lo).Lo);
{$ELSE}
State := TOwnerDrawState(LongRec(itemState).Lo);
{$ENDIF}
{$ENDIF}
Canvas.Handle := hDC;
Canvas.Font := Font;
Canvas.Brush := Brush;
if SkinListBox.FIndex <> -1
then
begin
if SkinListBox.UseSkinItemHeight
then
DrawSkinItem(Canvas, itemID, rcItem, State)
else
DrawStretchSkinItem(Canvas, itemID, rcItem, State);
end
else
DrawDefaultItem(Canvas, itemID, rcItem, State);
Canvas.Handle := 0;
end;
end;
procedure TbsListBox.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 TbsSkinCustomListBox.Create;
begin
inherited;
ControlStyle := [csCaptureMouse, csClickEvents,
csReplicatable, csOpaque, csDoubleClicks];
ControlStyle := ControlStyle + [csAcceptsControls];
FUseSkinItemHeight := True;
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 := TbsListBox.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;
function TbsSkinCustomListBox.GetAutoComplete: Boolean;
begin
Result := ListBox.AutoComplete;
end;
procedure TbsSkinCustomListBox.SetAutoComplete(Value: Boolean);
begin
ListBox.AutoComplete := Value;
end;
function TbsSkinCustomListBox.GetOnListBoxEndDrag: TEndDragEvent;
begin
Result := ListBox.OnEndDrag;
end;
procedure TbsSkinCustomListBox.SetOnListBoxEndDrag(Value: TEndDragEvent);
begin
ListBox.OnEndDrag := Value;
end;
function TbsSkinCustomListBox.GetOnListBoxStartDrag: TStartDragEvent;
begin
Result := ListBox.OnStartDrag;
end;
procedure TbsSkinCustomListBox.SetOnListBoxStartDrag(Value: TStartDragEvent);
begin
ListBox.OnStartDrag := Value;
end;
function TbsSkinCustomListBox.GetOnListBoxDragOver: TDragOverEvent;
begin
Result := ListBox.OnDragOver;
end;
procedure TbsSkinCustomListBox.SetOnListBoxDragOver(Value: TDragOverEvent);
begin
ListBox.OnDragOver := Value;
end;
function TbsSkinCustomListBox.GetOnListBoxDragDrop: TDragDropEvent;
begin
Result := ListBox.OnDragDrop;
end;
procedure TbsSkinCustomListBox.SetOnListBoxDragDrop(Value: TDragDropEvent);
begin
ListBox.OnDragDrop := Value;
end;
procedure TbsSkinCustomListBox.SetHorizontalExtent(Value: Boolean);
begin
FHorizontalExtent := Value;
UpdateScrollBar;
end;
procedure TbsSkinCustomListBox.ListBoxCreateWnd;
begin
end;
function TbsSkinCustomListBox.GetColumns;
begin
Result := ListBox.Columns;
end;
procedure TbsSkinCustomListBox.SetColumns;
begin
ListBox.Columns := Value;
UpDateScrollBar;
end;
procedure TbsSkinCustomListBox.SetRowCount;
begin
FRowCount := Value;
if FRowCount <> 0
then
Height := Self.CalcHeight(FRowCount);
end;
procedure TbsSkinCustomListBox.SetNumGlyphs;
begin
FNumGlyphs := Value;
RePaint;
end;
procedure TbsSkinCustomListBox.SetGlyph;
begin
FGlyph.Assign(Value);
RePaint;
end;
procedure TbsSkinCustomListBox.SetSpacing;
begin
FSpacing := Value;
RePaint;
end;
procedure TbsSkinCustomListBox.SetImages(Value: TCustomImageList);
begin
FImages := Value;
ListBox.RePaint;
end;
procedure TbsSkinCustomListBox.SetImageIndex(Value: Integer);
begin
FImageIndex := Value;
ListBox.RePaint;
end;
procedure TbsSkinCustomListBox.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (AComponent = Images) then
Images := nil;
end;
procedure TbsSkinCustomListBox.ListBoxWProc(var Message: TMessage; var Handled: Boolean);
begin
Handled := True;
end;
procedure TbsSkinCustomListBox.DefaultFontChange;
begin
if FIndex = -1 then Font.Assign(FDefaultFont);
end;
procedure TbsSkinCustomListBox.OnDefaultCaptionFontChange;
begin
if (FIndex = -1) and FCaptionMode then RePaint;
end;
procedure TbsSkinCustomListBox.SetDefaultCaptionHeight;
begin
FDefaultCaptionHeight := Value;
if (FIndex = -1) and FCaptionMode
then
begin
CalcRects;
RePaint;
end;
end;
procedure TbsSkinCustomListBox.SetDefaultCaptionFont;
begin
FDefaultCaptionFont.Assign(Value);
end;
procedure TbsSkinCustomListBox.SetDefaultItemHeight;
begin
FDefaultItemHeight := Value;
if FIndex = -1
then
ListBox.ItemHeight := FDefaultItemHeight;
end;
procedure TbsSkinCustomListBox.StartTimer;
begin
KillTimer(Handle, 1);
SetTimer(Handle, 1, 100, nil);
end;
procedure TbsSkinCustomListBox.StopTimer;
begin
KillTimer(Handle, 1);
TimerMode := 0;
end;
procedure TbsSkinCustomListBox.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 TbsSkinCustomListBox.CMMouseEnter;
begin
inherited;
if FCaptionMode
then
TestActive(-1, -1);
end;
procedure TbsSkinCustomListBox.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 TbsSkinCustomListBox.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 TbsSkinCustomListBox.MouseUp;
begin
if FCaptionMode
then
begin
if CaptureButton <> -1
then ButtonUp(CaptureButton, X, Y);
CaptureButton := -1;
end;
inherited;
end;
procedure TbsSkinCustomListBox.MouseMove;
begin
inherited;
if FCaptionMode then TestActive(X, Y);
end;
procedure TbsSkinCustomListBox.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 TbsSkinCustomListBox.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 TbsSkinCustomListBox.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 TbsSkinCustomListBox.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 TbsSkinCustomListBox.ButtonLeave(I: Integer);
begin
Buttons[i].MouseIn := False;
DrawButton(Canvas, i);
if (TimerMode <> 0) and Buttons[i].Down
then KillTimer(Handle, 1);
end;
procedure TbsSkinCustomListBox.CMTextChanged;
begin
inherited;
if FCaptionMode then RePaint;
end;
procedure TbsSkinCustomListBox.SetAlignment(Value: TAlignment);
begin
if FAlignment <> Value
then
begin
FAlignment := Value;
if FCaptionMode then RePaint;
end;
end;
procedure TbsSkinCustomListBox.DrawButton;
var
C: TColor;
kf: Double;
R1: TRect;
begin
if FIndex = -1
then
with Buttons[i] do
begin
R1 := R;