Masters of Delphi
 Сайт клуба любителей Delphi 
· FAQ · Статьи · Конференции · Ссылки · Новости мира компонент ·

Часто задаваемые Вопросы.. F.A.Q.

Дайджест от 25.11.2000

    Если Вы не нашли ответ на свой вопрос в этом дайджесте, то попробуйте найти его в основной базе.
    Поиск ведется так же и в "Круглом столе" славного "Королевства дельфи".
    И в разделе "Взаимопощь" на www.infoart.ru
Ключевые слова
Напоминаем, Вы можете получать лучшие вопросы на свой email !!! Достаточно подписаться на нашу почтовую конференцию.
 
Графика


Как быстро выводить графику? (А то Canvas очень медленно работает).
Вот пример заполнения формами точками случайного цвета.

type
TRGB=record
b,g,r:byte;
end;
ARGB=array [0..1] of TRGB;
PARGB=^ARGB;

var
b:TBitMap;

procedure TForm1.FormCreate(sender:TObject);
begin
b:=TBitMap.Create;
b.pixelformat:=pf24bit;
b.width:=Clientwidth;
b.height:=Clientheight;
end;

procedure TForm1.Tim1OnTimer(sender:TObject);
Var
p:PARGB;
x,y:integer;
begin
for y:=0 to b.height-1 do
begin
p:=b.scanline[y];
for x:=0 to b.width-1 do
begin
p[x].r:=random(256);
p[x].g:=random(256);
p[x].b:=random(256);
end;
end;
canvas.draw(0,0,b);
end;

procedure TForm1.FormDestroy(sender:TObject);
begin
b.free;
end;


Источник: Дельфи. Вокруг да около.

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

Как сделать прозрачным фон текста?


Используйте функцию SetBkMode().
Пример:

procedure TForm1.Button1Click(Sender: TObject);
var
OldBkMode : integer;
begin
with Form1.Canvas do begin
    Brush.Color := clRed;
    FillRect(Rect(0, 0, 100, 100));
    Brush.Color := clBlue;
    TextOut(10, 20, 'Not Transparent!');
    OldBkMode := SetBkMode(Handle, TRANSPARENT);
    TextOut(10, 50, 'Transparent!');
    SetBkMode(Handle, OldBkMode);
end;
end;


Источник: Дельфи. Вокруг да около.

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

Как в QuickReports вставить "Страница № из "


»»» Алексей (04.08.00 16:40)
Подскажите как можно в QuickReports на каждой странице вставить "Страница" № страницы "из" общее кол-во страниц.

»»» Fighter - FighterRu@Mail.ru (07.08.00 07:16)
Компонент TQRSysData используется для показа вспомогательной и системной информации. Вид показываемой информации определяется свойством: property Data: TQRSysDataType;

Возможные значения этого свойства:
qrsColumnNo - номер текущей колонки отчёта (для одноколончатого отчёта всегда 1).
qrsDate - текущая дата.
qrsDateTime - текущие дата и время.
qrsDetailCount - количество записей в НД, а при использовании нескольких НД -количество записей в главном наборе. Для случая, когда НД представлен компонентом TQuery, эта возможность может быть недоступной.
qrsDetailNo - номер текущей записи в НД.
qrsPageNumber - номер текущей страницы отчёта.
qrsPageCount - общее число страниц отчёта.
qrsReportTitle - заголовок отчёта.
qrsTime - текущее время.

Размести в компоненте QRBand подвала отчёта два компонента TQRSysData. В свойство Data первого из них установи значение qrsDetailNo, второго - qrsPageCount.

