vari: integer;r: real; beginr := 34.56;i := trunc(r); {i = 34} {Первый метод}i := round(r); {i = 35} {Второй метод}end; |
procedure TMainForm.FormCreate(Sender: TObject);beginkeyPreview := true; {"Включаем" обработку.}end; procedure TMainForm.FormKeyPress(Sender: TObject; var Key: Char);beginif Key = #13 thenbeginKey := #0;PostMessage(Handle, WM_NEXTDLGCTL, 0, 0);end;end; |
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift:TShiftState);beginif Key = VK_RETURN then Key = VK_TAB;end; procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);beginif Key = #13 then Key := #9;end; |
DBGrid1.SelectedField := Table1SomeField;DBGrid1.SetFocus; |
session.AddPassword('Мой секретный пароль');table1.active := true; |
constScreenHeight: Integer = 800; {Я разрабатывал мою форму в режиме 800x600.}ScreenWidth: Integer = 600; procedure TForm1.FormCreate(Sender: TObject);varx, y: LongInt; {Целое не будет достаточной для этого величиной.} beginform1.scaled := true;x := getSystemMetrics(SM_CXSCREEN);y := getSystemMetrics(SM_CYSCREEN);if (x <> ScreenHeight) or (y <> ScreenWidth) thenbeginform1.height := form1.height * x DIV ScreenHeight;form1.width := form1.width * y DIV ScreenWidth;scaleBy(x, ScreenHeight);end;end; |
procedure TForm1.Table1CalcFields(DataSet: TDataset);vart1, t2: tDateTime;begintable1d1.asDateTime := Date + 2; {или table1d1.value := date + 2;}table1d2.asDateTime := Date - 2;t1 := table1d1.asDateTime;t2 := table1d2.asDateTime;table1d3.asInteger := trunc(double(t1) - double(t2));end; |
ExpXY := Exp(Y * Ln(X)) |
PROCEDURE WMQueryOpen(VAR Msg : TWMQueryOpen); message WM_QUERYOPEN; |
PROCEDURE TForm1.WMQueryOpen(VAR Msg : TWMQueryOpen);beginMsg.Result := 0;end; |
with TMyForm.create(self) do show; |
procedure TForm1.Button1Click(Sender: TObject); beginwith tBox.create(self) do show;{Необходимо ComponentCount-1 поскольку отсчет идет с нуля}(form1.Components[form1.ComponentCount-1] as tForm).caption :='About Box # ' + intToStr(form1.ComponentCount-2);end; |
procedure TForm1.PopupItem1Click(Sender: TObject);beginLabel1.Caption := PopupMenu1.PopupComponent.ClassName;end; |
program Project1; usesForms, messages, wintypes, winprocs,Unit1 in 'UNIT1.PAS' {Form1}; {$R *.RES} varOldWndProc: TFarProc; function NewWndProc(hWndAppl: HWnd; Msg, wParam: Word;lParam: Longint): Longint; export;beginresult := 0; { Значение, возвращаемое WndProc по умолчанию }{*** Здесь дескриптор сообщения; Номер сообщения в Msg ***}result := CallWindowProc(OldWndProc, hWndAppl, Msg, wParam, lParam);end; beginApplication.CreateForm(TForm1, Form1);OldWndProc := TFarProc(GetWindowLong(Application.Handle,GWL_WNDPROC));SetWindowLong(Application.Handle, GWL_WNDPROC,longint(@NewWndProc));Application.Run;end. |
case (sender as tButton).tag of0: blah;1: blah_blah;end; |
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;Shift: TShiftState);constPageDelta = 10;beginWith VertScrollbar doif Key = vk_Next then Position := Position+PageDeltaelse if Key = vk_Prior then Position := Position-PageDelta;end; |
procedure TForm1.Button1Click(Sender: TObject);vart: TTable;begint := TTable.create(self);with t dobeginDatabaseName := 'MyAlias'; {персональный псевдоним}TableName := 'MyTbl.db';open;edit;insert;fieldByName('TheField').assign(memo1.lines); {Вот оно!}post; {требуется!!!}close;end; { Конец with-блока. }end; |
procedure TForm1.Button1Click(Sender: TObject);vart1, t2: tTable; {t1 = PW таблица; t2 = ASCII версия}begint1 := tTable.create(self);with t1 dobeginDataBaseName := 'pw'; { Персональный псевдоним для каталога Paradox }tableName := 'customer.db'; { Исходная таблица }open;end;t2 := tTable.create(self);with t2 dobeginDataBaseName := 'pw'; { Персональный псевдоним для каталога Paradox }tableName := 'asdf.txt';TableType := ttASCII; createTable;open;edit;BatchMove(t1, batCopy);close;end;t1.close;end; |
function FormatNumber(l: longint): string;varlen, count: integer;s: string;beginstr(l, s);len := length(s);for count := ((len - 1) div 3) downto 1 dobegininsert(',', s, len - (count * 3) + 1);len := len + 1;end;FormatNumber := s;end; |
function FormatNumber(l: longint): string; beginFormatNumber := FormatFloat('#,##0', StrToFloat(IntToStr(l)));end; |
function GetHiByte(w: word): byte; assembler;asmmov ax, wshr ax, 8end; function GetLoByte(w: word): byte; assembler;asmmov ax, wend; function SetHiByte(b: byte; w: word): word; assembler;asmxor ax, axmov ax, wmov ah, bend; function SetLoByte(b: byte; w: word): word; assembler;asmxor ax, axmov ax, wmov al, bend; |
TypeTWord2Byte = recordLo,Hi: Byte;end; var W: Word;B: Byte;beginW := $1234;B := TWord2Byte(W).Hi;writeln(TWord2Byte(W).Hi);{ возвращаем }TWord2Byte(W).Lo := $67;TWord2Byte(W).Hi := $98; { shl не нужен! }end. |
Procedure TurnOn; External;Procedure TurnOff; External; |
Function TurnOn: Integer; External;Function TurnOff: Integer; External; |
{$L filename.obj} |
procedure WMPaint(var Message: TWMPaint); message WM_PAINT; |
procedure TWhateverComponent.WMPaint(var Message: TWMPaint);begin{Теперь заставьте ваш компонент реагировать на событие должным образом}end; |
varf: tForm; beginf := tForm.create(self);f.WindowState := wsMaximized;f.color := black;f.borderStyle := bsNone;f.show;end; |
function GetTextWidth(CanvasOWner: TForm; Text : String;TextFont : TFont): Integer;varOldFont : TFont;beginOldFont := TFont.Create;tryOldFont.Assign( CanvasOWner.Font );CanvasOWner.Font.Assign( TextFont );Result := CanvasOWner.Canvas.TextWidth(Text);CanvasOWner.Font.Assign( OldFont );finallyOldFont.Free;end;end; |
program Project1; uses Forms, Unit1 in 'UNIT1.PAS' {Form1}, Splash; {$R *.RES}varSplashScreen : TSplashScreen; {в модуле Splash} beginApplication.CreateForm(TForm1, Form1);SplashScreen := TSplashScreen.Create(Application);trySplashScreen.Show;{осуществите остальные CreatForms или другиедействия прежде чем приложение запустится}SplashScreen.Close;finally {Убедитесь что окно с логотипом освобождается}SplashScreen.Free;end;Application.Run;end. |
procedure TForm1.Button1Click(Sender: TObject); typeTCallMeDll = function(a,b: Integer): string; varCallMeDll: TCallMeDll;FuncPtr: TFarProc;hDll: THandle;result: string; beginhDll:=LoadLibrary('Mytestdll.dll');FuncPtr:=GetProcAddress(hDLL,'CallMe');@CallMeDll:=FuncPtr;if @CallMeDll <> nil thenresult:=CallMeDll(4,5);FuncPtr:=nil;FreeLibrary(hDll);end; |
{ В интерфейсе программы } typeTCallBackFunction = function(s: string): integer;CallMe(s: string): integer; |
{ Программная реализация } procedure TestCallBack(CallBackFunction: TCallBackFunction); far; external 'Other';{ Имейте в виду, что 'other' - размещенная в Dll процедура с именем TestCallBack } function CallMe(s: PChar): integer;begin{ сделайте что-нибудь }CallMe := 1; { сделайте что-нибудь }end; procedure TForm1.Button1Click(Sender: TObject);beginTestCallBack(CallMe);end; |
{ в интерфейсе библиотеки Other } typeTMainFunction = function(s: string): integer;TestCallBack(MainFunc: TMainFunction); { в реализации библиотеки Other } TestCallBack(MainFunc: TMainFunction);varresult: integer;beginresult:=MainFunc('тест');end; |