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

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


Информационный Канал Subscribe.Ru

Ежедневная рассылка сайта Мастера DELPHI

DELPHIMASTER.ru

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

Кое-что из нашей кладовки   |x|
  • Hack 0.1 Шоломицкий 02pm@mail.ru   (06.06.03 22:52)
    Юль, оставь мне что-нить вгостевухе, а то она у меня новая, а сообщений нету почти
    »»» Скачать: исходные тексты
Лучшее из нашего FAQ   |x|
Как работать с палитрой в Delphi? На форме установлен TImage и видна картинка (*.BMP файл), как изменить у него палитру цветов ?
Палитра в TBitmap и TMetaFile доступна через property Palette. Если палитра имеется (что совсем необязательно), то Palette<>0:

procedure TMain.BitBtnClick(Sender: TObject);
var
Palette : HPalette;
PaletteSize : Integer;
LogSize: Integer;
LogPalette: PLogPalette;
Red : Byte;
begin
Palette := Image.Picture.Bitmap.ReleasePalette;
// здесь можно использовать просто Image.Picture.Bitmap.Palette, но я не
// знаю, удаляются ли ненужные палитры автоматически

if Palette=0 then exit; //Палитра отсутствует
PaletteSize := 0;
if GetObject(Palette, SizeOf(PaletteSize), @PaletteSize) = 0 then Exit;
// Количество элементов в палитре = paletteSize
if PaletteSize = 0 then Exit; // палитра пустая
// определение размера палитры
LogSize := SizeOf(TLogPalette) + (PaletteSize - 1) * SizeOf(TPaletteEntry);
GetMem(LogPalette, L! ogSize);
try
// заполнение полей логической палитры
with LogPalette^ do begin
palVersion := $0300; palNumEntries := PaletteSize;
GetPaletteEntries(Palette, 0, PaletteSize, palPalEntry);
// делаете что нужно с палитрой, например:
Red := palPalEntry[PaletteSize-1].peRed;
Edit1.Text := 'Красная составляющего последнего элемента палитры ='+IntToStr(Red);
palPalEntry[PaletteSize-1].peRed := 0;
//.......................................
end;
// завершение работы
Image.Picture.Bitmap.Palette := CreatePalette(LogPalette^);
finally
FreeMem(LogPalette, LogSize);
// я должен позаботиться сам об удалении Released Palette
DeleteObject(Palette);
end;
end;


{ Этот модуль заполняет фон формы рисунком bor6.bmp (256 цветов)
и меняет его палитру при нажатии кнопки }

unit bmpfo! rmu;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;

