• R/O
  • SSH
  • HTTPS

mantisbtmonitor: Commit


Commit MetaInfo

Revisión69 (tree)
Tiempo2021-12-17 03:04:32
Autorderekwildstar

Log Message

Estilos atualizados
Interposer para TListView capaz de lidar com dropagem de arquivos
Adição de um TListView na tela de gerenciamento de comentário

Cambiar Resumen

Diferencia incremental

--- trunk/client/prj/MantisBTMonitor.dproj (revision 68)
+++ trunk/client/prj/MantisBTMonitor.dproj (revision 69)
@@ -117,7 +117,7 @@
117117 <VerInfo_MinorVer>0</VerInfo_MinorVer>
118118 <VerInfo_Release>0</VerInfo_Release>
119119 <VerInfo_Locale>1033</VerInfo_Locale>
120- <VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.374;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName)</VerInfo_Keys>
120+ <VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.419;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName)</VerInfo_Keys>
121121 <Debugger_RunParams>/desenvolvimento</Debugger_RunParams>
122122 <VerInfo_AutoGenVersion>false</VerInfo_AutoGenVersion>
123123 <VerInfo_AutoIncVersion>true</VerInfo_AutoIncVersion>
@@ -124,7 +124,7 @@
124124 <DCC_DebugInformation>2</DCC_DebugInformation>
125125 <DCC_SymbolReferenceInfo>2</DCC_SymbolReferenceInfo>
126126 <DCC_DebugInfoInExe>true</DCC_DebugInfoInExe>
127- <VerInfo_Build>374</VerInfo_Build>
127+ <VerInfo_Build>419</VerInfo_Build>
128128 <DCC_MapFile>3</DCC_MapFile>
129129 </PropertyGroup>
130130 <ItemGroup>
--- trunk/client/src/lib/UInterposersAndHelpers.pas (revision 68)
+++ trunk/client/src/lib/UInterposersAndHelpers.pas (revision 69)
@@ -3,9 +3,54 @@
33 interface
44
55 uses
6- SHDocVw, Winapi.Windows, Winapi.Messages, System.Classes;
6+ SHDocVw, Winapi.Windows, Winapi.Messages, System.Classes, Vcl.ComCtrls,
7+ Winapi.ShellAPI;
78
89 type
10+ // Se for útil, colcar no Krakatoa
11+ TFileCatcher = class(TObject)
12+ private
13+ FDropHandle: HDROP;
14+
15+ function GetFileCount: Word;
16+ function GetPoint: TPoint;
17+ function GetFileName(AId: Word): String;
18+ function GetFileDisplayName(AId: Word): String;
19+ function GetFileType(AId: Word): String;
20+ function GetFileIcon(AId: Word): HICON;
21+ function GetFileSize(AId: Word): Int64;
22+ public
23+ constructor Create(ADropHandle: HDROP);
24+ destructor Destroy; override;
25+
26+ property FileCount: Word read GetFileCount;
27+ property FileNames[AId: Word]: String read GetFileName;
28+ // O display name é afetado pelo Windows. Caso o sistema esteja configurado
29+ // para não mostrar extensões de arquivos, ele não conterá a extensão. Leia
30+ // mais em https://docs.microsoft.com/en-us/windows/win32/api/shellapi/nf-shellapi-shgetfileinfoa
31+ property FileDisplayNames[AId: Word]: String read GetFileDisplayName;
32+ property FileTypes[AId: Word]: String read GetFileType;
33+ property FileSizes[AId: Word]: Int64 read GetFileSize;
34+ // Cada icone obtido precisa ser destruido com DestroyIcon
35+ property FileIcons[AId: Word]: HICON read GetFileIcon;
36+ property DropPoint: TPoint read GetPoint;
37+ end;
38+
39+ TOnDropFiles = procedure (ASender: TObject; const ADropHandle: LRESULT; out AMessageResult: LRESULT) of object;
40+
41+ // TListView com características estendidas
42+ TListView = class(Vcl.ComCtrls.TListView)
43+ private
44+ FOnDropFiles: TOnDropFiles;
45+
46+ procedure WMDropFiles(var AMessage: TWMDropFiles); message WM_DROPFILES;
47+ public
48+ procedure CreateWnd; override;
49+ procedure DestroyWnd; override;
50+
51+ property OnDropFiles: TOnDropFiles read FOnDropFiles write FOnDropFiles;
52+ end;
53+
954 // colocar isso no krakatoa... TKRKWebBrowser
1055 TWebBrowser = class(SHDocVw.TWebBrowser)
1156 private
@@ -28,7 +73,7 @@
2873 implementation
2974
3075 uses
31- WinApi.CommCtrl, System.SysUtils;
76+ WinApi.CommCtrl, System.SysUtils, Vcl.Graphics;
3277
3378 // Esta função de callback é usada para realização de subclasseamento de
3479 // procedimentos de janela. AIdSubclass é um identificador único que é passado
@@ -53,6 +98,113 @@
5398 end;
5499 end;
55100
101+{ TFileCatcher }
102+
103+constructor TFileCatcher.Create(ADropHandle: HDROP);
104+begin
105+ FDropHandle := ADropHandle;
106+end;
107+
108+destructor TFileCatcher.Destroy;
109+begin
110+ DragFinish(FDropHandle);
111+ inherited;
112+end;
113+
114+function TFileCatcher.GetFileName(AId: Word): String;
115+var
116+ FileNameLength: Integer;
117+begin
118+ FileNameLength := DragQueryFile(FDropHandle, AId, nil, 0);
119+ SetLength(Result, FileNameLength);
120+ DragQueryFile(FDropHandle, AId, PChar(Result), FileNameLength + 1);
121+end;
122+
123+function TFileCatcher.GetFileSize(AId: Word): Int64;
124+var
125+ Info: TWin32FileAttributeData;
126+begin
127+ Result := -1;
128+
129+ if not GetFileAttributesEx(PChar(GetFileName(AId)), GetFileExInfoStandard, @info) then
130+ Exit;
131+
132+ Result := Int64(Info.nFileSizeLow) or Int64(Info.nFileSizeHigh shl 32);
133+end;
134+
135+function TFileCatcher.GetFileType(AId: Word): String;
136+var
137+ FileInfo: SHFILEINFO;
138+begin
139+ SHGetFileInfo(PChar(GetFileName(AId)), 0, FileInfo, SizeOf(FileInfo), SHGFI_TYPENAME);
140+ Result := FileInfo.szTypeName;
141+end;
142+
143+function TFileCatcher.GetFileCount: Word;
144+begin
145+ Result := DragQueryFile(FDropHandle, $FFFFFFFF, nil, 0);
146+end;
147+
148+function TFileCatcher.GetFileDisplayName(AId: Word): String;
149+var
150+ FileInfo: SHFILEINFO;
151+begin
152+ SHGetFileInfo(PChar(GetFileName(AId)), 0, FileInfo, SizeOf(FileInfo), SHGFI_DISPLAYNAME);
153+ Result := FileInfo.szDisplayName;
154+end;
155+
156+function TFileCatcher.GetFileIcon(AId: Word): HICON;
157+var
158+ FileInfo: SHFILEINFO;
159+begin
160+ SHGetFileInfo(PChar(GetFileName(AId)), 0, FileInfo, SizeOf(FileInfo), SHGFI_ICON or SHGFI_SMALLICON);
161+ Result := FileInfo.hIcon;
162+end;
163+
164+function TFileCatcher.GetPoint: TPoint;
165+begin
166+ DragQueryPoint(FDropHandle, Result);
167+end;
168+
169+{ TListView }
170+
171+procedure TListView.CreateWnd;
172+begin
173+ inherited;
174+ DragAcceptFiles(Handle, True);
175+end;
176+
177+procedure TListView.DestroyWnd;
178+begin
179+ DragAcceptFiles(Handle, False);
180+ inherited;
181+end;
182+
183+//procedure TListBox.WMDropFiles(var AMessage: TWMDropFiles);
184+//begin
185+// inherited;
186+//
187+// with TFileCatcher.Create(AMessage.Drop) do
188+// try
189+// for var i: Cardinal := 0 to Pred(FileCount) do
190+// Items.Add(GetFile(i));
191+// finally
192+// Free;
193+// end;
194+//
195+// AMessage.Result := 0;
196+//end;
197+
198+procedure TListView.WMDropFiles(var AMessage: TWMDropFiles);
199+begin
200+ inherited;
201+
202+ AMessage.Result := 1;
203+
204+ if Assigned(FOnDropFiles) then
205+ FOnDropFiles(Self,AMessage.Drop,AMessage.Result);
206+end;
207+
56208 { TWebBrowser }
57209
58210 constructor TWebBrowser.Create(AOwner: TComponent);
--- trunk/client/src/UFormManageNote.pas (revision 68)
+++ trunk/client/src/UFormManageNote.pas (revision 69)
@@ -5,7 +5,8 @@
55 uses
66 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
77 Dialogs, UFormBasicDialog, StdCtrls, Buttons, UPngBitBtn, ExtCtrls, PngImage,
8- KRK.Internet.Edge, Winapi.ActiveX, Vcl.ComCtrls;
8+ KRK.Internet.Edge, Winapi.ActiveX, Vcl.ComCtrls, UInterposersAndHelpers,
9+ System.ImageList, Vcl.ImgList, Vcl.Menus, Vcl.ActnPopup, Vcl.XPStyleActnCtrls;
910
1011 type
1112 TFormManageNote = class(TFormBasicDialog)
@@ -13,7 +14,10 @@
1314 TASHComment: TTabSheet;
1415 TASHAttachments: TTabSheet;
1516 EDBR: TEdgeBrowser;
16- Label1: TLabel;
17+ LIVIAttachments: TListView;
18+ IMLIAttachments: TImageList;
19+ PUABAttachments: TPopupActionBar;
20+ MNUICopyReferenceToFile: TMenuItem;
1721 procedure EDBRExecuteScript(Sender: TCustomEdgeBrowser; AResult: HRESULT; const AResultObjectAsJson: string);
1822 procedure EDBRCreateWebViewCompleted(Sender: TCustomEdgeBrowser; AResult: HRESULT);
1923 procedure FormCreate(Sender: TObject);
@@ -20,11 +24,18 @@
2024 procedure EDBRWebResourceRequested(Sender: TCustomEdgeBrowser; Args: TWebResourceRequestedEventArgs);
2125 procedure FormDestroy(Sender: TObject);
2226 procedure FormShow(Sender: TObject);
27+ procedure LIVIAttachmentsChange(Sender: TObject; Item: TListItem;
28+ Change: TItemChange);
29+ procedure LIVIAttachmentsKeyUp(Sender: TObject; var Key: Word;
30+ Shift: TShiftState);
31+ procedure MNUICopyReferenceToFileClick(Sender: TObject);
2332 private
2433 { Private declarations }
2534 FUpdating: Boolean;
2635 FComment: String;
2736 FPostContent: TStringStream;
37+
38+ procedure DoDropFiles(ASender: TObject; const ADropHandle: LRESULT; out AMessageResult: LRESULT);
2839 protected
2940 procedure ValidateSave; override;
3041 public
@@ -37,10 +48,56 @@
3748 {$R *.dfm}
3849
3950 uses
40- JSON, UFunctions, UScrapFunctions, KRK.Internet.WebView2, UConfigurations;
51+ WinApi.ShellApi, ClipBrd, JSON, UFunctions, UScrapFunctions, KRK.Internet.WebView2,
52+ UConfigurations;
4153
4254 { TFormManageNote }
4355
56+procedure TFormManageNote.MNUICopyReferenceToFileClick(Sender: TObject);
57+begin
58+ inherited;
59+ Clipboard.AsText := '<atta class="mceNonEditable"><atna>' + LIVIAttachments.Selected.Caption + '</atna><atnn>' + LIVIAttachments.Selected.Caption + '</atnn></atta>';
60+ Application.MessageBox(PChar('A referência ao arquivo "' + LIVIAttachments.Selected.Caption + '" foi adicionada à área de transferência. Você pode colá-la no editor de comentário, onde é possível também dar um apelido a esta referência, selecionando-a e clicando no ícone com um clipe de papel'),'Referência copiada',MB_ICONINFORMATION);
61+end;
62+
63+procedure TFormManageNote.DoDropFiles(ASender: TObject; const ADropHandle: LRESULT; out AMessageResult: LRESULT);
64+var
65+ Icon: TIcon;
66+begin
67+ // Parte do código existente em TFileCatcher que diz respeito a obtenção de
68+ // informações sobre arquivos foi obtido a partir de
69+ // https://www.swissdelphicenter.ch/en/showcode.php?id=421
70+
71+ TListView(ASender).Items.BeginUpdate;
72+ Icon := TIcon.Create;
73+ try
74+ with TFileCatcher.Create(ADropHandle) do
75+ try
76+ for var i: Cardinal := 0 to Pred(FileCount) do
77+ begin
78+ with TListView(ASender).Items.Add do
79+ begin
80+ Caption := ExtractFileName(FileNames[i]);
81+ SubItems.Add(FormatFloat('###,###,###,##0', FileSizes[i]) + ' Bytes');
82+ SubItems.Add(FileTypes[i]);
83+ Subitems.Add(ExtractFilePath(FileNames[i]));
84+
85+ Icon.Handle := FileIcons[i];
86+ ImageIndex := TListView(ASender).SmallImages.AddIcon(Icon);
87+ DestroyIcon(Icon.Handle);
88+ end;
89+ end;
90+ finally
91+ Free;
92+ end;
93+ finally
94+ Icon.Free;
95+ TListView(ASender).Items.EndUpdate;
96+ end;
97+
98+ AMessageResult := 0;
99+end;
100+
44101 procedure TFormManageNote.EDBRCreateWebViewCompleted(Sender: TCustomEdgeBrowser; AResult: HRESULT);
45102 begin
46103 inherited;
@@ -52,7 +109,7 @@
52109
53110 EDBR.Navigate(Configurations.MantisBTBaseUrl + '/mantis/config/MantisBTMonitorTinyMCEEditor.php');
54111 end;
55- faça algo para mostrar os anexos ao editar e permitir a inclusao de anexos ao inserir
112+
56113 procedure TFormManageNote.EDBRExecuteScript(Sender: TCustomEdgeBrowser; AResult: HRESULT; const AResultObjectAsJson: string);
57114 begin
58115 // A execução de scripts na página atual com ExecuteJavaScript retorna sempre
@@ -103,6 +160,8 @@
103160 // Este stream precisa ser criado e mantido assim durante a vida toda deste
104161 // form, porque ele será usado como conteúdo da requisição post
105162 FPostContent := TStringStream.Create('',TEncoding.UTF8);
163+
164+ LIVIAttachments.OnDropFiles := DoDropFiles;
106165 end;
107166
108167 procedure TFormManageNote.FormDestroy(Sender: TObject);
@@ -126,6 +185,25 @@
126185 PACO.ActivePage := TASHComment;
127186 end;
128187
188+procedure TFormManageNote.LIVIAttachmentsChange(Sender: TObject; Item: TListItem; Change: TItemChange);
189+begin
190+ inherited;
191+ if TListView(Sender).Items.Count = 0 then
192+ for var i: Byte := 0 to Pred(TListView(Sender).Columns.Count) do
193+ TListView(Sender).Columns[i].Width := -2
194+ else
195+ for var i: Byte := 0 to Pred(TListView(Sender).Columns.Count) do
196+ TListView(Sender).Columns[i].Width := -1;
197+end;
198+
199+procedure TFormManageNote.LIVIAttachmentsKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
200+begin
201+ inherited;
202+
203+ if Key = VK_DELETE then
204+ LIVIAttachments.DeleteSelected;
205+end;
206+
129207 class function TFormManageNote.ShowMeModal(AOwner: TComponent; ATaskNumber, ACommentId: Cardinal; out AComment: String; out AUpdateToken: String): TModalResult;
130208 begin
131209 Result := mrAbort; // Se tudo der errado...
Show on old repository browser