Отправляет email-рассылки с помощью сервиса Sendsay

Мастера DELPHI. Новости мира компонент, FAQ, статьи...

Рассылка закрыта

При закрытии подписчики были переданы в рассылку "Delphi - проблемы и решения" на которую и рекомендуем вам подписаться.

Вы можете найти рассылки сходной тематики в Каталоге рассылок.

←   Апрель 2003   →
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
Автор
Сергей

Статистика

13.577 подписчиков
-18 за неделю
←   Все выпуски   →

Мастера DELPHI. Новости мира компонент, FAQ, статьи...


Информационный Канал Subscribe.Ru
Ежедневная рассылка сайта Мастера DELPHI

DELPHIMASTER.ru

Выпуск от 23.04.03 09:04

Ghost Installer - достойный инсталлятор для качественных сетапов. Весь спектр возможностей, быстрота и удобство.
Кое-что из нашей кладовки   |x|
  • TDBSTreeView&TMDDBTreeView alexdbases alexdbases@yandex.ru   (22.04.03 16:39)
    Два дерева для работы с БД.
    Первое работает с одним набором данных..
    Второе с мастер-детальным набором....
    Оба следят за перемещением по дереву, корректируя курсор НД.Все делалось для себя ...так что сильно не наезжать...а так пишите...если что не так.
    »»» Скачать: исходные тексты (11кб)
  • TDBSTreeView alexdbases alexdbases@yandex.ru   (22.04.03 14:51)
    Компанента предназначена для выгрузки набора данных в дерево.Cамое главное при "прогулки" по дереву переводит НД на запись соответствующюю узлу.(просто именно изза этой функции и писалось.)Если компанента вызовет чувства пишите :)...Описалово прилагаеться...
    »»» Скачать: исходные тексты (9кб)
Лучшее из нашего FAQ   |x|
Процедуры быстрого получения размера изображения из фалов: JPG, GIF, PNG 

unit ImgSize;

interface

uses Classes;


procedure GetJPGSize(const sFile: string; var wWidth, wHeight: word);
procedure GetPNGSize(const sFile: string; var wWidth, wHeight: word);
procedure GetGIFSize(const sGIFFile: string; var wWidth, wHeight: word);


implementation

uses SysUtils;

function ReadMWord(f: TFileStream): word;
type
  TMotorolaWord = record
    case byte of
      0: (Value: word);
      1: (Byte1, Byte2: byte);
  end;
var
  MW: TMotorolaWord;
