TObjectList re-order - delphi-xe

I need to re-order a TObjectList, according to some rules. How can I achieve this?
So I add panels to a ScrollBox dinamically.
When I add them, I also add them to the ObjectList in the order that they are added at runtime, for future use. Then I can re-organize the panels in the scrollBox by drag/drop.
I want the ObjectList to mirror the same order that is set at runtime by drag/drop.
Here is my code:
var
MainForm: TMainForm;
PanelList,PanelListTMP:TObjectList;
implementation
...
procedure TMainForm.FormCreate(Sender: TObject);
begin
PanelList:=TObjectList.Create;
PanelListTMP:=TObjectList.Create;
end;
procedure TMainForm.Button1Click(Sender: TObject);
begin
AddPanel('0');
AddPanel('1');
AddPanel('2');
AddPanel('3');
AddPanel('4');
end;
procedure TMainForm.Addpanel(what:string);
var
pan:TPanel;
bv:TShape;
begin
pan:=TPanel.Create(self);
pan.Parent:=TheContainer;
pan.Height:=50;
pan.BevelOuter:=bvNone;
pan.BorderStyle:=bsNone;
pan.Ctl3D:=false;
pan.Name:='LayerPan'+what;
pan.Caption:=what;
pan.Align:=alBottom;
pan.OnMouseDown:=panMouseDown;
end;
procedure TMainForm.panMouseDown(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
var
i:integer;
idu:String;
panui:TPanel;
begin
panui:=Sender as TPanel;
panui.ParentColor:=false;
panui.BringToFront;
// DRAG DROP STUFF
ReleaseCapture;
panui.Perform(wm_nclbuttondown,HTCAPTION,0);
for i := 0 to MainForm.ComponentCount - 1 do
begin
if MainForm.Components[i] is TWinControl then
if TWinControl(MainForm.Components[i]) is TPanel then
if (TWinControl(MainForm.Components[i]) as TPanel).Parent=MainForm.TheContainer then
begin
(TWinControl(MainForm.Components[i]) as TPanel).Align:=alBottom;
end;
end;
TheContainer.ScrollInView(panui);
ReOrderPanels;
end;
Procedure TMainForm.ReOrderPanels;
begin
end;
What should I do in the ReOrderPanels procedure?
I was thinking about feeding the panels of the ScrollBox from bottom to top into a new TObjectList (PanelListTMP), clear the PanelList and re-add them from the PanelListTMP, but when I do that, I get an error: Access Violation, and EInvalidPointer - Invalid Pointer Operation
So this is what I thought:
procedure TMainForm.ReOrderPanels;
var
ctrl:TControl;
pos:TPoint;
pan:TPanel;
bad:boolean;
ord,i:integer;
begin
memo2.Lines.Add('*** new order START');
panelListTMP.Clear;
// scroll top
TheContainer.VertScrollBar.Position := 0;
// scroll down
TheContainer.VertScrollBar.Position := TheContainer.VertScrollBar.Range;
// get panel
Pos:=TheContainer.ClientOrigin;
Pos.Y:=Pos.Y+TheContainer.Height-5;
ctrl := FindVCLWindow(pos) ;
if ctrl is TPanel then
if TPanel(ctrl).Parent = TheContainer then
begin
pan:=(ctrl as TPanel);
panelListTMP.Add(pan);
end;
ord:=1;
bad:=false;
repeat
repeat
Pos.Y:=pos.Y-1;
until (FindVCLWindow(pos) is TPanel)and(FindVCLWindow(pos)<>pan);
if (FindVCLWindow(pos) is TPanel)and(FindVCLWindow(pos).Name<>'LayerPan') then
begin
pan:=FindVCLWindow(pos) as TPanel;
containeru.VertScrollBar.Position := 0;
containeru.ScrollInView(pan);
ord:=ord+1;
panelListTMP.Add(pan);
end
else
bad:=true;
until bad=true;
// and now I do the swap between the ObjectLists...
panelList.Clear;
for i:=0 to PanelListTMP.Count-1 do
begin
(PanelListTMP.Items[i] as TPanel).Parent:=containeru;
panelList.Add(PanelListTMP.Items[i]);
end;
end;
So I assume that because the ObjectList is storing pointers to the actual objects, then when I clear the initial ObjectList, the actual objects are freed, so the second ObjectList contains a list of pointers that are no longer viable...
But then how can I achieve what I want?
So on ButtonClick, I get a ObjectList that contains panels in the following order:
PanelList[0] - Panel0
PanelList[1] - Panel1
PanelList[2] - Panel2
PanelList[3] - Panel3
PanelList[4] - Panel4
After I drag - drop panels inside the ScrollBox, I can end up with an order like this (in the ScrollBox)
Panel3
panel1
Panel4
Panel2
Panel0
But in the ObjectList, the order is the same as before...
Again, I want to be able to have the ObjectList ordered according to the order of the panels from the scrollBox.
In the re-order procedure I actually get all the panels in the desired order.
I just need to have them in the same order in my ObjectList.
Is there any other way of doing this? Other that with me creating a new class that would hold an index beside a TPanel and use that in the ObjectList to maintain the order?

TObjectList has an OwnsObjects property that is True by default. Make sure to set it to False since you don't want the list to auto-free the objects as they are owned by the Form.
As for the actual sorting of the TObjectList, consider using its Sort() or SortList() method for that. After you have repositioned the Panels as desired within their container, call Sort() or SortList(). The sorting callback you provide will be given two object pointers at a time while the sorting is iterating the list. Use the current positions of the objects relative to each other to tell the list what order they should appear in.
Try something like this:
var
MainForm: TMainForm;
PanelList: TObjectList;
implementation
...
procedure TMainForm.FormCreate(Sender: TObject);
begin
PanelList := TObjectList.Create(False);
end;
procedure TMainForm.FormDestroy(Sender: TObject);
begin
PanelList.Free;
end;
procedure TMainForm.Button1Click(Sender: TObject);
begin
AddPanel('0');
AddPanel('1');
AddPanel('2');
AddPanel('3');
AddPanel('4');
end;
procedure TMainForm.Addpanel(what: string);
var
pan: TPanel;
bv: TShape;
begin
pan := TPanel.Create(Self);
try
pan.Parent := TheContainer;
pan.Height := 50;
pan.BevelOuter := bvNone;
pan.BorderStyle := bsNone;
pan.Ctl3D := false;
pan.Name := 'LayerPan'+what;
pan.Caption := what;
pan.Align := alBottom;
pan.OnMouseDown := panMouseDown;
PanelList.Add(pan);
except
pan.Free;
raise;
end;
end;
procedure TMainForm.panMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
i: integer;
idu: String;
panui, pan: TPanel;
tmpList: TObjectList;
begin
panui := Sender as TPanel;
panui.ParentColor := false;
panui.BringToFront;
// DRAG DROP STUFF
ReleaseCapture;
panui.Perform(WM_NCLBUTTONDOWN, HTCAPTION, 0);
tmpList := TObjectList.Create(False);
try
for i := 0 to TheContainer.ControlCount - 1 do
begin
if TheContainer.Controls[i] is TPanel then
tmpList.Add(TPanel(TheContainer.Controls[i]));
end;
for i := 0 to tmpList.Count - 1 do
TPanel(tmpList[i]).Align := alBottom;
finally
tmpList.Free;
end;
TheContainer.ScrollInView(panui);
ReOrderPanels;
end;
function SortPanels(Item1, Item2: Pointer): Integer;
begin
Result := TPanel(Item2).Top - TPanel(Item1).Top;
end;
procedure TMainForm.ReOrderPanels;
begin
PanelList.Sort(SortPanels);
// Alternatively:
{
PanelList.SortList(
function(Item1, Item2: Pointer): Integer;
begin
Result := TPanel(Item2).Top - TPanel(Item1).Top;
end
);
}
end;

I think I found my answer using a temporary ObjectList and Extract(Object)
My code that seems to work is:
procedure TMainForm.ReOrderPanels;
var
ctrl:TControl;
pos:TPoint;
pan,panx:TPanel;
bad:boolean;
ord,i:integer;
begin
panelListTMP.Clear;
panelList.OwnsObjects:=false;
// scroll top
TheContainer.VertScrollBar.Position := 0;
// scroll down
TheContainer.VertScrollBar.Position := TheContainer.VertScrollBar.Range;
// get panel
Pos:=TheContainer.ClientOrigin;
Pos.Y:=Pos.Y+TheContainer.Height-5;
ctrl := FindVCLWindow(pos) ;
if ctrl is TPanel then
if TPanel(ctrl).Parent = TheContainer then
begin
pan:=(ctrl as TPanel);
panelListTMP.Add(PanelList.Extract(pan) as TPanel);
end;
ord:=1;
bad:=false;
repeat
repeat
Pos.Y:=pos.Y-1;
until (FindVCLWindow(pos) is TPanel)and(FindVCLWindow(pos)<>pan);
if (FindVCLWindow(pos) is TPanel)and(FindVCLWindow(pos).Name<>'LayerPan') then
begin
pan:=FindVCLWindow(pos) as TPanel;
TheContainer.VertScrollBar.Position := 0;
TheContainer.ScrollInView(pan);
ord:=ord+1;
panelListTMP.Add(PanelList.Extract(pan) as TPanel);
end
else
bad:=true;
until bad=true;
panelList.Clear;
panelListTMP.OwnsObjects:=false;
i:=0;
while (PanelListTMP.Count<>0) do
panelList.Add(PanelListTMP.Extract(PanelListTMP.Items[i]) as TPanel);
panelList.OwnsObjects:=true;
panelListTmp.Clear;
end;

Related

Do an IF by DBGrid Column Title

I want to create a different Popup for each column. Since the columns order can be changed I need to identify that by the column title but I have not found a solution.
These are two method I have applied without success.
procedure TForm2.DBGrid1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
ACol, ARow: Integer;
begin
if Y < DBGrid1.DefaultRowHeight then
begin
(Sender as TDBGrid).MouseToCell(X, Y, ACol, ARow);
if Button = mbRight then
begin
if DBGrid1.SelectedColumn.FieldName = 'Title1' then
BEGIN
ShowMessage('Title1'+ IntToStr(ACol));
end;
if DBGrid1.SelectedColumn.FieldName = 'Title2' then
BEGIN
ShowMessage('Title2'+ IntToStr(ACol));
end;
end;
end;
end;
It is not functional because it identifies the columns by id and not the name so if the user change the columns order it will not work fine.
Also this faily code
procedure TForm2.Button2Click(Sender: TObject);
var
i: Integer;
CaptionText: string;
begin
for i := 0 to DBGrid1.Columns.Count - 1 do
case DBGrid1.Columns[i].FieldName of
'TEST':
begin
DBGrid1.Columns[i].Title.Caption := 'REPLACE TEXT';
end;
end;
end;
It simply replace all titles in a click.
What I'm looking to do is to create an IF like this that handle on right clicking column title:
if selected column name = 'test' then
begin
showmessage('You have selected test column');
end;
I'll use the if to create dynamic popup to apply filters.
The code below is an event handler for a TDBGrid's MouseMove event which
displays the Caption of the Title of the column the mouse is over on the caption of the form.
procedure TForm1.DBGrid1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
Col,
Row : Integer;
begin
Col := DBGrid1.MouseCoord(X, Y).X;
Row := DBGrid1.MouseCoord(X, Y).Y;
if (dgIndicator in DBGrid1.Options) then
Dec(Col);
if (Col >= 0) and (Col < DBGrid1.Columns.Count) then
Caption := DBGrid1.Columns[Col].Title.Caption
else
Caption := '';
end;
Note that the
if (dgIndicator in DBGrid1.Options) then
Dec(Col);
is to adjust the behaviour for correct operation if the dgIndicator option is turned off.
Obviously, instead of
Caption := DBGrid1.Columns[Col].Title.Caption
you could do
MenuItem.Caption := DBGrid1.Columns[Col].Title.Caption
to copy the column title to a menuitem's caption. I think you probably don't need to do any comparison of the Title.Caption's value with any hard-coded constants, but obviously that's your choice.
Btw, if you would rather access the name of the dataset field which is supplying the displayed values for the Column's contents, you can read the Column's FieldName property.

TChart : The check/unchecked event not working in ExtraLegendTool

I displayed an ExtraLegendTool with checkboxes but the checkbox event is not working.
Here is the code to display the ExtraLegend:
procedure TFRChart.TCChartAfterDraw(Sender: TObject);
begin
if CKDisplay.Checked then
begin
with ExtraLegend do
begin
Active:= True;
Series := TBarSeries(Self.FindComponent('SeriesTotal'));
with Legend do
begin
LegendStyle := lsAuto;
CheckBoxes := True;
//MaxNumRows := 3;
CustomPosition := True;
Left:= TCChart.Legend.Left;
Top:= TCChart.Legend.ShapeBounds.Bottom + 10;
Width := TCChart.Legend.Width;
ShapeBounds.Right := TCChart.Legend.ShapeBounds.Bottom;
DrawLegend;
end;
end;
end;
end;
Please check the folowing image for more details :
As you can see in the image, I have 2 legends one of type 'Chart1.Legend.LegendStyle := lsSeriesGroups' and the other one is an ExtraLegend.
How can I NOT display all the blue bars for all the series groups when I uncheck the blue series in the Extralegend?
You can use the ExtraLegendTool Clicked() function at the chart OnClick event to get the item of the legend that has been clicked. Then, you can activate/deactivate any series you desire.
This simple example seems to work fine for me here:
procedure TForm1.Chart1Click(Sender: TObject);
var MousePos: TPoint;
index: Integer;
begin
MousePos:=Chart1.GetCursorPos;
index:=ChartTool1.Legend.Clicked(MousePos);
while (index>-1) and (index<Chart1.SeriesCount) do
begin
Chart1[index].Active:=not Chart1[index].Active;
index:=index+3;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
var i: Integer;
begin
Chart1.SeriesGroups.Add;
Chart1.SeriesGroups.Add;
Chart1.SeriesGroups[0].Name:='This is Group 1';
Chart1.SeriesGroups[1].Name:='This is Group 2';
for i:=0 to 9 do
with Chart1.AddSeries(TBarSeries) as TBarSeries do
begin
FillSampleValues(5);
if (i<3) then
begin
Chart1.SeriesGroups[0].Add(Chart1[i]);
StackGroup:=0;
end
else
begin
Chart1.SeriesGroups[1].Add(Chart1[i]);
StackGroup:=1;
end;
MultiBar:=mbStacked;
end;
Chart1.Legend.LegendStyle := lsSeriesGroups;
Chart1.Draw;
with ChartTool1 do
begin
Active:= True;
//Series := TBarSeries(Self.FindComponent('SeriesTotal'));
Series := Chart1[0];
with Legend do
begin
LegendStyle := lsAuto;
CheckBoxes := True;
MaxNumRows := 3;
CustomPosition := True;
Left:= Chart1.Legend.Left;
Top:= Chart1.Legend.ShapeBounds.Bottom + 10;
Width := Chart1.Legend.Width;
ShapeBounds.Right := Chart1.Legend.ShapeBounds.Bottom;
DrawLegend;
end;
end;
end;

Delphi GDIPLUS change image position

i am trying to achieve a simple task but by using GDI+ and i cannot find any example.
In my code i need to change an image position (top if to be more specific), but i have no idea if i can do it in a better way.
This is how i do it now:
procedure TForm2.Timer1Timer(Sender: TObject);
var
I: Integer;
begin
if image1.Top = -93 then
Begin
for I := -93 to -1 do
Begin
Sleep(10);
image1.Top := Image1.Top + 1;
Application.ProcessMessages;
End;
End else if image1.Top = 0 then
Begin
for I := 0 downto -92 do
Begin
Sleep(10);
image1.Top := Image1.Top - 1;
Application.ProcessMessages;
End;
End;
end;
Well it's pretty simple, but it does not go smooth, but jumps and redraws itself at each step.
I appreciate your help.
UPDATE:
Thanks to TLama and his inspiration i have found this GDIPlus implementation for delphi 2007
Moving control is a wrong way to animate anything, GDI+ independent. Instead, you should remember the position you want to change for the animation, modify it in the OnTimer event and tell the system that you want to invalidate the target control. Then in the control's OnPaint event you should render whatever you want by that position.
So as the first, replace your TImage component by a TPaintBox since the TImage is used mainly for static images, not for a dynamic rendering. Also use two timers. One for upward animation and one for downward animation.
The following code doesn't take into account approximation of a timer, and it uses less known Delphi 2009 GDI+ Library wrapper for Delphi:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, GdiPlus;
type
TForm1 = class(TForm)
Timer1: TTimer;
Timer2: TTimer;
PaintBox1: TPaintBox;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure Timer2Timer(Sender: TObject);
procedure PaintBox1Paint(Sender: TObject);
private
GPImage: IGPImage;
FImageTop: Integer;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
FImageTop := 0;
Timer1.Interval := 15;
Timer2.Interval := 15;
DoubleBuffered := True;
Timer1.Enabled := True;
Timer2.Enabled := False;
GPImage := TGPImage.Create('d:\Image.jpg');
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
// no need for the following line since it's a reference of the interface
// GPImage := nil;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
if (FImageTop > -93) then
begin
FImageTop := FImageTop - 1;
PaintBox1.Invalidate;
end
else
begin
Timer1.Enabled := False;
Timer2.Enabled := True;
end;
end;
procedure TForm1.Timer2Timer(Sender: TObject);
begin
if (FImageTop < 0) then
begin
FImageTop := FImageTop + 1;
PaintBox1.Invalidate;
end
else
begin
Timer2.Enabled := False;
Timer1.Enabled := True;
end;
end;
procedure TForm1.PaintBox1Paint(Sender: TObject);
var
GPGraphics: IGPGraphics;
begin
GPGraphics := TGPGraphics.Create(PaintBox1.Canvas.Handle);
GPGraphics.DrawImage(GPImage, 0, FImageTop);
end;
end.

How to create a pan from composite image in Delphi

I'm kind of new to delphi graphics methods and I'm stucked at creating a ... viewport , thats how I call it while i was doing it for a project. I'm sorry I can't provide any code for it but I'm stuck at the logic part , searching google pointed me to some OnPaint , Draw methods. But those are not what I'm trying to accomplish, since I have , for example:
A 1600x1000 background image anchored to the client's top/bottom/right and left.
Multiple TImage elements placed at set x/y coords.
A "hotspot" like a map element in HTML where I can set the clickable areas (for the images i'm placing at step 2)
No zoom needed.
And the most important thing, while the background is dragged, those TImages placed on top of the background need to be dragged too.
My logic (in HTML/jQuery) was to create a #viewportBinder (which was the div i was dragging, transparent bg), followed by another div inside it called #viewtown (1600x1000, the background) which contains the divs (those TImages) placed at set coordinates in CSS.
So when I am dragging the viewportBinder, jQuery sets the new x/y on the #viewport. Implicitly, the divs (TImages) inside the #viewport are moving because the parent was positioned relative.
Does anybody have any experience with this kind of project ? Any snippet of code ?
To be more specific i'll give you my html example of what i accomplised and what i want to port into Delphi code: http://www.youtube.com/watch?v=9iYqzvZFnGA
Sorry if i'm not clear enough, i have no starting point since I have no experience with this in delphi at all. (using RAD Studio 2010)
A very short example how it could be realized in an easy way.
You would use a Paintbox for painting, 1 Backimage, an array of Records with info and transparent pngimages.
Canvas can be manipulated in offset/zoom/rotation.
Moving and hitdetection would happen in mousedown and mousemove.
It's not complete, but might give you an idea how it could be done.
[delphi]
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls,PNGImage, StdCtrls;
type
TBuilding=Record // record for building informations
Pos:TPoint;
PNGImage:TPngImage;
// what ever needed
End;
TBuildingArray=Array of TBuilding; // array of buildings
TForm1 = class(TForm)
PaintBox1: TPaintBox;
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure PaintBox1Paint(Sender: TObject);
procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Button1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private-Deklarationen }
FXoffs,FYOffs,FZoom:Double; // offset and zoom for painting
FMouseDownPoint:TPoint;
FBackGroundPNG:TPNGImage;
FBuildingArray:TBuildingArray;
procedure Check4Hit(X, Y: Integer);
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
implementation
uses Math;
{$R *.dfm}
Procedure SetCanvasZoomAndRotation(ACanvas:TCanvas;Zoom:Double;Angle:Double;CenterpointX,CenterpointY:Double);
var
form : tagXFORM;
Winkel:Double;
begin
Winkel := DegToRad(Angle);
SetGraphicsMode(ACanvas.Handle, GM_ADVANCED);
SetMapMode(ACanvas.Handle,MM_ANISOTROPIC);
form.eM11 := Zoom * cos( Winkel);
form.eM12 := Zoom *Sin( Winkel) ;
form.eM21 := Zoom * (-sin( Winkel));
form.eM22 := Zoom * cos( Winkel) ;
form.eDx := CenterpointX;
form.eDy := CenterpointY;
SetWorldTransform(ACanvas.Handle,form);
end;
Procedure ResetCanvas(ACanvas:TCanvas);
begin
SetCanvasZoomAndRotation(ACanvas , 1, 0, 0,0);
end;
procedure TForm1.FormCreate(Sender: TObject);
var
Path:String;
i:Integer;
begin
FZoom := 1;
DoubleBuffered := true;
Path := ExtractFilePath(Paramstr(0));
FBackGroundPNG:=TPNGImage.Create;
FBackGroundPNG.LoadFromFile(Path + 'infect.png');
SetLength(FBuildingArray,3);
for I := 0 to High(FBuildingArray) do
begin
FBuildingArray[i].PNGImage := TPngImage.Create;
FBuildingArray[i].PNGImage.LoadFromFile(Path + Format('B%d.png',[i]));
FBuildingArray[i].Pos.X := I * 300;
FBuildingArray[i].Pos.Y := Random(1000);
end;
end;
procedure TForm1.FormDestroy(Sender: TObject);
var
i:Integer;
begin
for I := 0 to High(FBuildingArray) do
begin
FBuildingArray[i].PNGImage.Free;
end;
FBackGroundPNG.Free;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if FZoom=0.5 then FZoom := 1 else FZoom := 0.5;
PaintBox1.Invalidate;
end;
procedure TForm1.Check4Hit(X,Y:Integer);
var
i,Index:Integer;
R:TRect;
P:TPoint;
begin
index := -1;
for I := 0 to High(FBuildingArray) do
begin
R := Rect(FBuildingArray[i].Pos.X,FBuildingArray[i].Pos.Y
,FBuildingArray[i].Pos.X + FBuildingArray[i].PNGImage.Width
,FBuildingArray[i].Pos.Y + FBuildingArray[i].PNGImage.Height);
P := Point(Round((x - FXOffs)/FZoom) ,Round((y - FYOffs)/FZoom));
if PtInRect(R,P) then Index := i;
end;
if index > -1 then
begin
Caption := Format('Last hit %d',[index]);
end
else Caption := 'No Hit';
end;
procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Check4Hit(X,Y);
FMouseDownPoint.X := X;
FMouseDownPoint.Y := Y;
end;
procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if ssLeft in Shift then
begin
FXoffs := -( FMouseDownPoint.X - X) ;
FYoffs := -( FMouseDownPoint.Y - Y) ;
if FXoffs>0 then FXoffs := 0;
if FYoffs>0 then FYoffs := 0;
PaintBox1.Invalidate;
end;
end;
procedure TForm1.PaintBox1Paint(Sender: TObject);
var
i:Integer;
begin
SetCanvasZoomAndRotation(PaintBox1.Canvas,FZoom,0,FXoffs,FYOffs);
PaintBox1.Canvas.Draw(0,0,FBackGroundPNG);
for I := 0 to High(FBuildingArray) do
begin
PaintBox1.Canvas.Draw(FBuildingArray[i].Pos.X,FBuildingArray[i].Pos.Y,FBuildingArray[i].PNGImage);
end;
end;
end.
[/delphi]
Sorry, but for last several years i working with Lazarus instead of Delphi. But tis article will be informative: http://wiki.lazarus.freepascal.org/Developing_with_Graphics#Create_a_custom_control_which_draws_itself
About relative coordinates nothing to say - it is simple.
About dragging: A long time ago in a galaxy far, far away.. that was something like:
// To start dragging
procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
// To stop dragging
procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;
// To perform dragging
procedure WMMouseMove(var Message: TWMMouseMove); message WM_MOUSEMOVE;

how can i free a Tpanel That have a TbitBtn that calls to free the Tpanel

I create a Custom Tpanel and inside I put various Custom Components ...
procedure Panel_Comp(Location: TWinControl; NumOfComp: Integer;Left,Top,Height,width:Integer);
begin
MyPanel := TsPanel.Create(Conf);
MyPanel.Name := 'MyPanel' + IntToStr(NumOfComp);
MyPanel.Parent := Location;
MyPanel.Left := Left;
MyPanel.Top := Top;
MyPanel.Height := Height;
MyPanel.Width := width;
MyPanel.Caption := '';
end;
and i call it like this
Panel_Comp(Conf.ScrollBox1,1,8,10,70,322);
in the same logic i put inside the new panel other custom components including a tBitbtn the have a onclick event..
procedure BitBtn_Comp(Location: TWinControl; NumOfComp: Integer; Left,Top,Height,Width,ImageNum: Integer);
begin
MyBitBtn := TBitBtn.Create(Conf);
......
MyBitBtn.tag := NumOfComp;
MyBitBtn.OnClick:= Conf.CloseCurrentPanel;
end;
In the main Forn The TConf.CloseCurrentPanel;
procedure TConf.CloseCurrentPanel(Sender: TObject);
var
panelComp: TComponent;
begin
panelComp := FindComponentEx('Conf.MyPanel'+ IntToStr(TBitBtn(Sender).tag);
TPanel(panelComp).Free;
Application.ProcessMessages;
end;
When I call that I get access violation...
I think is something that I must free all the components inside the panel before free the panel but how I free the BitBtn before the panel and continue the action of the click event?
Here is the FindComponetEx function instead you need it...
function FindComponentEx(const Name: string): TComponent;
var
FormName: string;
CompName: string;
P: Integer;
Found: Boolean;
Form: TForm;
I: Integer;
begin
// Split up in a valid form and a valid component name
P := Pos('.', Name);
if P = 0 then
begin
raise Exception.Create('No valid form name given');
end;
FormName := Copy(Name, 1, P - 1);
CompName := Copy(Name, P + 1, High(Integer));
Found := False;
// find the form
for I := 0 to Screen.FormCount - 1 do
begin
Form := Screen.Forms[I];
// case insensitive comparing
if AnsiSameText(Form.Name, FormName) then
begin
Found := True;
Break;
end;
end;
if Found then
begin
for I := 0 to Form.ComponentCount - 1 do
begin
Result := Form.Components[I];
if AnsiSameText(Result.Name, CompName) then Exit;
end;
end;
Result := nil;
end;
The AV occurs because you are destroying a component (MyBitBtn) while it is still handling Windows messages. The solution is to postpone the destruction until later via PostMessage, similar to this:
unit Unit1;
interface
uses
Windows,
Messages,
SysUtils,
Variants,
Classes,
Graphics,
Controls,
Forms,
Dialogs,
ExtCtrls,
StdCtrls;
const
UM_DESTROYPANEL = WM_APP + 623; // some "unique" number; UM = user message
type
TConf = class(TForm)
Panel1: TPanel;
Button1: TButton;
procedure Button1Click(Sender: TObject);
strict private
procedure UMDestroyPanel(var Message: TMessage); message UM_DESTROYPANEL;
public
{ Public-Deklarationen }
end;
var
Conf: TConf;
implementation
{$R *.dfm}
procedure TConf.Button1Click(Sender: TObject);
begin
PostMessage(Handle, UM_DESTROYPANEL, 0, 0);
end;
procedure TConf.UMDestroyPanel(var Message: TMessage);
begin
Panel1.Free;
end;
end.
If needed you can use wParam and lParam to pass through parameters like so:
procedure TConf.Button1Click(Sender: TObject);
begin
PostMessage(Handle, UM_DESTROYPANEL, WPARAM(Panel1), 0);
end;
procedure TConf.UMDestroyPanel(var Message: TMessage);
begin
TObject(Message.WParam).Free;
end;
EDIT:
In your situation I'd probably rewrite TConf.CloseCurrentPanel like this:
procedure TConf.CloseCurrentPanel(Sender: TObject);
var
panelComp: TComponent;
begin
panelComp := FindComponentEx('Conf.MyPanel'+ IntToStr(TBitBtn(Sender).Tag);
PostMessage(Handle, UM_DESTROYPANEL, WPARAM(panelComp), 0);
end;
Alternatively you can pass through the Tag (might be the better solution because there's less casting involved):
procedure TConf.CloseCurrentPanel(Sender: TObject);
begin
PostMessage(Handle, UM_DESTROYPANEL, TBitBtn(Sender).Tag, 0);
end;
procedure TConf.UMDestroyPanel(var Message: TMessage);
var
panelComp: TComponent;
begin
panelComp := FindComponentEx('Conf.MyPanel'+ IntToStr(Message.WParam));
panelComp.Free;
end;
AFAICT the Application.ProcessMessages isn't needed.
procedure TConf.CloseCurrentPanel(Sender: TObject);
var
panelComp: TComponent;
begin
panelComp := FindComponentEx('Conf.MyPanel'+ IntToStr(TBitBtn(Sender).tag);
//Where you need to determine 'PanelComp' if there are.
if Assigned(panelComp) and (PanelComp is TPanel) then
TPanel(panelComp).Free;
Application.ProcessMessages;
end;

Resources