VPF::Арсенал форумистов - Форум программистов

p0s0l

Дата 15.4.2004, 00:04 (ссылка)

(нет голосов)

Загрузка ...

Г-н Посол

Профиль
Группа: Экс. модератор
Сообщений: 3668
Регистрация: 13.7.2003
Где: 58°38' с.ш. 4 9°41' в.д.

Репутация: 58
Всего: 112

Не раз уже встречал случаи, когда кто-нибудь хотел выложить какие-то свои наработки в Delphi: модули, исходники, компоненты, может еще что-то. Предлагалось создавать отдельный раздел, но пока не понятно, будет ли от этого толк. Пока что создаю эту тему. В дальнейшем же будет видно насчёт отдельного раздела исходников по тому, какая тут будет активность, и как к этому отнесётся Admin.

Единственное правило - в этой теме не флеймить, тут оставлять только краткое описание модулей и ссылки к ним.

Можно скинуть мне на мыло (кнопка E-Mail под моим постом) файл, и я его прикреплю к вашему сообщению при первой же возможности...

--------------------

С уважением, г-н Посол.

KgCoder

Дата 15.4.2008, 12:22 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 93
Регистрация: 6.3.2008
Где: KGstan

Репутация: нет
Всего: нет

Цитата(Dr Smth @ 28.10.2004, 14:36)

При составлении программ часто возникает ситуация, когда нужно что-нибудь подсчитать, и вывести результат в виде: ЧИСЛО + СЛОВО. Причём СЛОВО обозначает то, что, собственно, и нужно подсчитать. Например, нужно вывести число строк в списке TListBox в формате: 'N слов'. Благодаря особенностям великого и могучего русского языка и тому, что число N заранее неизвестно, может меняться и вычисляется самой программой, заранее также неясно в каком падеже нужно ставить следующее за числом слово.

Если плюнуть на это и написать просто: N + ' слово', то при расчётах получим малограмотные конструкции типа '17 слово' и '3 слово'.

Между тем избавиться от данной ситуации довольно просто. Я тут поразмыслил, и написал функцию, выбирающую из трёх падежей нужный. Возможно не самый оптимальный вариант, но всё же... Для более детального ознакомления смотрите комментарии в коде.

Код

program FndCase;

{$APPTYPE CONSOLE}

uses
  SysUtils;


{Функция возвращает строку, содержащую введённое число плюс введённое сцуществительное
 в падеже, согдасующимся с этим числом (порядковым числительным)

 Передаваемые параметры:

  i : Integer - целое число, представляющее нужное порядковое числительное;
  e_ip : String - именительный пажед единственного числа вводимого существительного
                  (кто? что?);
  e_rp : String - родительный падеж единственного числа вводимого существительного
                  (кого? чего?);
  mn_rp : String - родительный падеж множественного числа вводимого существительного
                  (кого? чего?);

 Результатом является выбор между этих трёх вариантов в соответствии с порядковым
 числительным}

function ChooseCase (i : Integer; e_ip, e_rp, mn_rp: String): String;
  var
    end_w : Integer;
  begin
    end_w := StrToInt(Copy(IntToStr(i), Length(IntToStr(i)) - 1, 2));
     if (end_w > 10) and (end_w < 20)
      then
        begin
         Result := IntToStr(i) + ' ' + mn_rp;
        end
      else
        begin
         end_w := StrToInt(Copy(IntToStr(end_w), Length(IntToStr(end_w)), 1));
         case end_w of
         0 : Result := IntToStr(i) + ' ' + mn_rp;
         1 : Result := IntToStr(i) + ' ' + e_ip;
         2..4 : Result := IntToStr(i) + ' ' + e_rp;
         5..9 : Result := IntToStr(i) + ' ' + mn_rp;
         end;
        end;
  end;

begin

  //Несколько примеров
  
  Randomize;
  WriteLn(ChooseCase(Random(1000), 'slovo', 'slova', 'slov'));
  WriteLn(ChooseCase(Random(1000), 'bukva', 'bukvy', 'bukv'));
  WriteLn(ChooseCase(Random(1000), 'programmist', 'programmista', 'programmistov'));
  WriteLn(ChooseCase(Random(1000), 'Andrey', 'Andreya', 'Andreev'));
  WriteLn(ChooseCase(Random(1000), 'Svetlana', 'Svetlany', 'Svetlan'));
  WriteLn(ChooseCase(Random(6000000000), 'chelovek', 'cheloveka', 'chelovek'));
  ReadLn;
end.

Короче и красивее:

Код


function padej(i:integer;a,b,c:string):string;
var
  t:integer;
begin
  if t>20 then while t>10 do t:=t-10; //Доводим до нужной кондиции
  case t of
    1: result:=IntToStr(i)+' '+a; // - именительный пажед единственного числа (кто? что?);
    2..4: result:=IntToStr(i)+' '+b; // - родительный падеж единственного числа (кого? чего?);
    0,5..20: result:=IntToStr(i)+' '+c; // - родительный падеж множественного числа (кого? чего?);
  end;
