Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Media";
Текущий архив: 2006.01.01;
Скачать: [xml.tar.bz2];

Вниз

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

 
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 вся ветка

Форум: "Media";
Текущий архив: 2006.01.01;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.49 MB
Время: 0.011 c
1-1133526751
Ugrael
2005-12-02 15:32
2006.01.01
как задать нужный переход по ENTER ?


8-1122279928
melena
2005-07-25 12:25
2006.01.01
частота пульсации


1-1133517420
DimLord
2005-12-02 12:57
2006.01.01
Вывод данных таблиц ы на печать


14-1133898381
YDS
2005-12-06 22:46
2006.01.01
Завершение внешнего приложения в случае ошибки


2-1134592806
Free0n
2005-12-14 23:40
2006.01.01
Помогите разобраться с файлами





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский