unit uMain;

interface

uses
  Windows, SysUtils, Graphics, Controls, Forms,
  StdCtrls, ComCtrls, ExtCtrls, Dialogs, ExtDlgs, Classes,
  Printers;

type
  RecBarcode = record
    MinLength, MaxLength : integer;
    TestString, PossibleChars, Misc : string;
  end;

  TfrmMain = class(TForm)
    Panel1: TPanel;
    cbDriver: TComboBox;
    Label1: TLabel;
    Panel2: TPanel;
    btnExit: TButton;
    pnPrint: TPanel;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    TabSheet4: TTabSheet;
    GroupBox3: TGroupBox;
    btnCut: TButton;
    GroupBox2: TGroupBox;
    Label2: TLabel;
    Label3: TLabel;
    btnCDOpen: TButton;
    cbDPW: TComboBox;
    rdoCD1: TRadioButton;
    rdoCD2: TRadioButton;
    GroupBox1: TGroupBox;
    listFont: TListBox;
    btnPrint: TButton;
    cbFontColor: TComboBox;
    GroupBox4: TGroupBox;
    chkFontBold: TCheckBox;
    chkFontUnderLine: TCheckBox;
    Label4: TLabel;
    GroupBox6: TGroupBox;
    edtPicture: TEdit;
    btnPicrureFind: TButton;
    Panel3: TPanel;
    Image1: TImage;
    chkCutWPF: TCheckBox;
    OpenPictureDialog1: TOpenPictureDialog;
    TabSheet5: TTabSheet;
    GroupBox8: TGroupBox;
    edtFontMsg: TEdit;
    btnFontMsgFile: TButton;
    chkFontMsgFile: TCheckBox;
    OpenDialog1: TOpenDialog;
    GroupBox13: TGroupBox;
    rdoNvNo1: TRadioButton;
    rdoNvNo2: TRadioButton;
    rdoNvNo3: TRadioButton;
    rdoNvNo4: TRadioButton;
    rdoNvNo5: TRadioButton;
    procedure btnExitClick(Sender: TObject);
    procedure btnPrintClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btnCutClick(Sender: TObject);
    procedure btnPicrureFindClick(Sender: TObject);
    procedure btnCDOpenClick(Sender: TObject);
    procedure btnFontMsgFileClick(Sender: TObject);
    procedure chkFontMsgFileClick(Sender: TObject);
    procedure listFontClick(Sender: TObject);
    procedure PageControl1Change(Sender: TObject);
    procedure listFontDrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure listFontMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
    fhMsg : TextFile;
    rBCode : array[0..6] of RecBarcode;

    procedure ProcPicrure;
    procedure ProcFont;
    procedure ProcNV;
    procedure Print(sPrint, sFontName : string; iFontSize : integer; Color : TColor; Style : TFontStyles);
    procedure PrintFile(sFile, sFontName : string; iFontSize : integer; Color : TColor; Style : TFontStyles);
    procedure LoadDriver;
    procedure PrinterLink;
    procedure SetFontStyleByOS;
  public
    { Public declarations }
  end;

const
  DRIVER_NAME = 'BIXOLON SAMSUNG SRP-370';
  CONTROL_FONT = 'FontControl'; { Control Function Font Name }
  DEFAULT_FONT = 'FontA1x1';

var
  frmMain: TfrmMain;

implementation

{$R *.DFM}

procedure TfrmMain.btnExitClick(Sender: TObject);
begin
    Close;
end;

procedure TfrmMain.btnPrintClick(Sender: TObject);
begin
    Printer.PrinterIndex := cbDriver.ItemIndex;
    Printer.Orientation := poPortrait;
    case PageControl1.ActivePageIndex of
        0:  ProcFont;
        1:  ProcPicrure;
        3:  ProcNV;
    end;
end;

procedure TfrmMain.ProcNV;
var
    sControl : string;
begin
    PrinterLink;
    if( rdoNVNo1.Checked ) then sControl := 'G';
    if( rdoNVNo2.Checked ) then sControl := 'H';
    if( rdoNVNo3.Checked ) then sControl := 'I';
    if( rdoNVNo4.Checked ) then sControl := 'J';
    if( rdoNVNo5.Checked ) then sControl := 'K';
    Print(sControl, CONTROL_FONT, 9, clBlack, []);

    CloseFile(fhMsg);
end;

procedure TfrmMain.Print(sPrint, sFontName : string; iFontSize : integer; Color : TColor; Style : TFontStyles);
begin
    Printer.Canvas.Font.Name := sFontName;
    Printer.Canvas.Font.Size := iFontSize;
    Printer.Canvas.Font.Color := Color;
    Printer.Canvas.Font.Style := Style;
    WriteLn(fhMsg, sPrint);
end;

procedure TfrmMain.PrinterLink;
begin
    AssignPrn(fhMsg);
    Rewrite(fhMsg);
end;

procedure TfrmMain.ProcFont;
    procedure FontPrint(sPrint, sFile, sFontName : string; iFontSize : integer; Color : TColor; Style : TFontStyles; bFilePrint : boolean);
    begin
        if(bFilePrint) then PrintFile(sFile, sFontName, iFontSize, Color, Style)
        else Print(sPrint, sFontName, iFontSize, Color, Style);
    end;
var
    i : integer;
    sFontName, sTemp : string;
    sPrint : PString;
    Color : TColor;
    Style : TFontStyles;
    bFilePrint : boolean;
begin
    sFontName := listFont.Items.Strings[listFont.ItemIndex];
    if('BLACK' = UpperCase(cbFontColor.Text)) then Color := clBlack
    else Color := clRed;
    Style := [];
    if(chkFontBold.Checked) then Include(Style, fsBold);
    if(chkFontUnderLine.Checked) then Include(Style, fsUnderLine);

    sPrint := nil;
    if(listFont.SelCount = 0) then begin
        listFont.Selected[listFont.Items.IndexOf(DEFAULT_FONT)] := true;
        sPrint := @sFontName;
    end
    else begin
        if(edtFontMsg.Text = '') then sPrint := @sFontName
        else begin
            sTemp := edtFontMsg.Text;
            sPrint := @sTemp;
        end;
    end;

    bFilePrint := chkFontMsgFile.Checked;

    PrinterLink;

    i := 0;
    while i < listFont.Items.Count do begin
        if(listFont.Selected[i]) then begin
            sFontName := listFont.Items.Strings[i];

            if StrPos(PChar(sFontName), PChar('x1')) <> nil then
              begin
                if StrPos(PChar(sFontName), PChar('FontA')) <> nil then
                  FontPrint(sPrint^, edtFontMsg.Text, sFontName, 9, Color, Style, bFilePrint)
                else
                  FontPrint(sPrint^, edtFontMsg.Text, sFontName, 7, Color, Style, bFilePrint)
              end
            else if StrPos(PChar(sFontName), PChar('x2')) <> nil then
              begin
                if StrPos(PChar(sFontName), PChar('FontA')) <> nil then
                  FontPrint(sPrint^, edtFontMsg.Text, sFontName, 19, Color, Style, bFilePrint)
                else
                  FontPrint(sPrint^, edtFontMsg.Text, sFontName, 13, Color, Style, bFilePrint)
              end
            else if StrPos(PChar(sFontName), PChar('x4')) <> nil then
              begin
                if StrPos(PChar(sFontName), PChar('FontA')) <> nil then
                  FontPrint(sPrint^, edtFontMsg.Text, sFontName, 38, Color, Style, bFilePrint)
                else
                  FontPrint(sPrint^, edtFontMsg.Text, sFontName, 27, Color, Style, bFilePrint)
              end
            else if StrPos(PChar(sFontName), PChar('x8')) <> nil then
              begin
                if StrPos(PChar(sFontName), PChar('FontA')) <> nil then
                  FontPrint(sPrint^, edtFontMsg.Text, sFontName, 77, Color, Style, bFilePrint)
                else
                  FontPrint(sPrint^, edtFontMsg.Text, sFontName, 54, Color, Style, bFilePrint)
              end
        end;
        inc(i);
    end;

    CloseFile(fhMsg);
end;

procedure TfrmMain.PrintFile(sFile, sFontName : string; iFontSize : integer; Color : TColor; Style : TFontStyles);
var
    fhFile : TextFile;
    sTemp : string;
begin
    AssignFile(fhFile,sFile);
    try
        Reset(fhFile);
        Printer.Canvas.Font.Name := sFontName;
        Printer.Canvas.Font.Size := iFontSize;
        Printer.Canvas.Font.Color := Color;
        Printer.Canvas.Font.Style := Style;
        while not(EOF(fhFile))do begin
            ReadLn(fhFile,sTemp);
            WriteLn(fhMsg,sTemp);
        end;
        WriteLn(fhMsg,sFontName);
    finally
        CloseFile(fhFile);
    end;
end;

procedure TfrmMain.btnPicrureFindClick(Sender: TObject);
begin
    if not(OpenPictureDialog1.Execute) then exit;
    OpenPictureDialog1.InitialDir := ExtractFilePath(OpenDialog1.FileName);
    edtPicture.Text := OpenPictureDialog1.FileName;
    try
        Image1.Picture.LoadFromFile(edtPicture.Text);
    except
    end;
end;

procedure TfrmMain.ProcPicrure;
    procedure PrintPicture(ARect : TRect; ABitmap : TBitmap);
    var
        Info : PBitmapInfo;
        InfoSize : DWORD;
        Image : Pointer;
        ImageSize : DWORD;
        Bits : HBITMAP;
        DIBWidth, DIBHeight : LongInt;
        PrinterWidth, PrinterHeight : integer;
    begin
        with Printer, Canvas do begin
            Bits := ABitmap.Handle;
            GetDIBSizes(Bits,InfoSize,ImageSize);
            Info := AllocMem(InfoSize);
            try
                Image := AllocMem(ImageSize);
                try
                    GetDIB(Bits, ABitmap.Palette, Info^, Image^);
                    with Info^.bmiHeader do begin
                        DIBWidth := biWidth;
                        DIBHeight := biHeight;
                    end;
                    PrinterWidth := DIBWidth * GetDeviceCaps(Printer.Handle, LOGPIXELSX) div Screen.PixelsPerInch;
                    PrinterHeight := DIBHeight * GetDeviceCaps(Printer.Handle, LOGPIXELSY) div Screen.PixelsPerInch;

                    StretchDIBits(Printer.Canvas.Handle, 0, 0, PrinterWidth, PrinterHeight, 0, 0, DIBWidth, DIBHeight, Image, Info^, DIB_RGB_COLORS, SRCCOPY);
                finally
                    FreeMem(Image, ImageSize);
                end;
            finally
                FreeMem(Info, InfoSize);
            end;
        end;
    end;
    procedure PrintText(sPrint, sFontName : string; iFontSize, iX, iY : integer; Color : TColor; Style : TFontStyles);
    var
        Metrics : TTextMetric;
    begin
        GetTextMetrics(Printer.Handle, Metrics);
        Printer.Canvas.Font.Name := sFontName;
        Printer.Canvas.Font.Size := iFontSize;
        Printer.Canvas.Font.Color := Color;
        Printer.Canvas.Font.Style := Style;
        Printer.Canvas.TextOut(iX , iY + Metrics.tmAscent, sPrint);
    end;
begin
    Printer.BeginDoc;
    PrintPicture(Image1.Picture.Bitmap.Canvas.ClipRect, Image1.Picture.Bitmap);
    Printer.EndDoc;
end;

procedure TfrmMain.LoadDriver;
var
    i : integer;
begin
    for i := 0 to Printer.Printers.Count - 1 do
        cbDriver.Items.Add(Printer.Printers.Strings[i]);

    cbDriver.ItemIndex := cbDriver.Items.IndexOf(DRIVER_NAME);
end;

procedure TfrmMain.btnCutClick(Sender: TObject);
begin
    Printer.PrinterIndex := cbDriver.ItemIndex;
    PrinterLink;

    if(chkCutWPF.Checked) then Print('g', CONTROL_FONT, 9, clBlack, [])
    else Print('P', CONTROL_FONT, 9, clBlack, []);

    CloseFile(fhMsg);
end;

procedure TfrmMain.btnCDOpenClick(Sender: TObject);
var
    sControl : string;
begin
    if(rdoCD1.Checked) then begin
        case cbDPW.ItemIndex of
            0:  sControl := 'A';
            1:  sControl := 'B';
            2:  sControl := 'C';
            3:  sControl := 'D';
            4:  sControl := 'E';
        end;
    end
    else begin
        case cbDPW.ItemIndex of
            0:  sControl := 'a';
            1:  sControl := 'b';
            2:  sControl := 'c';
            3:  sControl := 'd';
            4:  sControl := 'e';
        end;
    end;
    PrinterLink;
    Print(sControl, CONTROL_FONT, 9, clBlack, []);
    CloseFile(fhMsg);
end;

procedure TfrmMain.PageControl1Change(Sender: TObject);
begin
    case PageControl1.ActivePageIndex of
        0: btnPrint.Enabled := true;
        1: btnPrint.Enabled := true;
        2: btnPrint.Enabled := false;
        3: btnPrint.Enabled := true;
    end;
end;

procedure TfrmMain.btnFontMsgFileClick(Sender: TObject);
begin
    if not(OpenDialog1.Execute) then exit;
    OpenDialog1.InitialDir := ExtractFilePath(OpenDialog1.FileName);
    edtFontMsg.Text := OpenDialog1.FileName;
end;

procedure TfrmMain.chkFontMsgFileClick(Sender: TObject);
begin
    if(chkFontMsgFile.Checked) then
        btnFontMsgFile.Enabled := true
    else
        btnFontMsgFile.Enabled := false;
end;

procedure TfrmMain.listFontClick(Sender: TObject);
begin
    if(chkFontMsgFile.Checked) then exit;
    if(listFont.SelCount > 1) then begin
        edtFontMsg.Text := '';
        exit;
    end;
    edtFontMsg.Text := listFont.Items.Strings[listFont.ItemIndex];
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
    LoadDriver;
    Printer.Title := DRIVER_NAME;

    SetFontStyleByOS;

    listFont.ItemIndex := 0;
    cbFontColor.ItemIndex := 0;
    cbDPW.ItemIndex := 0;

    edtPicture.Text := ExtractFilePath(Application.ExeName) + 'Eng-Logo.bmp';
    OpenPictureDialog1.InitialDir := ExtractFilePath(Application.ExeName);
    OpenDialog1.InitialDir := ExtractFilePath(Application.ExeName);

    if(FileExists(edtPicture.Text)) then
        Image1.Picture.LoadFromFile(edtPicture.Text)
    else
        edtPicture.Text := '';
end;

procedure TfrmMain.SetFontStyleByOS;
    procedure SetControl(bEnable : boolean);
    begin
        chkFontBold.Enabled := bEnable;
        chkFontUnderLine.Enabled := bEnable;
    end;
var
    VI : TOSVersionInfo;
begin
    VI.dwOSVersionInfoSize := SizeOf(VI);
    GetVersionEx(VI);
    case VI.dwPlatformID of
        VER_PLATFORM_WIN32S: SetControl(true);
        VER_PLATFORM_WIN32_WINDOWS: SetControl(true);
        VER_PLATFORM_WIN32_NT: SetControl(false);
    end;
end;

procedure TfrmMain.listFontDrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
var
    sFontName : string;
begin
    sFontName := listFont.Items.Strings[Index];

    listFont.Canvas.TextRect(Rect, Rect.Left, Rect.Top, listFont.Items.Strings[Index]);
end;

procedure TfrmMain.listFontMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
    sFontName : string;
    Index : integer;
begin
    Index := listFont.ItemIndex;
    sFontName := listFont.Items.Strings[Index];
end;

end.
