500+ FAQ по Delphi

Перейти на: Главную | Индексную | Предыдущую | Следующую страницу
Узин проекты деревянных домов деревянный дом

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

Самый простой способ - воспользоваться функцией 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;
{не выделяем никакого текста}
Edit1.SelLength := 0;
end;

Как среагировать на минимизацию-максимизацию формы перед тем как произойдет изменение размера формы?

В примере перехватывается сообщение WM_SYSCOMMAND. Если это сообщение говорит о
минимизации или максимизации формы - пищит динамик.

type
TForm1 = class(TForm)
private
{Private declarations}
procedure WMSysCommand(var Msg: TWMSysCommand);
message WM_SYSCOMMAND;
public
{Public declarations}
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.WMSysCommand;
begin
if (Msg.CmdType = SC_MINIMIZE) or (Msg.CmdType = SC_MAXIMIZE) then
MessageBeep(0)
else
inherited;
end;

Можно ли сделать так - одна форма показывает другую и остается позади нее, но фокус ввода не переходит к новой форме, а остается у старой?

В примере показывается не автосоздаваемая (non auto-created) форма, но фокус ввода ей
не передается.

uses Unit2;

procedure TForm1.Button1Click(Sender: TObject);
begin
Form2 := TForm2.Create(Application);
Form2.Visible := FALSE;
ShowWindow(Form2.Handle, SW_SHOWNA);
end;

На некоторых laptop компьютерах может не быть флоппи дисковода. Можно ли удалять из списка TDriveComboBox диски которые отключены?


В примере TDriveComboBox не показывает дисководы, которые не готовы. (not ready).
Учтите что на многих компьютерах будет ощутимая задержка при поверке plug&play
флоппи дисковода.

