|
|
unit setpassform;
|
|
|
|
|
|
interface
|
|
|
|
|
|
uses
|
|
|
Windows,
|
|
|
SysUtils,
|
|
|
StrUtils,
|
|
|
Graphics,
|
|
|
Forms,
|
|
|
CallExec,
|
|
|
plugin,
|
|
|
pluginutil,
|
|
|
GIFImg,
|
|
|
My.EncdDecd,
|
|
|
Classes,
|
|
|
Controls,
|
|
|
Dialogs,
|
|
|
StdCtrls,
|
|
|
ComCtrls,
|
|
|
Menus,
|
|
|
ExtCtrls;
|
|
|
|
|
|
{$I NoRTTI.inc}
|
|
|
|
|
|
type
|
|
|
TViewPic = class(TForm)
|
|
|
Panel1: TPanel;
|
|
|
PC: TPageControl;
|
|
|
TabSheet1: TTabSheet;
|
|
|
TabSheet2: TTabSheet;
|
|
|
rcvlist: TListView;
|
|
|
ScrollBox1: TScrollBox;
|
|
|
img: TImage;
|
|
|
Splitter1: TSplitter;
|
|
|
sndlist: TListView;
|
|
|
rcvpop: TPopupMenu;
|
|
|
N1: TMenuItem;
|
|
|
sndpop: TPopupMenu;
|
|
|
MenuItem1: TMenuItem;
|
|
|
finfo: TPanel;
|
|
|
TabSheet3: TTabSheet;
|
|
|
scrlist: TListView;
|
|
|
scrpop: TPopupMenu;
|
|
|
MenuItem2: TMenuItem;
|
|
|
OD: TOpenDialog;
|
|
|
procedure imgMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
|
|
procedure imgMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
|
|
|
procedure FormShow(Sender: TObject);
|
|
|
procedure rcvlistClick(Sender: TObject);
|
|
|
procedure rcvlistKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
|
|
|
procedure sndlistClick(Sender: TObject);
|
|
|
procedure sndlistKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
|
|
|
procedure FormCreate(Sender: TObject);
|
|
|
procedure rcvlistKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
|
|
|
procedure sndlistKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
|
|
|
procedure rcvlistCompare(Sender: TObject; Item1, Item2: TListItem; Data: Integer; var Compare: Integer);
|
|
|
procedure rcvlistDblClick(Sender: TObject);
|
|
|
procedure sndlistDblClick(Sender: TObject);
|
|
|
procedure TabSheet1Show(Sender: TObject);
|
|
|
procedure TabSheet2Show(Sender: TObject);
|
|
|
procedure N1Click(Sender: TObject);
|
|
|
procedure rcvlistMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
|
|
procedure MenuItem1Click(Sender: TObject);
|
|
|
procedure sndlistMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
|
|
procedure TabSheet3Show(Sender: TObject);
|
|
|
procedure scrlistClick(Sender: TObject);
|
|
|
procedure scrlistDblClick(Sender: TObject);
|
|
|
procedure scrlistKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
|
|
|
procedure scrlistKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
|
|
|
procedure scrlistMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
|
|
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
|
|
|
procedure MenuItem2Click(Sender: TObject);
|
|
|
private
|
|
|
{ Private declarations }
|
|
|
public
|
|
|
class procedure OnButtonClick(iButton: Integer); static;
|
|
|
procedure SendImg;
|
|
|
procedure SendImgBuf;
|
|
|
procedure LoadSaved;
|
|
|
procedure SaveSettings;
|
|
|
procedure LoadSettings;
|
|
|
{ Public declarations }
|
|
|
end;
|
|
|
|
|
|
var
|
|
|
viewpic: TViewPic;
|
|
|
st: TStringList;
|
|
|
msgout: widestring;
|
|
|
h1, h0: TIcon;
|
|
|
Parts, StartX, StartY, ba: Integer;
|
|
|
indicate: boolean = false;
|
|
|
Spot: TPoint;
|
|
|
msg2disp, userPath, andrqPath: ansistring;
|
|
|
startsendpic: boolean;
|
|
|
execOD: boolean = true;
|
|
|
hico: TIcon;
|
|
|
|
|
|
MyTimer: Cardinal; // <20><> <20><> <20><> <20><> TTimer
|
|
|
MyTimerEnabled: boolean = false;
|
|
|
|
|
|
// procedure FNTimeCallBack(uTimerID, uMessage: UINT; dwUser, dw1, dw2: DWORD); stdcall;
|
|
|
// procedure StartMyTimer;
|
|
|
// procedure StopMyTimer;
|
|
|
|
|
|
const
|
|
|
namepl: ansistring = 'Pic-Is-Big 1.3.0';
|
|
|
|
|
|
implementation
|
|
|
|
|
|
uses action, sett;
|
|
|
|
|
|
{$R *.dfm}
|
|
|
|
|
|
procedure DisplayInfo(FileName: string);
|
|
|
var xFile: Integer; f: LongWord;
|
|
|
begin
|
|
|
xFile := FileOpen(pchar(FileName), GENERIC_READ);
|
|
|
f := GetFileSize(xFile, nil);
|
|
|
FileClose(xFile);
|
|
|
viewpic.finfo.caption := '<27><>: ' + IntToStr(viewpic.img.width) + 'x' + IntToStr(viewpic.img.height) + ', ' +
|
|
|
FormatFloat('0.00 <20><>', f / 1024);
|
|
|
end;
|
|
|
|
|
|
procedure TViewPic.SendImg;
|
|
|
const PG_PREF_VALUE = 103;
|
|
|
var
|
|
|
i, PartSize: Integer;
|
|
|
addon: string;
|
|
|
encoded64String: widestring;
|
|
|
data1: pointer;
|
|
|
fs: TMemoryStream;
|
|
|
begin
|
|
|
if RQ_GetChatUIN = 0 then
|
|
|
begin
|
|
|
MessageBox(0, '<27><> <20><> <20><> <20><> <20><> <20> <20><>', 'Pic-is-Big', MB_ICONINFORMATION);
|
|
|
exit;
|
|
|
end;
|
|
|
if startsendpic = true then
|
|
|
exit;
|
|
|
|
|
|
viewpic.OD.Title := '<27><> <20><> <20><> <20><>';
|
|
|
if execOD = true then
|
|
|
begin
|
|
|
viewpic.OD.FileName := '';
|
|
|
if not viewpic.OD.Execute(actfrm.Handle) then
|
|
|
exit;
|
|
|
end;
|
|
|
execOD := true;
|
|
|
|
|
|
fs := TMemoryStream.Create();
|
|
|
fs.LoadFromFile(viewpic.OD.FileName);
|
|
|
fs.Seek(0, soFromBeginning);
|
|
|
encoded64String := EncodeBase64(fs.Memory, fs.Size);
|
|
|
fs.Free;
|
|
|
|
|
|
msg2disp := '' + encoded64String + '';
|
|
|
encoded64String := '' + encoded64String + '';
|
|
|
|
|
|
data1 := callStr(AnsiChar(PM_GET) + AnsiChar(PG_PREF_VALUE) + _istring('use-crypt-msg'));
|
|
|
if _istring_at(data1, 6) = 'Yes' then
|
|
|
begin
|
|
|
PartSize := 5500;
|
|
|
addon := '<27><> <20><> <20><>, <20><> <20><> <20><> <20><>'#13#10'<27><> <20><> <20><> ~30% (<28><> <20><> <20><> <20><> <20><> <20><>).'#13#10
|
|
|
end
|
|
|
else
|
|
|
begin
|
|
|
PartSize := 7500;
|
|
|
addon := '';
|
|
|
end;
|
|
|
|
|
|
Parts := length(encoded64String) div PartSize;
|
|
|
inc(Parts);
|
|
|
|
|
|
startsendpic := true;
|
|
|
if MessageBox(0, PWideChar(addon + '<27><> <20><> <20><> <20><> ' + IntToStr(Parts) +
|
|
|
' <20><>.'#13#10'<27><>, <20><> <20><> <20><> <20><>?'), '<27><>', MB_YESNO) = ID_NO then
|
|
|
begin
|
|
|
startsendpic := false;
|
|
|
exit;
|
|
|
end;
|
|
|
|
|
|
hico.Handle := LoadIcon(HInstance, 'PIC2');
|
|
|
RQ_ChangeChatButton(ba, hico.Handle, '<27><> <20><>: ' + extractfilename(viewpic.OD.FileName));
|
|
|
for i := 1 to Parts do
|
|
|
begin
|
|
|
msgout := copy(encoded64String, PartSize * (i - 1) + 1, PartSize);
|
|
|
if (i = 1) and (setfrm.checkbox5.Checked = false) then
|
|
|
msgout := IntToStr(Parts) + msgout;
|
|
|
RQ_SendMsg(RQ_GetChatUIN, 0, msgout);
|
|
|
end;
|
|
|
end;
|
|
|
|
|
|
procedure TViewPic.SendImgBuf;
|
|
|
const PG_PREF_VALUE = 103;
|
|
|
var
|
|
|
i, PartSize: Integer;
|
|
|
encoded64String: widestring;
|
|
|
data1: pointer;
|
|
|
fs: TMemoryStream;
|
|
|
begin
|
|
|
if RQ_GetChatUIN = 0 then
|
|
|
begin
|
|
|
MessageBox(0, '<27><> <20><> <20><> <20><> <20><> <20> <20><>', 'Pic-is-Big', MB_ICONINFORMATION);
|
|
|
exit;
|
|
|
end;
|
|
|
if startsendpic = true then
|
|
|
exit;
|
|
|
|
|
|
viewpic.OD.Title := '<27><> <20><> <20><> <20><>';
|
|
|
if execOD = true then
|
|
|
begin
|
|
|
viewpic.OD.FileName := '';
|
|
|
if not viewpic.OD.Execute(actfrm.Handle) then
|
|
|
exit;
|
|
|
end;
|
|
|
execOD := true;
|
|
|
|
|
|
fs := TMemoryStream.Create();
|
|
|
fs.LoadFromFile(viewpic.OD.FileName);
|
|
|
fs.Seek(0, soFromBeginning);
|
|
|
encoded64String := EncodeBase64(fs.Memory, fs.Size);
|
|
|
fs.Free;
|
|
|
|
|
|
msg2disp := '' + encoded64String + '';
|
|
|
encoded64String := '' + encoded64String + '';
|
|
|
|
|
|
data1 := callStr(AnsiChar(PM_GET) + AnsiChar(PG_PREF_VALUE) + _istring('use-crypt-msg'));
|
|
|
if _istring_at(data1, 6) = 'Yes' then
|
|
|
PartSize := 5500
|
|
|
else
|
|
|
PartSize := 7500;
|
|
|
|
|
|
Parts := length(encoded64String) div PartSize;
|
|
|
inc(Parts);
|
|
|
|
|
|
startsendpic := true;
|
|
|
|
|
|
hico.Handle := LoadIcon(HInstance, 'PIC2');
|
|
|
RQ_ChangeChatButton(ba, hico.Handle, '<27><> <20><>: ' + extractfilename(viewpic.OD.FileName));
|
|
|
for i := 1 to Parts do
|
|
|
begin
|
|
|
msgout := copy(encoded64String, PartSize * (i - 1) + 1, PartSize);
|
|
|
if (i = 1) and (setfrm.checkbox5.Checked = false) then
|
|
|
msgout := IntToStr(Parts) + msgout;
|
|
|
RQ_SendMsg(RQ_GetChatUIN, 0, msgout);
|
|
|
end;
|
|
|
end;
|
|
|
|
|
|
function PopupMenuHeight(Popup: TPopupMenu): Integer;
|
|
|
var info: tagMENUINFO;
|
|
|
i, Y: Integer;
|
|
|
begin
|
|
|
FillChar(info, SizeOf(info), 0);
|
|
|
info.cbSize := SizeOf(info);
|
|
|
info.fMask := MIM_MAXHEIGHT;
|
|
|
|
|
|
if GetMenuInfo(Popup.Handle, info) and (info.cyMax > 0) then
|
|
|
result := info.cyMax
|
|
|
else
|
|
|
begin
|
|
|
Y := Round(GetSystemMetrics(SM_CYMENUCHECK) * 1.4);
|
|
|
result := 0;
|
|
|
if Popup.Items.Count > 0 then
|
|
|
begin
|
|
|
for i := 0 to Popup.Items.Count - 1 do
|
|
|
if Popup.Items[i].Visible then
|
|
|
inc(result, Y);
|
|
|
end;
|
|
|
end;
|
|
|
end;
|
|
|
|
|
|
class procedure TViewPic.OnButtonClick(iButton: Integer);
|
|
|
begin
|
|
|
case iButton of
|
|
|
0:
|
|
|
begin
|
|
|
if setfrm.RadioGroup1.ItemIndex = 0 then
|
|
|
actfrm.PopupMenu1.Popup(mouse.CursorPos.X - 5, mouse.CursorPos.Y - PopupMenuHeight(actfrm.PopupMenu1) - 25)
|
|
|
else
|
|
|
actfrm.Show;
|
|
|
end;
|
|
|
2:
|
|
|
setfrm.Show;
|
|
|
1:
|
|
|
begin
|
|
|
if MyTimerEnabled = true then
|
|
|
begin
|
|
|
// StopMyTimer;
|
|
|
RQ_ChangeChatButton(ba, h1.Handle, namepl);
|
|
|
DestroyIcon(h1.Handle);
|
|
|
DestroyIcon(h0.Handle);
|
|
|
end;
|
|
|
viewpic.Show;
|
|
|
viewpic.realign;
|
|
|
end;
|
|
|
end;
|
|
|
end;
|
|
|
|
|
|
function RcvListToFile(mods: Integer): string;
|
|
|
begin
|
|
|
if mods = -1 then
|
|
|
Result := viewpic.rcvlist.Selected.SubItems[2]
|
|
|
else
|
|
|
Result := viewpic.rcvlist.Items[mods].SubItems[2];
|
|
|
end;
|
|
|
|
|
|
function ScrListToFile(mods: Integer): string;
|
|
|
begin
|
|
|
if mods = -1 then
|
|
|
Result := viewpic.scrlist.Selected.SubItems[2]
|
|
|
else
|
|
|
Result := viewpic.scrlist.Items[mods].SubItems[2];
|
|
|
end;
|
|
|
|
|
|
function SndListToFile(mods: Integer): string;
|
|
|
begin
|
|
|
if mods = -1 then
|
|
|
Result := viewpic.sndlist.Selected.SubItems[2]
|
|
|
else
|
|
|
Result := viewpic.sndlist.Items[mods].SubItems[2];
|
|
|
end;
|
|
|
|
|
|
procedure TViewPic.LoadSaved;
|
|
|
var rec: TSearchRec;
|
|
|
FileAttrs, itmp: Integer;
|
|
|
li: TListItem;
|
|
|
fext, tmp: string;
|
|
|
begin
|
|
|
rcvlist.Items.Clear;
|
|
|
sndlist.Items.Clear;
|
|
|
scrlist.Items.Clear;
|
|
|
|
|
|
FileAttrs := faDirectory + faAnyFile + faHidden + faSysFile + faReadOnly + faArchive;
|
|
|
if FindFirst(userPath + 'Rcv\' + '*.*', FileAttrs, rec) = 0 then
|
|
|
repeat
|
|
|
if (extractfilename(userPath + 'Rcv\' + rec.name) <> '.') and (extractfilename(userPath + 'Rcv\' + rec.name) <> '..') then
|
|
|
begin
|
|
|
li := rcvlist.Items.Add;
|
|
|
tmp := extractfilename(userPath + 'Rcv\' + rec.name);
|
|
|
fext := ExtractFileExt(tmp);
|
|
|
tmp := ChangeFileExt(extractfilename(userPath + 'Rcv\' + rec.name), '');
|
|
|
li.Caption := copy(tmp, 19, length(tmp));
|
|
|
if TryStrToInt(li.caption, itmp) then
|
|
|
li.Caption := RQ_GetDisplayedName(itmp);
|
|
|
tmp := replacestr(copy(tmp, 1, 17), '.', ':');
|
|
|
tmp := replacestr(tmp, '_', ' ');
|
|
|
tmp := replacestr(tmp, '-', '.');
|
|
|
li.SubItems.Add(tmp);
|
|
|
li.SubItems.Add(fext);
|
|
|
li.SubItems.Add(userPath + 'Rcv\' + rec.name);
|
|
|
end;
|
|
|
until FindNext(rec) <> 0;
|
|
|
|
|
|
FileAttrs := faDirectory + faAnyFile + faHidden + faSysFile + faReadOnly + faArchive;
|
|
|
if FindFirst(userPath + 'Snd\' + '*.*', FileAttrs, rec) = 0 then
|
|
|
repeat
|
|
|
if (extractfilename(userPath + 'Snd\' + rec.name) <> '.') and (extractfilename(userPath + 'Snd\' + rec.name) <> '..') then
|
|
|
begin
|
|
|
li := sndlist.Items.Add;
|
|
|
tmp := extractfilename(userPath + 'Snd\' + rec.name);
|
|
|
fext := ExtractFileExt(tmp);
|
|
|
tmp := ChangeFileExt(extractfilename(userPath + 'Snd\' + rec.name), '');
|
|
|
li.Caption := copy(tmp, 19, length(tmp));
|
|
|
if TryStrToInt(li.caption, itmp) then
|
|
|
li.Caption := RQ_GetDisplayedName(itmp);
|
|
|
tmp := replacestr(copy(tmp, 1, 17), '.', ':');
|
|
|
tmp := replacestr(tmp, '_', ' ');
|
|
|
tmp := replacestr(tmp, '-', '.');
|
|
|
li.SubItems.Add(tmp);
|
|
|
li.SubItems.Add(fext);
|
|
|
li.SubItems.Add(userPath + 'Snd\' + rec.name);
|
|
|
end;
|
|
|
until FindNext(rec) <> 0;
|
|
|
|
|
|
FileAttrs := faDirectory + faAnyFile + faHidden + faSysFile + faReadOnly + faArchive;
|
|
|
if FindFirst(userPath + 'Scr\' + '*.*', FileAttrs, rec) = 0 then
|
|
|
repeat
|
|
|
if (extractfilename(userPath + 'Scr\' + rec.name) <> '.') and (extractfilename(userPath + 'Scr\' + rec.name) <> '..') then
|
|
|
begin
|
|
|
li := scrlist.Items.Add;
|
|
|
tmp := extractfilename(userPath + 'Scr\' + rec.name);
|
|
|
fext := ExtractFileExt(tmp);
|
|
|
tmp := ChangeFileExt(extractfilename(userPath + 'Scr\' + rec.name), '');
|
|
|
li.Caption := copy(tmp, 19, length(tmp));
|
|
|
if TryStrToInt(li.caption, itmp) then
|
|
|
li.Caption := RQ_GetDisplayedName(itmp);
|
|
|
tmp := replacestr(copy(tmp, 1, 17), '.', ':');
|
|
|
tmp := replacestr(tmp, '_', ' ');
|
|
|
tmp := replacestr(tmp, '-', '.');
|
|
|
li.SubItems.Add(tmp);
|
|
|
li.SubItems.Add(fext);
|
|
|
li.SubItems.Add(userPath + 'Scr\' + rec.name);
|
|
|
end;
|
|
|
until FindNext(rec) <> 0;
|
|
|
|
|
|
rcvlist.SortType := stNone;
|
|
|
sndlist.SortType := stNone;
|
|
|
scrlist.SortType := stNone;
|
|
|
rcvlist.SortType := stData;
|
|
|
sndlist.SortType := stData;
|
|
|
scrlist.SortType := stData;
|
|
|
end;
|
|
|
|
|
|
{
|
|
|
procedure StartMyTimer;
|
|
|
begin
|
|
|
MyTimer := TimeSetEvent(750,10000,@FNTimeCallBack,100,TIME_PERIODIC);
|
|
|
MyTimerEnabled := true;
|
|
|
end;
|
|
|
|
|
|
procedure StopMyTimer;
|
|
|
begin
|
|
|
MyTimerEnabled := false;
|
|
|
timeKillEvent(MyTimer);
|
|
|
end;
|
|
|
|
|
|
procedure FNTimeCallBack(uTimerID, uMessage: UINT; dwUser, dw1, dw2: DWORD); stdcall;
|
|
|
begin
|
|
|
indicate := not indicate;
|
|
|
if indicate = true then
|
|
|
RQ_ChangeChatButton(ba, h1, namepl + ': <20><> <20><>! <20><> <20><> <20><> <20><>.')
|
|
|
else
|
|
|
RQ_ChangeChatButton(ba, h0, namepl + ': <20><> <20><>! <20><> <20><> <20><> <20><>.');
|
|
|
end;
|
|
|
}
|
|
|
|
|
|
procedure TViewPic.SaveSettings;
|
|
|
begin
|
|
|
{ st := TStringList.create;
|
|
|
|
|
|
st.Add('on');
|
|
|
|
|
|
st.SaveToFile(RQ_GetUserPath + 'RatCrypt.ini');
|
|
|
st.Free;
|
|
|
|
|
|
memo1.lines.savetofile(RQ_GetUserPath + 'RatCryptWho.ini');
|
|
|
}
|
|
|
end;
|
|
|
|
|
|
procedure TViewPic.LoadSettings;
|
|
|
begin
|
|
|
{
|
|
|
if fileexists(RQ_GetUserPath + 'RatCryptWho.ini') then
|
|
|
memo1.lines.loadfromfile(RQ_GetUserPath + 'RatCryptWho.ini');
|
|
|
|
|
|
if not fileexists(RQ_GetUserPath + 'RatCrypt.ini') then exit;
|
|
|
st := TStringList.create;
|
|
|
st.LoadFromFile(RQ_GetUserPath + 'RatCrypt.ini');
|
|
|
|
|
|
if st[0] = 'on'
|
|
|
|
|
|
st.Free;
|
|
|
}
|
|
|
end;
|
|
|
|
|
|
procedure TViewPic.imgMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
|
|
begin
|
|
|
StartX := X;
|
|
|
StartY := Y;
|
|
|
end;
|
|
|
|
|
|
procedure TViewPic.imgMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
|
|
|
var ShfX, ShfY: Integer; ks: TKeyBoardState;
|
|
|
begin
|
|
|
GetKeyBoardState(ks);
|
|
|
if ks[VK_LBUTTON] >= 128 then
|
|
|
begin
|
|
|
ShfY := StartY - Y;
|
|
|
ShfX := StartX - X;
|
|
|
|
|
|
ScrollBox1.VertScrollBar.Position := ScrollBox1.VertScrollBar.Position + ShfY;
|
|
|
ScrollBox1.HorzScrollBar.Position := ScrollBox1.HorzScrollBar.Position + ShfX;
|
|
|
end;
|
|
|
end;
|
|
|
|
|
|
procedure TViewPic.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
|
|
|
begin
|
|
|
if Key = VK_ESCAPE then
|
|
|
close;
|
|
|
end;
|
|
|
|
|
|
procedure TViewPic.FormShow(Sender: TObject);
|
|
|
var MonNum: Integer;
|
|
|
begin
|
|
|
LoadSaved;
|
|
|
MonNum := Screen.MonitorFromWindow(GetForegroundWindow, mdNearest).MonitorNum;
|
|
|
Self.Top := Screen.Monitors[MonNum].Top + ((Screen.Monitors[MonNum].height div 2) - (Self.height div 2));
|
|
|
Self.Left := Screen.Monitors[MonNum].Left + ((Screen.Monitors[MonNum].width div 2) - (Self.width div 2));
|
|
|
end;
|
|
|
|
|
|
procedure TViewPic.rcvlistClick(Sender: TObject);
|
|
|
var fname: string; gif: TGIFImage; winimg: TWICImage;
|
|
|
begin
|
|
|
if rcvlist.Selected <> nil then
|
|
|
begin
|
|
|
fname := RcvListToFile(-1);
|
|
|
|
|
|
try
|
|
|
if rcvlist.Selected.SubItems[1] = '.gif' then
|
|
|
begin
|
|
|
gif := TGIFImage.Create;
|
|
|
gif.LoadFromFile(fname);
|
|
|
gif.Animate := false;
|
|
|
try
|
|
|
img.Picture.Assign(nil);
|
|
|
img.Picture.Assign(gif);
|
|
|
img.Transparent := gif.IsTransparent;
|
|
|
(img.Picture.Graphic as TGIFImage).Animate := true;
|
|
|
img.Refresh;
|
|
|
finally
|
|
|
gif.Free;
|
|
|
end;
|
|
|
end
|
|
|
else if rcvlist.Selected.SubItems[1] = '.webp' then
|
|
|
begin
|
|
|
winimg := TWICImage.Create;
|
|
|
winimg.LoadFromFile(fname);
|
|
|
try
|
|
|
img.Picture.Assign(nil);
|
|
|
img.Picture.Assign(winimg);
|
|
|
img.Transparent := true;
|
|
|
img.Refresh;
|
|
|
finally
|
|
|
winimg.Free;
|
|
|
end;
|
|
|
end
|
|
|
else
|
|
|
img.Picture.LoadFromFile(fname);
|
|
|
except
|
|
|
end;
|
|
|
DisplayInfo(fname);
|
|
|
end;
|
|
|
end;
|
|
|
|
|
|
procedure TViewPic.rcvlistKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
|
|
|
begin
|
|
|
rcvlist.OnClick(Sender)
|
|
|
end;
|
|
|
|
|
|
procedure TViewPic.sndlistClick(Sender: TObject);
|
|
|
var fname: string; gif: TGIFImage;
|
|
|
begin
|
|
|
if sndlist.Selected <> nil then
|
|
|
begin
|
|
|
fname := SndListToFile(-1);
|
|
|
|
|
|
try
|
|
|
if sndlist.Selected.SubItems[1] = '.gif' then
|
|
|
begin
|
|
|
gif := TGIFImage.Create;
|
|
|
gif.LoadFromFile(fname);
|
|
|
gif.Animate := false;
|
|
|
try
|
|
|
img.Picture.Assign(nil);
|
|
|
img.Picture.Assign(gif);
|
|
|
img.Refresh;
|
|
|
finally
|
|
|
gif.Free;
|
|
|
end;
|
|
|
end
|
|
|
else
|
|
|
img.Picture.LoadFromFile(fname);
|
|
|
except
|
|
|
end;
|
|
|
DisplayInfo(fname);
|
|
|
end;
|
|
|
end;
|
|
|
|
|
|
procedure TViewPic.sndlistKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
|
|
|
begin
|
|
|
sndlist.OnClick(Sender)
|
|
|
end;
|
|
|
|
|
|
procedure TViewPic.FormCreate(Sender: TObject);
|
|
|
var NewColumn: TListColumn;
|
|
|
begin
|
|
|
Icon.LoadFromResourceName(HInstance, 'PIC1');
|
|
|
|
|
|
with rcvlist do
|
|
|
begin
|
|
|
NewColumn := Columns.Add;
|
|
|
NewColumn.caption := '<27><>';
|
|
|
NewColumn.width := 120;
|
|
|
NewColumn := Columns.Add;
|
|
|
NewColumn.caption := '<27><>';
|
|
|
NewColumn.width := 110;
|
|
|
NewColumn := Columns.Add;
|
|
|
NewColumn.caption := '<27><>';
|
|
|
NewColumn.width := 60;
|
|
|
end;
|
|
|
|
|
|
with sndlist do
|
|
|
begin
|
|
|
NewColumn := Columns.Add;
|
|
|
NewColumn.caption := '<27><>';
|
|
|
NewColumn.width := 120;
|
|
|
NewColumn := Columns.Add;
|
|
|
NewColumn.caption := '<27><>';
|
|
|
NewColumn.width := 110;
|
|
|
NewColumn := Columns.Add;
|
|
|
NewColumn.caption := '<27><>';
|
|
|
NewColumn.width := 60;
|
|
|
end;
|
|
|
|
|
|
with scrlist do
|
|
|
begin
|
|
|
NewColumn := Columns.Add;
|
|
|
NewColumn.caption := '<27><>';
|
|
|
NewColumn.width := 120;
|
|
|
NewColumn := Columns.Add;
|
|
|
NewColumn.caption := '<27><>';
|
|
|
NewColumn.width := 110;
|
|
|
NewColumn := Columns.Add;
|
|
|
NewColumn.caption := '<27><>';
|
|
|
NewColumn.width := 60;
|
|
|
end;
|
|
|
end;
|
|
|
|
|
|
procedure TViewPic.rcvlistKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
|
|
|
var pastsel: Integer;
|
|
|
begin
|
|
|
if Key = VK_RETURN then
|
|
|
rcvlist.OnDblClick(Sender);
|
|
|
if Key = VK_DELETE then
|
|
|
if rcvlist.Selected <> nil then
|
|
|
begin
|
|
|
DeleteFile(RcvListToFile(-1));
|
|
|
pastsel := rcvlist.ItemIndex;
|
|
|
rcvlist.Selected.Delete;
|
|
|
if pastsel <= rcvlist.Items.Count - 1 then
|
|
|
rcvlist.ItemIndex := pastsel;
|
|
|
dec(pastsel);
|
|
|
if (pastsel = rcvlist.Items.Count - 1) and (pastsel >= 0) then
|
|
|
rcvlist.ItemIndex := pastsel;
|
|
|
img.Picture.Assign(nil);
|
|
|
end;
|
|
|
end;
|
|
|
|
|
|
procedure TViewPic.sndlistKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
|
|
|
var pastsel: Integer;
|
|
|
begin
|
|
|
if Key = VK_RETURN then
|
|
|
sndlist.OnDblClick(Sender);
|
|
|
if Key = VK_DELETE then
|
|
|
if sndlist.Selected <> nil then
|
|
|
begin
|
|
|
DeleteFile(SndListToFile(-1));
|
|
|
pastsel := sndlist.ItemIndex;
|
|
|
sndlist.Selected.Delete;
|
|
|
if pastsel <= sndlist.Items.Count - 1 then
|
|
|
sndlist.ItemIndex := pastsel;
|
|
|
dec(pastsel);
|
|
|
if (pastsel = sndlist.Items.Count - 1) and (pastsel >= 0) then
|
|
|
sndlist.ItemIndex := pastsel;
|
|
|
img.Picture.Assign(nil);
|
|
|
end;
|
|
|
end;
|
|
|
|
|
|
procedure TViewPic.rcvlistCompare(Sender: TObject; Item1, Item2: TListItem; Data: Integer; var Compare: Integer);
|
|
|
var fr: TFormatSettings; it1d, it2d: TDate; it1t, it2t: TTime;
|
|
|
begin
|
|
|
fr.ShortDateFormat := 'dd.mm.yy';
|
|
|
fr.ShortTimeFormat := 'hh:mm:ss';
|
|
|
fr.LongDateFormat := 'dd.mm.yy';
|
|
|
fr.LongTimeFormat := 'hh:mm:ss';
|
|
|
fr.DateSeparator := '.';
|
|
|
fr.TimeSeparator := ':';
|
|
|
|
|
|
it1t := StrToTime(copy(Item1.SubItems[0], 1, 8));
|
|
|
it1d := StrToDate(copy(Item1.SubItems[0], 10, 8));
|
|
|
|
|
|
it2t := StrToTime(copy(Item2.SubItems[0], 1, 8));
|
|
|
it2d := StrToDate(copy(Item2.SubItems[0], 10, 8));
|
|
|
|
|
|
Compare := 0;
|
|
|
if it1d > it2d then
|
|
|
Compare := -1
|
|
|
else if it1d < it2d then
|
|
|
Compare := 1
|
|
|
else if it1d = it2d then
|
|
|
if it1t > it2t then
|
|
|
Compare := -1
|
|
|
else if it1t < it2t then
|
|
|
Compare := 1;
|
|
|
end;
|
|
|
|
|
|
procedure TViewPic.rcvlistDblClick(Sender: TObject);
|
|
|
begin
|
|
|
if rcvlist.Selected <> nil then
|
|
|
begin
|
|
|
OD.FileName := RcvListToFile(-1);
|
|
|
execOD := false;
|
|
|
OnButtonClick(0);
|
|
|
end;
|
|
|
end;
|
|
|
|
|
|
procedure TViewPic.sndlistDblClick(Sender: TObject);
|
|
|
begin
|
|
|
if sndlist.Selected <> nil then
|
|
|
begin
|
|
|
OD.FileName := SndListToFile(-1);
|
|
|
execOD := false;
|
|
|
OnButtonClick(0);
|
|
|
end;
|
|
|
end;
|
|
|
|
|
|
procedure TViewPic.TabSheet1Show(Sender: TObject);
|
|
|
begin
|
|
|
img.Picture.Assign(nil);
|
|
|
finfo.caption := '<27><> <20><> <20><> <20> <20><>';
|
|
|
rcvlist.OnClick(Sender);
|
|
|
end;
|
|
|
|
|
|
procedure TViewPic.TabSheet2Show(Sender: TObject);
|
|
|
begin
|
|
|
img.Picture.Assign(nil);
|
|
|
finfo.caption := '<27><> <20><> <20><> <20> <20><>';
|
|
|
sndlist.OnClick(Sender);
|
|
|
end;
|
|
|
|
|
|
procedure TViewPic.N1Click(Sender: TObject);
|
|
|
var i: Integer;
|
|
|
begin
|
|
|
for i := 0 to rcvlist.Items.Count - 1 do
|
|
|
DeleteFile(RcvListToFile(i));
|
|
|
|
|
|
LoadSaved;
|
|
|
img.Picture := nil;
|
|
|
end;
|
|
|
|
|
|
procedure TViewPic.rcvlistMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
|
|
begin
|
|
|
if Button = mbRight then
|
|
|
rcvpop.Popup(mouse.CursorPos.X, mouse.CursorPos.Y);
|
|
|
end;
|
|
|
|
|
|
procedure TViewPic.MenuItem1Click(Sender: TObject);
|
|
|
var i: Integer;
|
|
|
begin
|
|
|
for i := 0 to sndlist.Items.Count - 1 do
|
|
|
DeleteFile(SndListToFile(i));
|
|
|
|
|
|
LoadSaved;
|
|
|
img.Picture := nil;
|
|
|
end;
|
|
|
|
|
|
procedure TViewPic.MenuItem2Click(Sender: TObject);
|
|
|
var i: Integer;
|
|
|
begin
|
|
|
for i := 0 to scrlist.Items.Count - 1 do
|
|
|
DeleteFile(ScrListToFile(i));
|
|
|
|
|
|
LoadSaved;
|
|
|
img.Picture := nil;
|
|
|
end;
|
|
|
|
|
|
procedure TViewPic.sndlistMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
|
|
begin
|
|
|
if Button = mbRight then
|
|
|
sndpop.Popup(mouse.CursorPos.X, mouse.CursorPos.Y);
|
|
|
end;
|
|
|
|
|
|
procedure TViewPic.TabSheet3Show(Sender: TObject);
|
|
|
begin
|
|
|
img.Picture.Assign(nil);
|
|
|
finfo.caption := '<27><> <20><> <20><> <20> <20><>';
|
|
|
scrlist.OnClick(Sender);
|
|
|
end;
|
|
|
|
|
|
procedure TViewPic.scrlistClick(Sender: TObject);
|
|
|
var fname: string; gif: TGIFImage;
|
|
|
begin
|
|
|
if scrlist.Selected <> nil then
|
|
|
begin
|
|
|
fname := ScrListToFile(-1);
|
|
|
|
|
|
try
|
|
|
if scrlist.Selected.SubItems[1] = '.gif' then
|
|
|
begin
|
|
|
gif := TGIFImage.Create;
|
|
|
gif.LoadFromFile(fname);
|
|
|
gif.Animate := false;
|
|
|
try
|
|
|
img.Picture.Assign(nil);
|
|
|
img.Picture.Assign(gif);
|
|
|
img.Refresh;
|
|
|
finally
|
|
|
gif.Free;
|
|
|
end;
|
|
|
end
|
|
|
else
|
|
|
img.Picture.LoadFromFile(fname);
|
|
|
except
|
|
|
end;
|
|
|
DisplayInfo(fname);
|
|
|
end;
|
|
|
end;
|
|
|
|
|
|
procedure TViewPic.scrlistDblClick(Sender: TObject);
|
|
|
begin
|
|
|
if scrlist.Selected <> nil then
|
|
|
begin
|
|
|
OD.FileName := ScrListToFile(-1);
|
|
|
execOD := false;
|
|
|
OnButtonClick(0);
|
|
|
end;
|
|
|
end;
|
|
|
|
|
|
procedure TViewPic.scrlistKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
|
|
|
var pastsel: Integer;
|
|
|
begin
|
|
|
if Key = VK_RETURN then
|
|
|
scrlist.OnDblClick(Sender);
|
|
|
if Key = VK_DELETE then
|
|
|
if scrlist.Selected <> nil then
|
|
|
begin
|
|
|
DeleteFile(ScrListToFile(-1));
|
|
|
pastsel := scrlist.ItemIndex;
|
|
|
scrlist.Selected.Delete;
|
|
|
if pastsel <= scrlist.Items.Count - 1 then
|
|
|
scrlist.ItemIndex := pastsel;
|
|
|
dec(pastsel);
|
|
|
if (pastsel = scrlist.Items.Count - 1) and (pastsel >= 0) then
|
|
|
scrlist.ItemIndex := pastsel;
|
|
|
img.Picture.Assign(nil);
|
|
|
end;
|
|
|
end;
|
|
|
|
|
|
procedure TViewPic.scrlistKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
|
|
|
begin
|
|
|
scrlist.OnClick(Sender)
|
|
|
end;
|
|
|
|
|
|
procedure TViewPic.scrlistMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
|
|
begin
|
|
|
if Button = mbRight then
|
|
|
scrpop.Popup(mouse.CursorPos.X, mouse.CursorPos.Y);
|
|
|
end;
|
|
|
|
|
|
end.
|