type
TBmpForm = class(TForm)
Button1: TButton;
procedure FormDestroy(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
Bitmap: TBitmap;
procedure ScrambleBitmap;
procedure WMEraseBkgnd(var m: TWMEraseBkgnd); message WM_ERASEBKGND;
end;

var
BmpForm: TBmpForm;

implementation
{$R *.DFM}
procedure TBmpForm.FormCreate(Sender: TObject);
begin
Bitmap := TBitmap.Create;
Bitmap.LoadFromFile('bor6.bmp');
end;

procedure TBmpForm.FormDestroy(Sender: TObject);
begin
Bitmap.Free;
end;

// since we're going t! o be painting the whole form, handling this
// message will suppress the uneccessary repainting of the background
// which can result in flicker.
procedure TBmpform.WMEraseBkgnd(var m : TWMEraseBkgnd);
begin
m.Result := LRESULT(False);
end;

procedure TBmpForm.FormPaint(Sender: TObject);
var x, y: Integer;
begin
y := 0;
while y < Height do begin
x := 0;
while x < Width do begin
Canvas.Draw(x, y, Bitmap);
x := x + Bitmap.Width;
end;
y := y + Bitmap.Height;
end;
end;

procedure TBmpForm.Button1Click(Sender: TObject);
begin
ScrambleBitmap; Invalidate;
end;

// scrambling the bitmap is easy when it's has 256 colors:
// we just need to change each of the color in the palette
// to some other value.
procedure TB! mpForm.ScrambleBitmap;
var
pal: PLogPalette;
hpal: HPALETTE;
i: Integer;
begin
pal := nil;
try
GetMem(pal, sizeof(TLogPalette) + sizeof(TPaletteEntry) * 255);
pal.palVersion := $300;
pal.palNumEntries := 256;
for i := 0 to 255 do
begin
pal.palPalEntry[i].peRed := Random(255);
pal.palPalEntry[i].peGreen := Random(255);
pal.palPalEntry[i].peBlue := Random(255);
end;
hpal := CreatePalette(pal^);
if hpal <> 0 then
Bitmap.Palette := hpal;
finally
FreeMem(pal);
end;
end;

end.


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

Обсуждается в конференциях   |x|
У нас большой выбор статей   |x|
Использование Debug API: пример перехвата вызовов функций Win32 API
Я предпочитаю не писать сухие статьи с кучей теории. Поскольку я люблю читать работающий исходный код, то и здесь будет только исходный код. Все пояснения я буду вставлять прямо в исходник - в виде комментариев. Впрочем, не надейтесь, что вам будет достаточно выдрать отсюда исходник, и он скомпилится. :-) Это не потому, что я специально что-то скрыл, а потому, что я вырезал кучу вспомогательных процедур, которые каждый может написать сам. Если вы, все же, паталогически ленивы - скачайте архив с полными рабочими исходниками. Оттуда точно заработает.
Новинки книжного рынка   |x|
Переход на Kylix для Delphi-программистов
Задача этой книги — познакомить программистов с мощным инструментом разработки приложений — средой Kylix, а также представить готовые решения, которые позволят созданным приложениям нормально работать. Для тех, кто не имеет опыта «общения» с Linux, изложены основы программирования в этой операционной системе. Необходимые для работы с Kylix знания в области синтаксиса языка C, подробное рассмотрение вопросов создания и подключения библиотек, управления процессами, работы с файловой системой и других ключевых для программирования вопросов, а также множество хорошо прокомментированных образцов программного кода делают эту книгу необходимым помощником любого Kylix-программиста.
Автор: Тэйлор Д., Мишель Дж., Джентри Т.
Другие сайты о DELPHI   |x|
Delphi - Программирование в Delphi
Сайт для настоящих программистов !
На этом сайте вы найдёте:
множество исходников, документации, компонентов, программ, а также для программистов есть чат, форум, FAQ и многое другое !
Сайт ...

» Оценка сайта: 4
Опрос населения :)
Как часто вы заглядываете на наш сайт?
»»» Регулярно
»»» Раз в неделю
»»» Когда нужна помощь
»»» По почтовой рассылке
»»» Сделал стартовой страницей
Для души

Хокку дня
Соевым соусом морду намажу
Сяду в кусты у дороги
Чем я не нинзя?

Афоризмы
Не стой на месте, иди, ищи новые... тупики!

Фраза дня
А все-таки она вертится!

Дурацкие законы (информация предоставлена сайтом kurilka.com)
В штате Нью Йорк (США) вам грозит штраф в 25 долларов, если вы на улице будете засматриваться на женщин. Закон особенно строг по отношению к тем, кто оборачивается вслед проходящим дамам. Мужчинам, которые были пойманы на этом дважды, предписывается надевать лошадиные шоры.
В Северной Каролине (США) запрещается использовать слонов для вспашки полей.

И на закуску коротенький анекдот
Жена спрашивает мужа:
- Ты меня сильно любишь, дорогой?
- Да, как и ты меня.
- Ну, знаешь!!!

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


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

Добро пожаловать на сайт -= Мастера DELPHI =- 


http://subscribe.ru/
E-mail: ask@subscribe.ru
Отписаться
Убрать рекламу

В избранное