Лидеры по количеству баллов:

Некоторая статистическая информация:

Примечание: Под форматированием текста понимается возможность оформлять ответы с использованием html-тегов.

Если Вы хотите, чтобы Вашего имени (ника) не было в данной таблице, отправьте письмо по этой ссылке с зарегистрированного у нас адреса. В теле письма, пожалуйста, укажите причину удаления имени из таблицы. Нам важно ваше мнение.

Основные правила нашей рассылки:
1. Не присылайте ответов на вопросы вроде "да я не знаю" или "да/нет". Такие ответы не публикуются.
2. Вопросы, не касающиеся Delphi, не принимаются (для этого существуют другие рассылки).
3. Запрещено присылать вложенные файлы, объёмом выше установленного ограничения (ограничения указаны в правилах).
4. Не изменяйте тем присылаемых писем. Письма с "неправильными" темами не обрабатываются! Используйте текстовый (не HTML) формат писем. HTML-теги применяйте только в том случае, если Вы уже достигли статуса, где это разрешено (см. правила).
5. Запрещено задавать вопросы, содержащие два (или несколько) вопросов разной тематики. Каждый из таких вопросов должен быть оформлен отдельным письмом.

Вопрос #231 (автор вопроса: Беляев Иван Леонидович; вопрос отправлен: 30.01.2006 12:56):

Здравствуйте уважаемые специалисты по Delphi, подскажите начинающему программисту. База Oracle, я не могу связать поле MEMO в Дельфи с полем типа BLOB в Oracle. Заранее благодарен.  [Ответить на вопрос]

Вопрос #232 (автор вопроса: rawen; вопрос отправлен: 01.02.2006 08:59):

Подскажите, как подключиться к реестру на удаленной машине и считать из него ключи?  [Ответить на вопрос]

Вопрос #233 (автор вопроса: elite; вопрос отправлен: 01.02.2006 16:43):

Здравствуйте уважаемые эксперты! Подскажите, как написать простейший Клиент и Сервер на Delphi? Заранее спасибо!  [Ответить на вопрос]

Вопрос #234 (автор вопроса: illuha_y; вопрос отправлен: 03.02.2006 03:40):

Здравствуйте! Ниже приведу кусок кода. Проблема с функцией RegEnumValue, возвращает ошибку 259. Подскажите в чем тут проблема?

procedure TForm1.SkanKey(HKey_: HKEY; KeyStr, Name: string;
var Value: TRegKeyInfo;var Alist:TStringList);
var
key: HKEY;
i,j,d:integer;
CountKey,LenKey,NumVal: word;
KeyName,ValueName, st: string;
Mem: TMemoryStream;
RegType: byte;
SizeData: integer;
len: DWORD;
MaxData: integer;
// LenValue: DWORD;
begin
FillChar(value, SizeOf(TRegKeyInfo), 0);
ErrorCode:= RegOpenKeyEx(Hkey_,PChar(name) , 0, KEY_READ, Key);
if ErrorCode <> ERROR_SUCCESS then
Alist.Add('[RegOpenKeyEx ERROR № '+IntToStr(ErrorCode)+'] ' + name)
else try
ErrorCode:= RegQueryInfoKey(key,nil,nil,nil,@Value.NumSubKeys,
@Value.MaxSubKeyLen,nil,@Value.NumValues,@Value.MaxValueLen,
@Value.MaxDataLen,nil,nil);
if SysLocale.FarEast and (Win32Platform = VER_PLATFORM_WIN32_NT) then
with value do begin
inc(MaxSubKeyLen,MaxSubKeyLen);
inc(MaxValueLen,MaxValueLen);
end;
mem:= TMemoryStream.Create;
try
mem.SetSize(value.MaxDataLen);
Len:= value.MaxValueLen+1;
MaxData:= value.MaxDataLen;
if value.NumValues > 0 then
for j:= 1 to value.NumValues do begin
ErrorCode:= RegEnumValue(HKey_,j,PChar(ValueName),Len,0,@RegType,
mem.Memory, @MaxData);
if ErrorCode <> ERROR_SUCCESS then Break;
end;
finally
mem.Free;
end;
finally
RegCloseKey(key);
end;

Вопрос #235 (автор вопроса: dimon; вопрос отправлен: 05.02.2006 00:23):

Помогите пожалуйста!!! Никак не могу написать программу, которая переносит данные из Excel в Word.  [Ответить на вопрос]

Вопрос #236 (автор вопроса: Игорь Середюк; вопрос отправлен: 07.02.2006 15:00):

Как отследить момент двойного нажатия левой клавиши мыши в RichEdit? Надо, чтобы при этом дейстии выполнялись некоторые действия.  [Ответить на вопрос]

Вопрос #237 (автор вопроса: Naj; вопрос отправлен: 07.02.2006 16:24):

Ребят, плиз помогите !!! 1) Как сделать, чтоы брался текст из Edit, анализировался, в папке с прогой искался файл с названием=тексту из Edit и этот файл отображался в Memo? 2) То же с картинками. Плиз!  [Ответить на вопрос]

Вопрос #238 (автор вопроса: Ilya Bikmetov; вопрос отправлен: 09.02.2006 14:00):

Как можно связать TADOQuery и TQueryTableProducer?  [Ответить на вопрос]

Вопрос #239 (автор вопроса: Alog; вопрос отправлен: 10.02.2006 22:31):

1. Как определить размер MP3 файла который находится на CD диске? Использовал функцию filesize(var f), но она не работает. 2. Как определить качество звука MP3 файла? 3. И еще очень волнующий меня вопрос: Как выяснить позицию по X движка в trackbare? Заранее спасибо!  [Ответить на вопрос]

Вопрос #240 (автор вопроса: HEPB; вопрос отправлен: 11.02.2006 10:10):

