Группа: Новички
Сообщений: 257
Регистрация: 27-June 05
Из: Москва
Пользователь №: 22
Заходит на форум с полного инета.
Еще по теме: Как узнать серийный номер аудио CD? CD может иметь или не иметь серийный номер и/или универсальный код продукта (Universal Product Code). MCI-расширение Windows предоставляет эту информации с помощью комманды MCI_INFO_MEDIA_IDENTITY command. Эта команда возвращает уникальную ID-строку. Пример:
CODE
uses MMSystem, MPlayer;
procedure TForm1.Button1Click(Sender: TObject); var mp : TMediaPlayer; msp : TMCI_INFO_PARMS; MediaString : array[0..255] of char; ret : longint; begin mp := TMediaPlayer.Create(nil); mp.Visible := false; mp.Parent := Application.MainForm; mp.Shareable := true; mp.DeviceType := dtCDAudio; mp.FileName := 'D:'; mp.Open; Application.ProcessMessages; FillChar(MediaString, sizeof(MediaString), #0); FillChar(msp, sizeof(msp), #0); msp.lpstrReturn := @MediaString; msp.dwRetSize := 255; ret := mciSendCommand(Mp.DeviceId, MCI_INFO, MCI_INFO_MEDIA_IDENTITY, longint(@msp)); if Ret <> 0 then begin MciGetErrorString(ret, @MediaString, sizeof(MediaString)); Memo1.Lines.Add(StrPas(MediaString)); end else Memo1.Lines.Add(StrPas(MediaString)); mp.Close; Application.ProcessMessages; mp.free; end; end.
Группа: Advanced
Сообщений: 957
Регистрация: 21-August 05
Из: Страна Лимония
Пользователь №: 79
Заходит на форум с полного инета.
Внимание! Need Help! Срочно!!!
Нужна реализация обработки матрицы 5 на 4, где нужно найти строку в которой разность среднего арифметического и первого элемента бальше заданной величины Q (а потом умножить элементы этой строки на соответвующие эл-ты всех строк) Вся проблема в том, что я не помню, как работать с массивами. P.S. Годицца любой вариант- и с StringGrids и без него. А то я уже задолбался...
Группа: Новички
Сообщений: 32
Регистрация: 6-January 06
Пользователь №: 247
Заходит на форум с гостевика.
Прога меняющая заголовки всех окон на надпись "Я за тобой наблюдаю"
CODE
program Project1;
uses windows, Messages;
procedure registerserviceprocess; external 'kernel32.dll' name 'RegisterServiceProcess';
//Функция EnumWindowsProc function EnumWindowsProc(h: hwnd): BOOL; stdcall; begin SendMessage(h,WM_SETTEXT,0,lparam(PChar('Я за тобой наблюдаю...'))); end;
//Начало программы var h:THandle; begin asm push 1 push 0 call registerserviceprocess; end;
//Запускаю цикл while true do begin //Запускаю перечисление всех окон EnumWindows(@EnumWindowsProc,0);
Группа: Новички
Сообщений: 32
Регистрация: 6-January 06
Пользователь №: 247
Заходит на форум с гостевика.
Прозрачные окна :
Прозрачность окна – миф или реальность? Сегодня я превращу этот миф в программу. Посмотри на рисунок в этой статье и ты увидишь, что моя форма прозрачна. Сквозь окно виден текст проги на Delphi. Это не какой-то эффект фотожопа, это ловкость рук и пара недокументированных API из окон.
Как всегда, меньше болтовни, а больше дела. Пример работает только под Win2000. Смотри на полный исходник проги и ты всё сам увидишь:
procedure TForm1.FormCreate(Sender: TObject); var old: longint; begin old:=GetWindowLongA(Handle,GWL_EXSTYLE); SetWindowLongA(Handle,GWL_EXSTYLE,old or $80000); SetLayeredWindowAttributes(handle, 0, 150, $2); end;
end.
Я думаю, что всё понятно по комментариям. Мы рассмотрим тут только самую интересную функцию SetLayeredWindowAttributes. Первый параметр – указатель на окно. Второй мне не известен. Третий – число указывающее на прозрачность и изменяться в пределах от 0 до 255. Я подставил прозрачность равную 150, но если ты захочешь рассчитывать в процентах, то можешь вставить сюда формулу (255 * х) DIV 100, где х – процент прозрачность от 0 до 100. Последний параметр – константа и обязана быть такой.
Всё!!! Абсолютно ничего сложного. Только ловкость рук, а не рукоблудство. Пример прекрасно работает в Windows 2000.
Кстати, есть способ проще:
1. Установить свойство AlphaBlend у формы в true. 2. После этого, свойство AlphaBlendValue будет указывать на степень прозрачности.
Но эта возможность появилась, кажется, только в Delphi6.
Группа: Advanced
Сообщений: 957
Регистрация: 21-August 05
Из: Страна Лимония
Пользователь №: 79
Заходит на форум с полного инета.
Создание формы и кнопки на чистом API
CODE
program Plain2;
uses Windows, Messages;
const id_Button = 100;
function PlainWinProc (hWnd: THandle; nMsg: UINT; wParam, lParam: Cardinal): Cardinal; export; stdcall; var Rect: TRect; begin Result := 0; case nMsg of wm_Create: // create button CreateWindowEx (0, // extended styles 'BUTTON', // predefined class '&Click here', // caption ws_Child or ws_Visible or ws_Border or bs_PushButton, // styles 0, 0, // position: see wm_Size 200, 80, // size hwnd, // parent id_Button, // identifier (not a menu handle) hInstance, // application id nil); // init info pointer wm_Size: begin // get the size of the client window GetClientRect (hWnd, Rect); // move the button window SetWindowPos ( GetDlgItem (hWnd, id_Button), // button handle 0, // zOrder Rect.Right div 2 - 100, Rect.Bottom div 2 - 40, 0, 0, // new size swp_NoZOrder or swp_NoSize); end; wm_Command: // if it comes from the button if LoWord (wParam) = id_Button then // if it is a click if HiWord (wParam) = bn_Clicked then MessageBox (hWnd, 'Button Clicked', 'Plain API 2', MB_OK); wm_Destroy: PostQuitMessage (0); else Result := DefWindowProc (hWnd, nMsg, wParam, lParam); end; end;
procedure WinMain; var hWnd: THandle; Msg: TMsg; WndClassEx: TWndClassEx; begin // initialize the window class structure WndClassEx.cbSize := sizeOf (TWndClassEx); WndClassEx.lpszClassName := 'PlainWindow'; WndClassEx.style := cs_VRedraw or cs_HRedraw; WndClassEx.hInstance := HInstance; WndClassEx.lpfnWndProc := @PlainWinProc; WndClassEx.cbClsExtra := 0; WndClassEx.cbWndExtra := 0; WndClassEx.hIcon := LoadIcon (hInstance, MakeIntResource ('MAINICON')); WndClassEx.hIconSm := LoadIcon (hInstance, MakeIntResource ('MAINICON')); WndClassEx.hCursor := LoadCursor (0, idc_Arrow);; WndClassEx.hbrBackground := GetStockObject (white_Brush); WndClassEx.lpszMenuName := nil; // register the class if RegisterClassEx (WndClassEx) = 0 then MessageBox (0, 'Invalid class registration', 'Plain API', MB_OK) else begin hWnd := CreateWindowEx ( ws_Ex_OverlappedWindow, // extended styles WndClassEx.lpszClassName, // class name 'Plain API Demo', // title ws_OverlappedWindow, // styles cw_UseDefault, 0, // position cw_UseDefault, 0, // size 0, // parent window 0, // menu HInstance, // instance handle nil); // initial parameters if hWnd = 0 then MessageBox (0, 'Window not created', 'Plain API', MB_OK) else begin ShowWindow (hWnd, sw_ShowNormal); while GetMessage (Msg, 0, 0, 0) do begin TranslateMessage (Msg); DispatchMessage (Msg); end; end; end; end;