{"id":4041,"date":"2012-04-06T02:00:41","date_gmt":"2012-04-06T00:00:41","guid":{"rendered":"http:\/\/blogs.wittwer.fr\/whiler\/?p=4041"},"modified":"2023-03-12T14:58:52","modified_gmt":"2023-03-12T13:58:52","slug":"fonctions-delphi","status":"publish","type":"post","link":"https:\/\/blogs.wittwer.fr\/whiler\/2012\/04\/06\/fonctions-delphi\/","title":{"rendered":"Fonctions Delphi"},"content":{"rendered":"

R\u00e9guli\u00e8rement, je r\u00e9utilise les m\u00eames m\u00e9thodes parmi divers projets…<\/p>\n

J’en ai regroup\u00e9 certaines d’entre elles dans des unit\u00e9s que j’utilise lorsque j’en ai besoin, tandis que pour d’autres qui me servent moins souvent, je me contente de faire un copier\/coller.<\/p>\n

Le plus dur, en g\u00e9n\u00e9ral, est de retrouver le projet o\u00f9 j’en ai eu pr\u00e9c\u00e9demment besoin. \":$\" <\/p>\n

Alors, tout comme j’avais \u00e9crit un article sur les boutons de la barre des t\u00e2ches sous Windows 7<\/a>, et qui m’a encore servi pour wText2QR<\/a>, je r\u00e9dige un article o\u00f9 je vais recenser certaines des fonctions que j’utilise. Lorsque j’arriverai \u00e0 retrouver la r\u00e9f\u00e9rence d’une source, je l’ajouterai. Je sp\u00e9cifie n\u00e9anmoins que la plupart ont \u00e9t\u00e9 r\u00e9cup\u00e9r\u00e9e de pages Web au fil du temps, lorsque j’en ai eu pour la premi\u00e8re fois l’utilit\u00e9, \"(bow)\" et que je n’en suis pas l’auteur (j’ai \u00e9ventuellement fait des modifications pour mes propres exigences).<\/p>\n

\"Source<\/center><\/p>\n

<\/p>\n

Par o\u00f9 commencer… \":?\" <\/p>\n

\"Attention Certains bouts de code sont clairement hardcod\u00e9s pour mes besoins… relisez bien les scripts si vous en copiez certains !<\/p>\n

C’est par exemple le cas de cette unit\u00e9, que je me suis faite et qui fonctionne aussi bien sous Windows x86, x64 et Max OS X (VCL & FireMonkey) :<\/p>\n

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
<\/div><\/td>
\/\/\/ <summary><\/span>
\n\/\/\/   Unit with cross-platforms methods<\/span>
\n\/\/\/ <\/summary><\/span>
\n\/\/\/ <remarks><\/span>
\n\/\/\/   Currently works on Microsoft and Posix (OSX).<\/span>
\n\/\/\/ <\/remarks><\/span>
\nunit<\/span> uWxPlatform;<\/span>
\n
\ninterface<\/span>
\n
\nuses<\/span>
\n{$IFDEF MSWINDOWS}<\/span>
\n  Winapi.<\/span>ShellAPI<\/span>,<\/span> Winapi.<\/span>Windows<\/span>,<\/span> ShlObj,<\/span>
\n{$ENDIF MSWINDOWS}<\/span>
\n{$IFDEF POSIX}<\/span>
\n  Posix.<\/span>Stdlib<\/span>,<\/span>
\n{$ENDIF POSIX}<\/span>
\n{$IFDEF MACOS}<\/span>
\n  System.<\/span>RegularExpressions<\/span>,<\/span> MacApi.<\/span>AppKit<\/span>,<\/span> MacApi.<\/span>Foundation<\/span>,<\/span> Macapi.<\/span>CocoaTypes<\/span>,<\/span>
\n{$ENDIF MACOS}<\/span>
\n  System.<\/span>SysUtils<\/span>;<\/span>
\n
\n{$IFDEF MACOS}<\/span>
\nprocedure<\/span> NSBeep;<\/span> cdecl<\/span>;<\/span>  external<\/span> '\/System\/Library\/Frameworks\/AppKit.framework\/AppKit'<\/span> name '_NSBeep'<\/span>;<\/span>
\n{$ENDIF MACOS}<\/span>
\n
\ntype<\/span>
\n  TFileVersionInfo =<\/span> record<\/span>
\n    fCompanyName,<\/span>
\n    fFileDescription,<\/span>
\n    fFileVersion,<\/span>
\n    fInternalName,<\/span>
\n    fLegalCopyRight,<\/span>
\n    fLegalTradeMark,<\/span>
\n    fOriginalFileName,<\/span>
\n    fProductName,<\/span>
\n    fProductVersion,<\/span>
\n    fComments         :<\/span> string<\/span>;<\/span>
\n    fMajor,<\/span>
\n    fMinor,<\/span>
\n    fRelease,<\/span>
\n    fBuild            :<\/span> Word<\/span>;<\/span>
\n  end<\/span>;<\/span>
\n  \/\/\/ <summary><\/span>
\n  \/\/\/   The class which contains cross-platforms methods.<\/span>
\n  \/\/\/ <\/summary><\/span>
\n  \/\/\/ <remarks><\/span>
\n  \/\/\/   Procedures and functions are class methods when possible.<\/span>
\n  \/\/\/ <\/remarks><\/span>
\n  TMisc =<\/span> class<\/span>
\n
\n    \/\/\/ <summary><\/span>
\n    \/\/\/   To open the command.<\/span>
\n    \/\/\/ <\/summary><\/span>
\n    \/\/\/ <param name="sCommand"><\/span>
\n    \/\/\/   Command which is opened in the shell\/DOS.<\/span>
\n    \/\/\/ <\/param><\/span>
\n    \/\/\/ <remarks><\/span>
\n    \/\/\/   <para><\/span>
\n    \/\/\/     Example :<\/span>
\n    \/\/\/   <\/para><\/span>
\n    \/\/\/   <para><\/span>
\n    \/\/\/     TMisc.Open('https:\/\/www.whiler.com\/');<br \/>It loads the URL in the default browser.<\/span>
\n    \/\/\/   <\/para><\/span>
\n    \/\/\/   <para><\/span>
\n    \/\/\/     TMisc.Open('filename.txt');<br \/>It\u00a0opens the file <i>filename.txt<\/i> with the default text reader.<\/span>
\n    \/\/\/   <\/para><\/span>
\n    \/\/\/ <\/remarks><\/span>
\n    class<\/span> procedure<\/span> Open(<\/span>sCommand:<\/span> string<\/span>)<\/span>;<\/span>
\n    class<\/span> procedure<\/span> Beep;<\/span>
\n    class<\/span> function<\/span>  BrowseForFolder(<\/span>const<\/span> ATitle:<\/span> string<\/span>;<\/span> var<\/span> ADir:<\/span> string<\/span>)<\/span>:<\/span> Boolean<\/span>;<\/span>
\n    class<\/span> procedure<\/span> GetAppVersionInfo(<\/span>sAppNamePath:<\/span> string<\/span>;<\/span> var<\/span> aFileVersionInfo:<\/span> TFileVersionInfo)<\/span>;<\/span> static;<\/span>
\n    class<\/span> function<\/span>  IsCtrlDown:<\/span> Boolean<\/span>;<\/span>
\n    class<\/span> function<\/span>  IsShiftDown:<\/span> Boolean<\/span>;<\/span>
\n  private<\/span>
\n  end<\/span>;<\/span>
\n
\nimplementation<\/span>
\n
\nvar<\/span>
\n  lg_StartFolder:<\/span> String<\/span>;<\/span>
\n
\n
\n
\n{$IFDEF MSWINDOWS}<\/span>
\nfunction<\/span> BrowseForFolderCallBack(<\/span>Wnd:<\/span> HWND;<\/span> uMsg:<\/span> UINT;<\/span> lParam,<\/span> lpData:<\/span> LPARAM)<\/span>:<\/span> Integer<\/span> stdcall<\/span>;<\/span>
\nbegin<\/span>
\n  if<\/span> (<\/span>uMsg =<\/span> BFFM_INITIALIZED)<\/span> then<\/span>
\n  begin<\/span>
\n    SendMessage(<\/span>Wnd,<\/span> BFFM_SETSELECTION,<\/span> 1<\/span>,<\/span> Integer<\/span>(<\/span>@<\/span>lg_StartFolder[<\/span>1<\/span>]<\/span>)<\/span>)<\/span>;<\/span>
\n    Sleep<\/span>(<\/span>500<\/span>)<\/span>;<\/span>
\n    PostMessage(<\/span>Wnd,<\/span> BFFM_SETSELECTION,<\/span> 1<\/span>,<\/span> Integer<\/span>(<\/span>@<\/span>lg_StartFolder[<\/span>1<\/span>]<\/span>)<\/span>)<\/span>;<\/span>
\n  end<\/span>;<\/span>
\n  Result :<\/span>=<\/span> 0<\/span>;<\/span>
\nend<\/span>;<\/span>
\n{$ENDIF MSWINDOWS}<\/span>
\n
\nclass<\/span> procedure<\/span> TMisc.<\/span>Open<\/span>(<\/span>sCommand:<\/span> string<\/span>)<\/span>;<\/span>
\nbegin<\/span>
\n{$IFDEF MSWINDOWS}<\/span>
\n  ShellExecute(<\/span>0<\/span>,<\/span> 'OPEN'<\/span>,<\/span> PChar<\/span>(<\/span>sCommand)<\/span>,<\/span> ''<\/span>,<\/span> ''<\/span>,<\/span> SW_SHOWNORMAL)<\/span>;<\/span>
\n{$ENDIF MSWINDOWS}<\/span>
\n{$IFDEF POSIX}<\/span>
\n  _system(<\/span>PAnsiChar<\/span>(<\/span>'open '<\/span> +<\/span> AnsiString<\/span>(<\/span>sCommand)<\/span>)<\/span>)<\/span>;<\/span>
\n{$ENDIF POSIX}<\/span>
\nend<\/span>;<\/span>
\n
\nclass<\/span> procedure<\/span> TMisc.<\/span>Beep<\/span>;<\/span>
\nbegin<\/span>
\n{$IFDEF MSWINDOWS}<\/span>
\n  Beep;<\/span>
\n{$ENDIF MSWINDOWS}<\/span>
\n{$IFDEF MACOS}<\/span>
\n  NSBeep;<\/span>
\n{$ENDIF MACOS}<\/span>
\nend<\/span>;<\/span>
\n
\nclass<\/span> function<\/span> TMisc.<\/span>BrowseForFolder<\/span>(<\/span>const<\/span> ATitle:<\/span> string<\/span>;<\/span> var<\/span> ADir:<\/span> string<\/span>)<\/span>:<\/span> Boolean<\/span>;<\/span>
\n{$IFDEF MACOS}<\/span>
\nvar<\/span>
\n  LOpenDir:<\/span> NSOpenPanel;<\/span>
\n  LInitialDir:<\/span> NSURL;<\/span>
\n  LDlgResult:<\/span> NSInteger;<\/span>
\nbegin<\/span>
\n  Result   :<\/span>=<\/span> False<\/span>;<\/span>
\n  LOpenDir :<\/span>=<\/span> TNSOpenPanel.<\/span>Wrap<\/span>(<\/span>TNSOpenPanel.<\/span>OCClass<\/span>.<\/span>openPanel<\/span>)<\/span>;<\/span>
\n  LOpenDir.<\/span>setAllowsMultipleSelection<\/span>(<\/span>False<\/span>)<\/span>;<\/span>
\n  LOpenDir.<\/span>setCanChooseFiles<\/span>(<\/span>False<\/span>)<\/span>;<\/span>
\n  LOpenDir.<\/span>setCanChooseDirectories<\/span>(<\/span>True<\/span>)<\/span>;<\/span>
\n  if<\/span> (<\/span>ADir <> ''<\/span>)<\/span> then<\/span>
\n  begin<\/span>
\n    LInitialDir :<\/span>=<\/span> TNSURL.<\/span>Create<\/span>;<\/span>
\n    LInitialDir.<\/span>initFileURLWithPath<\/span>(<\/span>NSSTR(<\/span>ADir)<\/span>)<\/span>;<\/span>
\n    LOpenDir.<\/span>setDirectoryURL<\/span>(<\/span>LInitialDir)<\/span>;<\/span>
\n  end<\/span>;<\/span>
\n  if<\/span> (<\/span>ATitle <> ''<\/span>)<\/span> then<\/span>
\n  begin<\/span>
\n    LOpenDir.<\/span>setTitle<\/span>(<\/span>NSSTR(<\/span>ATitle)<\/span>)<\/span>;<\/span>
\n  end<\/span>;<\/span>
\n  LOpenDir.<\/span>retain<\/span>;<\/span>
\n  try<\/span>
\n    LDlgResult :<\/span>=<\/span> LOpenDir.<\/span>runModal<\/span>;<\/span>
\n    if<\/span> (<\/span>LDlgResult =<\/span> NSOKButton)<\/span> then<\/span>
\n    begin<\/span>
\n      ADir   :<\/span>=<\/span> string<\/span>(<\/span>TNSUrl.<\/span>Wrap<\/span>(<\/span>LOpenDir.<\/span>URLs<\/span>.<\/span>objectAtIndex<\/span>(<\/span>0<\/span>)<\/span>)<\/span>.<\/span>relativePath<\/span>.<\/span>UTF8String<\/span>)<\/span>;<\/span>
\n      Result :<\/span>=<\/span> True<\/span>;<\/span>
\n    end<\/span>;<\/span>
\n  finally<\/span>
\n    LOpenDir.<\/span>release<\/span>;<\/span>
\n  end<\/span>;<\/span>
\n{$ENDIF MACOS}<\/span>
\n{$IFDEF MSWINDOWS}<\/span>
\nvar<\/span>
\n  browse_info :<\/span> TBrowseInfo;<\/span>
\n  folder      :<\/span> array<\/span>[<\/span>0<\/span>..<\/span>MAX_PATH<\/span>]<\/span> of<\/span> char<\/span>;<\/span>
\n  find_context:<\/span> PItemIDList;<\/span>
\nbegin<\/span>
\n  Result :<\/span>=<\/span> False<\/span>;<\/span>
\n  \/\/--------------------------<\/span>
\n  \/\/ Initialise the structure.<\/span>
\n  \/\/--------------------------<\/span>
\n  FillChar<\/span>(<\/span>browse_info,<\/span>SizeOf<\/span>(<\/span>browse_info)<\/span>,<\/span>#0<\/span>)<\/span>;<\/span>
\n  lg_StartFolder             :<\/span>=<\/span> ADir;<\/span>
\n  browse_info.<\/span>pszDisplayName<\/span> :<\/span>=<\/span> @<\/span>folder[<\/span>0<\/span>]<\/span>;<\/span>
\n  browse_info.<\/span>lpszTitle<\/span>      :<\/span>=<\/span> PChar<\/span>(<\/span>ATitle)<\/span>;<\/span>
\n  browse_info.<\/span>ulFlags<\/span>        :<\/span>=<\/span> BIF_RETURNONLYFSDIRS or<\/span> BIF_NEWDIALOGSTYLE;<\/span>
\n\/\/  browse_info.hwndOwner := appHWND;<\/span>
\n  if<\/span> (<\/span>ADir <> ''<\/span>)<\/span> then<\/span>
\n  begin<\/span>
\n    browse_info.<\/span>lpfn<\/span> :<\/span>=<\/span> BrowseForFolderCallBack;<\/span>
\n  end<\/span>;<\/span>
\n  find_context :<\/span>=<\/span> SHBrowseForFolder(<\/span>browse_info)<\/span>;<\/span>
\n  if<\/span> Assigned<\/span>(<\/span>find_context)<\/span> then<\/span>
\n  begin<\/span>
\n    if<\/span> SHGetPathFromIDList(<\/span>find_context,<\/span>folder)<\/span> then<\/span>
\n    begin<\/span>
\n      ADir   :<\/span>=<\/span> folder;<\/span>
\n      Result :<\/span>=<\/span> True<\/span>;<\/span>
\n    end<\/span>
\n    else<\/span>
\n      ADir :<\/span>=<\/span> ''<\/span>;<\/span>
\n    GlobalFreePtr(<\/span>find_context)<\/span>;<\/span>
\n  end<\/span>
\n  else<\/span>
\n    ADir :<\/span>=<\/span> ''<\/span>;<\/span>
\n{$ENDIF MSWINDOWS}<\/span>
\nend<\/span>;<\/span>
\n
\nclass<\/span> procedure<\/span> TMisc.<\/span>GetAppVersionInfo<\/span>(<\/span>sAppNamePath:<\/span> string<\/span>;<\/span> var<\/span> aFileVersionInfo:<\/span> TFileVersionInfo)<\/span>;<\/span>
\nvar<\/span>
\n{$IFDEF MSWINDOWS}<\/span>
\n  iVerSize     :<\/span> Integer<\/span>;<\/span>
\n  pcVerBuf     :<\/span> PChar<\/span>;<\/span>
\n  pVerBufValue :<\/span> Pointer<\/span>;<\/span>
\n  iVerHandle   :<\/span> Cardinal<\/span>;<\/span>
\n  iVerBufLen   :<\/span> Cardinal<\/span>;<\/span>
\n  sVerKey      :<\/span> string<\/span>;<\/span>
\n
\n  function<\/span> GetInfo(<\/span>ThisKey:<\/span> string<\/span>)<\/span>:<\/span> string<\/span>;<\/span>
\n  begin<\/span>
\n    Result  :<\/span>=<\/span> ''<\/span>;<\/span>
\n    sVerKey :<\/span>=<\/span> '\\StringFileInfo\\'<\/span> +<\/span> IntToHex<\/span>(<\/span>loword(<\/span>integer<\/span>(<\/span>pVerBufValue^<\/span>)<\/span>)<\/span>,<\/span> 4<\/span>)<\/span> +<\/span>
\n                  IntToHex<\/span>(<\/span>hiword(<\/span>integer<\/span>(<\/span>pVerBufValue^<\/span>)<\/span>)<\/span>,<\/span> 4<\/span>)<\/span> +<\/span> '\\'<\/span> +<\/span> ThisKey;<\/span>
\n
\n    if<\/span> VerQueryValue(<\/span>pcVerBuf,<\/span> PChar<\/span>(<\/span>sVerKey)<\/span>,<\/span> pVerBufValue,<\/span> iVerBufLen)<\/span> then<\/span>
\n      Result :<\/span>=<\/span> StrPas<\/span>(<\/span>PChar<\/span>(<\/span>pVerBufValue)<\/span>)<\/span>;<\/span>
\n
\n  end<\/span>;<\/span>
\n
\n  function<\/span> QueryValue(<\/span>ThisValue:<\/span> string<\/span>)<\/span>:<\/span> string<\/span>;<\/span>
\n  begin<\/span>
\n    Result :<\/span>=<\/span> ''<\/span>;<\/span>
\n
\n    if<\/span> GetFileVersionInfo(<\/span>PChar<\/span>(<\/span>sAppNamePath)<\/span>,<\/span> iVerHandle,<\/span> iVerSize,<\/span> pcVerBuf)<\/span> and<\/span>
\n        VerQueryValue(<\/span>pcVerBuf,<\/span> '\\VarFileInfo\\Translation'<\/span>,<\/span> pVerBufValue,<\/span> iVerBufLen)<\/span> then<\/span>
\n      Result :<\/span>=<\/span> GetInfo(<\/span>ThisValue)<\/span>;<\/span>
\n
\n  end<\/span>;<\/span>
\n
\n  function<\/span> GetFileVersion<\/span>(<\/span>const<\/span> FileName:<\/span> string<\/span>)<\/span>:<\/span> boolean<\/span>;<\/span>
\n  \/\/ Returns True on success and False on failure.<\/span>
\n  var<\/span>
\n    lwSize,<\/span> lwLen :<\/span> LongWord<\/span>;<\/span>
\n    hFile         :<\/span> Cardinal<\/span>;<\/span>
\n    pcBuffer      :<\/span> PChar<\/span>;<\/span>
\n    pInfo         :<\/span> ^<\/span>VS_FIXEDFILEINFO;<\/span>
\n  begin<\/span>
\n    Result :<\/span>=<\/span> False<\/span>;<\/span>
\n    lwSize :<\/span>=<\/span> GetFileVersionInfoSize(<\/span>PWideChar<\/span>(<\/span>FileName)<\/span>,<\/span> hFile)<\/span>;<\/span>
\n    if<\/span> lwSize > 0<\/span> then<\/span>
\n    begin<\/span>
\n      GetMem<\/span>(<\/span>pcBuffer,<\/span> lwSize)<\/span>;<\/span>
\n      if<\/span> GetFileVersionInfo(<\/span>Pointer<\/span>(<\/span>FileName)<\/span>,<\/span> 0<\/span>,<\/span> lwSize,<\/span> pcBuffer)<\/span> then<\/span>
\n        if<\/span> VerQueryValue(<\/span>pcBuffer,<\/span> '\\'<\/span>,<\/span> pointer<\/span>(<\/span>pInfo)<\/span>,<\/span> lwLen)<\/span> then<\/span>
\n        begin<\/span>
\n          aFileVersionInfo.<\/span>fMajor<\/span>   :<\/span>=<\/span> HiWord(<\/span>pInfo.<\/span>dwFileVersionMS<\/span>)<\/span>;<\/span>
\n          aFileVersionInfo.<\/span>fMinor<\/span>   :<\/span>=<\/span> LoWord(<\/span>pInfo.<\/span>dwFileVersionMS<\/span>)<\/span>;<\/span>
\n          aFileVersionInfo.<\/span>fRelease<\/span> :<\/span>=<\/span> HiWord(<\/span>pInfo.<\/span>dwFileVersionLS<\/span>)<\/span>;<\/span>
\n          aFileVersionInfo.<\/span>fBuild<\/span>   :<\/span>=<\/span> LoWord(<\/span>pInfo.<\/span>dwFileVersionLS<\/span>)<\/span>;<\/span>
\n          Result  :<\/span>=<\/span> True<\/span>;<\/span>
\n        end<\/span>;<\/span>
\n      FreeMem<\/span>(<\/span>pcBuffer)<\/span>;<\/span>
\n    end<\/span>;<\/span>
\n  end<\/span>;<\/span>
\n{$ENDIF MSWINDOWS}<\/span>
\n{$IFDEF MACOS}<\/span>
\n  sPlist  :<\/span> string<\/span>;<\/span>
\n  sContent:<\/span> string<\/span>;<\/span>
\n  sLine   :<\/span> string<\/span>;<\/span>
\n  tf      :<\/span> TextFile<\/span>;<\/span>
\n
\n  function<\/span> QueryValue(<\/span>ThisValue:<\/span> string<\/span>)<\/span>:<\/span> string<\/span>;<\/span>
\n  var<\/span>
\n    reSearch:<\/span> TRegEx;<\/span>
\n    mFound  :<\/span> TMatch;<\/span>
\n  begin<\/span>
\n    Result   :<\/span>=<\/span> ''<\/span>;<\/span>
\n    reSearch :<\/span>=<\/span> TRegEx.<\/span>Create<\/span>(<\/span>'<key>'<\/span> +<\/span> ThisValue +<\/span> '<\/key>\\s*<string>([^<]*)<\/string>'<\/span>)<\/span>;<\/span>
\n    mFound   :<\/span>=<\/span> reSearch.<\/span>Match<\/span>(<\/span>sContent)<\/span>;<\/span>
\n    if<\/span> mFound.<\/span>Success<\/span> then<\/span>
\n    begin<\/span>
\n      Result :<\/span>=<\/span> mFound.<\/span>Groups<\/span>[<\/span>1<\/span>]<\/span>.<\/span>Value<\/span>;<\/span>
\n    end<\/span>;<\/span>
\n  end<\/span>;<\/span>
\n
\n{$ENDIF MACOS}<\/span>
\nbegin<\/span>
\n  if<\/span> sAppNamePath =<\/span> ''<\/span> then<\/span>
\n    sAppNamePath :<\/span>=<\/span> ParamStr<\/span>(<\/span>0<\/span>)<\/span>;<\/span>
\n
\n{$IFDEF MSWINDOWS}<\/span>
\n  GetFileVersion<\/span>(<\/span>sAppNamePath)<\/span>;<\/span>
\n  iVerSize :<\/span>=<\/span> GetFileVersionInfoSize(<\/span>PChar<\/span>(<\/span>sAppNamePath)<\/span>,<\/span> iVerHandle)<\/span>;<\/span>
\n  pcVerBuf :<\/span>=<\/span> AllocMem<\/span>(<\/span>iVerSize)<\/span>;<\/span>
\n  try<\/span>
\n    with<\/span> aFileVersionInfo do<\/span>
\n    begin<\/span>
\n      fCompanyName      :<\/span>=<\/span> QueryValue(<\/span>'CompanyName'<\/span>)<\/span>;<\/span>
\n      fFileDescription  :<\/span>=<\/span> QueryValue(<\/span>'FileDescription'<\/span>)<\/span>;<\/span>
\n      fFileVersion      :<\/span>=<\/span> QueryValue(<\/span>'FileVersion'<\/span>)<\/span>;<\/span>
\n      fInternalName     :<\/span>=<\/span> QueryValue(<\/span>'InternalName'<\/span>)<\/span>;<\/span>
\n      fLegalCopyRight   :<\/span>=<\/span> QueryValue(<\/span>'LegalCopyRight'<\/span>)<\/span>;<\/span>
\n      fLegalTradeMark   :<\/span>=<\/span> QueryValue(<\/span>'LegalTradeMark'<\/span>)<\/span>;<\/span>
\n      fOriginalFileName :<\/span>=<\/span> QueryValue(<\/span>'OriginalFileName'<\/span>)<\/span>;<\/span>
\n      fProductName      :<\/span>=<\/span> QueryValue(<\/span>'ProductName'<\/span>)<\/span>;<\/span>
\n      fProductVersion   :<\/span>=<\/span> QueryValue(<\/span>'ProductVersion'<\/span>)<\/span>;<\/span>
\n      fComments         :<\/span>=<\/span> QueryValue(<\/span>'Comments'<\/span>)<\/span>;<\/span>
\n    end<\/span>;<\/span>
\n  finally<\/span>
\n    FreeMem<\/span>(<\/span>pcVerBuf,<\/span> iVerSize)<\/span>;<\/span>
\n  end<\/span>;<\/span>
\n{$ENDIF MSWINDOWS}<\/span>
\n{$IFDEF MACOS}<\/span>
\n  sContent :<\/span>=<\/span> ''<\/span>;<\/span>
\n  sPlist   :<\/span>=<\/span> ExpandFileName<\/span>(<\/span>ExtractFilePath<\/span>(<\/span>sAppNamePath)<\/span> +<\/span> '\/..\/Info.plist'<\/span>)<\/span>;<\/span>
\n  if<\/span> FileExists<\/span>(<\/span>sPlist)<\/span> then<\/span>
\n  begin<\/span>
\n    AssignFile<\/span>(<\/span>tf,<\/span> sPlist)<\/span>;<\/span>
\n    Reset<\/span>(<\/span>tf)<\/span>;<\/span>
\n    while<\/span> not<\/span> Eof<\/span>(<\/span>tf)<\/span> do<\/span>
\n    begin<\/span>
\n      ReadLn<\/span>(<\/span>tf,<\/span> sLine)<\/span>;<\/span>
\n      sContent :<\/span>=<\/span> sContent +<\/span> sLine;<\/span>
\n    end<\/span>;<\/span>
\n    CloseFile<\/span>(<\/span>tf)<\/span>;<\/span>
\n  end<\/span>;<\/span>
\n  with<\/span> aFileVersionInfo do<\/span>
\n  begin<\/span>
\n    fCompanyName      :<\/span>=<\/span> 'Whiler.com \u00a9'<\/span>;<\/span>
\n    fFileDescription  :<\/span>=<\/span> ''<\/span>;<\/span>
\n    fFileVersion      :<\/span>=<\/span> QueryValue(<\/span>'CFBundleVersion'<\/span>)<\/span>;<\/span>
\n    fInternalName     :<\/span>=<\/span> QueryValue(<\/span>'CFBundleExecutable'<\/span>)<\/span>;<\/span>
\n    fLegalCopyRight   :<\/span>=<\/span> 'Whiler.com \u00a9'<\/span>;<\/span>
\n    fLegalTradeMark   :<\/span>=<\/span> 'Whiler.com \u00a9'<\/span>;<\/span>
\n    fOriginalFileName :<\/span>=<\/span> QueryValue(<\/span>'CFBundleDisplayName'<\/span>)<\/span>;<\/span>
\n    fProductName      :<\/span>=<\/span> QueryValue(<\/span>'CFBundleName'<\/span>)<\/span>;<\/span>
\n    fProductVersion   :<\/span>=<\/span> QueryValue(<\/span>'CFBundleVersion'<\/span>)<\/span>;<\/span>
\n    fComments         :<\/span>=<\/span> ''<\/span>;<\/span>
\n  end<\/span>;<\/span>
\n{$ENDIF MACOS}<\/span>
\nend<\/span>;<\/span>
\n
\nclass<\/span> function<\/span> TMisc.<\/span>IsCtrlDown<\/span>:<\/span> Boolean<\/span>;<\/span>
\n{$IFDEF MSWINDOWS}<\/span>
\nvar<\/span>
\n  ksCurrent :<\/span> TKeyboardState;<\/span>
\nbegin<\/span>
\n  GetKeyboardState(<\/span>ksCurrent)<\/span>;<\/span>
\n  Result :<\/span>=<\/span> (<\/span>(<\/span>ksCurrent[<\/span>VK_CONTROL]<\/span> and<\/span> 128<\/span>)<\/span> <> 0<\/span>)<\/span>;<\/span>
\n{$ENDIF MSWINDOWS}<\/span>
\n{$IFDEF MACOS}<\/span>
\nbegin<\/span>
\n  Result :<\/span>=<\/span> NSControlKeyMask and<\/span> TNSEvent.<\/span>OCClass<\/span>.<\/span>modifierFlags<\/span> =<\/span> NSControlKeyMask;<\/span>
\n{$ENDIF MACOS}<\/span>
\nend<\/span>;<\/span>
\n
\nclass<\/span> function<\/span> TMisc.<\/span>IsShiftDown<\/span>:<\/span> Boolean<\/span>;<\/span>
\n{$IFDEF MSWINDOWS}<\/span>
\nvar<\/span>
\n  ksCurrent :<\/span> TKeyboardState;<\/span>
\nbegin<\/span>
\n  GetKeyboardState(<\/span>ksCurrent)<\/span>;<\/span>
\n  Result :<\/span>=<\/span> (<\/span>(<\/span>ksCurrent[<\/span>VK_SHIFT]<\/span> and<\/span> 128<\/span>)<\/span> <> 0<\/span>)<\/span>;<\/span>
\n{$ENDIF MSWINDOWS}<\/span>
\n{$IFDEF MACOS}<\/span>
\nbegin<\/span>
\n  Result :<\/span>=<\/span> NSShiftKeyMask and<\/span> TNSEvent.<\/span>OCClass<\/span>.<\/span>modifierFlags<\/span> =<\/span> NSShiftKeyMask;<\/span>
\n{$ENDIF MACOS}<\/span>
\nend<\/span>;<\/span>
\n
\nend<\/span>.<\/span><\/div><\/td><\/tr><\/tbody><\/table><\/div>\n

J’avais d\u00e9j\u00e0 publi\u00e9 une partie de ce code dans cet article<\/a>.<\/p>\n

Retrouvez d’autres bouts de code sur la page suivante<\/a>…
\n
\nAvec la VCL, les couleurs (sans transparence) sont cod\u00e9es en Bleu-Vert-Rouge… Pour obtenir du Rouge-Vert-Bleu, une fonction qui inverse le rouge et le bleu (et donc utilisable dans les deux sens de conversion) :<\/p>\n

1
2
3
4
5
6
7
8
9
<\/div><\/td>
function<\/span> SwitchRB(<\/span>RGB:<\/span> TColor)<\/span>:<\/span> TColor;<\/span>
\nvar<\/span>
\n  R,<\/span> G,<\/span> B:<\/span> Integer<\/span>;<\/span>
\nbegin<\/span>
\n  R      :<\/span>=<\/span>   RGB div<\/span> $10000<\/span>;<\/span>
\n  G      :<\/span>=<\/span> (<\/span>(<\/span>RGB mod<\/span> $10000<\/span>)<\/span> div<\/span> $100<\/span>)<\/span> shl<\/span>  8<\/span>;<\/span>
\n  B      :<\/span>=<\/span>  (<\/span>RGB mod<\/span> $100<\/span>  )<\/span>           shl<\/span> 16<\/span>;<\/span>
\n  Result :<\/span>=<\/span> R +<\/span> G +<\/span> B;<\/span>
\nend<\/span>;<\/span><\/div><\/td><\/tr><\/tbody><\/table><\/div>\n

 
\nPour tester si les touches Contr\u00f4le<\/em> ou Majuscule<\/em> sont enfonc\u00e9es :<\/p>\n

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
<\/div><\/td>
\/\/ https:\/\/delphi.about.com\/cs\/adptips2000\/a\/bltip0400_3.htm<\/span>
\nfunction<\/span> isCtrlDown :<\/span> Boolean<\/span>;<\/span>
\nvar<\/span>
\n  ksCurrent :<\/span> TKeyboardState;<\/span>
\nbegin<\/span>
\n  GetKeyboardState(<\/span>ksCurrent)<\/span>;<\/span>
\n  Result :<\/span>=<\/span> (<\/span>(<\/span>ksCurrent[<\/span>VK_CONTROL]<\/span> and<\/span> 128<\/span>)<\/span> <> 0<\/span>)<\/span>;<\/span>
\nend<\/span>;<\/span>
\n
\nfunction<\/span> isShiftDown:<\/span> Boolean<\/span>;<\/span>
\nvar<\/span>
\n  ksCurrent :<\/span> TKeyboardState;<\/span>
\nbegin<\/span>
\n  GetKeyboardState(<\/span>ksCurrent)<\/span>;<\/span>
\n  Result :<\/span>=<\/span> (<\/span>(<\/span>ksCurrent[<\/span>VK_SHIFT]<\/span> and<\/span> 128<\/span>)<\/span> <> 0<\/span>)<\/span>;<\/span>
\nend<\/span>;<\/span><\/div><\/td><\/tr><\/tbody><\/table><\/div>\n

 
\nPour effectuer une rotation d’une image au format PNG :<\/p>\n

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
<\/div><\/td>
\/\/ https:\/\/www.delphipraxis.net\/559330-post20.html (sans la fuite m\u00e9moire)<\/span>
\nprocedure<\/span> SmoothRotate(<\/span>var<\/span> aPng:<\/span> TPngImage;<\/span> Angle:<\/span> Extended<\/span>)<\/span>;<\/span>
\n
\n  {Supporting functions: Inutile si on importe System.Math}<\/span>
\n  function<\/span> TrimInt(<\/span>i,<\/span> Min,<\/span> Max:<\/span> Integer<\/span>)<\/span>:<\/span> Integer<\/span>;<\/span>
\n  begin<\/span>
\n    if<\/span>      (<\/span>i > Max)<\/span> then<\/span> Result :<\/span>=<\/span> Max
\n    else<\/span> if<\/span> (<\/span>i < Min)<\/span> then<\/span> Result :<\/span>=<\/span> Min
\n    else<\/span>                   Result :<\/span>=<\/span> i;<\/span>
\n  end<\/span>;<\/span>
\n  function<\/span> IntToByte(<\/span>i:<\/span> Integer<\/span>)<\/span>:<\/span> Byte<\/span>;<\/span>
\n  begin<\/span>
\n    if<\/span>      (<\/span>i > 255<\/span>)<\/span> then<\/span> Result :<\/span>=<\/span> 255<\/span>
\n    else<\/span> if<\/span> (<\/span>i < 0<\/span>  )<\/span> then<\/span> Result :<\/span>=<\/span> 0<\/span>
\n    else<\/span>                   Result :<\/span>=<\/span> i;<\/span>
\n  end<\/span>;<\/span>
\n  function<\/span> Min<\/span>(<\/span>A,<\/span> B:<\/span> Double<\/span>)<\/span>:<\/span> Double<\/span>;<\/span>
\n  begin<\/span>
\n    if<\/span> (<\/span>A < B)<\/span> then<\/span> Result :<\/span>=<\/span> A
\n    else<\/span>            Result :<\/span>=<\/span> B;<\/span>
\n  end<\/span>;<\/span>
\n  function<\/span> Max<\/span>(<\/span>A,<\/span> B:<\/span> Double<\/span>)<\/span>:<\/span> Double<\/span>;<\/span>
\n  begin<\/span>
\n    if<\/span> (<\/span>A > B)<\/span> then<\/span> Result :<\/span>=<\/span> A
\n    else<\/span>            Result :<\/span>=<\/span> B;<\/span>
\n  end<\/span>;<\/span>
\n  function<\/span> Ceil<\/span>(<\/span>A:<\/span> Double<\/span>)<\/span>:<\/span> Integer<\/span>;<\/span>
\n  begin<\/span>
\n    Result :<\/span>=<\/span> Integer<\/span>(<\/span>Trunc<\/span>(<\/span>A)<\/span>)<\/span>;<\/span>
\n    if<\/span> (<\/span>Frac<\/span>(<\/span>A)<\/span> > 0<\/span>)<\/span> then<\/span>
\n      Inc<\/span>(<\/span>Result)<\/span>;<\/span>
\n  end<\/span>;<\/span>
\n
\n  {Calculates the png new size}<\/span>
\n  function<\/span> newsize:<\/span> TSize;<\/span>
\n  var<\/span>
\n    fRadians          :<\/span> Extended<\/span>;<\/span>
\n    fCosine,<\/span> fSine    :<\/span> Double<\/span>;<\/span>
\n    fPoint1x,<\/span> fPoint1y:<\/span> Double<\/span>;<\/span>
\n    fPoint2x,<\/span> fPoint2y:<\/span> Double<\/span>;<\/span>
\n    fPoint3x,<\/span> fPoint3y:<\/span> Double<\/span>;<\/span>
\n    fMinx,<\/span> fMiny      :<\/span> Double<\/span>;<\/span>
\n    fMaxx,<\/span> fMaxy      :<\/span> Double<\/span>;<\/span>
\n  begin<\/span>
\n    {Convert degrees to radians}<\/span>
\n    fRadians :<\/span>=<\/span> (<\/span>2<\/span> *<\/span> Pi *<\/span> Angle)<\/span> \/<\/span> 360<\/span>;<\/span>
\n
\n    fCosine :<\/span>=<\/span> Abs<\/span>(<\/span>Cos<\/span>(<\/span>fRadians)<\/span>)<\/span>;<\/span>
\n    fSine   :<\/span>=<\/span> Abs<\/span>(<\/span>Sin<\/span>(<\/span>fRadians)<\/span>)<\/span>;<\/span>
\n
\n    fPoint1x :<\/span>=<\/span> (<\/span>-<\/span>aPng.<\/span>Height<\/span> *<\/span> fSine)<\/span>;<\/span>
\n    fPoint1y :<\/span>=<\/span> (<\/span> aPng.<\/span>Height<\/span> *<\/span> fCosine)<\/span>;<\/span>
\n    fPoint2x :<\/span>=<\/span> (<\/span> aPng.<\/span>Width<\/span>  *<\/span> fCosine -<\/span> aPng.<\/span>Height<\/span> *<\/span> fSine)<\/span>;<\/span>
\n    fPoint2y :<\/span>=<\/span> (<\/span> aPng.<\/span>Height<\/span> *<\/span> fCosine +<\/span> aPng.<\/span>Width<\/span>  *<\/span> fSine)<\/span>;<\/span>
\n    fPoint3x :<\/span>=<\/span> (<\/span> aPng.<\/span>Width<\/span>  *<\/span> fCosine)<\/span>;<\/span>
\n    fPoint3y :<\/span>=<\/span> (<\/span> aPng.<\/span>Width<\/span>  *<\/span> fSine)<\/span>;<\/span>
\n
\n    fMinx :<\/span>=<\/span> Min<\/span>(<\/span>0<\/span>,<\/span> Min<\/span>(<\/span>fPoint1x,<\/span> Min<\/span>(<\/span>fPoint2x,<\/span> fPoint3x)<\/span>)<\/span>)<\/span>;<\/span>
\n    fMiny :<\/span>=<\/span> Min<\/span>(<\/span>0<\/span>,<\/span> Min<\/span>(<\/span>fPoint1y ,<\/span>Min<\/span>(<\/span>fPoint2y,<\/span> fPoint3y)<\/span>)<\/span>)<\/span>;<\/span>
\n    fMaxx :<\/span>=<\/span> Max<\/span>(<\/span>fPoint1x,<\/span> Max<\/span>(<\/span>fPoint2x,<\/span> fPoint3x)<\/span>)<\/span>;<\/span>
\n    fMaxy :<\/span>=<\/span> Max<\/span>(<\/span>fPoint1y,<\/span> Max<\/span>(<\/span>fPoint2y,<\/span> fPoint3y)<\/span>)<\/span>;<\/span>
\n
\n    Result.<\/span>cx<\/span> :<\/span>=<\/span> Ceil<\/span>(<\/span>fMaxx -<\/span> fMinx)<\/span>;<\/span>
\n    Result.<\/span>cy<\/span> :<\/span>=<\/span> Ceil<\/span>(<\/span>fMaxy -<\/span> fMiny)<\/span>;<\/span>
\n  end<\/span>;<\/span>
\ntype<\/span>
\n  TFColor =<\/span> record<\/span>
\n    b,<\/span> g,<\/span> r:<\/span>Byte<\/span>
\n  end<\/span>;<\/span>
\nvar<\/span>
\n  Top,<\/span> Bottom,<\/span> Left,<\/span> Right:<\/span> Extended<\/span>;<\/span>
\n  eww,<\/span> nsw                :<\/span> Extended<\/span>;<\/span>
\n  fx,<\/span> fy                  :<\/span> Extended<\/span>;<\/span>
\n  wx,<\/span> wy                  :<\/span> Extended<\/span>;<\/span>
\n  cAngle,<\/span> sAngle          :<\/span> Double<\/span>;<\/span>
\n  xDiff,<\/span> yDiff            :<\/span> Integer<\/span>;<\/span>
\n  ifx,<\/span> ify                :<\/span> Integer<\/span>;<\/span>
\n  px,<\/span> py                  :<\/span> Integer<\/span>;<\/span>
\n  ix,<\/span> iy                  :<\/span> Integer<\/span>;<\/span>
\n  x,<\/span> y                    :<\/span> Integer<\/span>;<\/span>
\n  cx,<\/span> cy                  :<\/span> Integer<\/span>;<\/span>
\n  nw,<\/span> ne,<\/span> sw,<\/span> se          :<\/span> TFColor;<\/span>
\n  anw,<\/span> ane,<\/span> asw,<\/span> ase      :<\/span> Byte<\/span>;<\/span>
\n  P1,<\/span> P2,<\/span> P3              :<\/span> pByteArray<\/span>;<\/span>
\n  A1,<\/span> A2,<\/span> A3              :<\/span> pByteArray<\/span>;<\/span>
\n  dst                     :<\/span> TPngImage;<\/span>
\n  IsAlpha                 :<\/span> Boolean<\/span>;<\/span>
\n  new_colortype           :<\/span> Integer<\/span>;<\/span>
\nbegin<\/span>
\n  anw :<\/span>=<\/span> 0<\/span>;<\/span>
\n  asw :<\/span>=<\/span> 0<\/span>;<\/span>
\n  {Only allows RGB and RGBALPHA images}<\/span>
\n  if<\/span> not<\/span> (<\/span>apng.<\/span>Header<\/span>.<\/span>ColorType<\/span> in<\/span> [<\/span>COLOR_RGBALPHA,<\/span> COLOR_RGB]<\/span>)<\/span> then<\/span>
\n    raise<\/span> Exception.<\/span>Create<\/span>(<\/span>CAPTION_ROTATION_ERROR)<\/span>;<\/span>
\n
\n  IsAlpha :<\/span>=<\/span> apng.<\/span>Header<\/span>.<\/span>ColorType<\/span> in<\/span> [<\/span>COLOR_RGBALPHA]<\/span>;<\/span>
\n
\n  if<\/span> IsAlpha then<\/span> new_colortype :<\/span>=<\/span> COLOR_RGBALPHA
\n  else<\/span>            new_colortype :<\/span>=<\/span> COLOR_RGB;<\/span>
\n
\n  with<\/span> newsize do<\/span>
\n  begin<\/span>
\n    {Creates a copy}<\/span>
\n    dst :<\/span>=<\/span> TPngImage.<\/span>CreateBlank<\/span>(<\/span>new_colortype,<\/span> 8<\/span>,<\/span> cx,<\/span> cy)<\/span>;<\/span>
\n  end<\/span>;<\/span>
\n  try<\/span>
\n    cx :<\/span>=<\/span> dst.<\/span>width<\/span>  div<\/span> 2<\/span>;<\/span>
\n    cy :<\/span>=<\/span> dst.<\/span>height<\/span> div<\/span> 2<\/span>;<\/span>
\n
\n    {Gather some variables}<\/span>
\n    Angle  :<\/span>=<\/span>  Angle;<\/span>
\n    Angle  :<\/span>=<\/span> -<\/span>Angle *<\/span> Pi \/<\/span> 180<\/span>;<\/span>
\n    sAngle :<\/span>=<\/span> Sin<\/span>(<\/span>Angle)<\/span>;<\/span>
\n    cAngle :<\/span>=<\/span> Cos<\/span>(<\/span>Angle)<\/span>;<\/span>
\n    xDiff  :<\/span>=<\/span> (<\/span>Dst.<\/span>Width<\/span>  -<\/span> aPng.<\/span>Width<\/span> )<\/span> div<\/span> 2<\/span>;<\/span>
\n    yDiff  :<\/span>=<\/span> (<\/span>Dst.<\/span>Height<\/span> -<\/span> aPng.<\/span>Height<\/span>)<\/span> div<\/span> 2<\/span>;<\/span>
\n
\n    {Iterates over each line}<\/span>
\n    for<\/span> y :<\/span>=<\/span> 0<\/span> to<\/span> Pred<\/span>(<\/span>Dst.<\/span>Height<\/span>)<\/span> do<\/span>
\n    begin<\/span>
\n      P3 :<\/span>=<\/span> Dst.<\/span>scanline<\/span>[<\/span>y]<\/span>;<\/span>
\n
\n      if<\/span> IsAlpha then<\/span>
\n        A3 :<\/span>=<\/span> Dst.<\/span>AlphaScanline<\/span>[<\/span>y]<\/span>;<\/span>
\n
\n      py :<\/span>=<\/span> 2<\/span> *<\/span> (<\/span>y -<\/span> cy)<\/span> +<\/span> 1<\/span>;<\/span>
\n
\n      {Iterates over each column}<\/span>
\n      for<\/span> x :<\/span>=<\/span> 0<\/span> to<\/span> Pred<\/span>(<\/span>Dst.<\/span>Width<\/span>)<\/span> do<\/span>
\n      begin<\/span>
\n        px  :<\/span>=<\/span> 2<\/span> *<\/span> (<\/span>x -<\/span> cx)<\/span> +<\/span> 1<\/span>;<\/span>
\n        fx  :<\/span>=<\/span> (<\/span>(<\/span>(<\/span>px *<\/span> cAngle -<\/span> py *<\/span> sAngle)<\/span> -<\/span> 1<\/span>)<\/span> \/<\/span> 2<\/span> +<\/span> cx)<\/span> -<\/span> xDiff;<\/span>
\n        fy  :<\/span>=<\/span> (<\/span>(<\/span>(<\/span>px *<\/span> sAngle +<\/span> py *<\/span> cAngle)<\/span> -<\/span> 1<\/span>)<\/span> \/<\/span> 2<\/span> +<\/span> cy)<\/span> -<\/span> yDiff;<\/span>
\n        ifx :<\/span>=<\/span> Round<\/span>(<\/span>fx)<\/span>;<\/span>
\n        ify :<\/span>=<\/span> Round<\/span>(<\/span>fy)<\/span>;<\/span>
\n
\n        {Only continues if it does not exceed image boundaries}<\/span>
\n        if<\/span> (<\/span>(<\/span>-<\/span>1<\/span> < ifx)<\/span> and<\/span> (<\/span>ifx < aPng.<\/span>Width<\/span>)<\/span> and<\/span> (<\/span>-<\/span>1<\/span> < ify)<\/span> and<\/span> (<\/span>ify < aPng.<\/span>Height<\/span>)<\/span>)<\/span> then<\/span>
\n        begin<\/span>
\n          {Obtains data to paint the new pixel}<\/span>
\n          eww :<\/span>=<\/span> fx -<\/span> ifx;<\/span>
\n          nsw :<\/span>=<\/span> fy -<\/span> ify;<\/span>
\n          iy  :<\/span>=<\/span> TrimInt(<\/span>ify +<\/span> 1<\/span>,<\/span> 0<\/span>,<\/span> aPng.<\/span>Height<\/span> -<\/span> 1<\/span>)<\/span>;<\/span>
\n          ix  :<\/span>=<\/span> TrimInt(<\/span>ifx +<\/span> 1<\/span>,<\/span> 0<\/span>,<\/span> aPng.<\/span>Width<\/span>  -<\/span> 1<\/span>)<\/span>;<\/span>
\n          P1  :<\/span>=<\/span> aPng.<\/span>Scanline<\/span>[<\/span>ify]<\/span>;<\/span>
\n          P2  :<\/span>=<\/span> aPng.<\/span>Scanline<\/span>[<\/span>iy]<\/span>;<\/span>
\n          if<\/span> IsAlpha then<\/span> A1  :<\/span>=<\/span> aPng.<\/span>AlphaScanline<\/span>[<\/span>ify]<\/span>;<\/span>
\n          if<\/span> IsAlpha then<\/span> A2  :<\/span>=<\/span> aPng.<\/span>AlphaScanline<\/span>[<\/span>iy]<\/span>;<\/span>
\n          nw.<\/span>r<\/span> :<\/span>=<\/span> P1[<\/span>ifx *<\/span> 3<\/span>]<\/span>;<\/span>
\n          nw.<\/span>g<\/span> :<\/span>=<\/span> P1[<\/span>ifx *<\/span> 3<\/span> +<\/span> 1<\/span>]<\/span>;<\/span>
\n          nw.<\/span>b<\/span> :<\/span>=<\/span> P1[<\/span>ifx *<\/span> 3<\/span> +<\/span> 2<\/span>]<\/span>;<\/span>
\n          if<\/span> IsAlpha then<\/span> anw :<\/span>=<\/span> A1[<\/span>ifx]<\/span>;<\/span>
\n          ne.<\/span>r<\/span> :<\/span>=<\/span> P1[<\/span>ix *<\/span> 3<\/span>]<\/span>;<\/span>
\n          ne.<\/span>g<\/span> :<\/span>=<\/span> P1[<\/span>ix *<\/span> 3<\/span> +<\/span> 1<\/span>]<\/span>;<\/span>
\n          ne.<\/span>b<\/span> :<\/span>=<\/span> P1[<\/span>ix *<\/span> 3<\/span> +<\/span> 2<\/span>]<\/span>;<\/span>
\n          if<\/span> IsAlpha then<\/span> ane :<\/span>=<\/span> A1[<\/span>ix]<\/span>;<\/span>
\n          sw.<\/span>r<\/span> :<\/span>=<\/span> P2[<\/span>ifx *<\/span> 3<\/span>]<\/span>;<\/span>
\n          sw.<\/span>g<\/span> :<\/span>=<\/span> P2[<\/span>ifx *<\/span> 3<\/span> +<\/span> 1<\/span>]<\/span>;<\/span>
\n          sw.<\/span>b<\/span> :<\/span>=<\/span> P2[<\/span>ifx *<\/span> 3<\/span> +<\/span> 2<\/span>]<\/span>;<\/span>
\n          if<\/span> IsAlpha then<\/span> asw :<\/span>=<\/span> A2[<\/span>ifx]<\/span>;<\/span>
\n          se.<\/span>r<\/span> :<\/span>=<\/span> P2[<\/span>ix *<\/span> 3<\/span>]<\/span>;<\/span>
\n          se.<\/span>g<\/span> :<\/span>=<\/span> P2[<\/span>ix *<\/span> 3<\/span> +<\/span> 1<\/span>]<\/span>;<\/span>
\n          se.<\/span>b<\/span> :<\/span>=<\/span> P2[<\/span>ix *<\/span> 3<\/span> +<\/span> 2<\/span>]<\/span>;<\/span>
\n          if<\/span> IsAlpha then<\/span> ase :<\/span>=<\/span> A2[<\/span>ix]<\/span>;<\/span>
\n
\n          {Defines the new pixel}<\/span>
\n          Top           :<\/span>=<\/span> nw.<\/span>b<\/span> +<\/span>eww *<\/span> (<\/span>ne.<\/span>b<\/span> -<\/span> nw.<\/span>b<\/span>)<\/span>;<\/span>
\n          Bottom        :<\/span>=<\/span> sw.<\/span>b<\/span> +<\/span>eww *<\/span> (<\/span>se.<\/span>b<\/span> -<\/span> sw.<\/span>b<\/span>)<\/span>;<\/span>
\n          P3[<\/span>x *<\/span> 3<\/span> +<\/span> 2<\/span>]<\/span> :<\/span>=<\/span> IntToByte(<\/span>Round<\/span>(<\/span>Top +<\/span> nsw *<\/span> (<\/span>Bottom -<\/span> Top)<\/span>)<\/span>)<\/span>;<\/span>
\n          Top           :<\/span>=<\/span> nw.<\/span>g<\/span> +<\/span> eww *<\/span> (<\/span>ne.<\/span>g<\/span> -<\/span> nw.<\/span>g<\/span>)<\/span>;<\/span>
\n          Bottom        :<\/span>=<\/span> sw.<\/span>g<\/span> +<\/span> eww *<\/span> (<\/span>se.<\/span>g<\/span> -<\/span> sw.<\/span>g<\/span>)<\/span>;<\/span>
\n          P3[<\/span>x *<\/span> 3<\/span> +<\/span> 1<\/span>]<\/span> :<\/span>=<\/span> IntToByte(<\/span>Round<\/span>(<\/span>Top +<\/span> nsw *<\/span> (<\/span>Bottom -<\/span> Top)<\/span>)<\/span>)<\/span>;<\/span>
\n          Top           :<\/span>=<\/span> nw.<\/span>r<\/span> +<\/span> eww *<\/span> (<\/span>ne.<\/span>r<\/span> -<\/span> nw.<\/span>r<\/span>)<\/span>;<\/span>
\n          Bottom        :<\/span>=<\/span> sw.<\/span>r<\/span> +<\/span> eww *<\/span> (<\/span>se.<\/span>r<\/span> -<\/span> sw.<\/span>r<\/span>)<\/span>;<\/span>
\n          P3[<\/span>x *<\/span> 3<\/span>]<\/span>     :<\/span>=<\/span> IntToByte(<\/span>Round<\/span>(<\/span>Top +<\/span> nsw *<\/span> (<\/span>Bottom -<\/span> Top)<\/span>)<\/span>)<\/span>;<\/span>
\n
\n          {Only for alpha}<\/span>
\n          if<\/span> IsAlpha then<\/span>
\n          begin<\/span>
\n            Top    :<\/span>=<\/span> anw +<\/span> eww *<\/span> (<\/span>ane -<\/span> anw)<\/span>;<\/span>
\n            Bottom :<\/span>=<\/span> asw +<\/span> eww *<\/span> (<\/span>ase -<\/span> asw)<\/span>;<\/span>
\n            A3[<\/span>x]<\/span>  :<\/span>=<\/span> IntToByte(<\/span>Round<\/span>(<\/span>Top +<\/span> nsw *<\/span> (<\/span>Bottom -<\/span> Top)<\/span>)<\/span>)<\/span>;<\/span>
\n          end<\/span>;<\/span>
\n        end<\/span>;<\/span>
\n      end<\/span>;<\/span>
\n    end<\/span>;<\/span>
\n
\n    aPng.<\/span>Assign<\/span>(<\/span>dst)<\/span>;<\/span>
\n  finally<\/span>
\n    dst.<\/span>Free<\/span>;<\/span>
\n  end<\/span>;<\/span>
\nend<\/span>;<\/span><\/div><\/td><\/tr><\/tbody><\/table><\/div>\n

 
\nPour jouer un fichier WAV qui est inclus dans les ressources :<\/p>\n

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
<\/div><\/td>
procedure<\/span> TfrmCapture.<\/span>PlaySound<\/span>(<\/span>sSound:<\/span> string<\/span>)<\/span>;<\/span>
\nvar<\/span>
\n  hFind,<\/span> hRes:<\/span> THandle<\/span>;<\/span>
\n  Song       :<\/span> PChar<\/span>;<\/span>
\nbegin<\/span>
\n  if<\/span> (<\/span>sSound<> ''<\/span>)<\/span> then<\/span>
\n  begin<\/span>
\n    hFind :<\/span>=<\/span> FindResource(<\/span>HInstance,<\/span> PWideChar<\/span>(<\/span>sSound)<\/span>,<\/span> 'WAVE'<\/span>)<\/span>;<\/span>
\n    if<\/span> (<\/span>hFind <> 0<\/span>)<\/span> then<\/span>
\n    begin<\/span>
\n      hRes :<\/span>=<\/span> LoadResource(<\/span>HInstance,<\/span> hFind)<\/span>;<\/span>
\n      if<\/span> (<\/span>hRes <> 0<\/span>)<\/span> then<\/span>
\n      begin<\/span>
\n        Song :<\/span>=<\/span> LockResource(<\/span>hRes)<\/span>;<\/span>
\n        if<\/span> Assigned<\/span>(<\/span>Song)<\/span> then<\/span>
\n        begin<\/span>
\n          SndPlaySound(<\/span>Song,<\/span> snd_ASync or<\/span> snd_Memory)<\/span>;<\/span>
\n        end<\/span>;<\/span>
\n        UnlockResource(<\/span>hRes)<\/span>;<\/span>
\n      end<\/span>;<\/span>
\n      FreeResource(<\/span>hFind)<\/span>;<\/span>
\n    end<\/span>;<\/span>
\n  end<\/span>;<\/span>
\nend<\/span>;<\/span><\/div><\/td><\/tr><\/tbody><\/table><\/div>\n

La liste est tr\u00e8s loin d’\u00eatre exhaustive… mais c’est d\u00e9j\u00e0 un bon d\u00e9but \":)\"<\/p>\n

Si vous voyez des erreurs \u00e0 corriger, des optimisations qui pourraient \u00eatre faites, n’h\u00e9sitez pas \u00e0 laisser un commentaire \";)\"<\/p>\n","protected":false},"excerpt":{"rendered":"

R\u00e9guli\u00e8rement, je r\u00e9utilise les m\u00eames m\u00e9thodes parmi divers projets\u2026<\/p>\n

J\u2019en ai regroup\u00e9 certaines d\u2019entre elles dans des unit\u00e9s que j\u2019utilise lorsque j\u2019en ai besoin, tandis que pour d\u2019autres qui me servent moins souvent, je me contente de faire un copier\/coller.<\/p>\n

Le plus dur, en g\u00e9n\u00e9ral, est de retrouver le projet o\u00f9 j\u2019en ai eu pr\u00e9c\u00e9demment besoin.<\/p>\n

Alors, tout comme j\u2019avais \u00e9crit un article sur les boutons de la barre des t\u00e2ches sous Windows 7, et qui m\u2019a encore servi pour wText2QR, je r\u00e9dige un article o\u00f9 je vais recenser certaines des fonctions que j\u2019utilise. Lorsque j\u2019arriverai \u00e0 retrouver la r\u00e9f\u00e9rence d\u2019une source, je l\u2019ajouterai. Je sp\u00e9cifie n\u00e9anmoins que la plupart ont \u00e9t\u00e9 r\u00e9cup\u00e9r\u00e9e de pages Web au fil du temps, lorsque j\u2019en ai eu pour la premi\u00e8re fois l\u2019utilit\u00e9 et que je n\u2019en suis pas l\u2019auteur (j\u2019ai \u00e9ventuellement fait des modifications pour mes propres exigences).<\/p>\n","protected":false},"author":2,"featured_media":0,"comment_status":"open","ping_status":"open","sticky":false,"template":"","format":"standard","meta":{"footnotes":"","_links_to":"","_links_to_target":""},"categories":[7],"tags":[27,154,146,108,151],"class_list":["post-4041","post","type-post","status-publish","format-standard","hentry","category-delphi","tag-coloration-syntaxique","tag-delphi","tag-firemonkey","tag-script","tag-windows-7"],"_links":{"self":[{"href":"https:\/\/blogs.wittwer.fr\/whiler\/wp-json\/wp\/v2\/posts\/4041","targetHints":{"allow":["GET"]}}],"collection":[{"href":"https:\/\/blogs.wittwer.fr\/whiler\/wp-json\/wp\/v2\/posts"}],"about":[{"href":"https:\/\/blogs.wittwer.fr\/whiler\/wp-json\/wp\/v2\/types\/post"}],"author":[{"embeddable":true,"href":"https:\/\/blogs.wittwer.fr\/whiler\/wp-json\/wp\/v2\/users\/2"}],"replies":[{"embeddable":true,"href":"https:\/\/blogs.wittwer.fr\/whiler\/wp-json\/wp\/v2\/comments?post=4041"}],"version-history":[{"count":1,"href":"https:\/\/blogs.wittwer.fr\/whiler\/wp-json\/wp\/v2\/posts\/4041\/revisions"}],"predecessor-version":[{"id":6365,"href":"https:\/\/blogs.wittwer.fr\/whiler\/wp-json\/wp\/v2\/posts\/4041\/revisions\/6365"}],"wp:attachment":[{"href":"https:\/\/blogs.wittwer.fr\/whiler\/wp-json\/wp\/v2\/media?parent=4041"}],"wp:term":[{"taxonomy":"category","embeddable":true,"href":"https:\/\/blogs.wittwer.fr\/whiler\/wp-json\/wp\/v2\/categories?post=4041"},{"taxonomy":"post_tag","embeddable":true,"href":"https:\/\/blogs.wittwer.fr\/whiler\/wp-json\/wp\/v2\/tags?post=4041"}],"curies":[{"name":"wp","href":"https:\/\/api.w.org\/{rel}","templated":true}]}}