Varsayılan Yazıcı

Delphi'de kod yazma ile ilgili sorularınızı bu foruma yazabilirsiniz.
Cevapla
Nomercy
Üye
Mesajlar: 62
Kayıt: 17 Kas 2014 12:33

Varsayılan Yazıcı

Mesaj gönderen Nomercy »

Arkadaşlar Varsayılan Yazıcıyı Label4 e Yazdıramadım. Yardımcı Olurmusunuz? Birde Çift Tıklayıp Değişincede Yeni Varsayılan Yazıcı Label4 dede görünsün

Form Tasarımım:

Resim

Kullandığım Kodlar:

Kod: Tümünü seç

unit yazici;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, cxGraphics, cxLookAndFeels, cxLookAndFeelPainters,
  Menus, dxSkinsCore, dxSkinBlack, dxSkinBlue, dxSkinBlueprint,
  dxSkinCaramel, dxSkinCoffee, dxSkinDarkRoom, dxSkinDarkSide,
  dxSkinDevExpressDarkStyle, dxSkinDevExpressStyle, dxSkinFoggy,
  dxSkinGlassOceans, dxSkinHighContrast, dxSkiniMaginary, dxSkinLilian,
  dxSkinLiquidSky, dxSkinLondonLiquidSky, dxSkinMcSkin, dxSkinMoneyTwins,
  dxSkinOffice2007Black, dxSkinOffice2007Blue, dxSkinOffice2007Green,
  dxSkinOffice2007Pink, dxSkinOffice2007Silver, dxSkinOffice2010Black,
  dxSkinOffice2010Blue, dxSkinOffice2010Silver, dxSkinPumpkin, dxSkinSeven,
  dxSkinSevenClassic, dxSkinSharp, dxSkinSharpPlus, dxSkinSilver,
  dxSkinSpringTime, dxSkinStardust, dxSkinSummer2008,
  dxSkinTheAsphaltWorld, dxSkinsDefaultPainters, dxSkinValentine,
  dxSkinVS2010, dxSkinWhiteprint, dxSkinXmas2008Blue, cxButtons, XPMan;

  const
  MAXPRINTERBUFFER = 8000;
  MAXPRINTERNAME = 500;
  MAXPRINTERINFO = 50;

  type
  TPrinterBuffer = array[0..MAXPRINTERBUFFER - 1] of char;
  TFrmYaziciAyarla = class(TForm)
  Label1: TLabel;
  XPManifest1: TXPManifest;
  ListBox1: TListBox;
  Label2: TLabel;
  cxButton1: TcxButton;
    Label3: TLabel;
    Label4: TLabel;
  procedure FormCreate(Sender: TObject);
  procedure GetPrinterNames;
  function ParseNames(const namebuffer: TPrinterBuffer; var startPos: integer): string;
  function SetPrinter(const PrinterName : String) : boolean;
  procedure ListBox1DblClick(Sender: TObject);
  procedure cxButton1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FrmYaziciAyarla: TFrmYaziciAyarla;
  printerNames: TStringList;
  defaultPrinter: integer;

implementation

{$R *.dfm}

procedure TFrmYaziciAyarla.GetPrinterNames;
var
  buffer: TPrinterBuffer;
  currPos: integer;
  printerName: string;
begin
  printerNames.Free;
  printerNames := TStringList.Create;
  if GetProfileString(PChar('PrinterPorts'), nil, '', buffer, MAXPRINTERBUFFER) > 0 then
  begin
    currPos := 0;
    while (true) do
      begin
        printerName := ParseNames(buffer, currPos);
        if printerName <> '' then
        printerNames.Add(printerName)
    else
      break;
    end;
  end;
end;

function TFrmYaziciAyarla.ParseNames(const namebuffer: TPrinterBuffer;
var startPos: integer): string;
var
  i, j, NameLength: integer;
  str: string;
begin
  result := '';
  if (startPos > High(namebuffer)) or (namebuffer[startPos] = Chr(0))  
  then
    exit;
  for i := startPos to High(namebuffer) do begin
    if namebuffer[i] = Chr(0) 
    then begin
      nameLength := i - startPos;
      SetLength(str, nameLength);
      for j := 0 to nameLength - 1 do
      str[j+1] := namebuffer[startPos + j];
      result := str;
      startPos := i + 1;
      break;
    end;
  end;
end;

function TFrmYaziciAyarla.SetPrinter(const PrinterName: String): boolean;
var
  s2 : string;
  dum1 : Pchar;  
  xx, qq : integer;
const
  cs1 : pchar = 'Windows';
  cs2 : pchar = 'Device';
  cs3 : pchar = 'Devices';
  cs4 : pchar = #0;

