Komponenty - Unit1.pl - Programowanie

Jak za pomocą Drag&Drop przenieść item z jednego ListBox do drugiego?

Na początku w obu listach ustaw DragMode na dmAutomatic. Następnie ustaw dla nich wspólne procedury DragOver oraz DragDrop :

procedure TForm1.ListBox1DragDrop(Sender, Source: TObject; X, Y: Integer); 

begin 

If (Source is TListBox) then begin 

  TListBox(Sender).Items.Add(TListBox(Source).Items.Strings[TListBox(Source).ItemIndex]); 

  TListBox(Source).Items.Delete(TListBox(Source).ItemIndex); 

end; 


end; 


procedure TForm1.ListBox1DragOver(Sender, Source: TObject; X, Y: Integer; 

  State: TDragState; var Accept: Boolean); 

begin 

  Accept := True; 

end;

procedure TForm1.ListBox1DragDrop(Sender, Source: TObject; X, Y: Integer);

begin

If (Source is TListBox) then begin

TListBox(Sender).Items.Add(TListBox(Source).Items.Strings[TListBox(Source).ItemIndex]);

TListBox(Source).Items.Delete(TListBox(Source).ItemIndex);

end;

procedure TForm1.ListBox1DragOver(Sender, Source: TObject; X, Y: Integer;

State: TDragState; var Accept: Boolean);

begin

Accept := True;

end;

Autor: Nakiel

Czytaj więcej →

Jak w pętli odwołać się do wszystkich komponentów?

Jeżeli chcesz się odwołać do np. wszystkich TEdit, użyj następującego kodu:

for i := 0 to Form1.ComponentCount - 1 do

  if (Form1.Components is TEdit) then 

    (Form1.Components as TEdit).Text := '' ;

for i := 0 to Form1.ComponentCount - 1 do

if (Form1.Components is TEdit) then

(Form1.Components as TEdit).Text := '' ;

ComponentCount przechowuje liczbę komponentów znajdujących się na formie. Components to tablica zawierająca kolejne komponenty. Sprawdzamy operatorem is, czy dany komponent jest klasy TEdit, a jeśli tak, to każemy, za pomocą operatora as, uznać go za TEdit. Dzięki temu mamy dostęp do metod i […]

Czytaj więcej →

Jak w Memo programowo przejść kursorem na początek danej linii?

Posłuż się następującym kodem:

var wers : integer; // wers to numer linii

begin 

  wers := 3; 

  Memo1.SelStart := Memo1.Perform(EM_LINEINDEX, wers - 1, 0); 

  Memo1.SetFocus; 

end;

var wers : integer; // wers to numer linii

begin

wers := 3;

Memo1.SelStart := Memo1.Perform(EM_LINEINDEX, wers - 1, 0);

Memo1.SetFocus;

end;

Autor: Nakiel

Czytaj więcej →

Jak utworzyć nową kopię istniejącego egzemplarza klasy?

Użyj tego kodu :

TSample = class(TPersistent) 

 private 

   a: integer; 

 public 

   procedure Assign(source : TPersistent); override; 

end; 



var 

  Form1: TForm1; 


implementation 


{$R *.dfm} 


function CopyObject(Src,Dest : TObject; Related : Boolean = FALSE) : Boolean; 

var Mem  : Pointer; 

    Size : Integer; 

begin 


  if(NOT Assigned(Src)) OR (NOT Assigned(Dest)) then begin 

     Result := FALSE; 

     Exit; 

  end; 


  if(NOT Related)OR (Src.InheritsFrom(Dest.ClassType)) OR (Dest.InheritsFrom(Src.ClassType)) then 

  begin 

   if Src.InstanceSize < Dest.InstanceSize then 

    Size := Src.InstanceSize else 

    Size := Dest.InstanceSize; 

    Dec(Size,4); { opuszczamy pierwsze 4 bajty tablicy } 

    GetMem(Mem,Size); 

    if Size < Dest.InstanceSize then 

      System.FillChar(PByteArray(Dest)^[4],Size,0); 

    System.Move(PByteArray(Src)^[4],PByteArray(Dest)^[4],Size); 

    FreeMem(Mem); 

    Result := TRUE; 

  end else 

    Result := FALSE; 

end; 



procedure TSample.Assign(source : TPersistent); 

begin 

  if NOT CopyObject(Source,Self,TRUE) then 

     inherited Assign(Source); 

end; 



procedure TForm1.Button1Click(Sender: TObject); 

var 

 S1, S2 :TSample; 


begin 

  S1 := TSample.Create; 

  S1.a := 1; 


  S2 := TSample.Create; 


  S2.Assign(S1); 


  S2.a := 10; 


  caption := inttostr(S1.a); 

end;

100

101

102

103

104

105

106

107

108

109

110

111

112

113

TSample = class(TPersistent)

private

