500+ FAQ по Delphi

Перейти на: Главную | Индексную | Предыдущую | Следующую страницу
предлагаем ремонт шлагбаумов came с гарантией

Как при проигрывании музыки с Audio CD показывать сколько прошло минут и секунд?

В примере время выводится по таймеру.

Пример:
uses MMSystem;

procedure TForm1.Timer1Timer(Sender: TObject);
var
Trk : Word;
Min : Word;
Sec : Word;
begin
with MediaPlayer1 do
begin
Trk := MCI_TMSF_TRACK(Position);
Min := MCI_TMSF_MINUTE(Position);
Sec := MCI_TMSF_SECOND(Position);
Label1.Caption := Format('%.2d',[Trk]);
Label2.Caption := Format('%.2d:%.2d',[Min,Sec]);
end;
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;

Как выполнить какой-то процесс тогда, когда пользователь не работает с моим приложением?

Создайте процедуру, которая будет вызываться при событии Application.OnIdle.

Обьявим процедуру:
{Private declarations}
procedure IdleEventHandler(Sender: TObject; var Done: Boolean);

В разделе implementation опишем поцедуру:

procedure TForm1.IdleEventHandler(Sender: TObject; var Done: Boolean);
begin
{Do a small bit of work here}
Done := false;
end;

В методе Form'ы OnCreate - укажем что наша процедура вызывается на событии
Application.OnIdle.

Application.OnIdle := IdleEventHandler;

Событие OnIdle возникает один раз - когда приложение переходит в режим "безделья" (idle). Если в обработчике переменной Done присвоить False событие будет вызываться вновь и вновь, до тех пор пока приложение "бездельничает" и переменной Done не присвоенно значение True.

Как разместить маленькие картинки в компоненте TPopUpMenu?

В приведенном примере показано как это сделать с использованием функции Windows API SetMenuItemBitmaps(). Эта функция получает handle popup menu, позицию строчки меню куда будет помещена картинка, и два дескриптора(handles) на две картинки (одна из них - картинка которая будет показана когда строка меню доступна, вторая - когда строка меню недоступна).
type
TForm1 = class(TForm)
PopupMenu1: TPopupMenu;
Pop11: TMenuItem;
Pop21: TMenuItem;
Pop31: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
{Private declarations}
bmUnChecked : TBitmap;
bmChecked : TBitmap;
public
{Public declarations}
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
bmUnChecked := TBitmap.Create;
bmUnChecked.LoadFromFile('C:\Program Files\Borland\BitBtns\ALARMRNG.BMP');
bmChecked := TBitmap.Create;
bmChecked.LoadFromFile('C:\Program Files\Borland\BitBtns\CHECK.BMP');
{Add the bitmaps to the item at index 1 in PopUpMenu}
SetMenuItemBitmaps(PopUpMenu1.Handle,1,MF_BYPOSITION,BmUnChecked.Handle,
BmChecked.Handle);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
bmUnChecked.Free;
bmChecked.Free;
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
pt : TPoint;
begin
pt := ClientToScreen(Point(x, y));
PopUpMenu1.Popup(pt.x, pt.y);
end;

Как узнать число кадров AVI файла, и выяснить как долго будет проигрывться этот файл?

В приведенном примере указано как получить эту информацию.

procedure TForm1.Button1Click(Sender: TObject);
begin
MediaPlayer1.TimeFormat := tfFrames;
ShowMessage('Number of frames = ' + IntToStr(MediaPlayer1.Length));
MediaPlayer1.TimeFormat := tfMilliseconds;
ShowMessage('Number of milliseconds = ' + IntToStr(MediaPlayer1.Length));
end;

Как изменить число фиксированных колонок в TDbGrid?


Пример:

procedure TForm1.Button1Click(Sender: TObject);
begin
TStringGrid(DbGrid1).FixedCols := 2;
end;

Некоторые компоненты баз данных (и среди них TDBGrid) никак не меняют визуальных свойств, когда к ним отключен доступ (disabled). Как это изменить програмно?

