Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Общие вопросы Delphi
Регистрация

Восстановить пароль

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 31.10.2007, 00:06   #11
Алексей_C
Пользователь
 
Аватар для Алексей_C
 
Регистрация: 27.10.2007
Сообщений: 40
По умолчанию

выдает ошибку в этих строчках (пометил красным):
with CI do
begin
CI.wType := RC3_ICON;
CI.Count := 1;
end;
Stream.Write(CI, SizeOf(CI));

with List, PBitmapInfoHeader(ColorInfo)^ do
begin
Width := biWidth;
Height := biHeight;
Colors := biPlanes * biBitCount;
DIBSize := ColorInfoSize + ColorBitsSize + MonoBitsSize;
DIBOffset := SizeOf(CI) + SizeOf(List);

end;
Алексей_C вне форума Ответить с цитированием
Старый 31.10.2007, 00:08   #12
Slovinsky
Пользователь
 
Регистрация: 26.10.2007
Сообщений: 79
По умолчанию

См выше, я немного ошибся когда приводил описание структур. Исправил. Лучше просто uses Windows, Graphics напишите и ничего сами не объявляйте.
Slovinsky вне форума Ответить с цитированием
Старый 31.10.2007, 00:14   #13
Алексей_C
Пользователь
 
Аватар для Алексей_C
 
Регистрация: 27.10.2007
Сообщений: 40
По умолчанию

а теперь delphi ненравится GetIconInfo(Icon, IconInfo)
и все ровно осталась строчка строчка с RC3_ICON
Алексей_C вне форума Ответить с цитированием
Старый 31.10.2007, 00:18   #14
Slovinsky
Пользователь
 
Регистрация: 26.10.2007
Сообщений: 79
По умолчанию

Алексей, Вы издеваетесь?! GetIconInfo должна быть в Windows.pas вы в Uses объявили? На всякий случай:
function GetIconInfo(hIcon: HICON; var piconinfo: TIconInfo): BOOL; stdcall;external user32 name 'GetIconInfo';

RC3_ICON - в Graphics.pas
Цитата:
rc3_StockIcon = 0;
rc3_Icon = 1;
rc3_Cursor = 2;
Просто объявите модули в uses, дабы мне не подсказывать вам каждую строчку:
uses Windows, Graphics;
Slovinsky вне форума Ответить с цитированием
Старый 31.10.2007, 00:37   #15
Алексей_C
Пользователь
 
Аватар для Алексей_C
 
Регистрация: 27.10.2007
Сообщений: 40
По умолчанию

не я неиздеваюсь и все в uses находится, но вот что пишет

[Error] Unit1.pas(72): Types of actual and formal var parameters must be identical (Это по поводу GetIconInfo(Icon, IconInfo)
- он то вроде нормально работает и правильно определяется в Windows.pas но все же вылазиет это)
[Error] Unit1.pas(85): Undeclared identifier: 'RC3_ICON' (а вот этот неопределяется в Graphics.pas, я знаю что он там есть, но определиться неможет почемуто)
Алексей_C вне форума Ответить с цитированием
Старый 31.10.2007, 00:48   #16
Slovinsky
Пользователь
 
Регистрация: 26.10.2007
Сообщений: 79
По умолчанию

Выложите свой код, посмотрим. У меня все отлично компилируется и работает.
Slovinsky вне форума Ответить с цитированием
Старый 31.10.2007, 00:54   #17
Алексей_C
Пользователь
 
Аватар для Алексей_C
 
Регистрация: 27.10.2007
Сообщений: 40
По умолчанию

Вот код, незнаю может че забыл?

Код:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Controls, Forms,
  Dialogs, ShellApi, ExtCtrls, StdCtrls, Graphics;

type
  TForm1 = class(TForm)
    Image1: TImage;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }

  public
    { Public declarations }
  end;

TCursorOrIcon = packed record
Reserved: Word;
wType: Word;
Count: Word;
end;

TIconInfo = packed record
fIcon: BOOL;
xHotspot: DWORD;
yHotspot: DWORD;
hbmMask: HBITMAP;
hbmColor: HBITMAP;
end;

TIconRec = packed record
Width: Byte;
Height: Byte;
Colors: Word;
Reserved1: Word;
Reserved2: Word;
DIBSize: Longint;
DIBOffset: Longint;
end;

 HBITMAP = type LongWord;


var
  Form1: TForm1;



implementation



{$R *.dfm}

procedure WriteIcon32(Icon: HIcon; const Stream: TStream);
var
  IconInfo: TIconInfo;
  MonoInfoSize, ColorInfoSize: DWORD;
  MonoBitsSize, ColorBitsSize: DWORD;
  MonoInfo, MonoBits, ColorInfo, ColorBits: Pointer;
  CI: TCursorOrIcon;
  List: TIconRec;
