Блог программистов

Для начала маленький код для определения нажатия клавиши Print Screen:

  private

    procedure AppIdle(Sender: TObject; var Done: Boolean);

//…
procedure TForm1.AppIdle(Sender: TObject; var Done: Boolean);

begin

  if GetAsyncKeyState(VK_SNAPSHOT)  0 then

    Form1.Caption := 'PrintScreen!';

  Done := True;

end;
procedure TForm1.FormCreate(Sender: TObject);

begin

Application.OnIdle := AppIdle;

end;

А теперь программный аналог Print Screen’а:
(more…)

Все наверное хотят использовать свои курсоры. И большинству нужны не просто курсоры, а анимированные курсоры. Вот что надо сделать для загрузки курсора:

implementation

const
crMyCursor = 1;

procedure TForm1.FormCreate(Sender: TObject);
begin
// Это единственный способ загрузки который я знаю
Screen.Cursors[crMyCursor] := LoadCursorFromFile(‘C:\Курсор.ani’);
// Устанавливаем курсор на форму
Cursor := crMyCursor;
end;

Теперь перейдём к быстрой настройки мыши. Вот как можно поменять кнопки мыши между собой:
(more…)

CD приводом (далее просто CD) я думаю пользуются все без исключения. Давайте разберём как создать несложную программу открытия CD. Создадим новый проект. Кидаем на форму ComboBox и две Button. В разделе uses дописываем MMSystem. Создадим универсальную функцию. В Unit’е после {$R *.dfm} пишем:

function CD(Drive: PChar; OpenClose: Boolean): Boolean;
var
Res: MciError;
OpenParm: TMCI_Open_Parms;
Flags: DWord;
DeviceID: Word;
begin
Result := false;
Flags := mci_Open_Type or mci_Open_Element;
with OpenParm do
begin
dwCallback := 0;
lpstrDeviceType := ‘CDAudio’;
lpstrElementName := Drive;
end;
Res := mciSendCommand(0, MCI_OPEN, Flags, Longint(@OpenParm));
if Res <> 0 then exit;
DeviceID := OpenParm.wDeviceID;
try
if OpenClose=true then
Res := mciSendCommand(DeviceID, MCI_SET, MCI_SET_DOOR_OPEN, 0) else
Res := mciSendCommand(DeviceID, MCI_SET, MCI_SET_DOOR_CLOSED, 0);
if Res = 0 then exit;
Result := True;
finally
if OpenClose=true then
mciSendCommand(DeviceID, MCI_OPEN, Flags, Longint(@OpenParm)) else
mciSendCommand(DeviceID, MCI_CLOSE, Flags, Longint(@OpenParm));
end;
end;
В процедуре создания формы пишем:
(more…)

Для начала узнаем, с какой видеокартой мы работаем:

procedure TForm1.Button1Click(Sender: TObject);

var

  lpDisplayDevice: TDisplayDevice;

  dwFlags: DWORD;

  cc: DWORD;

begin

 Memo1.Clear;

  lpDisplayDevice.cb := sizeof(lpDisplayDevice);

  dwFlags := 0;

  cc := 0;

  while EnumDisplayDevices(nil, cc, lpDisplayDevice, dwFlags) do

 begin

    Inc(cc);

    Memo1.lines.add(lpDisplayDevice.DeviceString);

 end;

end;

Теперь разместим на форме ListBox и Button. В обработчике создания формы пишем:

procedure TForm1.FormCreate(Sender: TObject);

var

  i: Integer;

  DevMode: TDevMode;

begin

  i:=0;

  while EnumDisplaySettings(nil,i,DevMode) do

  begin

    with Devmode do

      ListBox1.Items.Add(Format('%dx%d %d Colors',

      [dmPelsWidth,dmPelsHeight,1 shl dmBitsperPel]));

    Inc(i);

  end;

end;

Вы увидите все возможные комбинации разрешений и цветов, которые поддерживает дисплей. Теперь пишем в нажатии на кнопку:
(more…)

Надо узнать, где запрятана, на компьютере, эта глюченая, но родная система под названием windows:

   Private

   Windir: string;

   WindirP: PChar;

   Res: Cardinal;

procedure TForm1.Button1Click(Sender: TObject);

begin

  WinDirP := StrAlloc(MAX_PATH);

  Res := GetWindowsDirectory(WinDirP, MAX_PATH);

  if Res > 0 then

    WinDir := StrPas(WinDirP);

  Caption := WinDir;

end;

Теперь надо выяснить, что за windows и dos перед нами. Думаю, пару label и одной button хватит:
(more…)

Реестр очень нужная вещь! Им должен уметь пользоваться каждый. Сегодня я покажу маленький пример как сохранить некоторые параметры Вашей программы.
Первое что надо сделать это добавить в uses модуль Registry
Затем написать две процедуры:

