Оглавление JPEG-картинки в качестве кнопок и фона формы (пример)

В задании (по компьютерным сетям) требовалось разработать SMTP-Client.
Студент Р.Орел применил оригинальный интерфейс, показанный на этой страничке.

Текст модуля (см ниже) содержит необходимые комментарии. 

// Этот проект разработал в 2006 г студент 4-го курса
// факультета "Компьютерные технологии и автоматизированные системы"
// КубГТУ (г. Краснодар) Орёл Роман.
// Проект имеет оригинальный интерфейс:
// Форма и кнопки выполнены как рисунки .jpeg,
// причем кнопки - в виде компонентов TImage. Для работы кнопок
// используются обработчики событий MouseDown и MouseUp.
// Здесь сохранен только интерфейс, остальное (работа в сети) будет показано,
// если будет добавлен раздел о компьютерных сетях
// (если кому-то нужно это уже сейчас - пишите)

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls, jpeg, ExtDlgs;

type
  TForm1 = class(TForm)
    SubjectEdit: TEdit;
    FromEdit: TEdit;
    HostEdit: TEdit;
    LoginEdit: TEdit;
    PasswordEdit: TEdit;
    ListAddr: TListBox;
    reMessageText: TRichEdit;
    ListLog: TListBox;
    NameEdit: TEdit;
    PortEdit: TEdit;
    Image1: TImage;
    AddImage: TImage;
    FindImage: TImage;
    DeleteImage: TImage;
    SendImage: TImage;
    ComboBox: TComboBox;
    Label1: TLabel;
    Label2: TLabel;
    procedure SendImageMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure SendImageMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure DeleteImageMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure DeleteImageMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FindImageMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FindImageMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure AddImageMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure AddImageMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
  private
    FileName:String;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
implementation

{$R *.dfm}

//1	При создании формы выполняем следующие действия
procedure TForm1.FormCreate(Sender: TObject);
begin
// Загружаем список сохраненных ранее адресов
  FileName := ChangeFileExt (Application.ExeName, '.txt');
  ListAddr.Items.LoadFromFile (FileName);
  ListLog.Items.Add ('Addresses: ' + IntToStr (ListAddr.Items.Count));
  // select the first item
  ListAddr.ItemIndex := 0;
end;

//2	При закрытии формы выполняем следующие действия
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
// Сохраняем лист адресов
  ListAddr.Items.SaveToFile (FileName);
end;

//3	При активизации IdSMTPClient выполняем следующие действия
//4	При начале посылки IdSMTPClient'ом выполняем следующие действия
//5	При начале завершении посылки IdSMTPClient'ом выполняем следующие действия

//6	При нажатии на кнопку "Добавить" выполняем следующие действия
procedure TForm1.AddImageMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
AddImage.Picture.LoadFromFile('add_down.jpg');//Перегружаем картинку
ListAddr.ItemIndex:=ListAddr.Items.Add(NameEdit.Text);
//Добавляем адрес из строки адреса в список контактов
end;

//7	При отпускании кнопки "Добавить" выполняем следующие действия
procedure TForm1.AddImageMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
AddImage.Picture.LoadFromFile('add_normal.jpg');//Перегружаем картинку
end;

//8	При нажатии на кнопку "Найти" выполняем следующие действия
procedure TForm1.FindImageMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  I:Integer;//счетчик для цикла
begin
	FindImage.Picture.LoadFromFile('find_down.jpg');//Перегружаем картинку
	for I:=0 to ListAddr.Items.Count-1 do//...
		if Pos (NameEdit.Text,ListAddr.Items[I])>0 then//...
			begin//...
			ListAddr.ItemIndex:=I;//Добавили позицию
			Break;
			end;
	Beep;//попищали
end;

//9	При отпускании кнопки "Найти" выполняем следующие действия
procedure TForm1.FindImageMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 FindImage.Picture.LoadFromFile('find_normal.jpg');//Перегружаем картинку
end;

//10	При нажатии на кнопку "Удалить" выполняем следующие действия
procedure TForm1.DeleteImageMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
DeleteImage.Picture.LoadFromFile('delete_down.jpg');//Перегружаем картинку
// копируем запись в nameedit и при надобности стираем или редактируем
NameEdit.Text:=ListAddr.Items[ListAddr.ItemIndex];
ListAddr.Items.Delete(ListAddr.ItemIndex);
end;

//11	При отпускании кнопки "Удалить" выполняем следующие действия
procedure TForm1.DeleteImageMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 DeleteImage.Picture.LoadFromFile('delete_normal.jpg');//Перегружаем картинку
end;

//12	При нажатии на кнопку "Послать" выполняем следующие действия
procedure TForm1.SendImageMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
	SendImage.Picture.LoadFromFile('send_down.jpg');//Перегружаем картинку
end;

//13	При отпускании кнопки "Послать" выполняем следующие действия
procedure TForm1.SendImageMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
  var
  nItem:Integer;
  Res:Word;
begin
	SendImage.Picture.LoadFromFile('send_normal.jpg');//Перегружаем картинку
	if ComboBox.ItemIndex=0 then
        //Если выбран режим использования SMTP-компонента,то делаем
		begin
			//Выводим окно для подверждения указанного адреса
			Res:=MessageDlg('Начать отправку элемента '+
			IntToStr(ListAddr.ItemIndex)+' ('+
			ListAddr.Items[ListAddr.ItemIndex]+')?'#13 +
			'(Не начинать с 0)',mtConfirmation,
			[mbYes,mbNo,mbCancel],0);
			if Res=mrCancel then
			Exit;
			if Res=mrYes then
			nItem:=ListAddr.ItemIndex
			else
			nItem:=0;

			//соединение SMTP-клиента с сервером
			ListLog.Items.Add('Connected to host'+HostEdit.Text);
                         //соответствующее сообщение в лог-листе
			try
			//устанавливаем фиксированную часть заголовка
			Application.ProcessMessages;
                         //показываем в списке контактов выбранного адресата
			ListAddr.ItemIndex:=nItem;
     //посылаем пакет
			finally
      //отсоединяемся
			ListLog.Items.Add('Disconnected from host'+HostEdit.Text);
       //соответствующее сообщение лог-листа
			end;
		end
	else//если выбран режим соединения через IdTCPClient
		begin
			//то же, что и с SMTP
			Res:=MessageDlg('Начать отправку элемента '+
			IntToStr(ListAddr.ItemIndex)+' ('+
			ListAddr.Items[ListAddr.ItemIndex]+')?'#13 +
			'(Не начинать с 0)',mtConfirmation,
			[mbYes,mbNo,mbCancel],0);
			if Res=mrCancel then
			Exit;
			if Res=mrYes then
			nItem:=ListAddr.ItemIndex
			else
			nItem:=0;
			//производим соединение
	{		TCP.Host:=HostEdit.Text; }
			ListLog.Items.Add('Connected to host'+HostEdit.Text);
                        //соответствующее сообщение лог-листа
			try//начинаем посылать стандартные SMTP-команды
		{	TCP.IOHandler.WriteLn('HELO '+HostEdit.Text);
      //Запрос на установление соединения}
			Application.ProcessMessages;
			ListAddr.ItemIndex:=nItem;
			finally
	 //		TCP.Disconnect;//отсоединяемся
			ListLog.Items.Add('Disconnected from host'+HostEdit.Text);
			end;
		end;
	end;
end.
Скачать RAR-архив проекта + .exe(0.73 Mб)
Rambler's Top100
Hosted by uCoz