Последние записи

made in programmersforum 8

Интенсив по Python: Работа с API и фреймворками 24-26 ИЮНЯ 2022. Знаете Python, но хотите расширить свои навыки?
Slurm подготовили для вас особенный продукт! Оставить заявку по ссылке - https://slurm.club/3MeqNEk

Online-курс Java с оплатой после трудоустройства. Каждый выпускник получает предложение о работе
И зарплату на 30% выше ожидаемой, подробнее на сайте академии, ссылка - ttps://clck.ru/fCrQw

11th
Дек

Canvas + Zoom

Posted by maloy under Delphi, Архив

alex Cones

Код:

procedure TFRMMain.FormCreate(Sender: TObject);
Var
 X,Y : Integer;
begin
 FRMMain.Left := 100;
 FRMMain.Top := 0;
 Bit := TBitMap.Create;
 Bit.Width := 50;
 Bit.Height := 50;
 BitZ := TBitMap.Create;
 BitZ.Width := 50;
 BitZ.Height := 50;
 If ParamStr(1) = '' Then
  Begin
   For Y := 0 To 499 Do
    For X := 0 To 499 Do
     Bit.Canvas.Pixels[X,Y] := $000000;
   Bit.Canvas.Pixels[0,0] := $0000FF;
   BitZ.Canvas.Draw(0,0, Bit);
  End
 Else
  Begin
   {...}
  End;
 FRMMain.IMGMain.Width := 50;
 FRMMain.IMGMain.Height := 50;
 FRMMain.IMGMain.Canvas.Draw(0,0,BitZ);
end;

Код:


procedure TFRMMain.RG2Click(Sender: TObject);
Begin
 Zoom := Round(Exp(FRMMain.RG2.ItemIndex * Ln(2)));
 DrawBit;
End;

Код:


Procedure DrawBit;
Var
 X,Y : Integer;
Begin
 BitZ.Width  := Bit.Width  * Zoom;
 BitZ.Height := Bit.Height * Zoom;
 For Y := 0 To BitZ.Height - 1 Do
  For X := 0 To BitZ.Widht - 1 Do
   Begin
    BitZ.Canvas.Pixels[X,Y] := Bit.Canvas.Pixels[X Div Zoom, Y Div Zoom];
   End;
 FRMMain.IMGMain.Width  := BitZ.Width;
 FRMMain.IMGMain.Height := BitZ.Height;
 FRMMain.IMGMain.Canvas.Draw(0,0, BitZ);
 FRMMain.IMGMain.Refresh;
End;

Не пашет и все тут. Выражается так — пиксель, который я установил красным в OnCreate увеличивается, а вот вся картинка (черный квадрат) остается прежних размеров. Причем IMAGE увеличивает размеры- скроллбокс дает прокрутки.

mutabor

Вот самый простой вариант с TImage

Код:


procedure TFrmMain.FormCreate(Sender: TObject);
Var
 X,Y : Integer;
begin
 IMGMain.AutoSize := True; // одна строка
 FRMMain.Left := 100;
 FRMMain.Top := 0;
 Bit := TBitMap.Create;
 Bit.Width := 50;
 Bit.Height := 50;
 BitZ := TBitMap.Create;
 BitZ.Assign(Bit);
 If ParamStr(1) = '' Then
  Begin
   Bit.Canvas.Brush.Color := 0;
   Bit.Canvas.FillRect(Bit.Canvas.ClipRect);
   Bit.Canvas.Pixels[0,0] := $0000FF;
   BitZ.Canvas.Draw(0,0, Bit);
  End
 Else
  Begin
   {...}
  End;
 IMGMain.Picture.Bitmap := BitZ; // вторая строка, всё, больше ничего не надо
end;

procedure TFrmMain.RG2Click(Sender: TObject);
Begin
 Zoom := Round(Exp(FRMMain.RG2.ItemIndex * Ln(2)));
 DrawBit;
End;

Procedure TFrmMain.DrawBit;
Var
 X,Y : Integer;
Begin
 BitZ.Width  := Bit.Width  * Zoom;
 BitZ.Height := Bit.Height * Zoom;
 For Y := 0 To BitZ.Height - 1 Do
  For X := 0 To BitZ.Width - 1 Do
   Begin
    BitZ.Canvas.Pixels[X,Y] := Bit.Canvas.Pixels[X Div Zoom, Y Div Zoom];
   End;
 IMGMain.Picture.Bitmap := BitZ; // присваиваем еще раз когда нужно обновить
End;

тема на форуме от 2010 года