Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2006.01.01;
Скачать: CL | DM;

Вниз

Графические Аппертуры   Найти похожие ветки 

 
Retryator   (2005-07-23 00:11) [0]

Народ поможите кто чем может, у меня аппертура в пределах которой меняю картинку ,а нужно шо-бы аппертуру можно было двигать мышой и соответственно изображение единовременно менялось.С изменением картинки и заданием аппертуры нет проблем ,а что-бы её при этом мышкой двигать аппертуру...геморой.Помогите.


 
Магнитон Борыч   (2005-07-23 18:40) [1]

Апертура!
И в чем проблема, я не понял. Как ты делаешь апертуру?


 
Retryator   (2005-07-24 16:07) [2]

user вводит координаты по x y,в пределах которых будет изменяться изображение примерно вот так:
if radiobutton3.Checked then
begin
a:=image1.Width;
b:=image1.Height;
for i:= strtoint(edit1.Text) to strtoint(edit2.Text) do
for j:= strtoint(edit3.Text) to strtoint(edit4.Text) do


 
Coleman   (2005-07-25 00:43) [3]

Не понимаю ровным счетом ничего...


 
Retryator   (2005-07-25 17:27) [4]

Coleman может у тебя идея получше,как создать апертуру?А то я чуствую так, как я сделал, гемороя не оберешься!


 
Магнитон Борыч   (2005-07-26 18:44) [5]

Так ты покажешь код, который делает апертуру?


 
PAVIA ©   (2005-07-26 18:50) [6]

Я конечно извеняюсь, но что такое Апертура?


 
Магнитон Борыч   (2005-07-26 19:05) [7]

Апертура (лат. "отверстие") - в оптике - диаметр отверстия, определяющего ширину светового пучка в оптической системе. Апертура определяется размерами линз или диафрагмами. От апертуры зависит разрешающая сила прибора.

Что подразумевает автор, не знаю..


 
Retryator   (2005-07-26 23:52) [8]

Магнитон Борыч  поясняю короче нужно что-бы на загруженной картинке  
появлялся квадратик в пределах которого можно менять яркость и контрастность картинки. Как сделать этот самый квадратик,а главное как сделать что-бы его можно было перетаскивать мышкой?И причем чтобы заданные параметры яркости и контрастности единовременно изменялись только в пределах квадратика перетаскиваемого по картинке и не оставлял за собой шлейфа изменений по изображению.Вот такой вот геморой!Я уже не знаю че иделать.Пробую танцевать с бубном вокруг компа ,пока не помогает.


 
Retryator   (2005-07-30 02:12) [9]

Я же Renegat, я же Lamer, я же Mister OffTop
MailTo: wexor@yandex.ru
MailTo: ksenechka555@yandex.ru


 
Renegat   (2005-08-01 08:22) [10]

Вот настаящие!
MailTo: rts@bk.ru
MailTo: alexmanyshev@bk.ru


 
Магнитон Борыч   (2005-08-01 20:25) [11]

http://fenik.nm.ru/samp.rar (309 kb)

unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
 Math;

type
 TForm1 = class(TForm)
   procedure FormCreate(Sender: TObject);
   procedure FormDestroy(Sender: TObject);
   procedure FormPaint(Sender: TObject);
   procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
     Shift: TShiftState; X, Y: Integer);
   procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
     Y: Integer);
   procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
     Shift: TShiftState; X, Y: Integer);
 private
   FDown: Boolean;
   Src, Dest, Temp: TBitmap;
   FPosition, FPosOnFrame: TPoint;
   FImageRect: TRect;
   procedure DrawBrightFrame(ACanvas: TCanvas; Pos: TPoint);
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

const
 ImageLeft = 20;
 ImageTop = 20;
 FrameWidth = 140;
 FrameHeight = 100;

procedure ContrastBrightness(Bitmap: TBitmap; ContrastValue: Integer);
 function BLimit(B: Integer): Byte;
 begin
   if B < 0 then Result := 0
     else if B > 255 then Result := 255
       else Result := B;
 end;
var Dest: pRGBTriple;
   x, y, mr, mg, mb, W, H: Integer;
   vd: Double;
begin
 if ContrastValue = 0 then Exit;
 W := Bitmap.Width - 1;
 H := Bitmap.Height - 1;
 mR := 127;
 mG := 127;
 mB := 127;
 if ContrastValue > 0 then vd := 1 + (ContrastValue / 10)
                      else vd := 1 - (Sqrt(-ContrastValue) / 10);
 for y := 0 to H do begin
   Dest := Bitmap.ScanLine[y];
   for x := 0 to W do begin
     with Dest^ do begin
       rgbtBlue  := BLimit(mB + Trunc((rgbtBlue  - mB) * vd));
       rgbtGreen := BLimit(mG + Trunc((rgbtGreen - mG) * vd));
       rgbtRed   := BLimit(mR + Trunc((rgbtRed   - mR) * vd));
     end;
     Inc(Dest);
   end;
 end;
