"Вопросы по 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. обработка нажатия кнопки...
лучше всего пример...
Если ты указал один из стандартных классов, то цвет можно изменить только в обработчике WM_PAINT. Если же ты сам регистрируешь класс окна, то там и можешь задать нужную кисть для фона. Вполне естественно, что все окна одного класса выводятся одним цветом.
Вертикальный скролл - добавить WS_VSCROLL в стиль окна.
Для того, чтобы писать каким-либо шрифтом, надо создать нужный фонт. Другие способы мне не известны, хотя, возможно, они и есть.
Рисунок проще всего размесить в том же WM_PAINT.
По нажатию кнопки приходит сообщение WM_COMMAND, в параметре WP которого номер нажатой кнопки. Как хочешь, так и обрабатываешь.
Основной источник справки для меня файл Win32.hlp, поставляемый обычно с виндовыми компиляторами. Более подробную информацию можно получить в MSDN.
Еще есть интересная программка http://forum.sources.ru/index.php?showtopic=182219. Она, правда, в явно незаконченном виде, но кое-какие примеры с ее помощью можно посмотреть.
А можно всё таки как-нибудь на примере?
Теоретически как бы всё понятно (до того как вопрос задал, догадывался), а на практике сделать не получается...
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.
Идея не самая удачная - учиться на том, что в принципе не разрешено: http://msdn.microsoft.com/en-us/library/bb760773(VS.85).aspx - как видишь, ничего связанного с прокруткой STATIC напрямую не поддерживает. Пользуйся лучше 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.
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.
es_readonly- почти то что нужно, но меняется цвет, а нужен всё таки белый...
1.
// Создаем прогрессбар
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;
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);
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)));
// Создаем прогрессбар
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;
А ты уверен что тебе нужно их именно уничтожать?
Скрыть (сделать, что б не рисовались) недостаточно?
SetWindowPos(handleWnd, 0, 0, 0, 700, 600, SWP_NOMOVE or SWP_NOZORDER);
SetWindowPos(handleWnd, 0, 0, 0, 700, 600, SWP_NOMOVE or SWP_NOZORDER);
indexLB:= SendMessage(ListB1, LB_GETCURSEL, 0, 0);
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))); // получаем данные
...
WM_DESTROY: begin
if MessageBox(handleW1, 'Подтверждение...', 'хотите выйти ?',
MB_OkCancel+MB_IconAsterisk+mb_systemmodal)= idCancel then exit;
PostQuitMessage(0);
Result := 0;
end; // Ну, или закрыли крестиком или Alt+F4
WM_CLOSE:
begin
// если все-таки хочешь выйти, значит удалить-таки окно: DestroyWindow
if MessageBox(handleWnd, 'Подтверждение...', 'хотите выйти ?',
MB_OKCANCEL + MB_ICONASTERISK + MB_SYSTEMMODAL) = IDOK then DestroyWindow(handleWnd);
end;
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');
У меня вот так прекрасно отработало:
// Внимание на типы!!! ResType я сделал Integer-ом!!!(к вопросу, почему именно целочисленная 10, а не 'CUSTOM': При преобразовании этой 10 к типу PChar в процедуре получим как раз PChar(10), что соответствует RT_RCDATA... Как записывали в ресурс, так надо и извлекать...)
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');
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;
Вообще-то когда работаешь с 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;
Новый вопросик... и мне кажется он где-то близко к 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;