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;
Есть идея по созданию интересной программы?
вторник, 22 июня 2010 г.
понедельник, 21 июня 2010 г.
Indy актуальная версия
Ярлыки:
indy
понедельник, 17 мая 2010 г.
IOResult Delphi
Ярлыки:
System
IOResult Возвращает последний результат операции ввода/вывода
0 в случае успешного завершения операции
if IOResult = 0 then
0 в случае успешного завершения операции
if IOResult = 0 then
Нетипизированные файлы в Delphi
Ярлыки:
System
Понадобилось записать структуру в нетипизированный файл, до этого момента ни когда не пользовался этим и столкнулся с тем, что информации по этому поводу много и ни о чем. Примеров много только толку от них мало.
По ходу самообучения буду добавлять описание функций для достижения на меченой цели
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.
По ходу самообучения буду добавлять описание функций для достижения на меченой цели
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
Ярлыки:
TWebBrowser
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;
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
Ярлыки:
SysUtils
Для этого можно использовать следующий оператор FileExists
Например
uses SysUtils;
if FileExists('C:\\1.txt') then
Application.MessageBox('Файл найден', 'Куда его?))', MB_OK + MB_ICONWARNING);
else
Application.MessageBox('Файл не найден', 'что делать?', MB_OK + MB_ICONWARNING);
Например
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
Пример использования стандартного функционала класса 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/ только в целях сохранения и передачи информации))
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 определяет прозрачные участки по левому нижнему углу. Вот по этой причине и возникла проблема с непонятным белым фоном.
Спасибо за внимание.
после чего открылось окно в котором можно добавить, удалить, заменить и экспортировать иконки
в окне нажал на кнопку ADD после чего выбрал необходимую мне иконку
после выбора иконки нажал кнопку ОК в imagelist editor'e после чего окно закрылось.
Иконки мне были необходимы для того, чтобы использовать их на кнопках в ToolBar1'е.
Бросил ToolBar1 на форму у ToolBar1'a свойство Images путем выбора из комбобокса сделал равным ImageList1. На ToolBar1'е нажав правой клавишей мыши и выбрав пункт меню New Button добавил кнопку на ToolBar ,
но вот незадача иконка которую я загрузил в ImageList1 была с прозрачным фоном а на кнопке была с белым фоном, что весьма плохо смотрелось(полный отстой я бы сказал). Скачал еще несколько иконок и заметил, что некоторые иконки отображаются корректно, а некоторые нет, хотя при просмотре просмоторщиком картинок все они на вид были одинаковыми, но как потом оказалось это лишь видимость.
Скачал бесплатный редактор иконок IcoFX и открыл один из исходников иконки (png) им после чего редактор мне предложил выбрать параметры будущей иконки (размер и палитра),
далее появилось окно расширенного импорта,
где задаются параметры прозрачности в которых методом научного тыка, я определил, что DELPHI определяет прозрачные участки по левому нижнему углу. Вот по этой причине и возникла проблема с непонятным белым фоном.
Спасибо за внимание.
Подписаться на:
Сообщения (Atom)