Sorry for my English, as I am from Germany.
I built a program: http://i.epvpimg.com/I0xie.png
And I want an exponent calculator (I am learning for test in school), but I have a problem...
If I do the number "Zahl" (meaning "number" in German). For example: Number= "2", then I do exponent = "1".
Normally I should get the result 2 but I am getting a 4, why?
What is the problem?
Here is my Code:
unit unit_oberflaeche;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
ExtCtrls, unit_inhalt;
type
{ TForm1 }
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
Edit2: TEdit;
Label1: TLabel;
Label2: TLabel;
Panel1: TPanel;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
var
Form1: TForm1;
rechner: Texponentrechner;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
rechner := Texponentrechner.Create;
end;
procedure TForm1.Button1Click(Sender: TObject);
VAR i, LVexponent, LVzahl, result: INTEGER;
BEGIN
LVexponent := StrToInt(Edit2.Text);
LVzahl := StrToInt(Edit1.Text);
rechner.set_exponent(LVexponent);
rechner.set_zahl(LVzahl);
FOR i := 1 TO LVexponent DO
BEGIN
result := result * LVzahl
end;
//result := LVzahl;
Panel1.Caption := IntToStr(result);
end;
end.
And here is the other part:
unit unit_inhalt;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils;
TYPE
Texponentrechner = class
private
{ private declarations }
Fexponent : INTEGER;
Fzahl : INTEGER;
public
{ public declarations }
procedure set_exponent (WPexponent:INTEGER);
procedure set_zahl (WPzahl:INTEGER);
function berechne_betrag():INTEGER;
end;
implementation
procedure Texponentrechner.set_exponent(WPexponent:INTEGER);
BEGIN
Fexponent := WPexponent;
end;
procedure Texponentrechner.set_zahl(WPzahl:INTEGER);
BEGIN
Fzahl := WPzahl;
end;
function Texponentrechner.berechne_betrag():INTEGER;
BEGIN
result := Fzahl * Fzahl;
end;
end.
I assume that your exponent calculation has to be done in Texponentrechner class. First, your calculation there is wrong because it returns your number multiplied by itself, and second you are never calling that function in the first place.
So your berechne_betrag function should look like this:
function Texponentrechner.berechne_betrag(): integer;
var i: integer;
begin
Result := 1;
for i := 1 to Fexponent do
Result := Result * Fzahl;
end;
Then you should actually call that function to get the result
rechner.set_exponent(LVexponent);
rechner.set_zahl(LVzahl);
result := rechner.berechne_betrag;
Panel1.Caption := IntToStr(result);
Also you are creating rechner object instance in FormCreate, but you are never releasing it and thus you are creating memory leak. You should call rechner.Free when you are finished using object. Since you have made it global var you create in FormCreate, proper place to release it will be in FormDestroy
But even better practice would be to make it local to Button1Click method.
...
type
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
Edit2: TEdit;
Label1: TLabel;
Label2: TLabel;
Panel1: TPanel;
procedure Button1Click(Sender: TObject);
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.Button1Click(Sender: TObject);
var
LVexponent, LVzahl, result: integer;
rechner: Texponentrechner;
begin
rechner := Texponentrechner.Create;
try
LVexponent := StrToInt(Edit2.Text);
LVzahl := StrToInt(Edit1.Text);
rechner.set_exponent(LVexponent);
rechner.set_zahl(LVzahl);
result := rechner.berechne_betrag;
Panel1.Caption := IntToStr(result);
finally
rechner.Free;
end;
end;
end.
Related
As an example, given the code extract below, I would like to define a breakpoint that triggers whenever the object field value changes and optionally, breaks on a condition (False or True in this case).
type
TForm1 = class(TForm)
EnableButton: TButton;
DisableButton: TButton;
procedure EnableButtonClick(Sender: TObject);
procedure DisableButtonClick(Sender: TObject);
private
FValue: Boolean; // <== Would like to define a breakpoint here whenever FValue changes.
public
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.DisableButtonClick(Sender: TObject);
begin
FValue := False;
end;
procedure TForm1.EnableButtonClick(Sender: TObject);
begin
FValue := True;
end;
Run the application under the debugger,
select 'Run' from the IDE menu then select 'Add Breakpoint' at the very bottom, then 'Data Breakpoint...'.
enter 'Form1.FValue' as input to the 'Adress:' field. You can also set your condition in the same dialog.
Some additional information thanks to Sertac answer and comment from David.
One can define a breakpoint based on changes in an array item with a condition.
In this case the data breakpoint is defined as follow:
Form1.FBooleans[0] = True
Code extract:
type
TBooleanArray = array of Boolean;
TForm1 = class(TForm)
EnableButton: TButton;
DisableButton: TButton;
procedure EnableButtonClick(Sender: TObject);
procedure DisableButtonClick(Sender: TObject);
private
FBooleans: TBooleanArray; // Breakpoint defined here with the condition
public
constructor Create(AOwner: TComponent); override;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
constructor TForm1.Create(AOwner: TComponent);
var
AIndex: Integer;
begin
inherited;
SetLength(FBooleans, 3);
for AIndex := 0 to Length(FBooleans) - 1 do
begin
FBooleans[AIndex] := (AIndex mod 2) = 1;
end;
end;
procedure TForm1.DisableButtonClick(Sender: TObject);
begin
FBooleans[0] := False;
end;
procedure TForm1.EnableButtonClick(Sender: TObject);
begin
FBooleans[0] := True; // Beakpoint stops here on condition.
end;
I wrote a small testprogram to try out the FormCreate and the FormCloseQuery procedure. The FormCreate works fine, but the FormCloseQuery just doesn't want to execute. Did I overlook something? Pressing the "X" on a form-window or using the close method, both doesn't work!
procedure FormCreate(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);
(...)
procedure TForm1.FormCreate(Sender: TObject);
beginn
//gets executed without problems
end;
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
case MessageDlg('Question', mtConfirmation, [mbyes, mbno, mbcancel], 0) of
mrYes:
begin
ShowMessage('yes');
CanClose := true;
end;
mrNo:
begin
ShowMessage('no');
CanClose := true;
end;
else
begin
ShowMessage('cancel');
CanClose := true;
end;
end;
end;
Here's the full code:
The lpr-File:
program project1;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, Unit1
{ you can add units after this };
{$R *.res}
begin
RequireDerivedFormResource:=True;
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
The Unit-File:
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls;
type
{ TForm1 }
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);
private
{ private declarations }
public
{ public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
ShowMessage('FormCreate Procedure wurde gestartet');
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Close;
end;
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
case MessageDlg('Question', mtConfirmation, [mbyes, mbno, mbcancel], 0) of
mrYes:
begin
ShowMessage('yes');
CanClose := true;
end;
mrNo:
begin
ShowMessage('no');
CanClose := true;
end;
else
begin
ShowMessage('cancel');
CanClose := true;
end;
end;
end;
end.
The solution is/was to hook up the form's OnCloseQuery event of the form to this procedure. Here's a short description how to do it:
Bring up and select the form (in my case "Form1: TForm1") in the object inspector (see explanation below).
In the object inspector go to the tab "events"
Locate the "OnCloseQuery"-Event and select "FormCloseQuery" if you already declared and written the procedure as it was the case in my example. (If you haven't declared/implemented it double click in the dropdown box or click on the button next to it, the one with the three dots, an an empty "OnCloseQuery"-procedure procedure will be added automatically. The code editor will jump directly to the new procedure.)
To bring up / select the form in the object inspector, open the object inspector (F11). If you are looking at the code editor bring up the form first (F12) and click on it. This should bring it up in the object inspector. Make sure the form (the top element in the list) is selected and none of it's components (like buttons etc.).
Here's another explanation: http://www.delphigroups.info/2/b2/444056.html
I'm constructing a TObjectList which will store objects of class tButton:
...
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
procedure FormCreate(Sender: TObject);
public
function FindButton (const aButtonName: string; var aButton: tButton) : Boolean;
end;
...
var ButtonObjectList : TObjectList<TButton>;
function TForm1.FindButton (const aButtonName: string; var aButton: tButton) : Boolean;
...
var b : Integer;
begin
Result := False;
for b := Low (ButtonObjectList.Count) to High (ButtonObjectList.Count) do
if ButtonObjectList.Items [b].Name = aButtonName then begin
Result := True;
aButton := ButtonObjectList.Items [b];
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
ButtonObjectList := TObjectList<TButton>.Create(True);
ButtonObjectList.Add(Button1);
ButtonObjectList.Add(Button2);
ButtonObjectList.Add(Button3);
end;
further, in unit untRetrieveButton:
...
var Button : TButton;
procedure FindAButton;
begin
if Form1.FindButton ('Button 1', Button) then
ShowMessage ('Button found')
else
ShowMessage ('Button not found')
end;
I want to get back an arbitrary button stored in the ButtonObjectList, but at this point, I only know the button's name. From what I've learn at the TObjectList documentation, the only way to achieve this, is traversing the entire Items list, and compare the parameter aButtonName with the Button's name in the TObjectList, as in
function TForm1.FindButton (const aButtonName: string; var aButton: tButton) : Boolean;
Is this right, or there is a better and most efficient way to retrieve an arbitrary Button by it's name?
I think, if you have only limited amount of buttons it doesn't matter and the speed should be ok.
If I have such cases I often use a solution like this:
var
ButtonDict: TDictionary<String,TButton>;
FoundButton: TButton;
begin
...
ButtonDict.Add(UpperCase(Button1.Name),Button1);
ButtonDict.Add(UpperCase(Button2.Name),Button2);
ButtonDict.Add(UpperCase(Button3.Name),Button3);
...
//fast access...
if ButtonDict.TryGetValue(UpperCase(NameOfButton),FoundButton) then
begin
//... now you got the button...
end else
begin
// Button not found...
end;
...
end;
Is there ANY way to get pixel color under mouse cursor really FAST? I have a mouse hook and I try to read pixel color during mouse move. Its kind of ColorPicker
Any attempts with getPixel and BitBlt were terribly slow.
UPDATE - ADDED CODE
unit Unit1;
{$mode delphi}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls, lclintf, Windows;
type
{ TForm1 }
TForm1 = class(TForm)
pnColor: TPanel;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure ms(var message: tmessage); message WM_USER+1234;
private
{ private declarations }
public
{ public declarations }
end;
var
Form1: TForm1;
DC:HDC;
const WH_MOUSE_LL = 14; //for Lazarus
implementation
{$R *.lfm}
{ TForm1 }
procedure HookMouse(Handle:HWND); stdcall; external 'mhook.dll';
procedure UnHookMouse; stdcall; external 'mhook.dll';
procedure TForm1.FormCreate(Sender: TObject);
begin
//Self.Caption := IntToStr(Self.Height);
Self.Left:= Screen.Monitors[0].WorkareaRect.Right - Self.Width - 18;
Self.Top := Screen.Monitors[0].WorkareaRect.Bottom - Self.Height - 18 - 25; //35 LAZARUS BUG
DC := getDC(0);
HookMouse(Self.Handle);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
UnHookMouse;
end;
procedure TForm1.ms(var message: tmessage);
var color:TColor;
begin
color := GetPixel(DC, message.WParam, message.LParam); //<-- Extremly slow
//format('%d - %d',[message.LParam, message.WParam]); // Edited
pnColor.Color:=color;
end;
end.
And the DLL
library project1;
{$mode delphi}{$H+}
uses
Windows,
Messages;
var Hook: HHOOK;
hParent:HWND;
function HookProc(nCode: Integer; MsgID: WParam; Data: LParam): LResult; stdcall;
var
mousePoint: TPoint;
begin
//if nCode = HC_ACTION then
//begin
mousePoint := PMouseHookStruct(Data)^.pt;
PostMessage(hParent, WM_USER+1234, mousePoint.X, mousePoint.Y);
//end;
Result := CallNextHookEx(Hook,nCode,MsgID,Data);
end;
procedure HookMouse(Parent: Hwnd); stdcall;
begin
hParent := parent;
if Hook = 0 then Hook:=SetWindowsHookEx(WH_MOUSE_LL,#HookProc,HInstance,0);
end;
procedure UnHookMouse; stdcall;
begin
UnhookWindowsHookEx(Hook);
Hook:=0;
end;
exports
HookMouse, UnHookMouse;
begin
end.
UPDATE 2 - One unit update with 100ms interval
unit Unit1;
{$mode delphi}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls, lclintf, Windows;
type
{ TForm1 }
TForm1 = class(TForm)
pnColor: TPanel;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
var
Form1: TForm1;
HookHandle: Cardinal;
DC:HDC;
timer:Long;
const WH_HOOK_LL = 14; //for Lazarus
implementation
{$R *.lfm}
{ TForm1 }
function LowLevelMouseProc(nCode: Integer; wParam: wParam; lParam: lParam): LRESULT; stdcall;
var
point:TPoint;
begin
if (nCode >= 0) then
begin
if(GetTickCount - timer >= 100) then
begin
point:=PMouseHookStruct(lParam)^.pt;
Form1.pnColor.Color := GetPixel(DC,point.X,point.Y);
timer := GetTickCount;
end;
end;
Result := CallNextHookEx(HookHandle, nCode, wParam, lParam);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
//Self.Caption := IntToStr(Self.Height);
Self.Left:= Screen.Monitors[0].WorkareaRect.Right - Self.Width - 18;
Self.Top := Screen.Monitors[0].WorkareaRect.Bottom - Self.Height - 18 - 25; //35 LAZARUS BUG
DC := GetWindowDC(GetDesktopWindow);
if HookHandle = 0 then
begin
HookHandle := SetWindowsHookEx(WH_HOOK_LL, #LowLevelMouseProc, hInstance, 0);
end;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
if HookHandle <> 0 then
UnhookWindowsHookEx(HookHandle);
ReleaseDC(GetDesktopWindow(), DC);
end;
end.
I wouldn't personally use a hook for this. I would use e.g. a timer with interval 30ms for instance and use the following code to determine position and color of the current pixel under the mouse cursor (the code will work only on Windows platform as your original code can). I'd use this, as because if your application won't be able to process (low level idle priority though) WM_TIMER messages, I don't think it will be able to process so frequent callbacks from your hook keeping the user interface responsible (to process own main thread messages):
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
StdCtrls, Windows;
type
{ TForm1 }
TForm1 = class(TForm)
Label1: TLabel;
Panel1: TPanel;
UpdateTimer: TTimer;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure UpdateTimerTimer(Sender: TObject);
private
DesktopDC: HDC;
public
{ public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
DesktopDC := GetDC(0);
if (DesktopDC <> 0) then
UpdateTimer.Enabled := True;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
ReleaseDC(GetDesktopWindow, DesktopDC);
end;
procedure TForm1.UpdateTimerTimer(Sender: TObject);
var
CursorPos: TPoint;
begin
if GetCursorPos(CursorPos) then
begin
Label1.Caption := 'Cursor pos: [' + IntToStr(CursorPos.x) + '; ' +
IntToStr(CursorPos.y) + ']';
Panel1.Color := GetPixel(DesktopDC, CursorPos.x, CursorPos.y);
end;
end;
end.
I have a standard TStringGrid on a form.
I have one Fixed Row in the grid that contains a number of columns, which are all TGridColumns objects. I have set the column titles using the object inspector and the default orientation is horizontal. Is there any way you can make the orientation vertical (like you can in cells in Excel)?
Here's how to render the first row's text vertically in Lazarus:
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Grids,
StdCtrls;
type
TStringGrid = class(Grids.TStringGrid)
protected
procedure DrawCellText(ACol, ARow: Integer; ARect: TRect;
AState: TGridDrawState; AText: String); override;
end;
type
TForm1 = class(TForm)
Button1: TButton;
StringGrid1: TStringGrid;
procedure Button1Click(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
procedure TStringGrid.DrawCellText(ACol, ARow: Integer; ARect: TRect;
AState: TGridDrawState; AText: String);
var
TextPosition: TPoint;
begin
if ARow = 0 then
begin
Canvas.Font.Orientation := 900;
TextPosition.X := ARect.Left +
((ARect.Right - ARect.Left - Canvas.TextHeight(AText)) div 2);
TextPosition.Y := ARect.Bottom -
((ARect.Bottom - ARect.Top - Canvas.TextWidth(AText)) div 2);
Canvas.TextOut(TextPosition.X, TextPosition.Y, AText);
end
else
inherited DrawCellText(ACol, ARow, ARect, AState, AText);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
I: Integer;
GridColumn: TGridColumn;
begin
for I := 0 to 4 do
begin
GridColumn := StringGrid1.Columns.Add;
GridColumn.Width := 24;
GridColumn.Title.Font.Orientation := 900;
GridColumn.Title.Layout := tlBottom;
GridColumn.Title.Caption := 'Column no. ' + IntToStr(I);
end;
StringGrid1.RowHeights[0] := 80;
end;
end.
Here's how to render the first row's text of the TStringGrid vertically in Delphi:
I would prefer to use the overriden DrawCell procedure because it seems to me as the easiest way to go because if you want to render the text simply in the OnDrawCell event then you should consider:
if you'll have the DefaultDrawing set to True then the text will already be rendered when the OnDrawCell event is fired, so here I would recommend e.g. to store the cell captions in a separate variable, not into Cells property so then no text will be rendered and you can draw your own stored captions vertically
if you'll have the DefaultDrawing set to False then you'll have to draw the whole cell by your own, including the 3D border, what is IMHO not so cool, and I would personally prefer to let the control draw the background for us
Here is the Delphi code which uses the overriden DrawCell procedure. The text is being centered inside of the cell rectangle; please note that I haven't used the DrawTextEx for text size measurement because this function doesn't take the changed font orientation into account.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Grids;
type
TStringGrid = class(Grids.TStringGrid)
protected
procedure DrawCell(ACol, ARow: Longint; ARect: TRect;
AState: TGridDrawState); override;
end;
type
TForm1 = class(TForm)
Button1: TButton;
StringGrid1: TStringGrid;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TStringGrid.DrawCell(ACol, ARow: Longint; ARect: TRect;
AState: TGridDrawState);
var
LogFont: TLogFont;
TextPosition: TPoint;
NewFontHandle: HFONT;
OldFontHandle: HFONT;
begin
if ARow = 0 then
begin
GetObject(Canvas.Font.Handle, SizeOf(LogFont), #LogFont);
LogFont.lfEscapement := 900;
LogFont.lfOrientation := LogFont.lfEscapement;
NewFontHandle := CreateFontIndirect(LogFont);
OldFontHandle := SelectObject(Canvas.Handle, NewFontHandle);
TextPosition.X := ARect.Left +
((ARect.Right - ARect.Left - Canvas.TextHeight(Cells[ACol, ARow])) div 2);
TextPosition.Y := ARect.Bottom -
((ARect.Bottom - ARect.Top - Canvas.TextWidth(Cells[ACol, ARow])) div 2);
Canvas.TextRect(ARect, TextPosition.X, TextPosition.Y, Cells[ACol, ARow]);
NewFontHandle := SelectObject(Canvas.Handle, OldFontHandle);
DeleteObject(NewFontHandle);
end
else
inherited DrawCell(ACol, ARow, ARect, AState);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
I: Integer;
begin
for I := 0 to StringGrid1.ColCount - 1 do
begin
StringGrid1.ColWidths[I] := 24;
StringGrid1.Cells[I, 0] := 'Column no. ' + IntToStr(I);
end;
StringGrid1.RowHeights[0] := 80;
end;
end.
And here's how it looks like: