Archiwum FAQs - Strona 3 z 8 - Unit1.pl - Programowanie

Jak zapisać Itemy TTreeView?

Posłuż się tym kodem:

procedure WriteNodeData(const f:TFileStream; node:TTreeNode); 

var 

   temp,t: integer; 

   st: array[0..255] of char; 

begin 

   //zapis nazwy 

   temp := Length(node.Text); 

   f.Write(temp, sizeof(integer)); 

   for t := 0 to temp-1 do 

      st[t] := node.text[t+1]; 

   f.Write(st, temp); 

   //zapis dzieci 

   //ile dzieci 

   temp := node.Count; 

   f.Write(temp, sizeof(integer)); 

   for t := 0 to temp-1 do 

      WriteNodeData(f, node.Item[t]); 

end; 


procedure ReadNodeData(const f:TFileStream; node:TTreeNode); 

var 

   temp,t: integer; 

   st: array[0..255] of char; 

   s: string; 

   nod: TTreeNode; 

begin 


   //odczyt nazwy 

   f.Read( temp, sizeof(integer)); 

   f.read(st, temp); 

   s := ''; 

   for t := 0 to temp-1 do 

      s := s + st[t]; 


   nod := form1.TreeView1.Items.AddChild(node, s); 


   //ile dzieci 

   f.Read( temp, sizeof(integer)); 

   //zapis dzieci 

   for t := 0 to temp-1 do 

      ReadNodeData(f, nod); 

end; 


procedure TForm1.SaveData1Click(Sender: TObject); 

var 

   f: TFileStream; 

   t,y: integer; 

begin 

   f := TFileStream.Create('tree.dat',fmCreate); 

   t :=TreeView1.Items.Count; 

   y := 0; 

   for t := 0 to TreeView1.Items.Count -1 do 

      if TreeView1.items[t].Level =0 then inc(y); 


   f.Write(y,sizeof(integer)); 

   for t := 0 to TreeView1.Items.Count -1 do 

      if TreeView1.items[t].Level =0 then WriteNodeData(f, TreeView1.items[t]); 

   f.free; 

end; 


procedure TForm1.LoadData2Click(Sender: TObject); 

var 

   f: TFileStream; 

   t,y: integer; 

begin 

   TreeView1.Items.Clear; 

   f := TFileStream.Create('tree.dat',fmOpenRead); 

   f.read(y, sizeof(integer)); 

   for t := 0 to y-1 do 

      ReadNodeData(f, nil); 

   f.free; 

end;

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

procedure WriteNodeData(const f:TFileStream; node:TTreeNode);

var

temp,t: integer;

st: array[0..255] of char;

begin

//zapis nazwy

temp := Length(node.Text);

f.Write(temp, sizeof(integer));

for t := 0 to temp-1 do

st[t] := node.text[t+1];

f.Write(st, temp);

//zapis dzieci

//ile dzieci

temp := node.Count;

f.Write(temp, sizeof(integer));

for t := 0 to temp-1 do

WriteNodeData(f, node.Item[t]);

end;

procedure ReadNodeData(const f:TFileStream; node:TTreeNode);

var

temp,t: integer;

st: array[0..255] of char;

s: string;

nod: TTreeNode;

begin

//odczyt nazwy

f.Read( temp, sizeof(integer));

f.read(st, temp);

s := '';

for t := 0 to temp-1 do

s := s + st[t];

nod := form1.TreeView1.Items.AddChild(node, s);

//ile dzieci

f.Read( temp, sizeof(integer));

//zapis dzieci

for t := 0 to temp-1 do

ReadNodeData(f, nod);

end;

procedure TForm1.SaveData1Click(Sender: TObject);

var

f: TFileStream;

t,y: integer;

begin

f := TFileStream.Create('tree.dat',fmCreate);

t :=TreeView1.Items.Count;

y := 0;

for t := 0 to TreeView1.Items.Count -1 do

if TreeView1.items[t].Level =0 then inc(y);

f.Write(y,sizeof(integer));

for t := 0 to TreeView1.Items.Count -1 do

if TreeView1.items[t].Level =0 then WriteNodeData(f, TreeView1.items[t]);

f.free;

end;

procedure TForm1.LoadData2Click(Sender: TObject);

var

f: TFileStream;

t,y: integer;

begin

TreeView1.Items.Clear;

f := TFileStream.Create('tree.dat',fmOpenRead);

