Помощь - Поиск - Пользователи - Календарь
Полная версия: Вопросы по WinApi...
Форум «Всё о Паскале» > Современный Паскаль и другие языки > Делфи
Snake_B
"Вопросы по WinApi..."

Ковыряюсь во всяких справочниках... чего то ни фига не получается...
Если кто может подскажите, как сделать или где поглядеть пример...

1. CreateWindow ( 'STATIC', text', WS_CHILD or WS_VISIBLE, 30, 8, 500, 80, handleWnd, 0, hInstance, nil );
* как задать ему цвет
* сделать вертикальный скролл
* изменить шрифт (размер, цвет и сам шрифт)

2. Загрузить и показать рисунок (bmp и jpg)...

3. Изменить цвет border color...

4. обработка нажатия кнопки...

лучше всего пример... blush.gif
andriano
Если ты указал один из стандартных классов, то цвет можно изменить только в обработчике WM_PAINT. Если же ты сам регистрируешь класс окна, то там и можешь задать нужную кисть для фона. Вполне естественно, что все окна одного класса выводятся одним цветом.

Вертикальный скролл - добавить WS_VSCROLL в стиль окна.

Для того, чтобы писать каким-либо шрифтом, надо создать нужный фонт. Другие способы мне не известны, хотя, возможно, они и есть.

Рисунок проще всего размесить в том же WM_PAINT.

По нажатию кнопки приходит сообщение WM_COMMAND, в параметре WP которого номер нажатой кнопки. Как хочешь, так и обрабатываешь.

Основной источник справки для меня файл Win32.hlp, поставляемый обычно с виндовыми компиляторами. Более подробную информацию можно получить в MSDN.

Еще есть интересная программка http://forum.sources.ru/index.php?showtopic=182219. Она, правда, в явно незаконченном виде, но кое-какие примеры с ее помощью можно посмотреть.
Snake_B
А можно всё таки как-нибудь на примере?
Теоретически как бы всё понятно (до того как вопрос задал, догадывался), а на практике сделать не получается...


program WApi;

uses
Windows,
Messages,
ComObj,
SysUtils,
ActiveX,
ShlObj,
shellapi;

const myClassName= 'myWindow';

var handleWnd: THandle; WndClass: TWndClass; Msg: TMsg;

// Procedure & function >>>>>

function WindowProc(Window: HWnd; AMessage, WParam, LParam: Longint): Longint; stdcall;
begin
WindowProc:= DefWindowProc(Window, AMessage, WParam, LParam);
case AMessage of
WM_DESTROY: Halt;
WM_PAINT: begin SetBkColor(handleWnd, color_btnface+1); UpdateWindow(handleWnd); end; // ?
WM_LBUTTONDOWN: Halt;
/// Срабатывает при нажатии на форму или на текст, а на нажатие button'а не реагирует...
end;
end;

// Procedure & function <<<<<
begin
with WndClass do begin
hInstance := hInstance;
lpszClassName:= myClassName;
style := cs_hRedraw or cs_vRedraw;
hbrBackground:= color_btnface+2;
lpfnWndProc := @WindowProc;
hCursor := LoadCursor(0, idc_Arrow);
end;
RegisterClass( WndClass );

handleWnd := CreateWindow(myClassName, 'Caption...', WS_SYSMENU or WS_MINIMIZEBOX,
400-300, 300-200, 600, 400, 0, 0, hInstance, NIL);
CreateWindow('Label', 'Text', WS_VISIBLE or WS_CHILD or WM_SETTEXT,
20, 10, 60, 23, handleWnd, 0, hInstance, nil);
CreateWindow('STATIC', 'Borland Studio Projects Borland Studio Projects Borland Studio' +
' Projects Borland Studio ProjectsBorland Studio Projects Borland Studio Projects Borland' +
' Studio Projects Borland Studio Projects', WS_CHILD or WS_VISIBLE + WS_VSCROLL,
30, 8, 200, 80, handleWnd, 0, hInstance, nil); /// Скролл выводит, но он не работает...
// SetTextColor(handleWnd, color_btnface+5);
CreateWindow('BUTTON', '123', WS_VISIBLE or WS_CHILD,
10, 179, 275, 22, handleWnd, 0, hInstance, nil);

ShowWindow(handleWnd, sw_ShowNormal); UpdateWindow(handleWnd);
while GetMessage (Msg, 0, 0, 0) do begin
TranslateMessage (Msg); DispatchMessage (Msg);
end;
end.



ну и загрузка/отображение рисунка... исходник бы какой... по проще... :-)
volvo
Идея не самая удачная - учиться на том, что в принципе не разрешено: MSDN: Static Control Styles - как видишь, ничего связанного с прокруткой STATIC напрямую не поддерживает. Пользуйся лучше EDIT-ом...
Snake_B
Цитата(volvo @ 6.05.2008 22:03) *