Доброго времени суток!
Требуется примерно следующее реализовать на Delphi. Используя компонент TChart.
1) Библиотека процессов. Процесс – некоторая ломанная ступенчатая функция от времени. То есть функция либо параллельна оси времени, либо перпендикулярна к ней. Начало процесса в нулевой момент времени. Библиотека процессов хранится в виде координат в базе данных. В чем сложность для меня? Для библиотеки нужно сделать редактор, где бы пользователь создавал новый процесс/редактировал существующий. Для задания точек использовать как график (TChart) так и значения точек в Grid’е. Реализовать стирание отдельных линий, дорисовка процесса сразу буквой "Г", при этом с прилипанием к точке в области которой был щелчок, "схватывание" вершин и перемещение в другое место.
2) Пуск процессов. Здесь тот же TChart. Но время на осях реальное. С датой и временем. Для пуска процесса пользователь выбирает один из процессов из библиотеки процессов и вставляет его в график, указав начало процесса на графике, скажем 2 февраля в 7:00. При этом на этом графике могут уже быть другие процессы, вставленные ранее. То есть тут необходима проверка, чтобы новый (вставляемый) процесс не перекрывал старые. Идеальная реализация видется в подобии Автокаду. Вставка блока из библиотеки. То есть пока блок (процесс из библиотеки) окончательно не поставили, он волочится за мышкой, ища точку начала, прилипая к ранее вставленным процессам, точнее к их вершинам. Но даже если его поставили, должна быть возможность его удалить целиком (во время текущей сессии редактирования, так как потом он уже не будет привязан к библиотеки а его составляющие отрезки заживут каждый своей жизнью) или перенести на другую дату. После того как его вставили, он превращается в набор отрезков и теперь они становятся для редактирования. Например, сломалось какое оборудование, процесс становится не нужным, нужно позволить его обрезать. То есть сделать нулем в какой-то момент времени, конец его отсечь. Также должна быть возможность продления графика, то есть разрыв графика в некий момент времени, удлинение отрезка и дорисовка окончания. У кого есть какие-нибудь идеи? Может кто-то нечто подобное делал. Любые идеи, советы приветствуются.  [Ответить на вопрос]

Вопрос #241 (автор вопроса: Александр Путилин; вопрос отправлен: 08.02.2006 18:26):

D6.TWebBrowser. IE6.0. Win2k, WinXP.Необходимо организовать некое подобие оффлайн-браузера. На форме имеются TShellTreeView и TWebBrowser. Проблема в том, что после нескольких кликов по ShellTreeView (10-20 раз) происходит аварийное завершение программы с любимым сообщением:
Project Project1.exe raised exception class EAccessViolation with message 'Access violation at address 0040358C in module 'Project1.exe'. Read of address 0000002C'. Process stopped. Use Step or Run to continue.
Аналогичное сообщение возникает при выходе из программы при запуске уже откомпилированного exe-шника из Windows. Делаю так:

procedure TMainForm.TreeViewChange(Sender: TObject; Node: TTreeNode);
var
F, FName: OleVariant;
Ext: String; begin
F:= 0;
FName:= TreeView.Path;
Ext:= LowerCase(ExtractFileExt(TreeView.Path));
if (Ext = '.htm') or (Ext = '.html') or
(Ext = '.php') or (Ext = '.shtml') then
WebBrowser.Navigate2(FName,F,F,F,F); // Navigate ?
end;

Вопрос #224:
Как создать программу, чтобы при нажатии на Button1 она загружала в Memo1 текстовый файл по адресу: http://www.myserver.com/news.txt?

1. [Отвечает: Dron (статус: Специалист), 29.01.2006 18:00]: Вот пример:

function GetInetFile(const fileURL, FileName: String): boolean;
const BufferSize = 1024;
var
  hSession, hURL: HInternet;
  Buffer: array[1..BufferSize] of Byte;
  BufferLen: DWORD;
  chType    : array[1..20] of Char;
  cLength   : cardinal;
  cIndex    : cardinal;
  f_loc:file;
  sAppName: string;
begin
Result:=False;
sAppName := ExtractFileName(Application.ExeName);
hSession := InternetOpen(PChar(sAppName),INTERNET_OPEN_TYPE_PRECONFIG,nil, nil, 0);
try
  hURL := InternetOpenURL(hSession,PChar(fileURL),nil,0,0,0);
  try
   AssignFile(f_loc, FileName);
   Rewrite(f_loc,1);
   repeat
    InternetReadFile(hURL, @Buffer,SizeOf(Buffer), BufferLen);BlockWrite(f_loc, Buffer, BufferLen);
    cLength := 250;
    cIndex := 0;
    HTTPQueryInfo(hURL,HTTP_QUERY_CONTENT_LENGTH,@chType,cLength,cIndex);
     Application.ProcessMessages();
   until BufferLen = 0;
   CloseFile(f_loc);
   Result:=True;
  finally
   InternetCloseHandle(hURL)
  end
finally
  InternetCloseHandle(hSession)
end
end;

procedure TForm1.Button2Click(Sender: TObject);
var FileOnNet, LocalFileName: string;
begin
FileOnNet:='http:⁄⁄www.delphi.int.ru⁄update.txt';
LocalFileName:=ExtractFilePath(Application.ExeName)+'temp.txt';
if GetInetFile(FileOnNet,LocalFileName)=True then
  Memo1.Lines.LoadFromFile(LocalFileName);
end;

Оценка за ответ: 5.

2. [Отвечает: romodos (статус: Эксперт: 1-ый класс), 29.01.2006 20:28]: Пример взят из DelphiWorld. Сначала надо загрузить файл из интернета, а потом загрузить его в Memo.

uses
  URLMon, ShellApi;

function DownloadFile(SourceFile, DestFile: string): Boolean;
begin
  try
    Result := UrlDownloadToFile(nil, PChar(SourceFile), PChar(DestFile), 0, nil) = 0;
  except
    Result := False;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
const
  SourceFile = 'http:⁄⁄www.myserver.com⁄news.txt';
  DestFile = 'c:\temp\news.txt';
begin
  if downloadFile(SourceFile, DestFile) then
    memo.lines.loadfromfile(DestFile);
  else
    ShowMessage('Ошибка при открытии файла' + SourceFile)
end;

Оценка за ответ: 5.

3. [Отвечает: SiNiK (статус: Эксперт: 2-ой класс), 29.01.2006 19:35]: От редактора: тот же самый код, что и в ответе romodos...

Оценка за ответ: 5.

4. [Отвечает: Матвеев И.В. (статус: Практикант), 30.01.2006 15:48]: Вот, специально для Вас написал:

procedure TForm1.Button1Click(Sender: TObject);
var
  hSession,
  hURL   : HInternet;
  FSize  : Cardinal;
  Buffer : TMemoryStream;
  Err    : Boolean;
begin
// Открыли сессию
hSession:= InternetOpen('memo.text', PRE_CONFIG_INTERNET_ACCESS, nil, nil, 0);
// Теперь сам URL
hURL := InternetOpenURL(hSession,PChar(Edit1.Text),nil,0,0,0);
// Узнаем размер файла
InternetQueryDataAvailable(hURL, FSize, 0, 0);

// Создадим буфер в памяти
Buffer := TMemoryStream.Create;
Buffer.SetSize(FSize);
// Качаем
Err := InternetReadFile(hURL, Buffer.Memory,FSize,FSize);
if Err = false then //Ошибка чтения
  begin
    ShowMessage(`При получении данных произошла ошибка`); //Сообщим и выходим
    Exit;
  end;

// Загрузим в Memo1
Memo1.Lines.LoadFromStream(Buffer);
Buffer.Free;
end;

