{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. В качестве параметров вы должны переслать начальную позицию курсора, и конечную позицию, определяющую конец выделения текста цветом. В приведенном примере курсор помещается во вторую позицию, текст внутри ячейки не выделяется.