Идея не самая удачная - учиться на том, что в принципе не разрешено: MSDN: Static Control Styles - как видишь, ничего связанного с прокруткой STATIC напрямую не поддерживает. Пользуйся лучше EDIT-ом...


а в edit'е можно сделать перенос строк? и как...
ну и с остальными так и не разобрался... :-[
volvo
Цитата
а в edit'е можно сделать перенос строк? и как...
Легко... Но давай начнем с того, что тебе надо подкорректировать всю программу:
program WinApiTest;

uses
Windows, Messages;

const
myClassName= 'myWindow';

BTN_ID = 200; // ID кнопки

var
handleWnd, myButton, myLabel, myStatic: HWND;
myFont: HFONT;

WndClass: TWndClassEx;
Msg: TMsg;

// Procedure & function >>
function WindowProc(Window: HWND; AMessage: UINT;
WParam: WPARAM; LParam: LPARAM): INT_PTR; stdcall;
begin
case AMessage of
WM_COMMAND: // Здесь ловим ID нажатой кнопки
begin
case LoWord(WParam) of
BTN_ID: // Вот он, значит, закрываем приложение
begin
PostQuitMessage(0);
Result := 0;
end;
end;
end;

WM_DESTROY: // Ну, или закрыли крестиком или Alt+F4
begin
PostQuitMessage(0);
Result := 0;
end;

else
// Если ничего не отработало - то вызываем стандартную функцию
Result := DefWindowProc(Window, AMessage, WParam, LParam);
end;

end;

// Main Function
begin
with WndClass do begin
cbSize := SizeOf(WndClass);
style := CS_HREDRAW or CS_VREDRAW;
lpfnWndProc := @WindowProc;
cbClsExtra := 0;
cbWndExtra := 0;
hIcon := LoadIcon(0, IDI_APPLICATION);
hCursor := LoadCursor(0, IDC_ARROW);
hbrBackground := COLOR_BTNFACE + 1;
lpszMenuName := nil;
lpszClassName := myClassName;
end;
WndClass.hInstance := HInstance;

if RegisterClassEx(WndClass) = 0 then exit;

// Создаем окно
handleWnd := CreateWindow(myClassName, 'Caption...',
WS_SYSMENU or WS_MINIMIZEBOX,
100, 100, 600, 400,
0, 0,
hInstance, nil);

ShowWindow(handleWnd, sw_ShowNormal);

// В этом окне - кнопку ...
myButton := CreateWindow('button', 'Close',
WS_VISIBLE or WS_CHILD,
10, 179, 275, 22,
handleWnd, BTN_ID, hInstance, nil);
// ... метку ...
myLabel := CreateWindow('static', 'Text',
WS_VISIBLE or WS_CHILD,
20, 10, 60, 23,
handleWnd, 0, hInstance, nil);

// ... и Edit
myStatic := CreateWindow('edit',
PChar('Borland Studio Projects Borland Studio Projects '+
'Borland Studio Projects Borland Studio Projects'+
'Borland Studio Projects Borland Studio Projects '+
'Borland Studio Projects Borland Studio Projects '+
'Borland Studio Projects Borland Studio Projects'+
'Borland Studio Projects Borland Studio Projects '+
'Borland Studio Projects Borland Studio Projects '+
'Borland Studio Projects Borland Studio Projects'+
'Borland Studio Projects Borland Studio Projects '+
'Borland Studio Projects Borland Studio Projects'),
WS_CHILD or WS_VISIBLE or WS_VSCROLL or ES_MULTILINE,
30, 25, 200, 100, handleWnd, 0, hInstance, nil );

// Это для красоты - меняем шрифт
myFont := CreateFont(
-11, 0, 0, 0, FW_NORMAL, 0, 0, 0, DEFAULT_CHARSET,
OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY,
DEFAULT_PITCH or FF_DONTCARE, 'MS Sans Serif'
);
SendMessage(myButton, WM_SETFONT, WPARAM(myFont), 0);
SendMessage(myLabel, WM_SETFONT, WPARAM(myFont), 0);
SendMessage(myStatic, WM_SETFONT, WPARAM(myFont), 0);

UpdateWindow(handleWnd);

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

Посмотри, что я изменил, и что из этого получилось... А потом посмотрим, что делать дальше... smile.gif
Snake_B
Цитата(volvo @ 7.05.2008 1:12) *

Легко... Но давай начнем с того, что тебе надо подкорректировать всю программу:
...
Посмотри, что я изменил, и что из этого получилось... А потом посмотрим, что делать дальше... smile.gif



program WinApiTest;

uses Windows, Messages, ComObj, SysUtils, ActiveX, ShlObj, shellapi;

const myClassName= 'myWindow';
BTN_ID = 200; // ID кнопки
IDChBox1 = 199;
IDRBtn1 = 1;
IDRBtn2 = 2;
IDRBtn3 = 3;
IDRBtn4 = 4;

var
handleWnd, myButton, myLabel, myStatic, ChBox1, RBtn1, RBtn2, RBtn3, RBtn4: HWND;
WndClass: TWndClassEx;
Msg: TMsg; SC1, SC2: string; myFont: HFONT;

// Procedure & function
function WindowProc(Window: HWND; AMessage: Integer;
WParam: WPARAM; LParam: LPARAM): LRESULT; stdcall;
var
Res: LRESULT;
p: PChar;
n: integer;
begin
case AMessage of
WM_COMMAND: // Здесь ловим ID нажатой кнопки
begin
if ( LoWord( wParam ) >= IDRBtn1 ) and ( LoWord( wParam ) <= IDRBtn2 ) then
begin CheckRadioButton( handleWnd, IDRBtn1, IDRBtn2, LoWord( wParam ) ); end;
if ( LoWord( wParam ) >= IDRBtn3 ) and ( LoWord( wParam ) <= IDRBtn4 ) then
begin CheckRadioButton( handleWnd, IDRBtn3, IDRBtn4, LoWord( wParam ) ); end;
case LoWord(WParam) of
BTN_ID: begin PostQuitMessage(0); Result := 0; end;
IDRBtn1: begin end; // Обработка radiobutton'ов
IDRBtn2: begin end;
IDRBtn3: begin end;
IDChBox1: begin // обработка checkbox'ов
Res := SendMessage( ChBox1, BM_GETCHECK, 0, 0 );
case Res of
BST_CHECKED: SetWindowText( myLabel, 'Состояние: включен' );
BST_UNCHECKED: SetWindowText( myLabel, 'Состояние: выключен' );
end; end;
end;
end;
WM_DESTROY: // Ну, или закрыли крестиком или Alt+F4
begin
PostQuitMessage(0);
Result := 0;
end;
else
// Если ничего не отработало - то вызываем стандартную функцию
Result := DefWindowProc(Window, AMessage, WParam, LParam);
end;
end;

// Procedure & function
begin
with WndClass do begin
cbSize := SizeOf(WndClass);
style := CS_HREDRAW or CS_VREDRAW;
lpfnWndProc := @WindowProc;
cbClsExtra := 0;
cbWndExtra := 0;
hIcon := LoadIcon(0, IDI_APPLICATION);
hCursor := LoadCursor(0, IDC_ARROW);
hbrBackground := COLOR_BTNFACE + 1;
lpszMenuName := nil;
lpszClassName := myClassName;
end;
WndClass.hInstance := HInstance;

if RegisterClassEx(WndClass) = 0 then exit;

handleWnd:= CreateWindow(myClassName, 'Caption...', WS_SYSMENU or WS_MINIMIZEBOX,
400-300,300-200, 600, 400, 0, 0, hInstance , NIL);
CreateWindow( 'Label', 'Text', WS_VISIBLE or WS_CHILD or WM_SETTEXT,
300, 152, 60, 23, handleWnd, 0, hInstance, nil);
ShowWindow(handleWnd, sw_ShowNormal);

myButton := CreateWindow('button', 'Close', WS_VISIBLE or WS_CHILD,
10, 179, 275, 22, handleWnd, BTN_ID, hInstance, nil);
myLabel := CreateWindow('static', 'Text', WS_VISIBLE or WS_CHILD,
20, 10, 120, 14, handleWnd, 0, hInstance, nil);
myStatic := CreateWindow('edit',
PChar('Borland Studio Projects Borland Studio Projects Borland Studio Projects Borland Studio Projects'+
'Borland Studio Projects Borland Studio Projects Borland Studio Projects Borland Studio Projects '+
'Borland Studio Projects Borland Studio Projects Borland Studio Projects Borland Studio Projects '+
'Borland Studio Projects Borland Studio Projects Borland Studio Projects Borland Studio Projects'+
'Borland Studio Projects Borland Studio Projects Borland Studio Projects Borland Studio Projects'),
WS_CHILD or WS_VISIBLE or WS_VSCROLL or ES_MULTILINE + WS_BORDER,
30, 25, 200, 100, handleWnd, 0, hInstance, nil );

CreateWindow('STATIC', PChar('|||||||||||||||||||||||||||||||||||||||||||||||||'),
WS_CHILD or WS_VISIBLE or WS_BORDER + es_readonly,
100, 280, 400, 21, handleWnd, 0, hInstance, nil );

ChBox1 := CreateWindowEx( 0, 'Button', 'BS_AUTOCHECKBOX',
WS_CHILD or WS_VISIBLE or BS_AUTOCHECKBOX, 300, 10, 130, 25,
handleWnd, IDChBox1, hinstance, nil );
RBtn1 := CreateWindowEx( 0, 'Button', 'Опция 1',
WS_CHILD or WS_VISIBLE or BS_RADIOBUTTON, 300, 40, 80, 20,
handleWnd, IDRBtn1, hInstance, nil );
RBtn2 := CreateWindowEx( 0, 'Button', 'Опция 2',
WS_CHILD or WS_VISIBLE or BS_RADIOBUTTON, 300, 70, 80, 20,
handleWnd, IDRBtn2, hInstance, nil );
RBtn3 := CreateWindowEx( 0, 'Button', 'Опция 3',
WS_CHILD or WS_VISIBLE or BS_RADIOBUTTON, 300, 120, 80, 20,
handleWnd, IDRBtn3, hInstance, nil );
RBtn4 := CreateWindowEx( 0, 'Button', 'Опция 4',
WS_CHILD or WS_VISIBLE or BS_RADIOBUTTON, 300, 150, 80, 20,
handleWnd, IDRBtn4, hInstance, nil );

myFont:= CreateFont(-11, 0, 0, 0, FW_NORMAL, 0, 0, 0,
DEFAULT_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS,
DEFAULT_QUALITY, DEFAULT_PITCH or FF_DONTCARE, 'MS Sans Serif');
SendMessage(myButton, WM_SETFONT, WPARAM(myFont), 0);
SendMessage(myLabel, WM_SETFONT, WPARAM(myFont), 0);
SendMessage(myStatic, WM_SETFONT, WPARAM(myFont), 0);
SendMessage( ChBox1, WM_SETFONT, WPARAM(myFont), 0 );
SendMessage( RBtn1, WM_SETFONT, WPARAM(myFont), 0 );
SendMessage( RBtn2, WM_SETFONT, WPARAM(myFont), 0 );
SendMessage( RBtn3, WM_SETFONT, WPARAM(myFont), 0 );
SendMessage( RBtn4, WM_SETFONT, WPARAM(myFont), 0 );

SendMessage( RBtn1, BM_CLICK, 0, 0 ); SendMessage( RBtn3, BM_CLICK, 0, 0 );
// Нажимаем radiobutton, для инициализации...

UpdateWindow(handleWnd);
while GetMessage (Msg, 0, 0, 0) do begin
TranslateMessage (Msg); DispatchMessage (Msg);
end;

end.


Спасибо, многое вроде понял :-)
но вопросики остались :-[

Поле Edit... мне нужно туда выводить текст, скролл если текст влазить не будет,
но этот текст должно быть нельзя редактировать.
es_readonly
- почти то что нужно, но меняется цвет, а нужен всё таки белый...
как изменить цвет или как по другому сделать можно, это 1.

2. Ну всё также, загрузка/показ рисунка... ни где так примера и не нашел...

3. Можно ли вызвать стандартный progress bar.... там я в исходнике в принципе набросал из STATIC'а...
но стандартным симпотичнее было бы...

Вроде кроме этого вопросов возникнуть не должно :-)

