ehutils.pas

很COOL的GRID控件

unit EHUtils;

interface

uses
  Windows, Classes,  Graphics, Controls, SysUtils,stdctrls;

type
  TCurrencyType = (ctHead,ctBody);

  TMoneyStyle   = Class(TPersistent)
  private
     FOnChange      : TNotifyEvent;
     FGrid          : TCustomControl;
     FCurrencyFont  : TFont;
     FCurrencySymbol: String;
     FCompartColor  : TColor;
     FKilobitColor  : TColor;
     FRadixColor    : TColor;
     FShowMinus     : Boolean;
     FShowZero      : Boolean;
     FMinusColor    : TColor;
     FLayout        : TTextLayout;
     FCHNWidth      : integer;
     FENGWidth      : integer;
     FCHNHeight     : integer;
     FENGHeight     : integer;
        FHeadFont: TFont;
        FDigits: Byte;
     procedure SetCurrencyFont(Value:Tfont);
     procedure SetCurrencySymbol(Value:String);
     procedure SetCompartColor(Value:TColor);
     procedure SetKilobitColor(Value:TColor);
     procedure SetRadixColor(Value:TColor);
     procedure SetShowMinus(Value:Boolean);
     procedure SetShowZero(Value:Boolean);
     procedure SetMinusColor(Value:TColor);
     procedure SetLayout(Value:TTextLayout);
     procedure FontChanged(Sender: TObject);
     procedure SetHeadFont(Value: TFont);
     procedure SetDigits(Value: Byte);
  public
     constructor Create(AGrid:TCustomControl);
     destructor  Destroy ; override;
     procedure Assign(Source: TPersistent); override;
     procedure CalcWidth;
     procedure Changed; dynamic;
     procedure paintHead(ACanvas:TCanvas;ARect:TRect);
     procedure paintBody(ACanvas:TCanvas;AText:String;hRect:TRect);
  published
     property CurrencyFont  : TFont         read  FCurrencyFont   write   SetCurrencyFont  ;
     property CurrencySymbol: String     read  FCurrencySymbol write   SetCurrencySymbol;
     property CompartColor  : TColor        read  FCompartColor   write   SetCompartColor  ;
     property KilobitColor  : TColor        read  FKilobitColor   write   SetKilobitColor  ;
     property RadixColor    : TColor        read  FRadixColor     write   SetRadixColor    ;
     property ShowMinus     : Boolean       read  FShowMinus      write   SetShowMinus     ;
     property ShowZero     : Boolean        read  FShowZero       write   SetShowZero     ;
     property MinusColor    : TColor        read  FMinusColor     write   SetMinusColor    ;
     property Layout        : TTextLayout   read  FLayout         write   SetLayout        ;
     property CHNWidth :integer read FCHNWidth;
     property ENGWidth :integer read FENGWidth;
     property CHNHeight:integer read FCHNHeight;
     property ENGHeight:integer read FENGHeight;
     property OnChange  : TNotifyEvent read FOnChange write FOnChange;
        property HeadFont: TFont read FHeadFont write SetHeadFont;
        property Digits: Byte read FDigits write SetDigits default 2;
 end;

TChinaAlignment=(agTopLeft, agTopCenter, agTopRight, agCenterLeft,
               agCenter, agCenterRight, agBottomLeft, agBottomCenter,
               agBottomRight);
{Misc Routines - Font}
function ChinaAlignRect(Alignment:TChinaAlignment; srcRect, destRect:TRect):TRect;
function ChinaAlignTextRect(Alignment:TChinaAlignment; const aString:String;
                          aRect:TRect;
                          Font:TFont; MultiLine, Accel:Boolean; flags:LongInt):TRect;
procedure ChinaDrawTextCalc(const aString:String; var aRect:TRect;
                          Font:TFont; MultiLine, Accel:Boolean;
                          BExt:Integer; flags:LongInt);
procedure ChinaDrawTextCalcExt(Canvas:TCanvas; const aString:String;
                          var aRect:TRect;
                          Font:TFont; MultiLine, Accel:Boolean;
                          BExt:Integer;flags:LongInt);
Function f_ReplaceAll(psString,psStr1,psStr2:string):String;
Function StrToCurrDef (value: String; defValue: Currency) : Currency;

implementation
uses
  consts;

Function f_ReplaceAll(psString,psStr1,psStr2:string):String;
var
  I: Integer;
  Source: string;
begin
  Source := psString;
  Result := '';
  repeat
    I := Pos(psStr1, Source);
    if I > 0 then begin
      Result := Result + Copy(Source, 1, I - 1) + psStr2;
      Source := Copy(Source, I + Length(psStr1), MaxInt);
    end
    else Result := Result + Source;
  until I <= 0;
end;

Function StrToCurrDef;
Begin
  If not TextToFloat (PChar (value), Result, fvCurrency) Then
    Result := defValue;

End;

procedure GetRectWH(aRect:TRect;var w,h:integer);
begin
  with aRect do
    begin
     w:=Right-Left;
     h:=Bottom-Top;
    end;
end;
{------------------------------------------------------------------------------}
function ChinaAlignRect(Alignment:TChinaAlignment; srcRect, destRect:TRect):TRect;
var
  sw, sh, dw, dh:Integer;
begin
  GetRectWH(srcRect, sw, sh);
  GetRectWH(destRect, dw, dh);
  case Alignment of
    agTopLeft, agTopCenter, agTopRight:result.Top:=0;
    agCenterLeft, agCenter, agCenterRight:result.Top:=(dh-sh) div 2;
    agBottomLeft, agBottomCenter, agBottomRight:result.Top:=dh-sh;
  end;
  case Alignment of
    agTopLeft, agCenterLeft, agBottomLeft:result.Left:=0;
    agTopCenter, agCenter, agBottomCenter:result.Left:=(dw-sw) div 2;
    agTopRight, agCenterRight, agBottomRight:result.Left:=dw-sw;
  end;
  with result do result:=Bounds(destRect.Left+Left, destRect.Top+Top, sw, sh);
end;

{------------------------------------------------------------------------------}
function ChinaAlignTextRect(Alignment:TChinaAlignment; const aString:String;
                          aRect:TRect;
                          Font:TFont; MultiLine, Accel:Boolean; flags:Longint):TRect;
var
  nRect:TRect;
begin
  nRect:=aRect; Dec(nRect.Right);
  ChinaDrawTextCalc(aString,nRect, Font, MultiLine,
                  Accel, 0, flags);
  result:=ChinaAlignRect(Alignment, nRect, aRect);
  IntersectRect(Result,Result,aRect);
end;


{calculates dimensions of strings (normal, rotated, multiline)}
{------------------------------------------------------------------------------}
procedure ChinaDrawTextCalc(const aString:String;  var aRect:TRect;
                          Font:TFont; MultiLine, Accel:Boolean; BExt:Integer; flags:Longint);
var
  aCanvas:TCanvas;
begin
  aCanvas:=TCanvas.Create;
  try
    ChinaDrawTextCalcExt(aCanvas, aString,  aRect, Font, MultiLine, Accel,BExt, flags);
  finally
    aCanvas.Free;
  end;
end;

{------------------------------------------------------------------------------}
procedure ChinaDrawTextCalcExt(Canvas:TCanvas; const aString:String;
                             var aRect:TRect;
                             Font:TFont; MultiLine, Accel:Boolean; BExt:Integer; flags:Longint);

var DC:HDC;
{    flag:Byte;
    sn, cs:real;
    tw, th, xm, ym, dummy:Integer;{}
    buffer:String;

begin
  buffer:=aString;
  DC := GetDC(0);
  try
    Canvas.Handle:=DC;
    Canvas.Font:=Font;
    flags:=flags or (DT_EXPANDTABS or DT_CALCRECT);
    if MultiLine then flags:=flags or DT_WORDBREAK;
    if (Length(buffer)=0) or (Accel and (buffer='&')) then buffer:=' ';
    if not Accel then Flags := Flags or DT_NOPREFIX;
    DrawTextEx(Canvas.Handle, PChar(buffer), Length(buffer), aRect, Flags, nil);
    Inc(aRect.Right, 2*(BExt+1));
    Inc(aRect.Bottom, 2*(BExt+1));
   finally
     Canvas.Handle := 0;
     ReleaseDC(0, DC);
   end;
end;

{ TMoneyStyle }
constructor TMoneyStyle.Create;
begin
  FGrid :=  AGrid;
  FCurrencySymbol:='￥';
  FDigits:=2;
  FCompartColor:= clSilver;
  FKilobitColor:=clGreen;
  FRadixColor:=clRed;
  FShowMinus:=True;
  FMinusColor:=clRed;
  FLayout:=tlCenter;
  FCurrencyFont:=TFont.Create;
  FHeadFont:=TFont.Create;
  FHeadFont.Name:='楷体_GB2312';
  CalcWidth;
  FCurrencyFont.OnChange:=self.FontChanged;
  FHeadFont.OnChange:=Self.FontChanged;
end;

destructor TMoneyStyle.Destroy;
begin
  FCurrencyFont.Free;
  FHeadFont.Free;
  inherited Destroy;
end;


procedure TMoneyStyle.Assign;
begin
    if Source is TMoneyStyle then
    begin
    Self.FCurrencyFont.Assign(TMoneyStyle(Source).CurrencyFont);
    Self.FHeadFont.Assign(TMoneyStyle(Source).HeadFont);
    Self.FCurrencySymbol:=TMoneyStyle(Source).CurrencySymbol;
    Self.FCompartColor:=TMoneyStyle(Source).CompartColor;
    Self.FKilobitColor:=TMoneyStyle(Source).KilobitColor;
    Self.FRadixColor:=TMoneyStyle(Source).RadixColor;
    Self.FShowMinus:=TMoneyStyle(Source).ShowMinus;
    Self.FMinusColor:=TMoneyStyle(Source).MinusColor;
    Self.FLayout:=Layout;

    exit;
    end;
    inherited Assign(Source);
end;

procedure TMoneyStyle.Changed;
begin
  if Assigned(FOnChange) then FOnChange(self);
  if FGrid<>nil then FGrid.Invalidate;
end;

procedure TMoneyStyle.SetCurrencyFont;
begin
  if FCurrencyFont <> Value then
  begin
     FCurrencyFont.Assign(Value);
     FCurrencyFont.Style:=[];
//     if Assigned(FCurrencyFont.OnChange) then FontChanged(Self);
  end;
end;

procedure TMoneyStyle.SetCurrencySymbol;
begin
  if FCurrencySymbol <> Value then
  begin
     FcurrencySymbol := Value;
     Changed;
  end;
end;

procedure TMoneyStyle.SetCompartColor;
begin
  if FCompartColor <> value then
  begin
     FCompartColor :=Value;
     Changed;
  end;
end;

procedure TMoneyStyle.SetKilobitColor;
begin
  if FKilobitColor <> Value then
  begin
    FKilobitColor := Value ;
     Changed;
  end;
end;