Перейти из форума на сайт.

НовостиФайловые архивы
ПоискАктивные темыТоп лист
ПравилаКто в on-line?
Вход Забыли пароль? Первый раз на этом сайте? Регистрация
Компьютерный форум Ru.Board » Компьютеры » Прикладное программирование » Вопросы по Delphi (все версии) - часть 4

Модерирует : ShIvADeSt

ShIvADeSt (28-06-2009 02:10): Продолжение в http://forum.ru-board.com/topic.cgi?forum=33&topic=10477  Версия для печати • ПодписатьсяДобавить в закладки
Страницы: 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

   

Frodo_Torbins

Silver Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
bandyn
А где вы видели ошибку? Warning - это еще не ошибка. А потеря данных при StringOfChar(ch: AnsiChar; Count: Integer): AnsiString; в любом случае возможна.

Всего записей: 2319 | Зарегистр. 24-05-2007 | Отправлено: 16:18 24-03-2009
Maks150988



Advanced Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
ShIvADeSt
Да вот если бы без нахлобучек VCL... =)
 
Кстати, назрел вопрос. Мне вот надо преобразовать png картинку в hBitmap на выходе. Полученная картинка требуется для дальнейшего наложения на окна - скинизация 32-битным битмапом к примеру. Захотел сделать функцию. Вот что получилось.
 

Код:
function CreatebitBitmapFromPngFile(): hBitmap;
var
  hTmpHdc     : HDC;
  hBmpNew: HBITMAP;
  hBmpOld: HBITMAP;
  Graphics  : Cardinal;
  GdiImage  : Cardinal;
  hMemHdc   : HDC;
  iHeight: UINT;
  iWidth : UINT;
  BmpInfo: BITMAPINFO;
  lpBits : Pointer;
begin
 
 
  GdipLoadImageFromFile('mspaint.png', GdiImage);
  if GdiImage = 0 then
    begin
      Result := 0;
      Exit;
    end;
 
  GdipGetImageHeight(GdiImage, iHeight);
  GdipGetImageWidth(GdiImage, iWidth);
 
  BmpInfo.bmiHeader.biSize      := SizeOF(BmpInfo.bmiHeader);
  BmpInfo.bmiHeader.biWidth     := iWidth;
  BmpInfo.bmiHeader.biHeight    := iHeight;
  BmpInfo.bmiHeader.biPlanes    := 1;
  BmpInfo.bmiHeader.biBitCount  := 32;
  BmpInfo.bmiHeader.biSizeImage := BmpInfo.bmiHeader.biWidth * BmpInfo.bmiHeader.biHeight * (BmpInfo.bmiHeader.biBitCount div 8);
 
  hTmpHdc := GetDC(0);
  hMemHdc := CreateCompatibleDC(hTmpHdc);
  ReleaseDC(0, hTmpHdc);
  hBmpNew := CreateDIBSection(hMemHdc, BmpInfo, DIB_RGB_COLORS, lpBits, 0, 0);
  hBmpOld := SelectObject(hMemHdc, hBmpNew);
  GdipCreateFromHDC(hMemHdc, Graphics);
 
  GdipDrawImageRect(Graphics, GdiImage, 0, 0, iWidth, iHeight);
 
  // тут непонятно что надо в результат
//Result := hBmpNew;
 
  GdipDisposeImage(GdiImage);
  GdipDeleteGraphics(Graphics);
  DeleteObject(hBmpNew);
  SelectObject(hMemHdc, hBmpOld);
  DeleteDC(hMemHdc);
end;

 
Вобщем где закомментировано, к этому моменту у нас в hMemHdc уже находится загруженное изображение, которое мы можем отбитблиттить. Я как бы немного не понимаю как сохранить hBitmap. Пытался подсовывать к хэндлам функции и CreateBitmap делать с нужным хэндлом временного DC - функция ничего не возвращает. Может кто подскажет как исправить... =)

Всего записей: 836 | Зарегистр. 23-12-2006 | Отправлено: 18:56 24-03-2009
ShIvADeSt



Moderator
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Maks150988

Цитата:
Мне вот надо преобразовать png картинку в hBitmap на выходе.

Посмотри тут, вроде что то умное
http://www.jose.it-berater.org/smfforum/index.php?topic=2820.0

----------
И создал Бог женщину... Существо получилось злобное, но забавное...

Всего записей: 3956 | Зарегистр. 29-07-2003 | Отправлено: 01:59 25-03-2009
Maks150988



Advanced Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
ShIvADeSt
Все, разобрался. После GdipDrawImageRect.
 