begin
  { It would probably be better to just read these two bytes in normally }
  { and then do a small ASM routine to swap them.  But we aren't talking }
  { about reading entire files, so I doubt the
performance gain would be }
  { worth the trouble. }
  f.Read(MW.Byte2, SizeOf(Byt!
e));
  f.Read(MW.Byte1, SizeOf(Byte));
  Result := MW.Value;
end;

procedure GetJPGSize(const sFile: string; var wWidth, wHeight: word);
const
  ValidSig : array[0..1] of byte = ($FF, $D8);
  Parameterless = [$01, $D0, $D1, $D2, $D3, $D4, $D5, $D6, $D7];
var
  Sig: array[0..1] of byte;
  f: TFileStream;
  x: integer;
  Seg: byte;
  Dummy: array[0..15] of byte;
  Len: word;
  ReadLen: LongInt;
begin
  FillChar(Sig, SizeOf(Sig), #0);
  f := TFileStream.Create(sFile, fmOpenRead);
  try
    ReadLen := f.Read(Sig[0], SizeOf(Sig));

    for x := Low(Sig) to High(Sig) do
      if Sig[x] <> ValidSig[x] then ReadLen := 0;

    if ReadLen > 0 then
    begin
      ReadLen := f.Read(Seg, 1);
      while (Seg = $FF)
and (ReadLen > 0) do
      begin
        ReadLen := f.Read(Seg, !
1);
        if Seg <> $FF then
        begin
          if (Seg = $C0) or (Seg = $C1) then
          begin
            ReadLen := f.Read(Dummy[0], 3); { don't need these bytes }
            wHeight := ReadMWord(f);
            wWidth := ReadMWord(f);
          end else begin
            if not (Seg in Parameterless) then
            begin
              Len := ReadMWord(f);
              f.Seek(Len-2, 1);
              f.Read(Seg, 1);
            end else
              Seg := $FF; { Fake it to keep looping. }
          end;
        end;
      end;
    end;
  finally
    f.Free;
  end;
end;

procedure GetPNGSize(const sFile: string; var wWidth, wHeight: word);
type

 TPNGSig = array[0..7] of byte;
const
  ValidSig: TPNGS!
ig = (137,80,78,71,13,10,26,10);
var
  Sig: TPNGSig;
  f: tFileStream;
  x: integer;
begin
  FillChar(Sig, SizeOf(Sig), #0);
  f := TFileStream.Create(sFile, fmOpenRead);
  try
    f.Read(Sig[0], SizeOf(Sig));
    for x := Low(Sig) to High(Sig) do
      if Sig[x] <> ValidSig[x] then exit;
    f.Seek(18, 0);
    wWidth := ReadMWord(f);
    f.Seek(22, 0);
    wHeight := ReadMWord(f);
  finally
    f.Free;
  end;
end;


procedure GetGIFSize(const sGIFFile: string; var wWidth, wHeight: word);
type
  TGIFHeader = record
    Sig: array[0..5] of char;
    ScreenWidth, ScreenHeight: word;
    Flags, Background, Aspect: byte;
  end;

  TGIFImageBlock = record
    Left, Top, Width, Height: word;
    Flags: byte;

 end;
var
  f: file;
  Header: TGifHeader;
  ImageBlock: TGi!
fImageBlock;
  nResult: integer;
  x: integer;
  c: char;
  DimensionsFound: boolean;
begin
  wWidth  := 0;
  wHeight := 0;

  if sGifFile = '' then
    exit;

  {$I-}
  FileMode := 0;   { read-only }
  AssignFile(f, sGifFile);
  reset(f, 1);
  if IOResult <> 0 then
    { Could not open file }
    exit;

  { Read header and ensure valid file. }
  BlockRead(f, Header, SizeOf(TGifHeader), nResult);
  if (nResult <> SizeOf(TGifHeader)) or (IOResult <> 0) or
     (StrLComp('GIF', Header.Sig, 3) <> 0) then
  begin
    { Image file invalid }
    close(f);
    exit;
  end;

  { Skip color map, if there is one }
  if (Header.Flags and $80) > 0 then
  begin
    x := 3 * (1 SHL ((Header.Flags and 7) + 1));
 
  Seek(f, x);
    if IOResult <> 0 then
    begin
      { !
Color map thrashed }
      close(f);
      exit;
    end;
  end;

  DimensionsFound := False;
  FillChar(ImageBlock, SizeOf(TGIFImageBlock), #0);
  { Step through blocks. }
  BlockRead(f, c, 1, nResult);
  while (not EOF(f)) and (not DimensionsFound) do
  begin
    case c of
      ',': { Found image }
        begin
          BlockRead(f, ImageBlock, SizeOf(TGIFImageBlock), nResult);
          if nResult <> SizeOf(TGIFImageBlock) then begin
            { Invalid image block encountered }
            close(f);
            exit;
          end;
          wWidth  := ImageBlock.Width;
          wHeight := ImageBlock.Height;
          DimensionsFound := True;
        end;
      'ÿ' : { Skip }
        begin
          { NOP }

       end;
    { nothing else.  just ignore }
    end;
  !
  BlockRead(f, c, 1, nResult);
  end;

  close(f);
  {$I+}
end;

end.

»»» Прислать свои комментарии

Обсуждается в конференциях   |x|
У нас большой выбор статей   |x|
Маленькие хитрости: цветной Progress Bar
Речь пойдет об индикаторе процесса выполнения (Progress Bar'е) нестандартного цвета.
Казалось бы, ничего сложного в этом нет. Просто берем и меняем свойство Color у компонента. Но у компонента нет такого свойства. Вот тут-то и начинается тот самый ступор, в который часто впадают новички в Delphi.
Новинки книжного рынка   |x|
Delphi 5: учебный курс
В книге рассмотрены возможности системы программирования Delphi 5, описан язык программирования Object Pascal, рассмотрены визуальные компоненты системы и методы их создания. Особое внимание уделено принципам и практическим приемам создания сетевых приложений для разных архитектур и разработке программ, поддерживающих основные протоколы Интернета.Не требует специальной подготовки, может быть использована как пособие для изучающих основы программирования и сетевые технологии, а также как справочник по компонентам Delphi и пособие для самообразования.
Автор: С. Бобровский
Другие сайты о DELPHI   |x|
Delphi X-Files
Один из самых известных сайтов в сети, который посвящен всем тонкостям и хитростям программирования на Borland Delphi. Множество интересных статей, исходников, примеров программ, компонентов, советов ...
» Оценка сайта: 5
Опрос населения :)
Новый журнал для программистов "RSDN Magazine". Ваше мнение, нужен ли он вообще?
»»» Да
»»» Нет
Для души

Хокку дня
Сорвавшись с уст,
Мои слова блуждают...
Млечный путь!

Афоризмы
Ты можешь и не заметить, что у тебя все идет хорошо. Но налоговая служба напомнит (Пьер Данинос)

Фраза дня
Деньги приходят и уходят, и уходят, и уходят...

Дурацкие законы (информация предоставлена сайтом kurilka.com)
В городе Лонг Бич (США) официальным постановлением признано, что "гаражи строятся для автомобилей".
В Англии до сих пор есть закон, который запрещает владеть телевизором всем, кто не имеет особой лицензии.

И на закуску коротенький анекдот
Если вы никак не можете разыскать своих родственников - дайте объявление о наследстве.

Фотоприколы.
Начните день с хорошего настроения!
http://delphi.mastak.ru/cgi-bin/prikol.pl?id=77

На этом позвольте откланяться и пожелать вам удачного дня.
Искренне ваш, Алексей (delphi@mastak.ru)

Добро пожаловать на сайт -= Мастера DELPHI =- 
http://subscribe.ru/
E-mail: ask@subscribe.ru 		Отписаться
Убрать рекламу
В избранное