отображение jpg в delphi

[Ivan XXX]

надо из папки с изображениями вывести на экран превьюхи...
кол-во файлов может меняца.
канвас выводит только в области видимости... соотв когда изображений много, отрезает те, кот не поместились...
может кто знает нормальное решение?

[Ivan XXX]

такой вопрос:
как в DrawGrid какой-либо ячейке присвоить jpg изображение?

[Yandex]

Спроси лучше тут
http://forum.sources.ru/index.php?showforum=9
Или скачай FAQ от сюда - www.drbk.ru (~10мб)
Ниже оттуда ответ на 2-ой вопрос.

по поводу 1-го - тупо грузить jpg и уменьшать их в pазмеpe - это коpяво , т.к. фоpмат jpg определяет хранение превью [миникопии изображения] в самом файле - работать будет намного быстрее. Как сделать конкретно понятия не имею - особо не заморачивался, мож есть какой компонент - глянь на torry.net
========================================
Как поместить графическое изображение в TDBGrid
Использование свойства Canvas компонента TDBGrid в методе OnDrawColumnCell позволяет не только выводить в ячейке текст методом TextOut, но и размещать в ячейках графические изображения. В этом случае используется метод Draw свойства Canvas.

Модифицируем наш пример, добавив в форму компонент TImageList и поместив в него несколько изображений.

Модифицируем код нашего приложения:
Соответствующий код для Delphi имеет вид:

procedure TForm1.DBGridDrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState);
var
Im1: TBitmap;
begin
Im1 := TBitmap.Create;
if Column.FieldName = 'VenueNo' then
with DBGrid1.Canvas do
begin
Brush.Color := clWhite;
FillRect(Rect);
if Table.FieldByName('VanueNo').Value = 1 then
ImageList1.GetBitmap(0, Im1)
else
ImageList1.GetBitmap(2, Im1);
Draw(round((Rect.Left + Rect.Right - Im1.Width) / 2), Rect.Top, Im1);
end;
end;

Теперь в TDBGrid в колонке VenueNo находятся графические изображения.

[Ivan XXX]

канвас не присваивает каждой ячейке по картинке, а просто рисует поверх. при скроллинге вниз/вверх изображение пропадает.

задача вобще такая:
при нажатии на одну кнопку, отобразить все изображения из одной папки
при нажатии на другую - из другой.

поиск файлов реализован, пути записаны в массив... а вот с выводом проблемы...

[Yandex]

Гы, а ты думаешь у каждой ячейки свой канвас? - это самому Pучками надо навеpно (точно не знаю - с VCL мало знаком). Да и pешение выводить каpтинки в DBГpид споpно, лучше уж какой-нить ListView заюзать.

А вообще мона динамически создавать TImaЖe-и с pодителем Form1 и выводить в них каpтинки

[Ivan XXX]

Yandex, была такая идея... только вот как с динамическими image и всем прочим работать? как их объявить и пр и пр...

Сообщение от Yandex

Гы, а ты думаешь у каждой ячейки свой канвас?

как раз не думаю...

[Ray79]

Эта класс где картинки фармируются

unit ImageText;

interface

uses
Windows, Messages, SysUtils, Classes, Controls, ExtCtrls, QStdCtrls,
Graphics, JPEG, StdCtrls, Preview;

const
Space = 10; // Расстояние между объектами
FontSize = 8; // Размер шрифта
TextHeight = 16; // Высота надписей

type
// Описание класса TImageText
TImageText = class(TControl)
private
// Поле для хранения ID
ID : Integer;
// Объект для хранения фотографии
jpg : TJpegImage;
// Объект для отображения фотографии
Image : TImage;
// Объект для отображения ФИО
FText : TStaticText;
// Объект для отображения статуса
SText : TStaticText;
protected
function R_Top : Integer;
function R_Left : Integer;
function R_Width : Integer;
function R_Height : Integer;
//---->
procedure W_Top (Value: Integer);
procedure W_Left (Value: Integer);
procedure W_Width (Value: Integer);
procedure W_Height (Value: Integer);
//---->
procedure W_Photo (Value: TJpegImage);
procedure W_Fio (Value: String);
procedure W_Status (Value: String);
public
constructor Create (Value: Integer);
destructor Destroy;
procedure Show (AOwner: TWinControl);
procedure LClick (Sender: TObject);
procedure RClick (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
published
// Координаты и размеры объекта TImageText
property Top : Integer read R_Top write W_Top;
property Left : Integer read R_Left write W_Left;
property Width : Integer read R_Width write W_Width;
property Height : Integer read R_Height write W_Height;
// Поля для хранения фотографии, ФИО и статуса посетителя
property Photo : TJpegImage write W_Photo;
property FIO : String write W_Fio;
property Status : String write W_Status;
end;

implementation

uses main_rec;

///////////////////////////////////////////////////////////////////
// КЛАСС TImageText //
///////////////////////////////////////////////////////////////////

// Конструктор класса TImageText

constructor TImageText.Create (Value: Integer);
begin
Image := TImage.Create(nil);
FText := TStaticText.Create(nil);
SText := TStaticText.Create(nil);
//---->
Image.Name := 'IM';
FText.Name := 'ST';
SText.Name := 'ST';
//---->
FText.Height := TextHeight;
SText.Height := TextHeight;
FText.Font.Size := FontSize;
SText.Font.Size := FontSize;
//---->
ID := Value;
jpg := TJpegImage.Create;
Image.OnDblClick := LClick;
Image.OnMouseUp := RClick;
end;

// Деструктор класса TImageText

destructor TImageText.Destroy;
begin
Image.Free;
FText.Free;
SText.Free;
end;

// Функция для чтения верхней координаты компонента

function TImageText.R_Top : Integer;
begin
Result := Image.Top;
end;

// Функция для чтения левой координаты компонента

function TImageText.R_Left : Integer;
begin
Result := Image.Left;
end;

// Функция для чтения ширины компонента

function TImageText.R_Width : Integer;
begin
Result := Image.Width;
end;

// Функция для чтения высоты компонента

function TImageText.R_Height : Integer;
begin
Result := Image.Height + 2*(TextHeight + Space);
end;

// Процедура для записи верхней координаты компонента

procedure TImageText.W_Top (Value: Integer);
begin
Image.Top := Value;
FText.Top := Image.Top + Image.Height;
SText.Top := FText.Top + FText.Height;
end;

// Процедура для записи левой координаты компонента

procedure TImageText.W_Left (Value: Integer);
begin
Image.Left := Value;
FText.Left := Value;
SText.Left := Value;
end;

// Процедура для записи ширины компонента

procedure TImageText.W_Width (Value: Integer);
begin
Image.Width := Value;
FText.Width := Value;
SText.Width := Value;
end;

// Процедура для записи высоты компонента

procedure TImageText.W_Height (Value: Integer);
begin
Image.Height := Value - 2 * TextHeight;
FText.Top := Image.Top + Image.Height;
SText.Top := FText.Top + FText.Height;
end;

// Процедура отображения фотографии

procedure TImageText.W_Photo (Value: TJpegImage);
var
Bmp : TBitMap;
begin
jpg := Value;
Bmp := TBitMap.Create;
Bmp.Assign(Value);
Image.Canvas.StretchDraw(Image.ClientRect, Bmp);
Bmp.Free;
end;

// Процедура отображения ФИО

procedure TImageText.W_Fio (Value: String);
begin
FText.Caption := Value;
end;

// Процедура отображения статуса

procedure TImageText.W_Status (Value: String);
begin
if Trim(Value) = 'Black List' then
SText.Font.Color := clRed;
if Trim(Value) = 'Member' then
SText.Font.Color := clBlack;
if Trim(Value) = 'Silver' then
SText.Font.Color := clNavy;
if Trim(Value) = 'Gold' then
SText.Font.Color := clYellow;
if Trim(Value) = 'Staff' then
SText.Font.Color := clBlack;
SText.Caption := Value;
end;

// Процедура отображения компонента TImageText

procedure TImageText.Show (AOwner: TWinControl);
begin
Image.Parent := AOwner;
FText.Parent := AOwner;
SText.Parent := AOwner;
end;

// Обработка двойного клика мыши на объекте

procedure TImageText.LClick (Sender: TObject);
begin
with MainForm do
begin
ReceptionQuery.Close;
ReceptionQuery.SQL.Clear;
ReceptionQuery.SQL.Add('SELECT * FROM RECEPTION WHERE ID_KEY = ' + IntToStr(ID));
ReceptionQuery.Open;
RecPageControl.ActivePageIndex := 0;
end;
end;

// Обработка нажатия правой и левой клавиши мыши

procedure TImageText.RClick (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
x1, x2, x3, x4, y1, y2, y3, y4 : integer;
begin
if Button = mbLeft then
begin
MainForm.BorderDel;

x1 := 0;
y1 := 0;
x2 := x1 + Image.Width;
y2 := y1;
x3 := x1;
y3 := y1 + Image.Height;
x4 := x2;
y4 := y3;

Image.Canvas.Pen.Color := clRed;
Image.Canvas.Pen.Width := 5;
Image.Canvas.Polyline([Point(x1, y1), Point(x2, y2), Point(x4, y4), Point(x3, y3), Point(x1, y1)]);
end;

if Button = mbRight then
begin
View := TPreview.Create(nil);
View.PhotoTrans.Active := False;
View.PhotoTrans.Active := True;
View.PhotoQuery.Close;
View.PhotoQuery.SQL.Clear;
View.PhotoQuery.SQL.Add('SELECT PHOTO FROM RECEPTION WHERE ID_KEY = ' + IntToStr(ID));
View.PhotoQuery.Open;
View.PhotoQuery.FetchAll;
View.PhotoQuery.First;
if View.PhotoQueryPHOTO.BlobSize > 1
then Jpg.Assign(View.PhotoQueryPHOTO);
View.ShowPreview(jpg);
View.ShowModal;
end;
end;

end.

[Ray79]

Эта так картинки рисуются ручками

// Процедура выбора размеров фотографии

procedure TMainForm.RadioGroup1Click(Sender: TObject);
begin
case RadioGroup1.ItemIndex of
0: begin
W := 350;
H := 350;
CreateGallery;
end;
1: begin
W := 230;
H := 230;
CreateGallery;
end;
2: begin
W := 170;
H := 170;
CreateGallery;
end;
3: begin
W := 135;
H := 135;
CreateGallery;
end;
4: begin
W := 110;
H := 110;
CreateGallery;
end;
end;
end;

// Процедура отрисовки одной фотографии

procedure TMainForm.CreatePhoto (var X, Y: integer; P: TJpegImage; F, S: String; ID: Integer);
var
IT : TImageText;
begin
IT := TImageText.Create (ID);
//---->
IT.Top := X;
IT.Left := Y;
IT.Width := W;
IT.Height := H;
//---->
IT.Photo := P;
IT.FIO := F;
IT.Status := S;
//---->
IT.Show(ScrollBox1);
end;

// Процедура отрисовки галереи

procedure TMainForm.CreateGallery;
var
T, L, CountNumber : Integer;
begin
CountNumber := 0;
DestroyGallery;
L := Space;
T := Space;
DataModule1.TodayShow.Last;
while not DataModule1.TodayShow.Bof do
begin
inc (CountNumber);
if DataModule1.TodayShowPHOTO.BlobSize > 1 then
Jpg.Assign(DataModule1.TodayShowPHOTO);
CreatePhoto (T, L, Jpg, Trim(DataModule1.TodayShowFAMILY.AsString) + ' ' +
Trim(DataModule1.TodayShowNAME.AsString),
DataModule1.TodayShowNAME1.AsString,
DataModule1.TodayShowID_KEY.AsInteger);
if (L + W + Space) < (ScrollBox1.Width - Space - W) then
begin
L := L + W + Space;
end
else
begin
L := Space;
T := T + H + Space;
end;
DataModule1.TodayShow.Prior;
if CountNumber >= Number then Break;
end;
BorderDel;
end;

// Процедура уничтожения галереи

procedure TMainForm.DestroyGallery;
var
i : Integer;
begin
for i := (ScrollBox1.ControlCount-1) DownTo 0 do
if ScrollBox1.Controls[i].Name = 'IM'
then (ScrollBox1.Controls[i] as TImage).Free
else (ScrollBox1.Controls[i] as TStaticText).Free;
end;

[Yandex]

Монстp!!!
Что же ты ему всю пpогу не написал?

2 Ivan XXX
> с динамическими image и всем прочим работать? как их объявить и пр и пр...
А слабо книгу по DelpНi почитать? (хотя и FAQ на котоpый я ccылку дал пойдет - там это есть).

Вообще то что то в духе
var
imgs = array of TImagе;
...
SetLengtН (imgs, <#каpтинок>);
for i := 0 to <#каpтинок> - 1 do
begin
imgs[i] := TImage.Create (Form1);
imgs.НeigНt := ...
imgs.WidtН := ...
...
end;

[Kerish]

Ни хрена себе...Столько знатоков недоязыка Delphi...

[Ray79]

Сообщение от Kerish

Ни хрена себе...Столько знатоков недоязыка Delphi...

Недоязык говоришь? Ню-ню, а вот тебе цитатка

Сообщение от Kerish

Luke Просто уже задрала пропоганда языков во всех темах.

[Kerish]

А я разве пропагандирую какой-то язык?

[darkart]

недоязыка Delphi...

Аргументы?

[Kerish]

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

[darkart]

В ПС не аргумент. Задача программиста, как раз и состоит в выборе средств и методов решения задачи. И если выбор не верен, то проблема вовсе не в языке, а в голове.

нормальных языков программирования

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

[phasma]

Kerish, лол ))) скажи ты на брэйнфаке пишешь ???)))

