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

Delphi Sources



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

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

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

Возникла необходимость использования компонента типа "Слайдер" - переключатель на два положения. Поискав в интернете, нашел нечто подобное, которое меня устраивает вполне на Stackoverflow https://stackoverflow.com/questions/...imilar-to-ipad.
Нижеприведенный код, замечательно компилируется и работает в Delphi 7.
Код:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
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 вне форума
Модератор
 
Регистрация: 17.04.2008
Сообщения: 8,087
Версия Delphi: 7, XE3, 10.2
Репутация: 49089
По умолчанию

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

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

Код:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
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;

Теперь ругается на вот эту строку
Код:
1
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 вне форума
Модератор
 
Регистрация: 17.04.2008
Сообщения: 8,087
Версия Delphi: 7, XE3, 10.2
Репутация: 49089
По умолчанию

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

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

Ну тут похоже порядок параметров другой.
В исходнике: 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
Сообщения: 51
Версия Delphi: Delphi 7
Репутация: 10
По умолчанию

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


Delphi Sources

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

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

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

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


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


 

Сайт

Форум

FAQ

Соглашения

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2025