GdipCreateHBITMAPFromBitmap(GdiImage, hImage, ARGB(0, 255, 0, 255));
 
И в результат помещаем hImage, который у нас объявлен как hBitmap в var.
 
Вобщем пока непонятно одно - фоновый цвет картинки. В модулях GDI+ под делфи прототип этой функцией выглядит ARGB. Непонятно как фон нужный задать - почему-то значение Blue "работает", а остальные в нулевом значении остаются. И в итоге результирующий цвет фона вида ргб(0,0,255), хотя мне нужен цвет фуксия - (255,0,255).
 
Модуль GDI+ для работы с изображением.

Код:
unit F_GdiPlus;
 
interface
 
uses
  Windows;
 
const
  WINGDIPDLL = 'gdiplus.dll';
 
type
  GDIPlusStartupInput = record
    GdiPlusVersion          : Integer;
    DebugEventCallback      : Integer;
    SuppressBackgroundThread: Integer;
    SuppressExternalCodecs  : Integer;
  end;
 
function GdiplusStartup(var token: Integer; var lpInput: GDIPlusStartupInput; lpOutput: Integer): Integer; stdcall; external WINGDIPDLL;
function GdiplusShutdown(var token: Integer): Integer; stdcall; external WINGDIPDLL;
function GdipCreateFromHDC(hDC: HDC; var Graphics: Cardinal): Integer; stdcall; external WINGDIPDLL;
function GdipLoadImageFromFile(FileName: PWideChar; var Image: Cardinal): Integer; stdcall; external WINGDIPDLL;
function GdipGetImageWidth(Image: Cardinal; var Width: UINT): Integer; stdcall; external WINGDIPDLL;
function GdipGetImageHeight(Image: Cardinal; var Height: UINT): Integer; stdcall; external WINGDIPDLL;
function GdipDrawImageRect(Graphics: Cardinal; Image: Cardinal; X, Y, Width, Height: Single): Integer; stdcall; external WINGDIPDLL;
function GdipDisposeImage(Image: Cardinal): Integer; stdcall; external WINGDIPDLL;
function GdipDeleteGraphics(Graphics: Cardinal): Integer; stdcall; external WINGDIPDLL;
function GdipCreateHBITMAPFromBitmap(Graphics: Cardinal; var Bitmap: hBitmap; Background: TColorRef): Integer; stdcall; external WINGDIPDLL;
function ARGB(A, R, G, B: Byte): TColorRef;
 
var
  hGDILib    : Cardinal;
  StartUpInfo: GDIPlusStartupInput;
  GdipToken  : Integer;
 
implementation
 
function ARGB(A, R, G, B: Byte): TColorRef;
begin
  Result := (DWORD(b) or (DWORD(g) shl 8) or (DWORD(r) shl 16) or (DWORD(a) shl 24));
end;
 
end.

 
И кстати, сдается мне что функцией CreateDIBSection создается всегда 32-битный битмап, а не то значение, которое нужно. Пробовал подставлять 16 и 256 и 16 и 24 в параметр битности заголовка - изображение вроде как 32-битное получается свиду.

Всего записей: 836 | Зарегистр. 23-12-2006 | Отправлено: 17:04 25-03-2009 | Исправлено: Maks150988, 21:27 25-03-2009
bornbill



Advanced Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
долго мучался в какой теме написать тут или по .NET решил тут.....
1. есть http://code.google.com/p/geckofx/
2. есть Delphi .net
 
Вопрос где можно найти примеры использования 1 во 2 гугл мне в помощь но найти ничего вразумительного не удалось.....
Заранее благодарен за направление ссылки и рекомендации

Всего записей: 1440 | Зарегистр. 02-04-2004 | Отправлено: 20:14 25-03-2009
diodio



Junior Member
Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору
Добрый день!
Подскажите, можно ли залогинится на файл-сервер в сети из программы автоматом, используя известные логин/пароль, и, если можно - то как? :0
 

Всего записей: 111 | Зарегистр. 26-12-2006 | Отправлено: 16:10 26-03-2009
Kursist



Junior Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Здравствуйте!
Такой вопрос, всё работает, но можно ли оптимизировать загрузку массива через файловый поток, чтобы не загружать в цикле побайтно:
     
 for loop1:=0 to Len-1 do
        FStream.Read(arr[loop1],SizeOf(Byte));
 
Хочется чего-то такого, но этот вариант не работает:
  FStream.Read(arr[loop1],Len);

Всего записей: 137 | Зарегистр. 12-07-2004 | Отправлено: 22:23 26-03-2009 | Исправлено: Kursist, 22:43 26-03-2009
Frodo_Torbins

