Форум по программированию Delphi Sources

 



Вернуться   Форум по программированию Delphi Sources > Все о Delphi > [ "Начинающим" ]
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 18.12.2018, 18:38
Аватар для LIONSMILE
LIONSMILE LIONSMILE вне форума
Прохожий
 
Регистрация: 19.03.2018
Сообщения: 41
Версия Delphi: Delphi 7
Репутация: 10
По умолчанию Создание компонента Slider для Delphi XE

Доброго времени суток!

Возникла необходимость использования компонента типа "Слайдер" - переключатель на два положения. Поискав в интернете, нашел нечто подобное, которое меня устраивает вполне на Stackoverflow https://stackoverflow.com/questions/...imilar-to-ipad.
Нижеприведенный код, замечательно компилируется и работает в Delphi 7.
Код:
unit OnOffSwitch;

interface

uses
  Classes, Controls, Windows, Messages, Graphics, Themes;

type
  TOnOffSwitch = class(TCustomControl)
  private
    FMouseHover: Boolean;
    FOff: Boolean;
    FSliderRect: TRect;
    procedure SetMouseHover(Value: Boolean);
    procedure SetOff(Value: Boolean);
    procedure UpdateSliderRect;
    procedure WMWindowPosChanged(var Message: TWMWindowPosChanged);
      message WM_WINDOWPOSCHANGED;
    procedure CMEnabledChanged(var Message: TMessage);
      message CM_ENABLEDCHANGED;
    procedure CMFocusChanged(var Message: TCMFocusChanged);
      message CM_FOCUSCHANGED;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
  protected
    procedure KeyUp(var Key: Word; Shift: TShiftState); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property Anchors;
    property Constraints;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Font;
    property Off: Boolean read FOff write SetOff default True;
    property OnClick;
    property OnContextPopup;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDock;
    property OnStartDrag;
    property ParentFont default False;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop default True;
    property Visible;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples', [TOnOffSwitch]);
end;

{ TOnOffSwitch }

resourcestring
  SOff = 'OFF';
  SOn = 'ON';

procedure TOnOffSwitch.CMEnabledChanged(var Message: TMessage);
begin
  Invalidate;
  inherited;
end;

procedure TOnOffSwitch.CMFocusChanged(var Message: TCMFocusChanged);
begin
  Invalidate;
  inherited;
end;

procedure TOnOffSwitch.CMMouseLeave(var Message: TMessage);
begin
  SetMouseHover(False);
  inherited;
end;

constructor TOnOffSwitch.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := [csCaptureMouse, csClickEvents, csDoubleClicks, csOpaque];
  FOff := True;
  Caption := SOff;
  Width := 75;
  Height := 25;
  TabStop := True;
  Font.Name := 'Tahoma';
  Font.Style := [fsBold];
end;

procedure TOnOffSwitch.KeyUp(var Key: Word; Shift: TShiftState);
begin
  if Key = VK_SPACE then
    SetOff(not FOff);
  inherited KeyUp(Key, Shift);
end;

procedure TOnOffSwitch.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  if (Shift = [ssLeft]) and PtInRect(FSliderRect, Point(X, Y)) then
    SetOff(not FOff);
  inherited MouseDown(Button, Shift, X, Y);
end;

procedure TOnOffSwitch.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  if GetCaptureControl = nil then
    SetMouseHover(PtInRect(FSliderRect, Point(X, Y)));
  inherited MouseMove(Shift, X, Y);
end;

procedure TOnOffSwitch.Paint;
var
  Button: TThemedButton;
  PaintRect: TRect;
  Details: TThemedElementDetails;
