home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 October / Chip_2001-10_cd1.bin / zkuste / delphi / kolekce / d6 / FRCLX.ZIP / SOURCE / FR_Var.pas < prev    next >
Pascal/Delphi Source File  |  2001-07-03  |  4KB  |  181 lines
  1.  
  2. {******************************************}
  3. {                                          }
  4. {           FastReport CLX v2.4            }
  5. {             Variables form               }
  6. {                                          }
  7. { Copyright (c) 1998-2001 by Tzyganenko A. }
  8. {                                          }
  9. {******************************************}
  10.  
  11. unit FR_Var;
  12.  
  13. interface
  14.  
  15. {$I FR.inc}
  16.  
  17. uses
  18.   SysUtils, Types, Classes, QGraphics, QControls,
  19.   QForms, QDialogs, QStdCtrls, FR_Const, QExtCtrls;
  20.  
  21. type
  22.   TfrVarForm = class(TForm)
  23.     VarLB: TListBox;
  24.     CategoryLB: TListBox;
  25.     Button1: TButton;
  26.     Button2: TButton;
  27.     Image1: TImage;
  28.     Image2: TImage;
  29.     procedure FormActivate(Sender: TObject);
  30.     procedure FormCreate(Sender: TObject);
  31.     procedure FormDeactivate(Sender: TObject);
  32.     procedure CategoryLBClick(Sender: TObject);
  33.     procedure VarLBDblClick(Sender: TObject);
  34.     procedure CategoryLBDrawItem(Sender: TObject; Index: Integer;
  35.       ARect: TRect; State: TOwnerDrawState; var Handled: Boolean);
  36.   private
  37.     { Private declarations }
  38.     function CurVal: String;
  39.     function CurDataSet: String;
  40.     procedure GetVariables;
  41.     procedure GetSpecValues;
  42.     procedure FillCategoryLB;
  43.     procedure Localize;
  44.   public
  45.     { Public declarations }
  46.     SelectedItem: String;
  47.   end;
  48.  
  49. var
  50.   frVarForm: TfrVarForm;
  51.  
  52. implementation
  53.  
  54. {$R *.xfm}
  55.  
  56. uses FR_Class, FR_Utils, FR_Ctrls;
  57.  
  58. var
  59.   LastCategory: String;
  60.   
  61.  
  62. function TfrVarForm.CurVal: String;
  63. begin
  64.   Result := '';
  65.   with VarLB do
  66.   if ItemIndex <> -1 then
  67.     Result := Items[ItemIndex];
  68. end;
  69.  
  70. function TfrVarForm.CurDataSet: String;
  71. begin
  72.   Result := '';
  73.   with CategoryLB do
  74.     if ItemIndex <> -1 then
  75.       Result := Items[ItemIndex];
  76. end;
  77.  
  78. procedure TfrVarForm.FillCategoryLB;
  79. var
  80.   s: TStringList;
  81. begin
  82.   s := TStringList.Create;
  83.   CurReport.Dictionary.GetCategoryList(s);
  84.   s.Add((SSystemVariables));
  85.   CategoryLB.Items.Assign(s);
  86.   s.Free;
  87. end;
  88.  
  89. procedure TfrVarForm.CategoryLBClick(Sender: TObject);
  90. begin
  91.   if CurDataSet = (SSystemVariables) then
  92.     GetSpecValues else
  93.     GetVariables;
  94. end;
  95.  
  96. procedure TfrVarForm.GetVariables;
  97. begin
  98.   CurReport.Dictionary.GetVariablesList(CategoryLB.Items[CategoryLB.ItemIndex],
  99.     VarLB.Items);
  100. end;
  101.  
  102. procedure TfrVarForm.GetSpecValues;
  103. begin
  104.   with VarLB.Items do
  105.   begin
  106.     Clear;
  107.     Add(SVar1);
  108.     Add(SVar3);
  109.     Add(SVar4);
  110.     Add(SVar5);
  111.     Add(SVar6);
  112.     Add(SVar7);
  113.     Add(SVar8);
  114.     Add(SVar9);
  115.   end;
  116. end;
  117.  
  118. procedure TfrVarForm.Localize;
  119. begin
  120.   Caption := S53440;
  121.   Button1.Caption := (SOk);
  122.   Button2.Caption := (SCancel);
  123. end;
  124.  
  125. procedure TfrVarForm.FormCreate(Sender: TObject);
  126. begin
  127.   Localize;
  128. end;
  129.  
  130. procedure TfrVarForm.FormActivate(Sender: TObject);
  131. begin
  132.   FillCategoryLB;
  133.   with CategoryLB do
  134.     if Items.IndexOf(LastCategory) <> -1 then
  135.       ItemIndex := Items.IndexOf(LastCategory) else
  136.       ItemIndex := 0;
  137.   CategoryLBClick(nil);
  138. end;
  139.  
  140. procedure TfrVarForm.FormDeactivate(Sender: TObject);
  141. begin
  142.   if ModalResult = mrOk then
  143.     if CurDataSet <> (SSystemVariables) then
  144.       SelectedItem := CurVal
  145.     else
  146.       if VarLB.ItemIndex > 0 then
  147.         SelectedItem := frSpecFuncs[VarLB.ItemIndex + 1] else
  148.         SelectedItem := frSpecFuncs[0];
  149.   LastCategory := CategoryLB.Items[CategoryLB.ItemIndex];
  150. end;
  151.  
  152. procedure TfrVarForm.VarLBDblClick(Sender: TObject);
  153. begin
  154.   ModalResult := mrOk;
  155. end;
  156.  
  157. procedure TfrVarForm.CategoryLBDrawItem(Sender: TObject; Index: Integer;
  158.   ARect: TRect; State: TOwnerDrawState; var Handled: Boolean);
  159. var
  160.   Image: TImage;
  161.   r: TRect;
  162. begin
  163.   r := ARect;
  164.   r.Right := r.Left + 18;
  165.   r.Bottom := r.Top + 16;
  166.   OffsetRect(r, 2, 0);
  167.   with TListBox(Sender) do
  168.   begin
  169.     Canvas.FillRect(ARect);
  170.     if Sender = CategoryLB then
  171.       Image := Image1 else
  172.       Image := Image2;
  173.     frDrawTransparent(Canvas, r.Left, r.Top, Image.Picture.Bitmap);
  174.     Canvas.TextOut(ARect.Left + 20, ARect.Top + 1, Items[Index]);
  175.   end;
  176. end;
  177.  
  178.  
  179. end.
  180.  
  181.