RusFAQ.ru: Программирование на Delphi

/ КОМПЬЮТЕРЫ И ПО / Языки программирования / Delphi

Выпуск № 159
от 21.06.2005, 22:20

Вопрос № 22.225

Здраствуйте эксперты! Возник вопрос. В программе используются Shape, Label, ProgressBar. Вообщем во всех виндовсах все замечательно. Но если используется Вин XP со стандартное темой, то этих компонент(Label, ProgressBar, Shape) он не видит.... Т.е. пустые места. Переключаешь тему на классическую, все видно.... В чем проблема??? Да, кстати, если делаешь обращение к компоненту(например по нажатию кнопки у него меняется цвет) то он становится видным.

Отправлен: 15.06.2005, 22:13 Вопрос задал: svsrus (статус: Посетитель) Всего ответов отправлено: 4

Отвечает: Master135 Здравствуйте, svsrus! В 7й Делфе есть такой компонент как ХР манифест вот думаю его то на форму поместить и надо

Ответ отправил: Master135 (статус: 5-ый класс) Отправлен: 16.06.2005, 01:42

Отвечает: Delphin Здравствуйте, svsrus! Что-то вы напутали. Может использовали обращение к каким-нибудь функция нестандартным отвечащим за темы? У меня ниразу! Не было такой ошибки. Возможно проблема в пропатченом uxtheme.dll или установленных обновления. Попробуйте если ничего не помогает просто перерисовывать форму с компонентами. --------- Ищу сервис пак для школы ^)))

Ответ отправил: Delphin (статус: 5-ый класс) Отправлен: 16.06.2005, 01:57

Отвечает: Gin Здравствуйте, svsrus! Попробуйте поменять цвет. С Уважнием, Gin.

Ответ отправил: Gin (статус: 5-ый класс) Отправлен: 16.06.2005, 08:26

Отвечает: sir henry Здравствуйте, svsrus! А Вы попробуйте тему отредактировать (настроить). :)

Ответ отправил: sir henry (статус: Профессор) Отправлен: 16.06.2005, 09:46

Вопрос № 22.239

Добрый день! Уважаемые эксперты, ссылка на TDBF (на которую вы уже несколько раз ссылались в последних рассылках) на sourceforge.net/proects/tdbf/ к сожалению давно уже мертвая. Не сочтите за труд - не могли бы вы выслать архив на E-mal zenkovv@halykbank.kz. Очень нужно. Заранее очень благодарен.

Отправлен: 16.06.2005, 06:35 Вопрос задал: Зенков Валентин Валентинович (статус: Посетитель) Всего ответов отправлено: 3

Отвечает: Rusland Здравствуйте, Зенков Валентин Валентинович! Правильная ссылка http://sourceforge.net/projects/tdbf/ , только она долго открывается.

Ответ отправил: Rusland (статус: 5-ый класс) Отправлен: 16.06.2005, 09:53

Отвечает: sir henry Здравствуйте, Зенков Валентин Валентинович! Выслал. Смотрите в ящик. :)

Ответ отправил: sir henry (статус: Профессор) Отправлен: 16.06.2005, 09:55

Отвечает: Denisss Здравствуйте, Зенков Валентин Валентинович! Не знаю почему, но у Вас неверный линк: правильный - "http://sourceforge.net/projects/tdbf/" в Вашем же пропущена буква "j" в слове "projects"

Ответ отправил: Denisss (статус: 5-ый класс) Отправлен: 16.06.2005, 17:44

Вопрос № 22.254

Добрый день, ув. эксперты! Имеется простой фотоаппарат, настроек почти нет, выдает джипеги размером изображения 1280 на 960. Мне нужно сделать размер 128 на 96. Хотелось бы программно, не пользуясь фотошопом и пр.

Отправлен: 16.06.2005, 11:12 Вопрос задал: Kvint (статус: Посетитель) Всего ответов отправлено: 2

