Выборочный FAQ по некоторым интересным вопросам.
- Каким образом можно узнать какая нажата кнопка на клавиатуре (мыши) вне зависимости от того, какое приложение в данный момент активно?
- Как мне получить путь к запущенной программе из нее самой?
- Как в Delphi определить, где установлена Windows?
- Каким образом можно убрать приложение из Task Bar?
- Каким образом можно убрать приложение из Task List? (Только для Win'9x)
- Каким образом можно спрятать приложение от показа при нажатии Alt+Tab?
- Как можно сделать форму прозрачной?
- Как сделать произвольную (непрямоугольную) форму?
- Как создать файлы с уникальными именами?
- Как программно переключать раскладку клавиатуры?
- Как сделать невидимой главную форму?
- Как запустить создание письма по указанному адресу?
- Как запустить браузер по http-адресу?
- Как рисовать прямо на экране?
- Как увеличить в RichEdit размер редактируемого файла?
- В каком порядке происходят события при создании и показе окна?
- Если приложение долго выполняет какой-то цикл, как сделать так, чтобы остальные приложения не подвисали?
- Как перекодировать строки из Win(1251) кодовой страницы в Dos(866) кодовую страницу и обратно?
- Как использовать анимированные курсоры в программе?
- Как сделать так, чтобы по Alt-F4 форма не закрывалась, а выдавала запрос на сохранение?
- Как выключить/включить PC Speaker?
- Как скопировать файл?
- Как инсталлировать на время работы программы свои шрифты?
- Как узнать текущее разрешение экрана?
- Как встроить некий ресурс, например, графику в исполняемый модуль?
- Как программно создать ярлык?
- Как быстро выводить графику? (А то Canvas очень медленно работает)
- Как перетаскивать форму не только за Caption, но и за любое другое место?
- Как лучше сделать, если необходимо запустить внешний процесс и подождать, пока он отработает?
var Windir : String;
WindirP : PChar;
. . . . .
nt(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;
........................................................
........................................................
Procedure DrawOnScreen;
Var DC:HDC;
DesktopCanvas:TCanvas;
begin
DC:=GetDC(0); // получили DC экрана
try
DesktopCanvas:=TCanvas.Create;
DesktopCanvas.Handle:=DC;
..................
// здесь рисуем на Canvas экрана
..................
finally
ReleaseDC(0,DC);
DesktopCanvas.Free;
end;
end;
........................................................
Пример формы, использующей анимированный курсор:
........................................................
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;
... ..... ...... ....... ....... ...... ..
Выключить: SyStemParametersInfo(SPI_SETBEEP,0,nil,SPIF_UPDATEINIFILE); Включить: SyStemParametersInfo(SPI_SETBEEP,1,nil,SPIF_UPDATEINIFILE);
........................................................
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 - полный путь к файлу со шрифтом.
........................................................ 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; ........................................................
=== 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;
........................................................
Вот пример заполнения формами точками случайного цвета.
........................................................
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;
........................................................
........................................................
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;
........................................................
procedure TForm1.Button1Click(Sender: TObject);
var si:STARTUPINFO;
pi:PROCESS_INFORMATION;
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;