Eigene Radiobuttons programmieren, wie?

Für Fragen von Einsteigern und Programmieranfängern...
Antworten
thosch
Beiträge: 328
Registriert: Mo 10. Jul 2017, 20:32

Eigene Radiobuttons programmieren, wie?

Beitrag von thosch »

Hallo,

ich hab dazu folgenden Ansatz:

Zunächst die UI Unit:

Code: Alles auswählen

{$MODE OBJFPC}{$H+}
{$modeswitch nestedprocvars}
unit tuiCore;
interface
uses 
    tools,vipgfx,myTTF;


const 
	tuiIDcounter : dword = 0;

	tuiBoxStd							= 1;
	tuiBoxStatic						= 2;
	tuiBoxNull							= 3;


type


	TtuiBox = class;



	TtuiBoxProc = procedure(box:TtuiBox) is nested;
	TtuiExecProc = procedure(param:string) of object;



	TtuiThemeTUI = record
			tui_StandartFontSize : byte;
	end;


	TtuiTUI = class
		public
			ThemeTui : TtuiThemeTUI;

			screen : gfxImage;

			boxes : TtuiBox;

			mainFont : ttfFont;
			switchBoxes : boolean;
		
			mouseCaptured : boolean;

			constructor create(theScreen:gfxImage;fontFileName:string);
			destructor destroy; override;

			procedure addBox(aBox:TtuiBox);
			procedure closeBox(aBox:TtuiBox);
			

			procedure update;


			function getBoxByID(theID:dword):TtuiBox;
			function getBoxByName(theName:string):TtuiBox;

		private
			
			function countBoxes:dword;

			procedure destroyBoxes;

			function getlastbox:TtuiBox;
			procedure sortBoxes4last(id:dword);
			function isInAnyBoxExclude(box:TtuiBox):boolean;			
			function isLastBox(theBox:TtuiBox):boolean;

			procedure deleteBox(Box:TtuiBox);

			procedure cleanClick;

			function createThemeTui:TtuiThemeTui;
	end;







	TtuiThemeBox = record
			Box_ActivateBorderUse : boolean;
			Box_ActivateBorderColor : dword;
			Box_ActivateBorderInitial : dword;

			Box_AlphaBlendOnCreate : boolean;
			Box_AlphaBlendOnCreateDelay : dword;

			Box_AlphaBlendOnClose : boolean;
			Box_AlphaBlendOnCloseSpeed : dword;

			Box_DockOnScreenBorder : boolean;


			Box_FontColorForderground : dword;
			Box_BackgroundColor : dword; 

			Box_LeftTopBorderColor : dword;
			Box_RightBottomBorderColor : dword;

			Box_HintTextColor:dword;
			Box_HintBackgroundColor:dword;

			Box_CrookedPixels:dword;
	end;



	TtuiBox = class
		public
			itemType : dword;

			BoxType : longint;
			BoxID : dword;
			BoxName : string;

			boxX,boxY : longint;
			boxWidth,boxHeight : longint;

			TUISelf : TtuiTUI;

			ThemeBox : TtuiThemeBox;


			active : boolean;

			nextBox : TtuiBox;
			lastBox : TtuiBox;

			items : TtuiBox;

			
			mouseInNirvana : boolean;

			dragging : boolean;

			function update:boolean; virtual;
			function getItemID:dword;virtual;abstract;
			function getNextItem:TtuiBox; virtual;
			procedure setNextItem(item:TtuiBox); virtual;
			
			constructor create(theTuiSelf:TtuiTUI;posX,posY:longint; theBoxWidth,theBoxHeight:dword; theName:string; theType:longint);
			destructor destroy; override;

			procedure addItem(item:TtuiBox);

			
			function createThemeBox:TtuiThemeBox;



			function isInBox(theBox:TtuiBox):TtuiBox;


			procedure isMouseInNirvana;
			procedure activateBox;			
			
		    procedure Draw; virtual;
		private			
			activationCount : integer;			

			clicked : boolean;

			doClose : boolean;

			
			procedure dragBox;
			procedure drawBox;

			

			function isInAnyBox:boolean;


		
			procedure deactiveAllBoxesExceptSelf;


			function isMouseInBox:boolean;
	end;


var
	oldMouseX:longint;
	oldMouseY:longint;

implementation



constructor TtuiTUI.create(theScreen:gfxImage;fontFileName:string);
begin
    //inherited Create;
	ThemeTui:=createThemeTui;
	boxes:=nil;
  	ttfCreateFont(fontFileName,ThemeTui.Tui_StandartFontSize,mainFont);
  	switchBoxes:=true;
  	screen:=theScreen;
end;


function TtuiTUI.createThemeTui:TtuiThemeTui;
var t:TtuiThemeTui;
begin
	t.Tui_StandartFontSize := 31;
	result:=t;
end;



function TtuiTUI.isInAnyBoxExclude(box:TtuiBox):boolean;
var 
    aBox:TtuiBox;
begin
    result:=false;

    aBox:=boxes;
    
    while assigned(aBox) do begin
        if aBox.isMouseInBox then begin
            if aBox<>box then begin
                result:=true;
                exit;
            end;
        end;
        aBox:=aBox.nextBox;
    end;

end;

procedure TtuiTUI.destroyBoxes;
var box:TtuiBox;
	prevbox:TtuiBox;
begin
	if countBoxes <> 0 then begin
		box:=boxes;
		while assigned(box) do begin
			prevbox:=box;
			box:=prevbox.nextBox;

			prevbox.free; prevbox:=nil;
		end;
	end;
end;



destructor TtuiTUI.destroy;
begin
	ttfCloseFont(mainFont);
	destroyBoxes;
end;



function TtuiTUI.countBoxes:dword;
var box:TtuiBox;
begin
	result:=0;
	box:=boxes;
	while assigned(box) do begin
		inc(result);
		box:=box.nextBox;
	end;
end;

procedure TtuiTUI.closeBox(aBox:TtuiBox);
var box:TtuiBox;
begin
	box:=boxes;
	while assigned(box) do begin
		if box=aBox then begin
			box.doClose:=true;
			exit;
		end;
		box:=box.nextBox;
	end;
