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


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




20076 Апр

Стандартная печать содержимого компонента

например, 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;
20072 Мар

Управление клавиатурой

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

20072 Мар

Управление мышью

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

implementation

const
crMyCursor = 1;

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

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

20072 Мар

Управление CD приводом

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…)

20072 Мар

Управление монитором

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

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…)

20072 Мар

Windows

Надо узнать, где запрятана, на компьютере, эта глюченая, но родная система под названием 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…)

20072 Мар

Работа с реестром

Реестр очень нужная вещь! Им должен уметь пользоваться каждый. Сегодня я покажу маленький пример как сохранить некоторые параметры Вашей программы.
Первое что надо сделать это добавить в 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…)

20072 Мар

О ярлыках

Основа создания ярлыка является следующие:
В раздел 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…)

20072 Мар

Элементарная работа с файлами

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

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…)

20072 Мар

Панель задач. Пуск

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

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…)

← Предыдущая страницаСледующая страница →
Page 7 of 8« First...«45678»

Облако меток

AdSense клиент компонент api ClientSocket библиотеки dll ServerSocket приложение INTERFACE шифровка байт char работа пароль учеба programmer процессор Application HANDLE Cursor C++ AssignFile хуки win api Project Internet google FASM memo исходники html функция язык System поиск GetLastError алгоритм программист programmersclub сервер форум exe сайт файл проект Assembler шифрование windows delphi