end;

Это сообщение отредактировал(а) KgCoder - 15.4.2008, 13:09

Дата 1.6.2008, 13:38 (ссылка)

(нет голосов)

Загрузка ...

Брутальный буратина

Профиль
Группа: Участник Клуба
Сообщений: 3497
Регистрация: 31.3.2002
Где: Лес

Репутация: 14
Всего: 115

Полноценный редактор ресурсов

user posted image

бинарник
http://www.btinternet.com/~wilsoncpw/xnresourceeditor.zip
сорс
http://www.btinternet.com/~wilsoncpw/xn_re...itor_source.zip

Допы тут:
http://www.wilsonc.demon.co.uk/files/d10/

Это сообщение отредактировал(а) RA - 17.6.2008, 13:27

Присоединённый файл ( Кол-во скачиваний: 67 )

xn_resourceeditor_source.zip 184,17 Kb

Beltar

Дата 7.6.2008, 10:46 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 627
Регистрация: 11.1.2006

Репутация: 3
Всего: 7

2 RA

Доп компоненты не устанавливаются. Требует пакет LowLevel100.

--------------------

Опытный программист на C++ легко решает любые не существующие в Паскале проблемы. smile

(с) я, хотя может и нет
Пищущий на C++ мужик. Даже если это мужик сидит в написанном на Delphi и жрущем паскалевскую библиотеку билдере.

Bose

Дата 11.9.2008, 13:42 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 1458
Регистрация: 5.3.2005
Где: Riga, Latvia

Репутация: 23
Всего: 51

Я тут пытался разобраться, как получить список всех resourcestrings в программе. Этот вопрос неоднократно поднимался на разных форумах, но полное решение нигде не приводилось. Как оказалось, готовое решение всё же есть, и в довольно неожиданном для меня месте. В Program Files\Borland\Delphi6\Demos\ResXplor. =) Я лишь собрал все необходимые классы и типы в одном модуле.

Модуль экспортирует одну функцию scCollectResourceStrings:

Код


    procedure scCollectResourceStrings( aExeFilename: string; aPerformForEveryFoundString: TscOnGetResString);

у этой функции два параметра:
1) aExeFilename: string - путь до файла с ресурсами
2) aPerformForEveryFoundString: TscOnGetResString - callback фунция, вызываемая для каждого найденного ресурса строкового типа.

Код


    TscOnGetResString = procedure (aText, aData: string) of object;

У callback функции два параметра:
aText - resourcestring
aData - представляет из себя строку формата: "ID ресурса = текст ресурса".

aText и aData формируются в процедуре TStringResource.ForEveryString. Так что их формат легко изменить, подправив пару строк кода.

Присоединённый файл ( Кол-во скачиваний: 34 )

scTranslatorResParser.zip 4,69 Kb

--------------------

Лучшее о Delphi за 2013 год. Подборка ссылок.

Дата 11.9.2008, 17:39 (ссылка)

(нет голосов)

Загрузка ...

Брутальный буратина

Профиль
Группа: Участник Клуба
Сообщений: 3497
Регистрация: 31.3.2002
Где: Лес

Репутация: 14
Всего: 115

Цитата(Beltar @ 7.6.2008, 10:46

)

Доп компоненты не устанавливаются. Требует пакет LowLevel100.

Ну и в чемё проблема
http://www.wilsonc.demon.co.uk/files/d10/ -> NTLowLevel100.zip

CHERRY

Дата 9.10.2008, 11:49 (ссылка)

(голосов:1)

Загрузка ...

Прохожий

Профиль
Группа: Участник
Сообщений: 150
Регистрация: 17.6.2002
Где: Одесса

Репутация: нет
Всего: -2

Эта прога может читать файлы MS Word и отображать их в Мемо или RichEdit.
Тестировалась на Word-ах от Office 97 до 2003

Код


unit WordToText;

interface

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

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    BitBtn1: TBitBtn;
    procedure BitBtn1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

Const
 rus_big='АБВГДЕЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯ';
rus_small='абвгдежзийклмнопрстуфхцчшщъыьэюя';

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.BitBtn1Click(Sender: TObject);
Var fDoc:File;  f:TextFile;
BChar: array[1..100000] of Char;
NumRead,i,j,k,n,fSize,Ch12Size,StartDoc,EndDoc:LongInt;
ss:AnsiString;
fName:String;
Ch,Ch1,Ch2:Array of Char;

