Ковыряюсь во всяких справочниках... чего то ни фига не получается... Если кто может подскажите, как сделать или где поглядеть пример...
1. CreateWindow ( 'STATIC', text', WS_CHILD or WS_VISIBLE, 30, 8, 500, 80, handleWnd, 0, hInstance, nil ); * как задать ему цвет * сделать вертикальный скролл * изменить шрифт (размер, цвет и сам шрифт)
2. Загрузить и показать рисунок (bmp и jpg)...
3. Изменить цвет border color...
4. обработка нажатия кнопки...
лучше всего пример...
andriano
6.05.2008 10:47
Если ты указал один из стандартных классов, то цвет можно изменить только в обработчике WM_PAINT. Если же ты сам регистрируешь класс окна, то там и можешь задать нужную кисть для фона. Вполне естественно, что все окна одного класса выводятся одним цветом.
Вертикальный скролл - добавить WS_VSCROLL в стиль окна.
Для того, чтобы писать каким-либо шрифтом, надо создать нужный фонт. Другие способы мне не известны, хотя, возможно, они и есть.
Рисунок проще всего размесить в том же WM_PAINT.
По нажатию кнопки приходит сообщение WM_COMMAND, в параметре WP которого номер нажатой кнопки. Как хочешь, так и обрабатываешь.
Основной источник справки для меня файл Win32.hlp, поставляемый обычно с виндовыми компиляторами. Более подробную информацию можно получить в MSDN.
А можно всё таки как-нибудь на примере? Теоретически как бы всё понятно (до того как вопрос задал, догадывался), а на практике сделать не получается...
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
6.05.2008 17:03
Идея не самая удачная - учиться на том, что в принципе не разрешено: MSDN: Static Control Styles - как видишь, ничего связанного с прокруткой STATIC напрямую не поддерживает. Пользуйся лучше EDIT-ом...
Snake_B
6.05.2008 19:15
Цитата(volvo @ 6.05.2008 22:03)
Идея не самая удачная - учиться на том, что в принципе не разрешено: MSDN: Static Control Styles - как видишь, ничего связанного с прокруткой STATIC напрямую не поддерживает. Пользуйся лучше EDIT-ом...
а в edit'е можно сделать перенос строк? и как... ну и с остальными так и не разобрался... :-[
volvo
6.05.2008 20:12
Цитата
а в 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;
// ... и 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 );
while GetMessage (Msg, 0, 0, 0) do begin TranslateMessage (Msg); DispatchMessage (Msg); end; end.
Посмотри, что я изменил, и что из этого получилось... А потом посмотрим, что делать дальше...
Snake_B
7.05.2008 21:14
Цитата(volvo @ 7.05.2008 1:12)
Легко... Но давай начнем с того, что тебе надо подкорректировать всю программу: ... Посмотри, что я изменил, и что из этого получилось... А потом посмотрим, что делать дальше...
// 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;
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 );
... 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; ...
Ну всё также, загрузка/показ рисунка... ни где так примера и не нашел...
Вот тебе пример:
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, достаточно написать ничего не делающую оконную функцию:
... 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; ...
Всё вроде понятно... но вот прогресс бар не хотит работать... не знаю чему :-)
p.s. с jpeg'ом тоже разобрался... стандартно... но размер exe сразу за 250 кб перевалил..
volvo
8.05.2008 3:17
Цитата
прогресс бар не хотит работать... не знаю чему :-)
Хочешь - вот проект полностью - у меня все работает (Delphi 2007 + WinXP SP2), компилируй, запускай (только свою картинку проставь, у меня уж очень большая, чтоб ее вывешивать)...
Snake_B
8.05.2008 4:05
Цитата(volvo @ 8.05.2008 8:17)
Хочешь - вот проект полностью - у меня все работает (Delphi 2007 + WinXP SP2), компилируй, запускай (только свою картинку проставь, у меня уж очень большая, чтоб ее вывешивать)...
тоже ни чего... странно...
и ещё вопросик... как правильно с формами работать.. т.е. создаю форму, надо удалить и создать другую...
оно то работает, то программа закрывается.. не могу толком разобратся... ну или как изменить размеры формы..
volvo
8.05.2008 4:22
Цитата
тоже ни чего... странно...
Что значит "Ничего"? Программа запустилась? Окно отрисовала? Картинку вывела? На кнопку нажал? Что произошло? Закрылось? Сразу, или с задержкой? Версия Windows и Delphi какая?
Это все я должен спрашивать, или ты мог сам догадаться рассказать? Невозможно локализовать ошибку, когда ты молчишь, как партизан: "не работает и все"... Ну, не работает, значит делай, чтоб работало... Программа в конце концов нужна тебе... У меня все отрабатывает.
Цитата
оно то работает, то программа закрывается.. не могу толком разобратся...
Что "ОНО"? Это я тоже должен догадаться, как ты реализовал, и что у тебя там происходит?
Snake_B
8.05.2008 4:31
Цитата(volvo @ 8.05.2008 9:22)
Что значит "Ничего"? Программа запустилась? Окно отрисовала? Картинку вывела? На кнопку нажал? Что произошло? Закрылось? Сразу, или с задержкой? Версия Windows и Delphi какая?
Это все я должен спрашивать, или ты мог сам догадаться рассказать? Невозможно локализовать ошибку, когда ты молчишь, как партизан: "не работает и все"... Ну, не работает, значит делай, чтоб работало... Программа в конце концов нужна тебе... У меня все отрабатывает.
Что "ОНО"? Это я тоже должен догадаться, как ты реализовал, и что у тебя там происходит?
действительно... :-[ 1. Окно отрисовало, картинка есть, кнопку нажал.. окно закрылось, с задержкой... но прогресс бар не отрисовало.... всё остальное есть, его нету... визуально...
delphi 2005 + win xp sp2
2. После первой формы надо создать вторую (это я сделал), а первую надо удалить, делаю "destroywindow(handleWindow);" программа закрывается полостью. Добавлял форму вторую, вроде работало, уничтажалась первая, программа работала дальше... потом вынес создание форм в процедуры закрывается при уничтожении любой из форм (и первой и второй)...
может исходник положить?
andriano
8.05.2008 10:10
А ты уверен что тебе нужно их именно уничтожать? Скрыть (сделать, что б не рисовались) недостаточно?
Snake_B
8.05.2008 12:52
Цитата(andriano @ 8.05.2008 15:10)
А ты уверен что тебе нужно их именно уничтожать? Скрыть (сделать, что б не рисовались) недостаточно?
Да в принципе лучше всего использовать одно, только менять его размеры... function SetWindowPos(Wnd, WndInsertAfter: HWnd; X, Y, cx, cy: может быть так... только у меня не получается :-)
volvo
8.05.2008 14:08
Цитата
окно закрылось, с задержкой... но прогресс бар не отрисовало....
Хочешь, я присоединю исходник, проверишь его, больше ничего сказать не могу, проверял на 4-х машинах, везде все в порядке...
Цитата
может быть так... только у меня не получается
Вот так - получается:
SetWindowPos(handleWnd, 0, 0, 0, 700, 600, SWP_NOMOVE or SWP_NOZORDER);
Snake_B
8.05.2008 18:47
Цитата(volvo @ 8.05.2008 19:08)
Хочешь, я присоединю исходник, проверишь его, больше ничего сказать не могу, проверял на 4-х машинах, везде все в порядке...
Вот так - получается:
SetWindowPos(handleWnd, 0, 0, 0, 700, 600, SWP_NOMOVE or SWP_NOZORDER);
Спасибо... А по прогресс бару... ну и ладно... без него сделаю.. не критично... В основном пока всё... но мне кажется будет ещё пару тройку вопросов по позже :-)
andriano
8.05.2008 22:32
Цитата(Snake_B @ 8.05.2008 15:47)
А по прогресс бару... ну и ладно... без него сделаю.. не критично...
Вообще-то все, что нужно, можно сделать ручками. Что-то мне не понравилось в стандартной прогрессбар, сделал свою.
Snake_B
12.05.2008 2:55
Цитата(andriano @ 9.05.2008 3:32)
Вообще-то все, что нужно, можно сделать ручками. Что-то мне не понравилось в стандартной прогрессбар, сделал свою.
не знаю... чего то не сильно получается... можно все файлы выложить? как в "TESTFNT2.exe"... а то у меня подозрение... что и этот не работает... или у меня руки кривые... и к Вольво тоже вопросик... пример с progressbar... exe-шник можно выложить? ну или на мыло...
это по прогресс бару... и новый вопросик.. есть у меня там ListBox...
вот так достаю номер выделенной строки... а как мне достать содержание этой строки?
volvo
12.05.2008 3:11
Цитата
а как мне достать содержание этой строки?
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
12.05.2008 4:48
Цитата(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
12.05.2008 12:54
Цитата
После показа messageBox'а скрывается основная форма... а это не нужно...
Естественно... Окно получает сообщение 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
12.05.2008 15:31
Цитата(volvo @ 12.05.2008 17:54)
Естественно... Окно получает сообщение 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;
p.s. вот тут файлик прикрепляю... так создаю и извлекаю.. всё тоже: "Resourse 1 not found" чего не так?
volvo
16.05.2008 16:28
У меня вот так прекрасно отработало:
// Внимание на типы!!! 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
17.05.2008 1:57
Цитата(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
17.05.2008 2:41
Вообще-то когда работаешь с 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
24.05.2008 14:53
Новый вопросик... и мне кажется он где-то близко к 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;