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.
336 lines
9.2 KiB
Plaintext
336 lines
9.2 KiB
Plaintext
{
|
|
This file is part of R&Q.
|
|
Under same license
|
|
}
|
|
unit StatusForm;
|
|
{$I RnQConfig.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
|
|
ExtCtrls, StdCtrls, ComCtrls, StrUtils, RnQButtons, ICQSession;
|
|
|
|
{$I NoRTTI.inc}
|
|
|
|
type
|
|
TStsBtn = TRnQSpeedButton;
|
|
|
|
type
|
|
TxStatusForm = class(TForm)
|
|
xStatusName: TEdit;
|
|
Bevel1: TBevel;
|
|
XStatusStrMemo: TMemo;
|
|
xSetButton: TRnQButton;
|
|
SBar: TStatusBar;
|
|
OldxStChk: TCheckBox;
|
|
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
|
|
procedure FormClose(Sender: TObject; var Action: TCloseAction);
|
|
procedure FormShow(Sender: TObject);
|
|
procedure xSetButtonClick(Sender: TObject);
|
|
procedure XStatusStrMemoChange(Sender: TObject);
|
|
procedure FormDestroy(Sender: TObject);
|
|
private
|
|
BtnWidth: Integer;
|
|
BtnHeight: Integer;
|
|
thisProto: TICQSession;
|
|
xStatusbuttons: array of TStsBtn;
|
|
procedure ChoosingX(Sender: TObject);
|
|
procedure DblClk(Sender: TObject);
|
|
{ Private declarations }
|
|
procedure Init;
|
|
procedure SetNameVis;
|
|
public
|
|
{ Public declarations }
|
|
// procedure ShowNear(icq : TICQSession; mR: TRect; X, Y: Integer);
|
|
procedure ShowNear(mR: TRect; X, Y: Integer);
|
|
// constructor ShowNear2(owner_ :Tcomponent; proto : IRnQProtocol; mR: TRect; X, Y: Integer);
|
|
// constructor ShowNear2(owner_ :TWinControl; proto : IRnQProtocol; mR: TRect; X, Y: Integer);
|
|
class procedure ShowNear2(owner_: TWinControl; const proto: TICQSession; mR: TRect; X, Y: Integer);
|
|
end;
|
|
|
|
function OpenedXStForm: Boolean;
|
|
|
|
var
|
|
// xStatusForm: TxStatusForm;
|
|
// xStatusbuttons: array [low(aXStatus)..High(aXStatus)] of TStsBtn;
|
|
// xStatusbuttons: array [low(XStatus6)..High(XStatus6)] of TStsBtn;
|
|
// xStatus6buttons: array [0..XStatus6Count-1] of TStsBtn;
|
|
tempStatus: Byte;
|
|
|
|
implementation
|
|
|
|
uses
|
|
Types,
|
|
RDGlobal, RDUtils, RnQLangs, RQThemes, RnQGraphics32,
|
|
utilLib, langLib, GlobalLib,
|
|
Protocol_ICQ, ICQConsts,
|
|
mainDlg;
|
|
|
|
{$R *.dfm}
|
|
|
|
procedure TxStatusForm.FormClose(Sender: TObject; var Action: TCloseAction);
|
|
begin
|
|
saveListsDelayed := True;
|
|
if Assigned(childWindows) then
|
|
childWindows.remove(self);
|
|
Action := caFree;
|
|
// SaveExtSts;
|
|
end;
|
|
|
|
procedure TxStatusForm.SetNameVis;
|
|
begin
|
|
begin
|
|
xStatusName.Visible := False;
|
|
xSetButton.Left := Bevel1.Left;
|
|
xSetButton.Width := Bevel1.Width + 1;
|
|
xSetButton.Anchors := [akRight, akTop, akLeft];
|
|
end
|
|
end;
|
|
|
|
procedure TxStatusForm.Init;
|
|
var
|
|
X: Integer;
|
|
BtnsInRow: Integer;
|
|
procedure addBtn(X: Integer);
|
|
var
|
|
k: Integer;
|
|
curBtn: TStsBtn;
|
|
begin
|
|
k := Length(xStatusbuttons);
|
|
curBtn := TStsBtn.create(Bevel1);
|
|
with curBtn do
|
|
begin
|
|
parent := self;
|
|
height := BtnHeight;
|
|
Width := BtnWidth;
|
|
Top := Bevel1.Top + 7 + (BtnHeight + 3) * ((k) div BtnsInRow);
|
|
Left := Bevel1.Left + 7 + (BtnWidth + 4) * ((k) mod BtnsInRow);
|
|
GroupIndex := 1;
|
|
Flat := True;
|
|
ImageName := XStatusArray[X].PicName;
|
|
Hint := XStatusArray[X].Caption;
|
|
Enabled := True;
|
|
Visible := Enabled;
|
|
ShowHint := True;
|
|
Tag := X;
|
|
OnClick := ChoosingX;
|
|
OnDblClick := DblClk;
|
|
end;
|
|
SetLength(xStatusbuttons, k + 1);
|
|
xStatusbuttons[k] := curBtn;
|
|
end;
|
|
|
|
begin
|
|
if showNewXStatuses then
|
|
BtnsInRow := 13
|
|
else
|
|
BtnsInRow := 9;
|
|
|
|
with theme.GetPicSize(RQteButton, status2imgName(Byte(SC_ONLINE)), icon_size) do
|
|
begin
|
|
BtnHeight := bound(cy, icon_size, icon_size*2) + 8;
|
|
BtnWidth := bound(cx, icon_size, icon_size*2) + 8;
|
|
end;
|
|
|
|
OldxStChk.Visible := False;
|
|
for X := low(XStatusArray) to High(XStatusArray) do
|
|
if (xsf_6 in XStatusArray[X].flags) then
|
|
if (showNewXStatuses or (not showNewXStatuses and (xsf_Old in XStatusArray[X].flags))) then
|
|
if not(StartsText('status_', XStatusArray[X].pid6)) then
|
|
addBtn(X);
|
|
|
|
Bevel1.Height := 12 + (round((High(xStatusbuttons) + 2) / BtnsInRow)) * (BtnHeight + 3);
|
|
ClientWidth := 22 + 4 + BtnsInRow * (BtnWidth + 4);
|
|
Bevel1.Width := clientwidth - 16;
|
|
XStatusStrMemo.Top := Bevel1.Top + Bevel1.Height + 8;
|
|
XStatusStrMemo.Height := SBar.Top - 10 - XStatusStrMemo.Top;
|
|
XStatusStrMemo.Width := Bevel1.Width - 1;
|
|
//ClientHeight := XStatusStrMemo.Top + XStatusStrMemo.Height + 6 + SBar.Height;
|
|
ClientHeight := XStatusStrMemo.Top + 90;
|
|
Self.Constraints.MinHeight := Height;
|
|
Self.Constraints.MinWidth := Width;
|
|
|
|
SetNameVis;
|
|
end;
|
|
|
|
procedure TxStatusForm.FormDestroy(Sender: TObject);
|
|
// var
|
|
// btn : TStsBtn;
|
|
begin
|
|
// for btn in xStatusButtons do
|
|
// btn.Free;
|
|
SetLength(xStatusbuttons, 0);
|
|
end;
|
|
|
|
procedure TxStatusForm.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
|
|
begin
|
|
// if key = VK_RETURN then
|
|
// xSetButtonClick(sender)
|
|
// else
|
|
if Key = VK_ESCAPE then
|
|
close;
|
|
end;
|
|
|
|
procedure TxStatusForm.FormShow(Sender: TObject);
|
|
var
|
|
// i:integer;
|
|
btn: TStsBtn;
|
|
begin
|
|
tempStatus := thisProto.getXStatus;
|
|
for btn in xStatusbuttons do
|
|
if (tempStatus = btn.Tag) and btn.Enabled then
|
|
btn.down := True;
|
|
// xstatusname.text:=curXStatusStr;
|
|
// XStatusStrMemo.Text := curXStatusDesc;
|
|
xStatusName.text := ExtStsStrings[tempStatus].Cap;
|
|
XStatusStrMemo.text := ExtStsStrings[tempStatus].Desc;
|
|
XStatusStrMemoChange(XStatusStrMemo);
|
|
(*
|
|
begin
|
|
xStatusName.Visible := False;
|
|
xSetButton.Left := XStatusStrMemo.Left;
|
|
xSetButton.Width := XStatusStrMemo.Width;
|
|
end *)
|
|
end;
|
|
|
|
procedure TxStatusForm.xSetButtonClick(Sender: TObject);
|
|
begin
|
|
thisProto.SendStatusStr(tempStatus, XStatusStrMemo.text);
|
|
self.ModalResult := mrOK;
|
|
end;
|
|
|
|
procedure TxStatusForm.XStatusStrMemoChange(Sender: TObject);
|
|
begin
|
|
SBar.panels[0].text := getTranslation('Chars:') + ' ' + IntToStr(Length(XStatusStrMemo.text));
|
|
SBar.panels[1].text := getTranslation('left:') + ' ' + IntToStr(MaxXStatusDescLen - Length(UTF(XStatusStrMemo.text)));
|
|
end;
|
|
|
|
procedure TxStatusForm.DblClk(Sender: TObject);
|
|
begin
|
|
ChoosingX(Sender);
|
|
xSetButtonClick(NIL);
|
|
// self.ModalResult:=mrOK;
|
|
end;
|
|
|
|
procedure TxStatusForm.ChoosingX(Sender: TObject);
|
|
begin
|
|
if xStatusName.text <> ExtStsStrings[tempStatus].Cap then
|
|
ExtStsStrings[tempStatus].Cap := Copy(xStatusName.text, 1, MaxXStatusLen);
|
|
if XStatusStrMemo.text <> ExtStsStrings[tempStatus].Desc then
|
|
ExtStsStrings[tempStatus].Desc := Copy(XStatusStrMemo.text, 1, MaxXStatusDescLen);
|
|
|
|
tempStatus := TStsBtn(Sender).Tag;
|
|
XStatusStrMemo.Clear;
|
|
|
|
xStatusName.text := ExtStsStrings[tempStatus].Cap;
|
|
XStatusStrMemo.text := ExtStsStrings[tempStatus].Desc;
|
|
XStatusStrMemoChange(XStatusStrMemo);
|
|
end;
|
|
|
|
procedure TxStatusForm.ShowNear(mR: TRect; X, Y: Integer);
|
|
var
|
|
MonRect: TRect;
|
|
P: TPoint;
|
|
begin
|
|
P.X := X;
|
|
P.Y := Y;
|
|
MonRect := Screen.MonitorFromPoint(P).WorkareaRect;
|
|
if rosterbarOnTop then
|
|
begin
|
|
if mR.Top - self.height < MonRect.Top then
|
|
begin
|
|
self.Top := mR.Top;
|
|
if (mR.Left - self.Width) < MonRect.Left then
|
|
self.Left := mR.Right
|
|
else
|
|
self.Left := mR.Left - self.Width;
|
|
end
|
|
else
|
|
begin
|
|
self.Top := mR.Top - self.height;
|
|
if (mR.Left + self.Width) > MonRect.Right then
|
|
self.Left := MonRect.Right - self.Width
|
|
else
|
|
self.Left := mR.Left;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
if mR.Bottom + self.height > MonRect.Bottom then
|
|
begin
|
|
self.Top := mR.Bottom - self.height;
|
|
if (mR.Left - self.Width) < MonRect.Left then
|
|
if (mR.Right + self.Width) < MonRect.Right then
|
|
self.Left := mR.Right // + self.Width
|
|
else
|
|
self.Left := mR.Right - self.Width
|
|
else
|
|
self.Left := mR.Left - self.Width;
|
|
end
|
|
else
|
|
begin
|
|
self.Top := mR.Bottom;
|
|
if (mR.Left + self.Width) > MonRect.Right then
|
|
self.Left := MonRect.Right - self.Width
|
|
else
|
|
self.Left := mR.Left;
|
|
end;
|
|
end;
|
|
try
|
|
// Self.
|
|
if not Visible then
|
|
ShowModal
|
|
// Show
|
|
else
|
|
Show;
|
|
except
|
|
|
|
end;
|
|
end;
|
|
|
|
// constructor TxStatusForm.ShowNear2(owner_ :Tcomponent; proto : IRnQProtocol; mR: TRect; X, Y: Integer);
|
|
// constructor TxStatusForm.ShowNear2(owner_ :TWinControl; proto : IRnQProtocol; mR: TRect; X, Y: Integer);
|
|
class Procedure TxStatusForm.ShowNear2(owner_: TWinControl; const proto: TICQSession; mR: TRect; X, Y: Integer);
|
|
var
|
|
xStForm: TxStatusForm;
|
|
begin
|
|
if not Assigned(proto) then
|
|
Exit;
|
|
|
|
xStForm := TxStatusForm.create(owner_);
|
|
xStForm.thisProto := proto;
|
|
xStForm.Init;
|
|
translateWindow(xStForm);
|
|
// xStForm.ShowNear(TicqSession(proto.ProtoElem), mR, x, y);
|
|
childWindows.Add(xStForm);
|
|
|
|
xStForm.ShowNear(mR, X, Y);
|
|
// xStForm.Free;
|
|
end;
|
|
|
|
function OpenedXStForm: Boolean;
|
|
var
|
|
i: Integer;
|
|
c: TComponent;
|
|
begin
|
|
if Assigned(childWindows) then
|
|
with childWindows do
|
|
begin
|
|
i := 0;
|
|
while i < count do
|
|
begin
|
|
c := items[i];
|
|
if TObject(c) is TxStatusForm then
|
|
begin
|
|
result := True;
|
|
Exit;
|
|
end;
|
|
inc(i);
|
|
end;
|
|
end;
|
|
result := False;
|
|
end; // OpenedXStForm
|
|
|
|
end.
|