end;



function TtuiTUI.isLastBox(theBox:TtuiBox):boolean;
var box:TtuiBox;
	i:dword;
begin
	result:=false;
	i:=0;
	box:=boxes;
	while assigned(box) do begin
		inc(i);
		
		if theBox.BoxID = box.BoxID then begin
			break;
		end;

		box:=box.nextBox;
	end;
	if i=countBoxes then result:=true;
end;



procedure TtuiTUI.addBox(aBox:TtuiBox);
label lActiveBox;
var box:TtuiBox;
    prevbox:TtuiBox;
    lastbox:TtuiBox;
begin
	lastbox:=nil;
	box:=boxes;

	if not assigned(box) then begin
		aBox.lastBox:=nil;
		aBox.nextBox:=nil;
		boxes:=aBox;
		goto lActiveBox;
	end;

	while assigned(box) do begin
      	if box.nextbox<>nil then lastbox:=box;
      	prevbox:=box;
 	   	box:=box.nextbox;
	end;

	abox.lastbox:=prevbox;
  	prevbox.lastbox:=lastbox;
  	prevbox.nextbox:=abox;
  	
lActiveBox:
  	aBox.deactiveAllBoxesExceptSelf;
  	aBox.active:=true;

end;



procedure TtuiTUI.CleanClick;
var box:TtuiBox;
begin
	box:=boxes;
	if not assigned(box) then exit;

	while assigned(box) do begin
		
		if box.clicked then box.clicked:=false;

		box:=box.nextBox;
	end;	
end;



procedure TtuiTUI.update;
label topBox;
var 
	box:TtuiBox;
begin
topBox:
	box:=boxes;
	if assigned(box) then
	while assigned(box) do begin
		
		if box.update then goto topBox;

		box:=box.nextBox;
	end;


	CleanClick;

	if not mouseL then switchBoxes:=true;

	oldMouseX:=mouseX;
	oldMouseY:=mouseY;
end;



function TtuiTUI.getlastbox:TtuiBox;
var aBox:TtuiBox;	
begin
	result:=nil;
	aBox:=boxes;
	while assigned(aBox) do begin
		result:=aBox;
		aBox:=aBox.nextBox;             
   end;
end;



procedure TtuiTUI.sortBoxes4last(id:dword);
var aBox,prev:TtuiBox;	
	savedBox:TtuiBox;
	thelastbox:TtuiBox;
begin
	if boxes = nil then exit;
	if boxes.nextBox = nil then exit;

	aBox:=boxes;
	thelastbox:=getlastbox;

	while assigned(aBox) do begin

		if aBox.BoxID = id then begin

        	if not assigned(aBox.lastbox) then begin
				boxes:=boxes.nextbox;
				boxes.lastbox:=nil;
				thelastbox.nextbox:=abox;
				abox.nextbox:=nil;
				abox.lastbox:=thelastbox;
				exit;
      	   	end;

			savedBox:=aBox;

			abox.lastBox.nextBox:=abox.nextBox;
			abox.nextBox.lastBox:=abox.lastBox;

		end;

		prev:=aBox;
		aBox:=aBox.nextBox;             
   end;

   	if not assigned(savedBox) then exit;

	savedBox.nextBox:=nil;
	savedBox.lastBox:=prev;
	prev.nextBox:=savedBox;		
end;




function TtuiTUI.getBoxByID(theID:dword):TtuiBox;
var aBox:TtuiBox;
begin
	aBox:=boxes;
	while assigned(aBox) do begin 
		if aBox.BoxID = theID then begin
			result:=aBox;
			exit;
		end;
		aBox:=aBox.nextBox;
	end;
end;



function TtuiTUI.getBoxByName(theName:string):TtuiBox;
var aBox:TtuiBox;
begin
	aBox:=boxes;
	while assigned(aBox) do begin 
		if aBox.boxName = theName then begin
			result:=aBox;
			exit;
		end;
		aBox:=aBox.nextBox;
	end;
end;





procedure TtuiTUI.deleteBox(Box:TtuiBox);
var aBox:TtuiBox;
	savedBox:TtuiBox;
begin
	aBox:=boxes;
	if not assigned(aBox) then exit;
	
	while assigned(aBox) do begin

		if aBox.BoxID = box.BoxID then begin
			
			savedBox:=aBox;

            if not assigned(aBox.lastbox) then begin
					boxes:=boxes.nextbox;
					if assigned(boxes) then boxes.lastbox:=nil;
									
					break;
	        end;

 		   	abox.lastBox.nextBox:=abox.nextBox;

			if assigned(aBox.nextbox) then abox.nextBox.lastBox:=abox.lastBox;

		end;

		aBox:=aBox.nextBox;             
   end;

	savedBox.free; savedBox:=nil;
end;


constructor TtuiBox.create(theTuiSelf:TtuiTUI; posX,posY:longint;theBoxWidth,theBoxHeight:dword;theName:string;theType:longint);
begin
    //inherited create;
    TUISelf:=theTUISelf;
    ThemeBox:=createThemeBox;
    BoxType:=theType;
    inc(tuiIDcounter);
    BoxID:=tuiIDcounter;
    boxX:=posX;
    boxY:=posY;
    boxWidth:=theBoxWidth;
    boxHeight:=theBoxHeight;
    BoxName:=theName;
    lastbox:=nil;
    nextbox:=nil;
    doClose:=false;

end;



function TtuiBox.createThemeBox:TtuiThemeBox;
var t:TtuiThemeBox;
begin
	t.Box_ActivateBorderUse := true;
	t.Box_ActivateBorderColor := $ffffffff;
	t.Box_ActivateBorderInitial := 8;

	t.Box_AlphaBlendOnCreate := true;
	t.Box_AlphaBlendOnCreateDelay := 16;

	t.Box_AlphaBlendOnClose := true;
	t.Box_AlphaBlendOnCloseSpeed := 16;

	t.Box_DockOnScreenBorder := false;


	t.Box_FontColorForderground := $ffFFFFFF;
	t.Box_BackgroundColor := $ff2D2D2D; 

	t.Box_LeftTopBorderColor := $ff007ACC;
	t.Box_RightBottomBorderColor := $ff007ACC;

	//t.Box_HintTextColor:=$ffcccccc;
	t.Box_HintTextColor:=$ffffffff;
	t.Box_HintBackgroundColor:=$ff424245;

	t.Box_CrookedPixels:=$ff686868;
	result:=t;