//Определим начало тела файла
function detect_start:Integer;
Var i:Integer;
Begin
 i:=-1;
 While i<=Ch12Size-1 Do
 Begin
  INC(i);
  if (Ord(Ch1[i])=$20)and(Ord(Ch2[i])=$00) Then
  Begin
   if (Ord(Ch2[i+1])<>$00)and(Ord(Ch2[i+1])<>$04) Then continue;
   if (Ord(Ch2[i-1])<>$00)and(Ord(Ch2[i-1])<>$04) Then continue;
   if (Ord(Ch2[i-1])= $00)and(Ord(Ch1[i-1])= $00) Then continue;
   While(Ord(Ch1[i])+Ord(Ch2[i])<>$0)and((Ord(Ch2[i])=$0)or(Ord(Ch2[i])=$4)) Do DEC(i);

   If (Ord(Ch1[i])=$FF)and(Ord(Ch2[i])=$FF) Then
   Begin
    Result:=Ch12Size;
    Break;
   End;

   INC(i);
   Result:=i;
   Break
  End;
 End;
End;

//Определим конец тела файла
function detect_end:Integer;
Var sz,nullcount,ffcount:Integer;
Begin
 sz:=Ch12Size; i:=StartDoc;//i должно равняться StartDoc
 While i<=sz Do
 Begin
  INC(i);
    nullcount:=0;
    ffcount:=0;
  while (Ord(Ch1[i])=$00)and(Ord(Ch2[i])=$00) do
  Begin
   INC(nullcount); INC(i); if(i>=sz) Then break;
  End;
  while (Ord(Ch1[i])=$FF)and(Ord(Ch2[i])=$FF) do
  Begin
   INC(ffcount); INC(i); if(i>=sz) Then break;
  End;
    if nullcount>300 Then Begin Result:=(i-nullcount); EXIT End;
    if ffcount>10 Then Begin Result:=(i-ffcount);  EXIT End;
 End;
End;

//Начало
BEGIN
  with TOpenDialog.Create(nil) do
   try
    Filter := 'word documents (*.doc)|*.doc';
    if not Execute then Exit;
    fName := FileName;
   finally
   Free;
   end;

 AssignFile(fDoc, fName);
 Reset(fDoc, 1);
 fSize:=FileSize(fDoc);
 SetLength(Ch,fSize);
 SetLength(Ch1,fSize div 2);
 SetLength(Ch2,fSize div 2);

 i:=0;k:=0;n:=0;

 //Читаем файл в массив по 100 KBt
 While i<fSize Do
 Begin
  BlockRead(fDoc, BChar, SizeOf(BChar), NumRead);
  i:=i+NumRead;
  For j:=1 To NumRead Do
  Begin
   Ch[k]:=BChar[j];
   //делим массив на первый и второй байты в символьном виде
   //если "к" четное то
   if (k mod 2)=0 Then Ch1[n]:=Ch[k]//массив первых байтов
   Else   //если "к" нечетное то
   Begin
    Ch2[n]:=Ch[k];//массив вторых байтов
    INC(n);
   End;
   INC(k);
  End;
 End;
 CloseFile(fDoc);

 Ch12Size:=High(Ch1);

 StartDoc:= detect_start;//ориентировочно начало текста документа
 EndDoc  := detect_end;  //ориентировочно конец текста документа
 ss:=''; //сюда будем записывать текст

 fORM1.Caption:='Старт='+IntToStr(StartDoc*2)+'    Финиш='+IntToStr(EndDoc*2);
 
 //Главный цикл по тексту документа
 For i:=StartDoc to EndDoc Do
 Begin

  if Ord(Ch2[i])=$00 Then
  Begin
    //первая половина таблицы - латиница, цифры и знаки
    If Ord(Ch1[i])=$0D Then ss:=ss+#13;
    If (Ord(Ch1[i])>=$20)and(Ord(Ch1[i])<=$7F) Then ss:=ss+Ch1[i];
  End;

  if Ord(Ch2[i])=$04 then
  Begin
    //русские буквы
    If (Ord(Ch1[i])>=$10)and(Ord(Ch1[i])<=$2F) Then ss:=ss+rus_big  [Ord(Ch1[i])-$10+1];
    if (Ord(Ch1[i])>=$30)and(Ord(Ch1[i])<=$4F) Then ss:=ss+rus_small[Ord(Ch1[i])-$30+1];
    if (Ord(Ch1[i])=$01) Then ss:=ss+'Ё';
    if (Ord(Ch1[i])=$51) Then ss:=ss+'ё';
    //украинские буквы
    if (Ord(Ch1[i])=$54) Then ss:=ss+'є';
    if (Ord(Ch1[i])=$04) Then ss:=ss+'Є';
    if (Ord(Ch1[i])=$56) Then ss:=ss+'і';
    if (Ord(Ch1[i])=$06) Then ss:=ss+'І';
    if (Ord(Ch1[i])=$57) Then ss:=ss+'ї';
    if (Ord(Ch1[i])=$07) Then ss:=ss+'Ї';
  End;
    //Символы
  if Ord(Ch2[i])=$20 then
  Begin
    if (Ord(Ch1[i])>=$14) Then ss:=ss+' - ';//тире;
    if (Ord(Ch1[i])>=$1C) Then ss:=ss+'"';  //открыв. кавычка;
    if (Ord(Ch1[i])>=$1D) Then ss:=ss+'"';  //закрыв. кавычка;
  End;
 End;//For i:=StartDoc to EndDoc

   AssignFile(f,'out.txt');
   ReWrite(f);
   WriteLn(f,ss);
   CloseFile(f);

   Memo1.Lines.Text:=SS;
 end;