a: integer;

public

procedure Assign(source : TPersistent); override;

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

function CopyObject(Src,Dest : TObject; Related : Boolean = FALSE) : Boolean;

var Mem : Pointer;

Size : Integer;

begin

if(NOT Assigned(Src)) OR (NOT Assigned(Dest)) then begin

Result := FALSE;

Exit;

end;

if(NOT Related)OR (Src.InheritsFrom(Dest.ClassType)) OR (Dest.InheritsFrom(Src.ClassType)) then

begin

if Src.InstanceSize < Dest.InstanceSize then

Size := Src.InstanceSize else

Size := Dest.InstanceSize;

Dec(Size,4); { opuszczamy pierwsze 4 bajty tablicy }

GetMem(Mem,Size);

if Size < Dest.InstanceSize then

System.FillChar(PByteArray(Dest)^[4],Size,0);

System.Move(PByteArray(Src)^[4],PByteArray(Dest)^[4],Size);

FreeMem(Mem);

Result := TRUE;

end else

Result := FALSE;

end;

procedure TSample.Assign(source : TPersistent);

begin

if NOT CopyObject(Source,Self,TRUE) then

inherited Assign(Source);

end;

procedure TForm1.Button1Click(Sender: TObject);

var

S1, S2 :TSample;

begin

S1 := TSample.Create;

S1.a := 1;

S2 := TSample.Create;

S2.Assign(S1);

S2.a := 10;

caption := inttostr(S1.a);

end;

Autor: Nakiel

Czytaj więcej →

Jak uniemożliwić wpisanie do Edit znaków innych niż cyfry?

W OnKeyPress Edit wpisz:

if not (Key in ['0'..'9' , ',' , #8]) then Key := #0 ;

1	if not (Key in ['0'..'9' , ',' , #8]) then Key := #0 ;

Kod ten pozwala wprowadzać liczby całkowite oraz zmiennoprzecinkowe. #8 jest kodem Backspace – gdybyś usunął kod tego znaku, to niemożliwe było by kasowanie zawartości Edit. Autor: Iskar

Czytaj więcej →

Jak umożliwić ruszanie ikonami w TListView jak na pulpicie?

W sekcji private naszej formy, na której jest TListView umieszczamy dwie zmienne:

  MovingIcon: Boolean;

  MovingP, StartP: TPoint;

MovingIcon: Boolean;

MovingP, StartP: TPoint;

Następnie do zdarzeń OnMouseDown, OnMouseMove i OnMouseUp naszego ListView’a podpinamy kolejne procedury: (w przykładzie główna forma nazywa się TfrmTest, a nasz ListView lvTest)

procedure TfrmTest.lvTestMouseDown(Sender: TObject; Button: TMouseButton;

  Shift: TShiftState; X, Y: Integer);

begin

  if lvTest.ItemIndex <> -1 then

    begin

      MovingIcon := True;

      MovingP := Point(X, Y);

      StartP := lvTest.Items[lvTest.ItemIndex].Position;

    end;

end;


procedure TfrmTest.lvTestMouseMove(Sender: TObject; Shift: TShiftState; X,

  Y: Integer);

begin

  if MovingIcon then

    with lvTest.Items[lvTest.ItemIndex] do

      SetPosition(Point(StartP.X + (X - MovingP.X), StartP.Y + (Y - MovingP.Y)));

end;


procedure TfrmTest.lvTestMouseUp(Sender: TObject; Button: TMouseButton;

  Shift: TShiftState; X, Y: Integer);

begin

  MovingIcon := False

end;

procedure TfrmTest.lvTestMouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

begin

if lvTest.ItemIndex <> -1 then

begin

MovingIcon := True;

MovingP := Point(X, Y);

StartP := lvTest.Items[lvTest.ItemIndex].Position;

end;

procedure TfrmTest.lvTestMouseMove(Sender: TObject; Shift: TShiftState; X,

Y: Integer);

begin

if MovingIcon then

with lvTest.Items[lvTest.ItemIndex] do

SetPosition(Point(StartP.X + (X - MovingP.X), StartP.Y + (Y - MovingP.Y)));

end;

procedure TfrmTest.lvTestMouseUp(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

begin

MovingIcon := False

end;

Autor: Kkkas

Czytaj więcej →

Jak sortować kolumny TListView w układzie raportu?

W Inspektorze Obiektów dla komponentu TListView ustawiamy

ViewStyle na vsReport

1	ViewStyle na vsReport

Deklarujemy dwie zmienne globalne

Var

kierunekSortowania:integer=-1;

kolumnaDoSortowania:integer=1;

Var

kierunekSortowania:integer=-1;

kolumnaDoSortowania:integer=1;

W zdarzeniach onColumnClick i OnCompare wprowadzamy poniższe linie kodu

procedure TForm1.ListView1ColumnClick(Sender: TObject;

  Column: TListColumn);

begin

  KolumnaDoSortowania := Column.Index;

 (Sender as TCustomListView).AlphaSort;

  case kierunekSortowania of

    1 :kierunekSortowania:=-1;

    -1:kierunekSortowania:=1;

  end;

end;

procedure TForm1.ListView1Compare(Sender: TObject; Item1, Item2: TListItem;

  Data: Integer; var Compare: Integer);

var

   i :integer;

begin

  if KolumnaDoSortowania = 0 then

    Compare := kierunekSortowania*CompareText(Item1.Caption,Item2.Caption)

  else begin

   i := KolumnaDoSortowania - 1;

   Compare := kierunekSortowania*CompareText(Item1.SubItems,Item2.SubItems);

  end;

end;

procedure TForm1.ListView1ColumnClick(Sender: TObject;

Column: TListColumn);

begin

KolumnaDoSortowania := Column.Index;

(Sender as TCustomListView).AlphaSort;

case kierunekSortowania of

1 :kierunekSortowania:=-1;

-1:kierunekSortowania:=1;

end;

procedure TForm1.ListView1Compare(Sender: TObject; Item1, Item2: TListItem;

Data: Integer; var Compare: Integer);

var

i :integer;

begin

if KolumnaDoSortowania = 0 then

Compare := kierunekSortowania*CompareText(Item1.Caption,Item2.Caption)

else begin

i := KolumnaDoSortowania - 1;

Compare := kierunekSortowania*CompareText(Item1.SubItems,Item2.SubItems);

end;

Po kliknięciu na tytule dowolnej kolumny sortujem całą zawartość raportu TListView A do Z a po ponownym kliknieciu w tą samą kolumnę zmienimy kierunek sortowania na przeciwny. Metoda działa dla każdej kolumny Autor: Oksal

Czytaj więcej →

Jak do TListView dodać programowo item?

procedure TForm1.FormCreate(Sender: TObject); 


const 

  Names: array[0..5, 0..1] of string = ( 

    ('Rubble', 'Barney'), 

    ('Michael', 'Johnson'), 

    ('Bunny', 'Bugs'), 

    ('Silver', 'HiHo'), 

    ('Simpson', 'Bart'), 

    ('Squirrel', 'Rocky') 

    ); 


var 

  I: Integer; 

  NewColumn: TListColumn; 

  ListItem: TListItem; 

  ListView: TListView; 

begin 

  ListView := TListView.Create(Self); 

  with ListView do 

  begin 

    Parent := Self; 

    Align := alClient; 


    ViewStyle := vsReport; 


    NewColumn := Columns.Add; 

    NewColumn.Caption := 'Last'; 

    NewColumn := Columns.Add; 

    NewColumn.Caption := 'First'; 


    for I := Low(Names) to High(Names) do 

    begin 

      ListItem := Items.Add; 

      ListItem.Caption := Names[I][0]; 

      ListItem.SubItems.Add(Names[I][1]); 

    end; 

  end; 

end;

procedure TForm1.FormCreate(Sender: TObject);

const

Names: array[0..5, 0..1] of string = (

('Rubble', 'Barney'),

('Michael', 'Johnson'),

('Bunny', 'Bugs'),

('Silver', 'HiHo'),

('Simpson', 'Bart'),

('Squirrel', 'Rocky')

);

var

I: Integer;

NewColumn: TListColumn;

ListItem: TListItem;

ListView: TListView;

begin

ListView := TListView.Create(Self);

with ListView do

begin

Parent := Self;

Align := alClient;

ViewStyle := vsReport;

NewColumn := Columns.Add;

NewColumn.Caption := 'Last';

NewColumn := Columns.Add;

NewColumn.Caption := 'First';

for I := Low(Names) to High(Names) do

begin

ListItem := Items.Add;

ListItem.Caption := Names[I][0];

ListItem.SubItems.Add(Names[I][1]);

end;

Kod z helpa Delphi. Zmiana nazwy w ListItem.Caption := Names[I][0]; Autor: Toster

Czytaj więcej →

Co zrobić, abym mógł używać polskie litery w Delphi?

Należy dodać odpowiednią wartość w rejestrze. Z menu Start wybierz Uruchom, wpisz regedit. W edytorze rejestru odszukaj klucz HKEY_CURRENT_USER/SOFTWARE/Borland/Delphi/7.0/Editor/Options. Z menu Edycja wybierz Nowy/Wartość ciągu. Nadaj nowej wartości nazwę NoCtrlAltKeys. Dwukrotnie kliknij na nowo dodaną wartość oraz wpisz w oknie cyfrę 1. Gotowe. Możesz też ściągnąć ze strony Borlanda odpowiedni klucz rejestru: http://www.borland.pl/download/pl_key.shtml Wystarczy go […]

Czytaj więcej →