rm_chbox.pas

中小企业管理系统------ ERP系统原代码

{*****************************************}
{                                         }
{             Report Machine v2.0         }
{         Checkbox Add-In Object          }
{                                         }
{*****************************************}

unit RM_chbox;

interface

{$I RM.inc}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Menus, RM_Class
{$IFDEF Delphi6}, Variants{$ENDIF};

type
  TRMCheckBoxObject = class(TComponent) // fake component
  end;

  TRMCheckBoxView = class(TRMView)
  private
    procedure DrawCheck(ARect: TRect; Checked: Boolean);
  protected
  	function GetViewCommon: string; override;
    procedure SetPropValue(Index: string; Value: Variant); override;
    function GetPropValue(Index: string): Variant; override;
  public
    CheckStyle: Byte;
    CheckColor: TColor;
    constructor Create; override;
    procedure Draw(aCanvas: TCanvas); override;
    procedure StreamOut(Stream: TStream); override;
    procedure ExportData; override;
    procedure LoadFromStream(Stream: TStream); override;
    procedure SaveToStream(Stream: TStream); override;
    procedure DefinePopupMenu(Popup: TPopupMenu); override;
    procedure DefineProperties; override;
  end;

const
  csCross = 0;
  csCheck = 1;

implementation

uses RM_CmpReg, RM_Intrp, RM_Pars, RM_Utils, RM_Const;

constructor TRMCheckBoxView.Create;
begin
  inherited Create;
//  FrameTyp := 15;
  BaseName := 'Check';
  CheckStyle := 0;

  RMConsts['csCross'] := csCross;
  RMConsts['csCheck'] := csCheck;
end;

procedure TRMCheckBoxView.DefineProperties;
begin
  inherited DefineProperties;
  AddEnumProperty('CheckStyle', 'csCross;csCheck', [csCross, csCheck], nil);
  AddProperty('CheckColor', [RMdtColor], nil);
  AddProperty('DataField', [RMdtOneObject, RMdtHasEditor, RMdtString], RMFieldEditor);

  AddProperty('OnBeforePrint', [RMdtHasEditor, RMdtOneObject], RMScript_BeforePrintEditor);
  AddProperty('OnAfterPrint', [RMdtHasEditor, RMdtOneObject], RMScript_AfterPrintEditor);
end;

procedure TRMCheckBoxView.SetPropValue(Index: string; Value: Variant);
begin
  inherited SetPropValue(Index, Value);
  Index := AnsiUpperCase(Index);
  if Index = 'CHECKSTYLE' then
    CheckStyle := Value
  else if Index = 'CHECKCOLOR' then
    CheckColor := Value;
end;

function TRMCheckBoxView.GetPropValue(Index: string): Variant;
begin
  Index := AnsiUpperCase(Index);
  Result := inherited GetPropValue(Index);
  if Result <> Null then Exit;
  if Index = 'CHECKSTYLE' then
    Result := CheckStyle
  else if Index = 'CHECKCOLOR' then
    Result := CheckColor;
end;

procedure TRMCheckBoxView.DrawCheck(ARect: TRect; Checked: Boolean);
var
  s: string;
begin
  if Checked then
  begin
    with Canvas do
    begin
      Font.Name := 'Wingdings';
      Font.Color := CheckColor;
      Font.Style := [];
      Font.Height := -(aRect.Bottom - aRect.Top);
{$IFNDEF Delphi2}
      Font.CharSet := DEFAULT_CHARSET;
{$ENDIF}
      if CheckStyle = 0 then s := #251 else s := #252;

      ExtTextOut(Handle, aRect.Left + (aRect.Right - aRect.Left - TextWidth(s)) div 2,
        aRect.Top, ETO_CLIPPED, @aRect, PChar(s), 1, nil);
    end;
  end;
end;

procedure TRMCheckBoxView.Draw(aCanvas: TCanvas);
var
  Res: Boolean;