Ниже приведен пример, меняющий цвет шрифта на clGray, когда доступ к элементу управления (в данном случае TDBGrid) запрещен (disabled).
procedure TForm1.Button1Click(Sender: TObject);
begin
DbGrid1.Enabled := false;
DbGrid1.Font.Color := clGray;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
DbGrid1.Enabled := true;
DbGrid1.Font.Color := clBlack;
end;

Как определить нажаты ли клавиши Shift, Alt, or 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;

Как изменить шрифт hint'а?

В примере перехватывается событие Application.OnShowHint и изменяется шрифт Hint'а.

type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
{Private declarations}
public
procedure MyShowHint(var HintStr: string;
var CanShow: Boolean;var HintInfo: THintInfo);
{Public declarations}
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.MyShowHint(var HintStr: string; var CanShow: Boolean;
var HintInfo: THintInfo);
var
i : integer;
begin
for i := 0 to Application.ComponentCount - 1 do
if Application.Components[i] is THintWindow then
with THintWindow(Application.Components[i]).Canvas do
begin
Font.Name:= 'Arial';
Font.Size:= 18;
Font.Style:= [fsBold];
HintInfo.HintColor:= clWhite;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Application.OnShowHint := MyShowHint;
end;

Есть ли в Delphi эквивалент функции SendKeys Visual Basic'а?

Ниже приведена процедура, позволяющаю отправлять нажатия в любой элемент управления (window control), способный принимать ввод с клавиатуры. Вы можете использовать эту технику чтобы включать клавиши NumLock, CapsLock и ScrollLock под Windows NT. Та же техника работает и под Windows 95 для CapsLock и ScrollLock но не работает для клавиши NumLock.
Обратите внимание, что приведены четыре поцедуры: SimulateKeyDown() - эмулировать нажатие клавиши (без отпускания) SimulateKeyUp() - эмулировать отпускание клавиши SimulateKeystroke() - эмулировать удар по клавише (нажатие и отпускание) и SendKeys(), позволяющие Вам гибко контролировать посылаемые сообщения клавиатуры.
SimulateKeyDown(), SimulateKeyUp() и SimulateKeystroke() получают коды виртуальных клавиш (virtural key) (вроде VK_F1). Процедура SimulateKeystroke() получает дополнительный параметр, полезный при эмуляции нажатия PrintScreen. Когда этот параметр равен нулю весь экран будет скопирован в буфер обмена (clipboard). Если дополнительный параметр равен 1 будет скопированно только активное окно.
Четыре метода "button click" демонстрируют использование: ButtonClick1 - включает capslock ButtonClick2 - перехватывает весь экран в буфер обмена (clipboard). ButtonClick3 - перехватывает активное окно в буфер обмена (clipboard). ButtonClick4 - устанавливает фокус в Edit и отправляет в него строку.
Пример:

procedure SimulateKeyDown(Key : byte);
begin
keybd_event(Key, 0, 0, 0);
end;

procedure SimulateKeyUp(Key : byte);
begin
keybd_event(Key, 0, KEYEVENTF_KEYUP, 0);
end;

procedure SimulateKeystroke(Key : byte; extra : DWORD);
begin
keybd_event(Key,extra,0,0);
keybd_event(Key,extra,KEYEVENTF_KEYUP,0);
end;

procedure SendKeys(s : string);
var
i : integer;
flag : bool;
w : word;
begin
{Get the state of the caps lock key}
flag := not GetKeyState(VK_CAPITAL) and 1 = 0;
{If the caps lock key is on then turn it off}
if flag then
SimulateKeystroke(VK_CAPITAL, 0);
for i := 1 to Length(s) do
begin
w := VkKeyScan(s[i]);
{If there is not an error in the key translation}
if ((HiByte(w) <> $FF) and (LoByte(w) <> $FF)) then
begin
{If the key requires the shift key down - hold it down}
if HiByte(w) and 1 = 1 then
SimulateKeyDown(VK_SHIFT);
{Send the VK_KEY}
SimulateKeystroke(LoByte(w), 0);
{If the key required the shift key down - release it}
if HiByte(w) and 1 = 1 then
SimulateKeyUp(VK_SHIFT);
end;
end;
{if the caps lock key was on at start, turn it back on}
if flag then
SimulateKeystroke(VK_CAPITAL, 0);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
{Toggle the cap lock}
SimulateKeystroke(VK_CAPITAL, 0);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
{Capture the entire screen to the clipboard}
{by simulating pressing the PrintScreen key}
SimulateKeystroke(VK_SNAPSHOT, 0);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
{Capture the active window to the clipboard}
{by simulating pressing the PrintScreen key}
SimulateKeystroke(VK_SNAPSHOT, 1);
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
{Set the focus to a window (edit control) and send it a string}
Application.ProcessMessages;
Edit1.SetFocus;
SendKeys('Delphi Is RAD!');
end;

Я загружаю TImageList динамически. Как сделать картинки из TImageList прозрачными?

procedure TForm1.Button1Click(Sender: TObject);
var
bm : TBitmap;
il : TImageList;
begin
bm := TBitmap.Create;
bm.LoadFromFile('C:\DownLoad\TEST.BMP');
il := TImageList.CreateSize(bm.Width,bm.Height);
il.DrawingStyle := dsTransparent;
il.Masked := true;
il.AddMasked(bm, clRed);
il.Draw(Form1.Canvas, 0, 0, 0);
bm.Free;
il.Free;
end;

Как заставить TMediaPlayer проигрывать одно и тоже бесконечно? AVI например?

В примере AVI файл проигрывается снова и снова - используем событие MediaPlayer'а Notify

procedure TForm1.MediaPlayer1Notify(Sender: TObject);
begin
with MediaPlayer1 do
if NotifyValue = nvSuccessful then
begin
Notify := True;
Play;
end;
end;

При выполнении диалога FontDialog со свойством Device равным fdBoth or fdPrinter, появляется ошибка "There are no fonts installed".

Эти установки должны показать шрифты совместимые либо с принтером либо с экраном. В примере диалог Windows ChooseFont вызывается напрямую чтобы показать список шрифтов, совместимых одновременно и с экраном и с принтером.

uses Printers, CommDlg;

procedure TForm1.Button1Click(Sender: TObject);
var
cf : TChooseFont;
lf : TLogFont;
tf : TFont;
begin
if PrintDialog1.Execute then
begin
GetObject(Form1.Canvas.Font.Handle, sizeof(lf),@lf);
FillChar(cf, sizeof(cf), #0);
cf.lStructSize := sizeof(cf);
cf.hWndOwner := Form1.Handle;
cf.hdc := Printer.Handle;
cf.lpLogFont := @lf;
cf.iPointSize := Form1.Canvas.Font.Size * 10;
cf.Flags := CF_BOTH or CF_INITTOLOGFONTSTRUCT or
CF_EFFECTS or CF_SCALABLEONLY or CF_WYSIWYG;
cf.rgbColors := Form1.Canvas.Font.Color;
if ChooseFont(cf) <> false then
begin
tf := TFont.Create;
tf.Handle := CreateFontIndirect(lf);
tf.COlor := cf.RgbColors;
Form1.Canvas.Font.Assign(tf);
tf.Free;
Form1.Canvas.TextOut(10, 10, 'Test');
end;
end;
end;


Материалы находятся на сайте http://cracklab.narod.ru/faq/


Создатель этого HTML файла не претендует на авторство вопросов/ответов представленных в нём, не отвечает за их содержание и достоверность, а также за последствия использования программных кодов , полученных из этого HTML файла. Также не принимаются претензии относительно не размещённой информации об авторе каждого конкретного FAQ'а. Любые другие вопросы присылайте на bad_guy@cracklab.ru (обращаться к Bad_guy'ю).
Hosted by uCoz