f.read(y, sizeof(integer));

for t := 0 to y-1 do

ReadNodeData(f, nil);

f.free;

end;

Autor: Toster

Czytaj więcej →

Jak ścieżkę do folderu, w którym znajduje się plik *.exe programu?

Należy skorzystać z funkcji ExtractFilePath, która zwraca ściężkę do podanego w parametrze pliku. Jako argument wysyłamy nazwę exeka, którą odczytujemy z Application.ExeName:

var 
sciezkaDoAplikacji : String ; 
begin 
sciezkaDoAplikacji := ExtractFilePath(Application.ExeName) ;

var

sciezkaDoAplikacji : String ;

begin

sciezkaDoAplikacji := ExtractFilePath(Application.ExeName) ;

Autor: Iskar

Czytaj więcej →

Jak otwierając naszym programem plik tekstowy wstawić jego zawartość do Memo?

Większość edytorów tekstowych posiada możliwość otwarcia pliku klikając na jego ikonę podczas przeglądania zawartości dysku. Aby również nasz program to potrafił wystarczy dodać krótki kod: W OnShow Formy wpisz :

If ParamStr(1) <> '' then 

  Memo1.Lines.LoadFromFile(ParamStr(1));

If ParamStr(1) <> '' then

Memo1.Lines.LoadFromFile(ParamStr(1));

Autor: Nakiel

Czytaj więcej →

Jak otrzymać datę ostatniej modyfikacji pliku?

Na początku utworzymy odpowiednią funkcję, która będzie zwracać obiekt klasy TDateTime, a nastepnie przy pomocy FormatDateTime wyświetlimy datę na ekranie. Oto kod:

function GetFileModifyDate(FileName: string): TDateTime; 

var 

  h: THandle; 

  Struct: TOFSTRUCT; 

  lastwrite: Integer; 

  t: TDateTime; 

begin 

  h := OpenFile(PChar(FileName), Struct, OF_SHARE_DENY_NONE); 

  try 

    if h <> HFILE_ERROR then 

    begin 

      lastwrite := FileGetDate(h); 

      Result    := FileDateToDateTime(lastwrite); 

    end; 

  finally 

    CloseHandle(h); 

  end; 

end; 


procedure TForm1.Button1Click(Sender: TObject); 

begin 

  if Opendialog1.Execute then 

    label1.Caption := FormatDateTime('dddd, d. mmmm yyyy hh:mm:ss', 

      GetFileModifyDate(Opendialog1.FileName)); 

end;

function GetFileModifyDate(FileName: string): TDateTime;

var

h: THandle;

Struct: TOFSTRUCT;

lastwrite: Integer;

t: TDateTime;

begin

h := OpenFile(PChar(FileName), Struct, OF_SHARE_DENY_NONE);

try

if h <> HFILE_ERROR then

begin

lastwrite := FileGetDate(h);

Result := FileDateToDateTime(lastwrite);

end;

finally

CloseHandle(h);

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

if Opendialog1.Execute then

label1.Caption := FormatDateTime('dddd, d. mmmm yyyy hh:mm:ss',

GetFileModifyDate(Opendialog1.FileName));

end;

Autor: Nakiel

Czytaj więcej →

Informacje o utworach MP3

Aby pobrać informacje na temat wykonawcy, tytułu, albumu, roku wydania oraz gatunku utworu z pliku MP3 to musimy odczytać jego ostatnie sektory. Ze względu na rozbudowaną strukturę tagów proponuję utworzyć osobny plik, w którym będzie znajdować się funkcją pobierająca dane … Oto jego kod źródłowy :

unit ID3;


interface


{$A+} { Honor packed }

{$Z1} { Byte storage for small enumerated types }



