Вопрос # 639: …ксперты!Я наверно достал всех со своим графическим редактором.Но мне н… (Графика (2D и 3D) в приложениях)

Здравствуйте, уважаемые эксперты!Я наверно достал всех со своим графическим редактором.Но мне надо добавить на панель инструментов лупу которая увеличивает рисунок и наоборот уменьшает но не с помощью оператаров strech и proportional как мне это сделать?

Здравствуйте, ММО!
Высылаю Вам часть кода, вспомогательный код могу выслать, если необходимо:

Приложение:

var
Srect, Drect, PosForme: TRect;
iWidth, iHeight, DmX, DmY: Integer;
iTmpX, iTmpY: Real;
C: TCanvas;
Kursor: TPoint;
...
if not IsIconic(Application.Handle) then
begin
GetCursorPos(Kursor);
PosForme := Rect(Form1.Left, Form1.Top, Form1.Left + Form1.Width, Form1.Top + Form1.Height);
if not PtInRect(PosForme, Kursor) then
begin
iWidth := Image1.Width;
iHeight := Image1.Height;
Drect := Bounds(0, 0, iWidth, iHeight);
iTmpX := iWidth / (Slider.Position * 4);
iTmpY := iHeight / (Slider.Position * 4);
Srect:=
Rect(Kursor.x, Kursor.y, Kursor.x, Kursor.y);
InflateRect(Srect, Round(iTmpX), Round(iTmpY));
C := TCanvas.Create;
try
C.Handle := GetDC(GetDesktopWindow);
Image1.Canvas.CopyRect(Drect, C, Srect);
finally
C.Free;
end;
end;
Windows.Application.ProcessMessages;
end;

Скачай себе базу знаний Delphi World (ещё раз советую). Там много интересного. Вот, к примеру, я там нашёл такую вещь (см. приложение):

Приложение:

{
This function resizes a bitmap calculating the average color of a rectangular
area of pixels from source bitmap to a pixel or a rectangular area to target
bitmap.
It produces a soft-color and undistorsioned result image unlike the StretchDraw
method
I think that this method have a tenichal name, but I am not sure.
As you can see, this function could be very optimized :p
}
procedure TFormConvertir.ResizeBitmap(imgo, imgd: TBitmap; nw, nh: Integer);
var
xini, xfi, yini, yfi, saltx, salty: single;
x, y, px, py, tpix: integer;
PixelColor: TColor;
r, g, b: longint;
function MyRound(const X: Double): Integer;
begin
Result := Trunc(x);
if Frac(x) >= 0.5 then
if x >= 0 then Result := Result + 1
else
Result := Result - 1;
// Result := Trunc(X + (-2 * Ord(X < 0) + 1) * 0.5);
end;
begin
// Set target size
imgd.Width := nw;
imgd.Height := nh;
// Calcs width & height of every area of pixels of the source bitmap
saltx := imgo.Width / nw;
salty := imgo.Height / nh;
yfi := 0;
for y := 0 to nh - 1 do
begin
// Set the initial and final Y coordinate of a pixel area
yini := yfi;
yfi := yini + salty;
if yfi >= imgo.Height then yfi := imgo.Height - 1;
xfi := 0;
for x := 0 to nw - 1 do
begin
// Set the inital and final X coordinate of a pixel area
xini := xfi;
xfi := xini + saltx;
if xfi >= imgo.Width then xfi := imgo.Width - 1;
// This loop calcs del average result color of a pixel area
// of the imaginary grid
r := 0;
g := 0;
b := 0;
tpix := 0;
for py := MyRound(yini) to MyRound(yfi) do
begin
for px := MyRound(xini) to MyRound(xfi) do
begin
Inc(tpix);
PixelColor := ColorToRGB(imgo.Canvas.Pixels[px, py]);
r := r + GetRValue(PixelColor);
g := g + GetGValue(PixelColor);
b := b + GetBValue(PixelColor);
end;
end;
// Draws the result pixel
imgd.Canvas.Pixels[x, y] :=
rgb(MyRound(r / tpix),
MyRound(g / tpix),
MyRound(b / tpix)
);
end;
end;
end;

Мини-форум вопроса

31 января 2011, 19:27: Статус вопроса изменён на решённый (изменил модератор Ерёмин А.А.): Автоматическая обработка (2 и более ответов с оценкой 5)

Чтобы оставлять сообщения в мини-форумах, Вы должны авторизироваться на сайте.

Экспертная система Delphi.int.ru

Сообщество программистов
Общение, помощь, обмен опытом

Delphi.int.ru Expert

Другие разделы портала

Переход к вопросу:

Статистика за сегодня:

Лучшие эксперты

Вопрос # 639

Мини-форум вопроса

Экспертная система Delphi.int.ru

Сообщество программистовОбщение, помощь, обмен опытом

Delphi.int.ru Expert

Другие разделы портала

Переход к вопросу:

Статистика за сегодня:

Лучшие эксперты

Вопрос # 639

Мини-форум вопроса

Сообщество программистов
Общение, помощь, обмен опытом