Заполнение фона формы рисунком

Delphi , Программа и Интерфейс , Интерфейс

unit bmpformu;

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 to 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 TBmpForm.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.

Перевод контента на русский язык:

Это приложение Delphi, которое заполняет форму изображением bitmap и позволяет пользователю помешать цветам изображения нажатием кнопки.

Вот подробное описание работы: 1. Класс TBmpForm наследуется от TForm и содержит несколько процедур: - FormCreate: эта процедура вызывается при создании формы. Она загружает bitmap-изображение из файла "bor6.bmp" в объект TBitmap. - FormDestroy: эта процедура вызывается при уничтожении формы. Она освобождает память, выделенную для объекта TBitmap. - WMEraseBkgnd: эта процедура обрабатывает сообщение WM_ERASEBKGND, которое отправляется форме, когда она должна очистить свой фон. В этом случае она подавляет стандартное поведение возвращая LRESULT(False). - FormPaint: эта процедура рисует форму с bitmap-изображением. Она рисует изображение на канвасе формы, строка за строкой. - Button1Click: эта процедура вызывается при нажатии кнопки на форме. Она вызывает процедуру ScrambleBitmap и недействует форму, чтобы спровоцировать перерисовку.

1. Процедура ScrambleBitmap помешает цветам bitmap-изображения, изменяя каждый цвет в палитре на случайное значение. Она создает новый логический палет, заполняет его случайными значениями для компонентов красного, зеленого и синего цветов, и присваивает эту палету изображению.

Пример вывода: Когда вы запустите программу, форма появится с bitmap-изображением. Если вы нажмете на кнопку на форме, цвета bitmap-изображения будут помешаны, и форма будет перерисована с новым цветовым схемой.

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

В статье описано заполнение фона формы рисунком в Delphi с помощью изменения палитры растрового изображения.

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: Интерфейс ::