begin
  if ThemeServices.ThemesAvailable then
  begin
    if not Enabled then
      Button := tbPushButtonDisabled
    else if not FOff then
      Button := tbPushButtonPressed
    else
      Button := tbPushButtonNormal;
    PaintRect := ClientRect;
    Details := ThemeServices.GetElementDetails(Button);
    ThemeServices.DrawElement(Canvas.Handle, Details, PaintRect);
    if FOff then
      Inc(PaintRect.Left, Round(2 / 5 * Width))
    else
      Dec(PaintRect.Right, Round(2 / 5 * Width));
    Canvas.Brush.Style := bsClear;
    Canvas.Font := Self.Font;
    if not Enabled then
      Canvas.Font.Color := $00A0A0A0
    else
      Canvas.Font.Color := $00555555;
    DrawText(Canvas.Handle, PChar(Caption), -1, PaintRect, DT_CENTER or
      DT_VCENTER or DT_SINGLELINE);
    if Enabled and not FOff then
    begin
      OffsetRect(PaintRect, 0, 1);
      Canvas.Font.Color := clWhite;
      DrawText(Canvas.Handle, PChar(Caption), -1, PaintRect, DT_CENTER or
        DT_VCENTER or DT_SINGLELINE);
    end;
    if not Enabled then
      Button := tbPushButtonDisabled
    else if Focused then
      Button := tbPushButtonDefaulted
    else if FMouseHover then
      Button := tbPushButtonHot
    else
      Button := tbPushButtonNormal;
    PaintRect := FSliderRect;
    Details := ThemeServices.GetElementDetails(Button);
    ThemeServices.DrawElement(Canvas.Handle, Details, PaintRect);
    if Focused then
    begin
      PaintRect := ThemeServices.ContentRect(Canvas.Handle, Details, PaintRect);
      SetTextColor(Canvas.Handle, clWhite);
      DrawFocusRect(Canvas.Handle, PaintRect);
    end;
  end;
end;

procedure TOnOffSwitch.SetMouseHover(Value: Boolean);
begin
  if FMouseHover <> Value then
  begin
    FMouseHover := Value;
    Invalidate;
  end;
end;

procedure TOnOffSwitch.SetOff(Value: Boolean);
begin
  if FOff <> Value then
  begin
    FOff := Value;
    if FOff then
      Caption := SOff
    else
      Caption := SOn;
    UpdateSliderRect;
    Invalidate;
  end;
end;

procedure TOnOffSwitch.UpdateSliderRect;
begin
  if FOff then
    SetRect(FSliderRect, 0, 0, Round(2 / 5 * Width), Height)
  else
    SetRect(FSliderRect, Round(3 / 5 * Width), 0, Width, Height);
end;

procedure TOnOffSwitch.WMWindowPosChanged(var Message: TWMWindowPosChanged);
begin
  inherited;
  UpdateSliderRect;
  Font.Size := Round(Height div 3) + 1;
end;

end.
LNcWd.png
Но мне нужно его использовать в Delphi XE7, но он выкидывает кучу ошибок и не работает. Просто не вижу смысла из-за одного компонента ставить целый pack от TMS, в котором подобный компонент присутствует, тем более что еще и pack этот Trial.
Помогите пожалуйста переделать компонент для Delphi XE7, если Вам не трудно.
Проект прикрепляю Slider_XE.7z. Исходник брал отсюда - https://svn.apada.nl/svn/NLDelphi-op...LDOnOffSwitch/
Заранее огромное спасибо!
Ответить с цитированием
  #2  
Старый 18.12.2018, 20:36
Аватар для lmikle
lmikle lmikle вне форума
Модератор
 
Регистрация: 17.04.2008
Сообщения: 7,309
Версия Delphi: 7, XE3, 10.2
Репутация: 49087
По умолчанию

Ошибки какие?
Если не ошибаюсь, компилил ээтот компонент в D10 какой-то, все работалло. Только я его не ставил, создавал динамически.
Ответить с цитированием
  #3  
Старый 19.12.2018, 03:00
Аватар для LIONSMILE
LIONSMILE LIONSMILE вне форума
Прохожий
 
Регистрация: 19.03.2018
Сообщения: 41
Версия Delphi: Delphi 7
Репутация: 10
По умолчанию

Была проблема с ThemeServices, которые в версиях Delphi XE идут как StyleServices, это я поправил, везде вроде бы

Код:
procedure TNLDOnOffSwitch.Paint;
var
  Button: TThemedButton;
  PaintRect: TRect;
  Details: TThemedElementDetails;
begin
  if StyleServices.Available then
  begin
    if not Enabled then
      Button := tbPushButtonDisabled
    else if not FOff then
      Button := tbPushButtonPressed
    else
      Button := tbPushButtonNormal;
    PaintRect := ClientRect;
    Details := StyleServices.GetElementDetails(Button);