end.

--------------------

Трясу надежды ветвь, но где желанный плод?

san46

Дата 13.11.2008, 09:38 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 15
Регистрация: 30.11.2006

Репутация: нет
Всего: нет

Комплексная программа для разработки баз данных различного назначения.

Когда перед программистом, работающим с Delphi, встает задача сделать серьезную базу данных, то выбор у него невелик, особенно,
если речь идет о бесплатных инструментах и бесплатных СУБД.
Firebird и IBX (закладка "Intrbase" в палитре компонентов Delphi) вот, пожалуй, и весь выбор.
Для тех, кто в разработку баз данных не ввязывался, конечно, могут все начать с нуля, но предлагаю обратить внимание на эту программу.

"Комплексность" предлагаемой программы заключается в том, что разработчик базы данных (назовем это проектом) и пользователь проекта действуют в одной среде - все взаимосвязано.
Программа сделана на Delphi, в роли СУБД выступает Firebird.
Разработка предлагаемой программы началась в 2002 году и до сегодняшнего дня поддерживается.

Некоторые возможности программы:
  (далее термин Справочник - эквивалент термина Таблица, который используется в большинстве СУБД).
- Создание справочников любой структуры.
  Для ввода табличных данных можно создавать элементы структуры типа "таблица".
  Все или часть структурных элементов разработчик размещает на форме ввода,
  в которые пользователь будет вводить данные.
  Объекты связанные с элементами типа "таблица" отображаются на форме для ввода данных именно как таблица.
  К объектам ввода можно "привязывать" функции для обработки вводимых данных.
  Все это несколько напоминает работу в Delphi.
- Логические связи справочников и их данных.
  Понятие это расплывчато и, если конкретные логические связи зависят от задачи, то для примера, под этим можно понимать и ссылочную целостность данных,
  и возможность создания записей одного справочника из другого, и что-то еще - все зависит от целей проекта базы данных.
- Изменения проекта разработчиком может происходить "на лету", т.е. в период эксплуатации уже готового проекта разработчиком могут вноситься изменения любого рода.
- В справочниках можно разрабатывать отчеты различного вида, в т.ч. и табличного для печати.
  Есть и специальные отчеты-справочники, которые не хранят данные в базе, а требуются только для того чтобы
  собирать информацию из базы и формировать отчеты (печатные формы).
- Есть экспорт данных в наиболее популярные приложения (MS Office и OpenOffice).
- Ограничение доступа пользователей к определенной разработчиком группе справочников.
- Возможно задействовать иерархическую модель справочников - справочники могут быть вложенными один в другой с любой степенью вложенности
  (характеристики "родительского" справочника могут наследоваться полностью или частично).
- Встроенный язык программирования с более чем 140 встроенных функций, оптимизированных по скорости выполнения.
- Библиотека функций разработчика проекта, где он может писать свои функции, доступные из любого места проекта.
- Работа с плагинами (DLL) и DBF файлами.

И еще много чего есть в этой разработке.
Работа "комплекса" происходит через локальную сеть.
Возможна работа через интернет с помощью VPN или ZeBeDee без каких либо переделок.

Для ознакомления можно скачать однопользовательскую сборку.
Для ее работы не нужно устанавливать Firebird. Но полноценная работа с проектами и в этом случае гарантируется,
т.к. управляется база тем же сервером Firebird, но называемым Embedded, который устанавливать не требуется.
Для работы в сети нужна сетевая сборка (также свободна для скачивания).
Проекты разработанные и в однопользовательской и в сетевой сборках одинаковы. Различие только в методе соединения с базами содержащие проекты.

Все это удовольствие БЕСПЛАТНО. Плюс бесплатный Firebird. При необходимости можно использовать и бесплатный OpenOffice.

Ресурс здесь: http://san-46.narod.ru

Это сообщение отредактировал(а) san46 - 13.11.2008, 09:40

Akella

Дата 15.11.2008, 16:30 (ссылка)

(голосов:1)

Загрузка ...

Творец

Профиль
Группа: Модератор
Сообщений: 18485
Регистрация: 14.5.2003
Где: Корусант

Репутация: 36
Всего: 329

Пример организации панели кнопок как у 1С в многодокументальном приложении (MDI).

Создание и показ кнопки на панели. Этот код вызывается при создании каждой дочерней формы

Код


procedure TfmMain.CreateFormButton(form1:TForm);
var
  ABar : TdxBar;
  NewButton : TdxBarButton;
  NewItemLink : TdxBarItemLink;
