Canvas + Zoom - не работает.

[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 увеличивает размеры- скроллбокс дает прокрутки.

[Alex Cones]

Сделал другой вариант, та же проблема:

Procedure DrawBit;
Var
 mRect : TRect;
Begin
 mRect := Rect(0, 0, Bit.Width * Zoom, Bit.Height * Zoom);
 FRMMain.IMGMain.Width := Bit.Width * Zoom;
 FRMMain.IMGMain.Height := Bit.Height * Zoom;
 FRMMain.IMGMain.Canvas.StretchDraw(mRect, Bit);
End;

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;
 If ParamStr(1) = '' Then
  Begin
   For Y := 0 To 49 Do
    For X := 0 To 49 Do
     Bit.Canvas.Pixels[X,Y] := $000000;
   Bit.Canvas.Pixels[0,0] := $0000FF;
  End
 Else
  Begin
   {...}
  End;
 FRMMain.IMGMain.Width := 50;
 FRMMain.IMGMain.Height := 50;
 FRMMain.IMGMain.Canvas.Draw(0,0,Bit);
end;

procedure TFRMMain.FormDestroy(Sender: TObject);
begin
 Bit.Free;
end;

[mutabor]

Первое чтобы я сделал, это поменял бы Image на PaintBox. Высокоуровневость Image часто только мешает и выражается в подобных багах, и в потере времени на их поиск. PaintBox же простой как три копейки, и делает только то что ты ему говоришь, добавить только процедуру его обновления (PaintBox.OnPaint) чтобы не пропадал когда не надо, но рисовать нужно непосредственно в нем, а не через обновление, а то мерцать будет, обновление пусть вызывается только системой.

Второе что я заметил, это заливка белым цветом в цикле, очень неэффективно. Делай просто FillRect(ClientRect), будет на порядок быстрее.

Я так понял, пытаешься масштабирование замутить? Для квадратиков конечно и так сойдет, но для более сложных картинок, чтобы было красиво, нужна интерполяция, не так просто. Я на опыте уже убедился, если под Винду, то апишный StretchBlt хорошо это делает. Дельфийские процедуры масштабирования работают хуже по качеству. А если самому, и хочешь качество, в сети есть алгоритмы (Scaling поищи).

PS Кстати, в рамках обмена опыта не объяснишь, что тут происходит? (не дружу я с математикой)
Zoom := Round(Exp(FRMMain.RG2.ItemIndex * Ln(2)));

PSS Как я и предполагал, замена на PaintBox решила проблему (код ниже). Либо замени, либо поколдуй над имиджом. Просто менять размеры мало, я не помню чего уж там ему не хватает, но что-то еще нужно сделать. Можешь просто присвоить свой битмап ему на битмап: Image.Bitmap := Bitmap; И автосайз задай ему, чтобы не менять размеры каждый раз явно. Так должно работать как надо.

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.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;
 FRMMain.IMGMain.Width := 50;
 FRMMain.IMGMain.Height := 50;
 FRMMain.IMGMain.Canvas.Draw(0,0,BitZ);
end;


procedure TFrmMain.ImgMainPaint(Sender: TObject);
begin
  (Sender as TPaintBox).Canvas.Draw(0, 0, 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;
 FRMMain.IMGMain.Width  := BitZ.Width;
 FRMMain.IMGMain.Height := BitZ.Height;
 FRMMain.IMGMain.Canvas.Draw(0,0, BitZ);
 // FRMMain.IMGMain.Refresh; // это лишнее
End;

[SERG1980]

Да и StrechDraw неплохо работает у того же имиджа

[mutabor]

Да и StrechDraw неплохо работает у того же имиджа

Апишный стретч для фотографий качественнее, проверено.

[Alex Cones]

Я все таки нашел решение для имаджа - просто, как все гениальное:

 FRMMain.IMGMain.Picture.Bitmap.Width := Bit.Width * Zoom;
 FRMMain.IMGMain.Picture.Bitmap.Height := Bit.Height * Zoom;

Похоже просто изменение размеров имаги не давало изменение размеров битмапа, ассоциированного внутри имаги. Интерполяция в данном случае даром не нужна, т.к. это смесь пеинта и моего формата файлов.

[mutabor]

Правильнее было бы так (автосайз должен быть задан имиджу):
FRMMain.IMGMain.Picture.Bitmap := BitZ;
И больше ничего не надо делать, изображение появится само.

А если BitZ уже был назначен имиджу, даже и этого делать не надо, тогда либо просто обновить его, либо он даже сам может среагировать на изменения в битмапе, нужно пробовать.

Кстати если ты будешь манипулировать битмапом имиджа, имей ввиду, ты манипулируешь на самом деле тем битмапом к-рый ранее назначил (присвоил свойству Bitmap) ему. Т.е. например, такой код:
Image.Canvas.Draw(0, 0, SomeBitmap);
может означать копирование самого в себя. Если до этого ссылка на SomeBitmap была присвоена в Picture.Bitmap.

Вношу поправку, это все не так. Image содержит независимый объект TBitmap, проверил адреса специально, и при присваивании скорее всего происходит неявное (код инкапсулирован где-то внутри имиджа) копирование битов одного битмапа в другой.

[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;