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.
427 lines
10 KiB
Plaintext
427 lines
10 KiB
Plaintext
{
|
|
This file is part of R&Q.
|
|
Under same license
|
|
}
|
|
unit ViewPicDimmedDlg;
|
|
{$I RnQConfig.inc}
|
|
{$I NoRTTI.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
Windows, SysUtils, Graphics, Classes, ExtCtrls, Themes,
|
|
Forms, StdCtrls, Controls, Menus, Generics.Collections,
|
|
ComCtrls, Messages, RnQGraphics32, AnsiClasses, Vcl.Imaging.GIFImg;
|
|
|
|
const
|
|
WM_FADEOUT = WM_USER + 1;
|
|
|
|
type
|
|
TOnTimerProc = reference to procedure;
|
|
TOneShotTimer = class
|
|
ID: UINT_PTR;
|
|
Proc: TOnTimerProc;
|
|
end;
|
|
|
|
TFormEx = class(TForm)
|
|
private
|
|
AnimTimer: TTimer;
|
|
AlphaValue: Integer;
|
|
Dimmed: Boolean;
|
|
LastImage: Integer;
|
|
ShownImage: Integer;
|
|
procedure onAnimTimer(Sender: TObject);
|
|
procedure OnCloseImg(Sender: TObject; var Action: TCloseAction);
|
|
procedure OnKeyDownImg(Sender: TObject; var Key: Word; Shift: TShiftState);
|
|
procedure OnMouseDownImg(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
|
procedure UpdateShownImage();
|
|
procedure ShowHideImages();
|
|
procedure UpdateFormSize();
|
|
procedure FadeOutMsg(var Msg: TMessage); message WM_FADEOUT;
|
|
procedure WMAppCommand(var msg: TMessage); message WM_APPCOMMAND;
|
|
public
|
|
otherForm: HWND;
|
|
procedure FadeOut;
|
|
procedure ShowWithFade();
|
|
procedure startTimer();
|
|
procedure stopTimer();
|
|
//procedure updateWindow();
|
|
procedure CreateParams(var Params: TCreateParams); override;
|
|
constructor CreateNew(AOwner: TComponent; DimmedParam: Boolean = False);
|
|
end;
|
|
|
|
function viewImageDimmed(evimage: RawByteString; evoffset: Integer): Tform;
|
|
procedure SetTimeout(AProc: TOnTimerProc; ATimeout: Cardinal);
|
|
|
|
implementation
|
|
|
|
uses
|
|
globalLib, utilLib, Base64, chatDlg, cgJpeg;
|
|
|
|
var
|
|
TimerList: TDictionary |
|
|
|
procedure TFormEx.onAnimTimer(Sender: TObject);
|
|
begin
|
|
if AnimTimer.Tag = 1 then
|
|
begin
|
|
if (AlphaValue > 0) and Assigned(self) and self.HandleAllocated then
|
|
try
|
|
if not Dimmed or (Dimmed and (AlphaValue <= 200)) then
|
|
SetLayeredWindowAttributes(handle, 0, AlphaValue, LWA_ALPHA);
|
|
Dec(AlphaValue, 33);
|
|
except
|
|
stopTimer()
|
|
end
|
|
else
|
|
stopTimer();
|
|
end
|
|
else
|
|
begin
|
|
if (((AlphaValue <= 255) and not Dimmed) or ((AlphaValue <= 200) and Dimmed)) and Assigned(self) and self.HandleAllocated then
|
|
try
|
|
SetLayeredWindowAttributes(handle, 0, AlphaValue, LWA_ALPHA);
|
|
Inc(AlphaValue, 25);
|
|
except
|
|
stopTimer()
|
|
end
|
|
else
|
|
stopTimer();
|
|
end;
|
|
end;
|
|
|
|
procedure TimerProc(hwnd: HWND; uMsg: UINT; idEvent: UINT_PTR; dwTime: DWORD); stdcall;
|
|
var
|
|
Proc: TOnTimerProc;
|
|
begin
|
|
if TimerList.TryGetValue(idEvent, Proc) then
|
|
try
|
|
KillTimer(0, idEvent);
|
|
Proc();
|
|
finally
|
|
TimerList.Remove(idEvent);
|
|
end;
|
|
end;
|
|
|
|
procedure SetTimeout(AProc: TOnTimerProc; ATimeout: Cardinal);
|
|
begin
|
|
TimerList.Add(SetTimer(0, 0, ATimeout, @TimerProc), AProc);
|
|
end;
|
|
|
|
procedure TFormEx.ShowWithFade();
|
|
begin
|
|
try
|
|
Show;
|
|
Invalidate;
|
|
if Dimmed then
|
|
startTimer()
|
|
else
|
|
SetTimeout(procedure begin startTimer(); end, 100);
|
|
except
|
|
end;
|
|
end;
|
|
|
|
procedure TFormEx.startTimer();
|
|
begin
|
|
if (Assigned(AnimTimer)) then
|
|
AnimTimer.Enabled := true;
|
|
end;
|
|
|
|
procedure TFormEx.stopTimer();
|
|
begin
|
|
if (Assigned(AnimTimer)) then
|
|
AnimTimer.Enabled := false;
|
|
|
|
if AnimTimer.Tag = 1 then
|
|
Close
|
|
else
|
|
AlphaValue := 255;
|
|
end;
|
|
{
|
|
procedure TFormEx.updateWindow();
|
|
var
|
|
Bitmap: TBitmap;
|
|
BitmapPos: TPoint;
|
|
BitmapSize: TSIZE;
|
|
BlendFunction: _BLENDFUNCTION;
|
|
begin
|
|
Bitmap := TBitmap.Create;
|
|
Bitmap.PixelFormat := pf32bit;
|
|
Bitmap.SetSize(1920, 1080);
|
|
Bitmap.Canvas.Brush.Color := clRed;
|
|
Bitmap.Canvas.FillRect(Rect(0, 0, Bitmap.Width, Bitmap.Height));
|
|
|
|
BitmapPos := Point(0, 0);
|
|
BitmapSize.cx := 1920;
|
|
BitmapSize.cy := 1080;
|
|
BlendFunction.BlendOp := AC_SRC_OVER;
|
|
BlendFunction.BlendFlags := 0;
|
|
BlendFunction.SourceConstantAlpha := 127;
|
|
BlendFunction.AlphaFormat := AC_SRC_ALPHA;
|
|
UpdateLayeredWindow(Handle, 0, nil, @BitmapSize, Bitmap.Canvas.Handle, @BitmapPos, 0, @BlendFunction, ULW_ALPHA);
|
|
|
|
Bitmap.Free;
|
|
end;
|
|
}
|
|
procedure TFormEx.CreateParams(var Params: TCreateParams);
|
|
begin
|
|
inherited;
|
|
Params.ExStyle := Params.ExStyle or WS_EX_NOACTIVATE;
|
|
end;
|
|
|
|
constructor TFormEx.CreateNew(AOwner: TComponent; DimmedParam: Boolean = False);
|
|
begin
|
|
inherited CreateNew(AOwner);
|
|
Dimmed := DimmedParam;
|
|
|
|
if StyleServices.Enabled and Assigned(self) then
|
|
begin
|
|
SetWindowLong(handle, GWL_EXSTYLE, GetWindowLong(handle, GWL_EXSTYLE) or WS_EX_LAYERED);
|
|
SetLayeredWindowAttributes(Handle, 0, 0, LWA_ALPHA);
|
|
end;
|
|
|
|
DoubleBuffered := True;
|
|
BorderStyle := bsNone;
|
|
KeyPreview := True;
|
|
OnClose := OnCloseImg;
|
|
OnKeyDown := OnKeyDownImg;
|
|
OnMouseDown := OnMouseDownImg;
|
|
if not Dimmed then
|
|
begin
|
|
FormStyle := fsStayOnTop;
|
|
SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOSIZE or SWP_NOMOVE or SWP_NOACTIVATE);
|
|
end;
|
|
|
|
alphaValue := 0;
|
|
animTimer := TTimer.Create(AOwner);
|
|
animTimer.Enabled := false;
|
|
animTimer.OnTimer := onAnimTimer;
|
|
animTimer.Interval := 10;
|
|
animTimer.Tag := 0;
|
|
end;
|
|
|
|
procedure TFormEx.FadeOut();
|
|
begin
|
|
animTimer.Tag := 1;
|
|
animTimer.Interval := 10;
|
|
animTimer.Enabled := true;
|
|
end;
|
|
|
|
procedure TFormEx.FadeOutMsg(var Msg: TMessage);
|
|
begin
|
|
FadeOut;
|
|
end;
|
|
|
|
procedure TFormEx.WMAppCommand(var msg: TMessage);
|
|
begin
|
|
if Dimmed then
|
|
PostMessage(otherForm, WM_APPCOMMAND, msg.WParam, msg.LParam)
|
|
else
|
|
case GET_APPCOMMAND_LPARAM(msg.LParam) of
|
|
APPCOMMAND_BROWSER_BACKWARD:
|
|
begin
|
|
dec(ShownImage);
|
|
if ShownImage < 0 then ShownImage := LastImage;
|
|
UpdateShownImage;
|
|
msg.Result := 1;
|
|
end;
|
|
|
|
APPCOMMAND_BROWSER_FORWARD:
|
|
begin
|
|
inc(ShownImage);
|
|
if ShownImage > LastImage then ShownImage := 0;
|
|
UpdateShownImage;
|
|
msg.Result := 1;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TFormEx.ShowHideImages();
|
|
var
|
|
i: integer;
|
|
begin
|
|
for i := 0 to ControlCount - 1 do
|
|
if i = ShownImage then
|
|
begin
|
|
Controls[i].Show;
|
|
if Controls[i].Tag = 3 then
|
|
try
|
|
// Remove flickering, animated GIFs only, doublebuffering messes up PNGs with alpha
|
|
if (((Controls[i] as TImageEx).Picture.Graphic as TGIFImage).Images.Count > 1) then
|
|
DoubleBuffered := True
|
|
else
|
|
DoubleBuffered := False;
|
|
except end else
|
|
DoubleBuffered := False;
|
|
end else
|
|
Controls[i].Hide;
|
|
end;
|
|
|
|
procedure TFormEx.UpdateShownImage();
|
|
begin
|
|
if Dimmed or (ControlCount = 1) then Exit;
|
|
|
|
AnimateWindow(Handle, 150, AW_BLEND or AW_HIDE);
|
|
ShowHideImages;
|
|
UpdateFormSize;
|
|
AnimateWindow(Handle, 150, AW_BLEND);
|
|
end;
|
|
|
|
procedure TFormEx.UpdateFormSize();
|
|
var
|
|
aspect: single;
|
|
offset: integer;
|
|
img: TImageEx;
|
|
bRect: TRect;
|
|
begin
|
|
if ControlCount = 0 then Exit;
|
|
|
|
if Assigned(chatFrm) then
|
|
bRect := Screen.MonitorFromWindow(chatFrm.Handle).BoundsRect
|
|
else
|
|
bRect := Screen.Monitors[0].BoundsRect;
|
|
|
|
img := (Controls[ShownImage] as TImageEx);
|
|
aspect := img.Width / img.Height;
|
|
|
|
if img.Height > bRect.Height - 50 then
|
|
begin
|
|
img.AutoSize := False;
|
|
img.Height := bRect.Height - 50;
|
|
img.Width := round(img.Height * aspect);
|
|
end;
|
|
|
|
if img.Width > bRect.Width - 50 then
|
|
begin
|
|
img.AutoSize := False;
|
|
img.Width := bRect.Width - 50;
|
|
img.Height := round(img.Width / aspect);
|
|
end;
|
|
|
|
Left := Round(bRect.Width / 2 - img.Width / 2);
|
|
Top := Round(bRect.Height / 2 - img.Height / 2);
|
|
Width := img.Width;
|
|
Height := img.Height;
|
|
end;
|
|
|
|
procedure TFormEx.OnKeyDownImg(Sender: TObject; var Key: Word; Shift: TShiftState);
|
|
begin
|
|
if Dimmed then
|
|
PostMessage(otherForm, WM_KEYDOWN, Key, 0)
|
|
else
|
|
if (Key = VK_RIGHT) or (Key = VK_NEXT) or (Key = VK_UP) then
|
|
begin
|
|
inc(ShownImage);
|
|
if ShownImage > LastImage then ShownImage := 0;
|
|
UpdateShownImage;
|
|
end
|
|
else
|
|
if (Key = VK_LEFT) or (Key = VK_PRIOR) or (Key = VK_DOWN) then
|
|
begin
|
|
dec(ShownImage);
|
|
if ShownImage < 0 then ShownImage := LastImage;
|
|
UpdateShownImage;
|
|
end
|
|
else
|
|
begin
|
|
PostMessage(otherForm, WM_FADEOUT, 0, 0);
|
|
FadeOut;
|
|
end;
|
|
end;
|
|
|
|
procedure TFormEx.OnMouseDownImg(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
|
begin
|
|
PostMessage(otherForm, WM_FADEOUT, 0, 0);
|
|
FadeOut;
|
|
end;
|
|
|
|
procedure TFormEx.OnCloseImg(Sender: TObject; var Action: TCloseAction);
|
|
begin
|
|
if Assigned(chatFrm) then
|
|
chatFrm.SetFocus;
|
|
Action := caFree;
|
|
end;
|
|
|
|
function viewImageDimmed(evimage: RawByteString; evoffset: Integer): Tform;
|
|
var
|
|
formDim, formImg: TFormEx;
|
|
img: TImageEx;
|
|
PIn, POut: Pointer;
|
|
RnQPicStream: TMemoryStream;
|
|
OutSize: Cardinal;
|
|
imgList: TStringList;
|
|
imgcnt: integer;
|
|
imgtag: RawByteString;
|
|
bRect: TRect;
|
|
i, offset: integer;
|
|
begin
|
|
formDim := TFormEx.CreateNew(chatFrm, True);
|
|
formImg := TFormEx.CreateNew(chatFrm);
|
|
formImg.otherForm := formDim.Handle;
|
|
formDim.otherForm := formImg.Handle;
|
|
|
|
if Assigned(chatFrm) then
|
|
bRect := Screen.MonitorFromWindow(chatFrm.Handle).BoundsRect
|
|
else
|
|
bRect := Screen.Monitors[0].BoundsRect;
|
|
|
|
formDim.BoundsRect := bRect;
|
|
formDim.Color := clBlack;
|
|
|
|
imgList := TStringList.Create;
|
|
parseMsgImages(evimage, imgList);
|
|
formImg.LastImage := imgList.count - 1;
|
|
|
|
offset := 1;
|
|
for imgcnt := 0 to imgList.count - 1 do
|
|
begin
|
|
imgtag := imgList.Strings[imgcnt];
|
|
PIn := @imgtag[1];
|
|
OutSize := CalcDecodedSize(PIn, length(imgtag));
|
|
RnQPicStream := TMemoryStream.Create;
|
|
RnQPicStream.SetSize(OutSize);
|
|
RnQPicStream.position := 0;
|
|
POut := RnQPicStream.Memory;
|
|
Base64Decode(PIn^, length(imgtag), POut^);
|
|
|
|
img := TImageEx.Create(formImg);
|
|
img.Parent := formImg;
|
|
img.AutoSize := True;
|
|
img.Center := True;
|
|
img.Stretch := False;
|
|
img.Proportional := True;
|
|
img.Name := 'image' + IntToStr(imgcnt);
|
|
img.Left := 0;
|
|
img.Top := 0;
|
|
|
|
loadImageEx(img, RnQPicStream, True);
|
|
|
|
if (evoffset >= offset) then
|
|
formImg.ShownImage := imgcnt;
|
|
|
|
if img.Tag = 0 then
|
|
img.Hide;
|
|
|
|
inc(offset, length(imgtag) + length(RnQImageExTag) + length(RnQImageExUnTag));
|
|
FreeAndNil(RnQPicStream);
|
|
end;
|
|
imgList.Free;
|
|
|
|
formImg.ShowHideImages;
|
|
formImg.UpdateFormSize;
|
|
|
|
formDim.ShowWithFade;
|
|
formImg.ShowWithFade;
|
|
Result := formImg;
|
|
end;
|
|
|
|
initialization
|
|
|
|
TimerList := TDictionary |
|
|
|
finalization
|
|
|
|
TimerList.Free;
|
|
|
|
end.
|