Пример использования в приложении списка объектов на основе класса TList
Материал из DRKB
Пример использования в приложении списка объектов на основе класса TList[править | править код]
Пример использования в приложении списка объектов на основе класса TList
uMain.dfm
object MainForm: TMainForm
Left = 225
Top = 141
Width = 499
Height = 435
Caption = 'DemoList'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
Position = poScreenCenter
OnClose = FormClose
OnCreate = FormCreate
OnMouseDown = FormMouseDown
PixelsPerInch = 96
TextHeight = 13
object ListBtn: TBitBtn
Left = 8
Top = 8
Width = 113
Height = 25
Caption = #1055#1086#1082#1072#1079#1072#1090#1100' '#1089#1087#1080#1089#1086#1082
TabOrder = 0
OnClick = ListBtnClick
end
object ClearBtn: TBitBtn
Left = 128
Top = 8
Width = 113
Height = 25
Caption = #1054#1095#1080#1089#1090#1080#1090#1100' '#1087#1086#1083#1077
TabOrder = 1
OnClick = ClearBtnClick
end
object DelBtn: TBitBtn
Left = 248
Top = 8
Width = 113
Height = 25
Caption = #1054#1095#1080#1089#1090#1080#1090#1100' '#1089#1087#1080#1089#1086#1082
TabOrder = 2
OnClick = DelBtnClick
end
object SortBtn: TBitBtn
Left = 368
Top = 8
Width = 113
Height = 25
Caption = #1057#1086#1088#1090#1080#1088#1086#1074#1072#1090#1100
TabOrder = 3
OnClick = SortBtnClick
end
end
uMain.pas
unit uMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons;
type
TMainForm = class(TForm)
ListBtn: TBitBtn;
ClearBtn: TBitBtn;
DelBtn: TBitBtn;
SortBtn: TBitBtn;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ListBtnClick(Sender: TObject);
procedure ClearBtnClick(Sender: TObject);
procedure DelBtnClick(Sender: TObject);
procedure SortBtnClick(Sender: TObject);
private
PixList: TList;
PixNum: Integer;
public
{ Public declarations }
end;
TMyPixel = class(TObject)
FX: Integer;
FY: Integer;
FText: Integer;
constructor Create(X, Y, Num: Integer);
procedure SetPixel;
end;
var
MainForm: TMainForm;
implementation
{$R *.dfm}
const PixColor = clRed;
var CurPixel: TMyPixel;
constructor TMyPixel.Create(X, Y, Num: Integer);
begin
inherited Create;
FX := X;
FY := Y;
FText := Num;
SetPixel;
end;
procedure TMyPixel.SetPixel;
begin
MainForm.Canvas.PolyLine([Point(FX, FY), Point(FX, FY)]);
MainForm.Canvas.TextOut(FX + 1, FY + 1, IntToStr(FText));
end;
function PixCompare(Item1, Item2: Pointer): Integer;
var Pix1, Pix2: TMyPixel;
begin
Pix1 := Item1;
Pix2 := Item2;
Result := Pix1.FX - Pix2.FX;
end;
procedure TMainForm.FormCreate(Sender: TObject);
begin
PixList := TList.Create;
PixNum := 1; {Счетчик точек}
Canvas.Pen.Color := PixColor; {Цвет точки}
Canvas.Pen.Width := 3; {Размер точки}
Canvas.Brush.Color := Color; {Цвет фора текста равен цвету формы}
end;
procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
PixList.Free;
end;
procedure TMainForm.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
PixList.Add(TMyPixel.Create(X, Y, PixNum));
Inc(PixNum);
end;
procedure TMainForm.ListBtnClick(Sender: TObject);
var i: Integer;
begin
with PixList do
for i := 0 to Count - 1 do
begin
CurPixel := Items[i];
CurPixel.SetPixel;
end;
end;
procedure TMainForm.ClearBtnClick(Sender: TObject);
begin
Canvas.FillRect(Rect(0, 0, Width, Height));
end;
procedure TMainForm.DelBtnClick(Sender: TObject);
begin
PixList.Clear;
PixNum := 1;
end;
procedure TMainForm.SortBtnClick(Sender: TObject);
var i: Integer;
begin
PixList.Sort(PixCompare);
with PixList do
for i := 0 to Count - 1 do TMyPixel(Items[i]).FText := i + 1;
end;
end.
Author: Akella
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 00310