p.s. там если в исходнике чего лишнего... я его не целиком выкладываю... кое-что удаляю... все равно там всё тоже самое... но огрызки остаются...
volvo
1.
Цитата
Можно ли вызвать стандартный progress bar

Можно:
  // Создаем прогрессбар
myProgress := CreateWindow('msctls_progress32', '', WS_CHILD or WS_VISIBLE,
250, 20, 300, 30, handleWnd, 0, HInstance, nil);
// устанавливаем границы
SendMessage(myProgress, PBM_SETRANGE, 0, MAKELPARAM(0, 100));


Вот так посылаем прогресс-бару сообщения:
...
case LoWord(WParam) of
BTN_ID: // По нажатию кнопки перед закрытием, отобразим Progress...
begin
for i := 0 to 100 do begin
Sleep(50);
SendMessage(myProgress, PBM_SETPOS, i, 0);
end;
PostQuitMessage(0);
Result := 0;
end;
...


Необходимые константы:
Const
PBM_SETRANGE = WM_USER + 1;
PBM_SETPOS = WM_USER + 2;
PBM_STEPIT = WM_USER + 5;



2.
Цитата
Ну всё также, загрузка/показ рисунка... ни где так примера и не нашел...
Вот тебе пример:

var 
StaticWnd: HWND;
ImLogo: HBITMAP;
...
// Создаем статический контрол
StaticWnd := CreateWindow('static', 'Test',
WS_VISIBLE or WS_CHILD or SS_BITMAP or SS_CENTERIMAGE,
100, 100, 500, 300, handleWnd, 0, HInstance, nil);
// Грузим в битмап содержимое BMP-файла
ImLogo := LoadImage(0, 'real_map.bmp', IMAGE_BITMAP, 0, 0,
LR_LOADFROMFILE or LR_LOADMAP3DCOLORS or LR_LOADTRANSPARENT);
// И посылаем стат. контролу сообщение об установке изображения
SendMessage(StaticWnd, STM_SETIMAGE, IMAGE_BITMAP, ImLogo);