Silver Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Kursist
Смотря массив чего. Если какие-нибудь интеджеры, то должно работать. Для строк же есть свой стрим.

Всего записей: 2319 | Зарегистр. 24-05-2007 | Отправлено: 22:59 26-03-2009 | Исправлено: Frodo_Torbins, 23:01 26-03-2009
Kursist



Junior Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
var
 arr:PByteArray;
 FStream:TFileStream;
 
а тогда уточню:
У меня есть файл с графической информацией, вначале идет различная инфа, а уже потом данные  RGBA для OpenGL, то есть, записывались эти данные тоже побайтно, но вот хочется сразу блоком считать, но не получается, даже при texW=texH=256;
 
GetMem(arr, texW*texH*4); //4:=RGB+Alpha
     
       Size:=texW*texH*4;
      // FStream.Read(arr,Size);  //вот так не работает!
 
      for loop1:=0 to (texW*texH*4-1) do
       FStream.Read(arr[loop1],SizeOf(Byte));  //

Всего записей: 137 | Зарегистр. 12-07-2004 | Отправлено: 00:09 27-03-2009
delover

Advanced Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Кто нибудь мне скажет чиво обозначает этот код, производитель которого Delphi?
Файл StdActns, Copyright (c) 1995-2005 Borland.

Код:
 
procedure TEditDelete.UpdateTarget(Target: TObject);
begin
  Enabled := (GetControl(Target).SelLength > 0) and  not GetControl(Target).ReadOnly;
end;
 

На мемке делаю попап меню. Добавляю стандартную акцию, у которой шоркат - Del. После этого клавиша Del в мемке не работает. Извините за ламерский вопрос - почему?

Всего записей: 1395 | Зарегистр. 25-06-2007 | Отправлено: 07:44 27-03-2009
Mandor Sawall

Junior Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Kursist
А так работает?
Код:
FStream.Read(arr^,Size);

 
delover
1. Код означает, что action "Delete" может быть выполнен толко, если в текущий контроль есть что-то выбрано и сам контроль не в режим "только для чтение".
 
2. Назначая клавиша Del для свой action, вы запрещаете его "нормальное" действие.

Всего записей: 119 | Зарегистр. 20-03-2003 | Отправлено: 09:26 27-03-2009
Frodo_Torbins

Silver Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Kursist
Данные в памяти могут быть "выровнены" для ускорения работы. Например, если включено 32-х битное выравнивание, то между каждым элементом массива будет еще 3 пустых байта. Да и вообще мне кажется удобнее будет использовать рекорды:
Код:
  TRGBQuadArray   = array[0..MaxInt div sizeof(TRGBQuad)-1] of TRGBQuad;
  PRGBQuadArray   = ^TRGBQuadArray;
TRGBQuad объявлен в модуле Windows и выглядит так:
Код:
  {$EXTERNALSYM tagRGBQUAD}
  tagRGBQUAD = packed record
    rgbBlue: Byte;
    rgbGreen: Byte;
    rgbRed: Byte;
    rgbReserved: Byte;
  end;
  TRGBQuad = tagRGBQUAD;
Директива packed означает, что в этой структуре выравнивание не производится, и она как раз поместится в 4 байта.

Всего записей: 2319 | Зарегистр. 24-05-2007 | Отправлено: 09:36 27-03-2009
Kursist



Junior Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Mandor Sawall
Спасибо! Так работает:

Цитата:
FStream.Read(arr^,Size);

 
Frodo_Torbins
Спасибо за полезную информацию! Теперь в раздумьях - делать ли рефакторинг программы создающей файл с данными RGBA.
 

Всего записей: 137 | Зарегистр. 12-07-2004 | Отправлено: 10:53 27-03-2009 | Исправлено: Kursist, 10:54 27-03-2009
Mandor Sawall

Junior Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Kursist
Обращайте более внимание на указателях. Код
Код:
FStream.Read(arr[loop1],SizeOf(Byte));
работает только потому, что, увидев индекс ([loop1]), Delphi заменяет ваш вызов на
Код:
FStream.Read(arr^[loop1],SizeOf(Byte));
(как и было правильно написать). В конце концов arr не массив, а только указатель к массива.

Всего записей: 119 | Зарегистр. 20-03-2003 | Отправлено: 12:22 27-03-2009
Bonivur



Advanced Member
Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору
У меня есть модуль для воспроизведения Midi звуков  
http://rapidshare.com/files/214155300/MidiGen.pas.html
был бы очень признателен если бы кто-нибудь помог сделать его работоспособным для Delphi 2009.  
 
использование типа этого:
 
