Hex Artifact Content
Not logged in

Artifact 6e95ee22bef66e9aad8258f3ef18ce0189426239:


0000: 75 6e 69 74 20 55 5f 53 68 65 6c 6c 49 74 65 6d  unit U_ShellItem
0010: 49 6d 61 67 65 3b 0d 0a 0d 0a 69 6e 74 65 72 66  Image;....interf
0020: 61 63 65 0d 0a 75 73 65 73 0d 0a 20 20 57 69 6e  ace..uses..  Win
0030: 61 70 69 2e 57 69 6e 64 6f 77 73 2c 20 56 63 6c  api.Windows, Vcl
0040: 2e 47 72 61 70 68 69 63 73 3b 0d 0a 0d 0a 66 75  .Graphics;....fu
0050: 6e 63 74 69 6f 6e 20 47 65 74 46 69 6c 65 49 6d  nction GetFileIm
0060: 61 67 65 28 63 6f 6e 73 74 20 41 46 69 6c 65 50  age(const AFileP
0070: 61 74 68 3a 20 73 74 72 69 6e 67 3b 20 63 6f 6e  ath: string; con
0080: 73 74 20 41 57 69 64 74 68 2c 20 41 48 65 69 67  st AWidth, AHeig
0090: 68 74 3a 20 69 6e 74 65 67 65 72 3b 0d 0a 20 20  ht: integer;..  
00a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
00b0: 20 20 20 20 63 6f 6e 73 74 20 41 46 6c 61 67 73      const AFlags
00c0: 3a 20 69 6e 74 65 67 65 72 3b 20 6f 75 74 20 68  : integer; out h
00d0: 42 6d 70 3a 20 48 42 49 54 4d 41 50 29 3a 20 48  Bmp: HBITMAP): H
00e0: 52 45 53 55 4c 54 3b 0d 0a 66 75 6e 63 74 69 6f  RESULT;..functio
00f0: 6e 20 47 65 74 46 69 6c 65 54 68 75 6d 62 6e 61  n GetFileThumbna
0100: 69 6c 28 63 6f 6e 73 74 20 41 46 69 6c 65 50 61  il(const AFilePa
0110: 74 68 3a 20 73 74 72 69 6e 67 3b 0d 0a 20 20 20  th: string;..   
0120: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
0130: 20 20 20 20 20 20 20 63 6f 6e 73 74 20 41 57 69         const AWi
0140: 64 74 68 3a 20 69 6e 74 65 67 65 72 20 3d 20 32  dth: integer = 2
0150: 35 36 3b 20 63 6f 6e 73 74 20 41 48 65 69 67 68  56; const AHeigh
0160: 74 3a 20 69 6e 74 65 67 65 72 20 3d 20 32 35 36  t: integer = 256
0170: 29 3a 20 54 42 69 74 6d 61 70 3b 0d 0a 66 75 6e  ): TBitmap;..fun
0180: 63 74 69 6f 6e 20 47 65 74 46 69 6c 65 49 63 6f  ction GetFileIco
0190: 6e 28 63 6f 6e 73 74 20 41 46 69 6c 65 50 61 74  n(const AFilePat
01a0: 68 3a 20 73 74 72 69 6e 67 3b 0d 0a 20 20 20 20  h: string;..    
01b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
01c0: 20 63 6f 6e 73 74 20 41 57 69 64 74 68 3a 20 69   const AWidth: i
01d0: 6e 74 65 67 65 72 20 3d 20 32 35 36 3b 20 63 6f  nteger = 256; co
01e0: 6e 73 74 20 41 48 65 69 67 68 74 3a 20 69 6e 74  nst AHeight: int
01f0: 65 67 65 72 20 3d 20 32 35 36 29 3a 20 54 42 69  eger = 256): TBi
0200: 74 6d 61 70 3b 0d 0a 0d 0a 0d 0a 69 6d 70 6c 65  tmap;......imple
0210: 6d 65 6e 74 61 74 69 6f 6e 0d 0a 0d 0a 75 73 65  mentation....use
0220: 73 0d 0a 20 20 57 69 6e 61 70 69 2e 41 63 74 69  s..  Winapi.Acti
0230: 76 65 58 2c 20 57 69 6e 61 70 69 2e 53 68 6c 4f  veX, Winapi.ShlO
0240: 62 6a 2c 20 53 79 73 74 65 6d 2e 57 69 6e 2e 43  bj, System.Win.C
0250: 6f 6d 4f 62 6a 3b 0d 0a 0d 0a 74 79 70 65 0d 0a  omObj;....type..
0260: 20 20 7b 24 45 58 54 45 52 4e 41 4c 53 59 4d 20    {$EXTERNALSYM 
0270: 53 49 49 47 42 46 7d 0d 0a 20 20 53 49 49 47 42  SIIGBF}..  SIIGB
0280: 46 20 3d 20 49 6e 74 65 67 65 72 3b 0d 0a 0d 0a  F = Integer;....
0290: 20 20 7b 24 45 58 54 45 52 4e 41 4c 53 59 4d 20    {$EXTERNALSYM 
02a0: 49 53 68 65 6c 6c 49 74 65 6d 49 6d 61 67 65 46  IShellItemImageF
02b0: 61 63 74 6f 72 79 7d 0d 0a 20 20 49 53 68 65 6c  actory}..  IShel
02c0: 6c 49 74 65 6d 49 6d 61 67 65 46 61 63 74 6f 72  lItemImageFactor
02d0: 79 20 3d 20 69 6e 74 65 72 66 61 63 65 28 49 55  y = interface(IU
02e0: 6e 6b 6e 6f 77 6e 29 0d 0a 20 20 20 20 5b 27 7b  nknown)..    ['{
02f0: 42 43 43 31 38 42 37 39 2d 42 41 31 36 2d 34 34  BCC18B79-BA16-44
0300: 32 46 2d 38 30 43 34 2d 38 41 35 39 43 33 30 43  2F-80C4-8A59C30C
0310: 34 36 33 42 7d 27 5d 0d 0a 20 20 20 20 66 75 6e  463B}']..    fun
0320: 63 74 69 6f 6e 20 47 65 74 49 6d 61 67 65 28 73  ction GetImage(s
0330: 69 7a 65 3a 20 54 53 69 7a 65 3b 20 66 6c 61 67  ize: TSize; flag
0340: 73 3a 20 53 49 49 47 42 46 3b 20 6f 75 74 20 70  s: SIIGBF; out p
0350: 68 62 6d 3a 20 48 42 49 54 4d 41 50 29 3a 20 48  hbm: HBITMAP): H
0360: 52 45 53 55 4c 54 3b 20 73 74 64 63 61 6c 6c 3b  RESULT; stdcall;
0370: 0d 0a 20 20 65 6e 64 3b 0d 0a 0d 0a 63 6f 6e 73  ..  end;....cons
0380: 74 0d 0a 20 20 53 49 49 47 42 46 5f 52 45 53 49  t..  SIIGBF_RESI
0390: 5a 45 54 4f 46 49 54 20 3d 20 24 30 30 30 30 30  ZETOFIT = $00000
03a0: 30 30 30 3b 0d 0a 20 20 53 49 49 47 42 46 5f 42  000;..  SIIGBF_B
03b0: 49 47 47 45 52 53 49 5a 45 4f 4b 20 3d 20 24 30  IGGERSIZEOK = $0
03c0: 30 30 30 30 30 30 31 3b 0d 0a 20 20 53 49 49 47  0000001;..  SIIG
03d0: 42 46 5f 4d 45 4d 4f 52 59 4f 4e 4c 59 20 3d 20  BF_MEMORYONLY = 
03e0: 24 30 30 30 30 30 30 30 32 3b 0d 0a 20 20 53 49  $00000002;..  SI
03f0: 49 47 42 46 5f 49 43 4f 4e 4f 4e 4c 59 20 3d 20  IGBF_ICONONLY = 
0400: 24 30 30 30 30 30 30 30 34 3b 0d 0a 20 20 53 49  $00000004;..  SI
0410: 49 47 42 46 5f 54 48 55 4d 42 4e 41 49 4c 4f 4e  IGBF_THUMBNAILON
0420: 4c 59 20 3d 20 24 30 30 30 30 30 30 30 38 3b 0d  LY = $00000008;.
0430: 0a 20 20 53 49 49 47 42 46 5f 49 4e 43 41 43 48  .  SIIGBF_INCACH
0440: 45 4f 4e 4c 59 20 3d 20 24 30 30 30 30 30 30 31  EONLY = $0000001
0450: 30 3b 0d 0a 0d 0a 7b 20 2d 2d 2d 2d 2d 2d 2d 2d  0;....{ --------
0460: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d  ----------------
0470: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d  ----------------
0480: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d  ----------------
0490: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d  ----------------
04a0: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d  ----------------
04b0: 2d 2d 2d 2d 2d 2d 2d 2d 20 7d 0d 0a 66 75 6e 63  -------- }..func
04c0: 74 69 6f 6e 20 47 65 74 46 69 6c 65 49 6d 61 67  tion GetFileImag
04d0: 65 28 63 6f 6e 73 74 20 41 46 69 6c 65 50 61 74  e(const AFilePat
04e0: 68 3a 20 73 74 72 69 6e 67 3b 20 63 6f 6e 73 74  h: string; const
04f0: 20 41 57 69 64 74 68 2c 20 41 48 65 69 67 68 74   AWidth, AHeight
0500: 3a 20 69 6e 74 65 67 65 72 3b 0d 0a 20 20 20 20  : integer;..    
0510: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
0520: 20 20 63 6f 6e 73 74 20 41 46 6c 61 67 73 3a 20    const AFlags: 
0530: 69 6e 74 65 67 65 72 3b 20 6f 75 74 20 68 42 6d  integer; out hBm
0540: 70 3a 20 48 42 49 54 4d 41 50 29 3a 20 48 52 45  p: HBITMAP): HRE
0550: 53 55 4c 54 3b 0d 0a 76 61 72 0d 0a 20 20 66 69  SULT;..var..  fi
0560: 6c 65 53 68 65 6c 6c 49 74 65 6d 49 6d 61 67 65  leShellItemImage
0570: 3a 20 49 53 68 65 6c 6c 49 74 65 6d 49 6d 61 67  : IShellItemImag
0580: 65 46 61 63 74 6f 72 79 3b 0d 0a 20 20 73 3a 20  eFactory;..  s: 
0590: 54 53 69 7a 65 3b 0d 0a 62 65 67 69 6e 0d 0a 20  TSize;..begin.. 
05a0: 20 52 65 73 75 6c 74 20 3a 3d 20 43 6f 49 6e 69   Result := CoIni
05b0: 74 69 61 6c 69 7a 65 45 78 28 6e 69 6c 2c 20 43  tializeEx(nil, C
05c0: 4f 49 4e 49 54 5f 41 50 41 52 54 4d 45 4e 54 54  OINIT_APARTMENTT
05d0: 48 52 45 41 44 45 44 20 6f 72 20 43 4f 49 4e 49  HREADED or COINI
05e0: 54 5f 44 49 53 41 42 4c 45 5f 4f 4c 45 31 44 44  T_DISABLE_OLE1DD
05f0: 45 29 3b 0d 0a 20 20 69 66 20 53 75 63 63 65 65  E);..  if Succee
0600: 64 65 64 28 52 65 73 75 6c 74 29 20 74 68 65 6e  ded(Result) then
0610: 20 62 65 67 69 6e 0d 0a 20 20 20 20 52 65 73 75   begin..    Resu
0620: 6c 74 20 3a 3d 20 53 48 43 72 65 61 74 65 49 74  lt := SHCreateIt
0630: 65 6d 46 72 6f 6d 50 61 72 73 69 6e 67 4e 61 6d  emFromParsingNam
0640: 65 28 50 43 68 61 72 28 41 46 69 6c 65 50 61 74  e(PChar(AFilePat
0650: 68 29 2c 20 6e 69 6c 2c 20 49 53 68 65 6c 6c 49  h), nil, IShellI
0660: 74 65 6d 49 6d 61 67 65 46 61 63 74 6f 72 79 2c  temImageFactory,
0670: 20 66 69 6c 65 53 68 65 6c 6c 49 74 65 6d 49 6d   fileShellItemIm
0680: 61 67 65 29 3b 0d 0a 20 20 20 20 69 66 20 53 75  age);..    if Su
0690: 63 63 65 65 64 65 64 28 52 65 73 75 6c 74 29 20  cceeded(Result) 
06a0: 74 68 65 6e 20 62 65 67 69 6e 0d 0a 20 20 20 20  then begin..    
06b0: 20 20 73 2e 63 78 20 3a 3d 20 41 57 69 64 74 68    s.cx := AWidth
06c0: 3b 0d 0a 20 20 20 20 20 20 73 2e 63 79 20 3a 3d  ;..      s.cy :=
06d0: 20 41 48 65 69 67 68 74 3b 0d 0a 20 20 20 20 20   AHeight;..     
06e0: 20 52 65 73 75 6c 74 20 3a 3d 20 66 69 6c 65 53   Result := fileS
06f0: 68 65 6c 6c 49 74 65 6d 49 6d 61 67 65 2e 47 65  hellItemImage.Ge
0700: 74 49 6d 61 67 65 28 73 2c 20 41 46 6c 61 67 73  tImage(s, AFlags
0710: 2c 20 68 42 6d 70 29 3b 0d 0a 20 20 20 20 65 6e  , hBmp);..    en
0720: 64 3b 0d 0a 20 20 20 20 43 6f 55 6e 69 6e 69 74  d;..    CoUninit
0730: 69 61 6c 69 7a 65 3b 0d 0a 20 20 65 6e 64 3b 0d  ialize;..  end;.
0740: 0a 65 6e 64 20 7b 47 65 74 46 69 6c 65 49 6d 61  .end {GetFileIma
0750: 67 65 7d 3b 0d 0a 0d 0a 7b 20 2d 2d 2d 2d 2d 2d  ge};....{ ------
0760: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d  ----------------
0770: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d  ----------------
0780: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d  ----------------
0790: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d  ----------------
07a0: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d  ----------------
07b0: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 20 7d 0d 0a 66 75  ---------- }..fu
07c0: 6e 63 74 69 6f 6e 20 47 65 74 46 69 6c 65 54 68  nction GetFileTh
07d0: 75 6d 62 6e 61 69 6c 28 63 6f 6e 73 74 20 41 46  umbnail(const AF
07e0: 69 6c 65 50 61 74 68 3a 20 73 74 72 69 6e 67 3b  ilePath: string;
07f0: 0d 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20  ..              
0800: 20 20 20 20 20 20 20 20 20 20 20 20 63 6f 6e 73              cons
0810: 74 20 41 57 69 64 74 68 2c 20 41 48 65 69 67 68  t AWidth, AHeigh
0820: 74 3a 20 69 6e 74 65 67 65 72 29 3a 20 54 42 69  t: integer): TBi
0830: 74 6d 61 70 3b 0d 0a 76 61 72 0d 0a 20 20 68 42  tmap;..var..  hB
0840: 6d 70 3a 20 48 42 49 54 4d 41 50 3b 0d 0a 62 65  mp: HBITMAP;..be
0850: 67 69 6e 0d 0a 20 20 52 65 73 75 6c 74 20 3a 3d  gin..  Result :=
0860: 20 54 42 69 74 6d 61 70 2e 43 72 65 61 74 65 3b   TBitmap.Create;
0870: 0d 0a 20 20 52 65 73 75 6c 74 2e 54 72 61 6e 73  ..  Result.Trans
0880: 70 61 72 65 6e 74 4d 6f 64 65 20 3a 3d 20 74 6d  parentMode := tm
0890: 41 75 74 6f 3b 0d 0a 20 20 52 65 73 75 6c 74 2e  Auto;..  Result.
08a0: 41 6c 70 68 61 46 6f 72 6d 61 74 20 3a 3d 20 61  AlphaFormat := a
08b0: 66 44 65 66 69 6e 65 64 3b 0d 0a 20 20 69 66 20  fDefined;..  if 
08c0: 53 75 63 63 65 65 64 65 64 28 47 65 74 46 69 6c  Succeeded(GetFil
08d0: 65 49 6d 61 67 65 28 41 46 69 6c 65 50 61 74 68  eImage(AFilePath
08e0: 2c 20 41 57 69 64 74 68 2c 20 41 48 65 69 67 68  , AWidth, AHeigh
08f0: 74 2c 20 53 49 49 47 42 46 5f 54 48 55 4d 42 4e  t, SIIGBF_THUMBN
0900: 41 49 4c 4f 4e 4c 59 20 6f 72 20 53 49 49 47 42  AILONLY or SIIGB
0910: 46 5f 42 49 47 47 45 52 53 49 5a 45 4f 4b 2c 20  F_BIGGERSIZEOK, 
0920: 68 42 6d 70 29 29 20 74 68 65 6e 0d 0a 20 20 20  hBmp)) then..   
0930: 20 52 65 73 75 6c 74 2e 48 61 6e 64 6c 65 20 3a   Result.Handle :
0940: 3d 20 68 42 6d 70 3b 0d 0a 65 6e 64 20 7b 47 65  = hBmp;..end {Ge
0950: 74 46 69 6c 65 54 68 75 6d 62 6e 61 69 6c 7d 3b  tFileThumbnail};
0960: 0d 0a 0d 0a 7b 20 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d  ....{ ----------
0970: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d  ----------------
0980: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d  ----------------
0990: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d  ----------------
09a0: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d  ----------------
09b0: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d  ----------------
09c0: 2d 2d 2d 2d 2d 2d 20 7d 0d 0a 66 75 6e 63 74 69  ------ }..functi
09d0: 6f 6e 20 47 65 74 46 69 6c 65 49 63 6f 6e 28 63  on GetFileIcon(c
09e0: 6f 6e 73 74 20 41 46 69 6c 65 50 61 74 68 3a 20  onst AFilePath: 
09f0: 73 74 72 69 6e 67 3b 20 63 6f 6e 73 74 20 41 57  string; const AW
0a00: 69 64 74 68 2c 20 41 48 65 69 67 68 74 3a 20 69  idth, AHeight: i
0a10: 6e 74 65 67 65 72 29 3a 20 54 42 69 74 6d 61 70  nteger): TBitmap
0a20: 3b 0d 0a 76 61 72 0d 0a 20 20 68 42 6d 70 3a 20  ;..var..  hBmp: 
0a30: 48 42 49 54 4d 41 50 3b 0d 0a 62 65 67 69 6e 0d  HBITMAP;..begin.
0a40: 0a 20 20 52 65 73 75 6c 74 20 3a 3d 20 54 42 69  .  Result := TBi
0a50: 74 6d 61 70 2e 43 72 65 61 74 65 3b 0d 0a 20 20  tmap.Create;..  
0a60: 52 65 73 75 6c 74 2e 54 72 61 6e 73 70 61 72 65  Result.Transpare
0a70: 6e 74 4d 6f 64 65 20 3a 3d 20 74 6d 41 75 74 6f  ntMode := tmAuto
0a80: 3b 0d 0a 20 20 52 65 73 75 6c 74 2e 41 6c 70 68  ;..  Result.Alph
0a90: 61 46 6f 72 6d 61 74 20 3a 3d 20 61 66 44 65 66  aFormat := afDef
0aa0: 69 6e 65 64 3b 0d 0a 20 20 4f 6c 65 43 68 65 63  ined;..  OleChec
0ab0: 6b 28 47 65 74 46 69 6c 65 49 6d 61 67 65 28 41  k(GetFileImage(A
0ac0: 46 69 6c 65 50 61 74 68 2c 20 41 57 69 64 74 68  FilePath, AWidth
0ad0: 2c 20 41 48 65 69 67 68 74 2c 20 53 49 49 47 42  , AHeight, SIIGB
0ae0: 46 5f 49 43 4f 4e 4f 4e 4c 59 2c 20 68 42 6d 70  F_ICONONLY, hBmp
0af0: 29 29 3b 0d 0a 20 20 52 65 73 75 6c 74 2e 48 61  ));..  Result.Ha
0b00: 6e 64 6c 65 20 3a 3d 20 68 42 6d 70 3b 0d 0a 65  ndle := hBmp;..e
0b10: 6e 64 20 7b 47 65 74 46 69 6c 65 54 68 75 6d 62  nd {GetFileThumb
0b20: 6e 61 69 6c 7d 3b 0d 0a 0d 0a 65 6e 64 2e 0d 0a  nail};....end...