type

  //wykaz gatunków

  ID3Genre = (

    id3gBlues, id3gClassicRock, id3gCountry, 

    id3gDance, id3gDisco,id3gFunk, id3gGrunge,

    id3gHipHop, id3gJazz, id3gMetal, id3gNewAge,

    id3gOldies, id3gOther, id3gPop, id3gRNB, 

    id3gRap, id3gReggae,id3gRock, id3gTechno, 

    id3gIndustrial, id3gAlternative, id3gSka,

    id3gDeathMetal, id3gPranks, id3gSoundtrack,

    id3gEuroTechno,id3gAmbient, id3gTripHop, 

    id3gVocal, id3gJazzFunk, id3gFusion,id3gTrance,

    id3gClassical, id3gInstrumental, id3gAcid, 

    id3gHouse, id3gGame, id3gSoundClip, id3gGospel,

    id3gNoise, id3gAlternRock, id3gBass, id3gSoul,

    id3gPunk, id3gSpace, id3gMeditative, 

    id3gInstrumentalPop, id3gInstrumentalRock, 

    id3gEthnic, id3gGothic,id3gDarkwave, 

    id3gTechnoIndustrial, id3gElectronic, id3gPopFolk,

    id3gEurodance, id3gDream, id3gSouthernRock,

    id3gComedy, id3gCult, id3gGangsta, id3gTop40, 

    id3gChristianRap, id3gPopFunk, id3gJungle,

    id3gNativeAmerican, id3gCabaret, id3gNewWave,

    id3gPsychadelic, id3gRave, id3gShowtunes, id3gTrailer,

    id3gLoFi, id3gTribal, id3gAcidPunk, id3gAcidJazz, 

    id3gPolka, id3gRetro, id3gMusical, id3gRockNRoll,

    id3gHardRock, id3gFolk, id3gFolkRock,

    id3gNationalFolk, id3gSwing, id3gFastFusion, 

    id3gBebob, id3gLatin, id3gRevival, id3gCeltic, 

    id3gBluegrass, id3gAvantgarde, id3gGothicRock, 

    id3gProgressiveRock, id3gPsychedelicRock, id3gSymphonicRock,

    id3gSlowRock, id3gBigBand, id3gChorus, id3gEasyListening,

    id3gAcoustic, id3gHumour, id3gSpeech, id3gChanson,

    id3gOpera, id3gChamberMusic, id3gSonata, id3gSymphony,

    id3gBootyBass, id3gPrimus, id3gPornGroove, id3gSatire,

    id3gSlowJam, id3gClub, id3gTango, id3gSamba, id3gFolklore,

    id3gBallad,id3gPowerBallad, id3gRhythmicSoul, id3gFreestyle,

    id3gDuet, id3gPunkRock, id3gDrumSolo, id3gAcapella,

    id3gEuroHouse, id3gDanceHall

    );


  ID3Struct = packed record

    Magic: array [0..2 ] of Char; //identyfikator

    Title: array [0..29] of Char; //tytuł

    Artist: array [0..29] of Char; //artysta

    Album: array [0..29] of Char; //album

    Year: array [0..3 ] of Char; //rok

    Comment: array [0..29] of Char; //komentarz

    Genre: ID3Genre; // gatunek

  end;


const

  ID3Magic = 'TAG';

  ID3OffsetFromEnd = 128;

  //odległość od końca pliku zarezerwowana dla tagów

   

  ID3UnknowGenre = ID3Genre(255); // nieznany gatunek

  

  //tablica gatunków

  ID3GenreName: array [ID3Genre] of PChar = (

    'Blues', 'Classic Rock', 'Country', 'Dance', 

    'Disco', 'Funk', 'Grunge', 'Hip-Hop', 'Jazz',

    'Metal', 'New Age', 'Oldies', 'Other', 'Pop',

    'R&B', 'Rap', 'Reggae', 'Rock', 'Techno',

    'Industrial', 'Alternative', 'Ska', 'Death Metal',

    'Pranks', 'Soundtrack', 'Euro-Techno', 'Ambient',

    'Trip-Hop', 'Vocal', 'Jazz+Funk', 'Fusion', 'Trance',

    'Classical', 'Instrumental', 'Acid', 'House', 

    'Game', 'Sound Clip', 'Gospel', 'Noise', 'AlternRock',

    'Bass', 'Soul', 'Punk', 'Space', 'Meditative',

    'Instrumental Pop', 'Instrumental Rock', 'Ethnic',

    'Gothic', 'Darkwave', 'Techno-Industrial', 'Electronic',

    'Pop-Folk', 'Eurodance', 'Dream', 'Southern Rock', 

    'Comedy', 'Cult', 'Gangsta', 'Top 40', 'Christian Rap',

    'Pop/Funk', 'Jungle', 'Native American', 'Cabaret', 

    'New Wave', 'Psychadelic', 'Rave', 'Showtunes', 'Trailer',

    'Lo-Fi', 'Tribal', 'Acid Punk', 'Acid Jazz', 'Polka', 

    'Retro', 'Musical', 'Rock & Roll', 'Hard Rock', 'Folk',

    'Folk-Rock', 'National Folk', 'Swing', 'Fast Fusion', 

    'Bebob', 'Latin', 'Revival', 'Celtic', 'Bluegrass', 

    'Avantgarde', 'Gothic Rock', 'Progressive Rock', 

    'Psychedelic Rock', 'Symphonic Rock', 'Slow Rock', 

    'Big Band', 'Chorus', 'Easy Listening', 'Acoustic', 

    'Humour', 'Speech', 'Chanson', 'Opera', 'Chamber Music',

    'Sonata', 'Symphony', 'Booty Bass', 'Primus', 'Porn Groove',

    'Satire', 'Slow Jam', 'Club', 'Tango', 'Samba',

    'Folklore', 'Ballad', 'Power Ballad', 'Rhythmic Soul', 

    'Freestyle', 'Duet', 'Punk Rock', 'Drum Solo', 'Acapella',

    'Euro-House', 'Dance Hall'

    );


