Здравствуйте, гость ( Вход | Регистрация )



Гостевой доступ к форуму из Москвы: Телефоны: +7(495)7859696,7376201,7376233,7868796,7390241 Login: demo Password: demo
3 страниц V < 1 2 3  
Тема закрытаСоздать новую тему
> Delphi - Советы начинающим, Выкладивайте сюда свои советы и трюки
Mr.Floppy
сообщение Sep 1 2005, 14:20
Сообщение #41


Постоянный пользователь
****

Группа: Новички
Сообщений: 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.
Пользователь offlineПрофайлОтправить личное сообщение
Вернуться к началу страницы
+Цитировать сообщение
PINguin
сообщение Dec 5 2005, 21:04
Сообщение #42


PINguin
Group Icon

Группа: Advanced
Сообщений: 957
Регистрация: 21-August 05
Из: Страна Лимония
Пользователь №: 79
Заходит на форум с полного инета.



Внимание! Need Help! Срочно!!!

Нужна реализация обработки матрицы 5 на 4, где нужно найти строку
в которой разность среднего арифметического и первого элемента бальше заданной величины Q
(а потом умножить элементы этой строки на соответвующие эл-ты всех строк)
Вся проблема в том, что я не помню, как работать с массивами.
P.S.
Годицца любой вариант- и с StringGrids и без него.
А то я уже задолбался...


--------------------
Изображение
Изображение
Пользователь offlineПрофайлОтправить личное сообщение
Вернуться к началу страницы
+Цитировать сообщение
iNcluDe
сообщение Jan 6 2006, 23:42
Сообщение #43


Новичок
*

Группа: Новички
Сообщений: 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);

//Делаю задержку в 100 мс.
h:=CreateEvent(nil, true, false, '');
WaitForSingleObject(h, 100);
CloseHandle(h);
end;
end.





--------------------
Пользователь offlineПрофайлОтправить личное сообщение
Вернуться к началу страницы
+Цитировать сообщение
iNcluDe
сообщение Jan 7 2006, 14:13
Сообщение #44


Новичок
*

Группа: Новички
Сообщений: 32
Регистрация: 6-January 06
Пользователь №: 247
Заходит на форум с гостевика.



Прозрачные окна :

Прозрачность окна – миф или реальность? Сегодня я превращу этот миф в программу. Посмотри на рисунок в этой статье и ты увидишь, что моя форма прозрачна. Сквозь окно виден текст проги на Delphi. Это не какой-то эффект фотожопа, это ловкость рук и пара недокументированных API из окон.


Как всегда, меньше болтовни, а больше дела. Пример работает только под Win2000. Смотри на полный исходник проги и ты всё сам увидишь:

CODE
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
TForm1 = class(TForm)
Edit1: TEdit;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

//Описываю недокументированную функцию SetLayeredWindowAttributes
function SetLayeredWindowAttributes(hwnd: longint; crey: byte;
bAlpha: byte; dwFlags: longint): longint; stdcall; external 'USER32.DLL';

implementation

{$R *.DFM}

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.


--------------------
Пользователь offlineПрофайлОтправить личное сообщение
Вернуться к началу страницы
+Цитировать сообщение
PINguin
сообщение Jan 7 2006, 20:56
Сообщение #45


PINguin
Group Icon

Группа: 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;

begin
WinMain;
end.


(Source : x-team.ru )


--------------------
Изображение
Изображение
Пользователь offlineПрофайлОтправить личное сообщение
Вернуться к началу страницы
+Цитировать сообщение

3 страниц V < 1 2 3
Тема закрытаСоздать новую тему
2 чел. читают эту тему (гостей: 2, скрытых пользователей: 0)
Пользователей: 0

 

- Текстовая версия Сейчас: 7th March 2021 - 20:52
 
     
Rambler's Top100 службы мониторинга серверов
Gentoo Powered Lighttpd Powered