end;



destructor TtuiBox.destroy;
var
	aItem,lastItem:TtuiBox;
begin 
  	aItem:=items;
	while assigned(aItem) do begin
		lastItem:=aItem;
		aItem:=aItem.getNextItem;
		lastItem.Free; lastItem:=nil;
	end;
end;


function TtuiBox.getNextItem:TtuiBox;
begin
	result:=nil;
end;

procedure TtuiBox.setNextItem(item:TtuiBox);
begin
end;

procedure  TtuiBox.drawBox;
begin

    drawBarClip(TUIself.screen,boxX,boxY,boxX+boxWidth,boxY+boxHeight,ThemeBox.Box_BackgroundColor);

    if BoxType = tuiBoxStatic then exit;


    drawVLineClip(TUIself.screen,boxY,boxY+boxHeight-1,boxX,ThemeBox.Box_LeftTopBorderColor);
    drawHLineClip(TUIself.screen,boxX,boxX+boxWidth-1,boxY,ThemeBox.Box_LeftTopBorderColor);
    drawVLineClip(TUIself.screen,boxY,boxY+boxHeight-1,boxX+boxWidth-1,ThemeBox.Box_RightBottomBorderColor);
    drawHLineClip(TUIself.screen,boxX,boxX+boxWidth-1,boxY+boxHeight-1,ThemeBox.Box_RightBottomBorderColor);

    if (activationCount>0) and (ThemeBox.Box_ActivateBorderUse) then begin
        if (activationCount mod 4) = 1 then begin
            drawVLineClip(TUIself.screen,boxY,boxY+boxHeight-1,boxX,ThemeBox.Box_ActivateBorderColor);
            drawHLineClip(TUIself.screen,boxX,boxX+boxWidth-1,boxY,ThemeBox.Box_ActivateBorderColor);
            drawVLineClip(TUIself.screen,boxY,boxY+boxHeight-1,boxX+boxWidth-1,ThemeBox.Box_ActivateBorderColor);
            drawHLineClip(TUIself.screen,boxX,boxX+boxWidth-1,boxY+boxHeight-1,ThemeBox.Box_ActivateBorderColor);    
        end;
    end;


end;

procedure TtuiBox.Draw;
begin
  drawBox;
end;


function TtuiBox.isMouseInBox:boolean;
begin
    result:=false;
    if (mouseX > boxX) and (mouseX < (boxWidth+boxX)) and (mouseY > boxY) and (mouseY < (boxHeight+boxY)) then result:=true;
end;


function TtuiBox.isInBox(theBox:TtuiBox):TtuiBox;
var 
    aBox:TtuiBox;
begin
    result:=nil;

    if theBox=nil then
        aBox:=TUISelf.boxes
    else
        aBox:=theBox;

    
    while assigned(aBox) do begin
        if aBox.isMouseInBox then begin
            result:=aBox;
        end;
        aBox:=aBox.nextBox;
    end;


end;

function TtuiBox.isInAnyBox:boolean;
var 
    aBox:TtuiBox;
begin
    result:=false;

    aBox:=TUISelf.boxes;
    
    while assigned(aBox) do begin
        if aBox.isMouseInBox then begin
            result:=true;
            exit;
        end;
        aBox:=aBox.nextBox;
    end;

end;


procedure TtuiBox.deactiveAllBoxesExceptSelf;
var 
    aBox:TtuiBox;
begin
    aBox:=TUISelf.boxes;
    
    while assigned(aBox) do begin
        if aBox.BoxID<>BoxID then begin
            aBox.active:=false;
        end;
        aBox:=aBox.nextBox;
    end;
end;


procedure TtuiBox.activateBox;
begin
    if not tuiSelf.switchBoxes then exit;
    if active then exit;  
    TUISelf.sortBoxes4last(BoxID);
    
    deactiveAllBoxesExceptSelf;
        
    activationCount:=ThemeBox.Box_ActivateBorderInitial;
    active:=true;   
 end;


procedure TtuiBox.dragBox;
begin
    if not mouseL then begin
        dragging:=false;
        exit;
    end;
    boxX:=boxX+(mouseX-oldMouseX);
    boxY:=boxY+(mouseY-oldMouseY); 
end;




procedure TtuiBox.isMouseInNirvana;
begin
    if mouseL and (not isInAnyBox) then
        mouseInNirvana:=true;
    
    if dragging then 
        mouseInNirvana:=false;

    if not mouseL then 
        mouseInNirvana:=false;
end;


function TtuiBox.update:boolean;
label onlyIterate;
var
	aItem:TtuiBox;
begin
    result:=false;



    if BoxType = tuiBoxNull then begin
    	goto onlyIterate;
    end;

    if dragging then dragBox;
    

    isMouseInNirvana;

    if BoxType = tuiBoxStd then begin

        if mouseL then 
        if (not mouseInNirvana) then begin

            	if (isInBox(nil)=Self) and (not tuiSelf.isLastBox(Self)) and (not dragging) and (not clicked)and tuiSelf.switchBoxes and (not tuiSelf.mouseCaptured) then begin
                    activateBox;
                    clicked:=true;
                    result:=true;
                    exit;
            	end else

                if (isInBox(nil)=Self) and tuiSelf.isLastBox(Self) and active then begin        
                    dragging:=true;
                end;

        end;

    end;

    if BoxType = tuiBoxStatic then begin
        dragging:=false;
    end;



    
    if activationCount>=0 then dec(activationCount);


    drawBox;



onlyIterate:

	aItem:=items;
	while assigned(aItem) do begin
		aItem.update;
		aItem:=aItem.getNextItem;
	end;
 

    if doClose then begin
       tuiSelf.deleteBox(Self);
       result:=true;
    end;
end;



