gmfuncs.pas

GmPrintSuite 2.96.7] a

                      Envelope_12,
                      Envelope_14];
end;

function IsPrinterCanvas(Canvas: TCanvas): Boolean;
begin
  Result := Canvas.ClassName = 'TPrinterCanvas';
end;

function MaxFloat(Value1, Value2: Extended): Extended;
begin
  if Value1 > Value2 then
    Result := Value1
  else
    Result := Value2;
end;

function MaxInt(Value1, Value2: integer): integer;
begin
  if Value1 > Value2 then
    Result := Value1
  else
    Result := Value2;
end;

function MinFloat(Value1, Value2: Extended): Extended;
begin
  if Value1 < Value2 then
    Result := Value1
  else
    Result := Value2;
end;

function MinInt(Value1, Value2: integer): integer;
begin
  if Value1 < Value2 then
    Result := Value1
  else
    Result := Value2;
end;

function GmRectHeight(ARect: TGmRect): Extended;
begin
  Result := ARect.Bottom - ARect.Top;
end;

function GmRectWidth(ARect: TGmRect): Extended;
begin
  Result := ARect.Right - ARect.Left;
end;

{function GmRectToString(ARect: TGmRect): string;
begin

end

function GmRectFromString(Value: string): TGmRect;
                                                        }
function RectHeight(ARect: TRect): integer;
begin
  Result := ARect.Bottom - ARect.Top;
end;

function RectWidth(ARect: TRect): integer;
begin
  Result := ARect.Right - ARect.Left;
end;

function PaperSizeToStr(APaperSize: TGmPaperSize): string;
begin
  Result := GetEnumName(Typeinfo(TGmPaperSize ), Ord(APaperSize));
end;

function StrToPaperSize(Value: string): TGmPaperSize;
var
  APaperSize: TGmPaperSize;
begin
  Result := Custom;
  for APaperSize := Low(TGmPaperSize) to High(TGmPaperSize) do
  begin
    if PaperSizeToStr(APaperSize) = Value then
    begin
      Result := APaperSize;
      Exit;
    end;
  end;
end;

procedure GmDrawRect(ACanvas: TCanvas; ARect: TRect);
begin
  ACanvas.Lock;
  try
    ACanvas.Polygon([Point(ARect.Left, ARect.Top),
                     Point(ARect.Right, ARect.Top),
                     Point(ARect.Right, ARect.Bottom),
                     Point(ARect.Left, ARect.Bottom),
                     Point(ARect.Left, ARect.Top),
                     Point(ARect.Right, ARect.Top)]);
  finally
    ACanvas.Unlock;
  end;
end;

procedure GmDrawRoundRect(ACanvas: TCanvas; x, y, x2, y2, x3, y3: integer);
var
  AHeight: integer;
  AWidth: integer;
  NodeLengthX: integer;
  NodeLengthY: integer;
begin
  AHeight := RectHeight(Rect(x, y, x2, y2));
  AWidth := RectWidth(Rect(x, y, x2, y2));
  NodeLengthX := Round(x3 / 4)-1;
  NodeLengthY := Round(y3 / 4)-1;
  x3 := x3 div 2;
  y3 := y3 div 2;
  if X3 > AWidth then X3 := AWidth;
  if Y3 > AHeight then Y3 := AHeight;
  ACanvas.Lock;
  try
    ACanvas.MoveTo(x + x3, y);
    ACanvas.PolyBezierTo([Point(x + NodeLengthX, y), Point(x, y+NodeLengthY), Point(x, y+Y3)]);
    ACanvas.LineTo(x, y2-y3);
    ACanvas.PolyBezierTo([Point(x, y2-NodeLengthY), Point(x+NodeLengthX, Y2), Point(X+x3, Y2)]);
    ACanvas.LineTo(x2-x3, y2);
    ACanvas.PolyBezierTo([Point(x2-NodeLengthX, y2), Point(x2, y2-NodeLengthY), Point(x2, y2-y3)]);
    ACanvas.LineTo(x2, y+y3);
    ACanvas.PolyBezierTo([Point(x2, y+NodeLengthY), Point(x2-NodeLengthX, y), Point(x2-x3, y)]);
    ACanvas.LineTo(x+x3, y);
  finally
    ACanvas.Unlock;
  end;
end;

procedure GmDrawEllipse(ACanvas: TCanvas; x,  y, x2, y2: integer);
var
  AHeight: integer;
  AWidth: integer;
  RadiusX: integer;
  RadiusY: integer;
  NodeX: integer;
  NodeY: integer;
begin
  AHeight := RectHeight(Rect(x, y, x2, y2));
  AWidth := RectWidth(Rect(x, y, x2, y2));
  RadiusX := AWidth div 2;
  RadiusY := AHeight div 2;
  NodeX := Round(AWidth / 4.45);
  NodeY := Round(AHeight / 4.45);
  ACanvas.MoveTo(x + RadiusX, y);
  ACanvas.PolyBezierTo([Point(x + NodeX, y), Point(x, y+NodeY), Point(x, y+RadiusY)]);
  ACanvas.PolyBezierTo([Point(x, y2-NodeY), Point(x+NodeX, Y2), Point(x+RadiusX, y2)]);
  ACanvas.PolyBezierTo([Point(x2-NodeX, y2), Point(x2, y2-NodeY), Point(x2, y2-RadiusY)]);
  ACanvas.PolyBezierTo([Point(x2, y+NodeY), Point(x2-NodeX, y), Point(x2-RadiusX, y)]);
end;

procedure GmDrawPolyShape(ObjID: integer; Canvas: TCanvas; const Points: array of TPoint);
type
  PPoints = ^TPoints;
  TPoints = array[0..0] of TPoint;
begin
  case ObjID of
    GM_POLYGON_OBJECT_ID     : Windows.Polygon(Canvas.Handle, PPoints(@Points)^, High(Points) + 1);
    GM_POLYLINE_OBJECT_ID    : Windows.PolyLine(Canvas.Handle, PPoints(@Points)^, High(Points) + 1);
    GM_POLYBEZIER_OBJECT_ID  : Windows.PolyBezier(Canvas.Handle, PPoints(@Points)^, High(Points) + 1);
    GM_POLYLINETO_OBJECT_ID  : Windows.PolyLineTo(Canvas.Handle, PPoints(@Points)^, High(Points) + 1);
    GM_POLYBEZIERTO_OBJECT_ID: Windows.PolyBezierTo(Canvas.Handle, PPoints(@Points)^, High(Points) + 1);
  end;
end;

procedure PrintBitmap(Canvas: TCanvas; ARect: TRect; Bitmap: TBitmap);
var
  BitmapHeader: pBitmapInfo;
  BitmapImage : POINTER;
  HeaderSize : DWORD; // Use DWORD for D3-D5 compatibility
  ImageSize : DWORD;
  CM : LongInt;
begin
  if Bitmap.Empty then Exit;
  CM := SRCCOPY;
  case Canvas.CopyMode of
    cmBlackness:  CM := BLACKNESS;
    cmDstInvert:  CM := DSTINVERT;
    cmMergeCopy:  CM := MERGECOPY;
    cmMergePaint: CM := MERGEPAINT;
    cmNotSrcCopy: CM := NOTSRCCOPY;
    cmNotSrcErase:CM := NOTSRCERASE;
    cmPatCopy:    CM := PATCOPY;
    cmPatInvert:  CM := PATINVERT;
    cmPatPaint:   CM := PATPAINT;
    cmSrcAnd:     CM := SRCAND;
    cmSrcCopy:    CM := SRCCOPY;
    cmSrcErase:   CM := SRCERASE;
    cmSrcInvert:  CM := SRCINVERT;
    cmSrcPaint:   CM := SRCPAINT;
    cmWhiteness:  CM := WHITENESS;
  end;

  GetDIBSizes(Bitmap.Handle, HeaderSize, ImageSize);
  GetMem(BitmapHeader, HeaderSize);
  GetMem(BitmapImage, ImageSize);
  GetDIB(Bitmap.Handle, Bitmap.Palette, BitmapHeader^, BitmapImage^);
  try
    StretchDIBits(Canvas.Handle,
                  ARect.Left, ARect.Top,
                  ARect.Right - ARect.Left,
                  ARect.Bottom - ARect.Top,
                  0, 0,
                  Bitmap.Width, Bitmap.Height,
                  BitmapImage,
                  TBitmapInfo(BitmapHeader^),
                  DIB_RGB_COLORS,
                  CM);
  finally
    FreeMem(BitmapHeader);
    FreeMem(BitmapImage);
  end;
end;

function TextExtent(AText: string; AFont: TFont): TGmSize;
var
  Mf: TMetafile;
  Mfc: TMetafileCanvas;
  AExtent: TSize;
begin
  //CriticalSection.Enter;
  try
    Mf := TMetafile.Create;
    try
      Mfc := TMetafileCanvas.Create(Mf, 0);
      try
        Mfc.Font.PixelsPerInch := 600;
        Mfc.Font.Assign(AFont);
        AExtent := Mfc.TextExtent(AText);
        Result.Width := AExtent.cx / 600;
        Result.Height := AExtent.cy / 600;
      finally
        Mfc.Free;
      end;
    finally
      Mf.Free;
    end;
  finally
  //  CriticalSection.Leave;
  end;
end;

function Tokenize(AText: string; APage, NumPages: integer; ADateFormat, ATimeFormat: string): string;
begin
  Result := AText;
  Result := ReplaceStringFields(Result, '{DATE}', FormatDateTime(ADateFormat,Date));
  Result := ReplaceStringFields(Result, '{TIME}', FormatDateTime(ATimeFormat,Time));
  Result := ReplaceStringFields(Result, '{PAGE}', IntToStr(APage));
  Result := ReplaceStringFields(Result, '{NUMPAGES}', IntToStr(NumPages));
end;

procedure SwapExtValues(var Value1: Extended; var Value2: Extended);
var
  TempVal: Extended;
begin
  TempVal := Value1;
  Value1 := Value2;
  Value2 := TempVal;
end;

procedure GraphicToJPeg(AGraphic: TGraphic; var AJpeg: TJPEGImage);
begin
  AJpeg := TJPEGImage.Create;
  AJpeg.Assign(AGraphic);
end;

procedure IconToBitmap(AIcon: TIcon; var ABitmap: TBitmap);
begin
  ABitmap := TBitmap.Create;
  ABitmap.Width := AIcon.Width;
  ABitmap.Height := AIcon.Height;
  ABitmap.Canvas.Draw(0, 0, AIcon);
end;

function ReturnOSVersion: string;
var
  VI: TOSVersionInfo;
begin
  VI.dwOSVersionInfoSize := SizeOf(VI);
  GetVersionEx(VI);
  with VI do
  begin
    case dwPlatformID of
      VER_PLATFORM_WIN32S: Result := 'Windows 3.1x running Win32s';
      VER_PLATFORM_WIN32_WINDOWS:
      if VI.dwMajorVersion >= 4 then
        if VI.dwMinorVersion >= 90 then Result := 'Windows ME'
          else
            Result := 'Windows 98'
        else
          Result := 'Windows 95';
      VER_PLATFORM_WIN32_NT:
      if VI.dwMajorVersion > 4 then
        if VI.dwMinorVersion >= 1 then Result := 'Windows XP'
        else
          Result := 'Windows 2000'
      else Result := 'Windows NT';
    end;
  end;
end;

end.