|
|
Как затенить кнопку [X] в заголовке формы.
Как скрыть TaskBar?
Как отключить показ кнопки программы в TaskBar?
Как вставить какую-нибудь программу внутрь EXE файла?
Как закрыть чужую программу?
Как отрубить показ файла в Ctrl-Alt-Del?
Как написать маленький инсталлятор?
Как из программы переключать языки?
Как разместить прозрачную надпись на TBitmap?
Как очистить содержимое Canvas?
Как извлечь Red, Green и Blue компонент из определенного цвета?
Как создать bitmap из пиктограммы (icon)?
Как рисовать на рамке формы?
Как определить, нажаты ли клавиши Shift, Alt или Ctrl?
Как поместить JPEG-картинку в exe-файл и потом загрузить ее?
Как поместить курсор в определенную позицию TEdit?
Как показать форму без передачи ей фокуса ввода?
Как уменьшить мерцание при перерисовке компонента?
Как эмулировать движение мыши?
Как зарегистрировать расширение файла?
Как затенить кнопку [X] в заголовке
формы. Следующий текст убирает команду
"Закрыть" из системного меню и одновременно делает серой
кнопку [X] в заголовке формы:procedure
TForm1.FormCreate(Sender: TObject); var
HMenuHandle:HMenu; begin HMenuHandle
:= GetSystemMenu(Handle, False); if
(HMenuHandle <> 0) then DeleteMenu(HMenuHandle,
SC_CLOSE, MF_BYCOMMAND); end;
Как скрыть TaskBar? procedure
TForm1.Button1Click(Sender: TObject); var
HTaskBar : THandle; begin HTaskBar :=
FindWindow('SHELL_TRAYWND', nil);
ShowWindow(HTaskBar, SW_HIDE); end;
procedure
TForm1.Button2Click(Sender: TObject); var
HTaskBar : THandle; begin HTaskBar :=
FindWindow('SHELL_TRAYWND', nil);
ShowWindow(HTaskBar, SW_SHOWNORMAL); end;
Как отключить показ кнопки программы в
TaskBar? Внеся
изменения (выделенные цветом) в свой проект вы получите
приложение, которое не видно в TaskBar.
program
Project1;
uses
Forms,
Windows,
Unit1 in 'Unit1.pas' {Form1};
{$R *.RES}
var ExtendedStyle :
integer;
begin Application.Initialize; ExtendedStyle:=GetWindowLong(Application.Handle,
GWL_EXSTYLE); SetWindowLong(Application.Handle,
GWL_EXSTYLE, ExtendedStyle
or
WS_EX_TOOLWINDOW); Application.CreateForm(TForm1,
Form1); Application.Run; end.
Как вставить какую-нибудь программу внутрь EXE
файла?
Пишем в блокноте RC-файл, куда
прописываем все нужные нам программы,
например:
ARJ EXEFILE
C:\UTIL\ARJ.EXE
Компилируем его в ресурс
при помощи Brcc32.exe. Получаем RES-файл. Далее в
тексте нашей программы:
implementation
{$R
*.DFM} {$R test.res} // Это
наш RES-файл
procedure
ExtractRes(ResType, ResName, ResNewName :
String); var Res :
TResourceStream; begin Res :=
TResourceStream.Create(Hinstance, Resname,
Pchar(ResType));
Res.SavetoFile(ResNewName);
Res.Free; end;
procedure
TForm1.BitBtn1Click(Sender: TObject); begin // Записывает в текущую папку
ARJ.EXE ExtractRes('EXEFILE', 'ARJ',
'ARJ.EXE'); end;
Как закрыть чужую
программу?
SendMessage(FindWindow(nil,
'заголовок окна'), WM_CLOSE,
0, 0);
Заголовок окна, например, у Вашей формы -
это Form1.Caption.
Как отрубить показ файла в
Ctrl-Alt-Del?
function
RegisterServiceProcess(dwProcessID, dwType: Integer):
Integer;
stdcall;
external 'KERNEL32.DLL';
implementation
procedure TForm1.Button1Click(Sender:
TObject); begin
//Hide if not (csDesigning in
ComponentState) then
RegisterServiceProcess(GetCurrentProcessID,
1); end;
procedure TForm1.Button2Click(Sender:
TObject); begin //Show if not
(csDesigning in ComponentState)
then
RegisterServiceProcess(GetCurrentProcessID, 0); end;
Как написать
маленький инсталлятор?
Главное
приложение само выполняет функции инсталлятора.
Первоначально файл называется Setup.exe. При запуске под
этим именем приложение устанавливает себя, после
установки программа переименовывает себя и перестает
быть
инсталлятором.
Application.Initialize;
if
UpperCase(ExtractFileName(Application.ExeName))='SETUP.EXE'
then
Application.CreateForm(TSetupForm, SetupForm) // форма
инсталлятора else
Application.CreateForm(TMainForm, MainForm); // форма основной
программы
Application.Run;
Как из программы
переключать языки?
Здесь переключатели
на русский и на английский.
procedure SetRU;
var Layout: array[0.. KL_NAMELENGTH] of
char; begin LoadKeyboardLayout(
StrCopy(Layout,'00000419'),KLF_ACTIVATE); end;
procedure
SetEN; var Layout: array[0..
KL_NAMELENGTH] of char; begin
LoadKeyboardLayout(StrCopy(Layout,'00000409'),KLF_ACTIVATE); end;
Как разместить
прозрачную надпись на
TBitmap?
procedure
TForm1.Button1Click(Sender: TObject); var
OldBkMode : Integer; begin
Image1.Picture.Bitmap.Canvas.Font.Color :=
clBlue; OldBkMode :=
SetBkMode(Image1.Picture.Bitmap.Canvas.Handle,TRANSPARENT);
Image1.Picture.Bitmap.Canvas.TextOut(10, 10, 'Hi
everybody');
SetBkMode(Image1.Picture.Bitmap.Canvas.Handle,OldBkMode); end;
Как очистить
содержимое Canvas?
Нарисовать
прямоугольник любого цвета.
Canvas.Brush.Color :=
ClWhite; Canvas.FillRect(Canvas.ClipRect);
Как извлечь Red,
Green и Blue компонент из определенного
цвета?
Используйте функции Window API
Get RValue(), GetGValue() и
GetBValue().
procedure
TForm1.Button1Click(Sender: TObject); begin
Form1.Canvas.Pen.Color :=
clRed; Memo1.Lines.Add('Red := '
+IntToStr(GetRValue(Form1.Canvas.Pen.Color)));
Memo1.Lines.Add('Green := ' +
IntToStr(GetGValue(Form1.Canvas.Pen.Color)));
Memo1.Lines.Add('Blue:= ' +
IntToStr(GetBValue(Form1.Canvas.Pen.Color))); end;
Как создать bitmap
из пиктограммы (icon)?
Используя
Bitmap.Canvas.Draw нарисовать пиктограмму на
Bitmap.
procedure TForm1.Button1Click(Sender:
TObject); var TheIcon : TIcon;
TheBitmap : TBitmap; begin TheIcon :=
TIcon.Create;
TheIcon.LoadFromFile('C:\Program
Files\Borland\MyIcons\MYICO1.ICO'); TheBitmap
:= TBitmap.Create; TheBitmap.Height :=
TheIcon.Height; TheBitmap.Width :=
TheIcon.Width; TheBitmap.Canvas.Draw(0, 0,
TheIcon); Form1.Canvas.Draw(10, 10,
TheBitmap); TheBitmap.Free;
TheIcon.Free; end;
Как рисовать на
рамке формы?
Для этого надо обработать
событие WM_NCPAINT. Ниже приводится код программы, в
которой рамка формы обводится красной линией толщиной в
1 пиксел.
type TForm1 =
class(TForm)
private
{Private
declarations} procedure
WMNCPaint(var Msg : TWMNCPaint); message
WM_NCPAINT; public
{Public
declarations} end;
var
Form1: TForm1;
implementation
{$R
*.DFM}
procedure TForm1.WMNCPaint(var Msg:
TWMNCPaint); var dc : hDc; Pen :
hPen; OldPen : hPen; OldBrush :
hBrush; begin inherited; dc :=
GetWindowDC(Handle); msg.Result := 1;
Pen := CreatePen(PS_SOLID, 1, RGB(255, 0,
0)); OldPen := SelectObject(dc,
Pen); OldBrush := SelectObject(dc,
GetStockObject(NULL_BRUSH)); Rectangle(dc,
0,0, Form1.Width, Form1.Height);
SelectObject(dc, OldBrush); SelectObject(dc,
OldPen); DeleteObject(Pen);
ReleaseDC(Handle, Canvas.Handle); end;
Как определить,
нажаты ли клавиши Shift, Alt или
Ctrl?
В приведенном примере показано,
как определить, нажата ли клавиша Shift при выборе
строчки меню. Пример также содержит функции проверки
состояния клавиш Alt, Ctrl.
function CtrlDown :
Boolean; var State :
TKeyboardState; begin
GetKeyboardState(State); Result :=
((State[vk_Control] And 128) <>
0); end;
function ShiftDown :
Boolean; var State :
TKeyboardState; begin
GetKeyboardState(State); Result :=
((State[vk_Shift] and 128) <>
0); end;
function AltDown :
Boolean; var State :
TKeyboardState; begin GetKeyboardState(State); Result
:= ((State[vk_Menu] and 128) <>
0); end;
procedure
TForm1.MenuItem12Click(Sender: TObject); begin
if ShiftDown then Form1.Caption := 'Shift'
else Form1.Caption := ''; end;
Как поместить
JPEG-картинку в exe-файл и потом загрузить
ее?
1) Создайте текстовый файл с
расширением ".rc". Имя этого файла должно отличаться от
имени файла-пректа или любого модуля проекта. Файл
должен содержать строку вроде: MYJPEG JPEG
C:\DownLoad\MY.JPG где: "MYJPEG" - имя ресурса, "JPEG" - пользовательский тип
ресурса, "C:\DownLoad\MY.JPG"
- путь к JPEG-файлу. Пусть, например, rc-файл называется
"foo.rc". Запустите BRCC32.EXE (Borland Resource
CommandLine Compiler) - программа находится в каталоге
Bin Delphi/C++ Builder'а - передав ей в качестве
параметра полный путь к rc-файлу. В нашем примере: C:\DelphiPath\BIN\BRCC32.EXE
C:\ProjectPath\FOO.RC Вы получите
откомпилированный ресурс - файл с расширением ".res". (в
нашем случает foo.res). Далее добавьте ресурс к своему
приложению.
{Грузим
ресурс} {$R
FOO.RES} uses Jpeg;
procedure
LoadJPEGFromRes(TheJPEG : string; ThePicture :
TPicture); var ResHandle :
THandle; MemHandle : THandle;
MemStream : TMemoryStream; ResPtr :
PByte; ResSize : Longint; JPEGImage
: TJPEGImage; begin ResHandle :=
FindResource(hInstance, PChar(TheJPEG),
'JPEG'); MemHandle := LoadResource(hInstance,
ResHandle); ResPtr :=
LockResource(MemHandle); MemStream :=
TMemoryStream.Create; JPEGImage :=
TJPEGImage.Create; ResSize :=
SizeOfResource(hInstance,
ResHandle); MemStream.SetSize(ResSize);
MemStream.Write(ResPtr^, ResSize);
FreeResource(MemHandle); MemStream.Seek(0,
0);
JPEGImage.LoadFromStream(MemStream);
ThePicture.Assign(JPEGImage);
JPEGImage.Free;
MemStream.Free; end;
procedure
TForm1.Button1Click(Sender: TObject);
begin LoadJPEGFromRes('MYJPEG',
Image1.Picture); end;
Как поместить
курсор в определенную позицию
TEdit?
Можно использовать методы
Delphi SelStart() и SelectLength().
procedure
TForm1.Button1Click(Sender:
TObject); begin Edit1.SetFocus; {переводим курсор во вторую
позицию} Edit1.SelStart := 2; {не выделяем никакого
текста} Edit1.SelLength := 0; end;
Как показать форму
без передачи ей фокуса ввода?
uses
Unit2;
procedure TForm1.Button1Click(Sender:
TObject); begin Form2 :=
TForm2.Create(Application); Form2.Visible :=
FALSE; ShowWindow(Form2.Handle,
SW_SHOWNA); end;
Как уменьшить
мерцание при перерисовке
компонента?
Если добавить флаг csOpaque (непрозрачный) к свойству
ControlStyle компонента - то фон компонента
перерисовываться не будет.
constructor
TMyControl.Create; begin
inherited; ControlStyle := ControlStyle +
[csOpaque]; end;
Как эмулировать
движение мыши?
В примере мышка слегка
"подталкивается" без участия
пользователя.
procedure
TForm1.Button1Click(Sender: TObject); var
pt : TPoint; begin
Application.ProcessMessages; Screen.Cursor :=
CrHourglass; GetCursorPos(pt);
SetCursorPos(pt.x + 1, pt.y + 1);
Application.ProcessMessages; SetCursorPos(pt.x
- 1, pt.y - 1); end;
Как
зарегистрировать расширение файла за своим приложением и
контекстное меню, связанное с этим
типом?
Пример регистрирует расширение
файла(.myext) - файлы этого
типа будут открываться приложением MyApp.Exe. Также регистрируется
одно действие (action) по умолчанию для файлов этого
типа и два дополнительных пункта контекстного меню,
связанного с этим типом файлов. Возможно, потребуется
перезайти в систему, чтобы изменения вступили в
силу.
uses Registry; ... procedure
TForm1.Button1Click(Sender: TObject); var R
: TRegIniFile; begin R :=
TRegIniFile.Create(''); with R
do
begin
RootKey :=
HKEY_CLASSES_ROOT;
WriteString('.myext','','MyExt'); WriteString('MyExt','','Some
description of MyExt
files');
WriteString('MyExt\DefaultIcon','','C:\MyApp.Exe,0');
WriteString('MyExt\Shell','','This_Is_Our_Default_Action');
WriteString('MyExt\Shell\First_Action', '','This is our
first
action');
WriteString('MyExt\Shell\First_Action\command','',
'C:\MyApp.Exe /LotsOfParamaters
%1');
WriteString('MyExt\Shell\This_Is_Our_Default_Action','',
'This is our default
action');
WriteString('MyExt\Shell\This_Is_Our_Default_Action\command','',
'C:\MyApp.Exe
%1');
WriteString('MyExt\Shell\Second_Action','', 'This
is our second
action');
WriteString('MyExt\Shell\Second_Action\command','',
'C:\MyApp.Exe /TonsOfParameters
%1');
Free;
end; end;
|