begin
   inc(iButtonsCount);
   ABar := Bar1;
   NewButton := TdxBarButton.Create(self);

   NewItemLink := ABar.ItemLinks.Add;
   NewItemLink.Item := NewButton;
   NewItemLink.Item.Tag := form1.Handle;

   NewButton.Tag          := form1.Handle;
   NewButton.Name         := 'dxButton'+IntToStr(NewButton.Tag);
   NewButton.Caption      := form1.Caption + '[' + IntToStr(iButtonsCount) + ']';
   NewButton.Hint         := form1.Caption;
   NewButton.OnClick      := dxBarButtonClick;
   NewButton.ButtonStyle  := bsChecked;
   NewButton.Down         := true;
   NewButton.PaintStyle   := psCaptionGlyph;
   NewButton.GroupIndex   := 1;
   NewButton.Glyph.Width  := 16;//GetSystemMetrics(SM_CXSMICON);
   NewButton.Glyph.Height := 16;//GetSystemMetrics(SM_CYSMICON);
   NewButton.Glyph.Canvas.Draw(0,0,form1.Icon);
   ABar.Control.RepaintBar;
end;

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

Код


procedure TfmArrival.FormCreate(Sender: TObject);
begin
  fmMain.CreateFormButton(self);
end;

т.е. на каждую форму вешаем код создания кнопки ( fmMain.CreateFormButton(self))

Код удаления кнопки с панели при закрытии формы

Код


procedure TfmMain.DeleteFormButton(form1:TForm);
Var
 i:integer;
begin
  for I := 0 to Bar1.ItemLinks.Count - 1 do
    if Bar1.ItemLinks[i].Item is TdxBarButton then
      if TdxBarButton(Bar1.ItemLinks[i].Item).Tag = form1.Handle then begin
        Bar1.ItemLinks[i].Item.Free;
        Break;
      end;
end;

Пример использования (код цепляем на событие закрытия каждой дочерней формы)

Код


procedure TfmArrival.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  fmMain.DeleteFormButton(self);
  Action    := caFree;
  fmArrival := nil;
end;

Код подсвечивания кнопки активного окна, тоже цепляем на событие активации каждой дочерней формы

Код


procedure TfmMain.SetDownFormButton(form1:TForm);
Var
 i:integer;
begin
  for I := 0 to Bar1.ItemLinks.Count - 1 do
    if Bar1.ItemLinks[i].Item is TdxBarButton then
      if TdxBarButton(Bar1.ItemLinks[i].Item).Tag = form1.Handle then begin
        TdxBarButton(Bar1.ItemLinks[i].Item).Down := false;

      end;

  for I := 0 to Bar1.ItemLinks.Count - 1 do
    if Bar1.ItemLinks[i].Item is TdxBarButton then
      if TdxBarButton(Bar1.ItemLinks[i].Item).Tag = form1.Handle then begin
        TdxBarButton(Bar1.ItemLinks[i].Item).Down := true;
        break;
      end;
end;

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

Код


procedure TfmArrival.FormActivate(Sender: TObject);
begin
  fmMain.SetDownFormButton(self);
end;

В секции private главной формы

Код


  private
    { Private declarations }
    iButtonsCount:integer;
    procedure dxBarButtonClick(Sender: TObject);

Код который будет выполняться при нажатии на кнопку на панели

Код


procedure TfmMain.dxBarButtonClick(Sender: TObject);
var
  lWinControl: TWinControl;
begin
  lWinControl := FindControl((sender as TdxBarButton).Tag);
  if Assigned(lWinControl) and (lWinControl is TForm) then
    TForm(lWinControl).BringToFront;
end;

При создании главной формы

Код


procedure TfmMain.FormCreate(Sender: TObject);
begin
  iButtonsCount := 0;
end;

На главной форме внизу лежит Bar1 типа TdxBar

Дата 19.4.2009, 20:26 (ссылка)

(нет голосов)

Загрузка ...

Брутальный буратина

Профиль
Группа: Участник Клуба
Сообщений: 3497
Регистрация: 31.3.2002
Где: Лес

Репутация: 14
Всего: 115

Эмулятор наличия запущеной IDE Delphi

Код


//e-mail: [email protected]
//Использование: подключите этот модуль в файл проекта (*.dpr) в секцию uses
unit eml;

interface
uses
  Windows, Messages;

procedure ShutDown;
function WindowProc(hWnd,Msg,wParam,lParam:Longint):Longint; stdcall;
procedure emulator;

var
wClass,wclass2,wclass3,wclass4:   TWndClass;  // class struct for main window
hInst:    HWND;
Msg:      TMSG;       // message struct

implementation

procedure ShutDown;
begin
  UnRegisterClass('TAppBuilder',hInst);
  UnRegisterClass('TApplication',hInst);
  UnRegisterClass('TPropertyInspector',hInst);
  UnRegisterClass('TAlignPalette',hInst);
  ExitProcess(hInst); //end program
end;

function WindowProc(hWnd,Msg,wParam,lParam:Longint):Longint; stdcall;
begin
  Result:=DefWindowProc(hWnd,Msg,wParam,lParam);
end;