Оценка за ответ: 5.

5. [Отвечает: Антон Трапезников (статус: Студент), 30.01.2006 14:26]: Загрузить в Memo какой - либо файл можно функцией Memo#.LoadFromFile, для загрузки же его с интернета необходимо, во - первых, определится с протоколом, который Вы собираетесь использовать, как я понимаю, это HTTP...

В Win32.SDK есть замечательная API-функция UrlDownloadToFile. А вот, то, что говорит нам про нее MSDN:

Загружает поток битов из интернета и сохраняет его в файл.

Синтаксис:

HRESULT URLDownloadToFile(
LPUNKNOWN pCaller,
LPCTSTR szURL,
LPCTSTR szFileName,
DWORD dwReserved,
LPBINDSTATUSCALLBACK lpfnCB
);

Неплохой пример использования в Delphi этой функции есть на: http://www.codenet.ru/progr/delphi/stat/HTTP-Download.php

Если же Вас интерисует протокол FTP, то смотрите информацию по функциям FTPOpenFile.

В MSDN есть неплохое описание всех этий функций.

Оценка за ответ: 5.

6. [Отвечает: midav.land.ru (статус: Эксперт: 10-ый класс), 30.01.2006 12:40]: Так как документ находиться в интернете, то его нужно загрузить (логично:-) ). Судя по адресу, нужно использовать протокол http. Наиболее простой способ - использовать компоненты Indy. Пример (для Indy 9 (Идёт с 7 делфой)):
//Вначале методом GET получаем страницу.
//Для метода POST можно даже параметры добавлять - внизу страницы в
//коментариях
idHttp1.Host := 'www.myserver.com'; // надо без http://
idHttp1.Connect;
s := idHttp1.Get('http://www.myserver.com/news.txt'); // а тут надо с http://
s:=AnsiReplaceStr(s,#$A,#$D#$A);//поправим разелитель строк
Memo1.Text:=s;
IdHTTP1.Disconnect; //Отключились
//Теперь страничка у нас в в memo и в переменное s. Можем мучить!

Способ рабочий и хорошо работает. Если нет компонентов Indy или с какихто причин не хочеться использовать, то можно воспользоваться системными функциями. Ниже приведена готовая функция для закачки файла. Одно неудобство - она сохраняет файл на диск.

От редактора: тот же самый код, что и в ответе Dron

Оценка за ответ: 5.

7. [Отвечает: Corporate (статус: Эксперт: 1-ый класс), 31.01.2006 16:28]: Функция получения удаленного файла в поток:

uses WinINet;

function DownloadFileStream(const AUrlName: GrfString; AStream: TStream): Boolean;
var
  INetHandle : HINTERNET;
  UrlHandle  : HINTERNET;
  BytesRead  : Cardinal;
  Buffer     : array[0..65535] of Byte;
  IsRead     : Boolean;
begin

  Result  := False;
  
  if (AStream<>nil)  then begin

    INetHandle  := InternetOpen('MyProgram', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
    if Assigned(INetHandle) then begin
      try

        UrlHandle := InternetOpenUrl(INetHandle, PChar(AUrlName), nil, 0, INTERNET_FLAG_RESYNCHRONIZE, 0);
        if Assigned(UrlHandle) then  begin
          try
            repeat
              FillChar(Buffer, SizeOf(Buffer), 0);
              IsRead := InternetReadFile(UrlHandle, @Buffer, SizeOf(Buffer), BytesRead);
              if IsRead then
                AStream.Write(Buffer,BytesRead)
              else
                break;
            until (BytesRead = 0);
            Result := IsRead;
          finally
            InternetCloseHandle(UrlHandle);
          end;
        end;
        
      finally
        InternetCloseHandle(INetHandle);
      end;
    end;
    
  end;

end;

Оценка за ответ: 5.

Вопрос #225:
Есть к примеру такая строка: Books[1].WorkSheets[1].Rows[1].HorizontalAlignment := 3; Она, как Вы знаете, в Excel'е выравнивает по центру и по горизонтали. Подскажите, как включить перенос по словам в той же ячейке? Такая строка выдает ошибку: XLApp.WorkBooks[1].WorkSheets[1].Columns[1].Autosize := True;

1. [Отвечает: Гавриленко Евгений (статус: Эксперт: 1-ый класс), 29.01.2006 19:22]: Лучше всего учиться программировать в Excel следующим образом:
1. включаешь режим записи макроса
2. Выполняешь необходимые операции
3. Останавливаешь запись макроса и смотришь его содержимое

Таким образом можно увидеть, что нужное свойство .WrapText.

Оценка за ответ: 5.

2. [Отвечает: Anthony (статус: Эксперт: 1-ый класс), 30.01.2006 9:48]: Я делаю это следующим образом:

exl.Application.ActiveWorkBook.sheets[Sheet].Range['M11'].Select;
exl.selection.WrapText:=True;

А вообще для справки, при работе с офисными приложениями можно делать так: Если нужно произвести какиое-либо дейсвие, к примеру с Excel-ем, открываем последний запускаем макрось на запись, делаем это дейсвтие ручками, смотрим код макроса, переводим синтаксис с VBA на Delphi.

Оценка за ответ: 5.

3. [Отвечает: Ermakova Dasha (статус: Специалист), 30.01.2006 12:27]: Для переноса по словам используй WrapText, например так:
E.ActiveWorkbook.Sheets.Item[1].Columns[1].WrapText:=true;

Но если нужно установить для конкретной ячейки, тогда:
E.ActiveWorkbook.Sheets.Item[1].Range['A1'].WrapText:= true;

Оценка за ответ: 5.

4. [Отвечает: Матвеев И.В. (статус: Практикант), 30.01.2006 23:48]: Если Вам нужно сделать перенос слов в ячейке - то есть, чтобы при выходе текста за пределы ячейки по ширине ячейка растягивалась по высоте и текст переносился вниз - используйте .WrapText := True;

Например:
ExcelApplication1.Cells.Item[1,1].WrapText := True;

Если Вам нужно сделать, чтобы при выходе текста из ячейки по ширине, размер текста автоматически подстраивался, чтобы уместиться в ячейке используйте .ShrinkToFit := True;

Например:
ExcelApplication1.Cells.Item[1,1].ShrinkToFit := True;

Оценка за ответ: 5.

5. [Отвечает: Анатолий Чульдум (статус: Эксперт: 1-ый класс), 31.01.2006 16:04]: WrapText = True пробовал? Или с текст+chr(10).

Оценка за ответ: 5.

6. [Отвечает: PVS (статус: Эксперт: 10-ый класс), 11.02.2006 17:32]: Ошибка возникает потому, что свойство AutoSize не существует, а перенос по словам называется WrapText. Если надо знать как что-то сделать в Excel'e то самый простой способ - войти в Excel, записать макрос и посмотреть что оно там пишет. Лишнего много, но найти нужный параметр довольно легко.

Оценка за ответ: 5.

Вопрос #226:
Как напечатать TForm и все копмоненты на ней в альбомном формате А4?

1. [Отвечает: Антон Трапезников (статус: Студент), 30.01.2006 15:06]: Когда-то давно стояла аналогичная задача, которую удалось решить поиском (успешным :) в сети следующего модуля. Логика алгоритма такова: программа делает снимок формы с помощью API-функции BitBlt (описание данной функции смотрите в MSDN), который затем печатается на принтере. Важно учесть, что раз это скриншот, то в момент "сьемки" форма должна быть поверх остальных окон и должна быть полностью видима.

unit Prntit;

interface

uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics,
Controls, Forms, Dialogs, StdCtrls, ExtCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
Image1: TImage;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

uses Printers;

procedure TForm1.Button1Click(Sender: TObject);
var

dc: HDC;
isDcPalDevice: BOOL;
MemDc: hdc;
MemBitmap: hBitmap;
OldMemBitmap: hBitmap;
hDibHeader: Thandle;
pDibHeader: pointer;
hBits: Thandle;
pBits: pointer;
ScaleX: Double;
ScaleY: Double;
ppal: PLOGPALETTE;
pal: hPalette;
Oldpal: hPalette;
i: integer;
begin

{Получаем dc экрана}
dc := GetDc(0);
{Создаем совместимый dc}
MemDc := CreateCompatibleDc(dc);
{создаем изображение}
MemBitmap := CreateCompatibleBitmap(Dc,
form1.width,
form1.height);
{выбираем изображение в dc}
OldMemBitmap := SelectObject(MemDc, MemBitmap);

{Производим действия, устраняющие ошибки при работе с некоторыми типами видеодрайверов}
isDcPalDevice := false;
if GetDeviceCaps(dc, RASTERCAPS) and
RC_PALETTE = RC_PALETTE then
begin
GetMem(pPal, sizeof(TLOGPALETTE) +
(255 * sizeof(TPALETTEENTRY)));
FillChar(pPal^, sizeof(TLOGPALETTE) +
(255 * sizeof(TPALETTEENTRY)), #0);
pPal^.palVersion := $300;
pPal^.palNumEntries :=
GetSystemPaletteEntries(dc,
0,
256,
pPal^.palPalEntry);
if pPal^.PalNumEntries <> 0 then
begin
pal := CreatePalette(pPal^);
oldPal := SelectPalette(MemDc, Pal, false);
isDcPalDevice := true
end
else
FreeMem(pPal, sizeof(TLOGPALETTE) +
(255 * sizeof(TPALETTEENTRY)));
end;

{копируем экран в memdc/bitmap}
BitBlt(MemDc,
0, 0,
form1.width, form1.height,
Dc,
form1.left, form1.top,
SrcCopy);

if isDcPalDevice = true then
begin
SelectPalette(MemDc, OldPal, false);
DeleteObject(Pal);
end;

{удаляем выбор изображения}
SelectObject(MemDc, OldMemBitmap);
{удаляем dc памяти}
DeleteDc(MemDc);
{Распределяем память для структуры DIB}
hDibHeader := GlobalAlloc(GHND,
sizeof(TBITMAPINFO) +
(sizeof(TRGBQUAD) * 256));
{получаем указатель на распределенную память}
pDibHeader := GlobalLock(hDibHeader);

{заполняем dib-структуру информацией, которая нам необходима в DIB}
FillChar(pDibHeader^,
sizeof(TBITMAPINFO) + (sizeof(TRGBQUAD) * 256),
#0);
PBITMAPINFOHEADER(pDibHeader)^.biSize :=
sizeof(TBITMAPINFOHEADER);
PBITMAPINFOHEADER(pDibHeader)^.biPlanes := 1;
PBITMAPINFOHEADER(pDibHeader)^.biBitCount := 8;
PBITMAPINFOHEADER(pDibHeader)^.biWidth := form1.width;
PBITMAPINFOHEADER(pDibHeader)^.biHeight := form1.height;
PBITMAPINFOHEADER(pDibHeader)^.biCompression := BI_RGB;

{узнаем сколько памяти необходимо для битов}
GetDIBits(dc,
MemBitmap,
0,
form1.height,
nil,
TBitmapInfo(pDibHeader^),
DIB_RGB_COLORS);

{Распределяем память для битов}
hBits := GlobalAlloc(GHND,
PBitmapInfoHeader(pDibHeader)^.BiSizeImage);
{Получаем указатель на биты}
pBits := GlobalLock(hBits);

{Вызываем функцию снова, но на этот раз нам передают биты!}
GetDIBits(dc,
MemBitmap,
0,
form1.height,
pBits,
PBitmapInfo(pDibHeader)^,
DIB_RGB_COLORS);

{Пробуем исправить ошибки некоторых видеодрайверов}
if isDcPalDevice = true then
begin
for i := 0 to (pPal^.PalNumEntries - 1) do
begin
PBitmapInfo(pDibHeader)^.bmiColors[i].rgbRed :=
pPal^.palPalEntry[i].peRed;
PBitmapInfo(pDibHeader)^.bmiColors[i].rgbGreen :=
pPal^.palPalEntry[i].peGreen;
PBitmapInfo(pDibHeader)^.bmiColors[i].rgbBlue :=
pPal^.palPalEntry[i].peBlue;
end;
FreeMem(pPal, sizeof(TLOGPALETTE) +
(255 * sizeof(TPALETTEENTRY)));
end;

{Освобождаем dc экрана}
ReleaseDc(0, dc);
{Удаляем изображение}
DeleteObject(MemBitmap);

{Запускаем работу печати}
Printer.BeginDoc;

{Масштабируем размер печати}
if Printer.PageWidth < Printer.PageHeight then
begin
ScaleX := Printer.PageWidth;
ScaleY := Form1.Height * (Printer.PageWidth / Form1.Width);
end
else
begin
ScaleX := Form1.Width * (Printer.PageHeight / Form1.Height);
ScaleY := Printer.PageHeight;
end;

{Просто используем драйвер принтера для устройства палитры}
isDcPalDevice := false;
if GetDeviceCaps(Printer.Canvas.Handle, RASTERCAPS) and
RC_PALETTE = RC_PALETTE then
begin
{Создаем палитру для dib}
GetMem(pPal, sizeof(TLOGPALETTE) +
(255 * sizeof(TPALETTEENTRY)));
FillChar(pPal^, sizeof(TLOGPALETTE) +
(255 * sizeof(TPALETTEENTRY)), #0);
pPal^.palVersion := $300;
pPal^.palNumEntries := 256;
for i := 0 to (pPal^.PalNumEntries - 1) do
begin
pPal^.palPalEntry[i].peRed :=
PBitmapInfo(pDibHeader)^.bmiColors[i].rgbRed;
pPal^.palPalEntry[i].peGreen :=
PBitmapInfo(pDibHeader)^.bmiColors[i].rgbGreen;
pPal^.palPalEntry[i].peBlue :=
PBitmapInfo(pDibHeader)^.bmiColors[i].rgbBlue;
end;
pal := CreatePalette(pPal^);
FreeMem(pPal, sizeof(TLOGPALETTE) +
(255 * sizeof(TPALETTEENTRY)));
oldPal := SelectPalette(Printer.Canvas.Handle, Pal, false);
isDcPalDevice := true
end;

{посылаем биты на принтер}
StretchDiBits(Printer.Canvas.Handle,
0, 0,
Round(scaleX), Round(scaleY),
0, 0,
Form1.Width, Form1.Height,
pBits,
PBitmapInfo(pDibHeader)^,
DIB_RGB_COLORS,
SRCCOPY);

{Просто используем драйвер принтера для устройства палитры}
if isDcPalDevice = true then
begin
SelectPalette(Printer.Canvas.Handle, oldPal, false);
DeleteObject(Pal);
end;

{Очищаем распределенную память} GlobalUnlock(hBits);
GlobalFree(hBits);
GlobalUnlock(hDibHeader);
GlobalFree(hDibHeader);

{Заканчиваем работу печати}
Printer.EndDoc;

end;

Еще один пример есть здесь: http://megalib.com/books/27/html/hard/printer/printer18.htm

Оценка за ответ: 5.

2. [Отвечает: midav.land.ru (статус: Эксперт: 10-ый класс), 30.01.2006 12:49]: У формы есть метод Print, который может её распечатать. Но она може не всегда помещаться на лист. Для этого можно отмасштабировать это дело с помощью свойства PrintScale. Одно из значений poPrintToFit - масштабировать по размеру страницы. А что бы размер страницы был A4 - это уже к настройкам принтера. Если же тебя не устраивает то, как печатается страничка, то открываешь файл Forms.pas (найдёшь в папке source\vcl) там находишь процедуру procedure TCustomForm.Print; Копируешь её себе и изучаеш, переделываешь как надо.

Оценка за ответ: 5.

3. [Отвечает: Матвеев И.В. (статус: Практикант), 11.02.2006 17:35]: C помощью объекта Printer модуля Printers. Вызываете Printer.BeginDoc, печатаете то что надо на Printer.Canvas, затем вызываете Printer.EndDoc.

Поскольку расширение у принтера отличается от расширения монитора нужно увеличивать печатаемое изображение.В приложении исходники примера, реализующего то, что Вам нужно. Загрузить прикреплённый файл >>

Оценка за ответ: 5.

4. [Отвечает: PVS (статус: Эксперт: 10-ый класс), 11.02.2006 17:35]: Надо писать то-то вроде:

uses ... printers, ...

var
SRect,DRect:TRect;

...........
SRect.Left:=0;
SRect.Top:=0;
SRect.Right:=Self.Width;
SRect.Bottom:=Self.Height;

Printer.Orientation := poLandscape;

DRect.Left:=0;
DRect.Top:=0;
DRect.Right:=Printer.PageWidth;
DRect.Bottom:=Printer.PageHeight;

Printer.Canvas.CopyRect(DRect,Self.Canvas,SRect);

Хотя сам я такого никогда не пробовал и за работоспособность кода не ручаюсь.

Оценка за ответ: 4.

Вопрос #227:
Я не могу получить вложение в письме, программа его просто не видит. Вот текст:
IdPOP31.Retrieve(i,msg);
for n:=0 to msg.MessageParts.Count do
begin
if (msg.MessageParts.Items[n] is TIdAttachment) then
showmessage('There is attachment');
end;
Как получить все вложения и сохранить их на диске?

1. [Отвечает: Антон Трапезников (статус: Студент), 30.01.2006 15:21]: Фрагмент кода из одной моей проги:

POP.Retrieve(n, Msg);
for n := 0 to Msg.MessageParts.Count - 1 do
  begin
    if Msg.MessageParts.Items[n] is TIdAttachment then
      begin
        if fileexists(TIdAttachment(Msg.MessageParts.Items[n]).FileName) then
          deletefile(TIdAttachment(Msg.MessageParts.Items[n]).FileName);
        TIdAttachment(Msg.MessageParts.Items[n]).SaveToFile(TIdAttachment(Msg.MessageParts.Items[n]).FileName);
      end
        else
     if Msg.MessageParts.Items[n] is TIdText then
       begin
         Memo1.Lines.Clear;
         Memo1.Lines.AddStrings(TIdText(Msg.MessageParts.Items[n]).Body);
       end;
  end;

Кстати, в момент ее разработки я наступил на такие забавные грабли: это должна была быть электронная жалобная книга, где жалобы отправлялись по почте с возможностью приаттачивания некоторых файлов.

Для проверки работы и прикреплял первый попавшийся файл (который, по иронии судьбы, оказался .exe), но письма я получал без этого файла :(

Как оказалось потом, корпоративный брандмауэр работал в режиме Paranoid и просто прибивал без суда и следствия все приаттаченные exe...

Оценка за ответ: 5.

Вопрос #228:
Здравствуйте. Есть такая проблема. Я пишу (на Delphi 7, мне он по душе, раньше имел опыт только на ZX-Spectrum :-)) программу по составлению сметы на строительные работы (нужно по работе). Сам являюсь начинающим, но хотелось бы довести до конца. И в смысле интересно, да и развиваться надо :-) Сделал основу. Таблица, в нее по кнопке добавляются услуги с ценой и количеством. Список услуг сохраняю в файл. Проблема в том, что цену приходится вводить вручную, как ее состыковать со списком услуг? И еще не могу придумать как сохранить готовую смету. Там пять столбиков плюс итоговая шапка ну и прочая лабуда. Если кто-нибудь возьмется отвечать, то прошу поподробнее. У меня мысли не успевают за текстом :-))) Был бы рад постоянной переписке с кем нибудь, в целях личного самообразования :-)

