IPB
ЛогинПароль:

> ВНИМАНИЕ!

Прежде чем задать вопрос, смотрите FAQ.
Рекомендуем загрузить DRKB.

Наладить общение поможет, если вы подпишитесь по почте на новые темы в этом форуме.

2 страниц V < 1 2  
 Ответить  Открыть новую тему 
> Вопросы по WinApi...
сообщение
Сообщение #21


Пионер
**

Группа: Пользователи
Сообщений: 72
Пол: Мужской

Репутация: -  0  +


Цитата(volvo @ 12.05.2008 8:11) *

Вот EXE-шник:
(только там теперь по нажатию на кнопку отрабатывает ProgressBar и размер формы меняется, закрывать форму придется "крестиком")...


спасибо, по листбоксу...
а прогрессбар в exe не показывает... уже тему поменял на стандартную и всё равно...
он в общем не сильно нужен...
но глюк интересный...

П.С. ещё одни вопросик нарисовался...

   
WM_DESTROY: begin
if MessageBox(handleW1, 'Подтверждение...', 'хотите выйти ?',
MB_OkCancel+MB_IconAsterisk+mb_systemmodal)= idCancel then exit;
PostQuitMessage(0);
Result := 0;
end; // Ну, или закрыли крестиком или Alt+F4


После показа messageBox'а скрывается основная форма... а это не нужно...
можно это исправить?

Сообщение отредактировано: Snake_B -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #22


Гость






Цитата
После показа messageBox'а скрывается основная форма... а это не нужно...
blink.gif Естественно... Окно получает сообщение WM_DESTROY тогда, когда уже не может отменить закрытие, ты отменяешь только уничтожение окна... Закрывается оно еще перед вызовом MessageBox-а... Тебе надо обрабатывать WM_CLOSE, чтоб иметь возможность отменять закрытие окна:

    WM_CLOSE:
begin
// если все-таки хочешь выйти, значит удалить-таки окно: DestroyWindow
if MessageBox(handleWnd, 'Подтверждение...', 'хотите выйти ?',
MB_OKCANCEL + MB_ICONASTERISK + MB_SYSTEMMODAL) = IDOK then DestroyWindow(handleWnd);
end;

 К началу страницы 
+ Ответить 
сообщение
Сообщение #23


Пионер
**

Группа: Пользователи
Сообщений: 72
Пол: Мужской

Репутация: -  0  +


Цитата(volvo @ 12.05.2008 17:54) *

blink.gif Естественно... Окно получает сообщение WM_DESTROY тогда, когда уже не может отменить...


С этим понятно...
Вот пытаюсь тут по FAQ (drkb), статья: "Сохранение и выдёргивание ресурсов в DLL или EXE? "
сохранить ресурс в exe... ресурс создал, в exe он судя по размеру тоже добавляется,
а когда пытаюсь его извлечь выдает: "Resourse 1 not found"


procedure ExtractToFile(Instance:THandle; ResID:Integer; ResType, FileName:String);
var ResStream: TResourceStream; FileStream: TFileStream;
begin
try ResStream := TResourceStream.CreateFromID(Instance, ResID, pChar(ResType));
try if FileExists(FileName) then DeleteFile(pChar(FileName));
FileStream := TFileStream.Create(FileName, fmCreate);
try FileStream.CopyFrom(ResStream, 0); finally
FileStream.Free; end;
finally ResStream.Free; end;
except on E:Exception do begin
DeleteFile(FileName); raise;
end; end; end;

...
ExtractToFile(handleW1, 1, 'CUSTOM', ExtractFiledir(paramStr(0))+'/Source SMP/LogoSI.bmp');


p.s. вот тут файлик прикрепляю... так создаю и извлекаю..
всё тоже: "Resourse 1 not found"
чего не так?

Сообщение отредактировано: Snake_B -


Прикрепленные файлы
Прикрепленный файл  Unit1.pas ( 3.58 килобайт ) Кол-во скачиваний: 182
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #24


Гость






У меня вот так прекрасно отработало:

// Внимание на типы!!! ResType я сделал Integer-ом!!!
procedure ExtractToFile(Instance:THandle;
ResID, ResType: integer; FileName:String);
var
ResStream: TResourceStream;
FileStream: TFileStream;
begin
try
ResStream := TResourceStream.CreateFromID(Instance, ResID, PChar(ResType));
try
if FileExists(FileName) then DeleteFile(pChar(FileName));
FileStream := TFileStream.Create(FileName, fmCreate);
try
FileStream.CopyFrom(ResStream, 0);
finally
FileStream.Free;
end;

finally
ResStream.Free;
end;

