Виртуальная библиотека Delphi

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;

EndPlace.x := X;

EndPlace.y := Y;

DrawFocusRect(Form1.Canvas.Handle,MakeRect(StartPlace,EndPlace));

Capturing := true;

Captured := true;

end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);

begin

if Capturing then begin

DrawFocusRect(Form1.Canvas.Handle,MakeRect(StartPlace,EndPlace));

EndPlace.x := X;

EndPlace.y := Y;

DrawFocusRect(Form1.Canvas.Handle,MakeRect(StartPlace,EndPlace));

end;

end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

Capturing := false;

end;

Вопрос:

Можно ли использовать иконку как картинку на кнопке TSpeedButton?

Ответ:

Можно.

См. пример.

Пример:

uses ShellApi;

procedure TForm1.FormShow(Sender: TObject);

var Icon: TIcon;

begin

Icon := TIcon.Create;

Icon.Handle := ExtractIcon(0,'C:\WINDOWS\NOTEPAD.EXE',1);

SpeedButton1.Glyph.Width := Icon.Width;

SpeedButton1.Glyph.Height := Icon.Height;

SpeedButton1.Glyph.Canvas.Draw(0, 0, Icon);

Icon.Free;

end;

Вопрос:

Как поместить прозрачную фоновую каринку на компонент CoolBar?

Ответ:

procedure TForm1.Button1Click(Sender: TObject);

var

Bm1 : TBitmap;

Bm2 : TBitmap;

begin

Bm1 := TBitmap.Create;

Bm2 := TBitmap.Create;

Bm1.LoadFromFile('c:\download\test.bmp');

Bm2.Width := Bm1.Width;

Bm2.Height := Bm1.Height;

bm2.Canvas.Brush.Color := CoolBar1.Color;

bm2.Canvas.BrushCopy(Rect(0, 0, bm2.Width, bm2.Height), Bm1, Rect(0, 0, Bm1.width, Bm1.Height), ClWhite);

bm1.Free;

CoolBar1.Bitmap.Assign(bm2);

bm2.Free;

end;

Вопрос:

Ползунок компонента TScrollBar все время мигает. Как это отключить?

Ответ:

Установите свойтсво ScrollBar.TabStop в False.

Вопрос:

Как программно перевести DBgrid в реим редактирования и установить курсор в окошке редактирования в требуемую позицию?

Ответ:

Переведите таблицу в режим редактирования, затем получите дескриптор (handle) окна редактирования и перешлите ей сообщение EM_SETSEL. В качестве параметров вы должны переслать начальную позицию курсора, и конечную позицию, определяющую конец выделения текста цветом. В приведенном примере курсор помещается во вторую позицию, текст внутри ячейки не выделяется.

Пример:

procedure TForm1.Button1Click(Sender: TObject);

var h : THandle;

begin

Application.ProcessMessages;

DbGrid1.SetFocus;

DbGrid1.EditorMode := true;

Application.ProcessMessages;

h:= Windows.GetFocus;

SendMessage(h, EM_SETSEL, 2, 2);

end;

Вопрос:

Как поместить курсор в определенную позицию edit'а и подобных ему элементов управления?

Ответ:

Можно использовать методы Delphi SelStart() и SelectLength().

Пример:

procedure TForm1.Button1Click(Sender: TObject);

begin

Edit1.SetFocus;

{переводим курсор во вторую позицию}

Edit1.SelStart := 2;

{не выделяем никакого текста}