Guest User

Untitled

a guest
Jun 20th, 2012
32
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 2.82 KB | None | 0 0
  1. Is this code thread safe
  2. // experimental code
  3. procedure TFormMain.MyThumbnailProvider( const Path: Unicodestring; Width,
  4. Height: Integer; out Bitmap: TBitmap );
  5. var
  6. AExtension: string;
  7. ARect: TRect;
  8. begin
  9. AExtension := LowerCase( ExtractFileExt( Path ) );
  10. if AExtension = '.wmf' then
  11. begin
  12. ARect.Left := 0;
  13. ARect.Top := 0;
  14. ARect.Right := Width;
  15. ARect.Bottom := Height;
  16. Image1.Picture.LoadFromFile( Path ); // added at design time to form
  17. Bitmap := TBitmap.Create;
  18. Bitmap.Width := Width;
  19. Bitmap.Height := Height;
  20. Bitmap.Canvas.StretchDraw( ARect, Image1.Picture.Graphic );
  21. end;
  22. end;
  23.  
  24. procedure TFormMain.MyThumbnailProvider( const Path: Unicodestring; Width, Height: Integer; out Bitmap: TBitmap );
  25. var
  26. ARect: TRect;
  27. APicture: TPicture;
  28. AExtension: string;
  29. begin
  30. // experimental code
  31. if FileExists( Path ) then
  32. begin
  33. AExtension := LowerCase( ExtractFileExt( Path ) );
  34. if AExtension = '.wmf' then
  35. begin
  36. ARect.Left := 0;
  37. ARect.Top := 0;
  38. ARect.Right := Width;
  39. ARect.Bottom := Height;
  40. APicture := TPicture.Create;
  41. try
  42. APicture.LoadFromFile( Path );
  43. Bitmap := TBitmap.Create;
  44. Bitmap.SetSize( Width, Height );
  45. Bitmap.IgnorePalette := True;
  46. Bitmap.PixelFormat := pf24bit;
  47. Bitmap.Transparent := False;
  48. Bitmap.Canvas.Lock; **// New**
  49. try
  50. Bitmap.Canvas.StretchDraw( ARect, APicture.Graphic );
  51. finally
  52. Bitmap.Canvas.Unlock; **// New!**
  53. end;
  54. finally
  55. APicture.Free;
  56. end;
  57. end;
  58. end;
  59. end;
  60.  
  61. Image1.Picture.LoadFromFile( Path );
  62. /// [...]
  63. Bitmap.Canvas.StretchDraw( ARect, Image1.Picture.Graphic );
  64.  
  65. procedure TFormMain.MyThumbnailProvider( const Path: Unicodestring;
  66. Width, Height: Integer; out Bitmap: TBitmap );
  67. var
  68. LThumnailData: TThumbnailData; //Assuming an appropriately defined record
  69. begin
  70. LThumbnailData.FPath := Path;
  71. LThumbnailData.FWidth := Width;
  72. LThumbnailData.FHeight := Height;
  73. LThumbnailData.FBitmap := nil;
  74. SendMessage(Self.Handle, <Your Message Const>, 0, Longint(@LThumbnailData));
  75. Bitmap := LThumbnailData.FBitmap;
  76. end;
  77.  
  78. const
  79. //Each distinct message must have its own unique ref number.
  80. //It's recommended to start at WM_APP for custom numbers.
  81. MSG_THUMBNAILINFO = WM_APP + 0;
  82.  
  83. type
  84. PThumbnailData = ^TThumbnailData;
  85. TThumbnailData = record
  86. FPath: Unicodestring;
  87. FWidth, FHeight: Integer;
  88. FBitmap: TBitmap;
  89. end;
  90.  
  91. procedure MSGThumbnailInfo(var Message: TMessage); message MSG_THUMBNAILINFO;
  92.  
  93. procedure TForm3.MSGThumbnailInfo(var Message: TMessage);
  94. var
  95. LThumbnailData: PThumbnailData;
  96. begin
  97. LThumbnailData := Pointer(Message.LParam);
  98.  
  99. //The rest of your code goes here.
  100. //Don't forget to set LThumbnailData^.FBitmap before done.
  101.  
  102. Message.Result := 0;
  103. inherited;
  104. end;
Advertisement
Add Comment
Please, Sign In to add comment