I'd like to draw marks in Chart.ChartAfterDraw using Aseries.Marks.DrawItem method. I'm using the following code.
procedure TMyForm.ChartAfterDraw(Sender: TObject);
var
mark : TTextShape;
begin
mark := TTextShape.Create(Chart);
mark.Font := ClickedSeries.Marks.Font;
ClickedSeries.Marks.DrawItem(mark,
clRed,
'pippo',
ClickedSeries.Marks.Positions[ ClickedTask ] );
end;
But as you can see in figure below mark is created fine, in correct position, but its text is not printed.
In debug mod when cursor go past the end of TMyForm.ChartAfterDraw the following message appear.
This sounds like an error occured in Marks.DrawItem method. Unfortunately i'm using TeeChart Lite, so i cant't see where that method fails (if it really fails)
Can you help me? Thank you.
P.s. I'm using XE5
It may be easier to directly draw your texts/marks using Chart1.Canvas.Rectangle() and Chart1.Canvas.TextOut() functions, but here you have an example using Marks.DrawItem() function. Note you had to create and initialize a TSeriesMarkPosition to pass it to the Marks.DrawItem().
uses Series;
type
TShapeAccess=class(TCustomTextShape);
var ClickedSeries: TChartSeries;
ClickedTask: Integer;
procedure TForm1.FormCreate(Sender: TObject);
var i: Integer;
begin
Chart1.View3D:=false;
for i:=0 to 3 do
with Chart1.AddSeries(TPointSeries) do
FillSampleValues;
end;
procedure TForm1.Chart1Click(Sender: TObject);
var i: Integer;
begin
for i:=0 to Chart1.SeriesCount-1 do
begin
ClickedTask:=Chart1[i].Clicked(Chart1.GetCursorPos.X, Chart1.GetCursorPos.Y);
if ClickedTask>-1 then
begin
ClickedSeries:=Chart1[i];
Break;
end;
end;
Chart1.Draw;
end;
procedure TForm1.Chart1AfterDraw(Sender: TObject);
var
mark : TTextShape;
position: TSeriesMarkPosition;
tmpString: String;
begin
if (ClickedSeries<>nil) and (ClickedTask>-1) and (ClickedTask<ClickedSeries.Count-1) then
begin
tmpString:='pippo';
mark := TTextShape.Create(Chart1);
mark.Text:=tmpString;
mark.Font := ClickedSeries.Marks.Font;
TShapeAccess(mark).CalcBounds(Chart1);
position:=TSeriesMarkPosition.Create;
position.LeftTop.X:=ClickedSeries.CalcXPos(ClickedTask);
position.LeftTop.Y:=ClickedSeries.CalcYPos(ClickedTask);
position.Width:=Chart1.Canvas.TextWidth(tmpString)+2;
position.Height:=Chart1.Canvas.TextHeight(tmpString)+4;
ClickedSeries.Marks.DrawItem(mark, clRed, tmpString, position);
end;
end;
Related
i want to ask how to retain controlls when im making a copy of a control. for example i have an edit box that can be controlled with a slider for value change. when i make a copy using this code i achieve a copy of the items but the slider stops controlling editbox values. how can i fix that?
TypInfo;
procedure CloneProperties(const Source: TControl; const Dest: TControl);
var
ms: TMemoryStream;
OldName: string;
begin
OldName := Source.Name;
Source.Name := ''; // needed to avoid Name collision
try
ms := TMemoryStream.Create;
try
ms.WriteComponent(Source);
ms.Position := 0;
ms.ReadComponent(Dest);
finally
ms.Free;
end;
finally
Source.Name := OldName;
end;
end;
procedure CloneEvents(Source, Dest: TControl);
var
I: Integer;
PropList: TPropList;
begin
for I := 0 to GetPropList(Source.ClassInfo, [tkMethod], #PropList) - 1 do
SetMethodProp(Dest, PropList[I], GetMethodProp(Source, PropList[I]));
end;
procedure DuplicateChildren(const ParentSource: TWinControl;
const WithEvents: Boolean = True);
var
I: Integer;
CurrentControl, ClonedControl: TControl;
begin
for I := ParentSource.ControlCount - 1 downto 0 do
begin
CurrentControl := ParentSource.Controls[I];
ClonedControl := TControlClass(CurrentControl.ClassType).Create(CurrentControl.Owner);
ClonedControl.Parent := ParentSource;
CloneProperties(CurrentControl, ClonedControl);
ClonedControl.Name := CurrentControl.Name + '_';
if WithEvents then
CloneEvents(CurrentControl, ClonedControl);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
DuplicateChildren(Panel1);
end;
Unless I'm misunderstanding you, your CloneProperties doesn't seem to have anything to do with the question you're asking. In your example of an edit control E1 and a slider S1, you can clone both of them to produce E2 and S2, but somewhere in your code there must be a statement that changes the value in E1 depending on the value of S1. However, in the way you've most likely written it, that statement doesn't apply to E2 and S2.
The simplest way around that is to write a method which takes the component instances and links the operation of the two together. e.g.
procedure TForm1.SetEditControlFromSlider(AnEdit : TEdit; ASlider : { TWhatever the slider actually is);
begin
// Set AnEdit's value from ASlider's properties
end;
Then, you can call this with Edit/Slider pairs like this
SetEditControlFromSlider(E1, S1);
[...]
SetEditControlFromSlider(E2, S2);
I can imagine you might not like having to do that.
IMO, the cleanest solution is to avoid attempting to clone components altogether and create a TFrame containing the Edit, Slider and the code that connects them, and then add to your form as many instances of the frame as you need. It's as easy as falling off a log.
type
TEditFrame = class(TFrame) // needs to be in its own unit, Used by your form
Edit1: TEdit;
TrackBar1: TTrackBar;
procedure TrackBar1Change(Sender: TObject);
private
public
end;
[...]
procedure TEditFrame.TrackBar1Change(Sender: TObject);
begin
Edit1.Text := IntToStr(TrackBar1.Position)
end;
Then, you can add clones of the frame to TForm1 by
procedure TForm1.Button1Click(Sender: TObject);
var
AFrame : TEditFrame;
begin
Inc(FrameCount); // Field of TForm1
AFrame := TEditFrame.Create(Self);
AFrame.Name := AFrame.Name + IntToStr(FrameCount);
AFrame.Parent := Self;
AFrame.Top := AFrame.Height * FrameCount;
end;
Note that because the code which links the two components, TrackBar1Change, it compiled into the frame's unit, it is automatically shared by every instance of the frame you create, without any need to "clone" the code.
procedure TfrmSongs.Display;
var
i: Integer;
begin
redOutput.Clear;
redOutput.Lines.Add('The TOP 10');
for i := 1 to iCount-1 do
begin
redOutput.Lines.Add(IntToStr(i)+arrSongs[i]);
end;
end;
procedure TfrmSongs.FormActivate(Sender: TObject);
var
tSongList: TextFile;
sSong: string;
begin
iCount := 0;
AssignFile(tSongList, ExtractFilePath(Application.ExeName)+'Songs.txt');
Reset(tSongList);
while not EOF do
begin
Readln(tSongList, sSong);
arrSongs[iCount] := sSong;
Inc(iCount);
end;
CloseFile(tSongList);
Display;
end;
I'm trying to display the array I tried to create via a text file in a rich edit. But every time I run the app, it gives me an 'I/O error 6' error and nothing displays. I don't know if it's something with the text file or if it's something with the display procedure.
There are a few problems with your code, but regarding the I/O error specifically, error 6 means "invalid file handle".
Since you are getting a popup error notification, you clearly have I/O checking enabled, which it is by default.
I/O error 6 is not typical for a failure on System.Reset(), and you are not seeing any other kind of error related to a failure in opening a file, so we can safely assume that the file is being opened successfully, and that System.Readln() and System.CloseFile() are not being passed an invalid I/O handle.
So that leaves just one line that could be receiving an invalid I/O handle:
while not EOF do
System.Eof() has an optional parameter to tell it which file to check. Since you are omitting that parameter, Eof() will use System.Input instead. And a GUI process does not have a STDIN handle assigned by default. So that is likely where error 6 is coming from.
That line needs to be changed to this instead:
while not EOF(tSongFile) do
UPDATE: given the declaration of arrSongs you have shown in comments (arrSongs: array[1..MAX] of string;), there are additional problems with your code. You need to make sure the reading loop does not try to store more than MAX strings in the array. Also, your reading loop is trying to store a string at index 0, which is not a valid index since the array starts at index 1. Also, Display() is skipping the last string in the array. See what happens when you omit important details?
Try this instead:
private
arrSongs: array[1..MAX] of string;
...
procedure TfrmSongs.Display;
var
i: Integer;
begin
redOutput.Clear;
redOutput.Lines.Add('The TOP 10');
for i := 1 to iCount do
begin
redOutput.Lines.Add(IntToStr(i) + arrSongs[i]);
end;
end;
procedure TfrmSongs.FormActivate(Sender: TObject);
var
tSongList: TextFile;
sSong: string;
begin
iCount := 0;
AssignFile(tSongList, ExtractFilePath(Application.ExeName) + 'Songs.txt');
Reset(tSongList);
try
while (not EOF(tSongList)) and (iCount < MAX) do
begin
Readln(tSongList, sSong);
arrSongs[1+iCount] := sSong;
Inc(iCount);
end;
finally
CloseFile(tSongList);
end;
Display;
end;
That being said, I would suggest getting rid of the reading loop completely. You can use a TStringList instead:
uses
..., System.Classes;
...
private
lstSongs: TStringList;
...
procedure TfrmSongs.Display;
var
i: Integer;
begin
redOutput.Clear;
redOutput.Lines.Add('The TOP 10');
for i := 0 to lstSongs.Count-1 do
begin
redOutput.Lines.Add(IntToStr(i+1) + lstSongs[i]);
end;
end;
procedure TfrmSongs.FormCreate(Sender: TObject);
begin
lstSongs := TStringList.Create;
end;
procedure TfrmSongs.FormDestroy(Sender: TObject);
begin
lstSongs.Free;
end;
procedure TfrmSongs.FormActivate(Sender: TObject);
begin
lstSongs.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Songs.txt');
Display;
end;
Or, you can use TFile.ReadAllLines() instead:
uses
..., System.IOUtils;
...
private
arrSongs: TStringDynArray;
...
procedure TfrmSongs.Display;
var
i: Integer;
begin
redOutput.Clear;
redOutput.Lines.Add('The TOP 10');
for i := 0 to High(arrSongs) do
begin
redOutput.Lines.Add(IntToStr(i+1) + arrSongs[i]);
end;
end;
procedure TfrmSongs.FormActivate(Sender: TObject);
begin
arrSongs := TFile.ReadAllLines(ExtractFilePath(Application.ExeName) + 'Songs.txt');
Display;
end;
I need to be able to make Undo and Redo operatons in my simple delphi paint. So I decided to make some container to save history (not full history, only few previous bitmap files).
unit HistoryQueue;
interface
uses
Graphics;
type
myHistory = class
constructor Create(Size:Integer);
public
procedure Push(Bmp:TBitmap);
function Pop():TBitmap;
procedure Clean();
procedure Offset();
function isEmpty():boolean;
function isFull():boolean;
function getLast():TBitmap;
protected
end;
var
historyQueueArray: array of TBitmap;
historyIndex, hSize:Integer;
implementation
procedure myHistory.Push(Bmp:TBitmap);
var tbmp:TBitmap;
begin
if(not isFull) then begin
Inc(historyIndex);
historyQueueArray[historyIndex]:=TBitmap.Create;
historyQueueArray[historyIndex].Assign(bmp);
end else begin
Offset();
historyQueueArray[historyIndex]:=TBitmap.Create;
historyQueueArray[historyIndex].Assign(bmp);
end;
end;
procedure myHistory.Clean;
var i:Integer;
begin
{ for i:=0 to hSize do begin
historyQueueArray[i].Free;
historyQueueArray[i].Destroy;
end; }
end;
constructor myHistory.Create(Size:Integer);
begin
hSize:=Size;
SetLength(historyQueueArray, hSize);
historyIndex:=-1;
end;
function myHistory.isEmpty: boolean;
begin
Result:=(historyIndex = -1);
end;
function myHistory.isFull: boolean;
begin
Result:=(historyIndex = hSize);
end;
procedure myHistory.Offset;
var i:integer;
begin
//historyQueueArray[0]:=nil;
for i:=0 to hSize-1 do begin
historyQueueArray[i]:=TBitmap.Create;
historyQueueArray[i].Assign(historyQueueArray[i+1]);
end;
end;
function myHistory.Pop: TBitmap;
var
popBmp:TBitmap;
begin
popBmp:= TBitmap.Create;
popBmp.Assign(historyQueueArray[historyIndex]);
Dec(historyIndex);
Result:=popBmp;
end;
function myHistory.getLast: TBitmap;
var
tBmp:TBitmap;
begin
tBmp:= TBitmap.Create;
tBmp.Assign(historyQueueArray[historyIndex]);
Result:=tBmp;
end;
end.
In my program I use it like that.
Saving in history:
procedure TMainForm.FormCreate(Sender: TObject);
begin
{...}
picHistory:=myHistory.Create(10); //FOR UNDO
tempHistory:=myHistory.Create(10); //FOR REDO
end;
//if mouse is up - that mean we finish to draw something on canvas, so we gonna save what we drew
procedure TMainForm.imgMainMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var bmp:TBitmap;
begin
mouseIsDown:=false;
bmp:=TBitmap.Create;
try
bmp.Assign(imgMain.Picture.Bitmap);
picHistory.Push(bmp);
finally
bmp.Free;
end;
end;
And making undo and redo.
procedure TMainForm.btnUndoClick(Sender: TObject);
var redBmp:TBitmap;
begin
if(not picHistory.isEmpty) then begin //if we draw something before
//prepare to save what've done into history for redo
redBmp:=TBitmap.Create;
redBmp.Assign(picHistory.getLast);
//showing what were done with image before on screen
MainForm.imgMain.Canvas.Draw(0,0, picHistory.Pop);
//but in case we want to be able get back our last changes we save it into redo history
tempHistory.Push(redBmp);
redBmp.Free;
end;
end;
{...}
procedure TMainForm.btnRedoClick(Sender: TObject);
begin
//if there were something into history for redo then show int on canvas
if(not tempHistory.isEmpty) then
MainForm.imgMain.Canvas.Draw(0,0, tempHistory.Pop);
end;
But there are strang thing happens - what I push on Undo nothing changes. And when I push on Redo - it works like Undo.
And by the way when I declare history for redo and undo with different lenght like that
procedure TMainForm.FormCreate(Sender: TObject);
begin
{...}
picHistory:=myHistory.Create(6); //FOR UNDO
tempHistory:=myHistory.Create(12); //FOR REDO
end;
And then whatch by steps what happens in picHistory it seems like lenght of it's array not 6, it's 12! So I think those two objects use one same array! Why does it happens and how to make it right?
Your two instances of the myHistory class share the same global data. You must move your data declarations into the class to make them per-instance data instead of global.
Try this:
type
myHistory = class
private
historyQueueArray: array of TBitmap; //Now they are class members instead of global
historyIndex, hSize:Integer;
public
constructor Create(Size:Integer);
procedure Push(Bmp:TBitmap);
function Pop():TBitmap;
procedure Clean();
procedure Offset();
function isEmpty():boolean;
function isFull():boolean;
function getLast():TBitmap;
protected
end;
How can I properly free the component once i make it with a loop like this? If I free it like I do now I get some GETMEM.INC exception. I am coming from Indy so i don't really know ICS too much.
Thanks
const
URLs : array[0..3] of string =
(
'http://www.example.com',
'http://www.example.com',
'http://www.example.com',
'http://www.example.com'
) ;
var
Output: array of TStringList;
S: array of TMemoryStream;
Async: array of TSslHttpCli;
implementation
procedure RequestDone(Sender: TObject; RqType: THttpRequest;
ErrCode: Word);
begin
with Sender as TSSLHTTPCLI do begin
S[Tag].Position:=0;
Output[Tag].LoadFromStream(S[Tag]);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
i:integer;
begin
for i := 0 to High(URLS) do begin
S[i]:=TMemoryStream.Create;
Output[i]:=TStringList.Create;
Async[i]:=TSslHttpCli.Create(nil);
Async[i].Tag:=i;
Async[i].FollowRelocation:=true;
Async[i].NoCache:=true;
Async[i].SocketFamily:=sfAny;
Async[i].OnRequestDone:=RequestDone;
Async[i].RcvdStream:=S[i];
Async[i].URL:= URLs[i];
Async[i].MultiThreaded:=true;
Async[i].GetASync;
end;
end;
procedure TForm1.Button4Click(Sender: TObject);
var
i:integer;
begin
for i := 0 to High(URLS) do begin
Output[i].Free;
Async[i].RcvdStream.Free;
Async[i].Free; // << -- EXCEPTION
// S[i].Free;
end;
end;
You never allocate any memory for Result, Asynch, or S. You need to SetLength on each of them before you can put anything into them (or take anything back out).
procedure TForm1.Button1Click(Sender: TObject);
var
i:integer;
begin
SetLength(Result, Length(URLS));
SetLength(S, Length(URLS));
SetLength(Asynch, Length(URLS));
for i := 0 to High(URLS) do begin
S[i]:=TMemoryStream.Create;
Result[i]:=TStringList.Create;
Async[i]:=TSslHttpCli.Create(nil);
// etc.
end;
end;
BTW, Result is a terrible name for a variable, especially one that's global in scope. It's the return value from a function that's automatically generated by the compiler, and use anywhere but in a function makes your code hard to read. See this, for instance:
var
Result: string = '';
procedure AddToReslt(CharToAdd: Char);
begin
// Many many lines of code
// go in here. Maybe a few loops
// of if statements.
Result := Result + CharToAdd;
end;
function DoSomeMath: Integer;
begin
// Some really complex numeric code, maybe
// calculating the value of `pi` to the 900th
// digit
Result := 2 * 2;
end;
Now quickly - remembering that each of them containss lots of code - which one is a function and which is a procedure?
If customsort function is passed in with a variable, it seems it will access violation.
public
...
col: integer;
...
Procedure listviewcol;
begin
col:=5
...
end;
procedure TForm1.sortcol(listview: tlistview);
function CustomSortProc(Item1,Item2: TListItem;
OptionalParam: integer): integer;stdcall;
begin
Result := AnsiCompareText(Item2.subitems.Strings[col], Item1.subitems.Strings[col]);
end;
begin
ListView.CustomSort(#CustomSortProc,0);
end;
This will prompt errors. // access violation
But if we change col in AnsicompareText to 5, it works well.
procedure TForm1.sortcol(listview: tlistview);
function CustomSortProc(Item1,Item2: TListItem;
OptionalParam: integer): integer;stdcall;
begin
Result := AnsiCompareText(Item2.subitems.Strings[5], Item1.subitems.Strings[5]);// it works.
end;
begin
ListView.CustomSort(#CustomSortProc,0);
end;
How to fix it.
Please help. Thanks a lot.
You cannot access col inside the callback function, it is not a method of your form. Your trick of nesting the callback in a method is futile. ;) If you need to access form fields then use the OptionalParam to be able to refer to your form in the callback.
begin
ListView.CustomSort(#CustomSortProc, Integer(Self));
[...]
function CustomSortProc(Item1,Item2: TListItem;
OptionalParam: integer): integer; stdcall;
var
Form: TForm1;
begin
Form := TForm1(OptionalParam);
Result := AnsiCompareText(Item2.subitems.Strings[Form.col],
Item1.subitems.Strings[Form.col]);
Of course you can send the value of col in 'OptionalParam' if that's the only thing you need. Or, you can make 'col' a global variable instead of a field, or use the 'Form1' global variable itself which the IDE puts just before the implementation section if it's not commented out.
You can also make use of the OnCompare event.
Pass col as OptionalParam:
function CustomSortProc(Item1,Item2: TListItem; col: integer): integer;stdcall;
begin
Result := AnsiCompareText(Item2.subitems.Strings[col], Item1.subitems.Strings[col]);
end;
begin
ListView.CustomSort(#CustomSortProc, col);
end;
Or use Sertac answer - he was faster :)