Насчет неизменяемого EDIT-а сейчас гляну...

Добавлено через 9 мин.
P.S. А, ну так не надо делать ES_READONLY, достаточно написать ничего не делающую оконную функцию:

var
OldEditProc: Pointer;

function myEditProc(Window: HWND; AMessage: UINT;
WParam: WPARAM; LParam: LPARAM): INT_PTR; stdcall;

begin
Case AMessage of
WM_CHAR: Result:=0;
WM_LBUTTONDOWN: Result:=0;
WM_RBUTTONDOWN: Result:=0;
else Result:=CallWindowProc(OldEditProc, Window, AMessage, WParam, LParam);
end;
end;

// и после создания EDIT-а подменить стандартную оконную функцию новой:

... // Здесь создаем myStatic

// и подменяем функцию окна
OldEditProc:=Pointer(SetWindowLong(myStatic,GWL_WNDPROC,LongInt(@myEditProc)));

Snake_B
Цитата(volvo @ 8.05.2008 3:08) *

Можно:
  // Создаем прогрессбар
myProgress := CreateWindow('msctls_progress32', '', WS_CHILD or WS_VISIBLE,
250, 20, 300, 30, handleWnd, 0, HInstance, nil);
// устанавливаем границы
SendMessage(myProgress, PBM_SETRANGE, 0, MAKELPARAM(0, 100));