procedure TtuiBox.addItem(item:TtuiBox);
var aItem,lastItem:TtuiBox;
begin

    aItem:=items;
    if not assigned(aItem) then begin
        items:=item;
        exit;
    end;

	aItem:=items;
	while assigned(aItem) do begin
		lastItem:=aItem;
		aItem:=aItem.getNextItem;
	end;

	lastItem.setNextItem(item);
 
end;







begin
end.
Nun mein Radiobutton:

Code: Alles auswählen

unit tuiRadioButton;
{$mode objfpc}
interface

uses classes,vipgfx,myTTF,tuiCore;

const
   tuiItemID_RadioButton = 14;
   
   
type
    TtuiThemeRadioButton = record
       theme_FontColor: dword;
       theme_BackgroundColor: dword;
       theme_FRameLeftTopColor: dword;
       theme_FrameRightBottomColor: dword;
       theme_PressedColor: dword;
       theme_PressedTimeOut: dword;
       theme_PressedTimeOutSpeed: dword;
       theme_SelectedBorderColor: dword;
       theme_CircleColor: dword;
       theme_CheckedColor: dword;
       theme_CircleBackColor: dword;
    end;

type
    TtuiRadioButton = class(TtuiBox)
    public
       RadioButtonID: Integer;
       RadioButtonName: String;
       RadioButtonCaption: String;
       ParentBox: TtuiBox;
       tuiThemeRadioButton: TtuiThemeRadioButton;
       next: TtuiBox;
       x,y,width,height: Integer;
       is_checked: boolean;

       constructor create(theParentBox:TtuiBox; theName:string; theX,theY:integer; the_Width:dword; the_Height:dword; aCaption:string; theExecProc:TtuiExecProc);
       procedure drawRadioButton;    //Radiobutton zeichnen
       function isChecked:boolean;   //soll feststellen, ob Radiobutton ausgewählt
       procedure updateRadioButton;  //veränderten Zustand zeigen und registrieren
       function update:boolean; override;
       function getNextItem: TtuiBox; override; //nächsten Radiobutton finden
       procedure setNextItem(Item: TtuiBox); override; //auf nächsten Radiobutton einstellen
    private
       execProc: TtuiExecProc;
       function isMouseOverCheckMark:boolean; //Ist Mauszeiger über der Auswahlmarke?
       procedure UnCheckAll;   //soll dafür sorgen, dass bei Auwahl anderer Radiobutton zuerst alle anderen UnCheked werden
       function CreateThemeRadioButton: TtuiThemeRadioButton; //Farbschema holen, zum Zeichnen
    end;

implementation


constructor TtuiRadioButton.create(theParentBox: TtuiBox; theName: string;
  theX, theY: integer; the_Width: dword; the_Height: dword; aCaption:string;
  theExecProc: TtuiExecProc);
//var rb: TRadioButton;
begin
  inherited create(theParentBox.TUISelf,theparentbox.BoxX+theX,theparentBox.BoxY+y+theY,the_width,the_Height,theName,TuiBoxStd);
  RadioButtonID := tuiItemID_RadioButton;
  RadioButtonName := theName;
  RadioButtonCaption := aCaption;
  ParentBox:=theParentBox;
  execProc := theExecProc;
  x:=theX;
  y:=theY;
  width:=the_width;
  height:=the_height;
  tuiThemeRadioButton := CreateThemeRadioButton;
  //rb := TRadioButton.Create(self);
end;

procedure TtuiRadioButton.drawRadioButton;
var Clip_Rect: TRect;
begin
  Clip_Rect := Rect(parentBox.boxX+x,parentBox.BoxY+y,ParentBox.BoxX+x+width,parentBox.BoxY+y+height);

  if Is_Checked then
  begin
    DrawBarClip(parentBox.TUIself.screen,parentBox.boxX+x,Clip_Rect.Top,parentBox.boxX+x+width,parentBox.BoxY+y+Height, TuiThemeRadioButton.theme_BackGroundColor);

    DrawHLineClip(parentBox.TUIself.screen,parentBox.boxX+x,parentBox.boxX+x+width,Clip_Rect.Top,TuiThemeRadioButton.theme_FrameLeftTopColor);
    DrawVLineClip(parentBox.TUIself.screen,Clip_Rect.Top,Clip_Rect.Bottom,parentBox.boxX+x+width,TuiThemeRadioButton.theme_FrameLeftTopColor);
    DrawHLineClip(parentBox.TUIself.screen,parentBox.boxX+x,parentBox.boxX+x+width,Clip_Rect.Bottom,TuiThemeRadioButton.theme_FrameRightBottomColor);
    DrawVLineClip(parentBox.TUIself.screen,Clip_Rect.Top,Clip_Rect.Bottom,parentBox.boxX+x,TuiThemeRadioButton.theme_FrameRightBottomColor);

    DrawCircleClip(parentBox.TUIself.screen, parentBox.boxX+x+16, parentBox.BoxY+y+10, 8, TuiThemeRadioButton.theme_CircleColor);
    DrawCircleClip(parentBox.TUIself.screen, parentBox.boxX+x+16, parentBox.BoxY+y+10, 7, TuiThemeRadioButton.theme_CircleBackColor);
    DrawCircleClip(parentBox.TUIself.screen, parentBox.boxX+x+16, parentBox.BoxY+y+10 ,4, TuiThemeRadioButton.theme_CheckedColor);
    DrawCircleClip(parentBox.TUIself.screen, parentBox.boxX+x+16, parentBox.BoxY+y+10 ,3, TuiThemeRadioButton.theme_CheckedColor);
    DrawCircleClip(parentBox.TUIself.screen, parentBox.boxX+x+16, parentBox.BoxY+y+10 ,2, TuiThemeRadioButton.theme_CheckedColor);
    
    ttfPrintStringXY(parentBox.TUIself.screen,parentBox.TUIself.mainfont,parentBox.boxX+x+30,parentBox.BoxY+y+2,TuiThemeRadioButton.theme_FontColor, RadioButtonCaption);
  end
  else
  begin
    DrawBarClip(parentBox.TUIself.screen,parentBox.boxX+x,parentBox.BoxY+y,parentBox.boxX+x+width,parentBox.BoxY+y+Height,TuiThemeRadioButton.theme_BackGroundColor);

    DrawHLineClip(parentBox.TUIself.screen,parentBox.boxX+x,parentBox.boxX+x+width,parentBox.BoxY+y,TuiThemeRadioButton.theme_FrameLeftTopColor);
    DrawVLineClip(parentBox.TUIself.screen,parentBox.BoxY+y,parentBox.BoxY+y+Height,parentBox.boxX+x+width,TuiThemeRadioButton.theme_FrameLeftTopColor);
    DrawHLineClip(parentBox.TUIself.screen,parentBox.boxX+x,parentBox.boxX+x+width,parentBox.BoxY+y+Height,TuiThemeRadioButton.theme_FrameRightBottomColor);
    DrawVLineClip(parentBox.TUIself.screen,parentBox.BoxY+y,parentBox.BoxY+y+Height,parentBox.boxX+x,TuiThemeRadioButton.theme_FrameRightBottomColor);

    DrawCircleClip(parentBox.TUIself.screen, parentBox.boxX+x+16, parentBox.BoxY+y+10, 8, TuiThemeRadioButton.theme_CircleColor);
    DrawCircleClip(parentBox.TUIself.screen, parentBox.boxX+x+16, parentBox.BoxY+y+10, 7, TuiThemeRadioButton.theme_CircleBackColor);
    
    ttfPrintStringXY(parentBox.TUIself.screen,parentBox.TUIself.mainfont,parentBox.boxX+x+30,parentBox.BoxY+y+2,TuiThemeRadioButton.theme_FontColor, RadioButtonCaption);
  end;

  //Clip_Rect := Rect(Clip_Rect.Left,Clip_Rect.Top,Clip_Rect.Right,Clip_Rect.Top+Height);