procedure TForm1.FormCreate(Sender: TObject);
var
i : integer;
OldErrorMode : Word;
OldDirectory : string;
begin
OldErrorMode := SetErrorMode(SEM_NOOPENFILEERRORBOX);
GetDir(0, OldDirectory);
i := 0;
while i <= DriveComboBox1.Items.Count - 1 do begin
{$I-}
ChDir(DriveComboBox1.Items[i][1] + ':\');
{$I+}
if IoResult <> 0 then
DriveComboBox1.Items.Delete(i)
else
inc(i);
end;
ChDir(OldDirectory);
SetErrorMode(OldErrorMode);
end;

Как сообщить всем формам моего приложения (в том числе и не видимым в данный момент) об изминении каких-то глобальных значений?

Один из способов - создать пользовательское сообщение и использовать метод preform
чтобы разослать его всем формам из массива Screen.Forms.

{Code for Unit1}

const
UM_MyGlobalMessage = WM_USER + 1;

type
TForm1 = class(TForm)
Label1: TLabel;
Button1: TButton;
procedure FormShow(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{Private declarations}
procedure UMMyGlobalMessage(var AMessage: TMessage); message
UM_MyGlobalMessage;
public
{Public declarations}
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

uses Unit2;

procedure TForm1.FormShow(Sender: TObject);
begin
Form2.Show;
end;

procedure TForm1.UMMyGlobalMessage(var AMessage: TMessage);
begin
Label1.Left := AMessage.WParam;
Label1.Top := AMessage.LParam;
Form1.Caption := 'Got It!';
end;

procedure TForm1.Button1Click(Sender: TObject);
var
f: integer;
begin
for f := 0 to Screen.FormCount - 1 do
Screen.Forms[f].Perform(UM_MyGlobalMessage, 42, 42);
end;

{Code for Unit2}

const
UM_MyGlobalMessage = WM_USER + 1;
type
TForm2 = class(TForm)
Label1: TLabel;
private
{Private declarations}
procedure UMMyGlobalMessage(var AMessage: TMessage);
message UM_MyGlobalMessage;
public
{Public declarations}
end;

var
Form2: TForm2;

implementation

{$R *.DFM}

procedure TForm2.UMMyGlobalMessage(var AMessage: TMessage);
begin
Label1.Left := AMessage.WParam;
Label1.Top := AMessage.LParam;
Form2.Caption := 'Got It!';
end;

Как обновить список дисков компонента TDriveComboBox, учитывая, что могут быть подключены/отключены сетевые диски и произведена "горячая замена" plug&play дисков?

Следующий пример вызывает защищенный (protected) метод класса TDriveComboBox
BuildList() для регеирации списка дисков. (использовая так наз. "class cracer")

type
TNewDriveComboBox = class(TDriveComboBox) //это наш "class cracer"
end;

procedure TForm1.Button1Click(Sender: TObject);
var
Drive : char;
begin
Drive := DriveComboBox1.Drive;
TNewDriveComboBox(DriveComboBox1).BuildList;
//вызываем защищенный метод родительского класса
DriveComboBox1.Drive := Drive;
end;

Как программно заставить выпасть меню?

В примере показано как показать меню и выбрать в нем какой-то пункт, эмулируя нажатие "быстрой кдавиши" пункта меню. Если у Вашего пункта меню нет "быстрой клавиши" Вы можете посылать комбинации VK_MENU, VK_LEFT, VK_DOWN, и VK_RETURN, чтобы программно "путешествовать" по меню.
Пример:

procedure TForm1.Button1Click(Sender: TObject);
begin
//Allow button to finish painting in response to the click
Application.ProcessMessages;
{Alt Key Down}
keybd_Event(VK_MENU, 0, 0, 0);
{F Key Down - Drops the menu down}
keybd_Event(ord('F'), 0, 0, 0);
{F Key Up}
keybd_Event(ord('F'), 0, KEYEVENTF_KEYUP, 0);
{Alt Key Up}
keybd_Event(VK_MENU, 0, KEYEVENTF_KEYUP, 0);
{F Key Down}
keybd_Event(ord('S'), 0, 0, 0);
{F Key Up}
keybd_Event(ord('S'), 0, KEYEVENTF_KEYUP, 0);
end;

Как сделать клавишу-акселератор (keyboard shortcut) компонету у которого нет заголовка?

Возможный вариант - присвоить ссылку на этот компонент свойству FocusControl TLabel'а. В примере используется невидимый Label для создания "быстрой" клавиши (Alt+M) компонента Memo. Чтобы использовать пример, разместите на форме компонет TMemo, Label и несколько других компонентов, которые могут принимать фокус ввода. Запустите программу, перевидите фокус ввода куда-нибудь вне Memo и нажмите Alt+M - фокус ввода вернется в Memo.
Пример:

procedure TForm1.FormCreate(Sender: TObject);
begin
Label1.Visible := false;
Label1.Caption := '&M';
Label1.FocusControl := Memo1;
end;

Можно ли как-то уменьшить мерцание при перерисовке компонента?

Если добавить флаг csOpaque (непрозрачный) к свойству ControlStyle компонента
- то фон компонента перерисовываться не будет.

constructor TMyControl.Create;
begin
inherited;
ControlStyle := ControlStyle + [csOpaque];
end;

Как запретить изменение размера моего компонента в design-time?

Поместите в конструктор компонента код, устанавливающий размеры по умолчанию.
Переопределите метод SetBounds и проверяйте в нем "componentstate". Если компонет
находится режиме "design-time" (csDesigning in ComponentState) просто передавайте
значения ширины и высоты (width и heights) компонента по умолчанию (в нашем
примере 50) методу класса-предка.

procedure TVu.SetBounds(ALeft : integer; ATop : integer; AWidth : integer;
AHeight : integer);
begin
if csdesigning in componentstate then
begin
AWidth := 50;
AHeight := 50;
inherited; //вызываем унаследованный от предка метод
end;
end;

Можно ли уменьшить потребляемые компонентами TNotebook и TTabbedNotebook ресурсы?

Да. Можно уничтожать обьекты, расположенные не на текущей странице TNotebook или
TTabbedNotebook. В примере вызывается защищенный (Protected) метод путем создания
так называемый "class cracer'ов".

type TMyTabbedNotebook = class(TTabbedNotebook); //это наш "class cracer"
type TMyNotebook = class(TNotebook);

procedure TForm1.TabbedNotebook1Change(Sender: TObject; NewTab: Integer;
var AllowChange: Boolean);
begin
with TabbedNotebook1 do //вызываем защищенный метод родительского класса
TMyTabbedNotebook(TWinControl(Pages.Objects[PageIndex])).DestroyHandle;
end;

procedure TForm1.TabSet1Change(Sender: TObject; NewTab: Integer;
var AllowChange: Boolean);
begin
with Notebook1 do //вызываем защищенный метод родительского класса
TMyNotebook(TWinControl(Pages.Objects[PageIndex])).DestroyHandle;
NoteBook1.PageIndex := NewTab;
AllowChange := true
end;


Материалы находятся на сайте http://cracklab.narod.ru/faq/


Создатель этого HTML файла не претендует на авторство вопросов/ответов представленных в нём, не отвечает за их содержание и достоверность, а также за последствия использования программных кодов , полученных из этого HTML файла. Также не принимаются претензии относительно не размещённой информации об авторе каждого конкретного FAQ'а. Любые другие вопросы присылайте на bad_guy@cracklab.ru (обращаться к Bad_guy'ю).
Hosted by uCoz