ehutils.pas

很COOL的GRID控件

procedure TMoneyStyle.SetRadixColor;
begin
  if FRadixColor <> Value then
  begin
    FRadixColor := Value;
     Changed;
  end;
end;

procedure TMoneyStyle.SetShowMinus;
begin
  if FShowMinus <> Value then
  begin
    FShowMinus:=Value;
     Changed;
  end;

end;

procedure TMoneyStyle.SetShowZero;
begin
  if FShowZero <> Value then
  begin
    FShowZero:=Value;
     Changed;
  end;

end;

procedure TMoneyStyle.SetMinusColor;
begin
 if FMinusColor <> value then
 begin
   FMinusCOlor := Value;
     Changed;
 end;
end;

procedure TMoneyStyle.SetLayout;
begin
 if FLayout <> Value then
 begin
   FLayout := Value ;
     Changed;
 end;
end;

procedure TMoneyStyle.FontChanged(Sender: TObject);
begin
  CalcWidth;
  Changed;
end;

procedure TMoneyStyle.CalcWidth;
var
  aCanvas:TCanvas;
  DC:HDC;
  LogRec:TLogFont;
  W0,W1:integer;
//  chaFont:TFont;
begin
  aCanvas:=TCanvas.Create;
//  chaFont:=TFont.Create;
  DC := GetDC(0);
  try
    aCanvas.Handle:=DC;
    with aCanvas do
    begin
        Font.Assign(CurrencyFont);
        FENGWidth:=TextWidth('0');
        FENGHeight:=TextHeight('09');{}
        Font.Assign(HeadFont);
{        with aCanvas.Font do
        begin
         Charset:=FHeadFont.Charset;//GB2312_CHARSET;
         Name :=FHeadFont.Name;//'楷体_GB2312';
         Style:=FCurrencyFont.Style;
         Size:=FCurrencyFont.Size;
         Height:=FCurrencyFont.Height;
        end;      {}
//        Font.Assign(chaFont);
        W0:=TextHeight('分');
        W1:=FENGWidth;
        GetObject(Font.Handle,SizeOf(TLOGFONT),Addr(LogRec));
          LogRec.lfHeight:= -1 * W0;
          LogRec.lfWidth := (W1 + W1 div 2 )div 2;
        Font.Handle:=CreateFontIndirect(LogRec);
        FCHNWidth:=TextWidth('分');
        FCHNHeight:=TextHeight('分');
   end;
  finally
    aCanvas.Handle := 0;
    aCanvas.Free;
    ReleaseDC(0, DC);
  //  chaFont.Free;
  end;
end;

procedure TMoneyStyle.SetHeadFont(Value: TFont);
begin
    if (FHeadFont <> Value) then begin
        FHeadFont.Assign( Value);
        Changed;
    end;
end;

procedure TMoneyStyle.SetDigits(Value: Byte);
begin
    if (FDigits <> Value)and
       (Value in[1..4]) then begin
        FDigits := Value;
        Changed;
    end;
end;
procedure TMoneyStyle.PaintHead;
var
   S:String;
   I,J,Flags:integer;
   PointArray:array[0..1]of TPoint;
   LogRec:TLogFont;
   W0,W1:integer;
   chaFont:TFont;
   DParams:TDRAWTEXTPARAMS;
begin
     //画财务栏头
 with DParams do
 begin
   cbSize:=Sizeof(DParams);
   iTabLength:=0;
   iLeftMargin:=0;
   iRightMargin:=0;
 end;
 if not(Fdigits in [1..4]) then Fdigits:=2;
 case digits of
        0 :S:='千百十万千百十亿千百十万千百十亿千百十万千百十亿千百十万千百十亿千百十万千百十元';
        1 :S:='千百十万千百十亿千百十万千百十亿千百十万千百十亿千百十万千百十亿千百十万千百十元角';
        2 :S:='千百十万千百十亿千百十万千百十亿千百十万千百十亿千百十万千百十亿千百十万千百十元角分';
        3 :S:='千百十万千百十亿千百十万千百十亿千百十万千百十亿千百十万千百十亿千百十万千百十元角分毫';
        4 :S:='千百十万千百十亿千百十万千百十亿千百十万千百十亿千百十万千百十亿千百十万千百十元角分毫厘';
  end;
  chaFont:=TFont.Create;
  chaFont.Assign(ACanvas.Font);
  Try
   ACanvas.Font.Assign(HeadFont);
   with ACanvas do
   begin
     W0:=CHNWIDTH;//TextWidth('分');
     W1:=ENGWidth;//TextHeight('分');
//-------------------------------------
//下面的代码是为了拉长中文字体,以美观一点
     GetObject(Font.Handle,SizeOf(TLOGFONT),Addr(LogRec));
     LogRec.lfHeight:= -1 * (CHNHeight);//W0;
     LogRec.lfWidth := (W1 + W1 div 2 )div 2;
     Font.Handle:=CreateFontIndirect(LogRec);
//--------------------------------------
     W0:=TextWidth('分');
     Flags:=DT_RIGHT or DT_SINGLELINE or DT_BOTTOM;
     DParams.uiLengthDrawn := Length(S);
     DrawTextEx(ACanvas.Handle,PChar(S),Length(S),ARect,Flags,@DParams );
   end;
   //画财务栏头隔线
   I:=aRect.Right-2;
   PointArray[0]:=Point(ARect.Left,ARect.Top);
   PointArray[1]:=Point(ARect.Right,ARect.Top);
   ACanvas.Pen.Color:=clBlack;//LineColor;
   ACanvas.Pen.Width:=1;//GridLineWidth;
   PolyLine(ACanvas.Handle,PointArray,2);

   ACanvas.Pen.Color:=CompartColor;
   J:= 0;
   while I > ARect.Left do
   begin
       PointArray[0]:=Point(I,ARect.Top);
       PointArray[1]:=Point(I,ARect.Bottom);
       if J = Digits then
       ACanvas.Pen.Color:=RadixColor
       else
       case (J -digits) mod 3 of
          0 : ACanvas.Pen.Color:=KilobitColor;
          else ACanvas.Pen.Color:=CompartColor;
       end;
       PolyLine(ACanvas.Handle,PointArray,2);
       Dec(I,W0);
       J:=J+1;
    end;
   Finally
    ACanvas.Font.Assign(chaFont);
    ChaFont.Free;
   end;
end;

procedure TMoneyStyle.PaintBody;
var
        B:TRect;
        OLD,I,J:integer;
        PointArray:array[0..1]of TPoint;
        W0,W1,Flags:integer;
        DParams:TDRAWTEXTPARAMS;
        saveColor:TColor;
        V:Currency;LogRec:TLogFont;
begin
       //画财务栏体
       saveColor:=ACanvas.Font.Color;
       with DParams do
       begin
        cbSize:=Sizeof(DParams);
        iTabLength:=0;
        iLeftMargin:=0;
        iRightMargin:=0;
       end;
       if not(Fdigits in [1..4]) then Fdigits:=2;
       with ACanvas do
        begin
          fillrect(hrect);
          Font.Assign(CurrencyFont);
          W0 := CHNWidth;
          W1 := ENGWidth;{}
          J:= W0 - W1 ;
          if fsBold in Font.Style then
          begin
           DParams.iRightMargin:=  -1 * J + J div 2 - J mod 2 - 1;
           Inc(j);
          end else
          ACanvas.Font.Color:=SaveColor;
          DParams.iRightMargin:=  -1 * J + J div 2 - J mod 2 +1;
          OLD:=SetTextCharacterExtra(Handle,J);

          V:=StrToCurrDef(AText,0);
          AText:=CurrToStrF(ABS(V),ffFixed,digits);

          if V<0 then
          begin
            Font.Color:=MinusColor;
            if ShowMinus then AText:='-'+AText;
          end
          else
          if (V=0) and (not ShowZero) then
            AText:='';
         AText:=f_ReplaceAll(AText,'.','');

         B:=hRect;
         B.Right:=B.Right-2 ;
         case Layout of
          tlTop : Flags:=DT_RIGHT or DT_SINGLELINE or DT_TOP;
          tlCenter: Flags:=DT_RIGHT or DT_SINGLELINE or DT_VCENTER;
          tlBottom: Flags:=DT_RIGHT or DT_SINGLELINE or DT_BOTTOM;
         end;
         DParams.iTabLength:=0;
         DParams.uiLengthDrawn := Length(AText);
         DrawTextEx(Handle,PChar(AText),Length(AText),B,Flags,@DParams );
         if AText<>'' then
         begin
         ACanvas.Font.Assign(HeadFont);
         I:=Length(AText)*CHNWidth;
         B.Right:=HRect.Right-I;
         B.Left:=B.Right-CHNWidth;
         GetObject(Font.Handle,SizeOf(TLOGFONT),Addr(LogRec));
         LogRec.lfHeight:= -1 * (ENGHeight);//W0;
         LogRec.lfWidth := (W1 + W1 div 2 )div 2;
         Font.Handle:=CreateFontIndirect(LogRec);
         if  B.Left>HRect.Left then
         DrawTextEx(Handle,PChar(FCurrencySymbol),Length(FCurrencySymbol),B,Flags,@DParams );
         end;
         SetTextCharacterExtra(Handle,OLD);
        end;
        B:=hRect;
        I:=B.Right-2;
        ACanvas.Pen.Color:=CompartColor;
        J:= 0;
        while I > B.Left do
        begin
          PointArray[0]:=Point(I,B.Top);
          PointArray[1]:=Point(I,B.Bottom);
          if J = digits then
          ACanvas.Pen.Color:=RadixColor
          else
          case (J-digits) mod 3 of
          0 :ACanvas.Pen.Color:=KilobitColor;
          else ACanvas.Pen.Color:=CompartColor;
          end;
          PolyLine(ACanvas.Handle,PointArray,2);
          Dec(I,W0);
          J:=J+1;
        end;
end;

end.