| |
 Смотрите также
|
Как затенить кнопку [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;
|
|
главная