home *** CD-ROM | disk | FTP | other *** search
/ Chip 1998 March / Chip_1998-03_cd.bin / zkuste / delphi / WhiteAnts / CONTSTRM.ZIP / Mainfrm.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-01-09  |  6.3 KB  |  224 lines
  1. unit Mainfrm;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, Buttons, ExtCtrls, StdCtrls, Menus, StrmSamp;
  8.  
  9. type
  10.   TMainForm = class(TForm)
  11.     ListBox: TListBox;
  12.     Toolbar: TPanel;
  13.     AddBtn: TSpeedButton;
  14.     EditBtn: TSpeedButton;
  15.     DelBtn: TSpeedButton;
  16.     OpenBtn: TSpeedButton;
  17.     SaveBtn: TSpeedButton;
  18.     NewBtn: TSpeedButton;
  19.     MainMenu: TMainMenu;
  20.     File1: TMenuItem;
  21.     Open1: TMenuItem;
  22.     Save1: TMenuItem;
  23.     New1: TMenuItem;
  24.     N1: TMenuItem;
  25.     Exit1: TMenuItem;
  26.     Edit1: TMenuItem;
  27.     Add1: TMenuItem;
  28.     Change1: TMenuItem;
  29.     Delete1: TMenuItem;
  30.     SortNameBtn: TSpeedButton;
  31.     SortValueBtn: TSpeedButton;
  32.     Header: THeader;
  33.     SaveDialog: TSaveDialog;
  34.     OpenDialog: TOpenDialog;
  35.     procedure FormCreate(Sender: TObject);
  36.     procedure Exit1Click(Sender: TObject);
  37.     procedure ListBoxDrawItem(Control: TWinControl; Index: Integer;
  38.       Rect: TRect; State: TOwnerDrawState);
  39.     procedure HeaderSized(Sender: TObject; ASection, AWidth: Integer);
  40.     procedure EditBtnClick(Sender: TObject);
  41.     procedure SamplesChange(Sender: TObject);
  42.     procedure AddBtnClick(Sender: TObject);
  43.     procedure DelBtnClick(Sender: TObject);
  44.     procedure FormDestroy(Sender: TObject);
  45.     procedure SortOnChange(Sender: TObject);
  46.     procedure NewBtnClick(Sender: TObject);
  47.     procedure OpenBtnClick(Sender: TObject);
  48.     procedure SaveBtnClick(Sender: TObject);
  49.   private
  50.     FSamples: TSampleList;
  51.     function EditSample(Sample: TSample): Boolean;
  52.   public
  53.     { Public declarations }
  54.   end;
  55.  
  56. var
  57.   MainForm: TMainForm;
  58.  
  59. implementation
  60.  
  61. uses EditFrm, Filters;
  62.  
  63. {$R *.DFM}
  64.  
  65. procedure TMainForm.FormCreate(Sender: TObject);
  66. begin
  67.   { fix up scaling problems }
  68.   Font.Size := Font.Size;
  69.   { create a 'long term' collection which will contain our samples.
  70.     Note TSampleList sets OwnesItems := True in it's constructor }
  71.   FSamples := TSampleList.Create;
  72.   { wire the OnChange event to synchronize the GUI with the sample list }
  73.   FSamples.OnChange := SamplesChange;
  74. end;
  75.  
  76. function TMainForm.EditSample(Sample: TSample): Boolean;
  77. begin
  78.   SampleForm.Sample := Sample;
  79.   Result := SampleForm.Execute;
  80. end;
  81.  
  82. procedure TMainForm.Exit1Click(Sender: TObject);
  83. begin
  84.   Close;
  85. end;
  86.  
  87. procedure TMainForm.ListBoxDrawItem(Control: TWinControl; Index: Integer;
  88.   Rect: TRect; State: TOwnerDrawState);
  89. var Sample: TSample;
  90. begin
  91.   { use owner draw style to draw sample on listboxes canvas, note that
  92.     the ListBox.Items property is ignored }
  93.   with ListBox.Canvas do
  94.   begin
  95.     Sample := FSamples[Index];
  96.     FillRect(Rect);
  97.     TextOut(Rect.Left + 2, Rect.Top, Sample.Name);
  98.     Inc(Rect.Left, Header.SectionWidth[0]);
  99.     FillRect(Rect);
  100.     TextOut(Rect.Left + 2, Rect.Top, IntToStr(Sample.Value));
  101.   end;
  102. end;
  103.  
  104. procedure TMainForm.HeaderSized(Sender: TObject; ASection,
  105.   AWidth: Integer);
  106. begin
  107.   ListBox.Invalidate;
  108. end;
  109.  
  110. procedure TMainForm.EditBtnClick(Sender: TObject);
  111. var Idx: Integer;
  112. begin
  113.   Idx := ListBox.ItemIndex;
  114.   if EditSample(FSamples[Idx]) then
  115.   { put back the edited and maybe changed sample, this will re-order it
  116.     and notify the GUI through OnChange }
  117.     FSamples[Idx] := FSamples[Idx];
  118. end;
  119.  
  120. procedure TMainForm.SamplesChange(Sender: TObject);
  121. var I: Integer;
  122. begin
  123.   ListBox.Items.BeginUpdate;
  124.   try
  125.     { Synchronize listbox.items with number of items in list, simply
  126.       add an empty string to the listbox. routine could be optimized
  127.       e.g. by using a listbox which does not store it's strings
  128.       or using the Delphi 2.0 ListViewer class }
  129.     ListBox.Items.Clear;
  130.     for I := 0 to FSamples.Count - 1 do
  131.       ListBox.Items.Add('');
  132.   finally
  133.     ListBox.Items.EndUpdate;
  134.   end;
  135. end;
  136.  
  137. procedure TMainForm.AddBtnClick(Sender: TObject);
  138. var Sample: TSample;
  139. begin
  140.   { Create a sample, if the user cancel the operation, free it again }
  141.   Sample := TSample.Create;
  142.   if EditSample(Sample) then
  143.     { this will add sample to FSamples and also dispatch OnChange }
  144.     FSamples.Add(Sample)
  145.   else
  146.     Sample.Free;
  147. end;
  148.  
  149. procedure TMainForm.DelBtnClick(Sender: TObject);
  150. begin
  151.   { Since FSample owns it's items, the TSample at Index is also free-ed }
  152.   FSamples.Delete(ListBox.ItemIndex);
  153. end;
  154.  
  155. procedure TMainForm.FormDestroy(Sender: TObject);
  156. begin
  157.   { do not forget to clean - up }
  158.   FSamples.Free;
  159. end;
  160.  
  161. procedure TMainForm.SortOnChange(Sender: TObject);
  162. begin
  163.   { See TSampleList.Compare for SortOn property }
  164.   if SortNameBtn.Down then FSamples.SortOn := soName else FSamples.SortOn := soValue;
  165. end;
  166.  
  167. procedure TMainForm.NewBtnClick(Sender: TObject);
  168. begin
  169.   { Just free the samples, not the sample list }
  170.   FSamples.Clear;
  171. end;
  172.  
  173. procedure TMainForm.OpenBtnClick(Sender: TObject);
  174. var F: TFilter;
  175.     Temp: TSampleList;
  176. begin
  177.   if OpenDialog.Execute then
  178.   begin
  179.     { TBufFileStream is a TFilter descendant which owns a TFileStream and
  180.       buffers it's IO. You need to pass the buf size as additional parameter }
  181.     F := TBufFileStream.Create(OpenDialog.FileName, fmOpenRead, 4096);
  182.     try
  183.       { This is the famous F.Get call. F.Get will read a TStreamable from Filter
  184.         therefore typecast it to TSampleList. See TSample.Load, TContainer.Load etc. }
  185.       Temp := F.Get as TSampleList;
  186.       if Assigned(Temp) then
  187.       begin
  188.         { free old list, which ownes it's sample instances }
  189.         FSamples.Free;
  190.         { now assign loaded samples to FSamples }
  191.         FSamples := Temp;
  192.         { assign the event handler again }
  193.         FSamples.OnChange := SamplesChange;
  194.         { we have manually switched samples, so notify GUI }
  195.         SamplesChange(Self);
  196.         { list always loaded as sorted on name }
  197.         SortnameBtn.Down := True;
  198.       end;
  199.     finally
  200.       { since the BufFileStream filter owns it's base stream. it will automatically
  201.         free it's filestream }
  202.       F.Free;
  203.     end;
  204.   end;
  205. end;
  206.  
  207. procedure TMainForm.SaveBtnClick(Sender: TObject);
  208. var F: TFilter;
  209. begin
  210.   if SaveDialog.Execute then
  211.   begin
  212.     F := TBufFileStream.Create(SaveDialog.FileName, fmCreate, 4096);
  213.     try
  214.       { This is the famous Filter.Put method, which will
  215.         write a TStreamable descendant to F, See TSample.Store, TContainer.Store etc. }
  216.       F.Put(FSamples);
  217.     finally
  218.       F.Free;
  219.     end;
  220.   end;
  221. end;
  222.  
  223. end.
  224.