Часовой пояс: UTC + 3 часа




Начать новую тему Новая тема / Ответить на тему Ответить  Сообщений: 2317 • Страница 86 из 116<  1 ... 83  84  85  86  87  88  89 ... 116  >
  Пред. тема | След. тема 
В случае проблем с отображением форума, отключите блокировщик рекламы
Автор Сообщение
 

Member
Статус: Не в сети
Регистрация: 06.02.2006
Откуда: Одесса
Xupyp1 писал(а):
Почему-то кажется, что какую-то глупость сморозил

ничего глупого нет.....
можете поковырять разные fileopen и тп. Если б текст был не ртф а бычный было бы проще.... самый сложный путь читать обычными функциями и самому производить формирование документа... т.е. в плане делфи - изобретать велосипед. А вообще гляньте на библиотеку JVCL - там множество полезных классов в т.ч. и для чтения файлов разного типа.

_________________
Mom! Kitty's being a dildo!



Партнер
 

Member
Статус: Не в сети
Регистрация: 15.02.2005
Откуда: Минск
Народ, подскажите плиз алгоритм решения уравнения 5го порядка (АХ**5 + ВХ**4 + СХ**3 + DX**2 + EX + F = 0) в делфе. Необходимо найти положительные корни.

Бошка уже болит... проект "вчера" сдавать надо :(

_________________
=nVidia OverGuru=
http://svetguitars.nm.ru/


 

Member
Статус: Не в сети
Регистрация: 02.12.2004
Sergey_H
Sergey_H писал(а):
гляньте на библиотеку JVCL

Качнул чуть больше 10Мб распаковалось на 180Мб :)
Смотрел, смотрел классы и бросил :)
Лучше, имхо, нечто типо архиватора использовать.
Тобиш хранить все ресурсы в защищенном архиве.
При необходимости можно дополнительно подключить шифрующие модули.
Получится сейф в сейфе :)


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

Код:
TAnswers = record
    Data : array[0..50] of String[255];
    isGood : array[0..50] of byte;
    Count : byte;
  end;

  TQuastion = record
    Text : string[255];
    QType : byte;
    TimeSec : integer;
    Answers : TAnswers;
  end;

  TQuastions = record
    Data : array[0..50] of TQuastion;
    Count : byte;
    Used : array[0..50] of byte;
    UCount : byte;
  end;

  TTest = record
    Quastions : TQuastions;
    Name : string[255];
  end;

  TResultInfo = record
    UserName : string[255];
    RCount : byte;
    R : array[0..50] of byte;
  end;


Пишется в файл методом Write :) :
Код:
var
  sd : TSaveDialog;
begin
  sd := TSaveDialog.Create(frmMain);
  try
    sd.Filter:='Файлы Тестов (*.btst)|*.btst|Все файлы (*.*)|*.*';
    sd.DefaultExt:='btst';
    sd.FilterIndex:=0;
    if sd.Execute then
      begin
        AssignFile(f, sd.FileName);
        Rewrite(f); //f file of TTest;
        if Test.Name='Безымянный тест' then
          Test.Name:=ExtractFileName(sd.FileName);
        Test.Quastions:=Quastions;
        Write(f, Test);
        CloseFile(f);
      end;
  finally
    TestFileName:=sd.FileName;
    sd.Free;
  end;


 

Member
Статус: Не в сети
Регистрация: 06.02.2006
Откуда: Одесса
Xupyp1 писал(а):
Сейчас нахожусь в состоянии эйфории т.к. такую прогу сделал... Одно обстоятельство лишь беспокоит.Практически пустой файл данных занимает не меньше полуметра дискового пространства

в JVCL есть компоненты для архивировани\разархивирования файлов в зип формат - сам их юзаю

_________________
Mom! Kitty's being a dildo!


 

Member
Статус: Не в сети
Регистрация: 03.01.2003
Откуда: Ростов-на-Дону
Sergey_H А на какой они там вкладке? Хотя может у меня какая нить старая версия, у меня 3.20 установлена.

_________________
Just Zerg! Остановим деградацию русского языка, скажем нет удафкомовской лексике!!


 

