Новичок
Профиль
Группа: Участник
Сообщений: 12
Регистрация: 11.2.2008
Репутация: нет
Всего: 1
|
Есть у меня макрос для Word для создания курсовых и рефератов. Написан он на VBA, немного я его переделал на Delphi. И предлагаю использовать в программе при создании книг с текстами песен. | Код |
private
{ Private declarations }
// Основные свойства формируемого документа
FDocumentType: String; // Диплом или Реферат
// Институт, группа и все остальные сведения
FInstitution: String; // Учебное заведение
FFaculty: String; // Факультет
FCourse: String; // Курс
FGroup: String; // Группа
FBranch: String; // Кафедра
FSubject: String; // Учебная дисциплина
FTutor: String; // Учитель
FTitle: String; // Тема работы
FAuthor: String; // Автор
FCity: String; // Город
FYear: String; // Год
// Флаги необходимости введение, заключения и списка источников
FIntroduction: Boolean; // Введение
FSummary: Boolean; // Заключение
FSourceList: Boolean; // Список источников
procedure InitializeProperties; // тестовая инициализация свойств
// !!! ПРОБЛЕМА !!! Вызов Application.CentimetersToPoints почему-то
// приводит сообщению "Неопознанная ошибка",
// поэтому реализуем эту функцию самостоятельно
function CentimetersToPoints(Centimeters: Real): Real;
procedure CreateTopic(ADocument: OleVariant; ACaption: String; ALevel: Integer;
AText: String = '');
private
procedure CreateTable(ADocument: OleVariant);
procedure CreateTableOfContents(ADocument: OleVariant);
procedure CreateContent(ADocument: OleVariant);
procedure CreateTitle(ADocument: OleVariant);
procedure UpdateTableOfContents(ADocument: OleVariant);
public
{ Public declarations }
// constructor Create(AOwner: TComponent); override;
end;
var
Form2: TForm2;
implementation
uses unit1, ComObj ;
{$R *.dfm}
{**} CONST {*******************************************************************}
// Служебные константы
//documentDiploma = 'диплом';
//documentEssay = 'реферат';
topicText = 'Здесь Вы можете начать создавать главу, параграф, подпункт... Удачи и творческих успехов!';
CRLF = #13#10;
{**} CONST {*******************************************************************}
// Основные константы, используемые Word,
wdAlignParagraphLeft = 0;
wdAlignParagraphCenter = 1;
wdAlignParagraphRight = 2;
wdAlignParagraphJustify = 3;
wdCellAlignVerticalCenter = 1;
wdLineStyleNone = 0;
wdRowHeightExactly = 2;
wdAdjustNone = 0;
wdUnderlineNone = 0;
wdUnderlineSingle = 1;
wdFieldTOC = 13;
wdFieldPage = 33;
wdFieldDocProperty = 85;
wdFieldEmpty = -1;
wdCollapseEnd = 0;
wdDoNotSaveChanges = 0;
wdHeaderFooterPrimary = 1;
function TForm2.CentimetersToPoints(Centimeters: Real): Real;
const
PointsInCentimeter = 28.25;
begin
Result := Centimeters * PointsInCentimeter;
end;
{
constructor TForm2.Create(AOwner: TComponent);
begin
inherited;
InitializeProperties;
end;
}
procedure TForm2.CreateContent(ADocument: OleVariant);
var
X: integer;
A: integer;
B: integer;
begin
// Собственно, создаем основное содержимое документа
// Введение
if FIntroduction then begin
CreateTopic(ADocument, 'Введение', 1, 'Здесь может быть ваше введение');
end;
// Заключение
if FSummary then begin
CreateTopic(ADocument, 'Заключение', 1, 'Некоторый текст заключения');
end;
for X := 0 to OGLAVL.Items.Count - 1 do begin
CreateTopic(ADocument, OGLAVL.Items[x], 1);
for A := 0 to TeListBox1.Items.Count - 1 do begin
CreateTopic(ADocument, TeListBox1.Items[A], 2);
for B := 0 to TeListBox2.Items.Count - 1 do begin
CreateTopic(ADocument, TeListBox2.Items[B], 3);
// Список источников
if FSourceList then begin
CreateTopic(ADocument, 'Список использованных источников', 3,
'Здесь необходимо указать список всех использованных источников');
end;
end;
end;
end;
end;
procedure TForm2.CreateTable(ADocument: OleVariant);
var
TableRange: OleVariant;
I, Cnt: Integer;
Paragraph: OleVariant;
begin
// Создаем таблицу, содержащую 7 строк, в каждой из которых содержится
// одна ячейка
ADocument.Tables.Add(ADocument.Application.Selection.Range, 7, 1);
// Для дальнейших операций нам понадобится объект Range таблицы
TableRange := ADocument.Tables.Item(1).Range;
// Устанавливаем горизонтальное выравнивание по центру
TableRange.ParagraphFormat.Alignment := wdAlignParagraphCenter;
// Устанавливаем вертикальное выравнивание в ячейках по центру
TableRange.Cells.VerticalAlignment := wdCellAlignVerticalCenter;
// Разделяем строки №2, 4 и 5 на, соответственно, 3, 2 и 2 ячейки
TableRange.Rows.Item(2).Cells.Item(1).Split(1, 3);
TableRange.Rows.Item(4).Cells.Item(1).Split(1, 2);
TableRange.Rows.Item(5).Cells.Item(1).Split(1, 2);
// Запрещаем отображение линий таблицы (вообще-то, они и так не отображаются)
TableRange.Rows.Borders.InsideLineStyle := wdLineStyleNone;
TableRange.Rows.Borders.OutsideLineStyle := wdLineStyleNone;
// Настраиваем размеры получившихся ячеек таблицы
TableRange.Rows.Item(1).Cells.Item(1).SetHeight(85, wdRowHeightExactly);
TableRange.Rows.Item(2).Cells.Item(1).SetHeight(92, wdRowHeightExactly);
TableRange.Rows.Item(3).Cells.Item(1).SetHeight(100, wdRowHeightExactly);
TableRange.Rows.Item(4).Cells.Item(1).SetHeight(185, wdRowHeightExactly);
TableRange.Rows.Item(4).Cells.Item(1).SetWidth(CentimetersToPoints(6.79), wdAdjustNone);
TableRange.Rows.Item(4).Cells.Item(2).SetWidth(CentimetersToPoints(10.58), wdAdjustNone);
TableRange.Rows.Item(5).Cells.Item(1).SetHeight(135, wdRowHeightExactly);
TableRange.Rows.Item(6).Cells.Item(1).SetHeight(60, wdRowHeightExactly);
TableRange.Rows.Item(7).Cells.Item(1).SetHeight(60, wdRowHeightExactly);
// Далее в оригинальном коде следует вызов процедуры СоздатьТитул,
// но мы для простоты восприятия реализуем ее непосредственно в следующем коде
// В первой строке записывается следующая информация:
// 1. Учебное заведение
// 2. Факультет
// 3. Курс
// 4. Группа
// Устанавливаем полуторный интервал между строками
TableRange.Rows.Item(1).Range.ParagraphFormat.Space15;
// Приступаем к формированию текста
TableRange.Rows.Item(1).Range.InsertAfter(FInstitution + CRLF + FFaculty + CRLF);
// Здесь у автора полная фигня с алгоритмом -- при отсутствии необходимых данных
// у него останутся лишние запятые
if FCourse <> '' then begin
TableRange.Rows.Item(1).Range.InsertAfter(FCourse + ' курс, ');
end;
if FGroup <> '' then begin
TableRange.Rows.Item(1).Range.InsertAfter(FGroup + ' группа');
end;
// Далее у автора зачем-то организован цикл, которого, как мне кажется,
// не нужно
TableRange.Rows.Item(1).Range.Paragraphs.Item(1).Range.Underline := wdUnderlineSingle;
TableRange.Rows.Item(1).Range.Paragraphs.Item(1).Range.Font.Size := 16;
TableRange.Rows.Item(1).Range.Paragraphs.Item(2).Range.Font.Size := 14;
TableRange.Rows.Item(1).Range.Paragraphs.Item(3).Range.Font.Size := 12;
// В третью ячейку второй строки записываем название кафедры
if FBranch <> '' then begin
TableRange.Rows.Item(2).Cells.Item(3).Range.Font.Size := 12;
TableRange.Rows.Item(2).Cells.Item(3).Range.ParagraphFormat.Alignment := wdAlignParagraphLeft;
TableRange.Rows.Item(2).Cells.Item(3).Range.InsertAfter('Кафедра: ' + FBranch);
end;
// Во второй строке показываем тип работы
TableRange.Rows.Item(3).Range.Font.Size := 36;
TableRange.Rows.Item(3).Range.Bold := TRUE;
TableRange.Rows.Item(3).Range.InsertAfter(AnsiUpperCase(FDocumentType));
// Во второй ячейке четвертой строки показываются
// 1. Дисциплина
// 2. Преподаватель
// 3. Тема
// 4. Исполнитель
// Устанавливаем полуторный междустрочный интервал
TableRange.Rows.Item(4).Cells.Item(2).Range.ParagraphFormat.Space15;
TableRange.Rows.Item(4).Cells.Item(2).Range.Font.Size := 12;
TableRange.Rows.Item(4).Cells.Item(2).Range.Italic := TRUE;
TableRange.Rows.Item(4).Cells.Item(2).Range.Underline := wdUnderlineSingle;
TableRange.Rows.Item(4).Cells.Item(2).Range.ParagraphFormat.Alignment := wdAlignParagraphLeft;
TableRange.Rows.Item(4).Cells.Item(2).Range.InsertAfter('Дисциплина: ' + FSubject + CRLF
+ 'Преподаватель: ' + FTutor + CRLF
+ 'Тема: ' + FTitle + CRLF
+ 'Исполнитель: ' + FAuthor);
// Дополнительное форматирование элементов
Cnt := TableRange.Rows.Item(4).Cells.Item(2).Range.Paragraphs.Count;
for I := 1 to Cnt do begin
Paragraph := TableRange.Rows.Item(4).Cells.Item(2).Range.Paragraphs.Item(I);
Paragraph.Range.Words.Item(1).Italic := FALSE;
Paragraph.Range.Words.Item(2).Italic := FALSE;
Paragraph.Range.Words.Item(1).Underline := wdUnderlineNone;
Paragraph.Range.Words.Item(2).Underline := wdUnderlineNone;
end;
// В седьмой строке рисуем город и год
TableRange.Rows.Item(7).Range.Font.Size := 14;
TableRange.Rows.Item(7).Range.Font.Spacing := 3;
TableRange.Rows.Item(7).Range.Bold := TRUE;
TableRange.Rows.Item(7).Range.ParagraphFormat.Space15;
TableRange.Rows.Item(7).Range.InsertAfter(FCity + CRLF + FYear + ' г.');
// Финальное ура:
// Устанавливаем курсор в конец получившегося документа
TableRange.SetRange(TableRange.End, TableRange.End);
TableRange.Select;
end;
procedure TForm2.CreateTableOfContents(ADocument: OleVariant);
var
Range: OleVariant;
begin
// Получаем текущий объект Range
Range := ADocument.Application.Selection;
// Формируем заголовок оглавления
Range.Text := CRLF + 'С О Д Е Р Ж А Н И Е' + CRLF + CRLF;
// Форматируем текст
Range.ParagraphFormat.Alignment := wdAlignParagraphCenter;
Range.ParagraphFormat.Space15;
Range.Font.Size := 16;
// Включаем разрыв страницы переда параграфом
Range.Paragraphs.Item(1).PageBreakBefore := TRUE;
// Устанавливаем курсор в конец документа
Range.SetRange(Range.End, Range.End);
Range.Select;
// А вот дальше создается поле документа типа TOC (table of contents)
// Похоже, все это работает только под русскоязычную версию ворда,
// т.к. используются русские названия стилей
ADocument.Fields.Add(ADocument.Application.Selection.Range,
wdFieldTOC,
'\o \f \ t' + #34 + 'ЗАГОЛОВОК 4;4' + #34);
// Вставляем дополнительные пустые параграфы
Range.SetRange(ADocument.Application.Selection.End, ADocument.Application.Selection.End);
Range.InsertParagraphAfter;
Range.InsertParagraphAfter;
Range.Paragraphs.Item(2).PageBreakBefore := TRUE;
// Переводим позицию в конец документа и применяем форматирование
Range.SetRange(Range.End, Range.End);
Range.ParagraphFormat.Alignment := wdAlignParagraphJustify;
Range.ParagraphFormat.FirstLineIndent := CentimetersToPoints(1.25);
Range.ParagraphFormat.Space2;
Range.Select;
ADocument.Application.Selection.Font.Size := 12;
end;
procedure TForm2.CreateTitle(ADocument: OleVariant);
var
Range: OleVariant;
begin
// Формирование колонтитула документа
// Верхний колонтитул
Range := ADocument.Sections.Item(1).Headers.Item(wdHeaderFooterPrimary).Range;
Range.Text := FAuthor + #34 + FTitle + #34 + ' (' + FDocumentType + ')' + CRLF
+ '______________________________________________________________________________________________________________';
Range.Font.Name := 'Courier New';
Range.Font.Size := 7;
Range.Font.Italic := TRUE;
Range.ParagraphFormat.RightIndent := 0;
Range.ParagraphFormat.Alignment := wdAlignParagraphRight;
// Нижний колонтитул
Range := ADocument.Sections.Item(1).Footers.Item(wdHeaderFooterPrimary).Range;
Range.Fields.Add(Range, wdFieldPage);
Range.ParagraphFormat.Alignment := wdAlignParagraphRight;
// Запрещаем показ колонтитулов на первой странице
ADocument.PageSetup.DifferentFirstPageHeaderFooter := TRUE;
end;
procedure TForm2.CreateTopic(ADocument: OleVariant; ACaption: String;
ALevel: Integer; AText: String = '');
var
Range: OleVariant;
Style: OleVariant;
begin
// Эта процедура несполько отличается от предложенной автором,
// т.к. принимает дополнительно еще и текст
// Создание основных информационных разделов
Range := ADocument.Application.Selection.Range;
ADocument.Fields.Add(Range, wdFieldEmpty, 'TC', FALSE);
// Функционал, формирующий поля документа, также не реализован,
// т.к. в оригинале все разделы документа хранятся в виде дополнительных свойств
// Устанавливаем текст заголовка
Range.Text := ACaption;
Range.SetRange(Range.Start, ADocument.Application.Selection.End);
// Формируетм стиль заголовка
Style := NULL;
case ALevel of
1: Style := ADocument.Styles.Item('Заголовок 1');
2: Style := ADocument.Styles.Item('Заголовок 2');
3: Style := ADocument.Styles.Item('Заголовок 3');
end;
Range.Style := Style;
// Формируем дополнительный информационный текст
Range.InsertParagraphAfter;
Range.Collapse(wdCollapseEnd);
if AText = '' then AText := topicText;
Range.InsertAfter(CRLF + AText + CRLF + CRLF);
// Данный вызов необязателен, т.к. новый текст и так имеет стиль Обычный
// Range.Style := ADocument.Styles.Item('Обычный');
Range.Font.Size := 12;
Range.Collapse(wdCollapseEnd);
Range.Select;
end;
procedure TForm2.InitializeProperties;
begin
// !!! ТЕСТОВАЯ ИНИЦИАЛИЗАЦИЯ ДАННЫХ !!!
FDocumentType := SeSkinComboBox4.Text;
FInstitution := SeSkinEdit11.Text;
FFaculty := 'Заборостроение';
FCourse := SeSkinComboBox1.text;
FGroup := SeSkinComboBox2.text;
FBranch := SeSkinEdit9.Text;
FSubject := SeSkinEdit8.Text;
FTutor := SeSkinEdit7.text;
FTitle := SeSkinEdit6.text;
FAuthor := SeSkinEdit3.text;
FCity := SeSkinEdit4.text;
FYear := SeSkinEdit5.text;
FIntroduction:= SeSkinCheckBox2.Checked;
FSummary := SeSkinCheckBox3.Checked;
FSourceList := SeSkinCheckBox4.Checked;
end;
procedure TForm2.UpdateTableOfContents(ADocument: OleVariant);
var
I, CNT: Integer;
Field: OleVariant;
begin
// Находим и обновляем поле, имеющее тип wdFieldTOC
CNT := ADocument.Fields.Count;
for I := 1 to CNT do begin
Field := ADocument.Fields.Item(I);
if Field.Type = wdFieldTOC then begin
Field.Update;
end;
end;
end;
procedure TForm2.SeSkinButton2Click(Sender: TObject);
var
OldCursor: TCursor;
Intf: IDispatch;
WordApp: OleVariant;
Document: OleVariant;
begin
OldCursor := Screen.Cursor;
Screen.Cursor := crHourGlass;
try
// Создаем приложение Word
Intf := CreateOleObject('Word.Application');
try
WordApp := Intf;
try
// Создаем новый документ
Document := WordApp.Documents.Add();
// Инициализация данных для документа
InitializeProperties;
// Приступаем к формированию документа
// В оригинале процесс формирования размещается в файле СозданиеРеферата.bas
// Процесс формирования состоит из 4-х этапов:
// 1. СоздатьТаблицу
// 2. СоздатьСодержание
// 3. СоздатьЗаголовки
// 4. РефератКолонтитул
// Сделаем аналогичные процедуры на Delphi
CreateTable(Document); // СоздатьТаблицу
CreateTableOfContents(Document); // СоздатьСодержание
CreateContent(Document); // СоздатьЗаголовки (на самом деле, создается все содержание документа)
CreateTitle(Document); // РефератКолонтитул
// Дополнительная функция, которой у автора нет:
// обновление содержания
UpdateTableOfContents(Document);
WordApp.Visible := TRUE;
WordApp.Activate;
except
// В случае возникнования ошибок завершаем приложение
WordApp.Quit(wdDoNotSaveChanges);
raise;
end
finally
Intf := NIL;
end;
finally
Screen.Cursor := OldCursor;
end;
end;
procedure TForm2.SeSkinButton1Click(Sender: TObject);
begin
close;
end;
procedure TForm2.SeSkinButton6Click(Sender: TObject);
var
a: integer;
begin
A:=OGLAVL.Items.count;
OGLAVL.Items.Add('Глава '+IntToStr(a+1)+vvod_glav.text);
end;
procedure TForm2.TeButton4aClick(Sender: TObject);
var
a: integer;
begin
A:=TeListBox1.Items.count;
TeListBox1.Items.Add('Параграф '+ IntToStr(a+1)+TeEdit1.text);
end;
procedure TForm2.TeButton8Click(Sender: TObject);
var
a: integer;
begin
A:=TeListBox2.Items.count;
TeListBox2.Items.Add('Подпункт '+ IntToStr(a+1)+TeEdit2.text);
end;
end.
|
|
Оболочка для текстов песен, База текстов песен с аккордами 
Загрузка ...
