⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 ehutils.pas

📁 很COOL的GRID表格控件
💻 PAS
📖 第 1 页 / 共 2 页
字号:
  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-1);
   PointArray[1]:=Point(ARect.Right,ARect.Top-1);
   ACanvas.Pen.Color:=clBtnShadow;//LineColor;
   ACanvas.Pen.Width:=1;//GridLineWidth;
   PolyLine(ACanvas.Handle,PointArray,2);
   PointArray[0]:=Point(ARect.Left,ARect.Top);
   PointArray[1]:=Point(ARect.Right,ARect.Top);
   ACanvas.Pen.Color:=clBtnHighlight;//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.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -