个人收集及编写的一个通用函数集.pas

个人收集及编写的一个通用函数集

var
  i : integer;
begin
  for i := 1 to Length(Data) do
  Data[i] := Chr(Byte(Data[i])- 48);
end;

function GetAveCharSize(Canvas: TCanvas): TPoint;
var
  I: Integer;
  Buffer: array[0..51] of Char;
begin
  for I := 0 to 25 do Buffer[I] := Chr(I + Ord('A'));
  for I := 0 to 25 do Buffer[I + 26] := Chr(I + Ord('a'));
  GetTextExtentPoint(Canvas.Handle, Buffer, 52, TSize(Result));
  Result.X := Result.X div 52;
end;

var
    ModalResults: array[TMsgDlgBtn] of Integer = (
    mrYes, mrNo, mrOk, mrCancel, mrAbort, mrRetry, mrIgnore, mrAll, mrNoToAll,
    mrYesToAll, 0);

function MaskForm(const imask : Byte): Byte;
var
  Form: TForm;
  cbSys: TCheckBox;
  cbFont: TCheckBox;
  cbFace: TCheckBox;
  Button: TButton;
begin
  Result := 0;
  Form := TForm.Create(Application);
  with Form do
    try
      Font.Name := '宋体';
      Font.Size := 9;
      Canvas.Font := Font;
      BorderStyle := bsDialog;
      Caption := '屏蔽设置';
      Position := poScreenCenter;
      Width := 257;
      Height := 145;
      cbSys := TcheckBox.Create(Form);
      with cbSys do
      begin
       parent := Form;
       Left := 24;
       Top := 24;
       Caption := '屏蔽系统信息';
       ParentFont := true;
       if Bool(imask and $01) then Checked := true;
      end;
      cbFont := TcheckBox.Create(Form);
      with cbFont do
      begin
       parent := Form;
        Left := 136;
        Top := 24;
       Caption := '屏蔽字体设置';
       ParentFont := true;
       if Bool(imask and $02) then Checked := true;
      end;
      cbFace:=  TCheckBox.Create(Form);
      with cbFace do begin
       parent := Form;
       Left := 24;
       Top := 56;
       Caption := '屏蔽聊天表情';
       ParentFont := true;
       if Bool(imask and $04) then Checked := true;
      end;
      Button:= TButton.Create(Form);
      with TButton.Create(Form) do
      begin
        Parent := Form;
        Caption := '确定';
        ModalResult := mrOk;
        Default := True;
        Left := (parent.Width - Width) div 2;
        Top := parent.ClientHeight - Height - 10;
      end;
      if ShowModal = mrOk then
      begin
        if cbSys.Checked then Result := 1;
        if cbFont.Checked then Inc(Result,2);
        if cbFace.Checked then Inc(Result,4);
      end;
   finally
    Form.Free;
   end;
end;

function InputBoxEx(const ACaption, APrompt, ADefault: string): string;
var
  Form: TForm;
  Prompt: TLabel;
  Edit: TEdit;
  DialogUnits: TPoint;
  ButtonTop, ButtonWidth, ButtonHeight: Integer;
begin
  Result := ADefault;

  Form := TForm.Create(Application);
  with Form do
    try
      Font.Name := '宋体';
      Font.Size := 9;
      Canvas.Font := Font;
      DialogUnits := GetAveCharSize(Canvas);
      BorderStyle := bsDialog;
      Caption := ACaption;
      ClientWidth := MulDiv(180, DialogUnits.X, 4);
      Position := poScreenCenter;
      Prompt := TLabel.Create(Form);
      with Prompt do
      begin
        Parent := Form;
        Caption := APrompt;
        Left := MulDiv(8, DialogUnits.X, 4);
        Top := MulDiv(8, DialogUnits.Y, 8);
        Constraints.MaxWidth := MulDiv(164, DialogUnits.X, 4);
        WordWrap := True;
      end;
      Edit := TEdit.Create(Form);
      with Edit do
      begin
        Parent := Form;
        Left := Prompt.Left;
        Top := Prompt.Top + Prompt.Height + 5;
        Width := MulDiv(164, DialogUnits.X, 4);
        MaxLength := 255;
        Text := Result;
        SelectAll;
      end;
      ButtonTop := Edit.Top + Edit.Height + 15;
      ButtonWidth := MulDiv(50, DialogUnits.X, 4);
      ButtonHeight := MulDiv(14, DialogUnits.Y, 8);
      with TButton.Create(Form) do
      begin
        Parent := Form;
        Caption := '确定';
        ModalResult := mrOk;
        Default := True;
        SetBounds(MulDiv(38, DialogUnits.X, 4), ButtonTop, ButtonWidth,
          ButtonHeight);
      end;
      with TButton.Create(Form) do
      begin
        Parent := Form;
        Caption := '取消';
        ModalResult := mrCancel;
        Cancel := True;
        SetBounds(MulDiv(92, DialogUnits.X, 4), Edit.Top + Edit.Height + 15,
          ButtonWidth, ButtonHeight);
        Form.ClientHeight := Top + Height + 13;          
      end;
      if ShowModal = mrOk then
      begin
        Result := Edit.Text;
      end;
    finally
      Form.Free;
    end;
end;
//********************************显示数字于一个框内start*******************************//

procedure DrawSegment(Canvas: TCanvas; dSegNum : Integer;const SegmentRect : TRect);
const
  cBorderGap = 1;  //边界宽度
  cSegmentThickness = 2; //每个线条宽度
  cHorzMargine = 1; //水平线条边界缩进
  cVertMargine = 1; //竖直线条边界缩进
var
   Ht,Lt,Rt,Tp,Bt,VertCentre, SegHalf : Integer;
   fPoints   : array [1..6] of TPoint;
begin
    Ht := SegmentRect.Bottom - SegmentRect.Top;
    Lt := SegmentRect.Left+cBorderGap;
    Rt := SegmentRect.Right-cBorderGap - 1 - (cSegmentThickness * 2); //move in a seg and a half
    Tp := SegmentRect.Top+cBorderGap;
    Bt := Ht-cBorderGap-1 +  SegmentRect.Top;

    VertCentre := ((Bt - Tp) div 2);
    SegHalf    := (cSegmentThickness div 2);

     case dSegNum of
          0 :
            begin
                 fPoints[1].x := Rt + cSegmentThickness{SegHalf};
                 fPoints[1].y := Bt - (VertCentre div 2);// - (cSegmentThickness * 2);

                 fPoints[2].x := Rt + SegHalf + cSegmentThickness * 2;// - (SegHalf + cSegmentThickness);
                 fPoints[2].y := Bt;

                 Canvas.Ellipse(fPoints[1].x, fPoints[1].y, fPoints[2].x, fPoints[2].y);
            end;
          3 :
            begin
                 fPoints[1].x := Lt + cHorzMargine;
                 fPoints[1].y := Tp;

                 fPoints[2].x := Rt - cHorzMargine;
                 fPoints[2].y := Tp;

                 fPoints[3].x := fPoints[2].x - cSegmentThickness;
                 fPoints[3].y := fPoints[2].y + cSegmentThickness;

                 fPoints[4].x := fPoints[1].x + cSegmentThickness;
                 fPoints[4].y := fPoints[1].y + cSegmentThickness;

                 Canvas.Polygon(Slice(fPoints,4));
            end;

           4 :
            begin
                 fPoints[1].x := Lt ;
                 fPoints[1].y := Tp+cVertMargine;

                 fPoints[2].x := Lt;
                 fPoints[2].y := Tp+VertCentre-cVertMargine;

                 fPoints[3].x := fPoints[2].x + cSegmentThickness;
                 fPoints[3].y := fPoints[2].y - cSegmentThickness;

                 fPoints[4].x := fPoints[1].x + cSegmentThickness;
                 fPoints[4].y := fPoints[1].y + cSegmentThickness;

                 Canvas.Polygon(Slice(fPoints,4));
            end;

            5:
             begin
                  fPoints[1].x := Lt ;
                  fPoints[1].y := Tp+cVertMargine+VertCentre;

                  fPoints[2].x := Lt;
                  fPoints[2].y := Tp+VertCentre-cVertMargine+VertCentre;

                  fPoints[3].x := fPoints[2].x + cSegmentThickness;
                  fPoints[3].y := fPoints[2].y - cSegmentThickness;

                  fPoints[4].x := fPoints[1].x + cSegmentThickness;
                  fPoints[4].y := fPoints[1].y + cSegmentThickness;

                  Canvas.Polygon(Slice(fPoints,4));
             end;

             6:
              begin
                   fPoints[1].x := Lt + cHorzMargine;
                   fPoints[1].y := Tp+VertCentre+VertCentre;

                   fPoints[2].x := Rt - cHorzMargine;
                   fPoints[2].y := fPoints[1].y;

                   fPoints[3].x := fPoints[2].x - cSegmentThickness;
                   fPoints[3].y := fPoints[2].y - cSegmentThickness;

                   fPoints[4].x := fPoints[1].x + cSegmentThickness;
                   fPoints[4].y := fPoints[1].y - cSegmentThickness;

                   Canvas.Polygon(Slice(fPoints,4));
              end;

              2:
               begin

                    fPoints[1].x := Rt;
                    fPoints[1].y := Tp+cVertMargine;

                    fPoints[2].x := fPoints[1].x;
                    fPoints[2].y := Tp+VertCentre-cVertMargine;

                    fPoints[3].x := fPoints[2].x - cSegmentThickness;
                    fPoints[3].y := fPoints[2].y - cSegmentThickness;

                    fPoints[4].x := fPoints[1].x - cSegmentThickness;
                    fPoints[4].y := fPoints[1].y + cSegmentThickness;

                    Canvas.Polygon(Slice(fPoints,4));
               end;

               7:
                begin
                     fPoints[1].x := Rt;
                     fPoints[1].y := Tp+cVertMargine+VertCentre;

                     fPoints[2].x := fPoints[1].x;
                     fPoints[2].y := Tp+VertCentre-cVertMargine+VertCentre;

                     fPoints[3].x := fPoints[2].x - cSegmentThickness;
                     fPoints[3].y := fPoints[2].y - cSegmentThickness;

                     fPoints[4].x := fPoints[1].x - cSegmentThickness;
                     fPoints[4].y := fPoints[1].y + cSegmentThickness;
                     Canvas.Polygon(Slice(fPoints,4));
                end;

                1:
                  begin
                       fPoints[1].x := Lt+cHorzMargine;
                       fPoints[1].y := Tp+VertCentre;

                       fPoints[2].x := fPoints[1].x + SegHalf;
                       fPoints[2].y := Tp+VertCentre - SegHalf  ; // 1 is Pen size

                       fPoints[3].x := Rt-cHorzMargine-SegHalf;
                       fPoints[3].y := fPoints[2].y;

                       fPoints[4].x := Rt-cHorzMargine;
                       fPoints[4].y := fPoints[1].y;

                       fPoints[5].x := Rt-cHorzMargine-SegHalf;
                       fPoints[5].y := Tp+VertCentre + SegHalf;

                       fPoints[6].x := fPoints[2].x;
                       fPoints[6].y := fPoints[5].y ;

                       Canvas.Polygon(fPoints);
               end;
     end;

