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

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

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

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

вторник, 22 июня 2010 г.

Кракозябры вместо русских букв (решение)

function RussianToUnicode(S: String): String;
var Wrd:Word;
  pW,pR:PWord;
  len:Integer;
begin
  pW:=@S[1];
  len:=Length(S);
  SetLength(Result,len);
  pR:=@Result[1];
  while Len<>0 do begin
    Wrd:=pW^;
    case Wrd of
      $C0..$DF,$E0..$FF:pR^:=Wrd+50;
      else pR^:=Wrd;
    end;
    inc(pW);
    inc(pR);
    dec(Len);
  end;
end;

понедельник, 21 июня 2010 г.

Компоненты для Delphi 7

Indy 10.5.5 скачана с SVN сегодня смотрим дату поста

Indy актуальная версия

не тут ftp://indy.fulgan.com/ZIP/
а тут SVN https://svn.atozed.com:444/svn/Indy10/
login Indy-Public-RO
Pass ПУСТО
SVN скачать можно тут
Можно так же скачать отсюда чтобы не заморачиваться  с SVN

понедельник, 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);

вторник, 20 апреля 2010 г.

TStringList Delphi удаление дубликатов

Пример использования стандартного функционала класса  TStringList для удаления дубликатов из переменной t

var
  t:TStringList;
begin
  t:=TStringList.Create;
  t.Add('1');
  t.Add('2');
  t.Add('1');
  t.Add('3');
  t.Add('2');
  t.Add('3');
  Label1.Caption:=IntToStr(t.Count);//количество строк в списке 6
  t.Sorted:=True;
  t.Duplicates:=dupIgnore;
  t.Clear;
  t.BeginUpdate;
  t.Add('1');
  t.Add('2');
  t.Add('1');
  t.Add('3');
  t.Add('2');
  t.Add('3');
  t.EndUpdate;
  Label2.Caption:=IntToStr(t.Count);//количество строк в списке 3

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

//remove duplicate strings from the string list
 procedure RemoveDuplicates(const stringList : TStringList) ;
 var
   buffer: TStringList;
   cnt: Integer;
 begin
   stringList.Sort;
   buffer := TStringList.Create;
   try
     buffer.Sorted := True;
     buffer.Duplicates := dupIgnore;
     buffer.BeginUpdate;
     for cnt := 0 to stringList.Count - 1 do
       buffer.Add(stringList[cnt]) ;
     buffer.EndUpdate;
     stringList.Assign(buffer) ;
   finally
     FreeandNil(buffer) ;
   end;
 end;

пример использования

var
   sl : TStringList;
   cnt : integer;
 begin
   Randomize;
   sl := TStringList.Create;
   try
     for cnt := 1 to 1000 do
       sl.Add(IntToStr(Random(2000))) ;
     ShowMessage('With duplicates: ' + #13#10 + IntToStr(sl.Count)) ;
     RemoveDuplicates(sl) ;
     ShowMessage('Without duplicates: ' + #13#10 + IntToStr(sl.Count)) ;
   finally
     sl.Free;
   end;
 end;

 процедура и пример ее использования были взяты с сайта http://delphi.about.com/ только в целях сохранения и передачи информации))

четверг, 8 апреля 2010 г.

Delphi и иконки (Delphi for ico)

Короче дело обстояло таким образом, я решил прикрутить к программе красивые иконки, нашел сайт по их поиску http://www.iconfinder.net/ и http://www.iconarchive.com/  все что было необходимо оставалось только за мной. Создал проект после чего бросил на форму ImageList1  
нажал правой клавишей на компоненте и выбрал пункт меню imagelist editor
после чего открылось окно в котором можно добавить, удалить, заменить и экспортировать иконки
в окне нажал на кнопку ADD после чего выбрал необходимую мне иконку
после выбора иконки нажал кнопку ОК в imagelist editor'e после чего окно закрылось.
Иконки мне были необходимы для того, чтобы использовать их на кнопках в ToolBar1'е.
Бросил ToolBar1 на форму у ToolBar1'a свойство Images путем выбора из комбобокса сделал равным ImageList1. На ToolBar1'е нажав правой клавишей мыши и выбрав пункт меню New Button добавил кнопку на ToolBar ,

но вот незадача иконка которую я загрузил в ImageList1 была с прозрачным фоном а на кнопке была с белым фоном, что весьма плохо смотрелось(полный отстой я бы сказал). Скачал еще несколько иконок и заметил, что некоторые иконки  отображаются корректно, а некоторые нет, хотя при просмотре просмоторщиком картинок все они на вид были одинаковыми, но как потом оказалось это лишь видимость.
Скачал бесплатный редактор иконок IcoFX и открыл один из исходников иконки (png) им после чего редактор мне предложил выбрать параметры будущей иконки (размер и палитра),


далее появилось окно расширенного импорта,


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