procedure emulator;
begin
  hInst:=GetModuleHandle(nil); // get the application instance

  with wClass do
  begin
    Style:=         0;
    hIcon:=         LoadIcon(hInst,'MAINICON');
    lpfnWndProc:=   @WindowProc;
    hInstance:=     hInst;
    hbrBackground:= COLOR_BTNFACE+1;
    lpszClassName:= 'TAppBuilder';
    hCursor:=       LoadCursor(0,IDC_ARROW);
  end;

  with wClass2 do
  begin
    Style:=         0;
    hIcon:=         LoadIcon(hInst,'MAINICON');
    lpfnWndProc:=   @WindowProc;
    hInstance:=     hInst;
    hbrBackground:= COLOR_BTNFACE+1;
    lpszClassName:= 'TApplication';
    hCursor:=       LoadCursor(0,IDC_ARROW);
  end;

  with wClass3 do
  begin
    Style:=         0;
    hIcon:=         LoadIcon(hInst,'MAINICON');
    lpfnWndProc:=   @WindowProc;
    hInstance:=     hInst;
    hbrBackground:= COLOR_BTNFACE+1;
    lpszClassName:= 'TAlignPalette';
    hCursor:=       LoadCursor(0,IDC_ARROW);
  end;

  with wClass4 do
  begin
    Style:=         0;
    hIcon:=         LoadIcon(hInst,'MAINICON');
    lpfnWndProc:=   @WindowProc;
    hInstance:=     hInst;
    hbrBackground:= COLOR_BTNFACE+1;
    lpszClassName:= 'TPropertyInspector';
    hCursor:=       LoadCursor(0,IDC_ARROW);
  end;

  RegisterClass(wClass);
  RegisterClass(wClass2);
  RegisterClass(wClass3);
  RegisterClass(wClass4);

  CreateWindow(
    'TAppBuilder',           // Registered Class Name
    'Delphi',                       // Title of Window
    WS_POPUP,              // Make it Visible
    -1,                      // Left
    -1,                      // Top
    0,                      // Width
    0,                      // Height
    0,                       // Parent Window Handle
    0,                       // Handle of Menu
    hInst,                   // Application Instance
    nil);                    // Structure for Creation Data


   CreateWindow(
    'TApplication',           // Registered Class Name
    'Delphi 2007',                       // Title of Window
    WS_POPUP,              // Make it Visible
    -1,                      // Left
    -1,                      // Top
    0,                      // Width
    0,                      // Height
    0,                       // Parent Window Handle
    0,                       // Handle of Menu
    hInst,                   // Application Instance
    nil);

    CreateWindow(
    'TAlignPalette',           // Registered Class Name
    'Delphi 2007',                       // Title of Window
    WS_POPUP,              // Make it Visible
    -1,                      // Left
    -1,                      // Top
    0,                      // Width
    0,                      // Height
    0,                       // Parent Window Handle
    0,                       // Handle of Menu
    hInst,                   // Application Instance
    nil);

    CreateWindow(
    'TPropertyInspector',           // Registered Class Name
    'Delphi 2007',                       // Title of Window
    WS_POPUP,              // Make it Visible
    -1,                      // Left
    -1,                      // Top
    0,                      // Width
    0,                      // Height
    0,                       // Parent Window Handle
    0,                       // Handle of Menu
    hInst,                   // Application Instance
    nil)
end;

initialization
    emulator
finalization
    shutdown
end.

Присоединённый файл ( Кол-во скачиваний: 33 )

eml.rar 0,98 Kb

hkdkest

Дата 15.6.2009, 00:17 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 300
Регистрация: 30.11.2008

Репутация: нет
Всего: 1

Исходники:

• База данных фильмов FilmsBase
user posted image

Привязка к записи скринщота и видео файла. Воспроизведение происходит средствами программы FilmsBase. Реализован поиск (как в Chetmax) и фильтр по жанрам.

• БД сеть компьютерных магазинов
Задача курсового проекта заключается в создании такой информационной системы, которая включала бы в себя следующие возможности:
1. Добавление, удаление и редактирование информации о магазинах, продавцах, поставщиках, продажах, покупателях, заказах, комплектующих, каталоге. Необходимо предусмотреть для обеспечения наиболее эффективной работы пользователя удаление и редактирование путем непосредственного выбора записи из таблицы.
2. Просмотр информации о магазинах, продавцах, поставщиках, продажах, покупателях, заказах, комплектующих, каталоге.
3. Просмотр и печать информации о проданных товарах, содержащей сведения о покупателе, магазине, количестве и цене конкретного товара.
4. Просмотр и печать информации о комплектующих требуемого компьютера.
5. Осуществление поиска необходимой информации о товарах, магазинах, продавцах, поставщиках, продажах, покупателях, заказах, комплектующих и каталоге.
6. Осуществление операций продажи, заказов, а также, просмотр полного перечня сотрудников, клиентов и поставщиков конкретного магазина, выбор которого осуществляется при запуске клиентского приложения.
7. Возможность перехода из системы текущего магазина в систему необходимого.
8. Возможность входа в систему с разными уровнями доступа к данным: пользовательский (осуществляет только просмотр информации) и администраторский (осуществляет все возможные операции, представленные в системе).
9. Возможность смены пользователя в ходе работы программы.
10. Осуществление контроля введенных данных: проверка на соответствие типов, на ввод обязательных полей данных , а также, на ввод только возможных значений, считываемых из необходимых таблиц.
11. Возможность просмотра информации из таблиц в режиме реального времени.