begin
  FillChar(CI, SizeOf(CI), 0);
  FillChar(List, SizeOf(List), 0);
  if not GetIconInfo(Icon, IconInfo) then RaiseLastOSError;
  try
    GetDIBSizes(IconInfo.hbmMask, MonoInfoSize, MonoBitsSize);
    GetDIBSizes(IconInfo.hbmColor, ColorInfoSize, ColorBitsSize);
    MonoInfo := nil; MonoBits := nil; ColorInfo := nil; ColorBits := nil;

    try
      MonoInfo := AllocMem(MonoInfoSize);
      MonoBits := AllocMem(MonoBitsSize);
      ColorInfo := AllocMem(ColorInfoSize);
      ColorBits := AllocMem(ColorBitsSize);
      GetDIB(IconInfo.hbmMask, 0, MonoInfo^, MonoBits^);
      GetDIB(IconInfo.hbmColor, 0, ColorInfo^, ColorBits^);
           CI.wType := RC3_ICON;
      with CI do
      begin
        CI.wType := RC3_ICON;
        CI.Count := 1;
      end;
      Stream.Write(CI, SizeOf(CI));

      with List, PBitmapInfoHeader(ColorInfo)^ do
      begin
        Width := biWidth;
        Height := biHeight;
        Colors := biPlanes * biBitCount;
        DIBSize := ColorInfoSize + ColorBitsSize + MonoBitsSize;
        DIBOffset := SizeOf(CI) + SizeOf(List);
      end;
      Stream.Write(List, SizeOf(List));

      with PBitmapInfoHeader(ColorInfo)^ do
        Inc(biHeight, biHeight); { color height includes mono bits }
      Stream.Write(ColorInfo^, ColorInfoSize);
      Stream.Write(ColorBits^, ColorBitsSize);
      Stream.Write(MonoBits^, MonoBitsSize);

    finally
      FreeMem(ColorInfo, ColorInfoSize);
      FreeMem(ColorBits, ColorBitsSize);
      FreeMem(MonoInfo, MonoInfoSize);
      FreeMem(MonoBits, MonoBitsSize);
    end;
  finally
    DeleteObject(IconInfo.hbmColor);
    DeleteObject(IconInfo.hbmMask);
  end;
end;

function LoadIconFromExe(FileName: String; X, Y: Integer): Cardinal;
var
  hMod: HModule;
begin
  hMod:=LoadLibraryEx(PChar(FileName),0,LOAD_LIBRARY_AS_DATAFILE);
  try
    Result:=LoadImage(hMod,'MAINICON',IMAGE_ICON,X,Y,LR_DEFAULTCOLOR);
  finally
    FreeLibrary(hMod);
  end;
end;




procedure TForm1.Button1Click(Sender: TObject);
var
  hIcon: Cardinal;
  Stream: TFileStream;
begin
  hIcon:=LoadIconFromExe('D:\12.exe',32,32);
  Stream:=TFileStream.Create('C:\Icon.ico',fmCreate);
  try
    WriteIcon32(hIcon,Stream);
  finally
    Stream.Free;
    DestroyIcon(hIcon);
  end;

end;




end.
Алексей_C вне форума Ответить с цитированием
Старый 31.10.2007, 00:58   #18
Slovinsky
Пользователь
 
Регистрация: 26.10.2007
Сообщений: 79
По умолчанию

Уберите вот это:


TCursorOrIcon = packed record
Reserved: Word;
wType: Word;
Count: Word;
end;

TIconInfo = packed record
fIcon: BOOL;
xHotspot: DWORD;
yHotspot: DWORD;
hbmMask: HBITMAP;
hbmColor: HBITMAP;
end;

TIconRec = packed record
Width: Byte;
Height: Byte;
Colors: Word;
Reserved1: Word;
Reserved2: Word;
DIBSize: Longint;
DIBOffset: Longint;
end;

HBITMAP = type LongWord;

ни к чему если мы ссылаемся на юниты, в которых типы есть. Именно из-за этого получаете Types of actual and formal var parameters must be identical, так как теперь у нас есть два одноименных типа

И если не находит константу RC3_ICON, объявите ее сами равной 1.
Slovinsky вне форума Ответить с цитированием
Старый 31.10.2007, 01:07   #19
Алексей_C
Пользователь
 
Аватар для Алексей_C
 
Регистрация: 27.10.2007
Сообщений: 40
По умолчанию

ладно там я все зделал, но теперь уже при сохранении ICO вылазиет ошибка Bitmap Image is not valid.
Алексей_C вне форума Ответить с цитированием
Старый 31.10.2007, 01:10   #20
Slovinsky
Пользователь
 
Регистрация: 26.10.2007
Сообщений: 79
По умолчанию

Значит скорее всего у вас иконка не загружается из файла даже. Рекомендации:
1. Проверить любым редактором ресурсов имя ресурса
2. Проверить срабатывает ли вызов LoadImage и если нет - какой код ошибки.

Удачи!
Slovinsky вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Как программно извлечь иконку из exe файла Altera Win Api 3 19.07.2008 21:39
Как извлечь имя скачиваемого файла Crazyman Работа с сетью в Delphi 0 01.07.2008 02:34
Извлечь путь из EXE NeiL Общие вопросы Delphi 3 21.05.2008 18:44
Извлечь имена приложений NeiL Win Api 3 07.05.2008 14:33
Извлечь песни из NFS Pro street DeN1308 Софт 0 24.11.2007 15:38