end;

function Padr(s : String;numPad : Integer) : String;
var
   i,l    : Integer;
begin
     Result := '';
      l := numPad-Length(s);
      for i := 1 to l do
          Result := Result+' ';
     Result := Result + s;
end;

procedure DrawSegments(Canvas: TCanvas; dSegment : TCharSegment;SegmentRect : TRect);
var
   i      : Byte;
begin
     for i := 0 to 7 do
         if (byte(i) in dSegment) then
            DrawSegment(Canvas,i,SegmentRect);
end;
{
    3
    --
  4| 1 |2
    --
  5|   |7
    --  * 0
    6
}

procedure MakeSegments(dChar : Char;var dSegment : TCharSegment);
begin
     dSegment := [];
     case dChar of
              '1':  dSegment := [2,7];
              '2':  dSegment := [3,2,1,5,6];
              '3':  dSegment := [3,2,1,7,6];
              '4':  dSegment := [4,1,2,7];
              '5':  dSegment := [3,4,1,7,6];
              '6':  dSegment := [3,4,5,6,7,1];
              '7':  dSegment := [3,2,7];
              '8':  dSegment := [3,4,5,6,7,2,1];
              '9':  dSegment := [3,4,1,2,7];
              '0':  dSegment := [3,4,5,6,7,2];
              '-':  dSegment := [1];
              '.':  dSegment := [0];
     end;
end;

procedure ShowDigiInRect(Canvas: TCanvas; mRect: TRect; str : string); //显示数字在一个框里
const
  cNumChars = 2;
var
   MySeg  : TCharSegment;
   xPos, i : Integer;
   MyRect : TRect;
   csize  : Integer;
   s  : String;
   clFront, clBack : TColor;
begin
   s := Padr(str,cNumChars);
   cSize := (mRect.Right - mRect.Left) div Length(s);
   xPos := 0;
    clFront := canvas.Pen.Color ;
    clBack := canvas.Brush.Color;
    canvas.Brush.Color := clLime; // 添充色
    canvas.Pen.Color := clLime; //前景色

   for i := 1 to Length(s) do
        begin
          MakeSegments(s[i],MySeg);
          MyRect.Top := mRect.Top;
          MyRect.Bottom := mRect.Bottom;
          MyRect.Left := mRect.Left + (xPos)*cSize;
          MyRect.Right:= MyRect.Left+cSize;
          DrawSegments(Canvas,MySeg,MyRect);
          Inc(xPos);
       end;
  Canvas.Pen.Color := clFront;
  Canvas.Brush.Color := clBack;
end;
//********************************显示数字于一个框内start*******************************//

function GetColorA(chint : boolean; vcolor : Tcolor) : TColor ; //改变阴影的函数
var
  r,g,b,H,S,L : integer;
  fcolor : TColor;
begin
  fColor := ColorToRGB(vcolor);
  b := GetBValue(fColor);
  g := GetGValue(fColor);
  r := GetRValue(fColor);
  RGBtoHSL(r,g,b,h,s,l);
  if chint then l := l + 15 else l := l - 15;
  HSLtoRGB(h,s,l,r,g,b);
  ReSult := RGB(r,g,b);
end;

function GetColor(chint : boolean; vcolor : Tcolor) : TColor ; //改变阴影的函数
var
  r,g,b,H,S,L : integer;
  fcolor : TColor;
begin
  fColor := ColorToRGB(vcolor);
  b := GetBValue(fColor);
  g := GetGValue(fColor);
  r := GetRValue(fColor);
  RGBtoHSL(r,g,b,h,s,l);
  if chint then l := l + 35 else l := l - 35;
  HSLtoRGB(h,s,l,r,g,b);
  ReSult := RGB(r,g,b);
end;