end;

procedure TtuiRadioButton.updateRadioButton;
begin
  if isMouseOverCheckMark then
  begin
    if mouseL then 
    begin
      //UncheckAll;
      is_Checked := isChecked;
      //if assigned(execproc) then execproc('');
    end;
  end;
  drawRadioButton;
end;

function TtuiRadioButton.update:boolean;
begin
  //Result := inherited update;
  UpdateRadioButton;  Result := true;
end;

function TtuiRadioButton.isChecked: boolean;
begin
  if isMouseOverCheckMark then
    if mouseL {and isMouseOverCheckMark} then if is_checked then is_Checked := false else is_Checked := true;
  isChecked := is_checked;
end;

function TtuiRadioButton.isMouseOverCheckMark: boolean;
begin
  Result := (mousex >= parentBox.BoxX+x+8) and (mousex <= parentBox.BoxX+x+25) and (mousey >= parentBox.BoxY+y+8) and (mousey <= parentBox.BoxY+y+18);
end;

procedure TtuiRadioButton.UnCheckAll;
var box: TtuiBox; i,rbCount: integer;
begin
  box := ParentBox; rbCount := 0;
  while box.Items <>nil do
  begin
    if (box.Items is TtuiRadioButton) then
    begin
      inc(rbCount);
      (box.Items as TtuiRadioButton).is_checked:=isChecked;
    end;
    box.Items := box.Items.getNextItem;
  end;
  box := ParentBox;
  {
  i:=0;
  while (box.Items <> nil) and (i<rbCount) do
  begin
    if (box.Items is TtuiRadioButton) then (box.Items as TtuiRadioButton).is_checked := false;
    inc(i); box.Items := box.Items.getNextItem;
  end;
  }
end;

function TtuiRadioButton.CreateThemeRadioButton: TtuiThemeRadioButton;
begin
  with tuiThemeRadioButton do
  begin  
     theme_FontColor := $ff101010;
     theme_BackgroundColor := $ff3F3F46;
     theme_FrameLeftTopColor := $ff858585;
     theme_FrameRightBottomColor := $ff858585;
     theme_PressedColor := $ff007acc;
     theme_PressedTimeOut := 8;
     theme_PressedTimeOutSpeed := 1;
     theme_SelectedBorderColor := $ff0098fb;
     theme_CircleColor := RGBA(0,0,0,$ff);
     theme_CheckedColor := RGBA(0,0,0,$ff);
     theme_CircleBackColor := RGBA($ff,$ff,$ff,$ff);
  end;
  Result := tuiThemeRadioButton;
end;

function TtuiRadioButton.getNextItem: TtuiBox;
begin
  Result := next;
end;

procedure TtuiRadioButton.setNextItem(Item: TtuiBox);
begin
  next := Item;
end;

end.
Aber nun werden wie bei einer Checkbox alle Radiobuttons ausgewählt, wenn ich mit der Maus auf einen klicke. Immer der, wo die Maus drüber ist, die anderen bleiben ausgewählt.

Ich will aber jeweils nur einen davon auswählen, im Programm wäre das eine der angebotenen Optionen.

Wie stelle ich das an, was ist da in meinem Quellcode falsch:

Hier ist noch ein Testprogramm:

Code: Alles auswählen

program tuitest;