Member
Статус: Не в сети
Регистрация: 23.12.2004
Откуда: Беларусь, Минск
Delphi 7 Enterprise так и остаётся лучшим IDE из Делфей?

_________________
ASUS A4M88T-M, Athlon II X3 425, 2GB NCP, video - internal ATI 4250, 200GB Samsung HDD, Win7 x64


 

Advanced member
Статус: Не в сети
Регистрация: 09.06.2003
Откуда: USSR
AzaZeo писал(а):
Delphi 7 Enterprise так и остаётся лучшим IDE из Делфей?

Для меня да. Все что выше само написано на .NET и по сути своей тормоз конкретный. Ждем Highlander :)


 

Member
Статус: Не в сети
Регистрация: 16.04.2006
Откуда: d3d9.dll
Фото: 7
Народ, ни у кого случаем не завалялась где-нибудь функция, преобразующая двоичное число в десятичное? А то вот откапал такую:
Код:
function BinToInt(Value: String): Integer;
 var
 i,Size: Integer;
 begin
  Result:=0;
  Size:=Length(Value);
  for i:=Size downto 0 do begin
    if Copy(Value,i,1)='1' then begin
    Result:=Result+(1 shl i);
    end;
  end;
 end;

а она работает некорректно. :(


 

Member
Статус: Не в сети
Регистрация: 02.12.2004
Shader 3.0
Нашел вот что:
Код:
function BaseConvert(NumIn: string; BaseIn: Byte; BaseOut: Byte): string;

var

i: integer;

currentCharacter: char;

CharacterValue: Integer;

PlaceValue: Integer;

RunningTotal: Double;

Remainder: Double;

BaseOutDouble: Double;

NumInCaps: string;

s: string;

begin

if (NumIn = '') or (BaseIn < 2) or (BaseIn > 36) or (BaseOut < 1) or (BaseOut > 36) then

begin

   Result := 'Error';

   Exit;

end;

 

NumInCaps    := UpperCase(NumIn);

PlaceValue   := Length(NumInCaps);

RunningTotal := 0;

 

for i := 1 to Length(NumInCaps) do

begin

   PlaceValue       := PlaceValue - 1;

   CurrentCharacter := NumInCaps[i];

   CharacterValue   := 0;

   if (Ord(CurrentCharacter) > 64) and (Ord(CurrentCharacter) < 91) then

     CharacterValue := Ord(CurrentCharacter) - 55;

 

   if CharacterValue = 0 then

     if (Ord(CurrentCharacter) < 48) or (Ord(CurrentCharacter) > 57) then

     begin

       BaseConvert := 'Error';

       Exit;

     end

     else

       CharacterValue := Ord(CurrentCharacter);

 

   if (CharacterValue < 0) or (CharacterValue > BaseIn - 1) then

   begin

     BaseConvert := 'Error';

     Exit;

   end;

   RunningTotal := RunningTotal + CharacterValue * (Power(BaseIn, PlaceValue));

end;

 

while RunningTotal > 0 do

begin

   BaseOutDouble := BaseOut;

   Remainder     := RunningTotal - (int(RunningTotal / BaseOutDouble) * BaseOutDouble);

   RunningTotal  := (RunningTotal - Remainder) / BaseOut;

 

   if Remainder >= 10 then

     CurrentCharacter := Chr(Trunc(Remainder + 55))

   else

   begin

     s := IntToStr(trunc(remainder));

     CurrentCharacter := s[Length(s)];

   end;

   Result := CurrentCharacter + Result;

end;

end;


Пример:
Код:
var
s:string;
///
///
s:=BaseConvert('FFFF', 16, 10);


Код взят из DRKB3


 

Member
Статус: Не в сети
Регистрация: 16.04.2006
Откуда: d3d9.dll
Фото: 7
Xupyp1
Спасибо. Но у меня эта функция как-то интересно работает - только с шестнадцатиричными числами, представленными буквенными символами (типа AFDC, AEFF и т. п.). Но мне надо бы перевести из двоичной системы в десятичную... В общем подумал немного и решил сам написать такую функцию. А потом в нете случайно нашёл как раз то что нужно. Вот, может кому-нибудь пригодится:
Код:
function BinToInt(BinStr : string) : Int64;
var i : byte;
    RetVar : Int64;
begin
   BinStr := UpperCase(BinStr);
   if BinStr[length(BinStr)] = 'B' then Delete(BinStr,length(BinStr),1);
   RetVar := 0;
   for i := 1 to length(BinStr) do begin
     if not (BinStr[i] in ['0','1']) then begin
        RetVar := 0;
        Break;
     end;
     RetVar := (RetVar shl 1) + (byte(BinStr[i]) and 1) ;
   end;
   
   Result := RetVar;
end;

Для обратного перевода (из десятичной СИ в двоичную) юзаю это:
Код:
function IntToBin(Value: Integer;Size: Integer): String;
 var
 i: Integer;
 begin
  Result:='';
  for i:=Size downto 0 do begin
    if Value and (1 shl i)<>0 then begin
    Result:=Result+'1';
    end else begin
    Result:=Result+'0';
    end;
  end;
 end;


 

Member
Статус: Не в сети
Регистрация: 02.12.2004
Народ, а как прочитать параметр запуска приложения?
В моем случае передается путь к файлу.
Разумеется он содержит немало пробелов :(
Как вы понимаете этот самый путь делится на куски и записывается в массив ParamStr

Я этот самый параметр читаю таким образом:
Код:
CMDLine:='';
For i:=1 to ParamCount do
   CMDLine:=CMDLine+ParamStr(i)+' ';
ShowMessage(CMDLine);

Имхо, это криво до невозможности :oops:
Есть какой-то другой способ?

И еще вопросик :)
В файл записывается структура:
Код:
    TBookItem = record
    ItemName: string;
    LecFileName : string;
    LabFileName : string;
    TstFileName : string;
  end;

  TBookFolder = record
    FolderName : string;
    Items : array of TBookItem;
  end;

  TBook = record
    BookName : string;
    AuthorName : string;
    RootFolders: array of TBookFolder;
    RootItems: array of TBookItem;
  end;

Везде String'и и динамические массивы :(
В результате получился геморрой....
Код:
procedure SaveBook(filename: string);
var tmpstr:array[0..255] of AnsiChar;
 fileh: System.Cardinal;
 i,j,k,dwWritten:dword;
begin
  strpcopy(tmpstr, filename);
  fileh:=CreateFile(tmpstr, GENERIC_WRITE, FILE_SHARE_WRITE, nil, CREATE_ALWAYS, 0, 0);
  if fileh<>INVALID_HANDLE_VALUE then
  begin
    strpcopy(tmpstr, Book.BookName);
    i:=length(Book.BookName);
    WriteFile(fileh, &i, sizeof(i), &dwWritten, nil);
    WriteFile(fileh, tmpstr, i, &dwWritten, nil);
    i:=length(Book.AuthorName);
    strpcopy(tmpstr, Book.AuthorName);
    WriteFile(fileh, &i, sizeof(i), &dwWritten, nil);
    WriteFile(fileh, tmpstr, i, &dwWritten, nil);
    i:=length(Book.RootItems);
    WriteFile(fileh, &i, sizeof(i), &dwWritten, nil);
    if i > 0 then
    begin
      for i := 0 to length(Book.RootItems) - 1 do
        begin
          j:=length(Book.RootItems[i].ItemName);
          strpcopy(tmpstr, Book.RootItems[i].ItemName);
          WriteFile(fileh, &j, sizeof(j), &dwWritten, nil);
          WriteFile(fileh, tmpstr, j, &dwWritten, nil);

          j:=length(Book.RootItems[i].LecFileName);
          strpcopy(tmpstr, Book.RootItems[i].LecFileName);
          WriteFile(fileh, &j, sizeof(j), &dwWritten, nil);
          WriteFile(fileh, tmpstr, j, &dwWritten, nil);

          j:=length(Book.RootItems[i].LabFileName);
          strpcopy(tmpstr, Book.RootItems[i].LabFileName);
          WriteFile(fileh, &j, sizeof(j), &dwWritten, nil);
          WriteFile(fileh, tmpstr, j, &dwWritten, nil);

          j:=length(Book.RootItems[i].TstFileName);
          strpcopy(tmpstr, Book.RootItems[i].TstFileName);
          WriteFile(fileh, &j, sizeof(j), &dwWritten, nil);
          WriteFile(fileh, tmpstr, j, &dwWritten, nil);
        end;
    end;
    i:=length(Book.RootFolders);
    WriteFile(fileh, &i, sizeof(i), &dwWritten, nil);
    if i > 0 then
    begin
      for i := 0 to length(Book.RootFolders) - 1 do
        begin
          j:=length(Book.RootFolders[i].FolderName);
          strpcopy(tmpstr, Book.RootFolders[i].FolderName);
          WriteFile(fileh, &j, sizeof(j), &dwWritten, nil);
          WriteFile(fileh, tmpstr, j, &dwWritten, nil);
          j:=length(Book.RootFolders[i].Items);
          WriteFile(fileh, &j, sizeof(j), &dwWritten, nil);
          if j > 0 then
          begin
            for k := 0 to length(Book.RootFolders[i].Items) - 1 do
              begin
                j:=length(Book.RootFolders[i].Items[k].ItemName);
                strpcopy(tmpstr, Book.RootFolders[i].Items[k].ItemName);
                WriteFile(fileh, &j, sizeof(j), &dwWritten, nil);
                WriteFile(fileh, tmpstr, j, &dwWritten, nil);

                j:=length(Book.RootFolders[i].Items[k].LecFileName);
                strpcopy(tmpstr, Book.RootFolders[i].Items[k].LecFileName);
                WriteFile(fileh, &j, sizeof(j), &dwWritten, nil);
                WriteFile(fileh, tmpstr, j, &dwWritten, nil);

                j:=length(Book.RootFolders[i].Items[k].LabFileName);
                strpcopy(tmpstr, Book.RootFolders[i].Items[k].LabFileName);
                WriteFile(fileh, &j, sizeof(j), &dwWritten, nil);
                WriteFile(fileh, tmpstr, j, &dwWritten, nil);

                j:=length(Book.RootFolders[i].Items[k].TstFileName);
                strpcopy(tmpstr, Book.RootFolders[i].Items[k].TstFileName);
                WriteFile(fileh, &j, sizeof(j), &dwWritten, nil);
                WriteFile(fileh, tmpstr, j, &dwWritten, nil);
              end;
          end;
        end;
    end;
    CloseHandle(fileh);
  end;
end;

Я к чему это пишу - хочу сделать запись непосредственно самих файлов данных (*.rtf, *.txt, *.btst), а не путей.
Писать хочу в сам исполняемый файл приложения (просмотрощика)
Пока получился такой код:
Код:
procedure SaveToExe(filename:string);
var tmpstr:array[0..255] of AnsiChar;
 fileh: System.Cardinal;
 i,j,k,dwWritten,sz:dword;
 appendfileDLL: HMODULE;
 appendFile: TAppendFile;
begin
  appendfileDLL:=LoadLibrary('fileappend.dll');

  @appendFile:=GetProcAddress(appendfileDLL, 'AppendFile');

  strpcopy(tmpstr, filename);
  fileh:=CreateFile(tmpstr, GENERIC_WRITE, FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0);
  if fileh<>INVALID_HANDLE_VALUE then
  begin
    sz:=SetFilePointer(fileh, 0, nil, FILE_END);

    strpcopy(tmpstr, Book.BookName);
    i:=length(Book.BookName);
    WriteFile(fileh, &i, sizeof(i), &dwWritten, nil);
    WriteFile(fileh, tmpstr, i, &dwWritten, nil);
    i:=length(Book.AuthorName);
    strpcopy(tmpstr, Book.AuthorName);
    WriteFile(fileh, &i, sizeof(i), &dwWritten, nil);
    WriteFile(fileh, tmpstr, i, &dwWritten, nil);
    i:=length(Book.RootItems);
    WriteFile(fileh, &i, sizeof(i), &dwWritten, nil);
    if i > 0 then
    begin
      for i := 0 to length(Book.RootItems) - 1 do
        begin
          j:=length(Book.RootItems[i].ItemName);
          strpcopy(tmpstr, Book.RootItems[i].ItemName);
          WriteFile(fileh, &j, sizeof(j), &dwWritten, nil);
          WriteFile(fileh, tmpstr, j, &dwWritten, nil);

          strpcopy(tmpstr, Book.RootItems[i].LecFileName);
          appendFile(fileh, tmpstr, 0);
          strpcopy(tmpstr, Book.RootItems[i].LabFileName);
          appendFile(fileh, tmpstr, 0);
          strpcopy(tmpstr, Book.RootItems[i].TstFileName);
          appendFile(fileh, tmpstr, 0);
        end;
    end;
    i:=length(Book.RootFolders);
    WriteFile(fileh, &i, sizeof(i), &dwWritten, nil);
    if i > 0 then
    begin
      for i := 0 to length(Book.RootFolders) - 1 do
        begin
          j:=length(Book.RootFolders[i].FolderName);
          strpcopy(tmpstr, Book.RootFolders[i].FolderName);
          WriteFile(fileh, &j, sizeof(j), &dwWritten, nil);
          WriteFile(fileh, tmpstr, j, &dwWritten, nil);
          j:=length(Book.RootFolders[i].Items);
          WriteFile(fileh, &j, sizeof(j), &dwWritten, nil);
          if j > 0 then
          begin
            for k := 0 to length(Book.RootFolders[i].Items) - 1 do
              begin
                j:=length(Book.RootFolders[i].Items[k].ItemName);
                strpcopy(tmpstr, Book.RootFolders[i].Items[k].ItemName);
                WriteFile(fileh, &j, sizeof(j), &dwWritten, nil);
                WriteFile(fileh, tmpstr, j, &dwWritten, nil);

                strpcopy(tmpstr, Book.RootFolders[i].Items[k].LecFileName);
                appendFile(fileh, tmpstr, 0);
                strpcopy(tmpstr, Book.RootFolders[i].Items[k].LabFileName);
                appendFile(fileh, tmpstr, 0);
                strpcopy(tmpstr, Book.RootFolders[i].Items[k].TstFileName);
                appendFile(fileh, tmpstr, 0);
              end;
          end;
        end;
    end;

    sz:=SetFilePointer(fileh, 0, nil, FILE_CURRENT) - sz;
    WriteFile(fileh, &sz, sizeof(sz), &dwWritten, nil);
    WriteFile(fileh, magicBuffer, sizeof(magicBuffer), &dwWritten, nil);
    CloseHandle(fileh);
  end;

  FreeLibrary(appendfileDLL);
end;


Почему-то никак на паскале не могу написать код присоединения одного файла к другому :bandhead:
Пришлось использовать dll написанный на c++ :?:

Код:
#define WIN32_LEAN_AND_MEAN
#include <windows.h>
#include <stdlib.h>

WORD __stdcall AppendFile(HANDLE targetFile, char* filename, WORD showMsg)
{
   DWORD dwWritten = 0;
   if( filename[0] == 0 )
   {
      DWORD dw = 0;
      WriteFile(targetFile, &dw, sizeof(dw), &dwWritten, 0);
      return 1;
   }

   HANDLE srcfile = CreateFileA(filename, GENERIC_READ, FILE_SHARE_READ, 0, OPEN_EXISTING, 0, 0);
   if( srcfile == INVALID_HANDLE_VALUE )
      return 0;

   if( showMsg )
      MessageBoxA(0, filename, "Src file:", MB_OK);

   DWORD size = GetFileSize(srcfile, 0);
   void* data = malloc(size);
   DWORD dwRead = 0;
   ReadFile(srcfile, data, size, &dwRead, 0);
    CloseHandle(srcfile);

   WriteFile(targetFile, &size, sizeof(size), &dwWritten, 0);
   WriteFile(targetFile, data, size, &dwWritten, 0);

   free(data);

   return 1;
}


 

Member
Статус: Не в сети
Регистрация: 05.01.2005
Xupyp1
Xupyp1 писал(а):
Разумеется он содержит немало пробелов
Как вы понимаете этот самый путь делится на куски и записывается в массив ParamStr

Я этот самый параметр читаю таким образом:

Если содержит пробелы, то он должен передаваться в кавычках -> bla.exe "привеД медвеД"
Остальное влом смотреть, извини.

Xupyp1 писал(а):
Почему-то никак на паскале не могу написать код присоединения одного файла к другому

Наверно что-то делаешь не так... ;)


 

