Маленькая аська :) https://rnq.ru
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 

426 lines
10 KiB

{
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<UINT_PTR, TOnTimerProc>;
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<UINT_PTR, TOnTimerProc>.Create;
finalization
TimerList.Free;
end.