Отвечает: Gin Здравствуйте, Kvint! Сам Чайник, но попробуйте поизвращаться над моей "пробой пера" ;) Здесь будет фотографироваться рабочий стол. В зависимости от размеров формы получите размер снимка. Пример простой. Кнопки будут мешать - скройте их во време перерисовки. unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, StdCtrls; type TForm1 = class(TForm) Button1: TButton; Button2: TButton; Image1: TImage; Button3: TButton; procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure Button3Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} // С помощью этой процедуры я рисую прямо на десктопе procedure TForm1.Button1Click(Sender: TObject); { Я объявляю переменную ScreenDC типа HDC. HDC - это контекст рисования в windows, и работает почти так же, как и TCanvas } var ScreenDC:HDC; begin { С помощью функции GetDC(0) я возвращаю контекст окна указанного в скобках. Но в этих скобках стоит 0 (ноль), а это значит, что мне нужен глобальный контекст, то есть самого десктопа. } ScreenDC := GetDC(0); { Далее, я вызываю функцию Rectangle, она похожа на ту, что мы использовали раньше TCanvas.Rectangle. Есть только одно отличие - первый параметр теперь, это контекст устройства, а затем идут координаты прямоугольника. Это связано с тем, что раньше мы рисовали через объект TCanvas, а сейчас будем рисовать средствами GDI Windows. Скажу по секрету :) TCanvas.Rectangle всего лишь вызывает Rectangle из Windows API и подставляет нужный контекст устройства и размеры. Сейчас мы сами сделаем это, без помощь TCanvas. } Rectangle(ScreenDC, 10, 10, 200, 200); { После рисования, я освобождаю больше не нужный мне контекст через функцию ReleaseDC. Такие вещи обязательно надо освобождать, чтобы не засорять память } ReleaseDC(0,ScreenDC); end; { здесь я получаю копию десктопа } procedure TForm1.Button2Click(Sender: TObject); var Canvas:TCanvas; ScreenDC:HDC; begin Form1.Hide; Sleep(300); { Первая строка такая же, как и в предыдущей процедуре. Я точно также получаю контекст десктопа. } ScreenDC := GetDC(0); { Cоздаю новую переменную Canvas типа ТCanvas (знакомый нам контекст рисования) } Canvas:=TCanvas.Create(); { Cвязываю их между собой с помощью простого присваивания в Canvas.Handle:=ScreenDC Теперь мой TCanvas указывает на декстоп, и я могу рисовать на нём, привычными нам методами. } Canvas.Handle:=ScreenDC; { Получаю копию экрана и записываю её в картинку TImage с помощью функции Copyrect у контекста рисования картинки (Image1.Canvas.Copyrect). Эта функция выглядит так: procedure CopyRect( Dest: TRect; //Размеры получаемого изображения Canvas: TCanvas;//Контекст, из которого будет копироваться Source: TRect//Размеры исходного изображения ); } Image1.Canvas.Copyrect(Rect(0,0,Image1.Width,Image1.Height), Canvas, Rect(0,0,Screen.Width,Screen.Height)); ReleaseDC(0,ScreenDC); Canvas.Free; Form1.Show; end; { Procedure DrawOnScreen; Var DC:HDC; DesktopCanvas:TCanvas; begin DC:=GetDC(0); // получили DC экрана // (или DC:=GetDC(GetDesktopWindow) для рабочего стола) try DesktopCanvas:=TCanvas.Create; DesktopCanvas.Handle:=DC; .................. // здесь рисуем на Canvas экрана .................. finally ReleaseDC(0,DC); DesktopCanvas.Free; end; end; } procedure TForm1.Button3Click(Sender: TObject); var DC: HDC; Canva: TCanvas; B: TBitmap; begin Canva := TCanvas.Create; B := TBitmap.Create; DC := GetDC(0); try Canva.Handle := DC; with Screen do begin B.Width := Width; B.Height := Height; B.Canvas.CopyRect(Rect(0, 0, Width, Height), Canva, Rect(0, 0, Width, Height)); B.SaveToFile('c:screen.bmp'); end finally ReleaseDC(0, DC); B.Free; Canva.Free end; end; end. Удачи Вам, сударь. С Уважением, Gin.

Ответ отправил: Gin (статус: 5-ый класс) Отправлен: 16.06.2005, 12:22 Оценка за ответ: 5 Комментарий оценки: Попробую применить CopyRect, хотя пока вроде добился результата с StretchDraw