-= Из конференции сайта MASTERS OF DELPHI (http://delphi.mastak.com) =-
НаверхПрислать свои комментарии

Проблемы с Toolbar


»»» Дмитрий (26.07.00 18:31)
В Дельфях 3 написаная программа при установку на другой компьютер с виндами 95 не показывает изображение на кнопках, где-то читал как можно исправить, но не помню.
Помогите.

»»» Hordi - iqsoft@news.cg.ukrtel.net (27.07.00 01:18)
Проблема решается обновлением на конечном компьютере файла comctl32.dll, но правильнее будет все картинки на кнопках грузить оперативно при загрузке программы.

»»» Дмитрий - eda@arhadm.net.ru (27.07.00 08:35)
А на 5 Дельфях такая проблема есть?

»»» Hordi (28.07.00 00:08)
А это не совсем проблема Делфи, да и проблемой её считать нельзя

-= Из конференции сайта MASTERS OF DELPHI (http://delphi.mastak.com) =-
НаверхПрислать свои комментарии

TRichEdit и картинки


»»» Nuke Dukem (28.07.00 15:25)
TRichEdit и картинки подружить можно? Я мог бы наверное и рисовать картинку чуть ли не вручную поверх RichEdit-а, но при прокрутке скроллером надо картинку двигать и т.п. Вроде можно через Ole добавить картинку, но я в этом ничего не понимаю совсем.

»»» maestro - maestro@bashneft.ru (01.08.00 12:59)
я работаю с Д4, в котором кажется реализован RF v1.0. я делал следующее:
1. подготовил файл с картинкой, затем:
RichEdit1.PlainText := False;
RichEdit1.Lines.LoadFromFile('...');
в результате все прогрузилось, кроме самой картинки
2. скопировал картинку в буфер и вставил следующий код:
For nCount := 0 To Clipboard.FormatCount - 1 Do
RichEdit1.Perform(EM_PASTESPECIAL, Clipboard.Formats[bCount], 0); // То бишь пытаюсь вытащить содержимое кармана во всех возможных форматах. вышеприведенный код отлично работает с текстом, но отказывается работать с графикой
вывод: RF v1.0 (или сам RichEdit, что вобщем-то все равно) не поддерживает графику

»»» Sergey - ntv@kuzbe.elektra.ru (02.08.00 04:30)
Попробуй RXReachEdit, классная штука, делает почти всё!

-= Из конференции сайта MASTERS OF DELPHI (http://delphi.mastak.com) =-
НаверхПрислать свои комментарии

Как сделать RichEdit c прозрачным фоном?


»»» maestro - maestro@bashneft.ru (27.07.00 13:28)
Вообще-то никак. Потому что как показывает мой личный опыт, Windows для всех контролов, порожденных от TWinControl, сама закрашивает задний план. И даже если ты перехватишь WM_PAINT, то и это не поможет, так как Windows самостоятельно выполнит закраску. Однако 2 совета:
1. попробуй поиграть с WM_ERASEBCKGND (кажется так пишется);
2. попробуй ControlStyle := ControlStyle + [csOpaque] или ControlStyle := ControlStyle - [csOpaque]

»»» Merlin (27.07.00 14:10)
Я одно время занимался аналогичной задачей и в инете нашел наборы прозрачных компонент. Пытался и сам сделать набор прозрачных компонент, но... :( Результат получился не очень, они достаточно глючно работали, и компоненты нужно переписывать с нуля.
Поэтому советую найти дпугой способ решения своей задачи :)

-= Из конференции сайта MASTERS OF DELPHI (http://delphi.mastak.com) =-
НаверхПрислать свои комментарии

Как получить кол-во цветов в изображении




if Image1.Picture.Graphic is TBitmap then begin
case Image1.Picture.Bitmap.PixelFormat of {Find color depth}
pf1bit : pf := '. Monochrome';
pf4bit : pf := '. 16 Colors';
pf8bit : pf := '. 256 Colors';
pf15bit: pf := '. 32768 Colors';
pf16bit: pf := '. 65536 Colors';
pf24bit: pf := '. 16 Million Colors';
pf32bit: pf := '. Gazillions of Colors!';
else
pf := '. Custom color scheme';
end;
end;

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

Изменения размера файлов формата JPEG


»»» Andrej (19.07.00 08:17)
Я недавно начал заниматься Delphi и столкнулся с проблемой изменения размера файлов формата JPEG. Вот что я пытаюсь сделать
=== Cut ===

var
b1,b2: TJpegImage;

begin
b1:=TJPEGImage.Create;
b2:=TJPEGImage.Create;
b1.LoadfromFile('01.jpg');
b2.Width:=b1.Width div 2;
b2.SaveToFile('02.jpg');
end;

=== Cut ===

Все ноpмально компилиpyется, но пpи запyске вылетает окно виндов, мол не могy
менять pазмеp файлов JPEG: "Cannot change the size of JPEG Image". Чего делать?
Может кто-нибyдь подкинет готовyю пpоцедypкy для изменения pазмеpа, я бы по ней
pазобpался. БМП изменять наyчился, но как не бился под JPEG никак не yдалосьпpиспособить этy пpоцедypy.
Может в BMP надо пеpеводить? Я пытался юзать метод DIBNeeded, но честно говоpя ничего толком не вышло.
Помогите, кто может. Спасибо.


»»» Merlin (19.07.00 17:31)
1. В приведенном коде ошибка. Зачем b2 ? Ведь ты в него картинку-то не грузишь.
2. Попробуй менять не b1.width , а его Canvas, может получится...
3. Создай b2 с нужным размером и СКОПИРУЙ в него картинку из b1 с масштабированием (функция bitblt, кажется :)


»»» GHOST - iconsun@nm.ru (19.07.00 21:46)
Вот простенькая процедура:

procedure divJpeg;
var
b1,b2: TJpegImage;
c1: TBitmap;
begin
b1:=TJPEGImage.Create;
b2:=TJPEGImage.Create;
c1:=TBitmap.Create;
b1.LoadfromFile('С:\01.jpg');
c1.Height:=b1.Height;
c1.Width:=b1.Width div 2;
c1.Canvas.Draw(0,0,b1);
b2.Assign(c1);
b2.SaveToFile('C:\02.jpg');
b1.Free;
b2.Free;
c1.Free;
end;

Таким образом можно преобразовывать .jpg в .bmp и обратно...
А Canvas так просто в TJpegImage недоступен...

-= Из конференции сайта MASTERS OF DELPHI (http://delphi.mastak.com) =-
НаверхПрислать свои комментарии

Что нужно предусмотреть при разработке приложения, которое будет работать при различном разрешении дисплея?



* а ранней стадии создания приложения решите для себя хотите ли вы позволить форме масштабироваться. Преимущество немасштабируемой формы в том, что ничего не меняется во время выполнения. В этом же заключается и недостаток (ваша форма может бать слишком маленькой или слишком большой в некоторых случаях).
* Если вы Е собираетесь делать форму масштабируемой, установите св-во Scaled=False и дальше не читайте.
* В противном случае Scaled=True.
* Установите AutoScroll=False. AutoScroll = True означает не менять размер окна формы при выполнении что не очень хорошо выглядит, когда содержимое формы размер меняет.
* Установите фонты в форме на TrueType фонты, например Arial.
!!!!: Если такого фонта не окажется на пользовательском компьютере, то Windows выберет альтернативный фонт из того же семейства. Этот фонт может не совпадать по размеру, что вызовет проблемы.
* Установите св-во Position в любое значение, отличное от poDesigned.
poDesigned оставляет форму там, где она была во время дизайна, и, например, при разрешении 1280x1024 форма окажется в левом верхнем углу и совершенно за экраном при 640x480.
* Оставляйте по-крайней мере 4 точки между компонентами, чтобы при смене положения границы на одну позицию компоненты не "наезжали" друг на друга.
* Для однострочных меток (TLabel) с выравниванием alLeft или alRight установите AutoSize=True. Иначе AutoSize=False.
* Убедитесь, что достаточно пустого места у TLabel для изменения ширины фонта - 25% пустого места многовато, зато безопасно. При AutoSize=False Убедитесь, что ширина метки правильная, при AutoSize=True убедитесь, что есть ссвободное место для роста метки.
* Для многострочных меток (word-wrapped labels), оставьте хотя бы одну пустую строку снизу.
* Будьте осторожны при открытии проекта в среде Delphi при разных разрешениях. Свойство PixelsPerInch меняется при открытии формы. Лучше тестировать приложения при разных разрешениях, запуская готовый скомпилированный проект, а редактировать его при одном разрешении. Иначе это вызовет проблемы с размерами.
* Не изменяйте свойство PixelsPerInch !
* В общем, нет необходимости тестировать приложение для каждого разрешения в отдельности, но стоит проверить его на 640x480 с маленькими и большими фонтами и на более высоком разрешении перед продажей.
* Уделите пристальное внимание принципиально однострочным компонентам типа TDBLookupCombo. Многострочные компоненты всегда показывают только целые строки, а TEdit покажет урезанную снизу строку. Каждый компонент лучше сделать на несколько точек больше.
НаверхПрислать свои комментарии

Как сделать DLL и потом из него каpтинки гpузить


Этап первый: создание DLL
Создаёшь тексотвый файл с расширением .RC и записываешь в него строки такого вида:
----------
<название картинки1> BITMAP <название файла1>
. . .
<название картинкиN> BITMAP <название файлаN>
-------------
запускаешь программу brcc и в качестве параметра --- твой файл, RC-файл и картинки должны храниться в одном каталоге после компиляции у тебя будет один большой RES-файл
Затем у себя в программе пишешь:

AModule: THandle;

AModule := LoadLibrary(...); <--- параметры точно не помню, а в хелп лень лезть, посмотри сам

Bitmap.LoadFromResourceName(AModule, <название картинки1>);

FreeLibrary(AModule); <--- это уже в самом конце

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

Возникла проблема описания большого кол-ва полигонов...


»»» eXtrem ART (05.08.00 18:58)
Здраствуйте! -Возникла проблема описания большого кол-ва полигонов, а полигоны могут быть с разным кол-вом вершин: Я создаю

type dinmas=record
num:Byte;
a:array of TPoint;
end;

var
f: file of dinmas;
a:array[1..n] of dinmas;
...

Это всё работает, но с сохранением в фаил, - .. проблема.. Помогите справиться с этой проблемой, psl^
или кинте мне идейку, как сохранять много польгонов в массиве и в файле.
Спасиюо всем за внимание!

»»» VKA - vastikov@mail.ru (21.08.00 14:02)
Абсолютно неправильно делаешь. A: Array of tPoint - это указатель типа pointer на данные динамического массива, и файл F:file of dinmas выглядит как запись Num:byte;A:pointer, так что нужно сохранять не указатель на данные, а сами данные, т.е.:

Var
F:file;
Begin
BlockWrite(F,Num,1);
BlockWrite(F,A^,SizeOf(Num*SizeOf(TPoint)));
end;


-= Из конференции сайта MASTERS OF DELPHI (http://delphi.mastak.com) =-
НаверхПрислать свои комментарии

Как менять разрешение экрана по ходу выполнения программы


function SetFullscreenMode:Boolean;
var DeviceMode : TDevMode;
begin
with DeviceMode do begin
dmSize:=SizeOf(DeviceMode);
dmBitsPerPel:=16;
dmPelsWidth:=640;
dmPelsHeight:=480;
dmFields:=DM_BITSPERPEL or DM_PELSWIDTH or DM_PELSHEIGHT;
result:=False;
if ChangeDisplaySettings(DeviceMode,CDS_TEST or CDS_FULLSCREEN) <> DISP_CHANGE_SUCCESSFUL
then Exit;
Result:=ChangeDisplaySettings(DeviceMode,CDS_FULLSCREEN) = DISP_CHANGE_SUCCESSFUL;
end;
end;

procedure RestoreDefaultMode;
var T : TDevMode absolute 0;
begin
ChangeDisplaySettings(T,CDS_FULLSCREEN);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
if setFullScreenMode then begin
sleep(7000);
RestoreDefaultMode;
end;
end;

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

Как преобразовать bmp в jpeg



 
unit Unit1;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
Image1: TImage;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

uses JPEG;

procedure TForm1.Button1Click(Sender: TObject);
var
JPEG: TJPEGImage;
Bitmap: TBitmap;
begin
JPEG := TJPEGImage.Create;
Bitmap := TBitmap.Create;
try
Bitmap.LoadFromFile('C:\Program Files\Common Files\alarm.bmp');
JPEG.Assign(Bitmap);
Image1.Picture.Assign(JPEG);
finally
JPEG.Free;
Bitmap.Free;
end;
end;

end.

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

Как отобразить 24-битный рисунок в режиме экрана 256 цветов




uses JPEG;

procedure TForm1.Button1Click(Sender: TObject);
var
JP : TJPEGImage;
IM : TImage;
TempFileName : string;
begin
{Pop up an Open Dialog}
OpenDialog1.Options := [ofNoChangeDir, ofFileMustExist];
OpenDialog1.Filter := 'Bitmap Files (*.bmp)|*.bmp';
if OpenDialog1.Execute then begin
{Create a temporary TImage}
IM := TImage.Create(nil);
{Load the bitmap file}
IM.Picture.LoadFromFile(OpenDialog1.FileName);
{Create a temporary TJPEGImage}
JP := TJPEGImage.Create;
{Priority on quality}
JP.Performance := jpBestQuality;
{Assign the bitmap to the JPEG}
JP.Assign(IM.Picture.Graphic);
{Free the temp image}
IM.Free;
{Make a temp file name with the extension of .jpg}
TempFileName := 'test.jpg';
{Save the JPEG to a temp file}
JP.SaveToFile(TempFileName);
{Free the JPEG}
JP.Free;
{Load the temp file to an image on the form}
Image1.Picture.LoadFromFile(TempFileName);
{Delete the temp file}
DeleteFile(TempFileName);
end;
end;

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

Как загрузить и отмасштабировать JPEGImage в TImage




Image1.Picture.Graphic := nil;
try
Image1.Picture.Graphic := nil;
Image1.Picture.LoadFromFile(jpegfile);
except
on EInvalidGraphic do
Image1.Picture.Graphic := nil;
end;
if Image1.Picture.Graphic is TJPEGImage then begin
TJPEGImage(Image1.Picture.Graphic).Scale := Self.Scale;
TJPEGImage(Image1.Picture.Graphic).Performance := jpBestSpeed;
end;

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

Как изменить размер Jpeg и сохранить его в новый файл




procedure TForm1.Button1Click(Sender: TObject);
var
bmp: TBItmap;
jpg: TJpegImage;
scale: Double;
begin
if opendialog1.execute then begin
jpg:= TJpegImage.Create;
try
jpg.Loadfromfile( opendialog1.filename );
if jpg.Height > jpg.Width then
scale := 50 / jpg.Height
else
scale := 50 / jpg.Width;
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(ChangeFileext( opendialog1.filename, '_thumb.JPG' ));
finally
bmp.free;
end;
finally
jpg.free;
end;
end;

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

Как подгружать картинки, т.е есть PageControl на некоторых закладках картинки, при это смена закладок занимает много времени. Как держать картинки подгружеными, чтобы уменьшить это время.




procedure TForm1.FormCreate(Sender: TObject);
begin
if Image1.Picture.Graphic is TJPEGImage then
begin
TJPEGImage(Image1.Picture.Graphic).DIBNeeded;
end;
end;

Данный код заставляет явно и сразу декодировать jpeg, вместо того, чтобы делать это при отображении картинки
НаверхПрислать свои комментарии

Пример прорисовки "плазмы"



unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics,
Controls, Forms, Dialogs, StdCtrls, ExtCtrls;

type
TForm1 = class(TForm)
Image1: TImage;
Button1: TButton;
procedure makeplasma;
procedure start1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1 : TForm1;
plasma : array[0..768,0..768] of byte;
implementation
{$R *.DFM}
procedure TForm1.makeplasma;
procedure halfway(x1,y1,x2,y2: integer);
procedure adjust(xa,ya,x,y,xb,yb: integer);
var
d: integer;
v: double;
begin
if plasma[x,y]<>0 then exit;
d:=Abs(xa-xb)+Abs(ya-yb);
v:=(plasma[xa,ya]+plasma[xb,yb])/2+(random-0.5)*d*2;
if v<1 then v:=1;
if v>=193 then v:=192;
plasma[x,y]:=Trunc(v);
end;
var
x,y: integer;
v: double;
begin
if (x2-x1<2) and (y2-y1<2) then exit;
x:=(x1+x2) div 2;
y:=(y1+y2) div 2;
adjust(x1,y1,x,y1,x2,y1);
adjust(x2,y1,x2,y,x2,y2);
adjust(x1,y2,x,y2,x2,y2);
adjust(x1,y1,x1,y,x1,y2);
if plasma[x,y]=0 then
begin
v:=(plasma[x1,y1]+plasma[x2,y1]+plasma[x2,y2]+plasma[x1,y2])/4;
plasma[x,y]:=Trunc(v);
end;
halfway(x1,y1,x,y);
halfway(x,y1,x2,y);
halfway(x,y,x2,y2);
halfway(x1,y,x,y2);
end;
var
x,y :integer ;
begin
randomize;
plasma[0,768]:=random(192);
plasma[768,768]:=random(192);
plasma[768,0]:=random(192);
plasma[0,0]:=random(192);
halfway(0,0,768,768);
end;
procedure TForm1.start1Click(Sender: TObject);
var
x,y:integer;
begin
makeplasma;
for x:=0 to 255 do
begin
for y:=0 to 255 do
begin
image1.canvas.pixels[x,y]:=rgb(plasma[x,y],plasma[x+256,y+256],plasma[x+512,y+512]);
end;
image1.update;
end;
end;
end.


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

Как временно отключить перерисовку окна?


Вызовите функцию WinAPI LockWindowUpdate передав ей дескриптор окна, которое необходимо не обновлять. Передайте ноль в качестве параметра для восстановления нормального обновления.

LockWindowUpdate(Memo1.Handle);
.
.
LockWindowUpdate(0);


Источник: Дельфи. Вокруг да около.
НаверхПрислать свои комментарии

Перерисовка canvasf моей формы занимает довольно много времени. Как определить установлен ли у пользователя режим перерисовки всего окна при перемещении чтобы временно отключить перерисовку моего окна?


В приведенном примере определяется включен ли режим "Full Window Drag" (перерисовки всего окна при перемещении)
Пример:

procedure TForm1.Button1Click(Sender: TObject);
var
b : bool;
begin
SystemParametersInfo(SPI_GETDRAGFULLWINDOWS, 0, @b, 0);
if not b then
    ShowMessage('Full Window Drag is not enabled') else
    ShowMessage('Full Window Drag is enabled');
end;


Источник: Дельфи. Вокруг да около.

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

Как включить JPG-файл внутрь exe-файла?


Первое:

Нужно создать resource script file (*.RC) с помощью простого текстового файла (например блокнота), и вписать всего одну строку:

1 RCDATA "MyPic.jpg"

Единичка – это просто номер ресурса, RCDATA - определяет, что мы имеем дело с user-defined resource. Последнее – имя файла с JPG рисунком.

Второе:

Компилируем его в .RES файл, при помощи BRCC32.EXE. В MS-DOS набираем:

BRCC32 MyPic.RC

Это должно создать файл MyPic.RES.

Третье:

Добавляем директиву компилятор в исходный код нашей программы. Она должна следовать за директивой формы, как показано здесь:

{$R *.DFM}
{$R MyPic.RES}


Четвертое:

Добавляем следующую процедуру в программу:

procedure LoadJPEGfromEXE;

var
MyJPG : TJPEGImage; // JPEG
ResStream : TResourceStream; // Resource Stream

begin
MyJPG := TJPEGImage.Create;
ResStream := nil;
try
ResStream := TResourceStream.CreateFromID(HInstance, 1, RT_RCDATA);
MyJPG.LoadFromStream(ResStream); // ДА! Так просто :)
Canvas.Draw(12,12,MyJPG); // Нарисуем на Canvas, чтобы убедиться, что все работает!
finally
MyJPG.Free;
ResStream.Free;
end;
end; // procedure


Посмотрите на второй параметр процедуры CreateFromID объекта TresourceStream. Это просто индекс ресурса. Вы можете включить более, чем один jpeg в своей программе просто добавляя новую строчку для каждого jpeg (с другим индексом) в .RC файл.

Пятое:

Запускайте программу, и ура! Теперь можно взять с полки пирожок :)
НаверхПрислать свои комментарии

Как определить размеры jpeg, gif, png


Вот вам процедуры, но они могут не работать с последними форматами типа progressive JPEG

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(Byte));
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: TPNGSig = (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: TGifImageBlock;
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.

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

Как перебросить TImage с jpeg в TBitmap в runtime




b := TBitmap.Create;
try
b.Assign(Image1.Picture.Graphic);
Image2.Picture.Graphic := b;
finally
b.Free;
end;

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

Можно ли из Delphi рисовать в любой части экрана или в чужом окне?


Для этого надо воспользоваться функциями API. Получить контекст чужого окна, либо всего экрана:
function GetDC(Wnd: HWnd): HDC;
где Wnd - указатель на нужное окно, или 0 для получения контекста всего экрана.
И далее, пользуясь функциями API, нарисовать все что надо.
Пример:

PROCEDURE DrawOnScreen;
VAR ScreenDC: hDC;
BEGIN
ScreenDC := GetDC(0); {получить контекст экрана}
Ellipse(ScreenDC, 0, 0, 200, 200); {нарисовать}
ReleaseDC(0,ScreenDC); {освободить контекст}
END;

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

Копирование экрана



unit ScrnCap;
interface
uses WinTypes, WinProcs, Forms, Classes, Graphics, Controls;

{ Копирует прямоугольную область экрана }
function CaptureScreenRect(ARect : TRect) : TBitmap;
{ Копирование всего экрана }
function CaptureScreen : TBitmap;
{ Копирование клиентской области формы или элемента }
function CaptureClientImage(Control : TControl) : TBitmap;
{ Копирование всей формы элемента }
function CaptureControlImage(Control : TControl) : TBitmap;

{===============================================================}
implementation
function GetSystemPalette : HPalette;
var
PaletteSize : integer;
LogSize : integer;
LogPalette : PLogPalette;
DC : HDC;
Focus : HWND;
begin
result:=0;
Focus:=GetFocus;
DC:=GetDC(Focus);
try
PaletteSize:=GetDeviceCaps(DC, SIZEPALETTE);
LogSize:=SizeOf(TLogPalette)+(PaletteSize-1)*SizeOf(TPaletteEntry);
GetMem(LogPalette, LogSize);
try
with LogPalette^ do
begin
palVersion:=$0300;
palNumEntries:=PaletteSize;
GetSystemPaletteEntries(DC, 0, PaletteSize, palPalEntry);
end;
result:=CreatePalette(LogPalette^);
finally
FreeMem(LogPalette, LogSize);
end;
finally
ReleaseDC(Focus, DC);
end;
end;


function CaptureScreenRect(ARect : TRect) : TBitmap;
var
ScreenDC : HDC;
begin
Result:=TBitmap.Create;
with result, ARect do begin
Width:=Right-Left;
Height:=Bottom-Top;
ScreenDC:=GetDC(0);
try
BitBlt(Canvas.Handle, 0,0,Width,Height,ScreenDC, Left, Top, SRCCOPY    );
finally
ReleaseDC(0, ScreenDC);
end;
Palette:=GetSystemPalette;
end;
end;

function CaptureScreen : TBitmap;
begin
with Screen do
Result:=CaptureScreenRect(Rect(0,0,Width,Height));
end;

function CaptureClientImage(Control : TControl) : TBitmap;
begin
with Control, Control.ClientOrigin do
result:=CaptureScreenRect(Bounds(X,Y,ClientWidth,ClientHeight));
end;

function CaptureControlImage(Control : TControl) : TBitmap;
begin
with Control do
if Parent=Nil then
result:=CaptureScreenRect(Bounds(Left,Top,Width,Height))
else
with Parent.ClientToScreen(Point(Left, Top)) do
result:=CaptureScreenRect(Bounds(X,Y,Width,Height));
end;
end.


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


Сайт клуба любителей Delphi - Masters of Delphi
Designed by MoveR Studio © 2000  - | -  Вопросы? Предложения? пишите