1. [Отвечает: Антон Трапезников (статус: Студент), 30.01.2006 16:06]: А зачем Вы сохраняете список услуг в файле? Отсюда и проблемы...

Не надо боятся БД, с ними действительно все проше, и решение будет выглядеть намного изящней, к тому же изначально Delphi создавалась и позиционировалась как средство быстрой разработки БД. Сделайте локальную БД (мне, например, по душе Access), с таблицей вида:
ServiceDetails
=============================
| PK | ServiceID | Integer |
=============================
| | ServiceName | String |
=============================
| | ServiceCost | Money |
==============================

Вторая таблица, соответственно, будет такого вида:

Orders
=============================
| PK | OrderID | Integer |
=============================
| FK | ServiceID | Integer |
=============================
| | Quantity |Integer |
=============================

Подключится к БД можно так:

sConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source='
+GetCurrentDir+'\db.mdb;Persist Security Info=False';

// Подключение к БД

AdoConnection1.ConnectionString := sConnectionString;
AdoConnection1.LoginPrompt := false;
AdoConnection1.Connected := true;

// Подключение таблиц

AdoTable1.Connection := AdoConnection1;
AdoTable1.TableName := 'ServiceDetails';
AdoTable1.Open;

AdoTable2.Connection := AdoConnection1;
AdoTable2.TableName := 'Orders';
AdoTable2.Open;