Member
Статус: Не в сети
Регистрация: 23.12.2004
Откуда: Беларусь, Минск
Как определить наведение мыши на контрол?
Сначала поумал - OnMouseOver - но это не из той оперы:), затем ничего интересного не нашёл и пока просто отслеживаю координаты мышки по таймеру :tooth: :lol:

_________________
ASUS A4M88T-M, Athlon II X3 425, 2GB NCP, video - internal ATI 4250, 200GB Samsung HDD, Win7 x64


 

Member
Статус: Не в сети
Регистрация: 05.01.2005
AzaZeo
AzaZeo писал(а):
ничего интересного не нашёл

Прикалываешься? :applause: :lol:

AzaZeo писал(а):
и пока просто отслеживаю координаты мышки по таймеру :tooth: :lol:

:lol: :lol: :lol: :up:


 

Member
Статус: Не в сети
Регистрация: 14.01.2004
Откуда: Киев, Украина
Разве там нету ничего подобного о OnMouseMove?
AzaZeo писал(а):
отслеживаю координаты мышки по таймеру Довольный и беззубый Laughing
Представляю :)))

_________________
Ку ку


 

Member
Статус: Не в сети
Регистрация: 20.05.2006
Откуда: Мин-Воды
Подскажите подалуйста, как распечатать базу данных, используя RAVE report.не могу разобрать с компонетами Band и data band в самом рэйв репорте, объясните плз как пользоваца ими