uses
tools, vipgfx, sysutils, tuiCore, tuiButton, tuiTextField, tuiDropBox,
tuiEditField, tuiSelectBox, tuiScrollBarHorizontal, tuiScrollBarVertical,
tuiMenuHorizontal, tuiMenuVertical, tuiDialogMessageBox, tuiDialogLoadFile,
tuiCheckBox, tuiRadioButton, tuiProgressBar, tuiPageControl, tuiHUpDown,
tuiVUpDown, tui_ToolBar;
type

 TmyExitBox = class
    aBox : TtuiBox;
   aButton : TtuiButton;
    aTextField : TtuiTextField;
    constructor Create;
    procedure execProcButton(param:string);
 end;

 TmyDropBox = class
    aBox : TtuiBox;
    aDropBox : TtuiDropBox;
    constructor Create;
    procedure ExecProcDropBox(param:string);
 end;

 TmyEditBox = class
    aBox : TtuiBox;
    aButton : TtuiButton;
    aTextField : TtuiTextField;
    aEditField : TtuiEditField;
    constructor Create;
    procedure execProcButton(param:string);
 end;


 TmySelectBox = class
    aBox : TtuiBox;
    aSelectBox : TtuiSelectBox;
    constructor Create;
    procedure execProcSeleectBoxClick(param:string);
    procedure execProcSeleectBoxDBClick(param:string);
 end;

 TmyScrollBars = class
    aBox : TtuiBox;
    aButton : TtuiButton;
    aTextField : TtuiTextField;
    aScrollBarHorizontal : TtuiScrollBarHorizontal;
    aScrollBarVertical : TtuiScrollBarVertical;
    constructor Create;
    procedure execProcScrollBarHorizontal(param:string);
    procedure execProcScrollBarVertical(param:string);
 end;



 TmyMenu = class
    aMenuHorizontal  : TtuiMenuHorizontal;
    aMenuVertical : TtuiMenuVertical;

    aButton : TtuiButton;
    aTextField : TtuiTextField;
    constructor Create;
    procedure execProcButton_BoxAbout_ButtonOK(param:string);
    procedure execProcMenuItemExit(param:string);
    procedure execProcMenuFile(param:string);
    procedure execProcMenuFileUnSelect(param:string);
    procedure execProcMenuItemAbout(param:string);
    procedure execProcMenuItemReference(param:string);
    procedure execProcMenuItemCheck(param:string);
    procedure execProcMenuHelpSelect(param:string);
    procedure execProcMenuHelpUnSelect(param:string);
    procedure execProcMenuSecond(param:string);
    procedure dummy(param:string);
 end;

 { TmyWidgets }

 TmyWidgets = class
    aBox: TtuiBox;
    aCheckBox: TtuiCheckBox;
    aRadioButton1: TtuiRadioButton;
    aRadioButton2: TtuiRadioButton;
    aHUpDown: TtuiHUpDown;
    aVUpDown: TtuiVUpDown;
    aProgressBar: TtuiProgressBar;
    aTuiPanel: TtuiPanel;
    aPageControl: TtuiPageControl;
    aToolBar: TtuiToolBar;
    aToolBtn: TtuiToolButton;
    constructor Create;
    procedure execProcHUpDown(param:string);
    procedure execProcVUpDown(param:string);
    procedure execProcCheckBox(param:string);
    procedure execprocRadioButton(param:string);
 end;



var
theTUI : TtuiTUI;
theExitBox : TmyExitBox;
theDropBox : TmyDropBox;
theEditBox : TmyEditBox;
theSelectBox : TmySelectBox;
theScrollBars : TmyScrollBars;
theMenu : TmyMenu;

thePageControl: TtuiPageControl;
theProgressBar: TtuiProgressBar;
theRadioButton: TtuiRadioButton;
theCheckBox: TtuiCheckBox;
theHUpDown: TtuiScrollBarHorizontal;
theVUpDown: TtuiScrollBarVertical;
theWidgets: TmyWidgets;

{ TmyWidgets }

constructor TmyWidgets.Create;
var aReg: TtuiButton; aPage: TtuiPage; aTab:TtuiTab; aPanel: TtuiPanel;
begin
  //inherited Create;
  aBox := TtuiBox.create(theTUI,100,100,500,500,'PgCtrl-TestBox',tuiBoxStd);
  theTUI.addBox(aBox);
                                                                                                                  
  aBox.addItem(aCheckBox);

  aCheckBox := TtuiCheckBox.create(aBox,'myCheckBox',10,35,100,20,'Auswahl',@execProcCheckBox);
  aBox.addItem(aCheckBox);

  ////----------------------------
  ////Hier ist der erste TtuiRadioButton
  aRadioButton1 := TtuiRadioButton.create(aBox,'myRadioButton-1',10,60,100,20,'Option 1',@execProcRadioButton);
  aBox.addItem(aRadioButton1);
  ////----------------------------

  //// Hier ist der zweite TtuiRadioButton
  aRadioButton2 := TtuiRadioButton.create(aBox,'myRadioButton-2',10,80,100,20,'Option 2',@execProcRadioButton);
  aBox.addItem(aRadioButton2);
  aHUpDown :=TtuiHUpdown.create(aBox,'myHUpdown',10,140,30,1000,@execprocHUpDown);
  aBox.addItem(aHUpDown);
  ////----------------------------
  ////----------------------------
  aVUpDown :=TtuiVUpdown.create(aBox,'myVUpdown',10,170,30,1000,@execprocVUpDown);
  aBox.addItem(aVUpDown);

  aProgressBar := TtuiProgressBar.Create(aBox,'myProgressBar',50,140,50,20,'0%',nil);
  aBox.addItem(aProgressBar);
end;

procedure TmyWidgets.execProcHUpDown(param: string);
var
  aBar: TtuiProgressBar;
  aUpDn: TtuiHUpdown;
begin
  aBox := theTUI.getBoxByName('myHUpdown');
  aUpDn := TtuiHUpdown(aBox);
  aBox := theTUI.getBoxByName('myProgressBar');
  aBar := TtuiProgressBar(aBox);
//  aBar.Position := aUpDn.curValue;  --- Exception
//  aBar.Update;                      --- Exception
end;

procedure TmyWidgets.execProcVUpDown(param: string);
begin
  aBox := theTUI.getBoxByName('myVUpdown');
end;

procedure TmyWidgets.execProcCheckBox(param: string);
begin
  aBox := theTUI.getBoxByName('myCheckBox');
  //TtuiCheckBox(aBox).drawCheckBox;
end;

procedure TmyWidgets.execprocRadioButton(param: string);
var
  aRBtn1: TtuiBox;
  aRBtn2: TtuiBox;
begin
  aRBtn1 := theTUI.getBoxByName('myRadioButton-1');
  aRBtn2 := theTUI.getBoxByName('myRadioButton-2');
  if TtuiRadioButton(aRBtn1).is_checked then TtuiRadioButton(aRBtn2).is_checked:=false;
  if TtuiRadioButton(aRBtn2).is_checked then TtuiRadioButton(aRBtn1).is_checked:=false;
end;


constructor TmyExitBox.Create;
begin
aBox:=TtuiBox.create(theTUI,300,300,200,100,'box2',tuiBoxStd);
theTUI.addBox(aBox);