// Подключение источника данных;

DataSource1.DataSet := AdoTable1;
DBGrid1.DataSource := DataSource1;

DataSource2.DataSet := AdoTable2;
DBGrid2.DataSource := DataSource2;

Вот и все :) Затем можно создать вычисляемое поле Sum (Цена * Количество и поле подстановки ServiceName)

Я прикладываю архив с исходником, но он, к сожалению, написан на BDS 2006 :( Загрузить прикреплённый файл >>

Если будут вопросы, то пишите мне на trapeznikov@asc-ural.ru, либо в icq 272-544-920.

Оценка за ответ: 5.

2. [Отвечает: Деревянко Евгений (статус: Эксперт: 5-ый класс), 30.01.2006 20:45]: Очевидно вы не достаточно хорошо знакомы с технологией баз данных, иначе вопрос состыковки отпал бы сам собой. Для локальной базы данных неплохо подойдут компоненты с вкладки BDE. Правда для того, чтобы с ними работать очень полезным окажется знание языка SQL. Данные хранятся в виде таблиц определенной структуры обращение к которым автоматизировано, нужно только правильно сформулировать своё желание относительно необходимой информации (читай: правильно сформировать SQL-запрос). Присоединив к этому компоненты для отображения информации на форме (BDGrid, DBNavigator...) и автоматически генерируемые отчеты (QuickReport, RaveReport) в течение считанных часов получаем довольно функциональной приложением. Вам необходимо проделать следующие шаги:
1) Создать таблицы (в этом вам поможет Database Desktop из набора Delphi);
2) Создать приложение и поместить на форму компонент TTable на вкладке BDE.
3) В свойстве DatabaseName указать полный путь к созданным таблицам. 3) В свойстве TableName выбрать необходимую таблицу.
4) Установить свойство Enabled компонента Table1 в True.
5) Поместить на форму компонент DataSource (вкладка Data Access).
6) Выбрать в его свойстве DataSet ранее установленный Table1.
7) Помещем на форму также компоненты для отображения данных (вкладка Data Controls) и присоединяем их к DataSet.
Если всё сделано правильно, то получим простейшее приложение для работы с базами данных. При выполнении этих действий вероятнее всего в первый раз будут трудности. Возникшие вопросы можно присылать на derevyanko_evgen@mail.ru постараюсь отвечать по возможности.