begin
  xx := 254;
  GetMem( dum1, xx);
  Result := False;
  try
    qq := GetProfileString( cs3, pchar( printerName ), #0, dum1, xx);
    if (qq > 0) and (trim( strpas( dum1 )) <> '') 
   then begin
      s2 := PrinterName + ',' + strpas( dum1 );
      while GetProfileString( cs1, cs2, cs4, dum1, xx) > 0 do
        WriteProfileString( cs1, cs2, #0);
      WriteProfileString( cs1, cs2, pchar( s2 ));
      case Win32Platform of
       VER_PLATFORM_WIN32_NT :
        // SendMessage( HWND_BROADCAST, WM_WININICHANGE, 0, LongInt(cs1));
        // VER_PLATFORM_WIN32_WINDOWS :
        // SendMessage( HWND_BROADCAST, WM_SETTINGCHANGE, 0, LongInt(cs1));
     end; 
  Result := True;
end;
finally
  FreeMem( dum1 );
end;
end;


procedure TFrmYaziciAyarla.cxButton1Click(Sender: TObject);
begin
Close;
end;

procedure TFrmYaziciAyarla.FormCreate(Sender: TObject);
begin
GetPrinterNames;
Listbox1.Items.AddStrings(PrinterNames);
end;

procedure TFrmYaziciAyarla.ListBox1DblClick(Sender: TObject);
var
  x : integer;
begin
  try
  for x := 0 to printerNames.Count -1 do begin
    If ListBox1.Selected[x] then begin
      if (SetPrinter(ListBox1.Items.Strings[x]))
      then
      begin
      Application.MessageBox('Varsayılan Yazıcı Başarıyla Ayarlanmıştır.','Başarılı',MB_ICONINFORMATION+MB_OK)
        end
      else
      begin
        Application.MessageBox('Varsayılan Yazıcı Ayarlanamamıştır.','Başarısız',MB_ICONSTOP+MB_OK);
           end;
    end;
  end;
  except
    Application.MessageBox('Yazıcıyı Ayarlama Sırasında Bir Hata Oluştu','Hata',MB_ICONSTOP+MB_OK);
  end;
end;


end.
Nomercy
Üye
Mesajlar: 62
Kayıt: 17 Kas 2014 12:33

Re: Varsayılan Yazıcı

Mesaj gönderen Nomercy »

Yardımcı Olacak Kimse Yok mu?
Kullanıcı avatarı
ovural
Üye
Mesajlar: 167
Kayıt: 22 Eki 2003 10:20
İletişim:

Re: Varsayılan Yazıcı

Mesaj gönderen ovural »

Kod: Tümünü seç

uses printers;


Label1.Caption := Printer.Printers.Strings[ Printer.PrinterIndex ];

bu şekilde label 1 varsayılan yazıcıyı alırsın .. varsayılan yazıcı değiştiğinde değişmesi için bir timer ekle belli aralıklarla aynı kodu çalıştır
Kim ilim öğrenir sonra da onu gizlerse âhirette onun ağzına ateşten bir gem vurulur. (Hadis-i Şerif)
erdogan_ozkaya
Üye
Mesajlar: 839
Kayıt: 03 Eki 2007 02:00

Re: Varsayılan Yazıcı

Mesaj gönderen erdogan_ozkaya »

Kod: Tümünü seç

unit Unit93;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, printers, Buttons;

type
  TYAZICI_AYARLARI_PENCERE_YAZICI_SEC = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    ListBox1: TListBox;
    PrinterSetupDialog1: TPrinterSetupDialog;
    ListBox2: TListBox;
    ListBox3: TListBox;
    SpeedButton2: TSpeedButton;
    SpeedButton1: TSpeedButton;
    procedure FormCreate(Sender: TObject);
    procedure FormKeyPress(Sender: TObject; var Key: Char);
    procedure ListBox1DblClick(Sender: TObject);
    procedure ListBox2DblClick(Sender: TObject);
    procedure ListBox3DblClick(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
    procedure ListBox2Click(Sender: TObject);
    procedure ListBox3Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  YAZICI_AYARLARI_PENCERE_YAZICI_SEC: TYAZICI_AYARLARI_PENCERE_YAZICI_SEC;

implementation

uses Unit73;

{$R *.dfm}

procedure TYAZICI_AYARLARI_PENCERE_YAZICI_SEC.FormCreate(Sender: TObject);
begin
 //yüklü yazici listesini listbox1 e yükle
 listbox1.Items:=printer.Printers;
 listbox1.ItemIndex :=printer.printerindex; //aktif yaziciyi işaretle
 printer.Title :='Deneme Çıktısı'; // yazicida görünen dosya başlığını belirle
 label2.Caption:='Geçerli Yazıcı: '+printer.Printers[printer.printerindex];
 label3.Caption:='Sayfa Ebatları (Nokta): '+inttostr(printer.PageHeight)+' x '
 +inttostr(printer.PageWidth);

 
 //yüklü yazici listesini listbox1 e yükle
 listbox2.Items:=printer.Printers;
 listbox2.ItemIndex :=printer.printerindex; //aktif yaziciyi işaretle
 printer.Title :='Deneme Çıktısı'; // yazicida görünen dosya başlığını belirle
 label2.Caption:='Geçerli Yazıcı: '+printer.Printers[printer.printerindex];
 label3.Caption:='Sayfa Ebatları (Nokta): '+inttostr(printer.PageHeight)+' x '
 +inttostr(printer.PageWidth);

 
 //yüklü yazici listesini listbox1 e yükle
 listbox3.Items:=printer.Printers;
 listbox3.ItemIndex :=printer.printerindex; //aktif yaziciyi işaretle
 printer.Title :='Deneme Çıktısı'; // yazicida görünen dosya başlığını belirle
 label2.Caption:='Geçerli Yazıcı: '+printer.Printers[printer.printerindex];
 label3.Caption:='Sayfa Ebatları (Nokta): '+inttostr(printer.PageHeight)+' x '
 +inttostr(printer.PageWidth);
end;

procedure TYAZICI_AYARLARI_PENCERE_YAZICI_SEC.FormKeyPress(Sender: TObject;
  var Key: Char);
begin
  if Key=#27 then
       Close;
end;

procedure TYAZICI_AYARLARI_PENCERE_YAZICI_SEC.ListBox1DblClick(
  Sender: TObject);
var
        yer : Integer;
begin
        yer := ListBox1.ItemIndex;
 printer.PrinterIndex :=listbox1.ItemIndex; //tiklanan yaziciyi varsayilan yap
 label2.Caption:='Geçerli Yazıcı: '+printer.Printers[printer.printerindex];
 label3.Caption:='Sayfa Ebatları (Nokta): '+inttostr(printer.PageHeight)+' x '
 +inttostr(printer.PageWidth);

 YAZICI_AYARLARI_PENCERE.RzNumericEdit1.Text:=IntToStr(yer);
 close;
end;

procedure TYAZICI_AYARLARI_PENCERE_YAZICI_SEC.ListBox2DblClick(
  Sender: TObject);
var
        yer : Integer;
begin
        yer := ListBox2.ItemIndex;
 printer.PrinterIndex :=listbox2.ItemIndex; //tiklanan yaziciyi varsayilan yap
 label2.Caption:='Geçerli Yazıcı: '+printer.Printers[printer.printerindex];
 label3.Caption:='Sayfa Ebatları (Nokta): '+inttostr(printer.PageHeight)+' x '
 +inttostr(printer.PageWidth);

 YAZICI_AYARLARI_PENCERE.RzNumericEdit2.Text:=IntToStr(yer);
 close;
end;

procedure TYAZICI_AYARLARI_PENCERE_YAZICI_SEC.ListBox3DblClick(
  Sender: TObject);
var
        yer : Integer;
begin
        yer := ListBox3.ItemIndex;
 printer.PrinterIndex :=listbox3.ItemIndex; //tiklanan yaziciyi varsayilan yap
 label2.Caption:='Geçerli Yazıcı: '+printer.Printers[printer.printerindex];
 label3.Caption:='Sayfa Ebatları (Nokta): '+inttostr(printer.PageHeight)+' x '
 +inttostr(printer.PageWidth);

 YAZICI_AYARLARI_PENCERE.RzNumericEdit3.Text:=IntToStr(yer);
 close;
end;

procedure TYAZICI_AYARLARI_PENCERE_YAZICI_SEC.ListBox1Click(
  Sender: TObject);
var
        yer : Integer;
begin
        yer := ListBox1.ItemIndex;
 printer.PrinterIndex :=listbox1.ItemIndex; //tiklanan yaziciyi varsayilan yap
 label2.Caption:='Geçerli Yazıcı: '+printer.Printers[printer.printerindex];
 label3.Caption:='Sayfa Ebatları (Nokta): '+inttostr(printer.PageHeight)+' x '
 +inttostr(printer.PageWidth);


end;

procedure TYAZICI_AYARLARI_PENCERE_YAZICI_SEC.ListBox2Click(
  Sender: TObject);
var
        yer : Integer;
begin
        yer := ListBox2.ItemIndex;
 printer.PrinterIndex :=listbox2.ItemIndex; //tiklanan yaziciyi varsayilan yap
 label2.Caption:='Geçerli Yazıcı: '+printer.Printers[printer.printerindex];
 label3.Caption:='Sayfa Ebatları (Nokta): '+inttostr(printer.PageHeight)+' x '
 +inttostr(printer.PageWidth);

end;

procedure TYAZICI_AYARLARI_PENCERE_YAZICI_SEC.ListBox3Click(
  Sender: TObject);
var
        yer : Integer;
begin
        yer := ListBox3.ItemIndex;
 printer.PrinterIndex :=listbox3.ItemIndex; //tiklanan yaziciyi varsayilan yap
 label2.Caption:='Geçerli Yazıcı: '+printer.Printers[printer.printerindex];
 label3.Caption:='Sayfa Ebatları (Nokta): '+inttostr(printer.PageHeight)+' x '
 +inttostr(printer.PageWidth);
end;

procedure TYAZICI_AYARLARI_PENCERE_YAZICI_SEC.SpeedButton1Click(
  Sender: TObject);
begin
   close;
end;

procedure TYAZICI_AYARLARI_PENCERE_YAZICI_SEC.SpeedButton2Click(
  Sender: TObject);
begin
 PrinterSetupDialog1.Execute;
end;

end.
Cevapla