aButton:=TtuiButton.create(aBox,'Button 2',30,55,140,32,'close',@execProcButton);
aBox.addItem(aButton);

aTextField:=TtuiTextField.create(aBox,'TextField 3',80,24,'Box 2');
aBox.addItem(aTextField);

end;


procedure TmyExitBox.execProcButton(param:string);
begin
aBox:=theTUI.getBoxByName('box2');
theTUI.CloseBox(aBox);
end;




constructor TmyDropBox.Create;
begin
aBox:=TtuiBox.create(theTUI,600,300,200,100,'box3',tuiBoxStd);
theTUI.addBox(aBox);

aDropBox:=TtuiDropBox.create(aBox,'dropBox',32,32,128,@ExecProcDropBox);
aDropBox.curChosen:=0;
aBox.addItem(aDropBox);

aDropBox.addString('String1');
aDropBox.addString('String2');
aDropBox.addString('String3');
aDropBox.addString('String4');
end;

procedure TmyDropBox.ExecProcDropBox(param:string);
begin
writeln('dropbox ',param);
end;

constructor TmyEditBox.Create;
begin
aBox:=TtuiBox.create(theTUI,100,100,200,100,'box1',tuiBoxStd);
theTUI.addBox(aBox);

aButton:=TtuiButton.create(aBox,'Button 1',30,55,140,32,'new',@execProcButton);
aBox.addItem(aButton);

aEditField:=TtuiEditField.create(aBox,'EditField 1',10,24,128,'test123456789009876543210abcd',@execProcButton);
aBox.addItem(aEditField);

end;

procedure TmyEditBox.execProcButton(param:string);
var efBox:TtuiBox;
begin
aBox:=TtuiBox.create(theTUI,100,450,200,100,'box4',tuiBoxStd);
theTUI.addBox(aBox);

efBox:=theTUI.getBoxByName('box1');
aEditField:=getEditFieldByName(efBox,'EditField 1');

aTextField:=TtuiTextField.create(aBox,'TextField 5',4,24,aEditField.theText);
aBox.addItem(aTextField);
end;

constructor TmySelectBox.Create;
var i:dword;
begin
aBox:=TtuiBox.create(theTUI,860,50,200,300,'box8',tuiBoxStd);
theTUI.addBox(aBox);

aSelectBox:=TtuiSelectBox.create(aBox,'selectBox',10,10,180,193,@execProcSeleectBoxClick,@execProcSeleectBoxDBClick);
aBox.addItem(aSelectBox);

for i:=0 to 16 do begin
    aSelectBox.addString('String'+numstr(i));
end;
end;


procedure TmySelectBox.execProcSeleectBoxClick(param:string);
begin
writeln('select '+param);
end;
procedure TmySelectBox.execProcSeleectBoxDBClick(param:string);
begin
writeln('selectDB '+param);
end;


constructor TmyScrollBars.Create;
begin

aBox:=TtuiBox.create(theTUI,900,370,200,300,'box7',tuiBoxStd);
theTUI.addBox(aBox);

aScrollBarHorizontal:=TtuiScrollBarHorizontal.Create(aBox,'Horizontal ScrollBar',10,10,100,124,@execProcScrollBarHorizontal);
aBox.addItem(aScrollBarHorizontal);

aScrollBarVertical:=TtuiScrollBarVertical.Create(aBox,'Vertical ScrollBar',128,32,100,124,@execProcScrollBarVertical);
aBox.addItem(aScrollBarVertical);



aTextField:=TtuiTextField.create(aBox,'TextField 5',64,64,':)');
aBox.addItem(aTextField);
aTextField:=TtuiTextField.create(aBox,'TextField 6',64,80,':)');
aBox.addItem(aTextField);



aBox:=TtuiBox.create(theTUI,350,70,200,200,'box8',tuiBoxStd);
theTUI.addBox(aBox);

aScrollBarHorizontal:=TtuiScrollBarHorizontal.Create(aBox,'Horizontal ScrollBar 2',10,10,100,124,@execProcScrollBarHorizontal);
aBox.addItem(aScrollBarHorizontal);

aScrollBarVertical:=TtuiScrollBarVertical.Create(aBox,'Vertical ScrollBar 2',128,32,100,124,@execProcScrollBarVertical);
aBox.addItem(aScrollBarVertical);

end;

procedure TmyScrollBars.execProcScrollBarHorizontal(param:string);
begin
aBox:=theTUI.getBoxByName('box7');
aScrollBarHorizontal:=getScrollBarHorizontalByName(aBox,'Horizontal ScrollBar');

aTextField:=getTextFieldByName(aBox,'TextField 5');
aTextField.caption:='X='+numstr(aScrollBarHorizontal.curValue);
end;


procedure TmyScrollBars.execProcScrollBarVertical(param:string);
begin
aBox:=theTUI.getBoxByName('box7');
aScrollBarVertical:=getScrollBarVerticalByName(aBox,'Vertical ScrollBar');

aTextField:=getTextFieldByName(aBox,'TextField 6');
aTextField.caption:='Y='+numstr(aScrollBarVertical.curValue);
end;









constructor TmyMenu.Create;
var aBox : TtuiBox;
begin
aBox:=TtuiBox.create(theTUI,0,0,200,200,'box Horizontal Menu',tuiBoxNull);
theTUI.addBox(aBox);

aMenuHorizontal:=TtuiMenuHorizontal.Create(aBox,'Main Menu',0,0,vscreen.width,18);

aMenuHorizontal.addMenuHorizontalItem('Menu File','File',@execProcMenuFile,@execProcMenuFileUnSelect);
aMenuHorizontal.addMenuHorizontalItem('Menu Help','Help',@execProcMenuHelpSelect,@execProcMenuHelpUnSelect);
aMenuHorizontal.addMenuHorizontalItem('Menu Second','Second',@execProcMenuSecond,@dummy);

aBox.addItem(aMenuHorizontal);
end;

