[lazarus] Pixels, pixels and pixels

[Luis R. Hilario]

This mail has two programs (three archives): pixel.pp and unidad1.pp are
hello.pp modified
pixel1.pp is scribble.pp modified to draw lines.

The first program does not work:
[TCustomForm.Create] Resource 'THELLO' not found
This is for information purposes only.   This is not critical at this
time.
An unhandled exception occurred at 0x080731B6 :
Access violation
  0x080731B6  TCUSTOMFORM__GETCANVAS,  line 729 of
./include/customform.inc
  0x00000001
  0x080C4D44  main,  line 13 of lcllinux.pp 

The example that is in the program testall.pp yes works.

The second I created it to see as that of the pixels in GTK works,
but I do not see that the function "gdk_draw_point()" is used in
Lazarus.
-- 
 |-----------------------------|
| Luis R. Hilario               |
| http://www.luisdigital.2y.net |
 |-----------------------------|

unit unidad1;

{$mode objfpc}
 {$H+}
interface

uses classes, forms, buttons, graphics;

type
   THello = class(TForm)
   private
   protected
   public
      button1 : TButton;
      constructor Create(AOwner: TComponent); override;
      procedure button1Click(Sender : TObject);
   end;

var
   Hello : THello;

implementation

constructor THello.Create(AOwner: TComponent);
begin
   inherited Create(AOwner);
   Caption := 'Hello World';
   Width := 200;
   Height := 200;
   Left := 200;
   Top := 200;


   button1 := TButton.Create(Self);
   button1.OnClick := @button1click;
   button1.Parent := Self;
   button1.left := width-80;
   button1.top := height-35;
   button1.width := 75;
   button1.height := 32;
   button1.caption := 'Close';
   button1.Show;

with Hello do
begin
  Canvas.Pen.Style := psSolid;
  Canvas.pen.Color := clRed;
  Canvas.line(1,1,10,10);
//Canvas.Pixels[3,3] := clRed;
end;

end;

procedure THello.button1Click(Sender : TObject);
begin
  close;
end;

end.


program pixel;

{$mode objfpc}

uses forms,
     unidad1;

begin
   Application.Initialize;
   Application.CreateForm(THello, Hello);
   Application.Run;
end.


{
  $Id: scribble.pp,v 1.1.2.1 2000/09/09 18:42:51 peter Exp $

  Converted from C to Pascal by Frank Loemker
  <floemker at techfak.uni-bielefeld.de>
}
program scribble;
uses
  glib,Gdk,Gtk;

{ Backing pixmap for drawing area }
const
  pixmap : PGdkPixmap = NIL;

{ Create a new backing pixmap of the appropriate size }
function  configure_event (widget : PGtkWidget; event: PGdkEventConfigure):boolean; cdecl;
begin
  if pixmap<>NIL then
    gdk_pixmap_unref(pixmap);

  pixmap := gdk_pixmap_new(widget^.window,
                           widget^.allocation.width,
                           widget^.allocation.height,
                           -1);
  gdk_draw_rectangle (pixmap,
                      PGtkStyle(widget^.thestyle)^.white_gc,
                      gint(true),
                      0, 0,
                      widget^.allocation.width,
                      widget^.allocation.height);

  configure_event := TRUE;
end;

{ Redraw the screen from the backing pixmap }
function  expose_event (widget : PGtkWidget ; event : PGdkEventExpose ) : boolean; cdecl;
begin
  gdk_draw_pixmap(widget^.window,
                  PGtkStyle(widget^.thestyle)^.fg_gc[gtk_WIDGET_STATE (widget)],
                  pixmap,
                  event^.area.x, event^.area.y,
                  event^.area.x, event^.area.y,
                  event^.area.width, event^.area.height);
  expose_event:= FALSE;
end;

{ Draw a rectangle on the screen }
procedure draw_brush (widget : PGtkWidget ; x, y: gint16);
var update_rect : TGdkRectangle;
begin
  update_rect.x := x;
  update_rect.y := y;
  gdk_draw_point (pixmap,
                      PGtkStyle(widget^.thestyle)^.black_gc,
                      update_rect.x, update_rect.y);
  gtk_widget_draw (widget, @update_rect);
end;

function  button_press_event (widget : PGtkWidget ; event: PGdkEventButton ) : boolean; cdecl;
begin
  if (event^.button = 1) and (pixmap <> NIL) then begin
    draw_brush (widget, trunc(event^.x), trunc(event^.y));
  end;
  button_press_event := TRUE;
end;

function  motion_notify_event (widget : PGtkWidget ; event: PGdkEventMotion ) : boolean; cdecl;
var x, y : longint ;
  state  : longint;
begin
  if (event^.is_hint<>0) then begin
    gdk_window_get_pointer (event^.window, @x, @y, @state);
  end else begin
    x := trunc(event^.x);
    y := trunc(event^.y);
    state := event^.state;
  end;

  if ((state and gdk_BUTTON1_MASK)<>0) and (pixmap <> NIL) then
    draw_brush (widget, x, y);

  motion_notify_event := TRUE;
end;

procedure quit;
begin
  gtk_exit (0);
end;

var window, drawing_area, vbox, button : PGtkWidget;
begin
  gtk_init (@argc, @argv);
  gtk_rc_init;

  window := gtk_window_new (gtk_WINDOW_TOPLEVEL);
  gtk_widget_set_name (window, 'Test Input');

  vbox := gtk_vbox_new (false, 0);
  gtk_container_add (PGtkCONTAINER (window), vbox);
  gtk_widget_show (vbox);

  gtk_signal_connect (PGtkOBJECT (window), 'destroy',
                      gtk_SIGNAL_FUNC (@quit), NIL);

  { Create the drawing area }

  drawing_area := gtk_drawing_area_new ();
  gtk_drawing_area_size (PGtkDRAWINGAREA (drawing_area), 200, 200);
  gtk_box_pack_start (PGtkBOX (vbox), drawing_area, true, true, 0);

  gtk_widget_show (drawing_area);

  { Signals used to handle backing pixmap }

  gtk_signal_connect (PGtkOBJECT (drawing_area), 'expose_event',
                      gtk_SIGNAL_FUNC (@expose_event), NIL);
  gtk_signal_connect (PGtkOBJECT(drawing_area),'configure_event',
                      gtk_SIGNAL_FUNC (@configure_event), NIL);  

  { Event signals }

  gtk_signal_connect (PGtkOBJECT (drawing_area), 'motion_notify_event',
                      gtk_SIGNAL_FUNC (@motion_notify_event), NIL);
  gtk_signal_connect (PGtkOBJECT (drawing_area), 'button_press_event',
                      gtk_SIGNAL_FUNC (@button_press_event), NIL);

  gtk_widget_set_events (drawing_area, gdk_EXPOSURE_MASK
                         or gdk_LEAVE_NOTIFY_MASK
                         or gdk_BUTTON_PRESS_MASK
                         or gdk_POINTER_MOTION_MASK
                         or gdk_POINTER_MOTION_HINT_MASK);

  { .. And a quit button }
  button := gtk_button_new_with_label ('Quit');
  gtk_box_pack_start (PGtkBOX (vbox), button, false, false, 0);

  gtk_signal_connect_object (PGtkOBJECT (button), 'clicked',
                             gtk_SIGNAL_FUNC (@gtk_widget_destroy),
                             PGtkOBJECT (window));
  gtk_widget_show (button);
  gtk_widget_show (window);

  gtk_main ();
end.
{
  $Log: scribble.pp,v $
  Revision 1.1.2.1  2000/09/09 18:42:51  peter
    * gtk win32 fixes

}