Большой Воронежский Форум Mobile

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

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.

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

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

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;