Оценка за ответ: 5.

3. [Отвечает: Анатолий Чульдум (статус: Эксперт: 1-ый класс), 31.01.2006 16:08]: IMHO надо юзать создание вычисляемого поля.

Оценка за ответ: 2.

4. [Отвечает: PVS (статус: Эксперт: 10-ый класс), 11.02.2006 17:44]: А сделать минимальную базу данных не пробовал? Там все немного проще (в смысле кода) и с сохранением, и со связями. Надо подробнее - спрашивай по e-mail - подскажу, что знаю.

Оценка за ответ: 3.

5. [Отвечает: evgan (статус: Эксперт: 1-ый класс), 10.02.2006 19:41]: Советую не изобретать велосипед.

Смету можно сохранять в таблице. Связь со справочником услуг можно организовать через целочисленный код этой услуги.

И то, и другое можно организовать при помощи теории баз данных. Для этого в Delphi присутствует целый ряд компонентов (BDE, ADO и пр.) и программа Database Desktop, поставляемая вместе с Delphi.

Для начала, создай 3 таблицы:
1) Таблица услуг с примерно следующей структурой
+-------------+-------------+-------------------+
| Поле | Тип | Описание |
+-------------+-------------+-------------------+
| ID | AutoInc |уник.Значение усл. |
+-------------+-------------+-------------------+
| RashodID | Integer | код услуги из спр.|
+-------------+-------------+-------------------+
| Price | Float | Цена |
+-------------+-------------+-------------------+

2) Справочник услуг
+-------------+-------------+-------------------+
| Поле | Тип | Описание |
+-------------+-------------+-------------------+
| ID | AutoInc |уник.Значение усл. |
+-------------+-------------+-------------------+
| Name | String | Наименование |
+-------------+-------------+-------------------+
| Price | Float | Цена |
+-------------+-------------+-------------------+

3) Таблица смет с уникальным кодом сметы и всеми необходимыми полями.

При внесении новой услуги в 1-ю таблицу в поле RashodID заноси целочисленное значение из поля ID второй таблицы и при необходимости подставляешь цену из той же 2-ой таблицы.

P.S. "Столбики" в твоем вопросе называются "полями". В своем ответе я использовал именно этот термин.

Оценка за ответ: 5.

Вопрос #229:
Как вывести TCalendar на один месяц с положением цифр не по центру ячейки, а в левый или правый угол?

1. [Отвечает: midav.land.ru (статус: Эксперт: 10-ый класс), 30.01.2006 13:05]: Мне кажется наиболее просто будет перекрыть отрисовку или сделать своего наследника.

Оценка за ответ: 2.

Вопрос #230:
Как ячейке StringGrid присвоить цвет или вставить рисунок?

1. [Отвечает: SiNiK (статус: Эксперт: 2-ой класс), 29.01.2006 19:32]: Вставить рисунок:

Такое позволяет обработчик события OnDrawCell. Приводим скелет кода, демонстрирующий принцип вывода изображения в ячейке компонента:

with StringGrid1.Canvas do
begin
{...}
Draw(Rect.Left, Rect.Top, Image1.Picture.Graphic);
{...}
end;

Достичь цели позволяют методы Draw() и StretchDraw() объекта TCanvas. В приведенном примере переменная Image1 класса TImage содержит заранее загруженное изображение.

Присвоить цвет:

procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
begin
  if (gdFocused in State) then
  begin
    StringGrid1.Canvas.Brush.Color := clBlack;
    StringGrid1.Canvas.Font.Color := clWhite;
  end
  else
  if ACol = 2 then
     StringGrid1.Canvas.Brush.color := $00F7F7F7
    else
      StringGrid1.canvas.brush.Color := $00ffffff;
  if (ACol > 0) and (ARow > 0) then
  begin
    StringGrid1.Canvas.FillRect(Rect);
    StringGrid1.Canvas.TextOut(Rect.Left, Rect.Top, StringGrid1.Cells[ACol, ARow]);
  end;
end;

Оценка за ответ: 5.

2. [Отвечает: Ermakova Dasha (статус: Специалист), 30.01.2006 12:43]: Вот пример, он по нажатию на кнопку закрашивает ячейку (1,1) бордовым цветом и вставляет рисунок в ячейку (2,2) StringGrid-а.

var
  Form1: TForm1;
  draw: bool;
  B: TBitmap;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
draw:=true;
B:=TBitmap.Create;
B.LoadFromFile('1.bmp');
StringGrid1.Repaint;
end;

procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
begin
  if draw = true then
  if (ACol = 1) and (ARow = 1) then
  begin
  StringGrid1.Canvas.Brush.Color:=clMaroon;
  StringGrid1.Canvas.Rectangle(Rect);
  end
  else
  if (ACol = 2) and (ARow = 2) then
  StringGrid1.Canvas.StretchDraw(Rect,B);
end;

Оценка за ответ: 5.

3. [Отвечает: Матвеев И.В. (статус: Практикант), 30.01.2006 22:29]: Проще простого, переопределяете функцию рисования на свою и вперед. А где там уж Вы будете хранить информацию о цвете или рисунке - Ваша проблема. Чтобы не быть голословным привожу кусок кода:

procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var
  fSender   : TStringGrid;
  fColor    : TColor;
  fYOffset  : Integer;
begin
// Кастинг Sender: TObject -> fSender : TStringGrid
fSender := (Sender as TStringGrid);

fColor := clWindow;
if ARow = 2 then fColor := $00CCDBA8;
if ACol = 2 then fColor := $00EAB5E4;
if (ARow = 2) and (ACol = 2) then fColor := $00E8E4B7;
fSender.Canvas.Brush.Color := fColor;

// Скопированно из Grids.pas - TStringGrid.DrawCell
fSender.Canvas.TextRect(Rect, Rect.Left+2, Rect.Top+2, fSender.Cells[ACol, ARow]);
end;

Оценка за ответ: 5.

4. [Отвечает: midav.land.ru (статус: Эксперт: 10-ый класс), 30.01.2006 13:00]: Наиболее простой вариант - рисовать вручную. В обработчике события OnDrawCell элемента StringGrid поместите следующий код:

with (Sender as TStringGrid) do
with Canvas do
begin
{...}
Draw(Rect.Left, Rect.Top, Image1.Picture.Graphic);
{...}
end;

Используй метод Draw() или StretchDraw() (этот метод позволяет растягивать картинку) класса TCanvas. Image1 - это TImage с предварительно загруженным в него bitmap-ом. Вместо него можно использовать заранее подготовленый TBitmap. Если картинок много и они одинакового размера, то есть смысл использовать ImageList. Как узнать какую картинку рисовать? ПРисмотрись к передаваемым параметрам этому событию ACol, ARow: Integer; - ячейка, которую нужно отрисовать Rect: TRect; - координаты ячейки на канве StringGrida. State: TGridDrawState - состояние ячейки. Возможные значения gdSelected - ячейка выделена gdFocused - ячейка имеет фокус gdFixed - ячейка фиксирована это свойсто является свойством - набором, поэтому проверять нужно так if gdSelected in State then {...};

И наконец посмотри этот пример. Здесь показано как закрашивать ячейку определённым цветом, выводить в несколько строк текст и другое.

procedure TFormHistory.ListHistoryDrawCell(Sender: TObject; Col, Row: Integer;
          Rect: TRect; State: TGridDrawState);
var
  S: string;
  DrawRect: TRect;
  CurrentColor: TColor;
begin
  // Определяем цвет строки в зависимости типа Imcoming
  if (Sender as TStrinGgrid).Cells[COLUMN_INCOMING , Row ] = '1' then
    CurrentColor:=clBlue
  else
    CurrentColor:=clMaroon;
  if (Sender as TStrinGgrid).Row = Row then
    CurrentColor := clHighlightText;
  (Sender as TStrinGgrid).Canvas.font.color := CurrentColor;
  S:= (Sender as TStrinGgrid).Cells[ Col, Row ];
  if (Col = COLUMN_MESSAGE ) and (Row <> ROW_HEADER) then
  begin
    if Length(S) > 0 then
    begin
      DrawRect:=Rect;
      DrawText((Sender as TStrinGgrid).Canvas.Handle, Pchar(S), Length(S),
      DrawRect, dt_calcrect or dt_wordbreak or dt_left );
      if (DrawRect.bottom - DrawRect.top) > (Sender as TStrinGgrid).RowHeights[Row] then
        (Sender as TStrinGgrid).RowHeights[row] :=(DrawRect.bottom - DrawRect.top)
      else
      begin
        DrawRect.Right:=Rect.Right;
        (Sender as TStrinGgrid).Canvas.FillRect( DrawRect );
        DrawText((Sender as TStrinGgrid).Canvas.Handle, Pchar(S),
                  Length(S), DrawRect, dt_wordbreak or dt_left);
      end;
    end;
  end
  else
    if Row <> ROW_HEADER then
      (Sender as TStrinGgrid).Canvas.Textout(rect.left+3, rect.top+3 , S );
end;

Оценка за ответ: 5.

5. [Отвечает: Антон Трапезников (статус: Студент), 30.01.2006 16:15]: Нижеприведенный код вставит изображение в одну из ячеек StringGrida

Такое позволяет обработчик события OnDrawCell.

with StringGrid1.Canvas do
begin
{...}
Draw(Rect.Left, Rect.Top, Image1.Picture.Graphic);
{...}
end;

Достичь цели позволяют методы Draw() и StretchDraw() объекта TCanvas. В приведенном примере переменная Image1 класса TImage содержит заранее загруженное изображение.

Для раскрашивания снова использется событие "OnDrawCell". Следующий код показывает, как сделать в Grid красный бэкраунд. Бэкграунд второй колонки будет зелёным.

procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
const //здесь определяем Ваш цвет. Так же можно использовать цвета по умолчанию.
  clPaleGreen = TColor($CCFFCC);
  clPaleRed = TColor($CCCCFF);
