Перейти на главную   
  helloworld.ru - документация и книги по программированию  
helloworld.ru - документация и книги по программированию
    главная     хостинг    
Поиск по сайту:  
Смотрите также
Языки программирования
C#
MS Visual C++
Borland C++
C++ Builder
Visual Basic
Quick Basic
Turbo Pascal
Delphi
JavaScript
Java
PHP
Perl
Assembler
AutoLisp
Fortran
Python
1C

Интернет-технологии
HTML
VRML
HTTP
CGI
FTP
Proxy
DNS
протоколы TCP/IP
Apache

Web-дизайн
HTML
Дизайн
VRML
PhotoShop
Cookie
CGI
SSI
CSS
ASP
PHP
Perl

Программирование игр
DirectDraw
DirectSound
Direct3D
OpenGL
3D-графика
Графика под DOS

Алгоритмы
Численные методы
Обработка данных

Сис. программирование
Драйверы

Базы данных
MySQL
SQL

Другое

Хостинг


Друзья
demaker.ru
Реклама

Лучший хостинг. Аренда серверов




helloworld.ru

Как затенить кнопку [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;










helloworld.ru © 2001-2021
Все права защищены