Блог по программированию в среде Delphi

Поиск по блогу

Есть идея по созданию интересной программы?

Опиши тут и я по возможности постараюсь это реализовать специально для тебя! Без $ ))

понедельник, 17 мая 2010 г.

IOResult Delphi

IOResult Возвращает последний результат операции ввода/вывода
0 в случае успешного завершения операции
if IOResult = 0 then

Нетипизированные файлы в Delphi

Понадобилось записать структуру в нетипизированный файл, до этого момента ни когда не пользовался этим и столкнулся с тем, что информации по этому поводу много и ни о чем. Примеров много только толку от них мало.
По ходу самообучения буду добавлять описание функций для достижения на меченой цели


f:file;//нетипизированный файл

AssignFile(f, 'c:\1111.txt');//открытие файла

Reset(f);//как это ни странно это открытие файла так же можно употреблять для добавления
записей (Append(f))

Rewrite(f);//Создает новый файл и открывает его.

Seek(f, Filesize(f)); // перемещаемся в конец файла

Write(f,ppp);//записать содержимое в файл

CloseFile(f);//закрыть файл

нашел в учебнике по Delphi 7 для начинающих пример программки немного пришло поправить, а то просто не хотел компилиться проект

для работы программы необходимы
2 ComboBox
3 Label
1 RadioGroup
1 TEdit
1 Button

листинг программки для записи структуры в файл

unit Unit1;

interface

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

type
// тип медали
TKind = (GOLD, SILVER, BRONZE);
  // запись файла
  TMedal=record
  country: string[20]; // страна
  sport: string[20]; // вид спорта
  person: string[40]; // спортсмен
  kind: TKind; // медаль
end;

type
  TForm1 = class(TForm)
    Button1: TButton;
    ComboBox1: TComboBox;
    ComboBox2: TComboBox;
    Edit1: TEdit;
    RadioGroup1: TRadioGroup;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    procedure FormActivate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  f: file of TMedal; // файл записей — база данных

implementation

{$R *.dfm}

procedure TForm1.FormActivate(Sender: TObject);
var
  resp : word; // ответ пользователя
begin
  AssignFile(f, 'c:\1111.txt');
  Reset(f); // открыть файл
  Seek(f, Filesize(f)); // указатель записи в конец файла
  if IOResult = 0 then
    Button1.enabled:=TRUE // теперь кнопка Добавить доступна
  else
  begin
    resp:=MessageDlg('Файл базы данных не найден. Создать новую БД?', mtInformation,[mbYes,mbNo],0);
    if resp = mrYes then
    begin
      {$I-}
      Rewrite(f);
      {$i+}
      if IOResult = 0 then
        Button1.enabled:=TRUE
      else
        ShowMessage('Ошибка создания файла БД.');
    end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  medal: TMedal;
begin
  with medal do
  begin
    country := ComboBox1.Text;
    sport := ComboBox2.Text;
    person := Edit1.Text;
    case RadioGroup1.ItemIndex of
      0: kind := GOLD;
      1: kind := SILVER;
      2: kind := BRONZE;
    end;
  end;
  Write(f,medal); // записать содержимое полей записи в файл
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  CloseFile(f); // закрыть файл
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  ComboBox1.Items.Add('Россия');
  ComboBox1.Items.Add('Австрия');
  ComboBox1.Items.Add('Германия');
  ComboBox1.Items.Add('Франция');
end;

end.

воскресенье, 2 мая 2010 г.

Вставка HTML кода в TWebBrowser Delphi 7

procedure TextToWebBrowser(Text: string; var WB: TWebBrowser);
var
  Document: IHTMLDocument2;
  V: OleVariant;
begin
  // Документ необходимо создать только один раз за текущую сессию работы
  if WB.Document = nil then
    WB.Navigate('about:blank');
  // Ожидаем создания документа и позволяем обрабатывать все сообщения
  while WB.Document = nil do
    Application.ProcessMessages;
  Document := WB.Document as IHtmlDocument2;
  // Вставляем текст (до 2Гб)
  {следующие строчки внесены недавно - старый вариант функции не работал под XP}
  V := VarArrayCreate([0, 0], varVariant);
  V[0] := Text;
  Document.Write(PSafeArray(TVarData(v).VArray));
  Document.Close;
end;

суббота, 1 мая 2010 г.

BLOB поля в FIBPlus

Работа с BLOB полями

Редактирование BLOB поля

procedure TMainForm.OpenBClick(Sender: TObject);
begin
   if not OpenD.Execute then exit;
   pFIBDataSet1.Edit;
   TBlobField(pFIBDataSet1.FieldByName('GRAPHIC')).LoadFromFile(OpenD.FileName);
   pFIBDataSet1.Post;
end;
Методами SaveToFile, SaveToStream мы можем сохранить значение BLOB-поля в некоторый внешний файл или TStream.

Пример сохранения BLOB поля в файл:


procedure TMainForm.SaveBClick(Sender: TObject);
begin
    if not SaveD.Execute then exit;
    if not pFIBDataset1.FieldByName('GRAPHIC').IsNull then
    begin
        TBlobField(pFIBDataSet1.FieldByName('GRAPHIC')).SaveToFile(SaveD.FileName);
    end;
end;

Пример очистки BLOB поля.


procedure TMainForm.Button1Click(Sender: TObject);
begin
    pFIBDataSet1.Edit;
    pFIBDataSet1.FieldByName('GRAPHIC').Clear;
    pFIBDataSet1.Post;
end;

Оригинал http://www.devrace.com/ru/fibplus/articles/2261.php

Проверить наличие файла в директории DELPHI

Для этого можно использовать следующий оператор FileExists
Например

uses SysUtils;
    if FileExists('C:\\1.txt') then
        Application.MessageBox('Файл найден', 'Куда его?))', MB_OK + MB_ICONWARNING);
    else
        Application.MessageBox('Файл не найден', 'что делать?', MB_OK + MB_ICONWARNING);