_________________
Ставрополье Оверклокерс !!! => http://forums.overclockers.ru/viewtopic.php?t=125746


 

Member
Статус: Не в сети
Регистрация: 16.04.2006
Откуда: d3d9.dll
Фото: 7
Даже не надеюсь что кто-то ответит на столь специфический вопрос... но всё же, вдруг кто-нибудь уже работал в этой области и даст хоть какой-то совет. В общем есть Edit, в котором записано число в двоичной системе (напр. 11001000). Нужно передать это число ввиде одного байта в буфер СОМ-порта. В нете нашёл множество примеров как передавать в СОМ-порт символы (но тогда будет передано 8 байт, а не 8 бит, т. е. каждый бит байта передаётся как символ). А как можно передать двоичное число не ввиде символа? :)


 

Member
Статус: Не в сети
Регистрация: 14.01.2004
Откуда: Киев, Украина
Shader 3.0 что же, пишите еще :)
Почему ASCII символ 8 байт? ПОЧЕМУ?

_________________
Ку ку


 

Member
Статус: Не в сети
Регистрация: 05.01.2005
Shader 3.0
Shader 3.0 писал(а):
В общем есть Edit, в котором записано число в двоичной системе (напр. 11001000). Нужно передать это число ввиде одного байта

Установи биты байта в соответствии с нужными значениями.

