Виртуальная библиотека Delphi - [90]

Запустите BRCC32.exe (Borland Resource CommandLine Compiler) — программа находится в каталоге Bin Delphi/C++ Builder'а — передав ей в качестве параметра полный путь к rc-файлу. В нашем примере:

C:\DelphiPath\BIN\BRCC32.EXE C:\ProjectPath\FOO.RC

Вы получите откомпилированный ресурс — файл с расширением ".res". (в нашем случае — foo.res). Далее добавьте ресурс к своему приложению.

{Грузим ресурс}
{$R FOO.RES}
uses Jpeg;

procedure LoadJPEGFromRes(TheJPEG : string; ThePicture : TPicture);
var
 ResHandle : THandle;
 MemHandle : THandle;
 MemStream : TMemoryStream;
 ResPtr : PByte;
 ResSize : Longint;
 JPEGImage : TJPEGImage;
 begin ResHandle := FindResource(hInstance, PChar(TheJPEG), 'JPEG');
 MemHandle := LoadResource(hInstance, ResHandle);
 ResPtr := LockResource(MemHandle);
 MemStream := TMemoryStream.Create;
 JPEGImage := TJPEGImage.Create;
 ResSize := SizeOfResource(hInstance, ResHandle);
 MemStream.SetSize(ResSize);
 MemStream.Write(ResPtr^, ResSize);
 FreeResource(MemHandle);
 MemStream.Seek(0, 0);
 JPEGImage.LoadFromStream(MemStream);
 ThePicture.Assign(JPEGImage);
 JPEGImage.Free;
 MemStream.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 LoadJPEGFromRes('MYJPEG', Image1.Picture);
end;

Вопрос:

Как перехватить сообщения прокрутки в TScrollBox?

Ответ:

Следующий пример перехватывает сообщения о прокрутке компонента TScrollBox и синхронизирует обе линейки прокрутки. Сообщения прокрутки перехватываются с помощью переопределения оконной процедуры (WinProc) ScrollBox'а.

Пример:

type
{$IFDEF WIN32}
WParameter = LongInt;
{$ELSE}
WParameter = Word;
{$ENDIF}
LParameter = LongInt;

{Declare a variable to hold the window procedure we are replacing}
var OldWindowProc : Pointer;

function NewWindowProc(WindowHandle : hWnd; TheMessage : WParameter; ParamW : WParameter; ParamL : LParameter) : LongInt
{$IFDEF WIN32} stdcall; {$ELSE} ; export; {$ENDIF}
var
 TheRangeMin : integer;
 TheRangeMax : integer;
 TheRange : integer;
begin
 if TheMessage = WM_VSCROLL then begin
  {Get the min and max range of the horizontal scroll box}
  GetScrollRange(WindowHandle, SB_HORZ, TheRangeMin, TheRangeMax);
  {Get the vertical scroll box position}
  TheRange := GetScrollPos(WindowHandle, SB_VERT);
  {Make sure we wont exceed the range}
  if TheRange < TheRangeMin then TheRange := TheRangeMin else if TheRange > TheRangeMax then TheRange := TheRangeMax;
  {Set the horizontal scroll bar}
  SetScrollPos(WindowHandle, SB_HORZ, TheRange, true);
 end;
 if TheMessage = WM_HSCROLL then begin
  {Get the min and max range of the horizontal scroll box}
  GetScrollRange(WindowHandle, SB_VERT, heRangeMin, TheRangeMax);
  {Get the horizontal scroll box position}
  TheRange := GetScrollPos(WindowHandle, SB_HORZ);
  {Make sure we wont exceed the range}
  if TheRange < TheRangeMin then TheRange := TheRangeMin else if TheRange > TheRangeMax then TheRange := TheRangeMax;
   {Set the vertical scroll bar}
   SetScrollPos(WindowHandle, SB_VERT, TheRange, true);
  end;
 {Call the old Window procedure to allow processing of the message.}
 NewWindowProc := CallWindowProc(OldWindowProc, WindowHandle, TheMessage, ParamW, ParamL);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 {Set the new window procedure for the control and remember the old window procedure.}
 OldWindowProc := Pointer(SetWindowLong(ScrollBox1.Handle, GWL_WNDPROC, LongInt(@NewWindowProc)));
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
 {Set the window procedure back to the old window procedure.}
 SetWindowLong(ScrollBox1.Handle, GWL_WNDPROC, LongInt(OldWindowProc));
end;

Вопрос:

Как сделать прямоугольник для выделения части картинки для редактирования?

Ответ:

Самый простой способ — воспользоваться функцией Windows API DrawFocusRect. Функция DrawFocusRect использует операцию XOR при рисовании — таким образом вывод прямоугольника дважды с одними и теми же координатами стирает прямоугольник, и прямоугольник всегда будет виден, на фоне какого бы цвета он не выводился.

Пример:

type TForm1 = class(TForm)
 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
 {Private declarations}
 Capturing : bool;
 Captured : bool;
 StartPlace : TPoint;
 EndPlace : TPoint;
public
 {Public declarations}
end;

var Form1: TForm1;

implementation
{$R *.DFM}

function MakeRect(Pt1 : TPoint; Pt2 : TPoint) : TRect;
begin
 if pt1.x < pt2.x then begin
  Result.Left := pt1.x;
  Result.Right := pt2.x;
 end else begin
  Result.Left := pt2.x;
  Result.Right := pt1.x;
 end;
 if pt1.y < pt2.y then begin
  Result.Top := pt1.y;
  Result.Bottom := pt2.y;
 end else begin
  Result.Top := pt2.y;
  Result.Bottom := pt1.y;
 end;
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
 if Captured then DrawFocusRect(Form1.Canvas.Handle,MakeRect(StartPlace,EndPlace));
 StartPlace.x := X;
 StartPlace.y := Y;