Отвечает: CJ Здравствуйте, Kvint! Для уменьшения картинок я использую следуюший код: см. в приложении. Ты можешь его немного модифицировать под себя, я еще использую OpenDialog и Save. Меняешь значение переменно Scale и меняется значение уменьшенной картинки. Это что-то вроде процентного сжатия. Приложение: unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls,jpeg; type TForm1 = class(TForm) Button1: TButton; OpenDialog1: TOpenDialog; SaveDialog1: TSaveDialog; Image1: TImage; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.Button1Click(Sender: TObject); var bmp: TBItmap; jpg: TJpegImage; scale: Double; s,s2:string; begin if opendialog1.Execute then s:=opendialog1.FileName; jpg:= TJpegImage.Create; try jpg.Loadfromfile(s); scale := 0.5; scale := 0.5; bmp:= Tbitmap.Create; try {Create thumbnail bitmap, keep pictures aspect ratio} bmp.Width := Round( jpg.Width * scale ); bmp.Height:= Round( jpg.Height * scale ); bmp.Canvas.StretchDraw( bmp.Canvas.Cliprect, jpg ); {Draw thumbnail as control} Self.Canvas.Draw( 100, 10, bmp ); {Convert back to JPEG and save to file} jpg.Assign( bmp ); jpg.SaveToFile(s); finally bmp.free; end; finally jpg.free; end; end;

Ответ отправил: CJ (статус: Студент) Отправлен: 16.06.2005, 23:46 Оценка за ответ: 5

Вопрос № 22.259

Здравствуйте, спасибо за ваши ответы. Очень помогают. Опять возникла загвоздка с чтением и записью COM портов. Вывод в порт получилось на ура! Но проблема в том, что нужно одновременно и записывать в порт и считывать! Я, как вы и советовали обрасщаюсь к КОМ порту как к обычному файлу, но одновременный доступ для чтения и записи получить не могу. В чем моя ошибка. Код в приложении. Спасибочки огромное. Приложение: var f : textfile; s : string; begin // Открываю порт так: AssignFile(f,ComboBox1.Text); FileMode := fmOpenReadWrite; Rewrite(f); // Вывожу в порт так: Write(f_out,s); // Считываю (по таймеру) так: Read(f,s);

Отправлен: 16.06.2005, 13:42 Вопрос задал: Мурник Роман (статус: 2-ой класс) Всего ответов отправлено: 3

Отвечает: Pushkin Здравствуйте, Мурник Роман! В строке Write(f_out,s) - ошибка (заменить f_out на f). А вообще предлагаю следующее: 1. Всю работу с COM-портом реализовывать в отдельном потоке или 2. Создать или найти специальный компонент для работы с COM-портом. А также 3. Работа с портом не может строится в режиме ReadWrite. Поэтому нужно использовать поочередное чтение, запись (Но без открытия/закрытия порта). По поводу потери информации при этом можно не беспокоится - на аппаратном уровне реализован буфер приема и передачи, и командами Read, Write на самом деле производится чтение и запись в/из буфера, а передачу по проводам уже делает микросхема UART 16550 или подобная. Поэтому, в принципе, программа верная, но я не пробовал ее запускать и не собираюсьэтого делать. И вам рекомендовал бы использовать для работы с портом специальный компонент, который могу выслать по электронке, если укажите свою. Моя электронка - asm79@mail.ru

Ответ отправил: Pushkin (статус: 4-ый класс) Отправлен: 16.06.2005, 15:56

Отвечает: CJ Здравствуйте, Мурник Роман! Не могу понять в чем может быть проблема...:( Я бы на твоем месте использовал потоки TThread. Хорошая статья есть на Мастерах Делфи.

Ответ отправил: CJ (статус: Студент) Отправлен: 16.06.2005, 23:50 Оценка за ответ: 5 Комментарий оценки: С потоками пробовал. Поток постоянно считывал порт и выводил данные в Мемо. Но с какими-то тогмозами и приоритеты пробовал другие. было примерно так: WriteToPort('AT+CPMS'); WriteToPort('AT+CMGR=1'); S:=Memo1.Lines[6]; ShowMessage(s); Чтобы переменная S приняла нужное значение нужно было несколько раз прогнать этот код, хотя в Мемо все появлялось сразу. error911@mail.ru

Отвечает: sir henry Здравствуйте, Мурник Роман! Ошибка Ваша в том, что Вы используете устаревшие процедуры Паскаля, которые применялись еще при царе Горохе. :) Сегодня правильные команды для порта - CreateFale() - открытие и CloseHandle() - закрытие (пример см в приложении). Параметр 1: Имя порта – ‘COM1’, итд Параметр 2: режим открытия GENERIC_READ – чтение, GENERIC_WRITE – запись Параметр 3: режим разделения ресуртса. Примечание: 0 – неразделяемый (именно так описано открытие последовательного порта в WIN SDK, другие режимы не проверял). Параметр 4: Режим безопасности. Имеет смысл в Windows NT, Windows 9x игнорирует его. Параметр 5: Способ открытия. Для порта - OPEN_EXISTING – открыть, когда устройство реально существует. Параметр6: режим наложения операций - FILE_FLAG_OVERLAPPED – разрешение таких операций. При этом операции чтения – записи, требующие значительного времени, выполняются фоново по отношению к основному потоку программы. Параметр7: шаблон файла, для последовательного порта – всегда 0. Читать и писать можно через функции ReadFile() и WriteFile(). Приложение: {Открытие порта:} Var FHandle: Thandle; FHandle := CreateFile( PChar(ComString), GENERIC_READ or GENERIC_WRITE, 0, nil, OPEN_EXISTING, FILE_FLAG_OVERLAPPED, 0); {Закрытие порта} CloseHandle(FHandle);

Ответ отправил: sir henry (статус: Профессор) Отправлен: 17.06.2005, 04:48 Оценка за ответ: 5 Комментарий оценки: Спасибо. Я привык при царе Горохе жить :)

Вопрос № 22.260

День добрый! Как уменьшить рисунок вроде разобрался (через зад пока - рисунок копирую в один имаж со стретчем, а из него в другой при помощи StretchDraw - тогда его можно оттуда забирать и отправлять в эксель с новыми размерами). Еще одна проблема - как его повернуть на 90 градусов, сохранив пропорции?

Отправлен: 16.06.2005, 13:45 Вопрос задал: Kvint (статус: Посетитель) Всего ответов отправлено: 2

Отвечает: Denisss Здравствуйте, Kvint! В приложении приведена процедура RotateBMP для поворота изображения на 90 градусов против часовой стрелки, а также приведен пример использования этой процедуры. Приложение: ... uses Graphics, JPEG, ...; ... procedure RotateBMP(var BMP: TBitmap); // Проедура для поворота изображения на 90 градусов // против часовой стрелки type TRGB = packed record G, B, R: Byte; end; PRGB = ^TRGB; var x, y: Integer; tmpBMP: TBitmap; RGBLine, tmpRGB: PRGB; begin BMP.PixelFormat:= pf24bit; tmpBMP:= TBitmap.Create; tmpBMP.PixelFormat:= pf24bit; tmpBMP.Width:= BMP.Height; tmpBMP.Height:= BMP.Width; for Y:= 0 to (BMP.Height - 1) do begin RGBLine:= BMP.ScanLine[Y]; for X:= 0 to (BMP.Width - 1) do begin tmpRGB:= tmpBMP.ScanLine[X]; inc(tmpRGB, Y); tmpRGB^.G:= RGBLine^.G; tmpRGB^.B:= RGBLine^.B; tmpRGB^.R:= RGBLine^.R; if (X < (BMP.Width - 1)) then inc(RGBLine); end; end; BMP.Assign(tmpBMP); FreeAndNil(tmpBMP); end; ... // Пример использования этой процедуры: var JPG: TJPEGImage; BMP: TBitmap; begin JPG:= TJPEGImage.Create; BMP:= TBitmap.Create; try JPG.LoadFromFile('try.jpg'); BMP.Assign(JPG); // Вызываем процедуру поворота изображения RotateBMP(BMP); // Изображение повернуто, можно идти дальше :) JPG.Assign(BMP); // Далее можете делать с JPG все, что хотите: // сохранять, например :) finally FreeAndNil(JPG); FreeAndNil(BMP); end; end;