Код:
function SetValue(const b0, b1, b2, b3, b4, b5, b6, b7: Boolean): byte;
begin
  Result:= ((byte(b0) shl 0) or (byte(b1) shl 1) or
            (byte(b2) shl 2) or (byte(b3) shl 3) or
            (byte(b4) shl 4) or (byte(b5) shl 5) or
            (byte(b6) shl 6) or (byte(b7) shl 7));
end;


Строку надеюсь, обработать сможешь? :spy:

Daemon
Daemon писал(а):
Почему ASCII символ 8 байт? ПОЧЕМУ?

Мот кака неделя юмора на Оверах :), а мы все пропустили? :spy:


 

Member
Статус: Не в сети
Регистрация: 11.07.2004
Откуда: Москва
как написать программу чтобы она в кип кнопку ctrl меняла на enter ?


Показать сообщения за:  Поле сортировки  
Начать новую тему Новая тема / Ответить на тему Ответить  Сообщений: 2317 • Страница 86 из 116<  1 ... 83  84  85  86  87  88  89 ... 116  >
-

Часовой пояс: UTC + 3 часа


Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 3


Вы не можете начинать темы
Вы не можете отвечать на сообщения
Вы не можете редактировать свои сообщения
Вы не можете удалять свои сообщения
Вы не можете добавлять вложения

Перейти:  
Создано на основе phpBB® Forum Software © phpBB Group
Русская поддержка phpBB | Kolobok smiles © Aiwan