On 14/03/2008, Rainer Stratmann <[EMAIL PROTECTED]> wrote:
> Exists there documentation about X11 interface?
> Or an example program?
Here is a basic example as show in many X11 documentation.
As I said, fpGUI will do all this hard work for you. ;-)
You can compile it as follows: fpc basicwin.pas
-------------------[ basicwin.pas ]--------------------
program basicwin;
{$mode objfpc}{$H+}
uses
SysUtils, xlib, x, xutil;
const
IconBitmapWidth = 40;
IconBitmapHeight = 40;
IconBitmapBits: packed array[1..200] of Byte = (
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $80, $00,
$00, $00, $00, $40, $00, $00, $10, $00, $20, $00, $00, $20,
$00, $10, $00, $00, $40, $00, $10, $00, $00, $80, $00, $08,
$00, $00, $00, $01, $04, $00, $00, $00, $01, $02, $00, $00,
$00, $02, $01, $00, $00, $00, $84, $00, $00, $00, $00, $48,
$00, $00, $00, $00, $30, $00, $00, $00, $00, $20, $00, $00,
$00, $00, $50, $00, $00, $00, $00, $88, $00, $00, $00, $00,
$04, $01, $00, $00, $00, $02, $02, $00, $00, $00, $01, $02,
$00, $00, $80, $00, $04, $00, $00, $40, $00, $08, $00, $00,
$40, $00, $10, $00, $00, $20, $00, $20, $00, $00, $10, $00,
$00, $00, $00, $08, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00);
BITMAPDEPTH = 1;
TOO_SMALL = 0;
BIG_ENOUGH = 1;
var
Display: PDisplay;
ScreenNum: Integer;
ProgName: String;
procedure CheckMemory(P: Pointer);
begin
if P = nil then
begin
Writeln(ProgName,': Failure Allocating Memory');
Halt(0);
end;
end;
procedure GetDC(Win: TWindow;var GC: TGC; FontInfo: PXFontStruct);
const
DashList: packed array[1..2] of Byte = (12, 24);
var
ValueMask: Cardinal;
Values: TXGCValues;
LineWidth: Cardinal;
LineStyle: Integer;
CapStyle: Integer;
JoinStyle: Integer;
DashOffset: Integer;
ListLength: Integer;
begin
ValueMask := 0;
LineWidth := 6;
LineStyle := LineOnOffDash;
CapStyle := CapRound;
JoinStyle := JoinRound;
DashOffset := 0;
ListLength := 2;
FillChar(Values, SizeOf(Values), 0);
GC := XCreateGC(Display, Win, ValueMask, @Values);
XSetFont(Display, GC, FontInfo^.fid);
XSetForeground(Display, GC, XBlackPixel(Display, ScreenNum));
XSetLineAttributes(Display, GC, LineWidth, LineStyle, CapStyle, JoinStyle);
XSetDashes(Display, GC, DashOffSet, @DashList, ListLength);
end;
procedure LoadFont(var FontInfo: PXFontStruct);
const
FontName: PChar = '9x15';
begin
Writeln('Font Struct:', SizeOf(TXFontStruct));
FontInfo := XLoadQueryFont(Display, FontName);
if FontInfo = nil then
begin
Writeln(Progname, ': Cannot open 9x15 font.');
Halt(1);
end;
end;
procedure PlaceText(Win: TWindow; GC: TGC; FontInfo: PXFontStruct;
WinWidth, WinHeight: Cardinal);
const
String1: PChar = 'Hi! I''m a window, who are you?';
String2: PChar = 'To terminate program; Press any key';
String3: PChar = 'or button while in this window.';
String4: PChar = 'Screen dimensions:';
var
Len1, Len2, Len3, Len4: Integer;
Width1, Width2, Width3: Integer;
CDHeight, CDWidth, CDDepth: PChar; // array[0..49] of Char;
FontHeight: Integer;
InitialYOffset, XOffset: Integer;
Top, Left: Integer;
begin
Writeln('#1');
Len1 := StrLen(String1);
Len2 := StrLen(String2);
Len3 := StrLen(String3);
Writeln('#2');
Width1 := XTextWidth(FontInfo, String1, Len1);
Width2 := XTextWidth(FontInfo, String2, Len2);
Width3 := XTextWidth(FontInfo, String3, Len3);
FontHeight := FontInfo^.Ascent + FontInfo^.Descent;
XDrawString(Display, Win, GC, (WinWidth - Width1) div 2, FontHeight, String1,
Len1);
Writeln('#2.2 ', Len2, ' ', String2);
Left := (WinWidth - Width2);
Writeln('#2.2.5 Here');
Left := Left div 2;
Top := WinHeight - FontHeight * 2;
Writeln('#2.3 Top:', Top, ' Left:', Left);
XDrawString(Display, Win, GC, Left, Top, String2, Len2);
Writeln('#2.3');
XDrawString(Display, Win, GC, (WinWidth - Width3) div 2,
WinHeight - FontHeight, String3, Len3);
Writeln('#3');
CDHeight := PChar(Format(' Height = %d pixels', [XDisplayHeight(Display,
ScreenNum)]));
CDWidth := PChar(Format(' Width = %d pixels', [XDisplayWidth(Display,
ScreenNum)]));
CDDepth := PChar(Format(' Depth = %d plane(s)', [XDefaultDepth(Display,
ScreenNum)]));
Len4 := StrLen(String4);
Len1 := StrLen(CDHeight);
Len2 := StrLen(CDWidth);
Len3 := StrLen(CDDepth);
Writeln('#4');
InitialYOffset := WinHeight div 2 - FontHeight - FontInfo^.descent;
XOffset := WinWidth div 4;
XDrawString(Display, Win, GC, XOffset, InitialYOffset, String4, Len4);
XDrawString(Display, Win, GC, XOffset, InitialYOffset + FontHeight,
CDHeight, Len1);
XDrawString(Display, Win, GC, XOffset, InitialYOffset + 2 * FontHeight,
CDWidth, Len2);
XDrawString(Display, Win, GC, XOffset, InitialYOffset + 3 * FontHeight,
CDDepth, Len3);
Writeln('#5');
end;
procedure PlaceGraphics(Win: TWindow; GC: TGC;
WindowWidth, WindowHeight: Cardinal);
var
X, Y: Integer;
Width, Height: Integer;
begin
Writeln('Window: ', Integer(Win));
Writeln('GC: ', INteger(GC));
Height := WindowHeight div 2;
Width := 3 * WindowWidth div 4;
X := WindowWidth div 2 - Width div 2;
Y := WindowHeight div 2 - Height div 2;
XDrawRectangle(Display, Win, GC, X, Y, Width, Height);
end;
procedure TooSmall(Win: TWindow; GC: TGC; FontInfo: PXFontStruct);
const
String1: PChar = 'Too Small';
var
YOffset, XOffset: Integer;
begin
YOffset := FontInfo^.Ascent + 2;
XOffset := 2;
XDrawString(Display, Win, GC, XOffset, YOffset, String1, StrLen(String1));
end;
var
Win: TWindow;
Width, Height: Word;
Left, Top: Integer;
BorderWidth: Word = 4;
DisplayWidth, DisplayHeight: Word;
// IconWidth, IconHeight: Word;
WindowNameStr: PChar = 'Basic Window Program';
IconNameStr: PChar = 'basicWin';
IconPixmap: TPixmap;
SizeHints: PXSizeHints;
SizeList: PXIconSize;
WMHints: PXWMHints;
ClassHints: PXClassHint;
WindowName, IconName: TXTextProperty;
Count: Integer;
Report: TXEvent;
GC: TGC;
FontInfo: PXFontStruct;
DisplayName: PChar = nil;
WindowSize: Integer = 0;
begin
ProgName := ParamStr(0);
// ProgName := 'BasicWin'; //JJS Remove when 80999 is fixed.
SizeHints := XAllocSizeHints;
CheckMemory(SizeHints);
WMHints := XAllocWMHints;
CheckMemory(WMHints);
ClassHints := XAllocClassHint;
CheckMemory(ClassHints);
Display := XOpenDisplay(DisplayName);
if Display = nil then
begin
Writeln(ProgName,': cannot connect to XServer',
XDisplayName(DisplayName));
Halt(1);
end;
ScreenNum := XDefaultScreen(Display);
DisplayWidth := XDisplayWidth(Display, ScreenNum);
DisplayHeight := XDisplayHeight(Display, ScreenNum);
Left := 0; Top := 0;
Width := DisplayWidth div 4; Height := DisplayHeight div 4;
Win := XCreateSimpleWindow(Display, XRootWindow(Display, ScreenNum),
Left, Top, Width, Height, BorderWidth, XBlackPixel(Display, ScreenNum),
XWhitePixel(Display, ScreenNum));
if XGetIconSizes(Display, XRootWindow(Display, ScreenNum), @SizeList,
@Count) = 0
then
Writeln('Window Manager didn''t set icon sizes - using default')
else
begin
end;
IconPixMap := XCreateBitmapFromData(Display, Win, @IconBitmapBits,
IconBitmapWidth, IconBitmapHeight);
SizeHints^.flags := PPosition or PSize or PMinSize;
SizeHints^.min_width := 300;
SizeHints^.min_height:= 200;
if XStringListToTextProperty(@WindowNameStr, 1, @WindowName) = 0 then
begin
Writeln(Progname, ': structure allocation for window name failed.');
Halt(1);
end;
if XStringListToTextProperty(@IconNameStr, 1, @IconName) = 0 then
begin
Writeln(Progname, ': structure allocqation for icon name failed.');
Halt(1);
end;
WMHints^.initial_state := NormalState;
WMHints^.input := True;
WMHints^.icon_pixmap := IconPixmap;
WMHints^.flags := StateHint or IconPixmapHint or InputHint;
ClassHints^.res_name := PChar(ProgName);
ClassHints^.res_class := 'BasicWin';
XSetWMProperties(Display, Win, @WindowName, @IconName, nil, 0, SizeHints,
WMHints, ClassHints);
XSelectInput(Display, Win, ExposureMask or KeyPressMask or ButtonPressMask
or StructureNotifyMask);
LoadFont(FontInfo);
GetDC(win, GC, FontInfo);
XMapWindow(Display, Win);
while True do
begin
XNextEvent(Display, @Report);
case Report._type of
Expose:
begin
Writeln('Expose');
if Report.xexpose.count = 0 then
begin
if WindowSize = TOO_SMALL then
TooSmall(Win, GC, FontInfo)
else
begin
PlaceText(Win, GC, FontInfo, Width, Height); //*** Fails
PlaceGraphics(Win, GC, Width, Height);
end;
end;
end;
ConfigureNotify:
begin
Writeln('Configure Notify');
Width := Report.xconfigure.Width;
Height := Report.xconfigure.Height;
Writeln(' Width: ', Width);
Writeln(' Height: ', Height);
if (width < SizeHints^.min_width) or
(Height < SizeHints^.min_height)
then
WindowSize := TOO_SMALL
else
WindowSize := BIG_ENOUGH;
end;
ButtonPress:
begin
Writeln('ButtonPress');
end;
KeyPress:
begin
Writeln('KeyProcess');
XUnloadFont(Display, FontInfo^.fid);
XFreeGC(Display, GC);
XCloseDisplay(Display);
halt(0);
end;
else
end;
end;
Writeln('End.');
end.
----------------------[ end ]------------------------
Regards,
- Graeme -
_______________________________________________
fpGUI - a cross-platform Free Pascal GUI toolkit
http://opensoft.homeip.net/fpgui/
_______________________________________________
fpc-pascal maillist - fpc-pascal@lists.freepascal.org
http://lists.freepascal.org/mailman/listinfo/fpc-pascal