procedure TmyMenu.execProcMenuFile(param:string);
var aItem : TtuiMenuHorizontalItem;
aBox : TtuiBox;
begin
aBox:=theTUI.getBoxByName('box Horizontal Menu');
aMenuHorizontal:=getMenuHorizontalByName(aBox,'Main Menu');
aItem:=aMenuHorizontal.getItemByName('Menu File');


aBox:=TtuiBox.create(theTUI,0,0,200,200,'box Vertical Menu File',tuiBoxNull);
theTUI.addBox(aBox);
aMenuVertical:=TtuiMenuVertical.create(aBox,'Vertical Menu File',aItem.x,18);
aMenuVertical.addMenuVerticalItem('Vertical Menu Help - Exit','Exit',@execProcMenuItemExit);

aBox.addItem(aMenuVertical);

end;

procedure TmyMenu.execProcMenuFileUnSelect(param:string);
var
aBox : TtuiBox;
begin
aBox:=theTUI.getBoxByName('box Vertical Menu File');
theTUI.CloseBox(aBox);
end;

procedure TmyMenu.execProcMenuHelpSelect(param:string);
var aBox : TtuiBox;
aItem : TtuiMenuHorizontalItem;
begin
aBox:=theTUI.getBoxByName('box Horizontal Menu');
aMenuHorizontal:=getMenuHorizontalByName(aBox,'Main Menu');
aItem:=aMenuHorizontal.getItemByName('Menu Help');

aBox:=TtuiBox.create(theTUI,0,0,200,200,'box Vertical Menu Help',tuiBoxNull);
theTUI.addBox(aBox);


aMenuVertical:=TtuiMenuVertical.create(aBox,'Vertical Menu Help',aItem.x,18);
aMenuVertical.addMenuVerticalItem('Vertical Menu Help - About','About',@execProcMenuItemAbout);
aMenuVertical.addMenuVerticalItem('Vertical Menu Help - Reference','Reference',@execProcMenuItemReference);
aMenuVertical.addMenuVerticalItem('Vertical Menu Help - Check','Check',@execProcMenuItemCheck);
aMenuVertical.addMenuVerticalItem('Vertical Menu Help - Check2','Check2',@execProcMenuItemCheck);
aBox.addItem(aMenuVertical);

end;
procedure TmyMenu.execProcMenuHelpUnSelect(param:string);
var aBox : TtuiBox;
begin
aBox:=theTUI.getBoxByName('box Vertical Menu Help');
theTUI.CloseBox(aBox);
end;

procedure TmyMenu.execProcMenuSecond(param:string);
begin
writeln('Second');
end;

procedure TmyMenu.dummy(param:string);
begin
end;


procedure TmyMenu.execProcMenuItemExit(param:string);
begin
gfxDone:=true;
end;

procedure TmyMenu.execProcMenuItemAbout(param:string);
var aBox : TtuiBox;
begin


aBox:=theTUI.getBoxByName('box Vertical Menu Help');
theTUI.CloseBox(aBox);

aBox:=TtuiBox.create(theTUI,100,450,200,100,'box about',tuiBoxStd);
theTUI.addBox(aBox);


aTextField:=TtuiTextField.create(aBox,'TextField About - TUI',84,24,'TUI');
aBox.addItem(aTextField);


aButton:=TtuiButton.create(aBox,'Button OK',30,55,140,32,'OK',@execProcButton_BoxAbout_ButtonOK);
aBox.addItem(aButton);
end;


procedure TmyMenu.execProcButton_BoxAbout_ButtonOK(param:string);
begin

end;

procedure TmyMenu.execProcMenuItemReference(param:string);
begin
writeln('execProcMenuItemReference');
end;

procedure TmyMenu.execProcMenuItemCheck(param:string);
begin
writeln('execProcMenuItemCheck');
end;





var
theDialogMessageBox:TtuiDialogMessageBox;
theDialogLoadFile:TtuiDialogLoadFile;


begin

      initgfxsystem(1280,720,false);



      theTUI:=TtuiTUI.create(vscreen,'corbel.ttf');

      theExitBox:=TmyExitBox.Create;
      theDropBox:=TmyDropBox.Create;
      theEditBox:=TmyEditBox.Create;
      theSelectBox:=TmySelectBox.Create;
      theScrollBars:=TmyScrollBars.Create;
      theMenu:=TmyMenu.Create;

      theDialogMessageBox:=TtuiDialogMessageBox.Create(theTUI,'hallo');
      theDialogLoadFile:=TtuiDialogLoadFile.Create(theTUI);
      theDialogLoadFile.doit;

      theWidgets := TmyWidgets.Create;

      repeat
          fastfill(vscreen.data,vscreen.width*vscreen.height,$ff000000);

          theTUI.update;

          updateGFXsystem;
      until gfxDone or keyboard[KEY_ESCAPE];

      theWidgets.Free;

      theDialogLoadFile.Free;
      theDialogMessageBox.Free;
      theExitBox.Free;
      theDropBox.Free;
      theEditBox.Free;
      theSelectBox.Free;
      theScrollBars.Free;
      theMenu.Free;


      finishGFXsystem;
      theTUI.Free;
      ReturnFPSstring;

end.
die fehlenden Dateien zum Nachvollziehen sind hier: https://disk.yandex.com/d/L8CChKs4ty0-zw
Nach oben
wennerer
Beiträge: 607
Registriert: Di 19. Mai 2015, 20:05
OS, Lazarus, FPC: Linux Mint 20 Cinnamon,Lazarus 2.2.6 (rev lazarus_2_2_6) FPC 3.2.2 x86_64-linux-
CPU-Target: x86_64-linux-gtk2

Re: Eigene Radiobuttons programmieren, wie?

Beitrag von wennerer »

Hallo thosch,
deinen Code nachzuvollziehen war mir etwas zuviel. Ich habe aber mal ein kleines Programm gemacht wie ich es angehen würde. Kannst es dir bei Gelegenheit ja mal ansehen.
RadioButtons.png
RadioButtons.png (14.08 KiB) 683 mal betrachtet
Viele Grüße
Bernd
Dateianhänge
EigeneRadioButtons.zip
(56.2 KiB) 55-mal heruntergeladen
Nach oben
Antworten

Zurück zu „Einsteigerfragen“