begin
  BeginDraw(aCanvas);
  Memo1.Assign(Memo);
  CalcGaps;
  ShowBackground;
  Res := False;
  if (DocMode = dmPrinting) and (Memo1.Count > 0) and (Memo1[0] <> '') then
    Res := Memo1[0][1] <> '0';
  if DocMode = dmDesigning then
    Res := True;
  DrawCheck(DRect, Res);
  ShowFrame;
  RestoreCoord;
end;

procedure TRMCheckBoxView.StreamOut(Stream: TStream);
var
  SaveTag: string;
begin
  BeginDraw(Canvas);
  Memo1.Assign(Memo);
  CurReport.InternalOnEnterRect(Memo1, Self);
  RMInterpretator.DoScript(Script);
  if not Visible then Exit;

  SaveTag := Tag;
  if (Tag <> '') and (Pos('[', Tag) <> 0) then
    ExpandVariables(Tag);

  if Memo1.Count > 0 then
    Memo1[0] := IntToStr(Trunc(RMParser.Calc(Memo1[0])));

  Stream.Write(Typ, 1);
  RMWriteString(Stream, ClassName);
  SaveToStream(Stream);

  RMInterpretator.DoScript(Script_AfterPrint);
  Tag := SaveTag;
end;

procedure TRMCheckBoxView.ExportData;
var
  s: string;
begin
  inherited;
  s := '';
  if (Memo.Count > 0) and (Memo[0] <> '') then
  begin
    if Memo[0][1] <> '0' then
      s := 'X';
  end;
  CurReport.InternalOnExportText(DRect, x, y, s, 0, Self);
end;

procedure TRMCheckBoxView.DefinePopupMenu(Popup: TPopupMenu);
begin
  // no specific items in popup menu
end;

procedure TRMCheckBoxView.LoadFromStream(Stream: TStream);
var
	UseFontWingdings: Boolean;
begin
  inherited LoadFromStream(Stream);
  if RMVersion > 23 then
  begin
    Stream.Read(CheckStyle, 1);
    Stream.Read(CheckColor, 4);
  end;
  if (RMVersion >= 27) and (RMVersion < 29) then
  begin
    Stream.Read(UseFontWingdings, 1);
  end;
end;

procedure TRMCheckBoxView.SaveToStream(Stream: TStream);
begin
	LVersion := 0;
  inherited SaveToStream(Stream);
  Stream.Write(CheckStyle, 1);
  Stream.Write(CheckColor, 4);
end;

function TRMCheckBoxView.GetViewCommon: string;
begin
	Result := '[CheckBox]';
end;

initialization
  RMRegisterObjectByRes(TRMCheckBoxView, 'RM_CHBOXOBJECT', RMLoadStr(SInsCheckBox), nil);

finalization

end.



//此源码由程序太平洋收集整理发布,任何人都可自由转载,但需保留本站信息
//╭⌒╮┅~ ¤　欢迎光临程序太平洋╭⌒╮
//╭⌒╭⌒╮╭⌒╮～╭⌒╮  ︶  ,︶︶
//,︶︶︶︶,''︶~~ ,''~︶︶　 ,''
//╔　╱◥███◣═╬╬╬╬╬╬╬╬╬╗
//╬ ︱田︱田 田 ︱　　　　　　　　　 ╬
//╬　　　　　　　http://www.5ivb.net ╬
//╬　 ╭○╮●　                   　╬
//╬　　/■\/■\　　                  ╬
//╬　　 <|　||　   有希望,就有成功！ ╬
//╬　　　　　　　　　　　　　　　　　╬
//╚╬╬╬╬╬╬╬╬╬╬╗  ╔╬╬╬╬╝
//
//说明：
//专业提供VB、．NET、Delphi、ASP、PB源码下载
//包括:程序源码,控件,商业源码,系统方案，开发工具，书籍教程，技术文档