I used to use Delphi 7 on my PC, but now that I bought a MacBook (Mid 2012 - OSX Mountain Lion), I wanted to continue programming in Pascal and have a similar Interface. Lazarus seems to deliver most of the things I wanted, but it seems to run into a lot of errors, when compiling even the simplest applications! To test it, I made a simple "Russian Roulette" application, just for fun, but the program just freezes, when launched or even when compiled inside Lazarus.
When launching it from command line, It shows me the following error:
TCarbonButton.SetFocus Error: SetKeyboardFocus failed with result -30585
I don't think my coding is the problem, but I guess I should include it:
unit RussianRouletteUnit;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
Buttons, ExtCtrls;
type
{ TForm1 }
TForm1 = class(TForm)
Button1: TButton;
Kugeln: TLabeledEdit;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
var
Form1: TForm1;
Number: Integer;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.Button1Click(Sender: TObject);
begin
if Random(StrToInt(Kugeln.Text))+1 = 1 then
begin
Button1.SetFocus;
Memo1.Color := clred;
Memo1.Text := 'BOOM';
Memo1.Lines.Add('HEADSHOT');
end;
end;
initialization
randomize;
end.
I hope you guys can help me out, any help is apprechiated :D
Related
I have trouble displaying RTF-Formatted text between two delphi-Versions.
The TDBRichEdit-Control and TRichEdit-Control seem to have trouble parsing the RTF-text supplied.
Sometimes it seems as if to get it to work in XE8 you simply have to connect a TDBRichEdit to the appropriate Field in the Dataset, but the same Method would mess up the Delphi 7 Version.
So we figured we handle this via Code.
Basically we replaced the TDBRichEdits with normal TRichEdits and
supply the RTF through a stream.
textstream:=TStringStream.Create(CDS.FieldByName('TEXT').AsString);
try
RichEditFAPLAN.Lines.Clear();
RichEditFAPLAN.Lines.LoadFromStream(textStream);
finally
textstream.Free();
end;
this worked fine until about 1h ago when I decided to move the code above into it's own globally available function.
procedure StreamRichTextTo(ARichEdit:TCustomRichEdit; ADataSet:TDataSet; AFieldName:String);
var
ws:WideString;
Stream:TStringStream;
begin
ARichEdit.Lines.Clear();
if (ADataSet=nil) or (ADataSet.FindField(AFieldName)=nil) or (ADataSet.FieldByName(AFieldName).IsNull) then exit;
ws:=UTF8Decode(ADataSet.FieldByName(AFieldName).AsString);
Stream:=TStringStream.Create(ws);
try
Stream.Position:=0;
ARichEdit.Lines.LoadFromStream(Stream);
finally
Stream.Free();
end;
end;
I tried different Variations of this code. With MemoryStream, Widestring, UTF8 Encoding, AnsiString and what not.
procedure StreamRichTextTo(ARichEdit:TCustomRichEdit; ADataSet:TDataSet; AFieldName:String);
var
{$IFDEF VER150}
ws:WideString;
Stream:TStringStream;
{$ELSE}
s:AnsiString;
//Stream:TMemoryStream;
Stream:TStringStream;
{$ENDIF}
begin
ARichEdit.Lines.Clear();
if (ADataSet=nil) or (ADataSet.FindField(AFieldName)=nil) or (ADataSet.FieldByName(AFieldName).IsNull) then exit;
{$IFDEF VER150}
ws:=UTF8Decode(ADataSet.FieldByName(AFieldName).AsString);
Stream:=TStringStream.Create(ws);
{$ELSE}
{
s:=ADataSet.FieldByName(AFieldName).AsAnsiString;
Stream:=TMemoryStream.Create();
Stream.Clear();
Stream.Write(PAnsiChar(s)^,length(s));
}
s:=ADataSet.FieldByName(AFieldName).AsAnsiString;
Stream:=TStringStream.Create(s,TEncoding.UTF8);
//Stream.WriteString(s);
Stream.Position:=0;
{$ENDIF}
try
ARichEdit.Lines.LoadFromStream(Stream);
finally
Stream.Free();
end;
end;
All to no avail, the XE-RTF-Text always comes out looking either like this or as a simple '':
{\rtf1\fbidis\ansi\ansicpg1252\deff0{\fonttbl{\f0\fnil\fcharset0 arial;}{\f1\fswiss\fprq2\fcharset0 Arial;}{\f2\fnil arial;}}
\viewkind4\uc1\pard\ltrpar\lang1031\f0\fs20 Gie\'dftemp.: \tab 1350 - 1370 \'b0C
\par \ul\f1 Form fest verklammern und belasten
\par \ulnone\f0
\par \tab\tab\f2
\par }
What's more, the original Code with the "textstream", that I commented back in, is also not working anymore.
What I'm looking for is a code-solution that can properly handle RTF-Text between different IDE-Versions.
EDIT:
Here is a sample Project-Code.
The thing is, everything works fine in this project.
I have no idea why the same code does no longer work in our software and I can not reproduce it.
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ComCtrls, Data.DB,
Datasnap.DBClient;
type
TForm1 = class(TForm)
REGoal: TRichEdit;
Button1: TButton;
CDS: TClientDataSet;
RESource: TRichEdit;
procedure Button1Click(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure StreamRichTextTo(ARichEdit:TRichEdit; ADataSet:TDataSet; AFieldName:String);
var
Stream:TStringStream;
//{$IFDEF VER150}
ws:WideString;
//{$ELSE}
//{$ENDIF}
begin
ARichEdit.Lines.Clear();
if (ADataSet=nil) or (ADataSet.FindField(AFieldName)=nil) or (ADataSet.FieldByName(AFieldName).IsNull) then exit;
try
//{$IFDEF VER150}
ws:=UTF8Decode(ADataSet.FieldByName(AFieldName).AsString);
Stream:=TStringStream.Create(ws);
//{$ELSE}
// Stream:=TStringStream.Create(ADataSet.FieldByName(AFieldName).AsString);
//{$ENDIF}
ARichEdit.Lines.LoadFromStream(Stream);
finally
Stream.Free();
end;
end;
(* Copy this to RESource
{\rtf1\ansi\ansicpg1252\deff0{\fonttbl{\f0\fnil\fcharset0 arial;}{\f1\fnil arial;}}
\viewkind4\uc1\pard\lang1031\f0\fs20 Erste Form ist eine Zulegekontrolle durchzuf\fchren.
\par
\par
\par \f1
\par }
*)
procedure TForm1.Button1Click(Sender: TObject);
var
Stream:TStringStream;
begin
if CDS.FindField('TEXT')=nil then
begin
CDS.FieldDefs.Add('TEXT',ftWideString,4096);
CDS.CreateDataSet();
end;
CDS.Edit();
CDS.FieldByName('TEXT').AsString:=RESource.text;
CDS.Post();
StreamRichTextTo(REGoal,CDS,'TEXT');
end;
Just Create a new Form1
Add 2 TRichEdits, one is called RESource and the other REGoal
Add a TClientDataSet and call it CDS
Add A Button
Assign the OnClick-procedure to the button
I'll try creating the project in D7 and port it to XE8 next, maybe this will reproduce the effect.
EDIT 2:
Creating the Project in Delphi 7 and then Opening it in XE8 produces the same result.
My guess is, that there is something happening when the Database-Value is assigned to a String-Variable (or passed directly into the stream) which would be why I'm unable to reproduce the error.
Also maybe the Database is at fault.
it's a Firebird 3.0 Database with a VarChar-Field
This IS the working Version of the code.
Apparently there was something wrong with the RTF-Code itself due to a bug in our Editor
procedure StreamRichTextTo(ARichEdit:TRichEdit; ADataSet:TDataSet; AFieldName:String);
var
{$IFDEF VER150}
ws:WideString;
{$ELSE}
ws:String;
{$ENDIF}
Stream:TStringStream;
begin
ARichEdit.Lines.Clear();
if (ADataSet=nil) or (ADataSet.FindField(AFieldName)=nil) or (ADataSet.FieldByName(AFieldName).IsNull) then exit;
{$IFDEF VER150}
ws:=UTF8Decode(ADataSet.FieldByName(AFieldName).AsString);
{$ELSE}
ws:=ADataSet.FieldByName(AFieldName).AsString;
{$ENDIF}
Stream:=TStringStream.Create(ws);
try
ARichEdit.Lines.LoadFromStream(Stream);
finally
Stream.Free();
end;
end;
I made the following code but something does not work.
unit Unit9;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, DB, ADODB, Grids, DBGrids, ExtCtrls;
type
TForm9 = class(TForm)
edt1: TEdit;
procedure FormCreate(Sender: TObject);
end;
var
Form9: TForm9;
const
EM_SETCUEBANNER = $1501;
implementation
uses
Unit2;
{$R *.dfm}
procedure TForm9.FormCreate(Sender: TObject);
var
Banner: String;
buf: array [0..$ff] of Char;
begin
Banner := UTF8Encode('Введите логин');
Utf8ToUnicode(PWideChar(#buf), PAnsiChar(Banner), Length(Banner));
SendMessage(edt1.Handle, EM_SETCUEBANNER, 0, Integer(#buf));
end;
end.
For example, as on some websites, an edit control displays "Login" until something is written.
I have a simple Application that reads data from an .ini file into a record, and then does a ShellExecute. However, when I run it in debug mode,it tells me that the True free heap isn't what it should be:
"True heap size: 688128, True free heap: 688016, Should be: 688128"
This only happens if I actually run the ShellExecute (however even if I don't run the ShellExecute, I get a True free heap of 688016, but no complaint that it should be 688128), so I wonder if I either need to free the PChar() conversion (which shouldn't be the case from all that I've read), or the handle returned by ShellExecute (though CloseHandle(ShellHandle); doesn't change the message), or if it's intended behavior?
The IniSettings.SetupCommand in question is an .msi file that triggers a UAC prompt, but I really just want to make this a Fire & Forget thing since my Lazarus app doesn't care what it launches.
For reference, here's my whole Unit. I'm using Lazarus 1.6.2, FPC 3.0.0, i386-win32, and I'm targeting Windows only with this. My Debug Settings are at the very bottom, after the code.
unit MainUnit;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls,
Graphics, Dialogs, StdCtrls, IniFiles, Windows;
type
{ IniSettings }
TAutorunIniSettings = record
AutorunTitle: AnsiString;
SetupCommand: AnsiString;
end;
{ TMainForm }
TMainForm = class(TForm)
btnSetup: TButton;
lblTitle: TLabel;
procedure btnSetupClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ private declarations }
IniSettings: TAutorunIniSettings;
public
{ public declarations }
end;
var
MainForm: TMainForm;
implementation
{$R *.lfm}
{ TMainForm }
procedure TMainForm.FormCreate(Sender: TObject);
var
AutorunIni: TIniFile;
begin
try
AutorunIni := TIniFile.Create('Autorun.ini');
IniSettings.AutorunTitle := AutorunIni.ReadString('Autorun', 'Title', 'Autorun');
IniSettings.SetupCommand := AutorunIni.ReadString('Autorun', 'Setup', '');
self.Caption := IniSettings.AutorunTitle;
finally
if(AutorunIni <> nil) then AutorunIni.Free;
end;
end;
procedure TMainForm.FormDestroy(Sender: TObject);
begin
end;
procedure TMainForm.btnSetupClick(Sender: TObject);
begin
ShellExecute(0, 'open', PChar(IniSettings.SetupCommand), nil, nil, SW_SHOWNORMAL);
end;
end.
I'm having trouble getting to grips with DLLs in Delphi 7. I have two problems:
1) The procedure takes an integer parameter - but the dll receives a different value to the one I pass.
2) The application that called the dll crashes with an access violation after the function completes.
Here's my dll code:
library apmDLL;
uses
Classes, Messages, Windows, Dialogs, sysutils ;
const
WM_MY_MESSAGE = WM_USER + 1;
procedure sendtoACRPM (functionKey : integer); stdcall;
begin
showmessage('You sent - '+inttostr(functionKey));
showmessage('Finished Now');
end;
exports sendtoACRPM;
end.
So when I call this with the code below I get:
'Sending - 1'
'You Sent - 1636532'
'Finished Now'
Then the calling application crashes with an access violation.
The calling application looks like this:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, shlobj, shellapi;
const
WM_MY_MESSAGE = WM_USER + 1;
type
TForm1 = class(TForm)
Edit1: TEdit;
Button2: TButton;
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
procedure sendtoACRPM (functionKey : integer) ; external 'apmDLL.dll';
implementation
{$R *.dfm}
procedure TForm1.Button2Click(Sender: TObject);
var
myInt: integer;
begin
myInt := strtoint(edit1.text);
showmessage('Sending - ' + inttostr(myInt));
sendtoACRPM(myInt);
end;
end.
Any ideas what I'm doing wrong here?
You need stdcall both in the DLL and in the calling code declaration. You only have it in the DLL.
Calling conventions need to match on both sides. :-)
procedure sendtoACRPM (functionKey : integer); stdcall; external 'apmDLL.dll';
You should use the standard Windows MessageBox instead of ShowMessage, so that the DLL can be used from non-Delphi applications as well.
I'm trying to respond to some windows and application messages, but I get them multiple times.
For example, I write the following code to show a message box when the date of system is changed using WM_TIMECHANGE. WMTimeChange is executed more than once, and I see multiples (most times two or three) messageboxes one behind another. Maybe, I am missing something?
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs;
type
TForm1 = class(TForm)
protected
procedure WMTimeChange(var Msg: TMessage) ; message WM_TIMECHANGE;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{ TForm1 }
procedure TForm1.WMTimeChange(var Msg: TMessage);
begin
showmessage('Date/Time has changed!');
end;
end.
Testing in Windows XP.
EDIT: Just to clarify, my intention is understand WHY that happen and not how to get around the multiple calls. Anyway, if an answer to that is not possible, I will probably accept one answer to the later.
EDIT2: Removed Delphi Tag as it seems not a Delphi issue.
Your code is correct. It sounds like that Windows is sending the WM_TIMECHANGE message several times.
So you can just add a small time-hysteresis comparison to let your message be triggered only once per a 1% of day, i.e. more or less 15 minutes:
type
TForm1 = class(TForm)
protected
FWMTimeChangeTimeStamp: TDateTime;
procedure WMTimeChange(var Msg: TMessage) ; message WM_TIMECHANGE;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{ TForm1 }
procedure TForm1.WMTimeChange(var Msg: TMessage);
begin
if Now-FWMTimeChangeTimeStamp>0.01 then
begin
showmessage('Date/Time has changed!');
FWMTimeChangeTimeStamp := Now;
end;
end;
This is kind of what I've used in my case to be resilient to this behavior. But as said in comments, will only work if the user take time to answer the application. So, Arnaud Bounchez is a better approach to general use. Only don't forget to initialize the FWMTimeChangeStamp to something that is different from current computer clock.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs;
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
protected
procedure WMTimeChange(var Msg: TMessage) ; message WM_TIMECHANGE;
private
isTimeChangeEventShowing: Boolean;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
isTimeChangeEventShowing := false
end;
procedure TForm1.WMTimeChange(var Msg: TMessage);
begin
if not isTimeChangeEventShowing then
begin
isTimeChangeEventShowing := true;
showmessage('Date/Time has changed!');
isTimeChangeEventShowing := false;
end;
end;
end.