Отображать текст вместе с картинками

[crit]

Здравствуйте Друзья! делаю систему тестирования..так вот проблема вставки картинки в редакторе теста... не получается сохранить картинку к вопросу, когда перехожу к созданию следующего.. вот код привожу работы в редакторе:

Код: Выделить всё

.........
const
  sost: array [0..10] of string[47] = (
    'Создание нового вопроса','Создание нового ответа',
    'Удаление текущего вопроса','Удаление последнего ответа',
    'Просмотр предыдущего вопроса','Просмотр следующего вопроса',
    'Вернуться к предыдущему вопросу','Просмотреть следующий вопрос',
    'Закончить тестирование','','Сохранить тест и вернуться к окну тестирования');
type
  TTest = record                      //Тип данных используемый для хранения вопроса теста
            question: array [1..50,1..91] of char;
            answer: array [1..5,1..151] of char;
            lines,anscount,true: byte;
            pass: array [1..20] of char;
          end;
  TTestFile = file of TTest;          //Тип файла теста
var
  Form1: TForm1;
  Test: TTestFile;                                      
//Файловая переменная для обращения к файлу теста
  CurQuest: ^TTest;                                      
//Переменная для хранения 1 вопроса теста
  path: string;                                    
//Переменные для хранения пароля к тесту и пути к файлу теста
  Count,Right,TrueCount,CurPos: byte;
  rb: array [1..10] of TRadioButton;
  ed: array [1..10] of TEdit;
  anscount: byte;
    ..............................
procedure SaveQuestion(var Test: TTestFile; n,k: byte);  
//Процедура сохранения вопроса в файл
var
  i,j: byte;
  s: string;
begin
  reset(Test);
  seek(test,n);                                          
//Перемещаем указатель в файле в конец
  for i:=1 to Form1.Memo1.Lines.Count do                
//Преобразовываем текст вопроса в формат пригодный для записи в файл
      begin
        s:=Form1.Memo1.Lines.Strings[i-1]+#10;
        for j:=1 to length(s) do
            curquest^.question[i,j]:=s[j];
      end;
  curquest^.lines:=Form1.Memo1.Lines.Count;              
//Запоминаем количество строк в вопросе
  for i:=1 to anscount do
      begin                                              
//Преобразовываем текст ответов в формат пригодный для записи в файл
        s:=ed[i].Text+#10;
        for j:=1 to length(s) do
            curquest^.answer[i,j]:=s[j];
      end;                                              
  curquest^.anscount:=anscount;                          
//Запоминаем количество ответов
  curquest^.true:=k;                                    
//Запоминаем правильный ответ
  if length(pass)>19 then                                
//Если длина выбранного пароля превышает допустимую, удаляем лишние литеры
      delete(pass,19,length(pass)-19);
  pass:=pass+#10;
  for i:=1 to length(pass) do                            
//Преобразовываем пароль в формат пригодный для записи в файл
      curquest^.pass[i]:=pass[i];
  write(test,curquest^);                                
//Записываем вопрос в файл
  if Form1.Button3.Visible=true
      then Form1.GroupBox1.caption:='  Вопрос ('+inttostr(n+2)+'/'+inttostr(filesize(test)+1)+')  '
      else Form1.GroupBox1.caption:='  Вопрос ('+inttostr(n+1)+'/'+inttostr(filesize(test))+')  ';
  closefile(test);

[crit]

продолжение ато не уместилось=)

Код: Выделить всё

function IfSave: boolean;                                
//Функция, используемая для сохранения проделаных изменений в файл, если удалось сохранить - возвращает true
var
  Checked: boolean;
  i,k,save: byte;
begin
  result:=false;
  k:=1;
  save:=0;
  if Form1.Memo1.Text=''                                
//Проверяем чтобы вопрос не оказался пустым
      then save:=1;
  Checked:=false;
  for i:=1 to anscount do                                
//Проверяем все ли поля ответов заполнены, и запоминаем правильный ответ, если он выбран
      begin
          if ed[i].Text=''
            then save:=2;
          if rb[i].Checked
            then begin
                    checked:=true;
                    k:=i;
                  end;
      end;
  if not Checked
      then save:=3;
  if anscount=1                                          
//Проверяем, чтобы на вопрос было как минимум два возможных варианта ответа
      then save:=4;
  case save of
        0: begin                                          
//Если все хорошо, то сохраняем изменения в файл
              if Form1.N17.Enabled=false
                then SaveQuestion(Test,count,k)
//Если мы в режиме создания теста, то сохраняем вопрос последним
                else SaveQuestion(Test,CurPos,k);
//Если мы в режиме редактирования, то сохраняем вопрос в текущюю позицию указателя
              inc(count);
              for i:=1 to anscount do                    
//Избавляемся от форм ввода вариантов вопроса
                  begin
                    ed[i].Destroy;
                    rb[i].Destroy;
                  end;
              anscount:=0;
              result:=true;
          end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if IfSave //Если удалось записать текущий вопрос в файл, то готовим форму для следующего вопроса
  then begin
          rb[1]:=TRadioButton.Create(self);
          rb[1].Parent:=Form1;
          rb[1].Left:=16;
          rb[1].Top:=216;
          ed[1]:=TEdit.Create(self);
          ed[1].Parent:=Form1;
          ed[1].Left:=34;
          ed[1].Top:=216;
          ed[1].Width:=517;
          anscount:=1;
          Memo1.Text:='';
        end;
end;