type

  TForm1 = class(TForm)

    procedure SaveProgParam;

    procedure LoadProgParam;

procedure TForm1.SaveProgParam;

var

 FIniFile: TRegIniFile;

Begin

// по умолчанию всё делается в HKEY_CURRENT_USER

 FIniFile := TRegIniFile.Create('Software');

 FIniFile.OpenKey('Папка_вашей_программы',true);

if Form1.WindowState=wsNormal then

  begin

   FIniFile.WriteInteger('Option', 'Width', Width);

// Write… - означает запись, …Integer – означает тип записываемой переменной

// Первый параметр 'Option' – это подраздел: 'Папка_вашей_программы\Option\'

// Второй параметр 'Width' – название ключа (файла в реестре)

// Третий – это переменная которую мы записываем

   FIniFile.WriteInteger('Option', 'Heigth', Height);

   FIniFile.WriteInteger('Option', 'Left', Left);

   FIniFile.WriteInteger('Option', 'Top', Top);

  end;

 FIniFile.WriteInteger('Option', 'WinState', Integer(WindowState));

 FIniFile.Free; //освобождаем переменную

end;

Здесь мы записали положение окна и развёрнуто ли оно. Далее мы пишем процедуру загрузки этих параметров:
(more…)

Основа создания ярлыка является следующие:
В раздел Uses необходимо добавить следующие модули ShlObj, ActiveX, ComObj, StdCtrls;
private
procedure CreateShotCut(SourceFile, ShortCutName, SourceParams: String);
public
{ Public declarations }
end;

implementation

procedure TForm1.CreateShotCut(SourceFile, ShortCutName, SourceParams: String);
var
IUnk: IUnknown;
ShellLink: IShellLink;
ShellFile: IPersistFile;
tmpShortCutName: string;
WideStr: WideString;
i: Integer;
begin
IUnk := CreateComObject(CLSID_ShellLink);
ShellLink := IUnk as IShellLink;
ShellFile := IUnk as IPersistFile;

ShellLink.SetPath(PChar(SourceFile));
ShellLink.SetArguments(PChar(SourceParams));
ShellLink.SetWorkingDirectory(PChar(ExtractFilePath(SourceFile)));

ShortCutName := ChangeFileExt(ShortCutName,’.lnk’);
if fileexists(ShortCutName) then
begin
ShortCutName := copy(ShortCutName,1,length(ShortCutName)-4);
i := 1;
repeat
tmpShortCutName := ShortCutName +'(‘ + inttostr(i)+ ‘).lnk’;
inc(i);
until not fileexists(tmpShortCutName);
WideStr := tmpShortCutName;
end
else
WideStr := ShortCutName;
ShellFile.Save(PWChar(WideStr),False);
end;

Например, для создания ярлыка в автозагрузки надо:
(more…)

Первое что я рассмотрю это копирование файлов:

procedure TForm1.Button1Click(Sender: TObject);

begin

CopyFile('Откуда\Имя файла','Куда\Новое имя файла',true)

// если файл с таким же именем уже есть то true - если заменять или false если оставить прошлую копию файла

end; 

Запись в файл:

program CrtApp;

var

 outfile: TextFile;

begin

AssignFile(outfile, 'c:\outfile.txt'); // связываем переменную с файла в который будем писать

Rewrite(outfile);

writeln(outfile, 'Привет МИР!'); // Запись в файл 'c:\outfile.txt' легендарного текста

CloseFile(outfile); // обязательно закрываем файл

end. 

Печать текста сразу на принтер:
(more…)

Начнём с общего. Как скрыть и показать Панель задач:

procedure TForm1.Button1Click(Sender: TObject);

begin

ShowWindow(FindWindow('Shell_TrayWnd', nil), SW_HIDE); // Скрыть

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

ShowWindow(FindWindow('Shell_TrayWnd', nil), SW_SHOW); // Показать

end;

Теперь сделаем иконку рядом с часами:
(more…)

Итак, Рабочий стол- это первое что мы видим после загрузки пользователя. Сначала я дам код, как изменить фоновый рисунок на Столе. Вот что надо написать:

implementation

Uses ShlObj, ComObj;
procedure ChangeWallpaper;

const

CLSID_ActiveDesktop: TGUID = '{75048700-EF1F-11D0-9888-006097DEACF9}';

var

ActiveDesktop: IActiveDesktop;

begin

ActiveDesktop := CreateComObject(CLSID_ActiveDesktop)

as IActiveDesktop;

ActiveDesktop.SetWallpaper('Путь к файлу', 0);

ActiveDesktop.ApplyChanges(AD_APPLY_ALL or AD_APPLY_FORCE);

end;

(more…)