StyleServices.DrawElement(Canvas.Handle, Details, PaintRect);
    if FOff then
      Inc(PaintRect.Left, Round(2 / 5 * Width))
    else
      Dec(PaintRect.Right, Round(2 / 5 * Width));
    Canvas.Brush.Style := bsClear;
    Canvas.Font := Self.Font;
    if not Enabled then
      Canvas.Font.Color := $00A0A0A0
    else
      Canvas.Font.Color := $00555555;
    DrawText(Canvas.Handle, PChar(Caption), -1, PaintRect, DT_CENTER or
      DT_VCENTER or DT_SINGLELINE);
    if Enabled and not FOff then
    begin
      OffsetRect(PaintRect, 0, 1);
      Canvas.Font.Color := clWhite;
      DrawText(Canvas.Handle, PChar(Caption), -1, PaintRect, DT_CENTER or
        DT_VCENTER or DT_SINGLELINE);
    end;
    if not Enabled then
      Button := tbPushButtonDisabled
    else if Focused then
      Button := tbPushButtonDefaulted
    else if FMouseHover then
      Button := tbPushButtonHot
    else
      Button := tbPushButtonNormal;
    PaintRect := FSliderRect;
    Details := StyleServices.GetElementDetails(Button);
    StyleServices.DrawElement(Canvas.Handle, Details, PaintRect);
    if Focused then
    begin
      PaintRect := StyleServices.GetElementContentRect(Canvas.Handle, Details, PaintRect);
      SetTextColor(Canvas.Handle, clWhite);
      DrawFocusRect(Canvas.Handle, PaintRect);
    end;
  end;
end;

Теперь ругается на вот эту строку
Код:
      PaintRect := StyleServices.GetElementContentRect(Canvas.Handle, Details, PaintRect);
Пишет - [dcc32 Error] NLDOnOffSwitch.pas(177): E2250 There is no overloaded version of 'GetElementContentRect' that can be called with these arguments - как говорит кривой переводчик гугл - Не существует перегруженной версии GetElementContentRect, которую можно вызывать с этими аргументами.
Ответить с цитированием
  #4  
Старый 19.12.2018, 04:51
Аватар для lmikle
lmikle lmikle вне форума
Модератор
 
Регистрация: 17.04.2008
Сообщения: 7,309
Версия Delphi: 7, XE3, 10.2
Репутация: 49087
По умолчанию

Ага, сигнатура метода, видимо, отличается. Нажми Ctrl+Space на имени метода, должна появиться подсказка. Там смотри типы параметров.
Ответить с цитированием
Этот пользователь сказал Спасибо lmikle за это полезное сообщение:
LIONSMILE (22.12.2018)
  #5  
Старый 20.12.2018, 08:59
Аватар для LIONSMILE
LIONSMILE LIONSMILE вне форума
Прохожий
 
Регистрация: 19.03.2018
Сообщения: 41
Версия Delphi: Delphi 7
Репутация: 10
По умолчанию

Вот что он мне нарисовал
Ф1.JPG
Ответить с цитированием
  #6  
Старый 20.12.2018, 20:24
Аватар для lmikle
lmikle lmikle вне форума
Модератор
 
Регистрация: 17.04.2008
Сообщения: 7,309
Версия Delphi: 7, XE3, 10.2
Репутация: 49087
По умолчанию

Ну тут похоже порядок параметров другой.
В исходнике: Details, Canvas.Handle, PaintRect
А библиотечная функция ожидает: Canvas.Handle, Details, PaintRect
(еще там может быть четвертый - тот же PaintRect, если этот метод описан как procedure,а не как function.
Ответить с цитированием
Этот пользователь сказал Спасибо lmikle за это полезное сообщение:
LIONSMILE (22.12.2018)
  #7  
Старый 22.12.2018, 05:41
Аватар для LIONSMILE
LIONSMILE LIONSMILE вне форума
Прохожий
 
Регистрация: 19.03.2018
Сообщения: 41
Версия Delphi: Delphi 7
Репутация: 10
По умолчанию

Оказывается все было куда проще, нужно было просто поменять классы, что я и сделал ранее, и просто пересоздать заново файл DPK. В итоге все получилось и работает.
ScreenXE7.png
Вложения
Тип файла: 7z Slider_DXE7.7z (11.4 Кбайт, 0 просмотров)
Ответить с цитированием
Ответ



Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 12:12.


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

Copyright © Форум "Delphi Sources", 2004-2019

ВКонтакте   Facebook   Twitter