freepascal.ru

Вопрос : Нарисовать часы со стрелками в MSEIDE.

Среда : MSEide
Операционная система : любая
Источник : закрома Родины
Теги : Часы со стрелками, MSEide

Создаем новый проект. На форму помещаем ttimer1 и tpaintbox1

В object inspector :
Создаем событие у tpaintbox1.onpaint
Создаем событие у ttimer1.ontimer
Включаем ttimer1 : ttimer1.enabled = true

Пишем код:

Код: Выделить всё

unit main;
{$ifdef FPC}{$mode objfpc}{$h+}{$endif}
interface
uses
msetypes,mseglob,mseguiglob,mseguiintf,mseapplication,msestat,msemenus,msegui,
msegraphics,msegraphutils,mseevent,mseclasses,msewidgets,mseforms,
msesimplewidgets,msetimer;

type
tmainfo = class(tmainform)
   tpaintbox1: tpaintbox;
   ttimer1: ttimer;
   procedure on_timer(const sender: TObject);
   procedure on_paint(const sender: twidget; const acanvas: tcanvas);
end;
var
mainfo: tmainfo;
hour, min, sec, sec100: WORD;

implementation
uses
main_mfm, dos;


procedure tmainfo.on_paint(const sender: twidget; const acanvas: tcanvas);
var center, p1,p2 : pointty;
    i : integer;
    q, sinA, cosA: REAL;
    x1, y1, x2, y2: INTEGER;
    radius1, radius2 : integer;
   
   procedure draw_arr(qq : real; _sectors, _length : integer; _color : colorty);
   begin
    sinA := Sin( (qq + 45) * Pi*2/_sectors);
    cosA := Cos( (qq + 45) * Pi*2/_sectors);
   
    x1 := Round(radius2 * cosA);
    y1 := Round(radius2 * sinA);
    x2 := Round((radius1-_length)*cosA);
    y2 := Round((radius1-_length)*sinA);
 
    p1.x := x1 + center.x;
    p1.y := y1 + center.y;
    p2.x := x2 + center.x;
    p2.y := y2 + center.y;
   
    acanvas.DRAWLine(p1, p2, _color);
   end;
   
begin
  with acanvas do
  begin
  smooth := true;
  center.x := tpaintbox1.width div 2 - 1;
  center.y := tpaintbox1.height div 2 - 1;
  if tpaintbox1.width > tpaintbox1.height
     then radius1 := center.y - tpaintbox1.frame.framewidth * 2
     else radius1 := center.x - tpaintbox1.frame.framewidth * 2;
  radius2 := 5;

  //drow hour sections
  q:=0;
  linewidth := 8;
  FOR i := 1 TO 12 DO
    BEGIN
      sinA := Sin(q * Pi/180);
      cosA := Cos(q * Pi/180);
     
      x1 := Round(radius1 * cosA);
      y1 := Round(radius1 * sinA);
      x2 := Round((radius1-radius2 - 5) * cosA);
      y2 := Round((radius1-radius2 - 5) * sinA);
     
      p1.x := x1 + center.x;
      p1.y := y1 + center.y;
      p2.x := x2 + center.x;
      p2.y := y2 + center.y;
     
      DRAWLine(p1, p2, cl_red);
      q := q + 30;
    END;

  //drow minute sections
  q:=90;
  linewidth := 4;
  FOR i := 1 TO 60 DO
    BEGIN
      sinA := Sin(q * Pi/180);
      cosA := Cos(q * Pi/180);
     
      x1 := Round(radius1 * cosA);
      y1 := Round(radius1 * sinA);
      x2 := Round((radius1-radius2) * cosA);
      y2 := Round((radius1-radius2) * sinA);
     
      p1.x := x1 + center.x;
      p1.y := y1 + center.y;
      p2.x := x2 + center.x;
      p2.y := y2 + center.y;
     
      DRAWLine(p1, p2, cl_red);
      q := q + 6;
    END;

//draw arrows
  linewidth := 10;
  draw_arr(hour + min/60, 12, 40, cl_black);
  linewidth := 7;
  draw_arr(min + sec/60, 60, 20, cl_blue);
  linewidth := 3;
  draw_arr(sec, 60, 10, cl_red);

  //draw rounds
  linewidth := 5;
  drawCircle( center, radius1, cl_red);
  drawCircle( center, radius2, cl_red);
  end;
end;

procedure tmainfo.on_timer(const sender: TObject);
begin
    GetTime(hour, min, sec, sec100);
    tpaintbox1.invalidate;//invalidatewidget;
end;