Вот так посылаем прогресс-бару сообщения:
...
case LoWord(WParam) of
BTN_ID: // По нажатию кнопки перед закрытием, отобразим Progress...
begin
for i := 0 to 100 do begin
Sleep(50);
SendMessage(myProgress, PBM_SETPOS, i, 0);
end;
PostQuitMessage(0);
Result := 0;
end;
...


Необходимые константы:
Const
PBM_SETRANGE = WM_USER + 1;
PBM_SETPOS = WM_USER + 2;
PBM_STEPIT = WM_USER + 5;




Всё вроде понятно... но вот прогресс бар не хотит работать... не знаю чему :-)

p.s. с jpeg'ом тоже разобрался... стандартно... но размер exe сразу за 250 кб перевалил..
volvo
Цитата
прогресс бар не хотит работать... не знаю чему :-)

Хочешь - вот проект полностью - у меня все работает (Delphi 2007 + WinXP SP2), компилируй, запускай (только свою картинку проставь, у меня уж очень большая, чтоб ее вывешивать)...
Snake_B
Цитата(volvo @ 8.05.2008 8:17) *

Хочешь - вот проект полностью - у меня все работает (Delphi 2007 + WinXP SP2), компилируй, запускай (только свою картинку проставь, у меня уж очень большая, чтоб ее вывешивать)...


