 |
|
========================================================================
Дайджест по конференции RU.DELPHI (редакция от 26-06-99)
========================================================================
############################################################################
# #
# Я не претендую на авторские права тех людей, чьи материалы включены #
# в этот дайджест. Здесь не yказаны их копирайты, но так полyчилось лишь #
# потому что первоначально этот дайджест составлялся лично для себя. #
# Так что претензий по авторским правам не принимаю. Я лишь имею права #
# на эти материалы как составитель. #
# #
# С уважением... -= Ник - [FAQ TeAm] =- #
# #
# По всем вопросам: 2:5064/12.1@fidonet.org или nikbyte@mail.ru #
# Также принимаются различные дополнения и пожелания. #
# (Ненадо мне писать письма с вопросами - я не справочное бюро) #
############################################################################
*** СОДЕРЖАНИЕ ***
Часть 1:
--------
1. Каким образом можно узнать какая нажата кнопка на клавиатуре
(мыши) вне зависимости от того, какое приложение в данный момент
активно?
2. Как мне получить путь к запущенной программе из нее самой?
3. Как в Delphi определить, где установлена Windows?
4. Каким образом можно убрать приложение из Task Bar?
5. Каким образом можно убрать приложение из Task List?
6. Каким образом можно спрятать приложение от показа при нажатии Alt+Tab?
7. Как сделать произвольную (непрямоугольную) форму?
8. Как создать файлы с уникальными именами?
9. Как программно переключать раскладку клавиатуры?
10.Как сделать невидимой главную форму?
11.Как запустить создание письма по указанному адресу?
Как запустить браузер по http-адресу?
12.Как рисовать прямо на экране (рабочем столе)?
13.Как увеличить в RichEdit размер редактируемого файла?
14.В каком порядке происходят события при создании и показе окна?
15.Если приложение долго выполняет какой-то цикл, как сделать так, чтобы
остальные приложения не подвисали?
16.Как выключить/включить звуковое оповещение Windows (через PC Speaker)?
Часть 2:
--------
1. Как перекодировать строки из Win(1251) кодовой страницы в Dos(866) кодовую
страницу и обратно?
2. Как использовать анимированные курсоры в программе?
3. Как сделать так, чтобы по Alt-F4 форма не закрывалась, а выдавала запрос
на сохранение?
4. Как скопировать файл?
5. Как инсталлировать на время работы программы свои шрифты?
6. Как узнать текущее разрешение экрана?
7. Есть программа на Delphi, котоpая отображает какой-то html. В html исполь-
зуется gif-файл. Как в Delphi-пpоекте указать, чтобы этот gif находился
в exe как некий кусок кода. А когда надо будет, записать его обратно в
gif-файл без изменений, выковырнув из exe?
8. Как программно создать ярлык?
9. Как перетаскивать форму не только за Caption, но и за любое другое место?
Часть 3:
--------
1. Как в TMemo определить номер строки, в которой находится курсор и его
местоположение в строке?
2. Как быстро выводить графику? (А то Canvas очень медленно работает).
3. Как лучше сделать, если необходимо запустить внешний процесс и подождать,
пока он отработает?
4. Как сохранить содержимое экрана в файл?
5. Как пеpемещать фоpму за Label?
6. Как определить, есть ли в системе Wave-устройство?
7. Как определить из под какой операционной системы запущена программа?
------------------------------------------------------------------------------
> Каким образом можно узнать какая нажата кнопка на клавиатуре
> (мыши) вне зависимости от того, какое приложение в данный момент
> активно?
GetAsyncKeyState. И для клавиатуpы, и для мыши.
------------------------------------------------------------------------------
> Как мне получить путь к запущенной программе из нее самой?
Application.EXEName;
------------------------------------------------------------------------------
> Как в Delphi определить, где установлена Windows?
GetWindowsDirectory
Пример:
var Windir : String;
WindirP : PChar;
................................................
WinDirP := StrAlloc(MAX_PATH);
Res := GetWindowsDirectory(WinDirP, MAX_PATH);
if Res > 0 then WinDir := StrPas(WinDirP);
................................................
------------------------------------------------------------------------------
> Каким образом можно убрать приложение из Task Bar?
ShowWindow(Application.Handle,SW_HIDE);
------------------------------------------------------------------------------
> Каким образом можно убрать приложение из Task List? (Только для Win'9x)
Пример:
unit hideprg;
interface
procedure TryToHide;
implementation
procedure RegisterServiceProcess; external 'kernel32.dll' name
'RegisterServiceProcess';
procedure TryToHide;assembler;
asm
push 1
push 0
call RegisterServiceProcess;
end;
------------------------------------------------------------------------------
> Каким образом можно спрятать приложение от показа при нажатии Alt+Tab?
Пример (работает только в Win'95):
var WnHnd : Integer;
........................................................
WnHnd := GetWindowLong(Application.Handle, GWL_EXSTYLE);
WnHnd := WnHnd or WS_EX_TOOLWINDOW;
SetWindowLong(Application.Handle, GWL_EXSTYLE, WnHnd);
........................................................
------------------------------------------------------------------------------
> Как сделать произвольную (непрямоугольную) форму?
Win32 (Windows'95 or Windows NT 4.0 or above).
Достаточно создать регион нужной формы и вызвать SetWindowRgn -
HRGN rgn := CreateEllipticRgn( 10,10,100,100 );
SetWindowRgn( hMyWnd,rgn ); // Вот и будет круглое окно
При этом регион этот теперь используется Windows и будет уничтожен при
закрытии окна.
Вот, например:
........................................................
procedure TForm1.FormCreate(Sender: TObject);
const W=36*pi/180;
var R,R1,R2: HRgn; X,Y,i:integer;
function S(a:integer;R:integer):integer;
begin
Result:=round(R*sin(W*a));
end;
function C(a:integer;R:integer):integer;
begin
Result:=round(R*cos(W*a));
end;
function GetStarReg(X,Y,R:integer):HRGN;
var P : array [0..4] of TPoint;
begin
P[0] := Point(X, Y-R);
P[1] := Point(X-S(4,R), Y-C(4,R));
P[2] := Point(X-S(8,R), Y-C(8,R));
P[3] := Point(X-S(2,R), Y-C(2,R));
P[4] := Point(X-S(6,R), Y-C(6,R));
Result := CreatePolygonRgn(P, 5, WINDING);
end;
begin
X:=Width div 2;
Y:=Height div 2;
R:=GetStarReg(X,Y,100);
i:=1;
repeat
R1:=GetStarReg(X-S(i,120),Y-C(i,110),40);
CombineRgn(R,R,R1,RGN_OR);
inc(i,2);
until i>9;
R1:=GetStarReg(X,Y,30);
CombineRgn(R,R,R1,RGN_DIFF);
R1:=CreateEllipticRgn(3,3,Width-6,Height-6);
R2:=CreateEllipticRgn(20,10,Width-20,Height-10);
CombineRgn(R1,R1,R2,RGN_DIFF);
CombineRgn(R,R,R1,RGN_OR);
SetWindowRgn(Handle, R, True);
end;
........................................................
------------------------------------------------------------------------------
> Как создать файлы с уникальными именами?
Здесь удобнее всего использовать имя, состоящее из даты и времени, напри-
мер: 2310566160798 для 23:10:56 16-07-98. Если перевести это число в 32-чную
систему счисления, получим искомые восемь символов имени файла. Это хорошо
использовать, если программа создает много файлов, которые потом будут ис-
пользоваться. Если же нужно создать несколько временных файлов, то лучше
воспользоваться фyнкцией GetTempFileName.
------------------------------------------------------------------------------
> Как программно переключать раскладку клавиатуры?
LoadKeyboardLayout('00000409', KLF_ACTIVATE); // английский
LoadKeyboardLayout('00000419', KLF_ACTIVATE); // русский
------------------------------------------------------------------------------
> Как сделать невидимой главную форму?
Написать Application.ShowMainForm:=false в файле пpоекта.
------------------------------------------------------------------------------
> Как запустить создание письма по указанному адресу?
> Как запустить браузер по http-адресу?
Сначала необходимо написать в разделе uses ShellAPI.
E-mail:
ShellExecute(Application.Handle,'open','mailto:towho@mysite.com',nil,nil,0);
Страничку:
ShellExecute(Application.Handle,'open','http://mysite.com,nil,nil,0);
------------------------------------------------------------------------------
> Как рисовать прямо на экране (рабочем столе)?
........................................................
Procedure DrawOnScreen;
Var DC:HDC;
DesktopCanvas:TCanvas;
begin
DC:=GetDC(0); // получили DC экрана
// (или DC:=GetDC(GetDesktopWindow) для рабочего стола)
try
DesktopCanvas:=TCanvas.Create;
DesktopCanvas.Handle:=DC;
..................
// здесь рисуем на Canvas экрана
..................
finally
ReleaseDC(0,DC);
DesktopCanvas.Free;
end;
end;
........................................................
------------------------------------------------------------------------------
> Как увеличить в RichEdit размер редактируемого файла?
RichEdit1.Perform(EM_LIMITTEXT, нужный размер , 0);
Перед каждым открытием файла это действие необходимо повторять.
------------------------------------------------------------------------------
> В каком порядке происходят события при создании и показе окна?
OnCreate, OnShow, OnPaint, OnActivate, OnResize и снова OnPaint.
------------------------------------------------------------------------------
> Если приложение долго выполняет какой-то цикл, как сделать так, чтобы
> остальные приложения не подвисали?
1. Вставить в тело цикла: Application.ProcessMessages
2. Запустить этот цикл как отдельный процесс, используя класс TThread.
------------------------------------------------------------------------------
> Как выключить/включить звуковое оповещение Windows (через PC Speaker)?
Выключить:
SyStemParametersInfo(SPI_SETBEEP,0,nil,SPIF_UPDATEINIFILE);
Включить:
SyStemParametersInfo(SPI_SETBEEP,1,nil,SPIF_UPDATEINIFILE);
------------------------------------------------------------------------------
> Как перекодировать строки из Win(1251) кодовой страницы в Dos(866) кодовую
> страницу и обратно?
CharToOEM/OEMToChar и CharToOEMBuff/OEMToCharBuff.
Например в Memo можно сделать так:
........................................................
var N: PChar;
...
Memo1.Lines.LoadFromFile('dos.txt');
N := Memo1.Lines.GetText;
OemToAnsi(N, N);
Memo1.Lines.Text := StrPas(N);
........................................................
------------------------------------------------------------------------------
> Как использовать анимированные курсоры в программе?
Пример формы, использующей анимированный курсор:
........................................................
procedure TForm1.Button1Click(Sender: TObject);
var
h : THandle;
begin
h := LoadImage(0,'C:\TheWall\Magic.ani',
IMAGE_CURSOR, 0, 0,
LR_DEFAULTSIZE or LR_LOADFROMFILE);
if h = 0 then ShowMessage('Cursor not loaded')
else
begin
Screen.Cursors[1] := h;
Form1.Cursor := 1;
end;
end;
........................................................
------------------------------------------------------------------------------
> Как сделать так, чтобы по Alt-F4 форма не закрывалась, а выдавала запрос
> на сохранение?
Обрабатывать событие OnCloseQuery
------------------------------------------------------------------------------
> Как скопировать файл?
Эта процедура позволяет скопиpовать как весь файл пpи From и Count = 0,
так и пpоизвольный его кусок.
........................................................
function CopyFile( InFile,OutFile: String; From,Count: Longint ): Longint;
var
InFS,OutFS: TFileStream;
begin
InFS := TFileStream.Create( InFile, fmOpenRead );
OutFS := TFileStream.Create( OutFile, fmCreate );
InFS.Seek( From, soFromBeginning );
Result := OutFS.CopyFrom( InFS, Count );
InFS.Free;
OutFS.Free;
end;
........................................................
------------------------------------------------------------------------------
> Как инсталлировать на время работы программы свои шрифты?
Добавить фонт (.fon, .fot, .fnt, .ttf) в систему можно след. образом:
........................................................
{$IFDEF WIN32}
AddFontResource( PChar( my_font_PathName { AnsiString } ) );
{$ELSE}
var
ss : array [ 0..255 ] of Char;
AddFontResource ( StrPCopy ( ss, my_font_PathName ));
{$ENDIF}
SendMessage ( HWND_BROADCAST, WM_FONTCHANGE, 0, 0 );
........................................................
Убрать его по окончании работы:
........................................................
{$IFDEF WIN32}
RemoveFontResource ( PChar(my_font_PathName) );
{$ELSE}
RemoveFontResource ( StrPCopy ( ss, my_font_PathName ));
{$ENDIF}
SendMessage ( HWND_BROADCAST, WM_FONTCHANGE, 0, 0 );
........................................................
Где my_font_PathName - полный путь к файлу со шрифтом.
------------------------------------------------------------------------------
> Как узнать текущее разрешение экрана?
Screen.Width и Screen.Height
------------------------------------------------------------------------------
> Есть программа на Delphi, котоpая отображает какой-то html. В html исполь-
> зуется gif-файл. Как в Delphi-пpоекте указать, чтобы этот gif находился
> в exe как некий кусок кода. А когда надо будет, записать его обратно в
> gif-файл без изменений, выковырнув из exe?
Можно, используя RxLib. После его установки в меню View появится пунктик
Project Resources. Нужно выбрать Project Resources->New->User Data и добавить
нужный файл. В данном случае ресурс был назван "RCDATA_1".
Если RxLib нет, то нужно создать файл описания ресурсов:
=== Begin gifs.rc ===
mygif rcdata "имя_gif-файла.gif"
mygif1 rcdata "RCDATA_1"
=== End dots.rc ===
Потом скомпилировать его командой brcc32 gifs.rc и получить gifs.res
В начало модуля добавь строчку {$R gifs.res}
В своей программе необходимо написать:
var
rs : TResourceStream;
a : Pointer;
begin
rs:=TResourceStream.Create(hinstance,'RCDATA_1',RT_RCDATA);
try
GetMem(a,rs.size);
rs.Read(a^,rs.size); {Теперь a - динамический указатель на код}
{ Здесь делается все, что необходимо с кодом, используя указатель a }
FreeMem(a);
finally
rs.Free;
end;
end;
А можно и так, если необходимо записать ресурс в файл:
var
rs : TResourceStream;
fs : TFileStream;
begin
rs:=TResourceStream.Create(hInstance, 'mygif', RT_RCDATA);
fs:=TFileStream.Create('имя_gif-файла.gif', fmCreate);
try
fs.CopyFrom(rs, rs.Size);
finally
fs.Free;
rs.Free;
end;
end;
------------------------------------------------------------------------------
> Как программно создать ярлык?
........................................................
uses ShlObj, ComObj, ActiveX;
procedure CreateLink(const PathObj, PathLink, Desc, Param: string);
var
IObject: IUnknown;
SLink: IShellLink;
PFile: IPersistFile;
begin
IObject := CreateComObject(CLSID_ShellLink);
SLink := IObject as IShellLink;
PFile := IObject as IPersistFile;
with SLink do begin
SetArguments(PChar(Param));
SetDescription(PChar(Desc));
SetPath(PChar(PathObj));
end;
PFile.Save(PWChar(WideString(PathLink)), FALSE);
end;
........................................................
------------------------------------------------------------------------------
> Как перетаскивать форму не только за Caption, но и за любое другое место?
........................................................
TForm1 = class(TForm)
...
private
...
procedure WMNCHitTest(var M: TWMNCHitTest); message wm_NCHitTest;
...
end;
...
procedure TForm1.WMNCHitTest(var M: TWMNCHitTest);
begin
inherited; { вызов унаследованного обpаботчика }
if M.Result = htClient then { Мышь сидит на окне? }
M.Result := htCaption; { Если да - то пусть Windows думает, что }
{ мышь на caption bar }
end;
........................................................
------------------------------------------------------------------------------
> Как в TMemo определить номер строки, в которой находится курсор и его
> местоположение в строке?
........................................................
var X,Y: LongInt;
Y:=Memo1.Perform(EM_LINEFROMCHAR, Memo1.SelStart, 0);
X:=Memo1.Parform(EM_LINEINDEX, Y, 0);
inc(Y);
X:=Memo1.SelStart-X+1;
........................................................
------------------------------------------------------------------------------
> Как быстро выводить графику? (А то Canvas очень медленно работает).
Вот пример заполнения формами точками случайного цвета.
........................................................
type
TRGB=record
b,g,r:byte;
end;
ARGB=array [0..1] of TRGB;
PARGB=^ARGB;
var
b:TBitMap;
procedure TForm1.FormCreate(sender:TObject);
begin
b:=TBitMap.Create;
b.pixelformat:=pf24bit;
b.width:=Clientwidth;
b.height:=Clientheight;
end;
procedure TForm1.Tim1OnTimer(sender:TObject);
Var
p:PARGB;
x,y:integer;
begin
for y:=0 to b.height-1 do
begin
p:=b.scanline[y];
for x:=0 to b.width-1 do
begin
p[x].r:=random(256);
p[x].g:=random(256);
p[x].b:=random(256);
end;
end;
canvas.draw(0,0,b);
end;
procedure TForm1.FormDestroy(sender:TObject);
begin
b.free;
end;
........................................................
------------------------------------------------------------------------------
> Как лучше сделать, если необходимо запустить внешний процесс и подождать,
> пока он отработает?
........................................................
procedure TForm1.Button1Click(Sender: TObject);
var si:TStartupInfo;
pi:TProcessInformation;
cmdline:string;
begin
ZeroMemory(@si,sizeof(si));
si.cb:=SizeOf(si);
cmdline:='c:\command.com';
if not CreateProcess( nil, // No module name (use command line).
PChar(cmdline), // Command line.
nil, // Process handle not inheritable.
nil, // Thread handle not inheritable.
False, // Set handle inheritance to FALSE.
0, // No creation flags.
nil, // Use parent's environment block.
nil, // Use parent's starting directory.
si, // Pointer to STARTUPINFO structure.
pi ) // Pointer to PROCESS_INFORMATION structure.
then
begin
ShowMessage( 'CreateProcess failed.' );
Exit;
end;
WaitForSingleObject( pi.hProcess, INFINITE );
CloseHandle( pi.hProcess );
CloseHandle( pi.hThread );
ShowMessage('Done !');
end;
........................................................
------------------------------------------------------------------------------
> Как сохранить содержимое экрана в файл?
........................................................
procedure TForm1.Button1Click(Sender: TObject);
var
DC: HDC;
Canva: TCanvas;
B: TBitmap;
begin
Canva := TCanvas.Create;
B := TBitmap.Create;
DC := GetDC(0);
try
Canva.Handle := DC;
with Screen do begin
B.Width := Width;
B.Height := Height;
B.Canvas.CopyRect(Rect(0, 0, Width, Height), Canva,
Rect(0, 0, Width, Height));
B.SaveToFile('c:\screen.bmp');
end
finally
ReleaseDC(0, DC);
B.Free;
Canva.Free
end
end;
........................................................
------------------------------------------------------------------------------
> Как пеpемещать фоpму за Label?
........................................................................
procedure TForm1.Label1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
const SC_DragMove = $F012; { a magic number }
begin
ReleaseCapture;
Form1.perform(WM_SysCommand, SC_DragMove, 0);
end;
........................................................................
------------------------------------------------------------------------------
> Как определить, есть ли в системе Wave-устройство?
........................................................
uses MMSystem;
procedure TForm1.Button1Click(Sender: TObject);
begin
if WaveOutGetNumDevs > 0 then
ShowMessage('Sound Card is installed')
else
ShowMessage('Sound Card is not installed')
end;
........................................................
------------------------------------------------------------------------------
> Как определить из под какой операционной системы запущена программа?
........................................................
If (GetVersion() and $80000000)<>0 then
// ...'Windows 95/98'...
else
// ... 'Windows NT'...
end;
........................................................
------------------------------------------------------------------------------
© faqs.org.ru