Don't like ads? PRO users don't see any ads ;-)
Guest

Untitled

By: a guest on Jun 20th, 2012  |  syntax: None  |  size: 2.82 KB  |  hits: 12  |  expires: Never
download  |  raw  |  embed  |  report abuse  |  print
Text below is selected. Please press Ctrl+C to copy to your clipboard. (⌘+C on Mac)
  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;