cxexteditutils.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 704 行 · 第 1/2 页

  else
    Inc(FR, AR);
  if (FG + AG) > High(Byte) then
    FG := High(Byte)
  else
    Inc(FG, AG);
  if (FB + AB) > High(Byte) then
    FB := High(Byte)
  else
    Inc(FB, AB);
  Result := RGB(FR, FG, FB);
end;

function CalcCenterPosHeight(const ARect: TRect; const ADrawHeight: Integer): Integer;
begin
  Result := (ARect.Bottom - ARect.Top - ADrawHeight) div 2;
end;

function CalcDrawWidth(const ARect: TRect; const ADrawHeight: Integer): Integer;
begin
  Result := (CalcCenterPosHeight(ARect, ADrawHeight) * 2 + 2) + ADrawHeight;
end;

function IsVarEmpty(const AValue : Variant): Boolean;
begin
  Result := VarIsNull(AValue) or VarIsEmpty(AValue);
end;

{$HINTS OFF}
function IsValidStringForInt(S: string): Boolean;
var
  ACode, AValue: Integer;
begin
  Result := False;
  S := Trim(S);
  if Length(S) > 0 then
  begin
    Val(S, AValue, ACode);
    Result := ACode = 0;
  end;
end;
{$HINTS ON}

function IsValidStringForDouble(const AValue: string): Boolean;
var
  I: Integer;
  AString: string;
  ADecimalSeparatorCounter: Integer;
begin
  AString := Trim(AValue);
  ADecimalSeparatorCounter := 0;
  Result := Length(AString) > 0;
  { Check for valid numeric symbols in string }
  if Result = True then
    for I := 1 to Length(AString) do
    begin
      if not(AString[I] in ['0'..'9', DecimalSeparator]) and
        ((AString[I] <> '-') or ((AString[I] = '-') and (I > 1))) then
          Result := False
      else
        if AString[I] = DecimalSeparator then
        begin
          if ADecimalSeparatorCounter = 0 then
            Inc(ADecimalSeparatorCounter)
          else
            Result := False
        end;
      if Result = False then Break;
    end;
  { Check for valid Double range }
  if Result then
    Result := (Abs(StrToFloat(AString)) <= MaxDouble);
end;

function cxStrToInt(const AValue: string;
  AToFirstNonNum: Boolean = False): Integer;
var
  I: Integer;
  S: string;
begin
  S := '';
  for I := 1 to Length(AValue) do
    if AValue[I] in ['0'..'9', '-'] then
      S := S + AValue[I]
    else
      if AToFirstNonNum then
        Break;
  if S = '' then
    S := '0';
  Result := StrToInt(S);
end;

function cxStrToFloat(const AValue: string;
  AToFirstNonNum: Boolean = False): Extended;
var
  I: Integer;
  S: string;
begin
  S := '';
  for I := 1 to Length(AValue) do
    if AValue[I] in ['0'..'9', '-', DecimalSeparator] then
        S := S + AValue[I]
    else
      if AToFirstNonNum then
        Break;
  if S = '' then
    S := '0';
  Result := StrToFloat(S);
end;

function cxStrToColor(const S: string; out AColor: TColor): Boolean;
var
  ATempColor: Longint;
begin
  Result := IdentToColor(S, ATempColor);
  if Result then
    AColor := ATempColor
  else
  begin
    Result := IsValidStringForInt(S);
    if Result then
      AColor := TColor(cxStrToInt(S));
  end;
end;

function cxRGBStringColorToColor(const AString: string): TColor;
var
  I, FPos: Integer;
  R, G, B: Integer;
  S, FSColor: string;
begin
  R := 0;
  G := 0;
  B := 0;
  FSColor := AString;
  for I := 1 to 3 do
  begin
    S := '';
    FPos := Pos('.', FSColor);
    if (FPos > 0) then
      S := Copy(FSColor, 1, FPos - 1)
    else
      S := FSColor;
    FSColor := Copy(FSColor, FPos + 1, Length(FSColor) - FPos);
    case I of
      1: R := cxStrToInt(S);
      2: G := cxStrToInt(S);
      3: B := cxStrToInt(S);
    end;
  end;
  Result := RGB(R, G, B);
end;

function cxHexRGBStringColorToColor(const AString: string): TColor;
var
  R, G, B: Integer;
  S: string;

  function IsHexDigit(C: Char): Boolean;
  begin
    Result := (C >= '0') and (C <= '9') or (C >= 'A') and (C <= 'F') or
      (C >= 'a') and (C <= 'f');
  end;

  function RemoveNonHexChars(const AString: string): string;
  var
    I: Integer;
  begin
    Result := '';
    for I := 1 to Length(AString) do
      if IsHexDigit(AString[I]) then
        Result := Result + AString[I];
  end;

  function HexStrToInt(const S: string): Longint;
  var
    HexStr: string;
  begin
    if Pos('$', S) = 0 then
      HexStr := '$' + S
    else
      HexStr := S;
    Result := StrToIntDef(HexStr, 0);
  end;

  function IntToByte(const Value: Integer): Byte;
  begin
    if Value > MaxByte then
      Result := MaxByte
    else
      Result := Value;
  end;