var
  mg : TMidiGen;
 
begin
 
  mg := TMidiGen.Create(Self):
  mg.PlayNote(100);
//mg.PlayString('C#4');
  mg.Free;
 
end;
 
заранее благодарю.

----------
Что будет стоить тысяча слов когда важна будет крепость руки? (В.Цой)

Всего записей: 655 | Зарегистр. 22-06-2003 | Отправлено: 17:07 27-03-2009
delover

Advanced Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Mandor Sawall
Вы нажимали клавишу Del в обычном мемо? Для меня по дефолту не только то что SelLength это тот же ассемблерный код. Для меня это ещё и абсолютно те же виндовые сообщения - директива messages (для тех кто знаком). А так же акция только Del, управится никто не собрался, и куда же девался SetLength?

Всего записей: 1395 | Зарегистр. 25-06-2007 | Отправлено: 19:41 27-03-2009
ShIvADeSt



Moderator
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
delover
Прочитай, что ты написал. Там без бутылки не разберешь - что именно ты имел ввиду. При чем тут асм код - вообще хз, если на асме работать - то один фиг вызываешь теже АПИ функции только на синтаксисе АСМа. Насчет Del - он тебе правильно Mandor Sawall. Ты определил его как стандартное действо для попапа и есть много вариантов, когда при таком переопределении он работать не будет. Тут надо либо в событии попапа при нажатии делита либо имитировать поведение мемо на данную клавишу (посылать сообщение в мемо на удаление куска текста), либо делать анализ поведения и в случае чего посылать данную клавишу нужному контролу. А вообще переотпределять нажатия стандарных действий (например делита или ескейпа) для некоторых контролов не есть гуд. Потом будешь гемороиться с разруливанием проблем.


----------
И создал Бог женщину... Существо получилось злобное, но забавное...

Всего записей: 3956 | Зарегистр. 29-07-2003 | Отправлено: 05:24 28-03-2009
delover

Advanced Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
ShIvADeSt
Mandor Sawall
Я же, Вас таки тогда, научу любить стандартные акции. Ассемблер тут нужен только для весомости моих возмущений.

Цитата:
текста), либо делать анализ поведения и в случае чего посылать данную клавишу нужному контролу.

Есть, мне кажется, лучшее решение, и думаю оно вполне в духе Borland, так как не содержит ниодной новой буквы или выражения.

Код:
 
  TEditDelete = class(TEditAction)
  protected
    function HandleShortCut: Boolean; override; <--!!!! DEL or Ctrl+DEL?
  public
    procedure ExecuteTarget(Target: TObject); override;
    procedure UpdateTarget(Target: TObject); override;
  end;
...
function TEditDelete.HandleShortCut: Boolean;
begin
  if GetControl(Target).SelLength > 0 then  
    Result := inherited HandleShortCut else
    Result := False;
end;

Геморой только в том, что хелпером оверрайд не сделать при помощи хелперов. И в том, что над клавишей Del нарисован Dot...

Всего записей: 1395 | Зарегистр. 25-06-2007 | Отправлено: 13:21 28-03-2009
ShIvADeSt



Moderator
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
delover

Цитата:
Я же, Вас таки тогда, научу любить стандартные акции.

Я подобные вещи делаю на чистом АПИ, если надо - то просто делаю перехват оконной функции контрола и не имею проблем Всякие TAction - по сути обертка. Хотя каждый поступает как ему удобнее.


----------
И создал Бог женщину... Существо получилось злобное, но забавное...

Всего записей: 3956 | Зарегистр. 29-07-2003 | Отправлено: 15:31 28-03-2009
Kardinalli



Advanced Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Господа, дилетантский вопрос, работают ли программы скомпилированные в D7 под Vista? Нужно мигрировать на другой язык, переносить программы, вот выбираю, куда податься. NET не предлагать, тогда мне и без Delphi хорошо, но это другой вопрос...

Всего записей: 705 | Зарегистр. 22-10-2006 | Отправлено: 23:59 28-03-2009
   

Страницы: 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

Компьютерный форум Ru.Board » Компьютеры » Прикладное программирование » Вопросы по Delphi (все версии) - часть 4
ShIvADeSt (28-06-2009 02:10): Продолжение в http://forum.ru-board.com/topic.cgi?forum=33&topic=10477


Реклама на форуме Ru.Board.

Powered by Ikonboard "v2.1.7b" © 2000 Ikonboard.com
Modified by Ru.B0ard
© Ru.B0ard 2000-2024

BitCoin: 1NGG1chHtUvrtEqjeerQCKDMUi6S6CG4iC

Рейтинг.ru