begin
  //Если ячейка получает фокус, то нам надо закрасить её другими цветами
  if (gdFocused in State) then
  begin
    StringGrid1.Canvas.Brush.Color := clBlack;
    StringGrid1.Canvas.Font.Color := clWhite;
  end
  else //Если же ячейка теряет фокус, то закрашиваем её красным и зелёным
    if ACol = 2 then //Вторая колонка будет зелёной , другие - ячейки красными
      StringGrid1.Canvas.Brush.color := clPaleGreen
    else
      StringGrid1.canvas.brush.Color := clPaleRed;

  //Теперь закрасим ячейки, но только, если ячейка не Title- Row/Column
  //Естественно это завит от того, есть у Вас title-Row/Columns или нет.

  if (ACol > 0) and (ARow > 0) then
  begin
    //Закрашиваем бэкграунд
    StringGrid1.Canvas.FillRect(Rect);

    //Закрашиваем текст (Text). Также здесь можно добавить выравнивание и т.д..
    StringGrid1.Canvas.TextOut(Rect.Left, Rect.Top, StringGrid1.Cells[ACol, ARow]);
  end;
end;

Если Вы захотите чтобы цвет ячеек менялся в зависимости от значения в них, то можно заменить 3 линии (if Acol = 2 ......) на что-нибуть вроде этого

if StringGrid1.Cells[ACol, ARow] = 'highlight it' then
  StringGrid1.Canvas.Brush.color := clPalered
else
  StringGrid1.canvas.brush.Color := clWhite;

Оценка за ответ: 5.

6. [Отвечает: Деревянко Евгений (статус: Эксперт: 5-ый класс), 30.01.2006 20:13]: Следует напистать обработчик для события OnDrawCell грида. Что-то типа:

procedure TForm1.StringGrid1DrawCell(
  Sender: TObject;         // на каком компоненте производится рисовние
                           // (собственно сам стринггрид)
  ACol, ARow: Integer;     // какая ячейка рисуется
  Rect: TRect;             // границы ячейки на канвасе
  State: TGridDrawState);  // состояние данной ячейки
begin
if ((ARow = 1) and (ACol <> 0)) or ((ACol = 1) and (ARow<>0)) then
    begin
    TStringGrid(Sender).Canvas.Pen.Color := clMaroon;
    TStringGrid(Sender).Canvas.Pen.Width := 2;
    TStringGrid(Sender).Canvas.Rectangle(Rect.Left+2,Rect.Top+2,Rect.Right-2,Rect.Bottom-2);
    TStringGrid(Sender).Canvas.TextOut(Rect.Left+4,Rect.Top+4,TStringGrid(Sender).Cells[ACol,ARow]);
    end;
end;

Таким образом можно нарисовать всё что угодно. Если надо перерисовать все ячейки грида, то следует установить DefaultDrawing грида в False.

Оценка за ответ: 5.

7. [Отвечает: Zeon (статус: Эксперт: 4-ый класс), 31.01.2006 12:46]: Используй DrawGrid:

1) Создаёшь ImageList, пихаешь туда нужные рисунки, такого же размера как размер ячейки DrawGrid.

2) В обработчике событий OnDrawCell компонента DrawGrid пишешь:

  procedure TForm1.DrawGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
   Rect: TRect; State: TGridDrawState);
  begin
    ImageList1.Draw(DrawGrid1.Canvas, Rect.Left, Rect.Top, <порядковый
    номер сисунка в списке ImageList(начиная с нуля)>, True);
  end;

Оценка за ответ: 5.

Все вопросы и ответы на них Вы всегда можете найти на нашем сайте в разделе "Delphi-Эксперт".

Из данного раздела Вы можете скачать различные файлы: компоненты, plug-in'ы для Delphi, документацию по программированию, программы, игры, написанные на Delphi и всё остальное... Вы можете добавить свои файлы в данный раздел. Чтобы сделать это, пожалуйста, заполните форму на сайте.

Новые файлы на сайте:

Название / описание файла		Категория	Объём	Ссылки
Пример работы с базой данных Access из программы.		Исходники	15.7 Кб	Загрузить
Пример программы, распечатывающей содержимое формы на принтере.		Исходники	2.20 Кб	Загрузить
Netloads - Простая программа для загрузки файлов из сети.		Исходники	4.90 Кб	Загрузить
NetTrafMonitor - Программа, подсчитывающая время использования соединения, объём трафика и т.п.		Исходники	49.9 Кб	Загрузить
Multimedia Box - Медиа-проигрыватель. Воспроизводит все самые ходовые форматы, даже DVD. При работе с DVD-Video есть небольшой глюк, но в целом программа работоспособна.		Исходники	49.3 Кб	Загрузить
FTP Server - Исходник FTP-клиента.		Исходники	16.4 Кб	Загрузить
	IETuner - Программа для тех, кто экономит свой входящий трафик любыми способами. IE Tuner отключает графику и flash-баннеры на интернет-страницах в бразуере Internet Explorer. Автор: LanKasper	Программы	448 Кб	Загрузить

Чтобы перейти к разделу "Файловый архив" на сайте, нажмите на эту ссылку.

Здесь представлены ссылки на дружественные сайты. Обмен ссылками и баннерами всегда приветствуется. Здесь представлены самые последние ссылки:

Юмор.

После распоряжения по фирме об ужесточении контроля за посещением веб-сайтов выяснилось, что наиболее посещаемым сайтом с большим отрывом оказался rabota.ru.

:))

Объявлен конкурс в Москве на строительство супермаркета. Ищут подрядчиков. Сидит управляющий и выслушивает предложения.
Первым заходит турок.
- Вы ознакомились с проектом?
- Да.
- И за какую сумму готовы построить?
- За 1 млн. долларов.
- Хорошо, спасибо, мы рассмотрим ваше предложение.
Затем заходит немец:
- Назовите вашу цену за строительство.
- 2 млн. долларов!
- А почему так много?
- Качество исполнения плюс сроки!
Заходит русский:
- За какую цену вы готовы построить?
- 3 млн. долларов!
- А почему так много-то!?
- Ну как почему. 1 миллион мне, 1 миллион – тебе, и за 1 миллион турки построят.

:))

- Как тpи пpогpаммиста могyт оpганизовать бизнес?
- Один пишет виpyсы, а дpyгой антивиpyсы.
- А тpетий?
- Опеpационные системы, под котоpыми это все pаботает!

:))

А теперь немного о погоде:
- В Японии средняя температура сегодня составила +27 градусов по цельсию. Максимальная температура в этот день была в 1945 году, она составила +850 градусов по цельсию.

:))

Присылайте свои анекдоты по этой ссылке: info@delphi.int.ru и они обязательно будут опубликованы. Желательно на компьютерную тему.

Наши реквизиты в системе WebMoney: R379291065219, Z165075684614.