тоже ни чего... странно...

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

оно то работает, то программа закрывается.. не могу толком разобратся...
ну или как изменить размеры формы..
volvo
Цитата
тоже ни чего... странно...
Что значит "Ничего"? Программа запустилась? Окно отрисовала? Картинку вывела? На кнопку нажал? Что произошло? Закрылось? Сразу, или с задержкой? Версия Windows и Delphi какая?

Это все я должен спрашивать, или ты мог сам догадаться рассказать? Невозможно локализовать ошибку, когда ты молчишь, как партизан: "не работает и все"... Ну, не работает, значит делай, чтоб работало... Программа в конце концов нужна тебе... У меня все отрабатывает.

Цитата
оно то работает, то программа закрывается.. не могу толком разобратся...
Что "ОНО"? Это я тоже должен догадаться, как ты реализовал, и что у тебя там происходит?
Snake_B
Цитата(volvo @ 8.05.2008 9:22) *

Что значит "Ничего"? Программа запустилась? Окно отрисовала? Картинку вывела? На кнопку нажал? Что произошло? Закрылось? Сразу, или с задержкой? Версия Windows и Delphi какая?

Это все я должен спрашивать, или ты мог сам догадаться рассказать? Невозможно локализовать ошибку, когда ты молчишь, как партизан: "не работает и все"... Ну, не работает, значит делай, чтоб работало... Программа в конце концов нужна тебе... У меня все отрабатывает.

Что "ОНО"? Это я тоже должен догадаться, как ты реализовал, и что у тебя там происходит?