[Kerish]

darkart, Согласен с последней репликой в сообщении.
phasma, Нет.

[phasma]

Kerish, ну тогда значит на машинном коде пишешь, рас называешь Delphi "недоязыком" ???)))

[aerin]

darkart

Задача программиста, как раз и состоит в выборе средств и методов решения задачи.

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

[darkart]

aerin, к примеру,
согласитесь что для написания баз данных глупо выбирать asm. К тому же и фирмам наверное будет не выгодно использовать средства, которые тормозят разработку ПО, время - деньги знаете ли.

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

TRUE;

[aerin]

darkart
Совещание в конторе "Рога и копыты", занимающейся разработкой ПО на базе какой-то БД под ключ. Поступил новый заказ. Начальник: "на чем будем писать?" Начальник одного из отделов: "Мошт на asm-е?" Второй: "Не, давай на жабе, этож самая прогрессивная технология, епте"
Вы это так себе представляете?
Реально я вижу по поделкам некоторых российских фирм, не будем показывать пальцем, что средства разработки меняются не по соображениям целесообразности, а по причине увольнения старой команды девелоперов и набора новых сотрудников, принесших с собой новые веяния. Например, в истории с фискальными регистраторами переход от Меркуриев к Штрихам - это откровенная деградация.

согласитесь что для написания баз данных глупо выбирать asm.

