[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.