Часто задаваемые вопросы по Delphi

Как выдать текст под наклоном?

Чтобы вывести под любым углом текст необходимо использовать TrueType Fonts (например "Arial"). Например:

var
LogFont : TLogFont;

...
GetObject(Canvas.Font.Handle, SizeOf(TLogFont), @LogFont);
{ Вывести текст 1/10 градуса против часовой стрелки }
LogFont.lfEscapement := Angle*10;
Canvas.Font.Handle := CreateFontIndirect(LogFont);



Как экспортировать таблицу базы данных в ASCII-файл?

procedure TMyTable.ExportToASCII;
var
I: Integer;
Dlg: TSaveDialog;
ASCIIFile: TextFile;
Res: Boolean;
begin
if Active then
if (FieldCount > 0) and (RecordCount > 0) then
begin
Dlg := TSaveDialog.Create(Application);
Dlg.FileName := FASCIIFileName;
Dlg.Filter := 'ASCII-Fiels (*.asc)|*.asc';
Dlg.Options := Dlg.Options+[ofPathMustExist,
ofOverwritePrompt, ofHideReadOnly];
Dlg.Title := 'Экспоритровать данные в ASCII-файл';
try
Res := Dlg.Execute;
if Res then
FASCIIFileName := Dlg.FileName;
finally
Dlg.Free;
end;
if Res then
begin
AssignFile(ASCIIFile, FASCIIFileName);
Rewrite(ASCIIFile);
First;
if FASCIIFieldNames then
begin
for I := 0 to FieldCount-1 do
begin
Write(ASCIIFile, Fields[I].FieldName);
if I <> FieldCount-1 then
Write(ASCIIFile, FASCIISeparator);
end;
Write(ASCIIFile, #13#10);
end;
while not EOF do
begin
for I := 0 to FieldCount-1 do
begin
Write(ASCIIFile, Fields[I].Text);
if I <> FieldCount-1 then
Write(ASCIIFile, FASCIISeparator);
end;
Next;
if not EOF then
Write(ASCIIFile, #13#10);
end;
CloseFile(ASCIIFile);
if IOResult <> 0 then
MessageDlg('Ошибка при создании или переписывании '+
'в ASCII-файл', mtError, [mbOK], 0);
end;
end
else
MessageDlg('Нет данных для экспортирования.',
mtInformation, [mbOK], 0)
else
MessageDlg('Таблица должна быть открытой, чтобы данные '+
'можно было экспортировать в ASCII-формат.', mtError,
[mbOK], 0);
end;



Как выяснить размер BLOB-поля?

Следующая функция поможет определить размер BLOB-поля.

Function GetBlobSize(Field: TBlobField): LongInt;
begin
with TBlobStream.Create(Field, bmRead) do
try
Result := Seek(0, 2);
finally
Free;
end;
end;



Как сравнить bookmarks в таблице?

function TBDEDirect.CompareBookmarks(Bookmark1,
Bookmark2: TBookmark): Boolean;
var
Res: DBIResult;
CompareRes: Word;
begin
Result := False;
if CheckDatabase then
begin
Res := DbiCompareBookmarks(FDataLink.DataSource.DataSet.Handle,
Bookmark1, Bookmark2, CompareRes);
if Res = 0 then
if CompareRes = 0 then
Result := True
else
else
Check(Res);
end;
end;



Как выделить окошко DBGrid другим цветом?

Необходимо обработать событие "OnDrawCellData". Например для того, чтобы пометить выбранное окошко красным фоном, необходимо сделать следующее:

procedure TForm1.DBGridDrawDataCell(Sender:TObject; const Rect:TRect;
Field:TField; State:TGridDrawState);
begin
if gdFocused in State then
with (Sender as TDBGrid).Canvas do
begin
Brush.Color := clRed;
FillRect(Rect);
TextOut(Rect.Left, Rect.Top, Field.AsString);
end;
end;



Как закрыть окно подсказки если пользователь закончил приложение?

В следующем примере показано как закрыть окно помощи если пользователь закончил приложение.

procedure TMainForm.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
Winhelp(Handle, 'WINHELP.HLP', HELP_QUIT, 0);
Action := caFree;
end;



Как установить количество цветов в системной палитре?

Функция GetNumColors возвращает количество цветов для актуально выбранного разрешения экрана.

function GetNumColors: LongInt;
var
BPP: Integer;
DC: HDC;
begin
DC := CreateDC('DISPLAY', nil, nil, nil);
if DC <> 0 then begin
try
BPP := GetDeviceCaps(DC, BITPIXEL) * GetDeviceCaps(DC, PLANES);
finally
DeleteDC(DC);
end;
case BPP of
1: Result := 2;
4: Result := 16;
8: Result := 256;
15: Result := 32768;
16: Result := 65536;
24: Result := 16777216;
end;
end else
Result := 0;
end;



Как через индекс обратиться к нескольким компонентам?

Чтобы найти и сделать видимыми, например, компоненты с именами от "Label1" и до "Label5" можно использовать следующий вариант:

for t := 1 to 5 do
FindComponent('Label' + IntToStr(t)).Visible := TRUE;






 

Рейтинг@Mail.ru          Rambler's Top100

X-ZiBiT