except on E:Exception do begin
DeleteFile(FileName); raise;
end;
end;
end;

...

// вместо Application.Handle лучше использовать HInstance...
ExtractToFile(HInstance, 1, 10, ExtractFiledir(paramStr(0))+'\pic_new.bmp');

(к вопросу, почему именно целочисленная 10, а не 'CUSTOM': При преобразовании этой 10 к типу PChar в процедуре получим как раз PChar(10), что соответствует RT_RCDATA... Как записывали в ресурс, так надо и извлекать...)

Сообщение отредактировано: volvo -
 К началу страницы 
+ Ответить 
сообщение
Сообщение #25


Пионер
**

Группа: Пользователи
Сообщений: 72
Пол: Мужской

Репутация: -  0  +


Цитата(volvo @ 16.05.2008 21:28) *

У меня вот так прекрасно отработало...


Спасибо, заработало... вроде :-)

И ещё вопросик :-[

function ChangeDirectory(): pchar;
var
TitleName : string;
lpItemID : PItemIDList;
BrowseInfo : TBrowseInfo;
DisplayName : array[0..MAX_PATH] of char;
begin
FillChar(BrowseInfo, sizeof(TBrowseInfo), #0);
BrowseInfo.hwndOwner := handleW1;
BrowseInfo.pszDisplayName := @DisplayName;
TitleName := 'Please specify a directory';
BrowseInfo.lpszTitle := PChar(TitleName);
BrowseInfo.ulFlags := BIF_RETURNONLYFSDIRS;
lpItemID := SHBrowseForFolder(BrowseInfo);
if lpItemId <> nil then begin
SHGetPathFromIDList(lpItemID, result);
GlobalFreePtr(lpItemID);
end;
end;

.....

sc1:=ChangeDirectory;



Вот, вызываю функцию... выбор папки... Если длинна выбранного пути > 38 (~),
то появляется ошибка...
что посоветуете? :-)
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #26


Гость






Вообще-то когда работаешь с PChar, надо быть осторожнее... Лучше сделай так:

function ChangeDirectory(): String;
var
TitleName : string;
lpItemID : PItemIDList;
BrowseInfo : TBrowseInfo;
DisplayName : array[0..MAX_PATH] of char;
TempName: Array[0 .. MAX_PATH] of char;
begin
FillChar(BrowseInfo, sizeof(TBrowseInfo), #0);
BrowseInfo.hwndOwner := form1.Handle; // ну, или что там у тебя ...
BrowseInfo.pszDisplayName := @DisplayName;
TitleName := 'Please specify a directory';
BrowseInfo.lpszTitle := PChar(TitleName);
BrowseInfo.ulFlags := BIF_RETURNONLYFSDIRS;
lpItemID := SHBrowseForFolder(BrowseInfo);
if lpItemId <> nil then begin
SHGetPathFromIDList(lpItemID, TempName);
result := strpas(TempName);
GlobalFreePtr(lpItemID);
end;
end;


Сообщение отредактировано: volvo -
 К началу страницы 
+ Ответить 
сообщение
Сообщение #27


Пионер
**

Группа: Пользователи
Сообщений: 72
Пол: Мужской

Репутация: -  0  +


Новый вопросик... и мне кажется он где-то близко к progressbar'у...


procedure ChangeLPB(value: integer);
var
i: integer;
s: string;
begin
s:=' ';
for i := 0 to value do s:=s+'|';
s:=s+' ';
SetWindowText( mS2, PChar(s));
end;

................

// создаю текст...
mS2:= CreateWindow('STATIC', '', WS_CHILD or WS_VISIBLE or WS_BORDER + es_readonly,
6, 180, 308, 21, handleW1, 0, hInstance, nil );
SendMessage(mS2, WM_SETFONT, WPARAM(mF3), 0);

for i := 0 to 99 do begin
Sleep(50);
ChangeLPB(i);
end;

while GetMessage (Msg1, 0, 0, 0) do begin
TranslateMessage (Msg1); DispatchMessage (Msg1);
end;

как дать команду отрисовать текст пред for...
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #28


Пионер
**

Группа: Пользователи
Сообщений: 72
Пол: Мужской

Репутация: -  0  +


Цитата(Snake_B @ 24.05.2008 19:53) *

Новый вопросик... и мне кажется он где-то близко к progressbar'у...

...

как дать команду отрисовать текст пред for...


туплю чего то :-)
UpdateWindow(handleW1);

и прогрессбар заработал... винду не переустанавливал... вообще вроде ни чего такого с компом не делал...
good.gif
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

2 страниц V < 1 2
 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 31.10.2020 15:56
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name