Marc Santhoff wrote:
Am Dienstag, den 10.01.2006, 19:22 +0100 schrieb darekm:
[...]
I've prepare patch once more, maybe now will be better.
Sorry for delay, but now I don`t have enough time.
Thank you very much for working at this spot.
I've applied it and it is not the whole thing (or too much of it):
- TButton and TPanel do not react to setting the color at all
I've investigate setting colors under GTK
SetColor for tButton and tBitBtn now work
In attach new patch and simple program to test
Please check, if it is good way to do this.
If yes, I will prepare patch for rest of Widget
Darek
Index: interfaces/gtk/gtkproc.inc
===================================================================
--- interfaces/gtk/gtkproc.inc (wersja 8501)
+++ interfaces/gtk/gtkproc.inc (kopia robocza)
@@ -6484,6 +6484,40 @@
Returns the associated string
------------------------------------------------------------------------------}
+
+
+
+
+procedure SetWidgetColor(aWidget : PGTKwidget; data : gpointer); cdecl;
+begin
+ gtk_widget_set_style(aWidget,data);
+ if gtk_is_button(aWidget) or gtk_is_check_button(aWidget) then begin
+ gtk_container_foreach(pGtkContainer(aWidget),@SetWidgetColor,data);
+ end;
+end;
+
+procedure setWidgetBG(aColor: longint;var aWidget : pGTKWidget);
+var
+ WindowStyle: PGtkStyle;
+begin
+ windowStyle:=gtk_widget_get_style(aWidget);
+ windowstyle^.bg[0]:=AllocGDKColor(aColor);
+ SetWidgetColor(aWidget,windowStyle);
+end;
+
+procedure setWidgetFG(aColor: longint;var aWidget : pGTKWidget);
+var
+ WindowStyle: PGtkStyle;
+ xColor:tGDKColor;
+
+begin
+ windowStyle:=gtk_widget_get_style(aWidget);
+ windowstyle^.fg[0]:=AllocGDKColor(aColor);
+ SetWidgetColor(aWidget,windowStyle);
+end;
+
+
+
function GdkAtomToStr(const Atom: TGdkAtom): string;
var
p: Pgchar;
@@ -7546,9 +7580,21 @@
Widget := MainWidget;
end;
- if not GTK_WIDGET_REALIZED(Widget) then exit;
- //debugln('UpdateWidgetStyleOfControl ',GetWidgetDebugReport(Widget));
+ if (AWinControl.Color<>clNone) then begin
+ if (csOpaque in AWinControl.ControlStyle)
+ and GtkWidgetIsA(MainWidget,GTKAPIWidget_GetType) then exit;
+ if AWinControl.ColorIsStored
+ and ((AWinControl.Color and SYS_COLOR_BASE)=0) then begin
+
+ setWidgetBG(AWinControl.Color,Widget);
+ end;
+ end;
+ if (AWinControl.Font.Color and SYS_COLOR_BASE)=0 then begin
+ setWidgetFG(AWinControl.Font.Color,Widget);
+ end;
+
+
RCStyle:=nil;
FreeFontName:=false;
FreeFontSetName:=false;
@@ -7570,16 +7616,8 @@
if (csOpaque in AWinControl.ControlStyle)
and GtkWidgetIsA(MainWidget,GTKAPIWidget_GetType) then exit;
- NewColor:=TColorToTGDKColor(AWinControl.Color);
- CreateRCStyle;
- RCStyle^.bg[GTK_STATE_NORMAL]:=NewColor;
- // Indicate which colors the GtkRcStyle will affect;
- // unflagged colors will follow the theme
- RCStyle^.color_flags[GTK_STATE_NORMAL]:=
- RCStyle^.color_flags[GTK_STATE_NORMAL] or GTK_RC_BG;
-
{for i:=0 to 4 do begin
RCStyle^.bg[i]:=NewColor;
@@ -7610,34 +7648,12 @@
end;}
// set font color
- if (AWinControl.Font.Color and SYS_COLOR_BASE)=0 then begin
- //NewColor:=TColorToTGDKColor(AWinControl.Font.Color);
- NewColor:=AllocGDKColor(AWinControl.Font.Color);
- //debugln('UpdateWidgetStyleOfControl New Font
Color=',dbgs(NewColor.Pixel),' ',dbgs(NewColor.Red),' ',dbgs(NewColor.Green),'
',dbgs(NewColor.Blue));
- CreateRCStyle;
- {for i:=0 to 4 do begin
- RCStyle^.text[i]:=NewColor;
- RCStyle^.fg[i]:=NewColor;
- RCStyle^.bg[i]:=NewColor;
- RCStyle^.base[i]:=NewColor;
- RCStyle^.color_flags[i]:=
- RCStyle^.color_flags[i] or 15;
- end;}
-
- RCStyle^.text[GTK_STATE_NORMAL]:=NewColor;
-
- // Indicate which colors the GtkRcStyle will affect;
- // unflagged colors will follow the theme
- RCStyle^.color_flags[GTK_STATE_NORMAL]:=
- RCStyle^.color_flags[GTK_STATE_NORMAL] or GTK_RC_TEXT;
-
- //DebugLn('UpdateWidgetStyleOfControl Font Color
',DbgSName(AWinControl),' Color=',DbgS(AWinControl.Font.Color));
- end;
-
// set font (currently only TCustomLabel)
- if GtkWidgetIsA(Widget,gtk_label_get_type)
+ if (GtkWidgetIsA(Widget,gtk_label_get_type)
or GtkWidgetIsA(Widget,gtk_editable_get_type)
+// or GtkWidgetIsA(Widget,gtk_button_get_type)
+ or GtkWidgetIsA(Widget,gtk_check_button_get_type))
and ((AWinControl.Font.Name<>DefFontData.Name)
or (AWinControl.Font.Size<>0)
or (AWinControl.Font.Style<>[]))
Index: interfaces/gtk/gtkdef.pp
===================================================================
--- interfaces/gtk/gtkdef.pp (wersja 8501)
+++ interfaces/gtk/gtkdef.pp (kopia robocza)
@@ -220,7 +220,8 @@
TWidgetInfoFlag = (
- wwiNotOnParentsClientArea
+ wwiNotOnParentsClientArea,
+ wwiHasOwnStyle
);
TWidgetInfoFlags = set of TWidgetInfoFlag;
Index: interfaces/gtk/gtkcallback.inc
===================================================================
--- interfaces/gtk/gtkcallback.inc (wersja 8501)
+++ interfaces/gtk/gtkcallback.inc (kopia robocza)
@@ -153,8 +153,6 @@
end;
end;
- if (TObject(Data) is TWinControl) then
- UpdateWidgetStyleOfControl(TWinControl(Data));
if not (csDesigning in TComponent(Data).ComponentState) then
RealizeAccelerator(TComponent(Data),Widget);
Index: interfaces/gtk/gtkobject.inc
===================================================================
--- interfaces/gtk/gtkobject.inc (wersja 8501)
+++ interfaces/gtk/gtkobject.inc (kopia robocza)
@@ -1308,7 +1308,28 @@
else Accelerate(AComponent, ASignalWidget, Ord(AccelKey), 0, ASignal);
end;
+procedure TGtkWidgetSet.SetLabelColor(const ALabel : PGtkWidget;const
FGColor,BGColor : longint);
+var
+ WindowStyle: PGtkStyle;
+// xColor:tGDKColor;
+// change : boolean;
+begin
+ windowStyle:=gtk_widget_get_style(aLabel);
+ if (FGCOlor<>clNone) and ((FGColor and SYS_COLOR_BASE)=0) then begin
+ windowStyle^.fg[0]:=AllocGDKColor(FGColor);
+ end;
+ if (BGCOlor<>clNone) and ((BGColor and SYS_COLOR_BASE)=0) then begin
+ windowStyle^.bg[0]:=AllocGDKColor(BGColor);
+ end;
+// SetWidgetColor(aWidget,windowStyle);
+ gtk_widget_set_style(aLabel,windowStyle);
+
+
+end;
+
+
+
{------------------------------------------------------------------------------
procedure TGtkWidgetSet.RealizeWidgetSize(Widget: PGtkWidget; NewWidth,
NewHeight: integer);
Index: interfaces/gtk/gtkproc.pp
===================================================================
--- interfaces/gtk/gtkproc.pp (wersja 8501)
+++ interfaces/gtk/gtkproc.pp (kopia robocza)
@@ -1248,14 +1248,14 @@
{$IFDEF EnableHideFromTaskBar}
// GTK1: reshowing does not work, so a modal form will hide the whole
application
// GTK
-
+
XDisplay := GDK_WINDOW_XDISPLAY (Window);
XScreen := XDefaultScreenOfDisplay(xdisplay);
XRootWindow := XRootWindowOfScreen(xscreen);
XWindow := GDK_WINDOW_XWINDOW (Window);
_NET_WM_STATE := XInternAtom(xdisplay, '_NET_WM_STATE', false);
- _NET_WM_STATE_SKIP_TASKBAR := XInternAtom(xdisplay,
'_NET_WM_STATE_SKIP_TASKBAR', false);
+ _NET_WM_STATE_SKIP_TASKBAR := XInternAtom(xdisplay,
'_NET_WM_STATE_SKIP_PAGER', false);
XEvent._type := ClientMessage;
XEvent.window := XWindow;
@@ -1268,6 +1268,12 @@
XEvent.data.l[1] := _NET_WM_STATE_SKIP_TASKBAR;
XSendEvent(XDisplay, XRootWindow, False, SubstructureNotifyMask, @XEvent);
+
+
+ _NET_WM_STATE_SKIP_TASKBAR := XInternAtom(xdisplay,
'_NET_WM_STATE_SKIP_PAGER', false);
+ XEvent.data.l[1] := _NET_WM_STATE_SKIP_TASKBAR;
+
+ XSendEvent(XDisplay, XRootWindow, False, SubstructureNotifyMask, @XEvent);
{$ENDIF}
end;
Index: interfaces/gtk/gtkwsbuttons.pp
===================================================================
--- interfaces/gtk/gtkwsbuttons.pp (wersja 8501)
+++ interfaces/gtk/gtkwsbuttons.pp (kopia robocza)
@@ -58,6 +58,7 @@
class procedure SetCallbacks(const AGtkWidget: PGtkWidget; const
AWidgetInfo: PWidgetInfo); virtual;
public
class function CreateHandle(const AWinControl: TWinControl; const
AParams: TCreateParams): TLCLIntfHandle; override;
+ class procedure InitStyle(const AWinControl: TWinControl); override;
class procedure ActiveDefaultButtonChanged(const AButton: TCustomButton);
override;
class function GetText(const AWinControl: TWinControl; var AText:
String): Boolean; override;
class procedure SetShortcut(const AButton: TCustomButton; const
OldShortcut, NewShortcut: TShortcut); override;
@@ -74,12 +75,15 @@
class procedure UpdateLayout(const AInfo: PBitBtnWidgetInfo; const
ALayout: TButtonLayout; const AMargin: Integer);
class procedure UpdateMargin(const AInfo: PBitBtnWidgetInfo; const
ALayout: TButtonLayout; const AMargin: Integer);
public
+ class procedure InitStyle(const AWinControl: TWinControl); override;
class function CreateHandle(const AWinControl: TWinControl; const
AParams: TCreateParams): TLCLIntfHandle; override;
class procedure SetGlyph(const ABitBtn: TCustomBitBtn; const AValue:
TBitmap); override;
class procedure SetLayout(const ABitBtn: TCustomBitBtn; const AValue:
TButtonLayout); override;
class procedure SetMargin(const ABitBtn: TCustomBitBtn; const AValue:
Integer); override;
class procedure SetSpacing(const ABitBtn: TCustomBitBtn; const AValue:
Integer); override;
class procedure SetText(const AWinControl: TWinControl; const AText:
String); override;
+ class procedure SetColor(const AWinControl: TWinControl); override;
+
end;
{ TGtkWSSpeedButton }
@@ -136,6 +140,51 @@
SetCallbacks(PGtkWidget(Result), WidgetInfo);
end;
+
+
+procedure tGtkWsButton.initStyle(const AWinControl: TWinControl);
+var
+ Widget : PGtkWidget;
+ BtnWidget: PGtkButton;
+ LblWidget : PGtkWidget;
+ WidgetInfo: PWidgetInfo;
+ NewStyle,
+ OldStyle: PGtkStyle;
+ BitBtnInfo: PBitBtnWidgetInfo;
+
+
+
+
+begin
+ Widget:=PGtkWidget(AWinControl.Handle);
+ WidgetInfo := GetWidgetInfo(Widget);
+ if (WidgetInfo<>nil) and not (wwiHasOwnStyle in widgetInfo^.Flags) then
begin
+
+ OldStyle:=gtk_widget_get_style(Widget);
+ NewStyle:=gtk_style_copy(OldStyle);
+ gtk_widget_set_style(Widget,NewStyle);
+
+ {$IFDEF GTK2}
+ LblWidget := PGtkBin(Widget)^.Child;
+ {$ELSE}
+ LblWidget := PGtkButton(Widget)^.Child;
+ {$ENDIF}
+
+
+ if LblWidget <> nil then begin
+ OldStyle:=gtk_widget_get_style(LblWidget);
+ NewStyle:=gtk_style_copy(OldStyle);
+ gtk_widget_set_style(LblWidget,NewStyle);
+ end;
+
+ Include(WidgetInfo^.Flags,wwiHasOwnStyle);
+ end;
+
+
+
+end;
+
+
procedure TGtkWSButton.ActiveDefaultButtonChanged(const AButton:
TCustomButton);
begin
if (AButton.Active)
@@ -199,6 +248,7 @@
GtkWidgetSet.SetLabelCaption(LblWidget, AText, AWinControl,
PGtkWidget(BtnWidget), 'clicked');
end;
+
procedure TGtkWSButton.GetPreferredSize(const AWinControl: TWinControl;
var PreferredWidth, PreferredHeight: integer);
begin
@@ -267,6 +317,39 @@
TGtkWSButton.SetCallbacks(PGtkWidget(Result), WidgetInfo);
end;
+procedure tGtkWsBitBtn.initStyle(const AWinControl: TWinControl);
+var
+ Widget : PGtkWidget;
+ WidgetInfo: PWidgetInfo;
+ NewStyle,
+ OldStyle: PGtkStyle;
+ BitBtnInfo: PBitBtnWidgetInfo;
+
+
+
+
+begin
+ Widget:=PGtkWidget(AWinControl.Handle);
+ WidgetInfo := GetWidgetInfo(Widget);
+ if (WidgetInfo<>nil) and not (wwiHasOwnStyle in widgetInfo^.Flags) then
begin
+
+ OldStyle:=gtk_widget_get_style(Widget);
+ NewStyle:=gtk_style_copy(OldStyle);
+ gtk_widget_set_style(Widget,NewStyle);
+ BitBtnInfo := WidgetInfo^.UserData;
+ if BitBtnInfo^.LabelWidget <> nil then begin
+ OldStyle:=gtk_widget_get_style(BitBtnInfo^.LabelWidget);
+ NewStyle:=gtk_style_copy(OldStyle);
+ gtk_widget_set_style(BitBtnInfo^.LabelWidget,NewStyle);
+ end;
+
+ Include(WidgetInfo^.Flags,wwiHasOwnStyle);
+ end;
+
+
+
+end;
+
procedure TGtkWSBitBtn.SetGlyph(const ABitBtn: TCustomBitBtn;
const AValue: TBitmap);
var
@@ -369,6 +452,26 @@
WidgetInfo^.CoreWidget, 'clicked');
end;
+
+procedure TGtkWSBitBtn.SetColor(const AWinControl: TWinControl);
+var
+ WidgetInfo: PWidgetInfo;
+ BitBtnInfo: PBitBtnWidgetInfo;
+
+begin
+// if not WSCheckHandleAllocated(AWincontrol, 'SetText')
+// then Exit;
+
+
+ WidgetInfo := GetWidgetInfo(Pointer(AWinControl.Handle));
+ BitBtnInfo := WidgetInfo^.UserData;
+ if BitBtnInfo^.LabelWidget = nil then Exit;
+ initStyle(AWinControl);
+
+ GtkWidgetSet.SetLabelColor(BitBtnInfo^.LabelWidget, AWinControl.font.color,
AWinControl.color);
+end;
+
+
procedure TGtkWSBitBtn.UpdateLayout(const AInfo: PBitBtnWidgetInfo;
const ALayout: TButtonLayout; const AMargin: Integer);
begin
Index: interfaces/gtk/gtkwscontrols.pp
===================================================================
--- interfaces/gtk/gtkwscontrols.pp (wersja 8501)
+++ interfaces/gtk/gtkwscontrols.pp (kopia robocza)
@@ -75,6 +75,7 @@
public
// Internal public
class procedure SetCallbacks(const AGTKObject: PGTKObject; const
AComponent: TComponent);
+
public
class procedure AddControl(const AControl: TControl); override;
@@ -425,6 +426,9 @@
procedure TGtkWSWinControl.SetColor(const AWinControl: TWinControl);
begin
+// Widget := PGtkWidget(AWinControl.Handle);
+
+ initStyle(AWinControl);
UpdateWidgetStyleOfControl(AWinControl);
end;
Index: interfaces/gtk/gtkint.pp
===================================================================
--- interfaces/gtk/gtkint.pp (wersja 8501)
+++ interfaces/gtk/gtkint.pp (kopia robocza)
@@ -252,6 +252,7 @@
public
// for gtk specific components:
procedure SetLabelCaption(const ALabel: PGtkLabel; const ACaption: String;
const AComponent: TComponent; const ASignalWidget: PGTKWidget; const ASignal:
PChar); virtual;
+ procedure SetLabelColor(const ALabel : PGtkWidget;const FGColor,BGColor :
longint);
procedure SetCallback(const AMsg: LongInt; const AGTKObject: PGTKObject;
const ALCLObject: TObject); virtual;
procedure SendPaintMessagesForInternalWidgets(AWinControl: TWinControl);
function LCLtoGtkMessagePending: boolean;virtual;
Index: include/wincontrol.inc
===================================================================
--- include/wincontrol.inc (wersja 8501)
+++ include/wincontrol.inc (kopia robocza)
@@ -4790,7 +4790,6 @@
Constraints.UpdateInterfaceConstraints;
InvalidatePreferredSize;
TWSWinControlClass(WidgetSetClass).ConstraintsChange(Self);
- FWinControlFlags := FWinControlFlags - [wcfColorChanged,wcfFontChanged];
//WriteClientRect('A');
if Parent <> nil then AddControl;
Index: widgetset/wscontrols.pp
===================================================================
--- widgetset/wscontrols.pp (wersja 8501)
+++ widgetset/wscontrols.pp (kopia robocza)
@@ -87,6 +87,7 @@
class procedure SetPos(const AWinControl: TWinControl; const ALeft, ATop:
Integer); virtual;
class procedure SetSize(const AWinControl: TWinControl; const AWidth,
AHeight: Integer); virtual;
class procedure SetText(const AWinControl: TWinControl; const AText:
String); virtual;
+ class procedure InitStyle(const AWinControl: TWinControl); virtual;
{ TODO: this procedure is only used in win32 interface }
class procedure AdaptBounds(const AWinControl: TWinControl;
@@ -140,6 +141,10 @@
begin
end;
+procedure TWSWinControl.InitStyle(const AWinControl: TWinControl);
+begin
+end;
+
function TWSWinControl.CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): HWND;
begin
{I start.inc}
program TEST_MV;
{.$mode objfpc}
{$H+}
uses
Interfaces,
classes,
gtkproc,
// wproot,
// pdffonts,
X, XLib, XUtil, //Font retrieval and Keyboard handling
glib, gdk, gtk, {$Ifndef NoGdkPixbufLib}gdkpixbuf,{$EndIf} GtkFontCache,
LMessages, LCLProc, LCLStrConsts, LCLIntf, LCLType, DynHashArray,
GraphType, GraphMath, Graphics, GTKWinApiWindow, LResources, Controls,
Buttons, Menus, StdCtrls, ComCtrls, CommCtrl, ExtCtrls, Dialogs, ExtDlgs,
FileUtil, ImgList, GTKGlobals, gtkDef,
math,
bitbtnform,
// wpekran,
// wpekran,
// wpstring,
//bazagr,
// bazad2,
// wppick,
// bazaPPL,
// sdbis,
Forms;
//in 'TV_Add_Remove_U1.pas' {Form1};
//{$R *.RES}
type
rZasilekPtr = ^rZasilek;
rZasilek =
packed record
index : word;
dni : Word;
wyplacono : Word;
podatek : Single;
brutto : Double;
opis : string[30];
podstawaSuma : Double;
procent : Single;
dniowka : Double;
{lista : word;}
{lRodz : tsPick;}
sumaDni : word;
rodzaj : string[9];
poz : Word;
kodch : string[4];
nrChoroby : string[8];
dzakl,
dZUSCH,
dInne,
dFGSP : word;
typ : byte;
tuzin : boolean;
{lplac : tsPick;}
stawkaPodat,
stawkamies : double;
dniobow : byte;
premiaKw,
premiaRocz : double;
dniowkaMies : double;
bezplatne : shortint;
urlopEXP : boolean;
urlopGodzin : boolean;
ilgodzin : single;
godzinobow : single;
wolne : string[1];
gpraca : array[0..14] of byte;
miesiacPR,
dZUSWP,
{ stawkaPodat,
stawkamies : double;
dniobow : byte;
premiaKw,
premiaRocz : double;
dniowkaMies : double;
wolne : string[29];
dZUSWP,
} dniZKL1,
dniFP1,
dniInne1 : word;
lPraca,
lUrlop,
lchor,
lObow : array[0..30] of byte;
wInne,
wProcent,
wstawka,
wPraca,
wUrlop,
wChor,
wPremia,
wUzup : array[0..30] of double;
tabG : array[1..10]of double;
end;
ttabzas = array [ 1..8]of rzasilek;
//var
// tabzas :^ttabzas;
procedure PostEdit2(ESP : tForm);
var
odp : word;
sa : string;
ia : word;
fs2,
fsc : ansistring;
fname : string;
begin
with esp do begin
{
fname:='';
}
end;
end;
procedure testBB;
var
tt : ttabzas;
lip,pole,lipp,
i,ia,
miesA : word;
aaa,
wsp : double;
gt : string[50];
d23,
d24,
d71 : double;
bbb : byte;
dat1999 : word;
tuz,
znal : boolean;
aamies : word;
begin
// dat1999:=dmyToDate(1,1,1999);
dat1999:=1;
d23:=0;
i:=1;
lip:=1;
{ for pole:=1 to 4 do begin
for i:= 10 downto 1 do begin
with tabzas^[i] do begin
try
// tabzas^[pole].gpraca[lip]:=tabzas^[pole].gpraca[lip]+round(tabpen[i].tabG[1]);
tabzas^[pole].gpraca[lip]:=tabzas^[pole].gpraca[lip]+round(tt[i].tabG[1]);
except
on Ezerodivide do tabzas^[pole].gpraca[lip]:=0;
else tabzas^[pole].gpraca[lip]:=0;
end;
end;
end;
end;
}
end;
(*
procedure MoveFast(const Src; var Dest; count : Integer);
begin
writeln('movefast',longint(@src):9,longint(@dest):9,count:9);
move(src,dest,count)
end;
procedure BazaChoice(nr,n1,n2,n3 : integer;var nnn : integer;var istring : shortstring;pl : tPickList);
{-Return a state string given an index}
var
it1 : pointer;
i : integer;
pickptr : BazaPL;
begin
if nr <= 0 then begin
exit;end;
pickPtr:=pointer(pl);
with PickPtr.bazaPtr do begin
it1:=item;
if longint(s)=0 then writeln('stop 00a');
writeln('choice a0 ',longint(item):11,' ',longint(item2):11,' ',longint(@item2):11,longint(@item):11);
movefast(item^,item2^,6);
movefast(item^,item2^,6);
writeln('choice aa ',longint(item),' ',longint(item2),' ');
item:=it1;
end;
end;
procedure testMM;
var
tb : tSadBisPL;
ss : shortstring;
ii : integer;
begin
tb:=tSadBisPL.Init;
BazaChoice(1,2,3,4,ii,ss,tb);
{ with tb do begin
writeln('choice a0 ',longint(item):11,' ',longint(item2):11,' ',longint(@item2):11,longint(@item):11);
movefast(item^,item2^,6);
// eee('123'+long2str(byte((item2+5)^))+long2str(byte((item2+6)^))+long2str(byte((item2+7)^)));
movefast(item^,item2^,6);
writeln('choice aa ',longint(item):,' ',longint(item2),' ');
end;
} tb.free;
end;
*)
procedure startapp;
begin
// wpAplication:=nil;
writeln('sadrrr>','<');
Application.Initialize;
end;
(*
procedure listafontow;
var
ts : tStringList;
i : integer;
thefonts : PPchar;
N : integer;
Tmp: AnsiString;
begin
ts:=tStringList.create;
fillscreenfonts(ts);
for i:=1 to ts.count-1 do
writeln(ts[i]);
theFonts := XListFonts(X11Display,PChar('-*-*-*-*-*-*-*-*-*-*-*-*-*-*'), 80000, @N);
// debugln('FillScreenFonts N=',dbgs(N));
for I := 0 to N - 1 do
if theFonts[I] <> nil then begin
// Tmp := ExtractFamilyFromXLFDName(theFonts[I]);
tmp:=theFOnts[i];
if Tmp <> '' then begin
// if ScreenFonts.IndexOf(Tmp) < 0 then
ts.Append(Tmp);
writeln(tmp);
end;
end;
XFreeFontNames(theFonts);
// for i:=1 to ts.count do
// writeln(ts[i]);
ts.free;
end;
*)
procedure testPYT;
begin
// pytanieTN('dddddd');
Application.CreateForm(TForm1, Form1);
// Form1.formcreate(application);
// wpAplication:=form1;
// listafontow;
Application.Run;
// form1.create (application);
// form1.show;
end;
procedure testlinie;
var
linie : array[0..1,0..100] of shortstring;
i,ii,iii : integer;
begin
fillchar(linie,sizeof(linie),0);
for i := 0 to 1 do begin
for ii:= 1 to 3 do begin
for iii:= 1 to 3 do begin
linie[i,ii]:= linie[i,ii]+char(64+ii+i*10);
end;
writeln(i:5,ii:5,linie[i,ii]) ;
end;
end;
end;
(*
procedure testFile;
const
ilma =16000;
var
sb : dosIdStream;
mb : byteArrayPtr;
lb ,
i : integer;
ww : integer ;
ppp : ^integer;
begin
getMemcheck(ppp,4);
ppp^:=1;
sb:=dosIdStream.init('rr',SOpenRead);
for i:= 1 to 1000 do begin
getMemcheck(mb,ilma);
writeln('tff',longint(mb),ppp^:5);
sb.seek(0);
lb:=sb.read(mb^,ilma);
freememcheck(mb,ilma);
end;
sb.free;
freememcheck(ppp,4);
end;
*)
procedure testCOMP;
var
nr,nra : comp;
begin
nra:=2;
nra:=nra+2;
nra:=nra+2.0;
nr:=$2eeeeeeeFeeeeeee;
nra:=nra*nr;
// nra:=nra div 2.0;
if nr<>nra then writeln(' blad');
writeln('gggg ',nr,' gggg');
end;
procedure addSpeed(ax,ay : integer;sss : string;aEntry : tForm);
var
bt : tSpeedButton;
begin
bt:=tSpeedButton.create(aEntry);
bt.caption:=sss;
bt.left:=ax;
bt.width:=50;
bt.top:=ay;
bt.parent:=aENtry;
bt.parentfont:=false;
bt.font.color:=clBlue;
bt.font.size:=20;
bt.show;
// bt.brush.color:=kl;
end;
procedure addBitBtn(ax,ay,kl : integer;sss : string;aEntry : tForm);
var
bt : tBitBtn;
begin
bt:=tBitBtn.create(aEntry);
bt.caption:=sss;
bt.left:=ax;
bt.top:=ay;
bt.width:=50;
bt.parent:=aEntry;
// bt.parentfont:=false;
bt.font.color:=kl;
bt.font.size:=20;
bt.show;
// bt.brush.color:=kl;
end;
procedure addButton(ax,ay,kl : integer;sss : string;aEntry : tForm);
var
bt : tButton;
begin
bt:=tButton.create(aEntry);
bt.caption:=sss;
bt.left:=ax;
bt.top:=ay;
bt.width:=50;
bt.parent:=aEntry;
// bt.parentfont:=false;
bt.font.color:=kl;
bt.font.size:=20;
bt.show;
// bt.brush.color:=kl;
end;
procedure testBrush;
var
tcc : tControlCanvas;
bkcolor : TColorRef;
begin
Application.CreateForm(TForm1, Form1);
// Form1.formcreate(application);
// wpAplication:=form1;
// listafontow;
// form1. color:=clAqua;
(*
form1.boolField := TCheckBox.Create(form1);
With form1.boolField do
begin
Parent := form1;
width := 80;
left := 15;
top := 50;
// Caption := 'bkClose';
caption:='fffffffffffff';
// font.size:=17;
// font.name:='courier new';
// font.charset:=1;
font.color:=clBlue;
// Show;
end;
form1.buffer:= tEdit.create(form1) ;
// tcc:=tControlCanvas.create;
/// tcc.control:=form1.buffer;
// tcc.bkcolor:=clred;
// BkColor := SetBkColor(MaskDC, ColorToRGB(clred));
form1.buffer.text:='aaaa';
// form1.buffer.color:=clGreen;
form1.buffer.font.Color:=clred;
form1.buffer.parent:=form1;
*)
addSpeed(10,100,'aaaaaaaaaaaa',form1);
addBitBtn(10,150,clred,'aaaaaaaaaaaa',form1);
addBitBtn(80,150,clgreen,'aaaaaaaaaaaa',form1);
addBitBtn(160,150,clblue,'aaaaaaaaaaaa',form1);
addButton(10,200,clRed,'aaaaaaaaaaaa',form1);
addButton(80,200,clGreen,'aaaaaaaaaaaa',form1);
(*
with form1.buffer do begin
parent:=form1;
// font.size:=10;
// caption:='ddddddddddd';
text:='tttttttttttttt';
// bkcolor:=clred;
color:=clgreen;
// brush.AllocateResources(brush.canvas,false);
// Pen.Color:=clred;
// brush.color:=clgreen;
// tcc.Brush.color:=clRed;
// font.color:=clgreen;
// brush.AllocateResources(brush.canvas,false);
// SetBkColor(tcc.handle, 4 );
end;
*)
Application.Run;
// Canvas.Draw(0,0,Buffer);
end;
procedure testDestroy;
begin
Application.CreateForm(TForm1, Form1);
form1.buffer:= tEdit.create(form1) ;
form1.Label1 := TLabel.Create(form1);
With form1.Label1 do
begin
Parent := form1;
width := 80;
left := 15;
top := 50;
color:=clRed;
Show;
end;
with form1.buffer do begin
parent:=form1;
top:=10;
// font.size:=10;
// caption:='ddddddddddd';
text:='tttttttttttttt';
color:=clgreen;
end;
addSpeed(10,50,'aaaaaaaaaaaa',form1);
addBitBtn(10,120,clred,'aaaaaaaaaaaa',form1);
form1.DestroyWnd;
Application.Run;
end;
begin
// testLinie;
// testFile;
// testComp;
startapp;
{ new(tabzas);
testBB;
dispose(tabzas);
}
// testPYT;
testBrush;
// testDestroy;
end.