действительно... :-[
1. Окно отрисовало, картинка есть, кнопку нажал..
окно закрылось, с задержкой... но прогресс бар не отрисовало....
всё остальное есть, его нету... визуально...

delphi 2005 + win xp sp2

2. После первой формы надо создать вторую (это я сделал),
а первую надо удалить, делаю "destroywindow(handleWindow);"
программа закрывается полостью.
Добавлял форму вторую, вроде работало, уничтажалась первая,
программа работала дальше... потом вынес создание форм в процедуры
закрывается при уничтожении любой из форм (и первой и второй)...

может исходник положить?
andriano
А ты уверен что тебе нужно их именно уничтожать?
Скрыть (сделать, что б не рисовались) недостаточно?
Snake_B
Цитата(andriano @ 8.05.2008 15:10) *

А ты уверен что тебе нужно их именно уничтожать?
Скрыть (сделать, что б не рисовались) недостаточно?


Да в принципе лучше всего использовать одно, только менять его размеры...
function SetWindowPos(Wnd, WndInsertAfter: HWnd; X, Y, cx, cy:
может быть так... только у меня не получается :-)
volvo
Цитата
окно закрылось, с задержкой... но прогресс бар не отрисовало....
Хочешь, я присоединю исходник, проверишь его, больше ничего сказать не могу, проверял на 4-х машинах, везде все в порядке...

Цитата
может быть так... только у меня не получается
Вот так - получается:
SetWindowPos(handleWnd, 0, 0, 0, 700, 600, SWP_NOMOVE or SWP_NOZORDER);
Snake_B
Цитата(volvo @ 8.05.2008 19:08) *

Хочешь, я присоединю исходник, проверишь его, больше ничего сказать не могу, проверял на 4-х машинах, везде все в порядке...

Вот так - получается:
SetWindowPos(handleWnd, 0, 0, 0, 700, 600, SWP_NOMOVE or SWP_NOZORDER);



Спасибо...
А по прогресс бару... ну и ладно... без него сделаю.. не критично...
В основном пока всё... но мне кажется будет ещё пару тройку вопросов по позже :-)
andriano
Цитата(Snake_B @ 8.05.2008 15:47) *

А по прогресс бару... ну и ладно... без него сделаю.. не критично...
Вообще-то все, что нужно, можно сделать ручками.
Что-то мне не понравилось в стандартной прогрессбар, сделал свою.
Snake_B
Цитата(andriano @ 9.05.2008 3:32) *

Вообще-то все, что нужно, можно сделать ручками.
Что-то мне не понравилось в стандартной прогрессбар, сделал свою.


не знаю... чего то не сильно получается... можно все файлы выложить? как в "TESTFNT2.exe"...
а то у меня подозрение... что и этот не работает... или у меня руки кривые...
и к Вольво тоже вопросик... пример с progressbar... exe-шник можно выложить?
ну или на мыло...

это по прогресс бару...
и новый вопросик.. есть у меня там ListBox...
indexLB:= SendMessage(ListB1, LB_GETCURSEL, 0, 0);

вот так достаю номер выделенной строки... а как мне достать содержание этой строки?
volvo
Цитата
а как мне достать содержание этой строки?


var
ListB1: HWND;
i, len: integer;
buffer: string;

...

len := SendMessage(ListB1, LB_GETTEXTLEN, i, 0); // i - номер строки
SetLength(Buffer, len); // достаточное место для хранения данных
SendMessage(ListB1, LB_GETTEXT, i, integer(PChar(Buffer))); // получаем данные
...


Вот EXE-шник: Нажмите для просмотра прикрепленного файла
(только там теперь по нажатию на кнопку отрабатывает ProgressBar и размер формы меняется, закрывать форму придется "крестиком")...
Snake_B
Цитата(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'а скрывается основная форма... а это не нужно...
можно это исправить?
volvo
Цитата
После показа 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;

Snake_B
Цитата(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"
чего не так?
volvo
У меня вот так прекрасно отработало:

// Внимание на типы!!! 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... Как записывали в ресурс, так надо и извлекать...)
Snake_B
Цитата(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 (~),
то появляется ошибка...
что посоветуете? :-)
volvo
Вообще-то когда работаешь с 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;
Snake_B
Новый вопросик... и мне кажется он где-то близко к 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...
Snake_B
Цитата(Snake_B @ 24.05.2008 19:53) *

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

...

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


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

и прогрессбар заработал... винду не переустанавливал... вообще вроде ни чего такого с компом не делал...
good.gif
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.