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.
RnQ/for.RnQ/RQmsgs.pas

387 lines
11 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 FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure OkBtnClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure msgListFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
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(msg: string; kind: TMsgDlgType; vTime: TDateTime; const uid: AnsiString = '');
end;
var
msgsFrm: TmsgsFrm;
msgKind: TMsgDlgType;
implementation
{$R *.dfm}
uses
Clipbrd, math, Types, // uiTypes,
RDUtils, RQUtil, RnQlangs, RQThemes, RnQMenu, RnQDialogs,
RnQSysUtils, RnQGlobal;
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, ic: string;
isFirst, selected: boolean;
r: TRect;
clr: TColor;
begin
selected := vsSelected in PaintInfo.Node^.States;
isFirst := PaintInfo.Node = msgList.GetFirst;
r := PaintInfo.CellRect;
// PaintInfo.Canvas.fillrect(r);
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
begin
with theme.drawPic(PaintInfo.Canvas.Handle, r.left, r.Top - GAP_Y + 2, IconNames[kind], isFirst) do
// with theme.getPicSize(RQteDefault, IconNames[kind], 16) do
begin
s := datetimeToStr(time) + CRLF;
if cy > 32 then
inc(r.left, 10 + cx)
else
begin
inc(r.left, 5 + cx);
// ic := StringOfChar(' ', 2 + cx div PaintInfo.Canvas.TextWidth(' '));
// s := ic + s;
// if cy > 16 then
// s := s + ic;
end;
s := s + text;
SetBkMode(PaintInfo.Canvas.Handle, TRANSPARENT);
DrawText(PaintInfo.Canvas.Handle, pchar(s), -1, r, DT_WORDBREAK + DT_EXTERNALLEADING + DT_NOPREFIX);
end;
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;
// if Tmsg(Pmsg(sender.getnodedata(node))^).text = '' then
// Exit;
s := m.text;
// s := Pmsg(sender.getnodedata(node))^.text;
// l := Length(msgs)-index-1;
// s:=msgs[l].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 := cy + 5;
inc(r.left, cx);
if cy > 16 then
Dec(r.Right, cx);
end;
// r.Bottom := 1000;
DrawText(TargetCanvas.Handle, pchar(s), -1, r, DT_WORDBREAK or DT_EXTERNALLEADING or DT_NOPREFIX or DT_CALCRECT);
NodeHeight := max(r.Bottom + GAP_Y, 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);
begin
OkBtn.left := Round((ClientWidth - OkBtn.Width) / 2);
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
{ if Assigned(MainProto) then
begin
with msgList do
if focusedNode<>NIL then
b := Pmsg(getnodedata(focusednode)).UID > '';
end;
if Assigned(OpenChatM) then
OpenChatM.Visible := b;
}
end;
procedure TmsgsFrm.openChat(Sender: TObject);
var
// cnt : TRnQContact;
s: String;
begin
{ cnt := NIL;
if Assigned(MainProto) then
begin
with msgList do
if focusedNode<>NIL then
cnt := mainProto.getContact(Pmsg(getnodedata(focusednode)).UID);
chatFrm.openOn(cnt);
end; }
with msgList do
if focusedNode <> NIL then
begin
s := Pmsg(getnodedata(focusedNode)).uid;
convertAllNewlinesToCRLF(s);
clipboard.asText := s;
end;
end;
procedure TmsgsFrm.AddMsg(msg: string; kind: TMsgDlgType; vTime: TDateTime; const uid: AnsiString);
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 focusedNode <> NIL then
begin
s := Pmsg(getnodedata(focusedNode)).text;
convertAllNewlinesToCRLF(s);
clipboard.asText := s;
end;
end;
end.