I have no idea how to fix it
procedure TForm1.Button1Click(Sender: TObject);
var conf, adult: Integer;
pr:real;
begin
adult:=StrToInt(Edit2.text);
conf:=StrToInt(Edit3.text);
pr:=StrToFloat(Edit4.text);
If Peak1.Checked then
pr:=(adult*8.95)+(conf*6.45)
else
pr:=(adult*7.45)+(conf*5.95);
Edit4.text:='£'+(FloatToStr(pr));
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
edit2.clear;
edit3.clear;
edit4.clear;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
close
end;
I tried to change from StrToInt to FloatToString, I have no idea how to fix it
The error "" is an invalid integer means you are trying to convert an empty string to a number which is impossible and hence the exception.
If you are not sure that the strings actually contain correctly written integers/floats, then use the TryStrToInt and TryStrToFloat functions. These functions do not throw exceptions and instead return a boolean value indicating whether the conversion succeeded — use the results to detect problems with user input.
Related
I'm getting an EOutOfResources exception 'Cannot remove shell notification icon' when trying to implement code to restore the tray icon after an Explorer crash/restart. My code is based on the old solution found here. The exception occurs when trying to hide the trayicon. Why does the Delphi XE code below not work?
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ImgList, ExtCtrls;
type
TForm1 = class(TForm)
TrayIcon1: TTrayIcon;
ImageListTray: TImageList;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
protected
procedure WndProc(var Message: TMessage); Override;
public
{ Public declarations }
end;
var
Form1: TForm1;
msgTaskbarRestart : Cardinal; {custom systemwide message}
implementation
{$R *.dfm}
//ensure systray icon recreated on explorer crash
procedure TForm1.FormCreate(Sender: TObject);
begin
msgTaskbarRestart := RegisterWindowMessage('TaskbarCreated');
end;
procedure TForm1.WndProc(var Message: TMessage);
begin
if (msgTaskbarRestart <> 0) and (Message.Msg = msgTaskbarRestart) then begin
TrayIcon1.Visible := False; {Destroy the systray icon here}//EOutOfResources exception here
TrayIcon1.Visible := True; {Replace the systray icon}
Message.Result := 1;
end;
inherited WndProc(Message);
end;
end.
The TTrayIcon.Visible property setter raises EOutOfResources when a NIM_DELETE request fails:
procedure TCustomTrayIcon.SetVisible(Value: Boolean);
begin
if FVisible <> Value then
begin
FVisible := Value;
...
if not (csDesigning in ComponentState) then
begin
if FVisible then
...
else if not (csLoading in ComponentState) then
begin
if not Refresh(NIM_DELETE) then
raise EOutOfResources.Create(STrayIconRemoveError); // <-- HERE
end;
...
end;
end;
end;
Where Refresh() is just a call to the Win32 Shell_NotifyIcon() function:
function TCustomTrayIcon.Refresh(Message: Integer): Boolean;
...
begin
Result := Shell_NotifyIcon(Message, FData);
...
end;
When you receive the TaskbarCreated message, your previous icons are no longer present in the Taskbar, so Shell_NotifyIcon(NIM_DELETE) returns False. When the Taskbar is (re-)created, you are not supposed to try to remove old icons at all, only re-add new icons with Shell_NotifyIcon(NIM_ADD) as needed.
TTrayIcon has a public Refresh() method, but that uses NIM_MODIFY instead of NIM_ADD, so that will not work in this situation, either:
procedure TCustomTrayIcon.Refresh;
begin
if not (csDesigning in ComponentState) then
begin
...
if Visible then
Refresh(NIM_MODIFY);
end;
end;
However, you don't actually need to handle the TaskbarCreated message manually when using TTrayIcon, because it already handles that message internally for you, and it will call Shell_NotifyIcon(NIM_ADD) if Visible=True:
procedure TCustomTrayIcon.WindowProc(var Message: TMessage);
...
begin
case Message.Msg of
...
else
if (Cardinal(Message.Msg) = RM_TaskBarCreated) and Visible then
Refresh(NIM_ADD); // <-- HERE
end;
end;
...
initialization
...
TCustomTrayIcon.RM_TaskBarCreated := RegisterWindowMessage('TaskbarCreated');
end.
If, for some reason, that is not working correctly, and/or you need to handle TaskbarCreated manually, then I would suggest calling the protected TCustomTrayIcon.Refresh() method directly, eg:
type
TTrayIconAccess = class(TTrayIcon)
end;
procedure TForm1.WndProc(var Message: TMessage);
begin
if (msgTaskbarRestart <> 0) and (Message.Msg = msgTaskbarRestart) then begin
if TrayIcon1.Visible then begin
// TrayIcon1.Refresh;
TTrayIconAccess(TrayIcon1).Refresh(NIM_ADD);
end;
Message.Result := 1;
end;
inherited WndProc(Message);
end;
Otherwise, simply don't use TTrayIcon at all. It is known to be buggy. I have seen a lot of people have a lot of problems with TTrayIcon over the years. I would suggest using Shell_NotifyIcon() directly instead. I have never had any problems using it myself.
I want square ,but i dont remember how to do it becauseI multiplying is a variable, but throw exeption and i don't know why.
please help i don't know what else to do
program Project1;
uses crt;
type TSquare=class
len:integer;
place:integer;
function Perimetr:integer;
function Area:integer;
function Verify():boolean;
procedure Show(P,S:real);
constructor Create(P,l:integer);
end;
function TSquare.Perimetr:integer;
var P:integer;
begin
P:=len*4;
end;
function TSquare.Area:integer;
var S:integer;
begin
S:=len*len;
end;
function TSquare.Verify:boolean;
begin
end;
procedure TSquare.Show(P,S:real);
begin
write('Площидь=',S,'Перимитр=',P);
end;
constructor TSquare.Create(p,l:integer);
begin
len:=l;
place:=p;
end;
var r: TSquare;
a,b:integer;
begin
r.Create(1,5);
r.Show(r.Perimetr(),r.Area());
end.
SIGSEGV means access of invalid memory. Here you do not create the TSquare object correctly.
r := TSquare.Create(1,5); is the correct way to create an instance of an object.
I had a unit for a Windows (32 bit) service that was built up like this:
unit uSvcBase;
interface
type
TMyServiceBase = class(TService)
procedure ServiceBeforeUninstall(Sender: TService);
procedure ServiceCreate(Sender: TObject);
procedure ServiceStop(Sender: TService; var Stopped: Boolean);
procedure ServiceExecute(Sender: TService);
procedure ServiceStart(Sender: TService; var Started: Boolean);
procedure ServiceAfterInstall(Sender: TService);
private
public
function GetServiceController: TServiceController; override;
end;
var
MyServiceBase: TMyServiceBase;
implementation
{$R *.DFM}
{$R SvcEventLogMessages.res}
procedure ServiceController(CtrlCode: DWord); stdcall;
begin
MyServiceBase.Controller(CtrlCode);
end;
function TMyServiceBase.GetServiceController: TServiceController;
begin
Result := ServiceController;
end;
const
rsServiceMessages =
'SYSTEM\CurrentControlSet\Services\EventLog\Application';
procedure TMyServiceBase.ServiceAfterInstall(Sender: TService);
var
lReg : TRegistry;
lAppName: String;
begin
lReg := TRegistry.create;
try
with lReg do
begin
Rootkey := HKEY_LOCAL_MACHINE;
if OpenKey(rsServiceMessages, False) then
begin
if OpenKey(MyServiceBase.Name, True) then
begin
lAppName := ParamStr(0);
WriteString('EventMessageFile', lAppName);
WriteString('CategoryMessageFile', lAppName);
WriteInteger('CategoryCount', 2);
WriteInteger('TypesSupported', EVENTLOG_ERROR_TYPE OR EVENTLOG_WARNING_TYPE OR EVENTLOG_INFORMATION_TYPE);
CloseKey;
end;
CloseKey;
end; { if OpenKey }
end; { with lReg }
finally
lReg.Free;
end;
end;
Because I needed to make a second service which was largely identical, I decided to make this a 'base' unit that others derive from (you can already see that in the names above):
unit uSvcTasks;
interface
uses
System.SysUtils, System.Classes, uSvcBase;
type
TMyServiceScheduler = class(TMyServiceBase)
procedure ServiceCreate(Sender: TObject);
private
public
end;
var
MyServiceScheduler: TMyServiceScheduler;
implementation
{%CLASSGROUP 'System.Classes.TPersistent'}
{$R *.dfm}
Uses uTypesAlgemeen;
procedure TMyServiceScheduler.ServiceCreate(Sender: TObject);
begin
inherited;
// Set some properties
end;
At design time, the MyServiceScheduler.Name in this descendant differs from the MyServiceBase.Name.
Issue: The AfterInstall now crashed. Trying to use the original code using OpenKey(MyServiceBase.Name was not allowed.
I worked around his by using a property for the name (setting it in the descendant Create), but I do not understand why referencing MyServiceBase.Name in the AfterInstall does not work. Can anyone explain?
Thanks to Uwe Raabe's comments I was able to figure out how to fix this:
The project had an Application.CreateForm(TMyServiceScheduler, MyServiceScheduler) in the project source which initializes MyServiceScheduler, but there was nothing initializing MyServiceBase, so refering to it was illegal.
Replace the reference to MyServiceBase.Name with Name in the AfterInstall(That should've been done anyway).
Move the code for the ServiceController from uSvcBase to uSvcTasks
I would like to accept files as soon as someone drops a file to a specific control (e.g. TMemo). I started with this example: http://delphi.about.com/od/windowsshellapi/a/accept-filedrop.htm and modified it like this:
procedure TForm1.FormCreate(Sender: TObject);
begin
DragAcceptFiles( Memo1.Handle, True ) ;
end;
This allows the control to show the dragging icon but the proper WM_DROPFILES message is not getting called because DragAcceptFiles needs a (Parent?)windowhandle. I could determine the MemoHandle in the WMDROPFILES procedure but I don't how, plus the dragging cursor applies for all the controls now. How do I allow dragging for a specific control (and block other controls from dragging)?
You should indeed pass the window handle of the memo control, but then you also need to listen to the WM_DROPFILES message sent to it:
unit Unit5;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ShellAPI;
type
TMemo = class(StdCtrls.TMemo)
protected
procedure WMDropFiles(var Message: TWMDropFiles); message WM_DROPFILES;
procedure CreateWnd; override;
procedure DestroyWnd; override;
end;
TForm5 = class(TForm)
Memo1: TMemo;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form5: TForm5;
implementation
{$R *.dfm}
procedure TForm5.FormCreate(Sender: TObject);
begin
end;
{ TMemo }
procedure TMemo.CreateWnd;
begin
inherited;
DragAcceptFiles(Handle, true);
end;
procedure TMemo.DestroyWnd;
begin
DragAcceptFiles(Handle, false);
inherited;
end;
procedure TMemo.WMDropFiles(var Message: TWMDropFiles);
var
c: integer;
fn: array[0..MAX_PATH-1] of char;
begin
c := DragQueryFile(Message.Drop, $FFFFFFFF, fn, MAX_PATH);
if c <> 1 then
begin
MessageBox(Handle, 'Too many files.', 'Drag and drop error', MB_ICONERROR);
Exit;
end;
if DragQueryFile(Message.Drop, 0, fn, MAX_PATH) = 0 then Exit;
Text := fn;
end;
end.
The example above only accept a single file dropped. The file name will be put in the memo control. But you can also allow a multiple selection to be dropped:
var
c: integer;
fn: array[0..MAX_PATH-1] of char;
i: Integer;
begin
c := DragQueryFile(Message.Drop, $FFFFFFFF, fn, MAX_PATH);
Clear;
for i := 0 to c - 1 do
begin
if DragQueryFile(Message.Drop, i, fn, MAX_PATH) = 0 then Exit;
Lines.Add(fn);
end;
After many Google and SO searches, I cannot find a definitive answer to this simple question:
How can I define a procedure inside of another procedure to use?
I know that there are nested blocks and nested procedures, but I haven't seen the exact syntax for what I want. i.e.
create or replace
PROCEDURE TOP_PROCEDURE
(...)
IS
-- nested procedure here?
BEGIN
NULL;
END;
create or replace
PROCEDURE TOP_PROCEDURE
(...)
IS
variable NUMBER;
PROCEDURE nested_procedure (...)
IS
BEGIN
NULL;
END;
PROCEDURE another_nested_procedure (...)
IS
BEGIN
NULL;
END;
BEGIN
NULL;
END;
Local procedures must be declared after anything else (e.g. variables).