You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
371 lines
10 KiB
Plaintext
371 lines
10 KiB
Plaintext
{
|
|
This file is part of R&Q.
|
|
Under same license
|
|
}
|
|
unit RQmsgs;
|
|
{$I ForRnQConfig.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
Windows, Messages, SysUtils,
|
|
Classes, Graphics, Controls, Forms,
|
|
RDGlobal, RnQButtons, RQMenuItem,
|
|
VirtualTrees, ExtCtrls, StdCtrls;
|
|
|
|
{$I NoRTTI.inc}
|
|
|
|
type
|
|
TMsgsFrm = class(TForm)
|
|
procedure FormShow(Sender: TObject);
|
|
procedure MsgListCompareNodes(Sender: TBaseVirtualTree; Node1, Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer);
|
|
procedure MsgListDrawNode(Sender: TBaseVirtualTree; const PaintInfo: TVTPaintInfo);
|
|
procedure MsgListMeasureItem(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode; var NodeHeight: Integer);
|
|
procedure MsgListFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
|
|
procedure OkBtnClick(Sender: TObject);
|
|
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
|
|
procedure FormClose(Sender: TObject; var Action: TCloseAction);
|
|
procedure FormCreate(Sender: TObject);
|
|
procedure FormResize(Sender: TObject);
|
|
// public
|
|
// function kind2iconIndex(kind:TMsgDlgType):integer;
|
|
protected
|
|
OkBtn: TRnQButton;
|
|
FTimer: TTimer;
|
|
menu: TRnQPopupMenu;
|
|
OpenChatM: TRQMenuItem;
|
|
procedure OnTimer(Sender: TObject);
|
|
procedure MenuPopup(Sender: TObject);
|
|
procedure OpenChat(Sender: TObject);
|
|
procedure CopyText(Sender: TObject);
|
|
public
|
|
MsgList: TVirtualDrawTree;
|
|
FSeconds: Integer;
|
|
procedure AddMsg(const msg: string; kind: TMsgDlgType; vTime: TDateTime; const uid: String = '');
|
|
end;
|
|
|
|
var
|
|
msgsFrm: TMsgsFrm;
|
|
msgKind: TMsgDlgType;
|
|
|
|
implementation
|
|
|
|
{$R *.dfm}
|
|
|
|
uses
|
|
Clipbrd, Math, Types,
|
|
RDUtils, RQUtil, RnQlangs, RQThemes, RnQMenu, RnQDialogs,
|
|
RnQSysUtils, RnQGlobal;
|
|
|
|
type
|
|
Pmsg = ^Tmsg;
|
|
Tmsg = record
|
|
text: String;
|
|
UID: String;
|
|
kind: TMsgDlgType;
|
|
time: Tdatetime;
|
|
end;
|
|
|
|
const
|
|
GAP_X = 3;
|
|
GAP_Y = 4;
|
|
|
|
procedure TMsgsFrm.OnTimer(Sender: TObject);
|
|
begin
|
|
Dec(FSeconds);
|
|
OkBtn.Caption := SMsgDlgOK + ' (' + IntToStr(FSeconds) + ')';
|
|
if FSeconds <= 0 then
|
|
begin
|
|
FTimer.Enabled := False;
|
|
OkBtnClick(nil);
|
|
// ModalResult := OkBtn.ModalResult;
|
|
end
|
|
end;
|
|
|
|
procedure TMsgsFrm.MsgListCompareNodes(Sender: TBaseVirtualTree; Node1, Node2: PVirtualNode; Column: TColumnIndex;
|
|
var Result: Integer);
|
|
begin
|
|
if Pmsg(Sender.getnodedata(Node1)).time > Pmsg(Sender.getnodedata(Node2)).time then
|
|
Result := -1
|
|
else if Pmsg(Sender.getnodedata(Node1)).time = Pmsg(Sender.getnodedata(Node2)).time then
|
|
Result := 0
|
|
else
|
|
Result := 1;
|
|
end;
|
|
|
|
procedure TMsgsFrm.MsgListDrawNode(Sender: TBaseVirtualTree; const PaintInfo: TVTPaintInfo);
|
|
var
|
|
s: String;
|
|
IsFirst, Selected: Boolean;
|
|
r: TRect;
|
|
clr: TColor;
|
|
begin
|
|
PaintInfo.Canvas.Font.Assign(Application.DefaultFont);
|
|
Selected := vsSelected in PaintInfo.Node^.States;
|
|
IsFirst := PaintInfo.Node = MsgList.GetFirst;
|
|
r := PaintInfo.CellRect;
|
|
Inc(r.Left, GAP_X);
|
|
Dec(r.Right, GAP_X);
|
|
Inc(r.Top, GAP_Y);
|
|
|
|
if (IsFirst) then
|
|
clr := clWindowText
|
|
else if not Selected then
|
|
clr := $555555
|
|
else
|
|
clr := $333333;
|
|
PaintInfo.Canvas.Font.Color := clr;
|
|
// additional spaces for icon
|
|
with Pmsg(Sender.getnodedata(PaintInfo.Node))^ do
|
|
with theme.drawPic(PaintInfo.Canvas.Handle, r.Left, r.Top, IconNames[kind], IsFirst) do
|
|
begin
|
|
s := DateTimeToStr(time) + CRLF;
|
|
if cy > 32 then
|
|
Inc(r.Left, 10 + cx)
|
|
else
|
|
Inc(r.Left, 5 + cx);
|
|
s := s + text;
|
|
|
|
SetBkMode(PaintInfo.Canvas.Handle, TRANSPARENT);
|
|
DrawText(PaintInfo.Canvas.Handle, PChar(s), -1, r, DT_EDITCONTROL or DT_WORDBREAK or DT_EXTERNALLEADING or DT_NOPREFIX);
|
|
end;
|
|
end;
|
|
|
|
procedure TMsgsFrm.MsgListFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
|
|
var
|
|
m: Pmsg;
|
|
begin
|
|
m := Pmsg(Sender.getnodedata(Node));
|
|
if m <> NIL then
|
|
begin
|
|
SetLength(m.text, 0);
|
|
SetLength(m.uid, 0);
|
|
end;
|
|
end;
|
|
|
|
procedure TMsgsFrm.MsgListMeasureItem(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode; var NodeHeight: Integer);
|
|
var
|
|
r: TRect;
|
|
s: string;
|
|
m: Pmsg;
|
|
// l : Integer;
|
|
begin
|
|
r := Rect(0, 0, Sender.ClientWidth, 0);
|
|
m := Pmsg(Sender.GetNodeData(Node));
|
|
if m = nil then
|
|
begin
|
|
NodeHeight := 1;
|
|
Exit;
|
|
end;
|
|
|
|
s := m.text;
|
|
if s = '' then
|
|
begin
|
|
NodeHeight := 1;
|
|
Exit;
|
|
end;
|
|
s := '000' + CRLF + s;
|
|
Inc(r.Left, GAP_X);
|
|
Dec(r.Right, GAP_X);
|
|
Inc(r.Top, GAP_Y);
|
|
with theme.GetPicSize(RQteDefault, IconNames[m.kind]) do
|
|
begin
|
|
NodeHeight := GAP_Y + cy + 5;
|
|
if cy > 32 then
|
|
Inc(r.Left, 10 + cx)
|
|
else
|
|
Inc(r.Left, 5 + cx);
|
|
end;
|
|
DrawText(TargetCanvas.Handle, PChar(s), -1, r, DT_EDITCONTROL or DT_WORDBREAK or DT_EXTERNALLEADING or DT_NOPREFIX or DT_CALCRECT);
|
|
NodeHeight := Max(r.Bottom + GAP_Y + 2, NodeHeight);
|
|
end;
|
|
|
|
procedure TMsgsFrm.FormClose(Sender: TObject; var Action: TCloseAction);
|
|
begin
|
|
try
|
|
FTimer.Enabled := False;
|
|
MsgList.Clear;
|
|
// setlength(msgs, 0);
|
|
except
|
|
|
|
end;
|
|
end;
|
|
|
|
procedure TMsgsFrm.FormCreate(Sender: TObject);
|
|
const
|
|
BottomHeight = 40;
|
|
begin
|
|
MsgList := TVirtualDrawTree.Create(Self);
|
|
Self.InsertComponent(MsgList);
|
|
with MsgList do
|
|
begin
|
|
BorderStyle := bsNone;
|
|
Parent := Self;
|
|
Left := 0;
|
|
Top := 0;
|
|
Width := Self.ClientWidth - GAP_X - GAP_X;
|
|
Height := Self.ClientHeight - BottomHeight - GAP_Y;
|
|
Align := alTop;
|
|
Anchors := [akLeft, akTop, akRight, akBottom];
|
|
DrawSelectionMode := smBlendedRectangle;
|
|
Colors.UnfocusedSelectionColor := clInactiveCaption;
|
|
Colors.FocusedSelectionColor := clInactiveCaption;
|
|
Colors.SelectionRectangleBlendColor := clInactiveCaption;
|
|
DefaultNodeHeight := 1;
|
|
{
|
|
Header.AutoSizeIndex = 0;
|
|
Header.Font.Charset = DEFAULT_CHARSET;
|
|
Header.Font.Color = clWindowText;
|
|
Header.Font.Height = -11;
|
|
Header.Font.Name = 'Tahoma';
|
|
Header.Font.Style = [];
|
|
Header.MainColumn = -1;
|
|
}
|
|
Header.Options := [hoColumnResize, hoDrag];
|
|
TabOrder := 0;
|
|
TreeOptions.AutoOptions := [toAutoDropExpand, toAutoScrollOnExpand, toAutoSort, toAutoTristateTracking,
|
|
toAutoDeleteMovedNodes];
|
|
TreeOptions.MiscOptions := [toAcceptOLEDrop, toFullRepaintOnResize, toGridExtensions, toInitOnSave, toReportMode,
|
|
toToggleOnDblClick, toWheelPanning, toVariableNodeHeight];
|
|
TreeOptions.PaintOptions := [toHideFocusRect, toShowButtons, toShowDropmark, toShowHorzGridLines, toShowRoot, toThemeAware,
|
|
toUseBlendedImages, toUseBlendedSelection];
|
|
TreeOptions.SelectionOptions := TreeOptions.SelectionOptions + [toFullRowSelect, toRightClickSelect];
|
|
OnCompareNodes := MsgListCompareNodes;
|
|
OnDrawNode := MsgListDrawNode;
|
|
OnMeasureItem := MsgListMeasureItem;
|
|
// Columns := <>
|
|
NodeDataSize := SizeOf(Tmsg);
|
|
end;
|
|
OkBtn := TRnQButton.Create(Self);
|
|
Self.InsertComponent(OkBtn);
|
|
with OkBtn do
|
|
begin
|
|
Parent := Self;
|
|
Left := Round((Self.ClientWidth - Width) / 2);
|
|
Top := Self.ClientHeight - BottomHeight + ((BottomHeight - 25) div 2);
|
|
Width := 89;
|
|
Height := 25;
|
|
Anchors := [akBottom];
|
|
Default := True;
|
|
ModalResult := 1;
|
|
TabOrder := 1;
|
|
OnClick := OkBtnClick;
|
|
ImageName := 'ok';
|
|
end;
|
|
|
|
MsgList.Clear;
|
|
menu := TRnQPopupMenu.Create(Self);
|
|
AddToMenu(menu.Items, 'Copy', 'copy', True, CopyText);
|
|
// OpenChatM := AddToMenu(menu.Items, 'Open chat',
|
|
// PIC_MSG, False, OpenChat);
|
|
OpenChatM := AddToMenu(menu.Items, 'Copy UIN', 'copy', True, OpenChat);
|
|
menu.OnPopup := menuPopup;
|
|
MsgList.PopupMenu := menu;
|
|
|
|
FSeconds := 0;
|
|
FTimer := TTimer.Create(Self);
|
|
FTimer.OnTimer := OnTimer;
|
|
ApplyTaskButton(Self);
|
|
end;
|
|
|
|
procedure TMsgsFrm.OkBtnClick(Sender: TObject);
|
|
begin
|
|
ModalResult := mrOk;
|
|
close;
|
|
end;
|
|
|
|
procedure TMsgsFrm.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
|
|
begin
|
|
if (Key = VK_CANCEL) or (Key = VK_ESCAPE) or (Key = VK_RETURN) or (Key = VK_ACCEPT) then
|
|
OkBtnClick(nil);
|
|
end;
|
|
|
|
procedure TMsgsFrm.FormResize(Sender: TObject);
|
|
var
|
|
Node: PVirtualNode;
|
|
begin
|
|
OkBtn.Left := Round((ClientWidth - OkBtn.Width) / 2);
|
|
|
|
Node := MsgList.GetFirst;
|
|
while Assigned(Node) do
|
|
begin
|
|
Exclude(Node.States, vsHeightMeasured);
|
|
Node := MsgList.GetNextSibling(Node)
|
|
end;
|
|
end;
|
|
|
|
procedure TMsgsFrm.FormShow(Sender: TObject);
|
|
begin
|
|
Caption := GetTranslation(getTranslation(LoadResString(Captions[msgKind])) + ' (%s)', [rnquser]);
|
|
OkBtn.Caption := SMsgDlgOK + ' (' + IntToStr(FSeconds) + ')';
|
|
FTimer.Enabled := True;
|
|
end;
|
|
|
|
procedure TMsgsFrm.MenuPopup(Sender: TObject);
|
|
begin
|
|
end;
|
|
|
|
procedure TMsgsFrm.OpenChat(Sender: TObject);
|
|
var
|
|
s: String;
|
|
begin
|
|
with MsgList do
|
|
if Assigned(FocusedNode) then
|
|
begin
|
|
s := Pmsg(GetNodeData(FocusedNode)).UID;
|
|
ConvertAllNewlinesToCRLF(s);
|
|
Clipboard.AsText := s;
|
|
end;
|
|
end;
|
|
|
|
procedure TMsgsFrm.AddMsg(const msg: String; kind: TMsgDlgType; vTime: TDateTime; const uid: String);
|
|
var
|
|
vmsg: Pmsg;
|
|
n: PVirtualNode;
|
|
SetFirst: boolean;
|
|
begin
|
|
if MsgList.FocusedNode = MsgList.GetFirst then
|
|
SetFirst := True
|
|
else
|
|
SetFirst := False;
|
|
MsgList.BeginUpdate;
|
|
n := MsgList.AddChild(nil);
|
|
vmsg := MsgList.GetNodeData(n);
|
|
vmsg.text := msg;
|
|
vmsg.kind := kind;
|
|
vmsg.time := vTime;
|
|
vmsg.uid := uid;
|
|
n.States := n.States - [vsHeightMeasured];
|
|
MsgList.MeasureItemHeight(MsgList.Canvas, n);
|
|
MsgList.EndUpdate;
|
|
FSeconds := max(MsgShowTime[kind], FSeconds);
|
|
// vmsg := nil;
|
|
if SetFirst then
|
|
begin
|
|
MsgList.ClearSelection;
|
|
MsgList.FocusedNode := n;
|
|
MsgList.Selected[n] := True;
|
|
end;
|
|
theme.pic2ico(RQteFormIcon, '', Self.Icon);
|
|
// theme.GetIco2(iconNames[kind], Self.Icon);
|
|
if not Self.Visible then
|
|
ShowForm(Self)
|
|
else
|
|
MsgList.InvalidateNode(n);
|
|
end;
|
|
|
|
procedure TMsgsFrm.CopyText(Sender: TObject);
|
|
var
|
|
s: String;
|
|
begin
|
|
with MsgList do
|
|
if Assigned(FocusedNode) then
|
|
begin
|
|
s := Pmsg(GetNodeData(FocusedNode)).Text;
|
|
ConvertAllNewlinesToCRLF(s);
|
|
Clipboard.AsText := s;
|
|
end;
|
|
end;
|
|
|
|
end.
|