Ответ отправил: Denisss (статус: 5-ый класс) Отправлен: 16.06.2005, 18:18 Оценка за ответ: 5

Отвечает: Malish Здравствуйте, Kvint! Я могу предложить только так: Создаешь новый Bitmap массив где ширину и высоту меняешь местами. Потом через for i:=0 to Высота do for j:=0 to Ширина do Bitmap1.Canvas.Pixels[i,j]:=Bitmap2.Canvas.Pixels[M-j,i];

Ответ отправил: Malish (статус: Студент) Отправлен: 16.06.2005, 23:14 Оценка за ответ: 5

Вопрос № 22.261

Задавай вопрос дважды не нашел ответа, искал в FAQ тоже не нашел. У меня программа которая считает мат. зависимости. На форме лежит TabSheet, с тремя вкладками. Так вот в последней вкладке нужно отобразить методику расчета выполненую в ВОРД. Я поместил OleContainer нажав два клика выбрал файл, после чего он стал отображаться в поле OleContainer но я ненашел нигде свойства scroll как сделать так чтобы появился скролл. Как связать компоненту scrollBar с содержимым. Я плохо разбираюсь в Делфи, потому помогите с таким пустяком, который я не могу решить. Если можно напишите кусок кода, как сделать так чтобы появился скролл, или как по умному вызывать этот файл. Заранее спасибо Ув. эксперты

Отправлен: 16.06.2005, 14:05 Вопрос задал: KolesnikovAV (статус: Посетитель) Всего ответов отправлено: 1

