Недавно добавленные исходники

•  DeLiKaTeS Tetris (Тетрис)  647

•  TDictionary Custom Sort  3 698

•  Fast Watermark Sources  3 418

•  3D Designer  5 300

•  Sik Screen Capture  3 675

•  Patch Maker  3 911

•  Айболит (remote control)  4 093

•  ListBox Drag & Drop  3 343

•  Доска для игры Реверси  83 879

•  Графические эффекты  4 326

•  Рисование по маске  3 559

•  Перетаскивание изображений  2 933

•  Canvas Drawing  3 098

•  Рисование Луны  2 890

•  Поворот изображения  2 528

•  Рисование стержней  2 351

•  Paint on Shape  1 752

•  Генератор кроссвордов  2 454

•  Головоломка Paletto  1 949

•  Теорема Монжа об окружностях  2 544

•  Пазл Numbrix  1 825

•  Заборы и коммивояжеры  2 297

•  Игра HIP  1 414

•  Игра Go (Го)  1 375

•  Симулятор лифта  1 619

•  Программа укладки плитки  1 365

•  Генератор лабиринта  1 703

•  Проверка числового ввода  1 507

•  HEX View  1 664

•  Физический маятник  1 498

 
скрыть


Delphi FAQ - Часто задаваемые вопросы

| Базы данных | Графика и Игры | Интернет и Сети | Компоненты и Классы | Мультимедиа |
| ОС и Железо | Программа и Интерфейс | Рабочий стол | Синтаксис | Технологии | Файловая система |



Delphi Sources

Переопределение оконной процедуры и метода для другой формы





unit SubSecon;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type
  TForm2 = class(TForm)
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

{$R *.DFM}

procedure TForm2.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  Caption := Format ('Cursor in %d, %d', [X, Y]);
end;

end.


unit SubMain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TForm1 = class(TForm)
    BtnShow: TButton;
    BtnProc: TButton;
    BtnMeth: TButton;
    procedure BtnShowClick(Sender: TObject);
    procedure BtnMethClick(Sender: TObject);
    procedure BtnProcClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    OldWndMeth, NewWndMeth: Pointer;
    SubControl: TWinControl;
  public
    procedure NewWinMethod (var Msg: TMessage);
  end;

var
  Form1: TForm1;

implementation

uses SubSecon;

{$R *.DFM}

var
  OldWndProc: Pointer = nil;

function NewWinProc (Handle: THandle;
  Msg, wParam, lParam: LongInt): LongInt; stdcall;
begin
  if Msg = wm_RButtonDown then
  begin
    Beep;
    SetWindowText (Handle,
      PChar (Format ('Right click in %d, %d', [
        LoWord (lParam), HiWord (lParam)])));
  end;
  // pass call to old window proc
  Result := CallWindowProc (OldWndProc, Handle,
    Msg, wParam, lParam);
end;

procedure TForm1.NewWinMethod (var Msg: TMessage);
begin
  if Msg.Msg = wm_LButtonDown then
  begin
    Beep;
    SubControl.SetTextBuf (
      PChar (Format ('Left click in %d, %d', [
        LoWord (Msg.lParam), HiWord (Msg.lParam)])));
  end
  else
    Msg.Result := CallWindowProc (OldWndMeth,
      SubControl.Handle, Msg.Msg, Msg.WParam, Msg.LParam);
end;

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

procedure TForm1.BtnProcClick(Sender: TObject);
begin
  OldWndProc := Pointer (SetWindowLong
    (Form2.Handle, gwl_WndProc, LongInt (@NewWinProc)));
  BtnProc.Enabled := False;
  end;

procedure TForm1.BtnMethClick(Sender: TObject);
begin
  SubControl := Form2;
  NewWndMeth := MakeObjectInstance (NewWinMethod);
  OldWndMeth := Pointer (SetWindowLong (
    SubControl.Handle, gwl_WndProc, Longint (NewWndMeth)));
  BtnMeth.Enabled := False;
    end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  if Assigned (NewWndMeth) then
    FreeObjectInstance (NewWndMeth);
end;

end.

Загрузить исходный код проекта





Похожие по теме исходники

Нейросеть для распознавания образов

Механизм станка качалки для нефти

Весы для взвешивания

Кувшины для воды

 

Доска для игры Реверси




Copyright © 2004-2024 "Delphi Sources" by BrokenByte Software. Delphi World FAQ

Группа ВКонтакте