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

Вот исходничек простенького клавиатурника можете делать с ним что хотите, главное не зазнавайтесь! К основным его преемуществам могу отнести то что он очень мал для проги такого класса (19кб), что кстати ломает убеждение о грамоздкости Делфи прог, и занимает мало места в оперативке (обычно 1-1,5мб)!
Программа абсолютно безопастная и предназдначенна только для изучения! 🙂
(more…)

Наверно все читали мою статью про упаковку файлов с помощью библиотеки ZLib в Delphi. В ней написано, как можно архивировать файлы почти с той же степенью сжатия, как и ZIP. Но я описал, как можно архивировать только единичные файлы. По многочисленным заявкам читателей я пишу ещё одну статью про архивирование целых папок.
Для того, что бы архивировать папку, давайте сначала научимся склеивать все файлы, находящиеся в некоторой папке. Давайте сначала разберёмся с форматом этого склеенного файла, а будут он примерно таким

Первые четыре байта будет составлять сигнатура, которая будет обозначать, что это файл нашего формата
Следующие четыре байта будут обозначать количество файлов в этом склеенном файле
Потом будет идти массив структур, который будет описывать все файлы в этом склеенном файле, каждая структура будет иметь вот такой формат
(more…)

например, Grid / DbGrid (далее Matrix) нужно заполнить значениями из Table..
затем :

with Printer do

begin

if Printing then exit;

PrinterIndex:= -1;

BeginDoc;

Onprint:= true;

Matrix.Color:= clWhite; // экономим чернила

Matrix.Repaint;

zoom:= PageWidth / (2*Matrix.Width);

zoom2:= PageHeight / (2*Matrix.Height);

if zoom2 на полстраницы

with canvas do

begin

Font.Size:= 14;

Font.Name:= 'Courier New';

TextOut((PageWidth-Textwidth(str)) div 2, 12, str);

StretchBlt(Handle, (PageWidth - wdt) div 2, 25+TextHeight(str), Wdt, Hgt,

Matrix.Canvas.handle, 0, 0, Matrix.Width, Matrix.Height-5, SrcCopy);

end;

EndDoc;

Onprint:= false;

Matrix.Color:= $00AABBCC;

Matrix.Repaint;

if aborted then MessageDlg('Печать была прервана!', mtInformation, [mbOK],0);

end;

Для начала маленький код для определения нажатия клавиши 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…)