procedure TForm1.Button10Click(Sender: TObject);  
//Если удалось записать текущий вопрос в файл, то прячем все ненужные элементы
begin
if IfSave
then begin
        Memo1.Clear;
        Memo1.Visible:=false;
        GroupBox1.Visible:=false;
        RadioGroup1.Visible:=false;
        Button1.Visible:=false;
        Button2.Visible:=false;
        Button3.Visible:=false;
        Button4.Visible:=false;
        Button5.Visible:=false;
        Button6.Visible:=false;
        Button7.Visible:=false;
        Button10.Visible:=false;
        N14.Enabled:=true;
        N17.Enabled:=false;
        N19.Enabled:=true;
        N21.Enabled:=false;
        GroupBox1.caption:='  Вопрос  ';
        Form1.Caption:=' Тестер';
    end;
end;
Procedure TForm1.Button6Click(Sender: TObject);  //кнопка 
begin
  reset(test);
  if CurPos<filesize(test)-1                  
//Проверяем не является ли текущий вопрос последним
      then begin
              closefile(test);
              if not ifsave                    
//Сохраняем изменения в текущем вопросе
                then MessageBox(application.Handle,'Ошибка записи в файл','IO ERROR',MB_OK+MB_ICONHAND);
              inc(CurPos);                      //Сдвигаем текущию позицию вперед на 1 вопрос
              ShowQuestForEdit(test,Curpos);    //Отображем вопрос
          end
      else begin 
              MessageBox(application.Handle,
                  'А дальше некуда, обрыв.','Ту-ту приехали',MB_OK+MB_ICONEXCLAMATION);
              closefile(test);
          end;

procedure TForm1.Button7Click(Sender: TObject);
begin
  if CurPos>0                                  
//Проверяем не является ои текущий редактируемый вопрос первым
      then begin
              if not ifsave                    
//Сохраняем изменения в вопросе и отображаем предстоящий вопрос
                then MessageBox(application.Handle,
                    'Ошибка записи в файл','IO ERROR',MB_OK+MB_ICONHAND);
              dec(CurPos);
              ShowQuestForEdit(Test,curpos);
          end
      else MessageBox(application.Handle,
          'А дальше некуда, обрыв.','Ту-ту приехали',MB_OK+MB_ICONEXCLAMATION);
end;




ну вот вроде все.... ПОМОГИТЕ ПЛИЗ!! курсовик горит

[/CODE]

[crit]

почитал тут, что можно сохранять картинки в файл! тоесть когда создаю новый тест в вопросе вставляю картинку в TImage ,перехожу к следующему, и картинка должна сохраняться в файл! Это применимо в моем коде????вот пример сохранения в файл

Код: Выделить всё

private
    { Private declarations }
    b: array of TBitmap;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.btnSaveClick(Sender: TObject);
var
  file1:TFileStream;
  m: TMemoryStream;
  i:Integer;
  len: array of integer;
begin
  m := TMemoryStream.Create;
  file1 := TFileStream.Create('out.dat', fmCreate);
  try
    SetLength(len, Length(b) + 1);
    len[0] := Length(b);

    for i := 0 to Length(b) - 1 do
    begin
      m.Clear;
      b[i].SaveToStream(m);
      len[i + 1] := m.Size;
    end;

    file1.WriteBuffer(len[0], Length(len) * SizeOf(Integer));
    for i := 0 to Length(b) - 1 do
      b[i].SaveToStream(file1);

  finally
    file1.Free;
    m.Free;
  end;
end;

[Naeel Maqsudov]

crit, для текста с картинками используйте TRichEdit.
Тогда тело вопроса можно готовить в любом текстовом процессопе в RTF-формате.

А еще лучше используйье TWebBrowser и тело вопроса в HTML.

[crit]

хм..да вот некогда перебивать структуру.. хотел просто вставлять в TImage.(((
--------------------------------------------------------------------------------
Добавлено сообщение
--------------------------------------------------------------------------------
хм..да вот некогда перебивать структуру.. хотел просто вставлять в TImage.((( а вопросы и ответы сохраняются просто в файл..

[Naeel Maqsudov]

Для курсового проекта стоит переделать структуру.
Как говорится: "Лучше день потерять, потом за 5 минут долететь"

Ну а сохранять/загружать картинки в TImage не сложно:

Image1.Pictire.LoadFromFile(const FileName: string);

Image1.Pictire.SaveToFile(const FileName: string);

[KarpovSergei]

Вывожу тект при помощи
procedure OutText Litera : pchar;
begin
glListBaseGLF_START_LIST;
glCallListsLength Litera, GL_UNSIGNED_BYTE, Litera;
end;
далее: OutTextpchars1; s1:string;
текст получается всегда белого цвета, хотя и задаю другой.
при создании формы есть команды:
glEnable GL_LIGHTING;
glEnable GL_LIGHT0;
glEnableGL_BLEND;
glBlendFuncGL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
Убрав любую из них текст становится нужного цвет, но это меняет вид других объектов. в чем проблема?

[Jay_D]

Вывожу тект при помощи
procedure OutText Litera : pchar;
begin
glListBaseGLF_START_LIST;
glCallListsLength Litera, GL_UNSIGNED_BYTE, Litera;
end;
далее: OutTextpchars1; s1:string;
текст получается всегда белого цвета, хотя и задаю другой.
при создании формы есть команды:
glEnable GL_LIGHTING;
glEnable GL_LIGHT0;
glEnableGL_BLEND;
glBlendFuncGL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
Убрав любую из них текст становится нужного цвет, но это меняет вид других объектов. в чем проблема?

sesr4etretrtert