Revisión | 69 (tree) |
---|---|
Tiempo | 2021-12-17 03:04:32 |
Autor | derekwildstar |
Estilos atualizados
Interposer para TListView capaz de lidar com dropagem de arquivos
Adição de um TListView na tela de gerenciamento de comentário
@@ -117,7 +117,7 @@ | ||
117 | 117 | <VerInfo_MinorVer>0</VerInfo_MinorVer> |
118 | 118 | <VerInfo_Release>0</VerInfo_Release> |
119 | 119 | <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> | |
121 | 121 | <Debugger_RunParams>/desenvolvimento</Debugger_RunParams> |
122 | 122 | <VerInfo_AutoGenVersion>false</VerInfo_AutoGenVersion> |
123 | 123 | <VerInfo_AutoIncVersion>true</VerInfo_AutoIncVersion> |
@@ -124,7 +124,7 @@ | ||
124 | 124 | <DCC_DebugInformation>2</DCC_DebugInformation> |
125 | 125 | <DCC_SymbolReferenceInfo>2</DCC_SymbolReferenceInfo> |
126 | 126 | <DCC_DebugInfoInExe>true</DCC_DebugInfoInExe> |
127 | - <VerInfo_Build>374</VerInfo_Build> | |
127 | + <VerInfo_Build>419</VerInfo_Build> | |
128 | 128 | <DCC_MapFile>3</DCC_MapFile> |
129 | 129 | </PropertyGroup> |
130 | 130 | <ItemGroup> |
@@ -3,9 +3,54 @@ | ||
3 | 3 | interface |
4 | 4 | |
5 | 5 | uses |
6 | - SHDocVw, Winapi.Windows, Winapi.Messages, System.Classes; | |
6 | + SHDocVw, Winapi.Windows, Winapi.Messages, System.Classes, Vcl.ComCtrls, | |
7 | + Winapi.ShellAPI; | |
7 | 8 | |
8 | 9 | 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 | + | |
9 | 54 | // colocar isso no krakatoa... TKRKWebBrowser |
10 | 55 | TWebBrowser = class(SHDocVw.TWebBrowser) |
11 | 56 | private |
@@ -28,7 +73,7 @@ | ||
28 | 73 | implementation |
29 | 74 | |
30 | 75 | uses |
31 | - WinApi.CommCtrl, System.SysUtils; | |
76 | + WinApi.CommCtrl, System.SysUtils, Vcl.Graphics; | |
32 | 77 | |
33 | 78 | // Esta função de callback é usada para realização de subclasseamento de |
34 | 79 | // procedimentos de janela. AIdSubclass é um identificador único que é passado |
@@ -53,6 +98,113 @@ | ||
53 | 98 | end; |
54 | 99 | end; |
55 | 100 | |
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 | + | |
56 | 208 | { TWebBrowser } |
57 | 209 | |
58 | 210 | constructor TWebBrowser.Create(AOwner: TComponent); |
@@ -5,7 +5,8 @@ | ||
5 | 5 | uses |
6 | 6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, |
7 | 7 | 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; | |
9 | 10 | |
10 | 11 | type |
11 | 12 | TFormManageNote = class(TFormBasicDialog) |
@@ -13,7 +14,10 @@ | ||
13 | 14 | TASHComment: TTabSheet; |
14 | 15 | TASHAttachments: TTabSheet; |
15 | 16 | EDBR: TEdgeBrowser; |
16 | - Label1: TLabel; | |
17 | + LIVIAttachments: TListView; | |
18 | + IMLIAttachments: TImageList; | |
19 | + PUABAttachments: TPopupActionBar; | |
20 | + MNUICopyReferenceToFile: TMenuItem; | |
17 | 21 | procedure EDBRExecuteScript(Sender: TCustomEdgeBrowser; AResult: HRESULT; const AResultObjectAsJson: string); |
18 | 22 | procedure EDBRCreateWebViewCompleted(Sender: TCustomEdgeBrowser; AResult: HRESULT); |
19 | 23 | procedure FormCreate(Sender: TObject); |
@@ -20,11 +24,18 @@ | ||
20 | 24 | procedure EDBRWebResourceRequested(Sender: TCustomEdgeBrowser; Args: TWebResourceRequestedEventArgs); |
21 | 25 | procedure FormDestroy(Sender: TObject); |
22 | 26 | 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); | |
23 | 32 | private |
24 | 33 | { Private declarations } |
25 | 34 | FUpdating: Boolean; |
26 | 35 | FComment: String; |
27 | 36 | FPostContent: TStringStream; |
37 | + | |
38 | + procedure DoDropFiles(ASender: TObject; const ADropHandle: LRESULT; out AMessageResult: LRESULT); | |
28 | 39 | protected |
29 | 40 | procedure ValidateSave; override; |
30 | 41 | public |
@@ -37,10 +48,56 @@ | ||
37 | 48 | {$R *.dfm} |
38 | 49 | |
39 | 50 | uses |
40 | - JSON, UFunctions, UScrapFunctions, KRK.Internet.WebView2, UConfigurations; | |
51 | + WinApi.ShellApi, ClipBrd, JSON, UFunctions, UScrapFunctions, KRK.Internet.WebView2, | |
52 | + UConfigurations; | |
41 | 53 | |
42 | 54 | { TFormManageNote } |
43 | 55 | |
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 | + | |
44 | 101 | procedure TFormManageNote.EDBRCreateWebViewCompleted(Sender: TCustomEdgeBrowser; AResult: HRESULT); |
45 | 102 | begin |
46 | 103 | inherited; |
@@ -52,7 +109,7 @@ | ||
52 | 109 | |
53 | 110 | EDBR.Navigate(Configurations.MantisBTBaseUrl + '/mantis/config/MantisBTMonitorTinyMCEEditor.php'); |
54 | 111 | end; |
55 | - faça algo para mostrar os anexos ao editar e permitir a inclusao de anexos ao inserir | |
112 | + | |
56 | 113 | procedure TFormManageNote.EDBRExecuteScript(Sender: TCustomEdgeBrowser; AResult: HRESULT; const AResultObjectAsJson: string); |
57 | 114 | begin |
58 | 115 | // A execução de scripts na página atual com ExecuteJavaScript retorna sempre |
@@ -103,6 +160,8 @@ | ||
103 | 160 | // Este stream precisa ser criado e mantido assim durante a vida toda deste |
104 | 161 | // form, porque ele será usado como conteúdo da requisição post |
105 | 162 | FPostContent := TStringStream.Create('',TEncoding.UTF8); |
163 | + | |
164 | + LIVIAttachments.OnDropFiles := DoDropFiles; | |
106 | 165 | end; |
107 | 166 | |
108 | 167 | procedure TFormManageNote.FormDestroy(Sender: TObject); |
@@ -126,6 +185,25 @@ | ||
126 | 185 | PACO.ActivePage := TASHComment; |
127 | 186 | end; |
128 | 187 | |
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 | + | |
129 | 207 | class function TFormManageNote.ShowMeModal(AOwner: TComponent; ATaskNumber, ACommentId: Cardinal; out AComment: String; out AUpdateToken: String): TModalResult; |
130 | 208 | begin |
131 | 209 | Result := mrAbort; // Se tudo der errado... |