Отвечает: sir henry Здравствуйте, KolesnikovAV! Будет намного лучше и проще, если вордовский документ Вы будете открывать прямо в ворде через функцию ShellExecute(). Поверьте, как только Вы увидите свой документ в ворде все вопросы у Вас отпадут сами собой. :) ******************** ShellExecute(0, 'open', 'Имя_файла.doc, NIL, 'Рабочий_каталог', SW_SHOW): ******************** Функция эта находиться в модуле ShellAPI.

Ответ отправил: sir henry (статус: Профессор) Отправлен: 17.06.2005, 04:59

Вопрос № 22.267

Здравствуйте! Пожплуйста подскажите как распечатать из Memo текст. Спасибо.

Отправлен: 16.06.2005, 19:03 Вопрос задала: Alisha (статус: Посетитель) Всего ответов отправлено: 4

Отвечает: Pushkin Здравствуйте, Alisha! Вариант 1. В режиме создания приложения: Создаем форму с компонентом QReport, кидаем на него компонент QRMemo. QRMemo.AutoSize := False Устанавливаем размеры QRMemo побольше Затем в режиме работы программы: Перекидываем весь текст из Memo в QRMemo (QRMemo1.Text := Memo1.Text) Печатаем с предварительным просмотром: QReport1.preview. Все это нужно делать из главной формы, т.е. форму с компонентом QReport показывать не надо. Вариант 2. Можно попробовать: Memo1.Lines.SaveToFile('prn')

Ответ отправил: Pushkin (статус: 4-ый класс) Отправлен: 16.06.2005, 19:26

Отвечает: sir henry Здравствуйте, Alisha! Вот ссылка на программу, которая печатает текст из МЕМО. Если такие сложности не нужны, то просто можно напечатать текстовый файл, который загружен в мемо (или предварительно туда выгружен, если Вы набираете новый текст): ShellExecute(0, 'print','Имя_файла.txt',NIL,'Рабочий_каталог', SW_SHOW);

Ответ отправил: sir henry (статус: Профессор) Отправлен: 17.06.2005, 05:25

Отвечает: Ерёмин Андрей Здравствуйте, Alisha! Например вот так: Memo1.Print; Можно ещё передать этой процедуре заголовок (текст), который также будет напечатан. --------- Жизнь - игра, в которой нет setup'а...

Ответ отправил: Ерёмин Андрей (статус: 8-ой класс) Отправлен: 17.06.2005, 08:18

Отвечает: VBA Здравствуйте, Alisha! Используем метод Print: Memo1.Print('Document'); --------- Неправ вечно юзер, ибо прав всегда Админ!

Ответ отправил: VBA (статус: 4-ый класс) Отправлен: 17.06.2005, 09:23

Вопрос № 22.268

Здравствуйте, уважаемые гуру! Опишу суть: есть путь к битмапу, взятый из HKEY_CURRENT_USERControl PanelDesktopWallpaper, есть задача растянуть этот битмап на форме, размером в экран. Проблема заключается в том, что картинка чаще всего не того размера, что экран, и слишком заметно искажение при сжатии или растягивании. Пробовал реализовать простой загрузкой в TImage, размер которого соответствует размерам формы (и экрана) при поставленном Stretch = True - четко видно искажение. При попытке сделать это прямо на канву формы CopyRect`ом - искажение еще больше. Подскажите, плиз, алгоритм, который сможет выполнить эту задачу без искажения. Делает же это винда как-то?

Отправлен: 16.06.2005, 19:50 Вопрос задал: Vit (статус: Посетитель) Всего ответов отправлено: 4

Отвечает: Pushkin Здравствуйте, Vit! Если правильно понял речь идет о пропорциях изображения не соответствующих пропорциям экрана, а именно оно не равно x/y=1,33 Это лечится так: 1. Создать Image1 свойства AutoSize := True, Visible := False; 2. Image1.Picture.Bitmap.LoadFromFile('filename'); 3. Определяем пропорции полученного Image1 и определяем где делать отступы (сверху/снизу или слева/справа). Если пропорции Image1<1,33, следовательно ширина меньше нужной и будем делать полосы по бокам. Если пропорции>=1,33 тогда полосы будем оставлять сверху и снизу. 4. Теперь необходимо определить ширину отступов. Делается это так: 4.1. Определяем разрешение экрана Screen.Width, Screen.Height 4.2. Определяем величину неизменного параметра (т.е. ширины или высоты Image1: если полосы вставляем по бокам, то в качестве неизменного параметра берем высоту, если сверху/снизу, то ширину); второй параметр назовем "изменным" 4.3. Определяем коэффициент масштабирования делением Screen.Width или Screen.Height на неизменный параметр. 4.4. Умножаем "изменный" параметр на коэффициент масштабирования. 4.5. Вычитаем величину, полученную в 4.4. из Screen.Width или Screen.Height соответственно и делим пополам. Получили ширину отступов с каждой стороны. 5. Теперь создаем Image2. Свойства AutoSize := False; Visible := True; Stretch := True; Left (или Top) := величина, полученная в 4.5. 6. Image2.Canvas.StretchDraw(Rect(0,0,размеры Image2), Image1.Picture.Bitmap);

Ответ отправил: Pushkin (статус: 4-ый класс) Отправлен: 16.06.2005, 20:43 Оценка за ответ: 4 Комментарий оценки: Я немного не это имел ввиду. Изображение именно РАСТЯГИВАЕТСЯ до размеров Screen.Width и Screen.Height. Какими бы ни были его пропорции. Нужно вылечить "пикселизацию" картинки после вставки. К примеру, изображение Wallpaper.bmp - 1600х1200, а десктоп - 1024х768. Растягивается чудесно, но сжимается в 1600/1024=1,5625 раз. Появляется искажение изображения - круги становятся горбатыми и т.п. Вот...

Отвечает: X Здравствуйте, Vit! Помойму, такого алгоритма нет: Если вы например увеличиваете картинку в 4 раза, то каждый пиксель превращаеться в 16 (квадрат 4x4). И сделать их разными ни как не получиться(в исходном изображении ведь дан только 1 пиксель) Можно попробовать менять отображение обоев: в HKEY_CURRENT_USERControi PanelDesktop TileWallpaper - 1 - рисунок размножен 2 - рисунок в центре WallpaperStyle - 2 -обои растянуты.

Ответ отправил: X (статус: 6-ой класс) Отправлен: 16.06.2005, 20:55

Отвечает: Jadd Здравствуйте, Vit! Винда точно так же делает stretch картинке. Другое дело, что есть способы масштабировать картинку с минимальной потерейкачества. Некоторые компании делают это так: сначала переводят картинку в векторный формат. Как известно, векторы легче масштабировать. Затем из масштабированного вектора делают битмап. Можно, конечно найти алгоритмы по подобным превращениям с самим битмапом, но, ты сам понимаешь, что сделать это очень точно - весьма сложно. Так что, либо юзай картинку с большим разрешением, достаточным для stretch'а без видимой потери (т.е. растеризации), либо ищи алгоритмы реализующие способы, описанные выше. --------- Hakuna matata

Ответ отправил: Jadd (статус: Студент) Отправлен: 16.06.2005, 21:41 Оценка за ответ: 4 Комментарий оценки: Собственно, эти алгоритмы я и ищу. С этим и к вам пришел. ;) Неужели никто из Экспертов не сталкивался с подобной задачей сгладить искаженный битмап?..

Отвечает: Samum Здравствуйте, Vit. В приложении я привел процедуру, которой пользовался в одном из своих проектов (не помню точно откуда она у меня). Она обеспечивает приличное качество при растяжении даже в 2 раза (без потерь не получится в любом случае). Во всяко случае гораздо лучшее, чем загрузка в Image со Stretch = true (см. прикрепленный файл). Использовать её можно так: var bitmap1: TBitmap; begin Bitmap1 := TBitmap.Create; Bitmap1.LoadFromFile('C:satisfaction.bmp'); ResizeBitmap(Bitmap1, Image2.Picture.Bitmap, Image2.Width, Image2.Height); end; Приложение: procedure TForm1.ResizeBitmap(Source, Destination: TBitmap; NewWidth, NewHeight: Integer); var xini, xfi, yini, yfi, saltx, salty: single; x, y, px, py, tpix: integer; PixelColor: TColor; r, g, b: longint; function MyRound(const X: Double): Integer; begin Result := Trunc(x); if Frac(x) >= 0.5 then if x >= 0 then Result := Result + 1 else Result := Result - 1; // Result := Trunc(X + (-2 * Ord(X < 0) + 1) * 0.5); end; begin // Set target size Destination.Width := NewWidth; Destination.Height := NewHeight; // Calcs width & height of every area of pixels of the source bitmap saltx := Source.Width / NewWidth; salty := Source.Height / NewHeight; yfi := 0; for y := 0 to NewHeight - 1 do begin // Set the initial and final Y coordinate of a pixel area yini := yfi; yfi := yini + salty; if yfi >= Source.Height then yfi := Source.Height - 1; xfi := 0; for x := 0 to newWidth - 1 do begin // Set the inital and final X coordinate of a pixel area xini := xfi; xfi := xini + saltx; if xfi >= Source.Width then xfi := Source.Width - 1; // This loop calcs del average result color of a pixel area // of the imaginary grid r := 0; g := 0; b := 0; tpix := 0; for py := MyRound(yini) to MyRound(yfi) do begin for px := MyRound(xini) to MyRound(xfi) do begin Inc(tpix); PixelColor := ColorToRGB(Source.Canvas.Pixels[px, py]); r := r + GetRValue(PixelColor); g := g + GetGValue(PixelColor); b := b + GetBValue(PixelColor); end; end; // Draws the result pixel if tpix<>0 then Destination.Canvas.Pixels[x, y] := rgb(MyRound(r / tpix), MyRound(g / tpix), MyRound(b / tpix)) else Destination.Canvas.Pixels[x, y] := rgb(0, 0, 0); end; end; end; Прикреплённый файл: Загрузить >> Срок хранения файла на сервере RusFAQ.ru составляет 14 суток с момента отправки ответа. --------- We came for victory

Ответ отправил: Samum (статус: Специалист) Отправлен: 17.06.2005, 21:14 Оценка за ответ: 5 Комментарий оценки: То, что доктор прописал! Единственный минус - времени на выполнение уходит уйма. Great Thanks!

© 2001-2005, RusFAQ.ru, Россия, Москва. Все права защищены.
Идея, дизайн, программирование, авторское право: Калашников О.А.