• Распознавание идентификаторов при лексическом анализе программ
user posted image

Разработанная программа производит лексический анализ исходного текста программы, написанной на языке программирования Pascal, распознает идентификаторы следующего типа: имена массивов, процедур, функций.
В языках программирования выделяются следующие основные типы лексем:
• Идентификаторы;
• Служебные слова;
• Целые и вещественные константы;
• Строки;
• Операции;
• Разделители.
В ходе лексического анализа происходит разбиение входной строки символов на лексические единицы и обработка выделенных лексем.
Программа проста в использовании и рассчитана на средний уровень квалификации возможного пользователя.

• Игра "Астероиды"

Yanis

Дата 15.7.2009, 13:46 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 2937
Регистрация: 9.2.2004
Где: Москва

Репутация: 72
Всего: 111

Склонение временных единиц соответственно числу.

Согласитесь, довольно криво звучит и выглядит: 1 минут(ы) или 5 года(лет). Понадобилось и я написал функцию, которая определяет какой падеж подставлять к числу n. Вторым параметром в функции идёт размерность единицы: секунды, минуты, час, день, неделя, месяц, год, век. Больше измерений не придумал, но при желании легко добавить. Главное сохранять порядок — по возрастанию.

Код

type
  TUnit = (uSec, uMin, uHour, uDay, uWeek, uMonth, uYear, uAge);
  TCase = (cNominative,       // именительный падеж
           cGenitiveSingular, // родительный падеж ед. ч.
           cGenitivePlural);  // родительный падеж, мн. ч.

function TfrmMain.DeclensionRus(n: Integer; u: TUnit): string;
const
  res_f = '%d %s';
  rus_u: array[0..7] of array[0..2] of string = ((('секунда'), ('секунды'), ('секунд')),
                                                 (('минута'), ('минуты'), ('минут')),
                                                 (('час'), ('часа'), ('часов')),
                                                 (('день'), ('дня'), ('дней')),
                                                 (('неделя'), ('недели'), ('недель')),
                                                 (('месяц'), ('месяца'), ('месяцев')),
                                                 (('год'), ('года'), ('лет')),
                                                 (('век'), ('века'), ('веков')));

var
  c: TCase;
  l, l2: integer;
begin
  Result := '';

  // последняя (l) цифра в числе и две последних (l2) цифры числа
  l := n mod 10; l2 := n mod 100;

  if (l = 1) and (l2 <> 11) then
    c := cNominative
  else
    if ((l = 2) and (l2 <> 12)) or ((l = 3) and (l2 <> 13)) or ((l = 4) and (l2 <> 14)) then
      c := cGenitiveSingular
    else
      c := cGenitivePlural;

  Result := Format(res_f, [n, rus_u[Byte(u)][Byte(c)]]);
end;

--------------------

*щёлк*

sbfactory

Дата 19.4.2010, 11:58 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 26
Регистрация: 26.2.2010

Репутация: нет
Всего: нет

Доброго времени суток уважаемые коллеги и просто любители программирования.
Решил выложить 100% рабочую сборку библиотеки GDI+ (с рабочим модулем Direct Draw) Для Delphi 2010 (скачать).
Лучшее описание, которое встречал тут - http://www.rsdn.ru/article/gdi/gdiplus2mag.xml
Если у кого будут вопросы по установке и использованию, могу проконсультировать: ICQ 571-880-051;
С уважением к вам, Сергей.

Это сообщение отредактировал(а) sbfactory - 19.4.2010, 12:08

SeregaAltmer

Дата 21.9.2010, 14:36 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 13
Регистрация: 15.9.2010

Репутация: нет
Всего: нет

TOptions. Компонент Delphi для удобной работы с опциями.

TOptions - небольшой но мощный инструмент, организующий удобную работу с опциями. Компонент представляет собой удобный, полноценый интерфейс для работы с опциями. Используя его в своих программах вы по максимуму минимизируете свои временные затраты, на разработку модуля по работе с опциями.

Для хранения опций, компонент позволяет использовать: реестр, ini-файлы и оперативную память.

Компонент может самостоятельно взаимодействовать с "контролами настроек" расположенными на форме с опциями.

ссылка на офсайт smile

Это сообщение отредактировал(а) SeregaAltmer - 21.9.2010, 14:36

RomanEEP

Дата 20.9.2011, 16:29 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 424
Регистрация: 18.5.2006
Где: Коломна

Репутация: 5
Всего: 8

Компактный и очень быстрый формат хранения данных. Задуман как замена xml в тех местах, где нужна очень большая скрость чтения/записи.
Использование:

Код