Для написания оболочек БД, да, глупо. Для написания критичных к скорости мест движка БД, отнюдь. Мало того, под разные процессоры один и тот же софт могут писать разные команды.
Как бы там ни было, сейчас в области написания софта, глобально, C/C++ - это индустриальный стандарт. И никто ничего не выбирает.
Есть специфические задачи, которые решаются другими языками, вплоть для скриптовых тип Lua, но это не отменяет первое необходимое условие.

[darkart]

Ну, во-первых я согласился с

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

Во-вторых, зачастую заказчик не знает, что в действительности хочет и приходится объяснять +/- различных вариантов решения проблемы.

[aerin]

darkart
А зачем вообще заказчику знать про какие-то языковые среды? Ему нужна работающая софтина, желательно безглючно, желательно со стандартным интерфесом, чтоб юзверей не пугать. А на чем это дело написано - вопрос десятый. Хотя есть другая сторона медали, если в смете будет указана стоимость ораклового сервака с кучей клиентских лицензий и оплаченной поддержкой на десять лет вперед, то, возможно, это и подвигнет заказчика на более пристальное рассмотрение используемых технологий
ЗЫ. Но я говорил о другом, если у кого-то возникнет мысль зарабатывать на хлеб с маслом написанием софта, то начать следует с C/C++, бо без этого никуда...

[Balrog]

Ну что, начинается очередная священная война? Осеннее обострение, шумящее в автофоруме, и до этого болота добралось?

Если серьёзно - для неспецифичных задач (как-то интернет-проекты, запросы к субд и т.п.) C/C++ действительно достаточен, гибок и удобен. Дельфи, как и VB - непонятная попытка достичь тех же возможностей в другом синтаксисе. До сих пор ни один не достиг, преимуществ над C/C++ нет - так что я до сих пор не понимаю, на кой весь этот сыр-бор.

[zss_vrn]

Сообщение от Balrog

До сих пор ни один не достиг, преимуществ над C/C++ нет - так что я до сих пор не понимаю, на кой весь этот сыр-бор.

Преимущества есть- меньшая требовательность к квалификации программистов.

[phasma]

zss_vrn, требовательность к квалификации не изменится ... легкость изучения языка и скорость разработки преимущества Delphi ...

[aerin]

скорость разработки преимущества Delphi ...

Это миф. В серьезном проекте рисование интерфейса занимает мизерную часть времени. Все остальное быстрее написать на нормальном языке.

[Ray79]

Сообщение от aerin

Это миф. В серьезном проекте рисование интерфейса занимает мизерную часть времени. Все остальное быстрее написать на нормальном языке.

Нунискажи. Проекты разные бывают. А по мне вабсче этот базар пофиг. Я исчо не видел задач, которые можно решить ТОЛЬКО на Си. Все эти споры от кривых рук, и не более того. Видели бы вы извраты Х++, вабсче здохли бы. А оказывается и на этом писать можно

[phasma]

aerin, ну серьезные проекты никто на Delphi писать не будет ... хотя можно свободно создать окошечки на делфи, а какие-то вычислительные операции вкоючить в DLL, и использовать их уже из GUI на Delphi ...

[aerin]

<Весеннее обострение >
Ray79

Я исчо не видел задач, которые можно решить ТОЛЬКО на Си.

- А можно...?
- Конечно можно, только зачем?

Все эти споры от кривых рук, и не более того.

Адназначна!
phasma

хотя можно свободно создать окошечки на делфи, а какие-то вычислительные операции вкоючить в DLL, и использовать их уже из GUI на Delphi ...

Тоже можно, а зачем?
</Весеннее обострение >