Модераторы: Poseidon, Snowy, bems, MetalFan
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> TMemoryStream и TBitmap 
:(
    Опции темы
k2s
Дата 17.4.2005, 01:35 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 45
Регистрация: 23.2.2005

Репутация: нет
Всего: нет
При попытке помещения TBitmap в TMemoryStream выдаёт ошибку:"Access violation..."
Код

procedure TAddInDocForm.OKBtnClick(Sender: TObject);
var
 bmpt: TBitmap;
 bmpts: TMemoryStream;
begin
 with DataModule do
  begin
...
   bmpt := Graphics.TBitmap.Create;
...                          
   bmpts := TMemoryStream.Create;
   bmpts.Clear;
   bmpt.SaveToStream(bmpts);
   FIBQuery.ParamByName('THUMBNAIL').LoadFromStream(bmpts);          
   bmpt.Free;
   bmpts.Free;
...
end;

Если закоментировать строку
Код

   bmpt.SaveToStream(bmpts);
то никакой ошибки не происходит(но есстесственно ничего не происходит)
В чём может быть ошибка?
PM MAIL   Вверх
Alex
Дата 17.4.2005, 10:15 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Экс. модератор
Сообщений: 4147
Регистрация: 25.3.2002
Где: Москва

Репутация: 80
Всего: 162
Dот код, который не приводит не к какому AV
Код

var
 bmpt: TBitmap;
 bmpts: TMemoryStream;
begin
  bmpt := Graphics.TBitmap.Create;
  try
    bmpt.LoadFromFile('E:\Bitmaps\XP\FolderAdd.bmp');
    bmpts := TMemoryStream.Create;
    try
      bmpts.Clear;
      bmpt.SaveToStream(bmpts);
      IBQuery1.ParamByName('aaa').LoadFromStream(bmpts, ftGraphic);
    finally
      bmpts.Free;
    end;
  finally
    bmpt.Free;
  end;


Скорей всего, что-то другое приводит к AV в твоем коде. Покажи полностью код процедуры


--------------------
Написать можно все - главное четко представлять, что ты хочешь получить в конце. 
PM Skype   Вверх
k2s
Дата 17.4.2005, 13:04 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 45
Регистрация: 23.2.2005

Репутация: нет
Всего: нет
Код
procedure TAddInDocForm.OKBtnClick(Sender: TObject);
var
 bmpb: TBitmap;
 bmpt: TBitmap;
 bmpts: TMemoryStream;
begin
 with IODocsDataModule do           
  begin
   {Добавляются строки в SQL}
  end;
 with IODocsDataModule do
  begin
{Операторы типа FIBQuery.ParamByName('Field').AsString := (Edit.Text);}
      if (bmpb.Width > 67) and (bmpb.Height > 95) then     
       begin                                                    
        bmpb := Graphics.TBitmap.Create;                             
        bmpt := Graphics.TBitmap.Create;                                  
        bmpb.LoadFromFile(OpenPictureDialog.FileName);            
        StretchCool(67,95,bmpb,bmpt); // Функция уменьшает Bitmap из bmpb до 67x95 и помещает его в bmpt
        bmpts := TMemoryStream.Create;
        bmpts.Clear;
        bmpt.SaveToStream(bmpts);
        FIBQuery.ParamByName('THUMBNAIL').LoadFromStream(bmpts);
        bmpb.Free;                                                      
        bmpt.Free;
        bmpts.Free;                                                
       end                                                         
      else                                                           
       begin                                                         
        FIBQuery.ParamByName('THUMBNAIL').LoadFromFile(OpenPictureDialog.FileName);
       end;
     end;
   FIBQuery.ExecQuery;
   FIBTransaction.CommitRetaining;
  end;
 Form.Close;
end;                                                              


Это сообщение отредактировал(а) k2s - 17.4.2005, 13:05
PM MAIL   Вверх
Alex
Дата 17.4.2005, 13:28 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Экс. модератор
Сообщений: 4147
Регистрация: 25.3.2002
Где: Москва

Репутация: 80
Всего: 162
Уж очень хочется взглянуть на эту StretchCool


--------------------
Написать можно все - главное четко представлять, что ты хочешь получить в конце. 
PM Skype   Вверх
k2s
Дата 17.4.2005, 17:50 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 45
Регистрация: 23.2.2005

Репутация: нет
Всего: нет
Код

...
type
 TRGB=record
 r:byte;
 g:byte;
 b:byte;
 end;
 ARGB=array [0..1] of TRGB;
 PARGB=^ARGB;
 PRGB = ^TRGB;
...
procedure StretchCool(Width, Height : integer; var S,D : TBitmap); StdCall
var
  i, j, k, p : Integer;
  p1 : PARGB;
  col, r, g, b, Sheight1 : integer;
  Sh, Sw : Extended;
  Xp : array of PARGB;
begin
 If Width=0 then exit;
 If Height=0 then exit;
 S.PixelFormat:=pf24bit;
 D.PixelFormat:=pf24bit;
 D.Width:=Width;
 D.Height:=Height;
 Sh:=S.height/height;
 Sw:=S.width/width;
 Sheight1:=S.height-1;
 SetLength(Xp,S.height);
 for i:=0 to Sheight1 do
 Xp[i]:=s.ScanLine[i];
 for i:=0 to Height-1 do
 begin
  p1:=D.ScanLine[i];
  for j:=0 to Width-1 do
  begin
   col:=0;
   r:=0;
   g:=0;
   b:=0;
   for k:=Round(Sh*i) to Min(Round(Sh*(i+1))-1,Sheight1) do
   begin
    for p:=Round(Sw*j) to Min(Round(Sw*(j+1))-1,S.Width-1) do
    begin
     inc(col);
     inc(r,Xp[k,p].r);
     inc(g,Xp[k,p].g);
     inc(b,Xp[k,p].b);
    end;
   end;
   if col<>0 then
   begin
    p1[j].r:=r div col;
    p1[j].g:=g div col;
    p1[j].b:=b div col;
   end;
  end;
 end;
end;
...

Импортирую её из DLL
Код

procedure StretchCool(Width, Height : integer; var S,D : TBitmap); StdCall; external 'lib.dll';
PM MAIL   Вверх
Alex
Дата 17.4.2005, 19:40 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Экс. модератор
Сообщений: 4147
Регистрация: 25.3.2002
Где: Москва

Репутация: 80
Всего: 162
Стоп!

А что это такое по написано:
Код

if (bmpb.Width > 67) and (bmpb.Height > 95) then     
       begin                                                    
        bmpb := Graphics.TBitmap.Create;                             
        bmpt := Graphics.TBitmap.Create;  


Что за размеры вы проверяете, когда у вас даже объекты еще не созданы. Здесь 100% будет AV.


--------------------
Написать можно все - главное четко представлять, что ты хочешь получить в конце. 
PM Skype   Вверх
k2s
Дата 17.4.2005, 20:04 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 45
Регистрация: 23.2.2005

Репутация: нет
Всего: нет
А слона-то я и не приметил... smile

Сделал как надо. Теперь всё работает.

Alex, большое спасибо за помощь!
PM MAIL   Вверх
Alex
Дата 17.4.2005, 21:28 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Экс. модератор
Сообщений: 4147
Регистрация: 25.3.2002
Где: Москва

Репутация: 80
Всего: 162
Не за что! smile


--------------------
Написать можно все - главное четко представлять, что ты хочешь получить в конце. 
PM Skype   Вверх
  
 Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Общие вопросы"
SnowyMetalFan
bemsPoseidon
Rrader

Запрещается!

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами

  • Литературу по Дельфи обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи

Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, Snowy, MetalFan, bems, Poseidon, Rrader.
 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: Общие вопросы | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




[ Время генерации скрипта: 0.1040 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
 По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.