| Код |
program BLACK_KOT;
uses
Messages,
Windows,mmsystem;
{$R 1.res} {$R music.res}
var
W, Button1,edit1,label1,label2,CheckBox1: HWND;
WCl: TWndClass;
Msg: TMsg;
function LoadBitmapFromBMPFile(szFileName: LPTSTR;
var phBitmap: HBITMAP): BOOL;
begin
phBitmap := LoadImage(0, szFileName, IMAGE_BITMAP, 0, 0,
LR_CREATEDIBSECTION or LR_DEFAULTSIZE or LR_LOADFROMFILE);
if phBitmap = 0 then
begin
Result := False;
beep(100,100);
end
else
Result := True;
end;
//--------------------------обработка сообщений для CheckBox1
function chbProc(hWnd: HWND; Msg: UINT;wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
begin
case Msg of
WM_LBUTTONDOWN:
begin
end;
end;
Result := CallWindowProc(Pointer(GetWindowLong(hWnd, GWL_USERDATA)),hWnd, Msg, wParam, lParam);
end;
//--------------------------обработка сообщений для edit1
function EditProc(hWnd: HWND; Msg: UINT;wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
begin
case Msg of
WM_LBUTTONDOWN:
begin
end;
end;
Result := CallWindowProc(Pointer(GetWindowLong(hWnd, GWL_USERDATA)),hWnd, Msg, wParam, lParam);
end;
//--------------обработка сообщений для кнопки
function Button1Proc(hWnd: HWND; Msg: UINT;wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
begin
case msg of
WM_LBUTTONUP: PostQuitMessage(0);
end;
Result := CallWindowProc(Pointer(GetWindowLong(hWnd, GWL_USERDATA)),hWnd, Msg, wParam, lParam);
end;
procedure timer;
var
PMyMid: pointer;
HMyMid: THandle;
begin
HMyMid := FindResource(hInstance, 'rcdata_0',RT_RCDATA);
HMyMid := LoadResource(hInstance, HMyMid);
PMyMid := LockResource(HMyMid);
sndPlaySound(PMyMid, snd_Memory or SND_ASYNC);
UnlockResource(HMyMid);
FreeResource(HMyMid);
end;
//--------------------главный обработчик сообщений
function WndProc(hnd, wmsg, wparam, lparam: integer): integer; stdcall;
var h:hdc;
hNewBitmap: HBITMAP;
hMemDC: HDC;
bm: BITMAP;
begin
Result:=0;
case wmsg of
WM_CREATE:
begin
label1:=CreateWindowEx(WS_EX_DLGMODALFRAME,'STATIC','BLACK_KOT''s program', WS_VISIBLE or WS_CHILD,0,0,192,22,hnd, 0, hInstance, nil);
label2:=CreateWindowEx(0 ,'STATIC',' Введите анаграмму',WS_VISIBLE or WS_CHILD,3,25,75,35, hnd, 0, hInstance, nil);
Button1:=CreateWindowEx(BS_RIGHTBUTTON, 'BUTTON', 'X', WS_TABSTOP or WS_VISIBLE or WS_CHILD, 194, 1, 21, 21, hnd, 0, hInstance, nil);
SetWindowLong(Button1, GWL_USERDATA,SetWindowLong(Button1, GWL_WNDPROC, LongInt(@Button1Proc)));
Edit1 := CreateWindowEx(0, 'Edit', '',ws_BORDER or WS_CHILD or WS_VISIBLE or ES_LEFT or ES_AUTOhSCROLL,85,30,125,20, hnd, 0, HInstance, nil);
SetWindowLong(Edit1, GWL_USERDATA,SetWindowLong(Edit1, GWL_WNDPROC, LongInt(@EditProc)));
CheckBox1:= CreateWindowEx(0, 'Button', 'checkbox',WS_CHILD or WS_VISIBLE or BS_AUTOCHECKBOX,25,70,90,14, hnd, 0, HInstance, nil);
SetWindowLong(CheckBox1, GWL_USERDATA,SetWindowLong(CheckBox1, GWL_WNDPROC, LongInt(@chbProc)));
timer;
setTimer(hnd,100,7450,nil); // TIMER !!
if LoadBitmapFromBMPFile('C:\1.bmp', hNewBitmap) then
begin
GetObject(hNewBitmap, sizeof(BITMAP), @bm);
hMemDC := CreateCompatibleDC(0);
SelectObject(hMemDC, hNewBitmap);
h:=GetDC(hnd);
//beep(958,100);
BitBlt( h, 0, 0, bm.bmWidth, bm.bmHeight,hMemDC, 0, 0, SRCCOPY);
DeleteObject(hNewBitmap);
end;
end;
WM_TIMER: timer;
WM_LBUTTONDOWN: SendMessage(W,WM_SYSCOMMAND,$F012, 0); //таскаем форму
WM_CTLCOLOREDIT:
begin
{ Устанавливаем цвет шрифта }
SetTextColor(wParam,$0000ff);
end;
WM_DESTROY: PostQuitMessage(0);
else Result:=DefWindowProc(hnd, wmsg, wparam, lparam);
end;
end;
Procedure CreateMySelf;
begin
with WCl do
begin
lpszClassName:='cln';
lpfnWndProc:=@WndProc;
hCursor:=LoadCursor(hInstance, IDC_ARROW);
hbrBackground:=COLOR_3DSHADOW;
end;
RegisterClass(WCl);
W:=CreateWindowEx(WS_EX_TOPMOST, 'cln', 'BLACK_KOT''s program', WS_VISIBLE or WS_POPUPWINDOW, 200, 200, 218, 230, 0, 0, hInstance, nil);
SetFocus(edit1);
end;
begin
CreateMySelf;
while GetMessage(Msg, 0, 0, 0) do
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end.
|
|