function GetMP3Infos(FN:String): id3struct; // FN - nazwa pliku


implementation


function GetMP3Infos(FN:String): id3struct;

var

  F: File of Byte;

  Tag: ID3Struct;

  HasTag: Boolean;

  GenreName: String;

  NewFN: String;

const

  Tab = #9;

begin

  AssignFile(F, fn);

  try

    Reset(F);

    try

      Seek(F, FileSize(F) - ID3OffsetFromEnd);

      BlockRead(F, Tag, SizeOf(Tag));

      HasTag := Tag.Magic = ID3Magic;

      if not HasTag then 

      begin

        FillChar(Tag, Sizeof(Tag), ' ');

        Tag.Magic := ID3Magic;

        Tag.Genre := ID3UnknowGenre;

      end;

      CloseFile(f);

      Result:=Tag;

    except

    end;

  except

  end;

end;


end.

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

219

220

221

222

223

224

225

226

227

228

229

230

231

232

233

234

235

236

237

238

239

240

241

242

243

244

245

246

247

248

249

250

251

252

253

254

255

256

257

258

259

unit ID3;

interface

{$A+} { Honor packed }

{$Z1} { Byte storage for small enumerated types }

type

//wykaz gatunków

ID3Genre = (

id3gBlues, id3gClassicRock, id3gCountry,

id3gDance, id3gDisco,id3gFunk, id3gGrunge,

id3gHipHop, id3gJazz, id3gMetal, id3gNewAge,

id3gOldies, id3gOther, id3gPop, id3gRNB,

id3gRap, id3gReggae,id3gRock, id3gTechno,

id3gIndustrial, id3gAlternative, id3gSka,

id3gDeathMetal, id3gPranks, id3gSoundtrack,

id3gEuroTechno,id3gAmbient, id3gTripHop,

id3gVocal, id3gJazzFunk, id3gFusion,id3gTrance,

id3gClassical, id3gInstrumental, id3gAcid,

id3gHouse, id3gGame, id3gSoundClip, id3gGospel,

id3gNoise, id3gAlternRock, id3gBass, id3gSoul,

id3gPunk, id3gSpace, id3gMeditative,

id3gInstrumentalPop, id3gInstrumentalRock,

id3gEthnic, id3gGothic,id3gDarkwave,

id3gTechnoIndustrial, id3gElectronic, id3gPopFolk,

id3gEurodance, id3gDream, id3gSouthernRock,

id3gComedy, id3gCult, id3gGangsta, id3gTop40,

id3gChristianRap, id3gPopFunk, id3gJungle,

id3gNativeAmerican, id3gCabaret, id3gNewWave,

id3gPsychadelic, id3gRave, id3gShowtunes, id3gTrailer,

id3gLoFi, id3gTribal, id3gAcidPunk, id3gAcidJazz,

id3gPolka, id3gRetro, id3gMusical, id3gRockNRoll,

id3gHardRock, id3gFolk, id3gFolkRock,

id3gNationalFolk, id3gSwing, id3gFastFusion,

id3gBebob, id3gLatin, id3gRevival, id3gCeltic,

id3gBluegrass, id3gAvantgarde, id3gGothicRock,

id3gProgressiveRock, id3gPsychedelicRock, id3gSymphonicRock,

id3gSlowRock, id3gBigBand, id3gChorus, id3gEasyListening,

id3gAcoustic, id3gHumour, id3gSpeech, id3gChanson,

id3gOpera, id3gChamberMusic, id3gSonata, id3gSymphony,

id3gBootyBass, id3gPrimus, id3gPornGroove, id3gSatire,

id3gSlowJam, id3gClub, id3gTango, id3gSamba, id3gFolklore,

id3gBallad,id3gPowerBallad, id3gRhythmicSoul, id3gFreestyle,

id3gDuet, id3gPunkRock, id3gDrumSolo, id3gAcapella,

id3gEuroHouse, id3gDanceHall

);

