Помощь - Поиск - Пользователи - Календарь
Полная версия: милиметровка в делфи
Форум «Всё о Паскале» > Delphi, Assembler и другие языки. > Delphi
amega
добрый день!
я нашол исходник милиметровки в дефи но не как не могу понять где поменять цвет а то очень темный лист получается хотелось бы посветлей(цвет примерно оранжевый)


program PrnGrid;

 

uses

Dialogs,

Printers,

Windows,

Types;

 

{$R *.res}

 

function GetPenWidth(I: Integer): Integer;

begin

if I mod 100 = 0 then

   Result := 45

else if I mod 50 = 0 then

   Result := 30

else if I mod 10 = 0 then

   Result := 20

else if I mod 5 = 0 then

   Result := 15

else

   Result := 10;

end;

 

var

PageRect: TRect;

I, J: Integer;

begin

with TPrintDialog.Create(nil) do

try

   if not Execute then

     Exit;

finally

   Free;

end;

 

PageRect := Rect(0, 0, Printer.PageWidth, Printer.PageHeight);

Printer.Title := 'Милиметровка';

Printer.BeginDoc;

try

   try

     with Printer.Canvas do

     begin

       SetMapMode(Handle, MM_HIMETRIC);

       DPtoLP(Handle, PageRect, 2);

 

       with PageRect do

       begin

        Inc(Left, 1000);

        Dec(Top, 1000);

        Dec(Right, 1000);

        Inc(Bottom, 1000);

       end;

 

       J := 0;

       I := PageRect.Left;

       while I < PageRect.Right  do

       begin

         Pen.Width := GetPenWidth(J);

         MoveTo(I, PageRect.Top);

         LineTo(I, PageRect.Bottom);

         Inc(I, 100);

         Inc(J);

       end;

 

       J := 0;

       I := PageRect.Top;

       while I > PageRect.Bottom do

       begin

         Pen.Width := GetPenWidth(J);

         MoveTo(PageRect.Left, I);

         LineTo(PageRect.Right, I);

         Dec(I, 100);

         Inc(J);

       end;

     end;

   except

     Printer.Abort;

     raise;

   end;

finally

   Printer.EndDoc;

end;

end.

volvo
Цитата
не могу понять где поменять цвет
Наверное, установить тот цвет, который тебе нужен. Ну, например,

       I := PageRect.Left;
       Pen.Color := RGB($CC, $99, $33); // Вот тут ...

       while I < PageRect.Right  do ...
amega
volvo
огромное спасибо!
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.