home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 October / Chip_2001-10_cd1.bin / zkuste / delphi / kolekce / d6 / FRCLX.ZIP / SOURCE / FR_ChBox.pas < prev    next >
Pascal/Delphi Source File  |  2001-07-06  |  5KB  |  204 lines
  1.  
  2. {******************************************}
  3. {                                          }
  4. {           FastReport CLX v2.4            }
  5. {         Checkbox Add-In Object           }
  6. {                                          }
  7. { Copyright (c) 1998-2001 by Tzyganenko A. }
  8. {                                          }
  9. {******************************************}
  10.  
  11. unit FR_ChBox;
  12.  
  13. interface
  14.  
  15. {$I FR.inc}
  16.  
  17. uses
  18.   SysUtils, Types, Classes, QGraphics, QMenus, FR_Class;
  19.  
  20. type
  21.   TfrCheckBoxObject = class(TComponent)  // fake component
  22.   end;
  23.  
  24.   TfrCheckBoxView = class(TfrView)
  25.   private
  26.     procedure DrawCheck(ARect: TRect; Checked: Boolean);
  27.   protected
  28.     procedure SetPropValue(Index: String; Value: Variant); override;
  29.     function GetPropValue(Index: String): Variant; override;
  30.   public
  31.     CheckStyle: Byte;
  32.     CheckColor: TColor;
  33.     constructor Create; override;
  34.     procedure Draw(Canvas: TCanvas); override;
  35.     procedure StreamOut(Stream: TStream); override;
  36.     procedure ExportData; override;
  37.     procedure LoadFromStream(Stream: TStream); override;
  38.     procedure SaveToStream(Stream: TStream); override;
  39.     procedure DefinePopupMenu(Popup: TPopupMenu); override;
  40.     procedure DefineProperties; override;
  41.   end;
  42.  
  43.  
  44. const
  45.   csCross = 0;
  46.   csCheck = 1;
  47.  
  48.  
  49. implementation
  50.  
  51. uses FR_Intrp, FR_Pars, FR_Utils, FR_Const, Variants;
  52.  
  53. {$R *.res}
  54.  
  55. constructor TfrCheckBoxView.Create;
  56. begin
  57.   inherited Create;
  58.   FrameWidth := 2;
  59.   FrameTyp := 15;
  60.   BaseName := 'Check';
  61.   CheckStyle := 0;
  62.  
  63.   frConsts['csCross'] := csCross;
  64.   frConsts['csCheck'] := csCheck;
  65. end;
  66.  
  67. procedure TfrCheckBoxView.DefineProperties;
  68. begin
  69.   inherited DefineProperties;
  70.   AddEnumProperty('CheckStyle', 'csCross;csCheck', [csCross,csCheck]);
  71.   AddProperty('CheckColor', [frdtColor], nil);
  72.   AddProperty('DataField', [frdtOneObject, frdtHasEditor, frdtString], frFieldEditor);
  73. end;
  74.  
  75. procedure TfrCheckBoxView.SetPropValue(Index: String; Value: Variant);
  76. begin
  77.   inherited SetPropValue(Index, Value);
  78.   Index := AnsiUpperCase(Index);
  79.   if Index = 'CHECKSTYLE' then
  80.     CheckStyle := Value
  81.   else if Index = 'CHECKCOLOR' then
  82.     CheckColor := Value;
  83. end;
  84.  
  85. function TfrCheckBoxView.GetPropValue(Index: String): Variant;
  86. begin
  87.   Index := AnsiUpperCase(Index);
  88.   Result := inherited GetPropValue(Index);
  89.   if Result <> Null then Exit;
  90.   if Index = 'CHECKSTYLE' then
  91.     Result := CheckStyle
  92.   else if Index = 'CHECKCOLOR' then
  93.     Result := CheckColor
  94. end;
  95.  
  96. procedure TfrCheckBoxView.DrawCheck(ARect: TRect; Checked: Boolean);
  97. var
  98.   s: String;
  99. begin
  100.   if Checked then
  101.   with Canvas, ARect do
  102.   begin
  103.     Font.Name := 'Wingdings';
  104.     Font.Color := CheckColor;
  105.     Font.Style := [];
  106.     Font.Height := (DRect.Bottom - DRect.Top);
  107.     Font.CharSet := DEFAULT_CHARSET;
  108.     if CheckStyle = 0 then
  109.       s := #251 else
  110.       s := #252;
  111.     TextOut(DRect.Left + (DRect.Right - DRect.Left - TextWidth(s)) div 2,
  112.       DRect.Top, s);
  113.   end;
  114. end;
  115.  
  116. procedure TfrCheckBoxView.Draw(Canvas: TCanvas);
  117. var
  118.   Res: Boolean;
  119. begin
  120.   BeginDraw(Canvas);
  121.   Memo1.Assign(Memo);
  122.   CalcGaps;
  123.   ShowBackground;
  124.   Res := False;
  125.   if (DocMode = dmPrinting) and (Memo1.Count > 0) and (Memo1[0] <> '') then
  126.     Res := Memo1[0][1] <> '0';
  127.   if DocMode = dmDesigning then
  128.     Res := True;
  129.   DrawCheck(DRect, Res);
  130.   ShowFrame;
  131.   RestoreCoord;
  132. end;
  133.  
  134. procedure TfrCheckBoxView.StreamOut(Stream: TStream);
  135. var
  136.   SaveTag: String;
  137. begin
  138.   BeginDraw(Canvas);
  139.   Memo1.Assign(Memo);
  140.   CurReport.InternalOnEnterRect(Memo1, Self);
  141.   frInterpretator.DoScript(Script);
  142.   if not Visible then Exit;
  143.  
  144.   SaveTag := Tag;
  145.   if (Tag <> '') and (Pos('[', Tag) <> 0) then
  146.     ExpandVariables(Tag);
  147.  
  148.   if Memo1.Count > 0 then
  149.     Memo1[0] := IntToStr(Trunc(frParser.Calc(Memo1[0])));
  150.   Stream.Write(Typ, 1);
  151.   frWriteString(Stream, ClassName);
  152.   SaveToStream(Stream);
  153.  
  154.   Tag := SaveTag;
  155. end;
  156.  
  157. procedure TfrCheckBoxView.ExportData;
  158. var
  159.   s: String;
  160. begin
  161.   inherited;
  162.   s := '';
  163.   if (Memo.Count > 0) and (Memo[0] <> '') then
  164.     if Memo[0][1] <> '0' then
  165.       s := 'X';
  166.   CurReport.InternalOnExportText(DRect, x, y, s, 0{FrameTyp}, Self);
  167. end;
  168.  
  169. procedure TfrCheckBoxView.DefinePopupMenu(Popup: TPopupMenu);
  170. begin
  171.   // no specific items in popup menu
  172. end;
  173.  
  174. procedure TfrCheckBoxView.LoadFromStream(Stream: TStream);
  175. begin
  176.   inherited LoadFromStream(Stream);
  177.   if frVersion > 23 then
  178.   begin
  179.     Stream.Read(CheckStyle, 1);
  180.     Stream.Read(CheckColor, 4);
  181.   end;
  182. end;
  183.  
  184. procedure TfrCheckBoxView.SaveToStream(Stream: TStream);
  185. begin
  186.   inherited SaveToStream(Stream);
  187.   Stream.Write(CheckStyle, 1);
  188.   Stream.Write(CheckColor, 4);
  189. end;
  190.  
  191.  
  192. var
  193.   Bmp: TBitmap;
  194.  
  195. initialization
  196.   Bmp := TBitmap.Create;
  197.   Bmp.LoadFromResourceName(hInstance, 'FR_CHECKBOXVIEW');
  198.   frRegisterObject(TfrCheckBoxView, Bmp, SInsCheckBox);
  199.  
  200. finalization
  201.   Bmp.Free;
  202.  
  203. end.
  204.