end;

procedure TForm1.DrawBrightFrame(ACanvas: TCanvas; Pos: TPoint);
begin
 BitBlt(ACanvas.Handle, Pos.X, Pos.Y, FrameWidth, FrameHeight,
   Dest.Canvas.Handle, FPosition.X-ImageLeft, FPosition.Y-ImageTop, SRCCOPY);
 ACanvas.FrameRect(Rect(Pos.X, Pos.Y, Pos.X + FrameWidth, Pos.Y + FrameHeight));
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 Src := TBitmap.Create;
 Src.LoadFromFile("source.bmp");
 Src.PixelFormat := pf24Bit;
 FImageRect := Rect(ImageLeft, ImageTop, ImageLeft + Src.Width, ImageTop + Src.Height);
 Dest := TBitmap.Create;
 Dest.Assign(Src);
 ContrastBrightness(Dest, 100);
 Temp := TBitmap.Create;
 Temp.Width := FrameWidth;
 Temp.Height := FrameHeight;
 Temp.PixelFormat := pf24bit;
 FPosition := Point(ImageLeft, ImageTop);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
 Src.Free;
 Dest.Free;
 Temp.Free;
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
 BitBlt(Canvas.Handle, ImageLeft, ImageTop, Src.Width, Src.Height,
   Src.Canvas.Handle, 0, 0, SRCCOPY);
 DrawBrightFrame(Canvas, FPosition);
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
 FDown := (Button = mbLeft) and
   PtInRect(Rect(FPosition.X, FPosition.Y,
                 FPosition.X + FrameWidth,
                 FPosition.Y + FrameHeight), Point(X, Y));
 if FDown then
   FPosOnFrame := Point(X - FPosition.X, Y - FPosition.Y);
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var ComboRect: TRect;
   NewPos: TPoint;
   TempX, TempY: Integer;
begin
 if FDown then begin
   NewPos := Point(
     Max(Min(X - FPosOnFrame.X, FImageRect.Right - FrameWidth), FImageRect.Left),
     Max(Min(Y - FPosOnFrame.Y, FImageRect.Bottom - FrameHeight), FImageRect.Top));
   if (NewPos.X = FPosition.X) and (NewPos.Y = FPosition.Y) then Exit;

   ComboRect := Rect(
     Min(NewPos.X, FPosition.X),
     Min(NewPos.Y, FPosition.Y),
     Max(NewPos.X, FPosition.X) + FrameWidth,
     Max(NewPos.Y, FPosition.Y) + FrameHeight);

   Temp.Width := ComboRect.Right - ComboRect.Left;
   Temp.Height := ComboRect.Bottom - ComboRect.Top;
   BitBlt(Temp.Canvas.Handle, 0, 0, Temp.Width, Temp.Height,
     Src.Canvas.Handle, ComboRect.Left - ImageLeft, ComboRect.Top - ImageTop, SRCCOPY);

   TempX := NewPos.X - ComboRect.Left;
   TempY := NewPos.Y - ComboRect.Top;
   BitBlt(Temp.Canvas.Handle, TempX, TempY, FrameWidth, FrameHeight,
     Dest.Canvas.Handle, NewPos.X - ImageLeft, NewPos.Y - ImageTop, SRCCOPY);
   Temp.Canvas.FrameRect(Rect(TempX, TempY, TempX+FrameWidth, TempY+FrameHeight));

   BitBlt(Canvas.Handle,
     ComboRect.Left, ComboRect.Top, Temp.Width, Temp.Height,
     Temp.Canvas.Handle, 0, 0, SRCCOPY);

   FPosition := NewPos;
 end;
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
 FDown := False;
end;

end.



Страницы: 1 вся ветка

Текущий архив: 2006.01.01;
Скачать: CL | DM;

Наверх




Память: 0.5 MB
Время: 0.027 c
11-1116038421
uli
2005-05-14 06:40
2006.01.01
разрешение экрана


2-1134730011
Oleg777
2005-12-16 13:46
2006.01.01
Как определить IP-адрес пользователя


14-1133982665
Kerk
2005-12-07 22:11
2006.01.01
Я не люблю праздники. А вы?


8-1122406227
Gamer
2005-07-26 23:30
2006.01.01
Работа со цветами


2-1134403027
crazycorpse
2005-12-12 18:57
2006.01.01
Ввод массива чисел