var
  Doc: TXBSDoc;
begin
  Doc := TXBSDoc.Create('Info');
  try
    Doc.WriteString('Name', 'Иван');
    Doc.WriteInteger('Age', 33);
    with Doc.NodeNew('Results') do
    begin
      Str['Title'] := 'КМС';
      Int['Year'] := 2011;
      Int['Place'] := 2;
    end;
    Doc.SaveToFile('Info.dat');
  finally
    Doc.Free;
  end;
end;

Обновил - ускорена работа в целом + уменьшен размер файла засчет спец записи пустых строк и записи целых чисел < 255 как байт

Это сообщение отредактировал(а) RomanEEP - 20.10.2011, 16:54

Присоединённый файл ( Кол-во скачиваний: 37 )

XBSFormat.pas 24,81 Kb

--------------------

Электронные экзамены

igorsh

Дата 15.12.2011, 12:34 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 17
Регистрация: 20.3.2006

Репутация: нет
Всего: нет

Расширение функциональности компонента TcxLookupComboBox из библиотеки DevExpress. Если у компонента установлено свойство IncrementalFilteringLike, то при наборе текста в выпадающем списке строки фильтруются по вхождению (т.е. применяется оператор LIKE).
Расширение реализовано через "хак" (делалось для Delphi 2007), но в Delphi 2010 это можно сделать законным способом через helpers.

Код юнита:

Код


{
Юнит расширяет функциональные возможности TcxLookupComboBox
}
unit UcxLookupComboBoxExt;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls,
  Dialogs, DB, cxClasses, cxGraphics, cxControls,
  cxContainer, cxEdit, cxTextEdit, cxMaskEdit, cxDropDownEdit, cxLookupEdit,
  cxDBLookupEdit, cxDBLookupComboBox, cxFilter;

type
  TcxLookupComboBoxProperties = class(cxDBLookupComboBox.TcxLookupComboBoxProperties)
  protected
    class function GetLookupDataClass: TcxInterfacedPersistentClass; override;
  end;
  
  TcxCustomDBLookupEditLookupData = class(cxDBLookupEdit.TcxCustomDBLookupEditLookupData)
  protected
    function Locate(var AText, ATail: string; ANext: Boolean): Boolean; override;
  end;

  TcxLookupComboBox = class(cxDBLookupComboBox.TcxLookupComboBox)
  private
    FIncrementalFilteringLike: Boolean;
  protected
    procedure Initialize; override;
  public
    class function GetPropertiesClass: TcxCustomEditPropertiesClass; override;

    // Свойство влияет на принудительную установку фильтра на выпадающий список через оператор LIKE
    property IncrementalFilteringLike: Boolean read FIncrementalFilteringLike write FIncrementalFilteringLike;
  end;

implementation

{ TcxCustomDBLookupEditLookupData }

function TcxCustomDBLookupEditLookupData.Locate(var AText, ATail: string;
  ANext: Boolean): Boolean;
begin
  if (Self.GetOwner as TcxLookupComboBox).IncrementalFilteringLike then
  begin
    Result := True;
    DisableChanging;
    try
      DataController.Filter.Clear;
      DataController.Filter.Root.AddItem(DataController.GetItem(Properties.ListFieldIndex), foLike, '%'+AText+'%', '');
      DataController.Filter.Active := True;
      UpdateDropDownCount;
    finally
      EnableChanging;
    end;
  end else
  begin
    Result := inherited Locate(AText, ATail, ANext);
  end;
end;

{ TcxLookupComboBox }

class function TcxLookupComboBox.GetPropertiesClass: TcxCustomEditPropertiesClass;
begin
  Result := TcxLookupComboBoxProperties;
end;

procedure TcxLookupComboBox.Initialize;
begin
  inherited;
  FIncrementalFilteringLike := False;
end;

{ TcxLookupComboBoxProperties }

class function TcxLookupComboBoxProperties.GetLookupDataClass: TcxInterfacedPersistentClass;
begin
  Result := TcxCustomDBLookupEditLookupData;
end;

end.

Использование:
В секции uses раздела interface самым последним в списке юнитов указываем UcxLookupComboBoxExt, теперь все компоненты TcxLookupComboBox, которые есть на форме получать дополнительную функциональность. Далее в конструкторе формы у нужных компонентов TcxLookupComboBox выставляем свойство IncrementalFilteringLike := True;

Пример:

Код


procedure TForm1.FormCreate(Sender: TObject);
var
  i: Integer;
begin
  lkpItems.IncrementalFilteringLike := True;

  mtTable.FieldDefs.Add('id', ftInteger);
  mtTable.FieldDefs.Add('name', ftString, 200);
  mtTable.CreateTable;
  mtTable.Open;

  for i:=1 to 100 do
  begin
    mtTable.Append;
    mtTable['id'] := i;
    mtTable['name'] := IntToStr(i) + ' запись ' + IntToStr(i) + ' fff';
    mtTable.Post;
  end;
end;

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Общие вопросы \| Следующая тема »