3D med sjølvvald farge

Mange av funksjonane i Lazarus (Pascal) har «Properties» for å lage utheva eller nedsenka 3D-figurar. I property-lista for funksjonen «Panel» finn ein såleis «BevelInner», «BevelOuter» og «BevelWidth», men ingen eigenskap for å setje farge på desse (så langt eg har funne). Difor måtte eg lage ein prosedyre som teiknar firkantar i ønskt storleik med valfri plassering, rammebreidde og farge.

Den aktuelle prosedyren er
procedure beveledFrame(). Dei to funksjonane changeColor og colAdd blir brukte av prosedyren. Eigentleg kunne dei ha blitt plasserte inne i hovudprosedyren, men eg valde å dele dei opp for å gjere oversynet enklare både for meg sjølv og andre.

Det første du finn inne i beveledFrame() er canvas: TCanvas;. Dette betyr at du kan bruke denne prosedyren på alle elementa som har canvas. Oppkallet kan vere t.d. beveledFrame(Form1.Panel1.Canvas, …). Koordinata for yttersidene i firkanten blir bestemt med Rect. Ramma blir teikna innover frå denne. Det indre området blir såleis koordinata i Rect minus 2 gonger sidebreidda. bw er breidda på ramma i pikslar. color er fargen på ramma. Den lyse delen av ramma blir litt lysare enn denne fargen, medan den mørke delen av ramma blir litt mørkare enn denne fargen. cchange er kor stor fargeforandringa skal vere. Som oftast passar ein verdi på 15 til 25 her. Dersom raised er sett til True, vil ramma bli utheva, medan verdien False gjer at ramma blir nedsenka.

Området innføre ramma blir ikkje påverka.

Koden:

function colAdd(c:Byte; a:Integer): Byte;
var cc: Integer; // Byte kan bare ha verdiane 0 … 255, difor Integer
begin            // for å fange opp vediar større enn 255 og mindre enn 0
  cc := c;
  cc := cc + a;
  if cc > 255 then cc := 255;
  if cc < 0 then cc := 0;
  result := cc;
end;

function changeColor(c: TColor; endring: Integer): TColor;
var
  r,g,b: Byte;
begin
  r := colAdd(Red(c),endring);
  g := colAdd(Green(c),endring);
  b := colAdd(Blue(c),endring);
  result := RGBToColor(r,g,b);
end;

procedure beveledFrame(canvas: TCanvas; rect:TRect; borderWidth:Integer; color:TColor; cchange: Integer; raised:Boolean);
var
  cDark, cLight, col1, col2: TColor; i: Integer;
begin
  cLight := changeColor(color,cchange);
  cDark := changeColor(color,-cchange);
  if (raised = True) then
    begin
      col1 := cLight; col2 := cDark;
    end
  else // lowered
    begin
      col2 := cLight; col1 := cDark;
    end;

  with canvas do
  begin
    for i := 0 to borderWidth-1 do // Teiknar ramma
      begin
        Pen.Color := col1;
        Line(Rect.Left+i,Rect.Bottom-i,Rect.Left+i,Rect.Top+i);
        LineTo(Rect.Right-i,Rect.Top+i);
        Pen.Color := col2;
        LineTo(Rect.Right-i,Rect.Bottom-i);
        LineTo(Rect.Left+i,Rect.Bottom-i);
      end;
  end;
end;

Eg prøvde nokså mange metodar for å forandre lysverdien på fargane. Den mest logiske, trudde eg, var å gjere om fargen frå RGB til HSV, HLS eller liknande, redusere eller auke lysverdien V og deretter omforme tilbake til RGB (eller BGR). Sjå HLStoColor og ColorToHLS. Eg prøvde også ColorAdjustLuma og DecColor, men dei gav av og til litt merkelege utslag når fargane kom for langt ut mot ytterkantane, dvs. for nær svart eller kvitt. Difor den eigenproduserte metoden, som eigentleg er svært enkel. Studer funksjonen changeColor() i programlistinga.
Normalt vil nok programmet vere noe meir konsentrert, men er sett opp slik for at du lettare skal forstå kva programmet gjer.

Send melding

Stuestøl heimeside

Sist endra 11. april 2013