Skip to content

Commit 072a391

Browse files
kangreonkangreon
committed
Разработан виджет вывода информации о собеседнике
1 parent 7b4578f commit 072a391

9 files changed

+249
-4
lines changed

‎Image/ToxUISkin.png

5.83 KB
Loading

‎gui/MessageWidget/MessageControl.pas

+8-1
Original file line numberDiff line numberDiff line change
@@ -16,7 +16,7 @@ interface
1616
uses
1717
{$I tox-uses.inc}
1818
Classes, SysUtils, Controls, Graphics, StringUtils, MessageList,
19-
MessageDraw, Messages, ActiveRegion, MessageItem, FriendItem;
19+
MessageDraw, Messages, ActiveRegion, MessageItem, FriendItem, MessageHeader;
2020

2121
type
2222
TMessagePosition = (mpBefore, mpAfter);
@@ -29,6 +29,7 @@ TMessageControl = class(TCustomControl)
2929
FFrienSelect: TFriendItem;
3030
FMessageList: TMessageList;
3131
FDraw: TMessageDraw;
32+
FMessageHeader: TMessageHeader;
3233
procedure MessageGet(Sender: TObject; const Index: Integer; out Exist: Boolean;
3334
out Mess: TMessageItem);
3435
procedure ActiveOnMessage(Sender: TObject; RegionMessage: TRegionMessage;
@@ -120,6 +121,10 @@ procedure TMessageControl.CreateWnd;
120121
FDraw.Parent := Self;
121122
FDraw.OnGet := MessageGet;
122123
FActive.Parent := Self;
124+
125+
FMessageHeader := TMessageHeader.Create(Self);
126+
FMessageHeader.Align := alTop;
127+
FMessageHeader.Parent := Self;
123128
end;
124129

125130
{ * Запрос на следующее сообщение
@@ -142,6 +147,8 @@ procedure TMessageControl.SelectFriend(Friend: TFriendItem);
142147
LastMessage := FMessageList.GetMessageCount(Friend.ClientId) - 1;
143148
FFrienSelect := Friend;
144149
FDraw.Redraw(LastMessage);
150+
151+
FMessageHeader.SelectFriend(Friend);
145152
end;
146153

147154
procedure TMessageControl.WndProc(var Message: TMessage);

‎gui/MessageWidget/MessageHeader.pas

+172
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,172 @@
1+
// MessageHeader.pas
2+
//
3+
// Заголовок виджета сообщений, в котором выводится иконка, имя и статус
4+
// пользователя. Виджет содержит кнопки аудио и видео звонка.
5+
//
6+
// The MIT License (MIT)
7+
//
8+
// Copyright (c) 2013 Dmitry
9+
//
10+
unit MessageHeader;
11+
12+
interface
13+
{$I tox.inc}
14+
15+
uses
16+
Graphics, Classes, Controls, ButtonActive, ResourceImage, MessageHeaderStyle,
17+
FriendItem, StringUtils, UserIcon, ImageUtils, Types;
18+
19+
type
20+
TMessageHeader = class(TCustomControl)
21+
private
22+
FImageCall: TButtonActive;
23+
FImageCallVideo: TButtonActive;
24+
FSelectFriend: TFriendItem;
25+
FUserIcon: TUserIcon;
26+
procedure FriendUpdate(Sender: TObject);
27+
protected
28+
procedure CreateWnd; override;
29+
procedure Resize; override;
30+
procedure Paint; override;
31+
public
32+
constructor Create(AOwner: TComponent); override;
33+
destructor Destroy; override;
34+
35+
procedure SelectFriend(FriendItem: TFriendItem);
36+
end;
37+
38+
implementation
39+
40+
{ TMessageHeader }
41+
42+
constructor TMessageHeader.Create(AOwner: TComponent);
43+
var
44+
ResImage: TResourceImage;
45+
begin
46+
inherited;
47+
ResImage := TResourceImage.Clone;
48+
FSelectFriend := nil;
49+
Visible := False;
50+
51+
FUserIcon := TUserIcon.Create;
52+
53+
FImageCall := TButtonActive.Create(Self);
54+
FImageCall.InsertImage(ResImage.MessageHeaderButtons, 0);
55+
FImageCall.Cursor := crHandPoint;
56+
FImageCallVideo := TButtonActive.Create(Self);
57+
FImageCallVideo.InsertImage(ResImage.MessageHeaderButtons, 3);
58+
FImageCallVideo.Cursor := crHandPoint;
59+
end;
60+
61+
destructor TMessageHeader.Destroy;
62+
begin
63+
FImageCall.Free;
64+
FImageCallVideo.Free;
65+
66+
FUserIcon.Free;
67+
inherited;
68+
end;
69+
70+
procedure TMessageHeader.Paint;
71+
var
72+
Name, Status: DataString;
73+
l, t: Integer;
74+
MaxWidth: Integer;
75+
Size: TSize;
76+
Rect: TRect;
77+
begin
78+
inherited;
79+
if not Assigned(FSelectFriend) then
80+
Exit;
81+
82+
Name := FSelectFriend.UserName;
83+
Status := FSelectFriend.StatusMessage;
84+
85+
t := (ClientHeight - FUserIcon.Height) div 2;
86+
l := TMHStyle.IconMarginLeft;
87+
Canvas.Draw(l, t, FUserIcon.Image);
88+
89+
l := TMHStyle.UserNameMarginLeft + l + FUserIcon.Width;
90+
91+
MaxWidth := FImageCall.Left - l - TMHStyle.ButtonAudioMarginLeft;
92+
93+
// Вывод имени
94+
Canvas.Font.Name := TMHStyle.UserNameFontName;
95+
Canvas.Font.Size := TMHStyle.UserNameSize;
96+
Canvas.Font.Style := TMHStyle.UserNameStyle;
97+
Canvas.Font.Color := TMHStyle.UserNameColor;
98+
Canvas.Brush.Style := bsClear;
99+
100+
Size := Canvas.TextExtent(Name);
101+
t := ClientHeight div 2 - Size.cy - 2;
102+
Rect := Bounds(l, t, MaxWidth, Size.cy);
103+
104+
if Size.cx < MaxWidth then
105+
Canvas.TextOut(l, t, Name)
106+
else
107+
TextRectW(Canvas, Rect, Name, [tfEndEllipsis]);
108+
109+
// Вывод статуса
110+
Canvas.Font.Name := TMHStyle.StatusFontName;
111+
Canvas.Font.Size := TMHStyle.StatusSize;
112+
Canvas.Font.Style := TMHStyle.StatusStyle;
113+
Canvas.Font.Color := TMHStyle.StatusColor;
114+
Canvas.Brush.Style := bsClear;
115+
116+
Size := Canvas.TextExtent(Status);
117+
t := ClientHeight div 2;
118+
Rect := Bounds(l, t, MaxWidth, Size.cy);
119+
120+
if Size.cx < MaxWidth then
121+
Canvas.TextOut(l, t, Status)
122+
else
123+
TextRectW(Canvas, Rect, Status, [tfEndEllipsis]);
124+
end;
125+
126+
procedure TMessageHeader.CreateWnd;
127+
begin
128+
inherited;
129+
DoubleBuffered := True;
130+
131+
Constraints.MinHeight := TMHStyle.ControlHeight;
132+
Constraints.MaxHeight := TMHStyle.ControlHeight;
133+
ClientHeight := TMHStyle.ControlHeight;
134+
135+
FImageCall.Parent := Self;
136+
FImageCallVideo.Parent := Self;
137+
end;
138+
139+
procedure TMessageHeader.Resize;
140+
begin
141+
inherited;
142+
FImageCallVideo.Top := (ClientHeight - FImageCallVideo.Height) div 2;
143+
FImageCall.Top := FImageCallVideo.Top;
144+
145+
FImageCallVideo.Left := ClientWidth - TMHStyle.ButtonVideoMarginRight -
146+
FImageCallVideo.Width;
147+
FImageCall.Left := FImageCallVideo.Left - TMHStyle.ButtonAudioMarginRight -
148+
FImageCall.Width;
149+
end;
150+
151+
procedure TMessageHeader.SelectFriend(FriendItem: TFriendItem);
152+
begin
153+
if not Assigned(FriendItem) then
154+
begin
155+
FSelectFriend := nil;
156+
Visible := False;
157+
end
158+
else
159+
begin
160+
FSelectFriend := FriendItem;
161+
FSelectFriend.OnUpdate := FriendUpdate;
162+
Visible := True;
163+
Invalidate;
164+
end;
165+
end;
166+
167+
procedure TMessageHeader.FriendUpdate(Sender: TObject);
168+
begin
169+
Invalidate;
170+
end;
171+
172+
end.

‎gui/MessageWidget/MessageHeaderStyle.pas

+34
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,34 @@
1+
unit MessageHeaderStyle;
2+
3+
interface
4+
{$I tox.inc}
5+
6+
uses
7+
Graphics;
8+
9+
type
10+
TMHStyle = class
11+
public const
12+
ControlHeight: Integer = 59;
13+
BackgroundColor: TColor = $EFEFEF;
14+
ButtonVideoMarginRight: Integer = 10;
15+
ButtonAudioMarginRight: Integer = 10;
16+
ButtonAudioMarginLeft: Integer = 10;
17+
18+
IconMarginLeft: Integer = 10;
19+
20+
UserNameFontName: string = 'Fira Sans';
21+
UserNameSize: Integer = 10;
22+
UserNameStyle: TFontStyles = [fsBold];
23+
UserNameColor: TColor = $424040;
24+
25+
StatusFontName: string = 'Fira Sans';
26+
StatusSize: Integer = 9;
27+
StatusStyle: TFontStyles = [];
28+
StatusColor: TColor = $5c5a5a;
29+
30+
UserNameMarginLeft: Integer = 7;
31+
end;
32+
implementation
33+
34+
end.

‎gui/ResourceImage.pas

+28
Original file line numberDiff line numberDiff line change
@@ -36,9 +36,11 @@ TResourceImage = class
3636
FUserListStatus: array of TBitmapList;
3737
FControlButtons: TBitmapList;
3838
FSelfStatusIcons: TBitmapList;
39+
FMessageHeaderButtons: TBitmapList;
3940

4041
procedure LoadControlButtons(StartLeft, StartTop, Width, Height: Integer);
4142
procedure LoadSelfStatusIcons(StartLeft, StartTop, Width, Height: Integer);
43+
procedure LoadMessageHeaderButtons(StartLeft, StartTop, Width, Height: Integer);
4244
procedure LoadUserListStatus;
4345
function LoadImageBmp(Name: string): TBitmap;
4446
function LoadImageBmpFromPng(Name: string): TBitmap;
@@ -54,6 +56,7 @@ TResourceImage = class
5456
IsNewMessage: Boolean): TBitmap;
5557

5658
property ControlButtons: TBitmapList read FControlButtons;
59+
property MessageHeaderButtons: TBitmapList read FMessageHeaderButtons;
5760

5861
property LoadingAnimate10: TPngImage read FLoadingAnimate10;
5962

@@ -93,6 +96,7 @@ constructor TResourceImage.Create;
9396
LoadUserListStatus;
9497
LoadControlButtons(0, 108, 20, 20);
9598
LoadSelfStatusIcons(0, 128, 22, 22);
99+
LoadMessageHeaderButtons(0, 172, 52, 32);
96100

97101
FImageMenu := TImageList.Create(nil);
98102

@@ -255,6 +259,30 @@ function TResourceImage.LoadImagePng(name: string): TPngImage;
255259
Result := Image;
256260
end;
257261

262+
procedure TResourceImage.LoadMessageHeaderButtons(StartLeft, StartTop, Width,
263+
Height: Integer);
264+
var
265+
i: Integer;
266+
Image: TBitmap;
267+
DRect, SRect: TRect;
268+
begin
269+
DRect := Bounds(0, 0, Width, Height);
270+
271+
SetLength(FMessageHeaderButtons, 8);
272+
for i := Low(FMessageHeaderButtons) to High(FMessageHeaderButtons) do
273+
begin
274+
Image := TBitmap.Create;
275+
try
276+
Image.SetSize(Width, Height);
277+
278+
SRect := Bounds(StartLeft + i * Width, StartTop, Width, Height);
279+
Image.Canvas.CopyRect(DRect, FToxSkin.Canvas, SRect);
280+
finally
281+
FMessageHeaderButtons[i] := Image;
282+
end;
283+
end;
284+
end;
285+
258286
procedure TResourceImage.LoadSelfStatusIcons(StartLeft, StartTop, Width,
259287
Height: Integer);
260288
var

‎src/libtox.pas

+1-1
Original file line numberDiff line numberDiff line change
@@ -358,7 +358,7 @@ function tox_getname(tox: TTox; friendnumber: Integer; name: PByte): Integer; cd
358358
//int tox_set_statusmessage(Tox *tox, uint8_t *status, uint16_t length);
359359
//int tox_set_userstatus(Tox *tox, TOX_USERSTATUS status);
360360
function tox_set_statusmessage(tox: TTox; status: PByte; length: Word): Integer; cdecl; external TOX_LIBRARY;
361-
function tox_set_userstatus(tox: TTox; status: TToxUserStatus): Integer; cdecl; external TOX_LIBRARY;
361+
function tox_set_userstatus(tox: TTox; status: Integer): Integer; cdecl; external TOX_LIBRARY;
362362

363363
///* return the length of friendnumber's status message, including null.
364364
// * Pass it into malloc

‎src/toxcore.pas

+1-1
Original file line numberDiff line numberDiff line change
@@ -857,7 +857,7 @@ procedure TToxCore.SetUserName(const Value: DataString);
857857
procedure TToxCore.SetUserStatus(Status: TToxUserStatus);
858858
begin
859859
if FConnectState = csOnline then
860-
tox_set_userstatus(FTox, Status);
860+
tox_set_userstatus(FTox, Integer(Status));
861861
end;
862862

863863
procedure TToxCore.StartTox;

‎tox.dpr

+3-1
Original file line numberDiff line numberDiff line change
@@ -61,7 +61,9 @@ uses
6161
MessageItem in 'src\MessageItem.pas',
6262
FriendItem in 'src\FriendItem.pas',
6363
FriendBase in 'src\FriendBase.pas',
64-
DataBase in 'src\DataBase.pas';
64+
DataBase in 'src\DataBase.pas',
65+
MessageHeader in 'gui\MessageWidget\MessageHeader.pas',
66+
MessageHeaderStyle in 'gui\MessageWidget\MessageHeaderStyle.pas';
6567

6668
{ * Вывод сообщения об ошибке загрузки библиотеки libtoxcore
6769
* }

‎tox.dproj

+2
Original file line numberDiff line numberDiff line change
@@ -119,6 +119,8 @@
119119
<DCCReference Include="src\FriendItem.pas"/>
120120
<DCCReference Include="src\FriendBase.pas"/>
121121
<DCCReference Include="src\DataBase.pas"/>
122+
<DCCReference Include="gui\MessageWidget\MessageHeader.pas"/>
123+
<DCCReference Include="gui\MessageWidget\MessageHeaderStyle.pas"/>
122124
<BuildConfiguration Include="Debug">
123125
<Key>Cfg_2</Key>
124126
<CfgParent>Base</CfgParent>

0 commit comments

Comments
 (0)