ID3Struct = packed record

Magic: array [0..2 ] of Char; //identyfikator

Title: array [0..29] of Char; //tytuł

Artist: array [0..29] of Char; //artysta

Album: array [0..29] of Char; //album

Year: array [0..3 ] of Char; //rok

Comment: array [0..29] of Char; //komentarz

Genre: ID3Genre; // gatunek

end;

const

ID3Magic = 'TAG';

ID3OffsetFromEnd = 128;

//odległość od końca pliku zarezerwowana dla tagów

ID3UnknowGenre = ID3Genre(255); // nieznany gatunek

//tablica gatunków

ID3GenreName: array [ID3Genre] of PChar = (

'Blues', 'Classic Rock', 'Country', 'Dance',

'Disco', 'Funk', 'Grunge', 'Hip-Hop', 'Jazz',

'Metal', 'New Age', 'Oldies', 'Other', 'Pop',

'R&B', 'Rap', 'Reggae', 'Rock', 'Techno',

'Industrial', 'Alternative', 'Ska', 'Death Metal',

'Pranks', 'Soundtrack', 'Euro-Techno', 'Ambient',

'Trip-Hop', 'Vocal', 'Jazz+Funk', 'Fusion', 'Trance',

'Classical', 'Instrumental', 'Acid', 'House',

'Game', 'Sound Clip', 'Gospel', 'Noise', 'AlternRock',

'Bass', 'Soul', 'Punk', 'Space', 'Meditative',

'Instrumental Pop', 'Instrumental Rock', 'Ethnic',

'Gothic', 'Darkwave', 'Techno-Industrial', 'Electronic',

'Pop-Folk', 'Eurodance', 'Dream', 'Southern Rock',

'Comedy', 'Cult', 'Gangsta', 'Top 40', 'Christian Rap',

'Pop/Funk', 'Jungle', 'Native American', 'Cabaret',

'New Wave', 'Psychadelic', 'Rave', 'Showtunes', 'Trailer',

'Lo-Fi', 'Tribal', 'Acid Punk', 'Acid Jazz', 'Polka',

'Retro', 'Musical', 'Rock & Roll', 'Hard Rock', 'Folk',

'Folk-Rock', 'National Folk', 'Swing', 'Fast Fusion',

'Bebob', 'Latin', 'Revival', 'Celtic', 'Bluegrass',

'Avantgarde', 'Gothic Rock', 'Progressive Rock',

'Psychedelic Rock', 'Symphonic Rock', 'Slow Rock',

'Big Band', 'Chorus', 'Easy Listening', 'Acoustic',

'Humour', 'Speech', 'Chanson', 'Opera', 'Chamber Music',

'Sonata', 'Symphony', 'Booty Bass', 'Primus', 'Porn Groove',

'Satire', 'Slow Jam', 'Club', 'Tango', 'Samba',

'Folklore', 'Ballad', 'Power Ballad', 'Rhythmic Soul',

'Freestyle', 'Duet', 'Punk Rock', 'Drum Solo', 'Acapella',

'Euro-House', 'Dance Hall'

);

function GetMP3Infos(FN:String): id3struct; // FN - nazwa pliku

implementation

function GetMP3Infos(FN:String): id3struct;

var

F: File of Byte;

Tag: ID3Struct;

HasTag: Boolean;

GenreName: String;

NewFN: String;

const

Tab = #9;

begin

AssignFile(F, fn);

try

Reset(F);

try

Seek(F, FileSize(F) - ID3OffsetFromEnd);

BlockRead(F, Tag, SizeOf(Tag));

HasTag := Tag.Magic = ID3Magic;

if not HasTag then

begin

FillChar(Tag, Sizeof(Tag), ' ');

Tag.Magic := ID3Magic;

Tag.Genre := ID3UnknowGenre;

end;

CloseFile(f);

Result:=Tag;

except

end;

except

end;

end.

Autor: Nakiel

Czytaj więcej →

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 →