begin
  S := RemoveNonHexChars(AString);
  R := IntToByte(HexStrToInt(Copy(S, 1, 2)));
  G := IntToByte(HexStrToInt(Copy(S, 3, 2)));
  B := IntToByte(HexStrToInt(Copy(S, 5, 2)));
  Result := RGB(R, G, B);
end;

function CheckStateToString(const Value: TcxCheckBoxState): string;
begin
  case Value of
    cbsChecked: Result := '1';
    cbsGrayed: Result := '2';
    else Result := '0';
  end;
end;

function StringToCheckState(const Value: string; const AllowGrayed: Boolean): TcxCheckBoxState;
begin
  if AllowGrayed then
  begin
    if Value = '1' then Result := cbsChecked
     else if Value = '0' then Result := cbsUnchecked
      else Result := cbsGrayed;
  end
  else
  begin
    if Value = '1' then Result := cbsChecked
      else Result := cbsUnchecked;
  end;
end;

function CurrentShiftState: TShiftState;
{$IFDEF DELPHI5}
var
  KeyState: TKeyboardState;
{$ENDIF}
begin
  {$IFDEF DELPHI5}
  GetKeyboardState(KeyState);
  Result := KeyboardStateToShiftState(KeyState);
  {$ELSE}
  Result := [];
  if GetAsyncKeyState(VK_SHIFT) <> 0 then Include(Result, ssShift);
  if GetAsyncKeyState(VK_CONTROL) <> 0 then Include(Result, ssCtrl);
  if GetAsyncKeyState(VK_MENU) <> 0 then Include(Result, ssAlt);
  if GetAsyncKeyState(VK_LBUTTON) <> 0 then Include(Result, ssLeft);
  if GetAsyncKeyState(VK_RBUTTON) <> 0 then Include(Result, ssRight);
  if GetAsyncKeyState(VK_MBUTTON) <> 0 then Include(Result, ssMiddle);
  {$ENDIF}
end;

function GetWord(const APosition: Integer; const S: string;
  const Delimiter: Char): string;
var
  I, FPos: Integer;
  FStr: string;
begin
  Result := '';
  if APosition <= 0 then Exit;
  FStr := S;
  I := 1;
  FPos := Pos(Delimiter, FStr);
  if FPos = 0 then
  begin
    if APosition = 1 then Result := S;
  end
  else
  begin
    while FPos > 0 do
    begin
      if I = APosition then
      begin
        Result := Copy(FStr, 1, FPos - 1);
        Break;
      end
      else
        FStr := Copy(FStr, FPos + 1, Length(FStr));
      Inc(I);
      if FStr = '' then Break;
      FPos := Pos(Delimiter, FStr);
      if (FPos = 0) and (I = APosition) then
        Result := FStr;
    end;
  end;
end;

procedure PaintBackground(const AControl: TWinControl; DC: HDC; DoParent: Boolean);
var
  P: TPoint;
  FSaveIndex: Integer;
begin
  if Assigned(AControl) and (Assigned(AControl.Parent) and DoParent) then
  begin
    FSaveIndex := SaveDC(DC);
    try
      P := AControl.ClientOrigin;
      Windows.ScreenToClient(AControl.Parent.Handle, P);
      MoveWindowOrg(DC, -P.X, -P.Y);
      if Assigned(AControl.Parent) and DoParent then
      begin
        SendMessage(AControl.Parent.Handle, WM_ERASEBKGND, DC, 0);
        SendMessage(AControl.Parent.Handle, WM_PAINT, DC, 0);
        TWinControlAccess(AControl.Parent).PaintControls(DC, nil);
      end
      else
      begin
        SendMessage(AControl.Handle, WM_ERASEBKGND, DC, 0);
        TWinControlAccess(AControl).PaintControls(DC, nil);
      end;
    finally
      RestoreDC(DC, FSaveIndex);
    end;
  end;
end;

{$IFNDEF DELPHI5}
function SameText(const S1, S2: string): Boolean; assembler;
asm
        CMP     EAX,EDX
        JZ      @1
        OR      EAX,EAX
        JZ      @2
        OR      EDX,EDX
        JZ      @3
        MOV     ECX,[EAX-4]
        CMP     ECX,[EDX-4]
        JNE     @3
        CALL    CompareText
        TEST    EAX,EAX
        JNZ     @3
@1:     MOV     AL,1
@2:     RET
@3:     XOR     EAX,EAX
end;
{$ENDIF}

function AdjustCanvasFont(ACanvas: TCanvas; AFont: TFont; AAngle: Integer): Boolean;
var
  ALogFont: TLogFont;
  ARealAngle: Integer;
  ATextMetric: TTextMetric;
begin
  ACanvas.Font.Assign(AFont);
  GetTextMetrics(ACanvas.Handle, ATextMetric);
  ARealAngle := (AAngle mod 360 + 360) mod 360;
  Result := ((ATextMetric.tmPitchAndFamily and TMPF_TRUETYPE) <> 0);
  if not Result then Exit;
  if ARealAngle <> 0 then
  begin
    cxGetFontData(ACanvas.Font.Handle, ALogFont);
    ALogFont.lfEscapement := ARealAngle * 10;
    ACanvas.Font.Handle := CreateFontIndirect(ALogFont);
  end;
end;

end.