I am trying to create a retro text based game in style of Dungeons and Dragons. I encountered problem when I try to display number in Label. It seems that the procedure can´t find the Label from list. I always get: Error: Identifier not found "Label6"
Code:
procedure health;
var hp: integer;
begin
hp:=100;
Label6.Caption:= inttostr(hp);
end;
Related
I try to set the property of an object when filling a ListBox with ListBoxItems. The object is an ellipse added to the style used by the ListBox. The line of code below raises an exception:
ListBoxItem.StylesData['ellipsestyle.fill.Gradient.Points.Points[0].Color'] := newAlphaColor;
As a workaround, I tried to reach the property by getting the ellipsestyle object with ListBoxItem.FindStyleRessource, but the function returns nil.
Thank you !
StylesData can`t provide access to 'complex' properties.
you can do next workaround:
var
Obj: TObject;
myListBoxItem: TListBoxItem;
begin
// create new item
myListBoxItem:=TListBoxItem.Create(nil);
ListBox1.AddObject(myListBoxItem);
myListBoxItem.StyleLookup:='listboxitembottomdetail';
myListBoxItem.StylesData['ellipsestyle.fill.Kind']:=TValue.From<TBrushKind>(TBrushKind.Gradient);
// access to GradientPoints collection
Obj:=myListBoxItem.StylesData['ellipsestyle.fill.Gradient.Points'].AsObject;
if not (Obj is TGradientPoints) then
Exit;
TGradientPoints(Obj).Points[0].Color:=TAlphaColorRec.Blanchedalmond;
TGradientPoints(Obj).Points[1].Color:=TAlphaColorRec.Alpha;
About FindStyleResource:
First place, where you can get access to style object - OnApplyStyleLookup event of specified ListBoxItem. Before OnApplyStyleLookup (for example - immediatelly after creating Listboxitem) you cannot get access to style.
So, move your code to ListBoxItem.OnApplyStyleLookup and change it like this:
procedure TForm2.ListBoxItem1ApplyStyleLookup(Sender: TObject);
var
FMXObj: TFmxObject;
Ellipse: TEllipse;
begin
if not (Sender is TFmxObject) then
Exit;
FMXObj:=TFMXObject(Sender).FindStyleResource('ellipsestyle');// get object by it`s "StyleName".
if not (FMXObj is TEllipse) then
Exit;
Ellipse:=TEllipse(FMXObj);
Ellipse.Fill.Kind:=TBrushKind.Gradient;
Ellipse.Fill.Gradient.Points.Points[0].Color:=TAlphaColorRec.Blueviolet;
Ellipse.Fill.Gradient.Points.Points[1].Color:=TAlphaColorRec.Greenyellow;
end;
Also, you can force load style (this is not recommended way - by default, style for object loaded at the time of first painting):
var
FMXObj: TFmxObject;
Ellipse: TEllipse;
myListBoxItem: TListBoxItem;
begin
myListBoxItem:=TListBoxItem.Create(nil);
ListBox1.AddObject(myListBoxItem);
myListBoxItem.StyleLookup:='listboxitembottomdetail';
// force load style
myListBoxItem.NeedStyleLookup;
myListBoxItem.ApplyStyleLookup; // this method also call OnApplyStyleLookup event
FMXObj:=myListBoxItem.FindStyleResource('ellipsestyle');
if not (FMXObj is TEllipse) then
Exit;
Ellipse:=TEllipse(FMXObj);
Ellipse.Fill.Kind:=TBrushKind.Gradient;
Ellipse.Fill.Gradient.Points.Points[0].Color:=TAlphaColorRec.Blanchedalmond;
Ellipse.Fill.Gradient.Points.Points[1].Color:=TAlphaColorRec.Alpha;
I'm trying to draw an image on a TPanel's Canvas in a procedure of this Panel. When I do this in Paint Method of the Panel it works just fine, but when I try to draw on the Canvas in another procedure or in the constructor nothing happens.
This is how I draw on the Panel's Canvas in the Paint Procedure:
procedure TFeld.Paint;
var bmp : TBitmap;
begin
inherited;
bmp := TBitmap.Create;
try
bmp.LoadFromFile('textures\ground.bmp');
self.Canvas.Draw(0,0,bmp);
finally
bmp.Free;
end;
end;
And this is how I try to draw on it in another procedure:
procedure TFeld.setUnsichtbar;
var bmp : TBitmap;
begin
bmp := TBitmap.Create;
try
bmp.LoadFromFile('textures\invisible.bmp');
self.Canvas.Draw(0,0,bmp);
finally
bmp.Free;
end;
end;
But the Panel's Canvas is still the image I applied in the Paint procedure.
I already tried to move the drawing from the Paint procedure to the Constructor which didn't work.
The path is also correct, switched the paths and now the Panels have the 'invisible.bmp' image.
Whole Class/Unit: http://pastebin.com/YhhDr1F9
Any idea why this doesn't work?
Looking at your whole class I asume you desire to controll which image is being shown at which time based on certain condition. Right?
If that is the case first thing that you need is for your class to have a field for storing the image data. In your example above you are only using bmp files so TBitmap would suffice. But if you are using other picture types you might want to use TPicture field instead as this one alows loading of all supported picture images as TImage that you also tried to use component can.
Then you change your component's Paint method to use the above mentioned field for getting picture data instead of creating local picture data variable every time as you do it now.
In fact what you are doing now is terrible as you are forcing your application to read the image data from file into memory every time your component is rendered. This could cause terrible performance.
And finally when you want to change the picture that is shown on your component just load different picture into your picture field.
So with above changes your class should look something like this:
type
TFeld=class(TPanel)
protected
procedure Paint;override;
procedure BitmapChange(Sender: TObject);
private
zSichtbar : Boolean;
zPosHor,zPosVer : Integer; // Position im Array
zEinheit : TEinheit;
Bitmap: TBitmap; //Field for storing picture data
public
// hImage : TImage;
constructor Create(pX,pPosHor,pY,pPosVer,pHoehe,pBreite:integer;pImgPath:String;pForm:Tform); virtual;
destructor Destroy;
procedure ChangeImage(pImgPath: String);
end;
...
implementation
constructor TFeld.Create(pX,pPosHor,pY,pPosVer,pHoehe,pBreite:integer;pImgPath:String;pForm:Tform);
begin
inherited create(pForm);
...
//Creater internal component for storing image data
Bitmap := TBitmap.Create;
//Assign proper method to Bitmaps OnChange event
Bitmap.OnChange := BitmapChange;
//Load initial image data
Bitmap.LoadFromFile(pImgPath);
....
end;
destructor Destroy;
begin
//We need to destroy the internal component for storing image data before
//we destory our own component in order to avoid memory leaks
Bitmap.Free;
end;
procedure TFeld.Paint;
begin
inherited;
//Use local image field to tell the Paint method of what to render
self.Canvas.Draw(0,0,Bitmap);
end;
procedure TFeld.BitmapChange(Sender: TObject);
begin
//Force redrawing of the component on bitmap change
self.Invalidate;
end;
procedure TFeld.ChangeImage(pImgPath: String);
begin
//Load different image into image field
Bitmap.LoadFromFile(pImgPath);
end;
EDIT: Adding necessary code to force component redrawing after bitmap has been changed.
I want to know width and height of Image while it is in Clipboard, because if dimensions are too small then message like "Image is too small" should appear.
How to get width and height?
Unless you are prepared to manually parse the various image formats that you want to support, you can have the VCL simply load the image for you (just make sure suitable TGraphic classes have been registered, such as TGIFImage, TJPEGImage, TPNGImage, etc), and then you can ask the image for its dimensions, eg:
uses
Graphics, Clipbrd, Jpeg, PngImage, ...;
procedure TForm1.BitBtn1Click(Sender: TObject);
var
p: TPicture;
begin
p := TPicture.Create;
try
try
p.Assign(Clipboard);
// use p.Graphic, p.Graphic.Width, p.Graphic.Height as needed...
except
// unable to access Clipboard, or Clipboard
// does not contain a supported image type
end;
finally
p.Free;
end;
end;
If this is about bitmap I think you may try this.
procedure TForm1.BitBtn1Click(Sender: TObject);
var b:TBitmap;
begin
if Clipboard.HasFormat(CF_BITMAP) then begin
b:=TBitmap.Create;
try
b.Assign(Clipboard);
ShowMessage(IntToStr(b.Width)+','+IntToStr(b.Height));
finally
b.Free;
end;
end;
end;
you can instead of showmessage put If-statement and do what ever you want.
In Delphi XE, I'm trying to implement an "instant search" feature - one that resembles Firefox's "search as you type" somewhat, but is better illustrated by a similar feature in an open source clipboard extender, Ditto:
There is a list of items that handles typical navigation events. However, any alphanumeric keys as well as navigation and editing commands (right/left arrows, shift+arrows, backspace, delete etc.) should be rerouted to the edit box below the list. An OnChange event of the edit box will trigger a refresh of the list.
The point of the UI is that user does not have to tab or shift-tab between the controls. The two controls (the list and the edit box) should 'feel" as if they were a single control. The behavior of the search UI should not be contingent on which control has focus.
It seems my best option is to forward certain keyboard events from the list control (I'm using TcxTreeList) to the edit box, and forward a handful of navigation keys from the edit box to the list. How can I achieve that?
Notes:
TcxTreeList supports incremental search of course, but this is not what I'm after. The search goes to an SQLite database and looks for substring matches. The list displays only the matching items from the db.
There is some overlap, e.g. both controls would normally handle VK_HOME and VK_END, but that's OK - in this case the keys would go to the list. I'll need to decide whether to forward each individual keypress, or handle it in the control that received it.
On Edit:
One obvious way seemed to be to invoke the respective KeyDown, KeyUp and KeyPress methods of the edit control, like so:
type
THackEdit = class( TEdit );
procedure TMainForm.cxTreeList1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
THackEdit( edit1 ).KeyDown( Key, Shift );
end;
Unfortunately, this has no effect. My guess is TEdit won't process key events unless it is focused. Using SendMessage( THackEdit( edit1 ).Handle, WM_KEYDOWN, Key, 0 ) has no effect, either.
You can use the message handling capability of a VCL control and send the relevant messages to one another. I don't know about a 'TcxTreeList', but the following demonstrates the idea on an edit control and a memo control responding to keyboard events synchronously (whereever possible of course).
type
TEdit = class(stdctrls.TEdit)
private
FMsgCtrl: TWinControl;
FRecursing: Boolean;
procedure WmChar(var Msg: TWMChar); message WM_CHAR;
procedure WmKeyDown(var Msg: TWMKeyDown); message WM_KEYDOWN;
procedure WmKeyUp(var Msg: TWMKeyUp); message WM_KEYUP;
end;
TMemo = class(stdctrls.TMemo)
private
FMsgCtrl: TWinControl;
FRecursing: Boolean;
procedure WmChar(var Msg: TWMChar); message WM_CHAR;
procedure WmKeyDown(var Msg: TWMKeyDown); message WM_KEYDOWN;
procedure WmKeyUp(var Msg: TWMKeyUp); message WM_KEYUP;
end;
TForm1 = class(TForm)
Edit1: TEdit;
Memo1: TMemo;
procedure FormCreate(Sender: TObject);
private
public
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{ TEdit }
procedure TEdit.WmChar(var Msg: TWMChar);
begin
if not FRecursing then begin
inherited;
// Insert test here to see if the message will be forwarded
// exit/modify accordingly.
if Assigned(FMsgCtrl) then begin
FRecursing := True;
try
FMsgCtrl.Perform(Msg.Msg,
MakeWParam(Msg.CharCode, Msg.Unused), Msg.KeyData);
finally
FRecursing := False;
end;
end;
end;
end;
procedure TEdit.WmKeyDown(var Msg: TWMKeyDown);
begin
// exact same contents as in the above procedure
end;
procedure TEdit.WmKeyUp(var Msg: TWMKeyUp);
begin
// same here
end;
{ TMemo }
procedure TMemo.WmChar(var Msg: TWMChar);
begin
// same here
end;
procedure TMemo.WmKeyDown(var Msg: TWMKeyDown);
begin
// same here
end;
procedure TMemo.WmKeyUp(var Msg: TWMKeyUp);
begin
// same here
end;
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
Edit1.FMsgCtrl := Memo1;
Memo1.FMsgCtrl := Edit1;
end;
You might need to intervene additional messages but you get the idea.
If for one reason or another you cannot derive a new control or override message handling, you can consider sub-classing the controls. Answer to this question would show you how to do that.
Not exactly what you are asking for, but for similar results, I use the following trick.
Assume you have one TEdit Edit1 and one TListbox Listbox1.
In the OnEnter event of Listbox1, simply yield focus to Edit1
procedure TForm1.ListBox1Enter(Sender: TObject);
begin
edit1.SetFocus;
end;
And in the OnKeyDown event of Edit1, use the up and down arrows to navigate the items of the listbox and use the enter key to move the selected item to the edit box.
procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
var k:word;
begin
if (Shift=[]) and (key=VK_DOWN) then
begin
listbox1.ItemIndex:=listbox1.ItemIndex+1;
key:=0;
end
else if (Shift=[]) and (key=VK_UP) then
begin
listbox1.ItemIndex:=listbox1.ItemIndex-1;
key:=0;
end
else if (Shift=[]) and (key=VK_RETURN) then
begin
edit1.text:=listbox1.items[listbox1.itemindex];
end;
end;
I am a student, and I'm working on a little slots game (if the same random number comes up 3 timed, you win). I use Borland Pascal 7. I use graph to make this a bit more visual, but when I start the game my background turns from black to grey, and the other problem is that if I click the game start button, the game runs many times until I release the mouse button. How can I solve this?
Here is my full program:
program slots;
uses mymouse,graph,crt;
var gdriver,gmode,coin:integer;
m:mouserec;
a,b,c,coins:string;
procedure gomb(x1,y1,x2,y2:integer;szoveg:string);
var j,n:integer;
begin
setcolor(blue);
rectangle(x1,y1,x2,y2);
setfillstyle(1,blue);
floodfill(x1+2,y1+2,blue);
setcolor(0);
outtextxy((x1+x2)div 2 -textwidth(szoveg) div 2 ,(y1+y2) div 2-textheight(szoveg) div 2,szoveg);
end;
procedure randomal(var a,b,c:string);
begin
randomize;
STR(random(2)+1,a);
STR(random(2)+1,b);
STR(random(2)+1,c);
end;
procedure menu;
begin;
settextstyle(0,0,1);
outtextxy(20,10,'Meno menu');
gomb(20,20,90,50,'Teglalap');
gomb(20,60,90,90,'Inditas');
gomb(20,100,90,130,'Harmadik');
gomb(20,140,90,170,'Negyedik');
end;
procedure teglalap(x1,x2,y1,y2,tinta:integer);
begin
setcolor(tinta);
rectangle(x1,x2,y1,y2);
end;
procedure jatek(var a,b,c:string;var coin:integer;coins:string);
begin;
clrscr;
menu;
randomal(a,b,c);
if ((a=b) AND (b=c)) then coin:=coin+1 else coin:=coin-1;
settextstyle(0,0,3);
setbkcolor(black);
outtextxy(200,20,a);
outtextxy(240,20,b);
outtextxy(280,20,c);
STR(coin,coins);
outtextxy(400,400,coins);
end;
procedure eger;
begin;
mouseinit;
mouseon;
menu;
repeat
getmouse(m);
if (m.left) and (m.x>20) ANd (m.x<90) and (m.y>20) and (m.y<50) then teglalap(90,90,300,300,blue);
if (m.left) and (m.x>20) AND (m.x<90) and (m.y>60) and (m.y<90) then jatek(a,b,c,coin,coins);
until ((m.left) and (m.x>20) ANd (m.x<140) and (m.y>140) and (m.y<170));
end;
begin
coin:=50;
gdriver:=detect;
initgraph(gdriver, gmode, '');
eger;
end.
I have many years to use Turbo Pascal :)
I used this snippet to init BGI (graphic) mode:
Gd := Detect;
InitGraph(Gd, Gm, 'bgi');
if GraphResult <> grOk then
Halt(1);
SetBkColor(black);
Cleardevice;
If I recall correctly, ClearDevice is proper for clearing the screen, ClrScr is for text mode.
Now, GetMouse(m); probably returns immediately the mouse data thus the code
in the repeat loop runs again and again with no delay, even if you don't use the mouse.
One solution is to check if the mouse button is up before you execute that code or
add some kind of delay before calling the GetMouse.